Dze je subor www.TrSek.com/cover/ales/autoo.pas

{ 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.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com