Game escape
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Author: Ivan Rebo
Program: Utek.pas, Readme.txt, Ed.pas, Hp.pas, Hpu.pas, Ivo.pas, Pismo.pas, Pouzi.pas, Prezri.pas, Rutins.pas, Setup.pas, Txtp.pas, Unpack.pas, Utek.pas, Vezmi.pas, Instal.pas, Makeins.pas, Xla.pas, Riki.txt, Uvod.txt
File exe: Utek.exe, Ed.exe, Setup.exe
need: Mods.obj, Utek-working-dos.7z
Author: Ivan ReboProgram: Utek.pas, Readme.txt, Ed.pas, Hp.pas, Hpu.pas, Ivo.pas, Pismo.pas, Pouzi.pas, Prezri.pas, Rutins.pas, Setup.pas, Txtp.pas, Unpack.pas, Utek.pas, Vezmi.pas, Instal.pas, Makeins.pas, Xla.pas, Riki.txt, Uvod.txt
File exe: Utek.exe, Ed.exe, Setup.exe
need: Mods.obj, Utek-working-dos.7z
Escape game with sound for COVOX for very old computers.
{ UTEK.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 } {$a+,g+,B-,E-,I-,N-,O-,Q-,R-,S-,T-} {$l-,y-,d-} {$m 4000,281000,281000} program utek; uses crt,rutins; var f:file; kabinet,co,farb:byte; reg,neber,telcis:string[20]; inte,g,m:word; procedure kabload; begin win:=false; zm(har);zmaz; loadobr('data\kabinet'); assign(f,'data\kabinet.nnm');reset(f,1);close(f); if IOResult <> 0 then endee; assign(f,'data\kabinet.nnm');reset(f,1); blockread(f,mapa^,filesize(f)); depack(filesize(f),mappoi);close(f); move(tmp^,mapa^,49600); assign(t,'data\kabinet.nnt');reset(t);close(t); if IOResult <> 0 then endee; assign(t,'data\kabinet.nnt'); reset(t); a:=0; repeat inc(a);readln(t,strings^[a]);until eof(t); for b:=1 to a do for c:=1 to length(strings^[b]) do strings^[b][c]:=chr(ord(strings^[b][c])-30); close(t);movepal(seg(paletta^),ofs(paletta^));tmav;zobraz;kabsvetlo; end; procedure loadroomcele(meno:string); begin win:=false; zmcele(har);zmazcele; loadobrcele(meno); move(palletspri,paletta^[631],138); assign(f,meno+'.nnm');reset(f,1);close(f); if IOResult <> 0 then endee; assign(f,meno+'.nnm');reset(f,1); blockread(f,mapa^,filesize(f)); depack(filesize(f),mappoi);close(f); move(tmp^,mapa^,64000); assign(t,meno+'.nnt');reset(t);close(t); if IOResult <> 0 then endee; assign(t,meno+'.nnt'); reset(t); a:=0; repeat inc(a);readln(t,strings^[a]);until eof(t); for b:=1 to a do for c:=1 to length(strings^[b]) do strings^[b][c]:=chr(ord(strings^[b][c])-30); close(t);movepal(seg(paletta^),ofs(paletta^));tmavcele;zobrazcele;obcele(har); end; procedure klavesa; begin pauza(6700); end; procedure zmazfont; begin pis(165,1,' '); pis(174,1,' '); pis(183,1,' '); pis(192,1,' '); end; procedure intro; label endintro; begin zmcele(har);zmazcele;if soundis then begin stopsound;initsound(cfg,speed,'uvod.dom');end; loadobrcele('uvod\uvod1');move(palletspri,paletta^[631],138); movepal(seg(paletta^),ofs(paletta^));zobrazcele; tmavcele;ob(0); pis(165,1,' JE 31. JN. VETCI S U NETRPEZLIV.'); pis(174,1,' V TRIEDE 3.B. SA MARTINKA ROZPRVA S PRIATEKAMI :'); pis(183,1,'"NO TAK PO U ! P~JDEME ETE DO CUKROKY ?"'); pis(192,1,'"JA NEM~EM, IDEME NA VLET A ETE NIE SOM POBALEN."'); obfont(0); klavesa;if kl=27 then goto endintro; zmfont(0);zmazfont; pis(165,1,'"TAK SA MAJ. MY IDEME. PRJEMN PRZDNINY !"'); pis(174,1,'"AJ TEBE."'); pis(183,1,'MARTINKA SA OTOILA A CHCELA SA ROZBEHN DOMOV,'); pis(192,1,'KE TU ZRAZU PRED ĽOU ZASTAVILO DLH IERNE AUTO.'); obfont(0); klavesa;if kl=27 then goto endintro; zmfont(0);zmazfont; pis(165,1,'"AHOJ MARTINKA !", OZVAL SA HRUB HLAS.'); pis(174,1,'"DOBR DEĽ."'); pis(183,1,'"JA SOM KAMART TVOJHO OTECKA A IDEM S VAMI NA CHATU."'); pis(192,1,'"AHA, TO STE VY ? OTEC VS U SPOMNAL."'); obfont(0); klavesa;if kl=27 then goto endintro; zmfont(0);zmazfont; pis(165,1,'"MM A ODVIEZ DOMOV. AUTOM JE TO RCHLEJIE."'); pis(174,1,'"DOBRE, TAK TEDA IDEM."'); pis(183,1,'"SADNI SI SEM. HEJ ! JANO ! DUPNI NA TO. MME JU."'); obfont(0);klavesa;if kl=27 then goto endintro; zmfont(0);zmcele(0);zmazcele; loadobrcele('uvod\uvod2');move(palletspri,paletta^[631],138); movepal(seg(paletta^),ofs(paletta^));zobrazcele; tmavcele;ob(0); zmfont(0); pis(165,1,'PO CHVLI CESTOVANIA :'); pis(174,1,'"PUSTITE MA ! HEJ ! O MI ROBTE. A."'); pis(183,1,'"TAK, A JE TO V SUCHU. BUDE SPA ASPOĽ 4 HODINY."'); pis(192,1,'"AK P~JDEME RCHLO, STIHNEME TO."'); obfont(0); klavesa;if kl=27 then goto endintro; zmfont(0);zmazfont; pis(165,1,'PO TROCH HODINCH RCHLEJ CESTY :'); pis(174,1,'"SME NA MIESTE, FE."'); pis(183,1,'"O.K. VYSTP A ZOBER JU HORE."'); obfont(0); klavesa;if kl=27 then goto endintro; zmfont(0);zmcele(0);zmazcele; loadobrcele('uvod\uvod3');move(palletspri,paletta^[631],138); movepal(seg(paletta^),ofs(paletta^));zobrazcele; tmavcele;ob(0); zmfont(0); pis(165,1,'O HODINU NESK~R SA MARTINKA PREBRALA A ZISTILA,'); pis(174,1,'E NIE JE DOMA. ZRAZU PRIIEL OTCOV DAJN PRIATE.'); pis(183,1,'"KDE S OTEC A MAMA ?"'); pis(192,1,'"PRDU ZA CHVU. POZERAJ SA NA TELKU."'); obfont(0);klavesa;if kl=27 then goto endintro; zmfont(0);zmazfont; pis(165,1,'TAK SI TEDA PUSTILA TELKU A POZERALA SA A KM JU'); pis(174,1,'NEPRERUILO ZVONENIE TELEFNU.'); pis(183,1,'"TU JE PROFESOR NEMEHLO. MTE TO DIEVA ?"'); pis(192,1,'"NO, POZAJTRA JU PRIVEZIEME. KAMIL, VYBER TEN RUM !"'); obfont(0);klavesa;if kl=27 then goto endintro; zmfont(0);zmazfont; pis(165,1,'MARTINKA SI SADLA A ZAMYSLELA SA.'); pis(174,1,'"TAKE MM CEL DVA DNI NA TEK."'); pis(183,1,''); pis(192,1,'PODAR SA JEJ DOSTA S PAZROV PROFESORA ???'); obfont(0);klavesa;kl:=1;tloff; endintro:zmcele(0); if soundis then begin stopsound;initsound(cfg,speed,'title.dom');end; move(palletspri,paletta^[631],138); loadroomcele('code\uvod');umiestni(160*8,142*8); end; procedure memory; begin getmem(tmppoi,64786);getmem(obrpoi,64000);getmem(spritpoi,64000); getmem(mappoi,64000);getmem(pallpoi,6400); getmem(strpoi,sizeof(strings^));getmem(fontpoi,10000); font:=fontpoi;tmp:=tmppoi;mapa:=mappoi; paletta:=pallpoi;sprites:=spritpoi;obrazok:=obrpoi;strings:=strpoi; end; procedure loadsave(cislo:char); var pomoc:byte; begin assign(f,'saves\save'+cislo+'.sav');reset(f,1);close(f); if IOResult <> 0 then endee; assign(f,'saves\save'+cislo+'.sav'); reset(f,1); seek(f,14); blockread(f,pomoc,1); izba:=pomoc-34; blockread(f,pomoc,1); cast:=pomoc-36; blockread(f,pomoc,1); kabinet:=pomoc-38; blockread(f,predreal,40); for a:=1 to 40 do begin if predreal[a]-a-70=14 then predm[a]:=true else if predreal[a]-a-70=4 then predm[a]:=false;end; blockread(f,predreal,40); for a:=1 to 40 do begin if predreal[a]-a-70=14 then predmal[a]:=true else if predreal[a]-a-70=4 then predmal[a]:=false;end; close(f); end; procedure save(cislo:char;name2:string); var by,pomoc:byte; begin assign(f,'saves\save'+cislo+'.sav');rewrite(f,1);close(f); if IOResult <> 0 then endee; assign(f,'saves\save'+cislo+'.sav');reset(f,1); for a:=1 to length(name2) do begin by:=ord(name2[a])+60+a; blockwrite(f,by,1); end; for a:=length(name2)+1 to 14 do begin by:=$20+60+a; blockwrite(f,by,1); end; pomoc:=izba+34; blockwrite(f,pomoc,1); pomoc:=cast+36; blockwrite(f,pomoc,1); pomoc:=kabinet+38; blockwrite(f,pomoc,1); for a:=1 to 40 do begin if predm[a] then predreal[a]:=a+70+14 else predreal[a]:=a+70+4; end; blockwrite(f,predreal,40); for a:=1 to 40 do begin if predmal[a] then predreal[a]:=a+70+14 else predreal[a]:=a+70+4; end; blockwrite(f,predreal,40); close(f); end; procedure loadsav; var cisl:string; name2:array [0..9] of string[20]; cis:char; sejvy:array [0..9] of boolean; begin chdir('saves'); if IOResult <> 0 then mkdir('saves') else chdir('..'); if IOResult <> 0 then endee; for a:=0 to 9 do sejvy[a]:=false; pisat:=false; loadspr('code\load');zobraz;a:=0; repeat str(a,cisl); name2[a]:=''; assign(f,'saves\save'+cisl+'.sav'); {$i-} reset(f,1); if ioresult=0 then sejvy[a]:=true; if sejvy[a] then begin for c:=1 to 14 do begin blockread(f,b,1); name2[a]:=name2[a]+chr(b-60-c); end; close(f); end; inc(a); until a=10; for a:=0 to 9 do begin pis(19+12*(a+1),118,name2[a]);for b:=0 to 8 do move(mem[$a000:(17+12*(a+1))*320+118+b*320],obrazok^[(17+12*(a+1))*320+119+b*320],14*6); end; repeat kurzor(0); if prave then kl:=27; if lave then kl:=13; tl(0); b:=mapa^[x+y*320+1]; until (kl=27)or((b>=232)and(b<=241)and(sejvy[b-232])and(kl=13)); if kl<>27 then begin str(b-232,cisl); cis:=cisl[1]; if cisl='10' then cis:='0'; loadsave(cis); end; closewin;zobraz; pisat:=true; end; procedure savesav; var cisl:string; meno:string[14]; name2:array [0..9] of string[20]; kolke:byte; cis:char; sejvy:array [0..9] of boolean; begin chdir('saves'); if IOResult <> 0 then mkdir('saves') else chdir('..'); if IOResult <> 0 then endee; for a:=0 to 9 do sejvy[a]:=false; pisat:=false; loadspr('code\save');zobraz;a:=0; repeat str(a,cisl); name2[a]:=''; assign(f,'saves\save'+cisl+'.sav'); {$i-} reset(f,1); if ioresult=0 then sejvy[a]:=true; if sejvy[a] then begin for c:=1 to 14 do begin blockread(f,b,1);name2[a]:=name2[a]+chr(b-60-c);end;close(f); end;inc(a); until a=10; for a:=0 to 9 do begin pis(19+12*(a+1),118,name2[a]);for b:=0 to 8 do move(mem[$a000:(17+12*(a+1))*320+118+b*320],obrazok^[(17+12*(a+1))*320+119+b*320],14*6); end; repeat kurzor(0); if prave then kl:=27;if lave then kl:=13;tl(0);b:=mapa^[x+y*320+1]; until (kl=27)or((b>=232)and(b<=241)and(kl=13)); if kl<>27 then begin str(b-232,cisl);kolke:=b-232;cis:=cisl[1];if cisl='10' then cis:='0'; meno:='';pis(19+12*(kolke+1),118,' '); repeat kl:=ord(readkey); if (upcase(chr(kl))>='A')and(upcase(chr(kl))<='Z')and(length(meno)<14) then meno:=meno+upcase(chr(kl)); if (upcase(chr(kl))>='0')and(upcase(chr(kl))<='9')and(length(meno)<14) then meno:=meno+chr(kl); if (kl=8)and(length(meno)>0) then meno[0]:=chr(length(meno)-1); if (kl=32)and(length(meno)<14) then meno:=meno+' '; pis(19+12*(kolke+1),118,' '); pis(19+12*(kolke+1),118,meno); until ((kl=13)and(length(meno)<>0)and(length(meno)<>15))or(kl=27); if kl=13 then save(cis,meno); end; closewin;zobraz; if kl<>27 then say(192,9,'O.K. GAME SAVED !'); pisat:=true; end; procedure uvodd; begin move(palletspri,paletta^[631],138); loadroomcele('code\uvod'); pisat:=false; repeat kurzor(0); if (lave)or(kl=13) then begin if mapa^[x+y*320+1]<>0 then predmet:=strings^[mapa^[x+y*320+1]] else predmet:='';tl(0); if predmet=chr(3) then intro; if predmet=chr(2) then begin umiestni(160*8,80*8);zmazcelemapa(seg(mapa^),ofs(mapa^)); zmazcelemapa(seg(obrazok^),ofs(obrazok^)); zobrazcele;zobrazpred;loadsav; if kl<>13 then begin loadroomcele('code\uvod'); umiestni(160*8,142*8);end;pisat:=false; end; if predmet=chr(4) then ende; end else begin if kl=27 then ende; if prave then tl(0);end; until (predmet=chr(1))or((predmet=chr(2))and(kl=13)); if predmet<>chr(2) then begin loadobrcele('data\cast1');nuluj;cast:=1;izba:=1; zmcele(har);zmazcele; movepal(seg(paletta^),ofs(paletta^));tmavcele;zobrazcele;obcele(0); pauza(1500); zmcele(0);zmazcele; end; pisat:=true; end; procedure uvod; begin if soundis then begin initsound(cfg,speed,'title.dom'); end; loadobrcele('code\present'); movepal(seg(paletta^),ofs(paletta^));tmavcele; zobrazcele;obcele(har); a:=0; pauza(3500); if kl=27 then ende; tloff;zmcele(har); move(palletspri,paletta^[631],138); loadobrcele('code\uvadza'); movepal(seg(paletta^),ofs(paletta^));tmavcele; zobrazcele;obcele(har); pauza(2000); if kl=27 then ende; tloff;zmcele(har); uvodd; end; procedure loadfirst; begin for a:=0 to 255 do strings^[a]:=''; assign(f,'code\sprites.nnp');reset(f,1);close(f); if IOResult <> 0 then endee; assign(f,'code\sprites.nnp');reset(f,1); blockread(f,sprites^,filesize(f)); depack(filesize(f),spritpoi);close(f); move(tmp^[19+630],palletspri,138); move(tmp^[787],sprites^,64000); for a:=1 to 138 do palletspri[a]:=palletspri[a] div 4; for a:=0 to 45 do begin o:=palletspri[a*3+3];palletspri[a*3+3]:=palletspri[a*3+1]; palletspri[a*3+1]:=o;end; assign(f,'code\sprites.nnm');reset(f,1);close(f); if IOResult <> 0 then endee; assign(f,'code\sprites.nnm');reset(f,1); blockread(f,obrazok^,filesize(f)); depack(filesize(f),obrpoi);close(f); move(tmp^[155*320],sprites^[110*320],45*320); assign(t,'code\sprites.nnt');reset(t);close(t); if IOResult <> 0 then endee; assign(t,'code\sprites.nnt');reset(t);a:=0; repeat inc(a);readln(t,predstr[a]);until eof(t); for b:=1 to a do for c:=1 to length(predstr[b]) do predstr[b][c]:=chr(ord(predstr[b][c])-30); close(t); assign(t,'code\texty.nnt');reset(t);close(t); if IOResult <> 0 then endee; assign(t,'code\texty.nnt');reset(t);a:=0; repeat inc(a);readln(t,strings^[a+251]);until eof(t); for b:=251 to a+251 do for c:=1 to length(strings^[b]) do strings^[b][c]:=chr(ord(strings^[b][c])-30); close(t); assign(f,'code\font.nnp');reset(f,1);close(f); if IOResult <> 0 then endee; assign(f,'code\font.nnp'); reset(f,1); blockread(f,obrazok^,filesize(f)); depack(filesize(f),obrpoi); close(f);move(tmp^[787],font^,10000); asm les di,paletta xor ax,ax mov cx,3 rep stosw end; end; procedure cheat; begin for a:=6 to 14 do predm[a+12]:=true; end; procedure testuj; begin assign(f,'music\uvod.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>154940) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463465:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f);assign(f,'music\music1-2.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>85596) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463265:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f); assign(f,'music\music1-1.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>130060) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463465:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f);assign(f,'music\happyend.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>82051) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463265:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f); assign(f,'music\music2-1.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>68900) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463465:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f);assign(f,'music\music2-2.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>111621) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463265:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f); assign(f,'music\music2-3.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>101688) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463465:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f);assign(f,'music\music3-1.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>137740) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463265:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f); assign(f,'music\title.dom');reset(f,1); if (ioresult<>0)or(filesize(f)<>101681) then begin sound(1502);delay(154);nosound;writeln; writeln('Chyba - 463465:56874 - Chyba dolezity subor !!!'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end; close(f); end; procedure naloaduj; begin if soundis then begin if playing then stopsound; end; zobrazpred; if cast=1 then begin if izba=1 then loadroom('data\izba1'); if izba=3 then loadroom('data\izba2'); if izba=4 then loadroom('data\izba4'); if izba=5 then loadroom('data\izba3'); if izba=2 then loadroom('data\chodba'); if izba=6 then loadroom('data\chodba1'); if izba=7 then loadroom('data\kuchyna'); if izba=8 then loadroom('data\kabinet'); if izba=9 then loadroom('data\izba5'); if izba=10 then kabload; if izba=11 then loadroom('data\kabinet2'); if izba=12 then loadroom('data\telefon'); if izba=13 then loadroom('data\kabinet'); if izba=14 then loadroom('data\pivnica'); if izba=15 then loadroom('data\ulica'); if predmal[7] then predstr[14]:='VNOKENA'; end; if cast=2 then begin if izba=1 then loadroom('data2\posch1'); if izba=2 then loadroom('data2\poschod'); if izba=3 then loadroom('data2\posch2'); if izba=4 then loadroom('data2\poschkup'); if izba=5 then loadroom('data2\poschod2'); if izba=6 then loadroom('data2\poschzac'); if izba=7 then loadroom('data2\poschoby'); if izba=8 then loadroom('data2\poschkuc'); if izba=9 then loadroom('data2\prizchod'); if izba=10 then loadroom('data2\prizach'); if izba=11 then loadroom('data2\prizkuch'); if izba=12 then loadroom('data2\prizjeda'); if izba=13 then loadroom('data2\prizoby'); if izba=14 then loadroom('data2\sutere02'); if izba=15 then loadroom('data2\suteren'); if izba=16 then loadroom('data2\sutere01'); if izba=17 then loadroom('data2\prizvcho'); end; if cast=3 then begin if izba=1 then loadroom('data3\vratnica'); if izba=2 then loadroom('data3\vratposc'); end; if soundis then begin if cast=1 then if predmal[3] then meno:='music1-2.dom' else meno:='music1-1.dom'; if cast=2 then if (izba>=1)and(izba<=8) then meno:='music2-1.dom' else if (izba>=9)and(izba<=13)or(izba=17) then meno:='music2-2.dom' else if (izba>=14)and(izba<=16) then meno:='music2-3.dom'; if cast=3 then meno:='music3-1.dom'; initsound(cfg,speed,meno); end; end; procedure getreg; begin reg:='freeware'; { assign(f,'utek.exe'); reset(f,1); seek(f,30); blockread(f,hlava,51); close(f); for a:=1 to 20 do reg:=reg+chr(hlava[a+29]-a*3-50);} end; procedure testreg; begin {if hlava[51]<>$50 then begin writeln;writeln('Ilegalna kopia !!!');halt(40);end; if hlava[52]<>$40 then begin writeln;writeln('Ilegalna kopia !!!');halt(40);end; a:=52;repeat inc(a); until (hlava[a]-120<>mem[$f000:$78+(a-53)])or(a=81); if a<>81 then begin writeln;writeln('Ilegalna kopia !!!');halt(40);end;} end; {$i prezri.pas} {$i vezmi.pas} {$i pouzi.pas} {--------------------------------Hlavny program------------------------------} begin assign(f,'utek.exe'); reset(f,1); {if (ioresult<>0)or(filesize(f)<>46668) then begin sound(1502); delay(154); nosound; writeln; writeln('Chyba - 466665:56873 - Chyba v UTEK.EXE ! (mozno virus)'); writeln('Thanx for trying to play Utek ---------------------- NoName Software'); halt(0); end;} close(f); checkbreak:=false; getreg; k:=4;kl:=1;kabinet:=3;predme:=3;pisat:=true;neber:='TO DO RUKY NEVEZMEM !'; textcolor(lightmagenta);hc; writeln;writeln('-------------------------------------------------------------------------------'); textcolor(lightgreen); write('Utek 1.00');textcolor(7);write(' - ');textcolor(blue); write(' REGISTERED TO : ');textcolor(lightblue);writeln(reg); textcolor(lightmagenta); writeln('-------------------------------------------------------------------------------'); writeln;textcolor(lightred);write('Warning');textcolor(brown); write(' COPIES are ');textcolor(lightred+blink);write('NOT'); textcolor(brown);writeln(' FREE !!!');writeln;textcolor(cyan); write('Created by ');textcolor(lightcyan);write('NoName Software'); textcolor(cyan);writeln(', 6. 3. 1995 - All rights reserved.'); textcolor(7);sc;testinit;hc;textcolor(cyan);writeln; write('Press any key or mouse button to continue ...');textcolor(7); pauza(1500); gotoxy(1,wherey);write(' '); gotoxy(1,wherey);write('Loading ...'); sc;testuj;testreg;setsound; for a:=1 to 40 do predmal[a]:=false;for a:=1 to 40 do predm[a]:=false; izba:=1;co:=1;cast:=1; memory;loadfirst;asminit;umiestni(160*8,142*8); nuluj;uvod;move(palletspri,paletta^[631],138);paleta; movepal(seg(paletta^),ofs(paletta^)); zobrazpred;ob(har);mapaspod; naloaduj; b:=0;e:=19;d:=19; repeat kurzor(predme); if (lave)or(kl=13) then begin if mapa^[x+y*320+1]<>0 then predmet:=strings^[mapa^[x+y*320+1]] else predmet:=''; if predmet<>'' then begin if mapa^[x+y*320+1]>=241 then begin if mapa^[x+y*320+1]>=252 then begin tl(predme); if predme<6 then if predmet='ZOBER' then begin prikaz:='zober';predme:=4;zobrazpred;end else if predmet='POUI' then begin prikaz:='pouzi';predme:=3;zobrazpred;end else if predmet='PREZRI' then begin prikaz:='prezri';predme:=5;zobrazpred;end else if predmet='MENU' then begin pisat:=false;loadspr('code\menu');zobraz; movepal(seg(paletta^),ofs(paletta^));tmav;menusvetlo;umiestni(160*8,80*8); repeat kurzor(0);if prave then kl:=27;if lave then kl:=13; tl(0); until ((mapa^[x+y*320+1]>=238)and(mapa^[x+y*320+1]<=241)and(kl=13))or(kl=27); b:=mapa^[x+y*320+1]; closewin;zobraz; if kl=27 then begin kl:=1;zobraz;end else if b=238 then begin umiestni(160*8,80*8);loadsav;if kl<>27 then naloaduj;kl:=1;end else if b=239 then begin umiestni(160*8,80*8);savesav;zobrazpred;kl:=1;end else if b=240 then begin umiestni(160*8,142*8);zobraz;zm(har);zmcele(har); if soundis then begin stopsound;initsound(cfg,speed,'title.dom');end; uvodd;move(palletspri,paletta^[631],138);paleta; movepal(seg(paletta^),ofs(paletta^));zobrazpred;ob(har); mapaspod;naloaduj; end else if b=241 then ende;paleta;pisat:=true; end end else begin if prikaz='zober' then say(192,9,'VE NEM~EM VZIA TO, O U MM.'); if prikaz='prezri' then begin if predmet='50 HALIEROV' then say(192,9,'OBYAJN KUS KOVU.'); if predmet='PAPUE' then say(192,9,'FJ. TO JE SMRAD.'); if predmet='K' then say(192,9,'ZNAKA FAB. S DOBERMANOM NA DRUHEJ STRANE.'); if predmet='ROBOVK' then say(192,9,'NORMLNE JE VYDRAT, A DO MSA.'); if predmet='KIK' then say(192,9,'JE NEJAK UDN. MONO, E JE DREVENN.'); if predmet='VNO' then say(192,9,'NI PRE MĽA, ALE TUHIE TU NIE JE.'); if predmet='OKENA' then say(192,9,'NEMM IADNE OKNO.'); if predmet='RKA' then say(192,9,'JA ZA NI NERUM.'); if predmet='KORENIE' then say(192,9,'HAPK.'); if predmet='STEHNO' then say(192,9,'MĽAM. MĽAM.'); if predmet='VNOKENA' then say(192,9,'DOBR KOMBINCIA.'); if predmet='ZHRDZAVEN K' then say(192,9,'V TOM AKVRIU MUSEL BY VEMI DLHO.'); if predmet='POKORENEN STEHNO' then say(192,9,'KE HO NIEKTO ZJE, TAK PN BOH S NM.'); if predmet='DR~TIK' then say(192,9,'NEVERIM, E MI POM~E.'); if predmet='KUS PLAGTU' then say(192,9,'AKO SOM LEN MOHLA.'); if predmet='K' then say(192,9,'PEKN DREVENN.'); if predmet='VVRTKA'then say(192,9,'TO SA TO.'); if predmet='KUKA' then say(192,9,'JE CEL KOVOV.'); if predmet='NONICE' then say(192,9,'RIADNE OSTR.'); if predmet='NRKA' then say(192,9,'PCHNE.'); if predmet='OBRSOK' then say(192,9,'PEKN VZORKA.'); if predmet='KLIETE' then say(192,9,'RIADNE KOMBINAKY.'); if predmet='K' then say(192,9,'JE TO JEDENSTKA.'); if predmet='OLEJNIKA' then say(192,9,'JE NAJAK MASTN.'); if predmet='N~' then say(192,9,'.'); if predmet='PENIAZE' then say(192,9,'A BUDE AJ KEN !'); if predmet='TOALETN PAPIER' then say(192,9,'JE NEJAK HNED.'); if predmet='LIEVIK' then say(192,9,'JE DERAV.'); if predmet='HADICA' then say(192,9,'JE TROCHU KUKAT.'); if predmet='HANDRA' then say(192,9,'NEVIZER BY VEMI IST.'); if predmet='MOKR PAPIER' then say(192,9,'JE MOKR.'); if predmet='MASKA' then say(192,9,'PROTI PLYNU, RADIOAKTIVITE ...'); end; if (prikaz='pouzi')and(predme<6) then begin predme:=predreal[mapa^[x+y*320+1]-241]; zobrazpred; end else if (prikaz='pouzi')and(predme>5) then begin if cast=1 then begin if ((predme=9)and(predmet='STEHNO'))or((predme=7)and(predmet='KORENIE')) then begin predm[7]:=false;predm[9]:=false;predm[10]:=true; predme:=3;zobrazpred; end else if ((predme=14)and(predmet='OKENA'))or((predme=15)and(predmet='VNO')) then begin predstr[14]:='VNOKENA';predm[15]:=false; predme:=3;zobrazpred;predmal[7]:=true; end else if (predmet<>'')and(predmet<>'ZOBER')and(predmet<>'POUI')and(predmet<>'PREZRI')and(predmet<>'MENU') then say(192,9,'NEVIEM O STEAM.'); end; if cast=2 then begin if ((predme=24)and(predmet='MOKR PAPIER'))or((predme=35)and(predmet='NRKA')) then begin predm[24]:=false;predm[35]:=false;predme:=3;predm[36]:=true; zobrazpred;say(192,9,'NAASTIE POZERM MAC GYVERA.'); end else say(192,9,'NEVIEM O STEAM.'); end; if cast=3 then say(192,9,'NEVIEM O STEAM.'); end; end; end else if predmet='ZATVOR OKNO' then begin closewin;zobraz;end else if prikaz='prezri' then prezri else if prikaz='zober' then vezmi else if prikaz='pouzi' then pouzi; end; tl(predme); end; if (prave)or(kl=32) then begin tl(predme); if predme>5 then begin predme:=3;zobrazpred;end else if predme=3 then begin predme:=4;prikaz:='zober';zobrazpred;end else if predme=4 then begin predme:=5;prikaz:='prezri';zobrazpred;end else if predme=5 then begin predme:=3;prikaz:='pouzi';zobrazpred;end; end; until kl=27; ende; end.