{ AUTOO.PAS Copyright (c) Ales Kucik } { Hra auticko v textovem rezimu - musite se vyhybat priseram. } { } { Datum:29.11.2002 http://www.trsek.com } program Auticko; uses Crt; const Zhora=10; Sirka= 20; Delka= 20; {Zalezi na grafickem modu} XxLoop=20; Wait=7; RelX=30; {Vzdalenost od leveho kraje obrazovky} Hustota=20; {Cislo udava s jakou pravdepodobnosti padne zed 1:Hustota} Dvoji=0; TextCode=C80 + Font8x8; type tBunka=(empty, wall); tHLmenu=(start,credit,konci); tOvladani=(levo,pravo,esc); tAuto=record xStary,x,y:byte; end; tPlocha=array[1..Delka, 1..Sirka] of tBunka; var konec:boolean; procedure Game; var loopG:integer; GameOver:boolean; Auto:tAuto; Plocha:tPlocha; {*************** Procedurky a Fce ****************} procedure initFirst(var xAuto:tAuto; var xPlocha:tPlocha); var i,j:byte; begin xAuto.x:=10; xAuto.xStary:=xAuto.x; xAuto.y:=Delka; for i:=1 to delka do begin xPlocha[i,1] :=wall; xPlocha[i,sirka]:=wall; for j:=2 to sirka-1 do xPlocha[i,j]:=empty; end; end; procedure ZobrazG (var xPlocha:tPlocha); var i,j:byte; begin for i:=1 to delka do begin gotoXY(Relx+1,i+Zhora); for j:=1 to sirka do case xPlocha[i,j] of wall : write('*'); empty: write(' '); end; end; end; procedure ZobrazA (var xAuto:tAuto); begin if xAuto.x <> xAuto.xStary then begin gotoxy(RelX+xAuto.xStary,delka+Zhora); write(' '); end; gotoxy(RelX+xAuto.x,delka+Zhora); write(chr(30)); xAuto.xStary:=xAuto.x; end; procedure Vlevo (var xAuto:tAuto; var xPlocha:tPlocha); begin if xPlocha[xAuto.y,xAuto.x-1]=empty then xAuto.x:=xAuto.x-1; end; procedure Vpravo(var xAuto:tAuto; var xPlocha:tPlocha); begin if xPlocha[xAuto.y,xAuto.x+1]=empty then xAuto.x:=xAuto.x+1; end; procedure Dalsi (var xPlocha:tPlocha); var i,j:byte; begin for i:=delka downto 2 do for j:= 2 to sirka-1 do xPlocha[i,j]:=xPlocha[i-1,j]; for j:=2 to sirka-1 do begin if random(Hustota)=0 then xPlocha[1,j]:=wall else xPlocha[1,j]:=empty; end; end; function Ovladani:tOvladani; var Znak:char; begin Znak:=readkey; if ord(Znak)=Dvoji then {Cteni znaku s dvojim nacitanim} begin Znak:=readkey; case ord(Znak) of 75: Ovladani:= levo; 77: Ovladani:= pravo; end; end else if ord(Znak)= 27 then Ovladani:= Esc; end; procedure KonecHrac; begin clrscr; writeln('******************************************'); writeln('******* !!! KONEC !!! *******'); writeln('******************************************'); repeat until keypressed; end; function Koncis(xAuto:tAuto;xPlocha:tPlocha):boolean; begin if xPlocha[delka-1,xAuto.x]= wall then koncis:=true else koncis:= false; end; begin {Main GAME} clrscr; initFirst(Auto,Plocha); GameOver:=false; repeat ZobrazG(Plocha); for loopG:=1 to XxLoop do begin ZobrazA(Auto); if keypressed then begin case Ovladani of levo : Vlevo (Auto,Plocha); pravo: Vpravo(Auto,Plocha); esc : GameOver:=true; end; end; delay(Wait); end; if GameOver then KonecHrac{Ukonceno uzivatelem} else if Koncis(Auto,Plocha) then begin GameOver:=true; {Uzivatel prohral} writeln('Ha Ha NARAZILS !!!!'); repeat until keypressed; end else Dalsi(Plocha); {Pokracovani hry} until GameOver; end; {Main GAME} procedure Intro; begin Writeln('Tohle je ale uchylna hra'); delay(3000); end; procedure Outro; begin writeln('Uz toho mas plny zuby co?????'); delay(3000); end; procedure JaJenJA; begin writeln('Nechci se chlubyt ale tohle jsem udelal JAAAAAAAAaaaaaa'); repeat until keypressed; end; procedure ZobrazHLm; begin writeln('Start hry.........s'); writeln('Credits...........c'); writeln('Konec...........ESC'); end; function HLmenu:tHLmenu; var Znak:char; begin Znak:=readkey; case Znak of 's','S': HLmenu:= start; 'c','C': HLmenu:= credit; chr(27): HLmenu:= konci; end; end; begin clrscr; intro; randomize; TextMode(TextCode); repeat clrscr; ZobrazHLm; case HLmenu of start : Game; credit: JaJenJA; konci : konec:=true; end; until konec; outro; end.