Hra had v ktorej máte za úlohu zozbierať body na ploche

Kategórie: KMP (Programy mladých programátorů)
Autor: Miroslav Lízal, Tomáš Okurek
web: pascalweb.wz.cz/index86.html

Program: Had.pas
Soubor exe: Had.exe

{ HAD.PAS                Copyright (c) Miroslav Lízal, TomᚠOkurek }
{ Hra had v ktorej mate za ulohu zozbierat body na ploche.          }
{                                                                   }
{ Datum:12.03.2003                             http://www.trsek.com }
 
program had1;
uses crt,dos;
type had=array[byte]of integer;
     con=array[byte]of real;
var n,bx,by,i,j,kla,zx,zy:integer;
    hx,hy,phx,phy,p,pp:had;
    conh:con;
    conb:real;
    od:char;
 
procedure SetCursor(s,e:Byte);
var regs: Registers;
begin
  with regs do
    begin
      ah:=01;
      cl:=e;
      ch:=s
    end;
  Intr($10,regs)
end;
 
procedure CursorOff;
begin
  SetCursor($20,$20)
end;
 
procedure CursorOn;
begin
  Setcursor(6,7)
end;
 
begin
 repeat
  clrscr;
  randomize;
  textmode(CO40);
  CursorOff;
  n:=1;
  hx[1]:=19;
  hy[1]:=6;
  kla:=80;
  p[1]:=80;
  bx:=random(37)+1;
  by:=random(22)+1;
  gotoxy(bx,by);
  write(#254);
  gotoxy(2,25);
  write('Score: 0');
 
  repeat
    if (hx[1]=bx)and(hy[1]=by) then
     begin
       gotoxy(2,25);
       write('Score: ',n);
       bx:=random(37)+1;
       by:=random(22)+1;
       for i:=1 to n do conh[i]:=hx[i]+hy[i]/100;
       conb:=bx+by/100;
       j:=1;
 
       repeat
         if conb=conh[i] then
          begin
            bx:=random(37)+1;
            by:=random(22)+1;
            j:=1
          end
         else j:=j+1;
       until j>n;
 
       n:=n+1;
       case p[n-1] of
          75:begin
               hx[n]:=hx[n-1]+1;
               hy[n]:=hy[n-1];
               p[n]:=75
             end;
          80:begin
               hx[n]:=hx[n-1];
               hy[n]:=hy[n-1]-1;
               p[n]:=80
             end;
          72:begin
               hx[n]:=hx[n-1];
               hy[n]:=hy[n-1]+1;
               p[n]:=72
             end;
          77:begin
               hx[n]:=hx[n-1]-1;
               hy[n]:=hy[n-1];
               p[n]:=77
             end
       end;
       gotoxy(bx,by);
       write(#254)
     end;
 
    gotoxy(bx,by);
    write(#254);
    if keypressed then
      begin
       kla:=ord(readkey);
       if kla=0 then kla:=ord(readkey)
      end;
 
    if (((kla=80)and(p[1]=72))or((kla=72)and(p[1]=80))or((kla=75)and(p[1]=77))or((kla=77)and(p[1]=75))) then
      begin
        for i:=1 to n do case p[i] of
                            80:p[i]:=72;
                            72:p[i]:=80;
                            75:p[i]:=77;
                            77:p[i]:=75
                         end;
 
        kla:=p[n];
        for i:=n downto 1 do
          begin
            pp[i]:=p[n-i+1];
            phx[i]:=hx[n-i+1];
            phy[i]:=hy[n-i+1]
          end;
 
        hx:=phx;
        hy:=phy;
        p:=pp;
        for i:=1 to n-1 do p[i]:=p[i+1]
      end;
 
    for i:=n downto 1 do if i>1 then p[i]:=p[i-1]
                                else case kla of
                                         72,80,75,77:p[1]:=kla
                                     end;
    zx:=hx[n];
    zy:=hy[n];
    for i:=1 to n do case p[i] of
                          80:hy[i]:=hy[i]+1;
                          72:hy[i]:=hy[i]-1;
                          77:hx[i]:=hx[i]+1;
                          75:hx[i]:=hx[i]-1
                     end;
 
    for i:=1 to n do if hx[i]>38 then hx[i]:=1
                                 else if hx[i]<1 then hx[i]:=38
                                                 else if hy[i]>23 then hy[i]:=1
                                                                  else if hy[i]<1 then hy[i]:=23;
    for i:=1 to n do
     begin
       gotoxy(hx[i],hy[i]);
       write(chr(219))
     end;
 
    gotoxy(zx,zy);
    write(' ');
    for i:=2 to n do
      if (hx[1]=hx[i])and(hy[1]=hy[i]) then
        begin
          clrscr;
          textmode(CO40);
          gotoxy(9,13);
          write('Kousl ses!');
          kla:=0;
          delay(3000)
        end;
 
    case n of
          1..10:delay(50);
         11..20:delay(40);
         21..30:delay(30)
           else delay(20)
    end
 
  until (kla=27)or(kla=0);
 
  textmode(CO40);
  clrscr;
  gotoxy(9,13);
  write('Score: ',n-1);
  delay(3000);
 
  if kla=0 then
   begin
     clrscr;
     gotoxy(9,13);
     write('Chces hrat znovu? a\n  ');
     read(od);
     if od='n' then kla:=27
   end
 
 until kla=27;
 clrscr;
 gotoxy(9,13);
 delay(1000);
 CursorOn
end.