Hra na utek

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: KMP (Klub mladých programátorov)
utek.pngAutor: Ivan Rebo
Program: Utek.pasReadme.txtEd.pasHp.pasHpu.pasIvo.pasPismo.pasPouzi.pasPrezri.pasRutins.pasSetup.pasTxtp.pasUnpack.pasUtek.pasVezmi.pasInstal.pasMakeins.pasXla.pasRiki.txtUvod.txt
Súbor exe: Utek.exeEd.exeSetup.exe
Potrebné: Mods.objUtek-working-dos.7z

Hra utek so zvukom na COVOX pre velmi stare pocitace.
{ TXTP.PAS                                  Copyright (c) Ivan Rebo }
{ https://github.com/IRebo/utek/tree/master/old-199x-version        }
{                                                                   }
{ Author: Ivan Rebo                                                 }
{ Datum: 20.01.1995                           http://www.trsek.com  }
 
program hoepack;
uses crt;
type ras=array[0..65534] of byte;
var f,f2:file;
    size,sizes:word;
    a,a2:^ras;
    meno:string;
    p,p2:pointer;
    c,d:byte;
    e,ff:word;
 
procedure packuj(siz:word);
begin
 blockread(f2,a^,siz);
 ff:=0;
 e:=0;
 c:=0;
 while e<siz do
 begin
  if (a^[e]<>13)and((a^[e]<>$a)) then a2^[e]:=a^[e]+30 else a2^[e]:=a^[e];
  inc(e);
  inc(ff);
 end;
 blockwrite(f,a2^,ff);
end;
 
begin
 writeln('HoeSoft''s beta-TXT-packer 1995 Ver 0.00.01');
 if paramstr(2)='' then begin writeln;
  writeln('Neboli zadane parametre: 1. Meno suboru na packovanie');
  writeln('                         2. Pripona buduceho suboru');
  writeln;halt(1);end;
 write('Packing...');
 getmem(p,65535);
 getmem(p2,65535);
 a:=p;
 a2:=p2;
 meno:=copy(paramstr(1),1,length(paramstr(1))-4);
 assign(f2,paramstr(1));
 reset(f2,1);
 assign(f,meno+'.'+paramstr(2));
 rewrite(f,1);
 size:=filesize(f2);
 repeat
  if size>64000 then
  begin
   size:=size-64000;
   sizes:=64000;
  end
  else sizes:=size;
  packuj(sizes);
 until size=sizes;
 close(f2);close(f);
 freemem(p,65535);freemem(p2,65535);
 writeln; writeln;
 writeln('Vela stastia a uspechov v DOSe.');
end.