pohyb.pas
Petr "Zweistein" Prokop
{ zwei.stein@worldonline.cz, zweistein.kgb.cz }
program pohyb;
{
(c) Petr "Zweistein" Prokop
Program pohyb :
pokus o rogue-like engine
}
uses crt;
type screen = array [1..80,1..24] of char;
KEY = array [1..3] of boolean;
teleporta = array[1..4,1..2] of byte;
cila=array [1..2] of byte;
var ANsound:Boolean;
pole:screen;
klic:key;
teleporty:teleporta;
cil:cila;
liv,mov,strel,jumps:byte;
tim:word;
x,y:byte;
x0,y0:byte;
zn:char;
score:word;
procedure curoff;
assembler;
asm
mov ax, 0100h
mov bx, 0000h
mov ch, 1
mov cl, 0
int 0010h
end;
procedure play (delka,vyska:integer);
begin;
If ANsound=true then begin;
sound(vyska);
delay(delka);
nosound;
End;
end;
procedure razn (pocet:integer;znak:char);
var x,y:byte;
i:word;
begin;
for i:=1 to pocet do begin;
x:=random(24);
y:=random(80);
x:=round(x)+1;
y:=round(y)+1;
pole[y,x]:=znak;
end;
end;
procedure cleanpole (var pole:screen);
var i,i2:byte;
begin;
for i:=1 to 80 do for i2:=1 to 24 do pole[i,i2]:=' ';
end;
procedure cleanklic (var klice:Key);
var i:byte;
begin;
for i:=1 to 3 do klic[i]:=false;
end;
procedure pispole;
var i,i2:byte;
begin;
for i:=1 to 80 do for i2:=1 to 24 do begin;
gotoxy(i,i2);
write (pole[i,i2]);
end;
end;
procedure strela ;
var sx,sy,sx0,sy0:byte;
xplus,yplus:integer;
zas:boolean;
begin;
if not(strel=0) then begin;
strel:=strel - 1;
xplus:=0;
yplus:=0;
Case zn of
'8' : xplus:=-1;
'2' : xplus:=1;
'4' : yplus:=-1;
'6' : yplus:=1;
End;
sx:=x;
sy:=y;
repeat
sx:=sx+xplus;
sy:=sy+yplus;
if pole[sy,sx]='@' then zas:=true;
if pole[sy,sx]='#' then begin;
play (200,150);
play (300,50);
play (200,200);
play (300,250);
zas:=true;
gotoxy(sy,sx);
write('+');
score:=score+10;
delay(2000);
gotoxy(sy,sx);
write(' ');
pole[sy,sx]:=' ';
end;
gotoxy(sy,sx);
play (50,70);
write('ž');
delay(50);
gotoxy(sy,sx);
write(' ');
if (sy>81) or (0>sy) or (0>sx) or (sx>25) then zas:=true;
until zas=true;
clrscr;
pispole;
play (300,400);
play (300,50);
zas:=false;
end;
end;
procedure stavrad;
var i:Byte;
begin;
gotoxy(1,25);
for I:=1 to 79 do write(' ');
gotoxy(1,25);
write ('¦ivot:',liv,' X:',x,' Y:',y,' Stýel:',strel,' Move:',mov,' Time:',tim,' Jump:',jumps,' Score:',score,' Key:');
if klic[1]=true then write('{');
if klic[2]=true then write('(');
if klic[3]=true then write('[');
if (klic[1]=false)And(klic[2]=false)And(klic[3]=false) Then write('No');
end;
Procedure jump;
begin;
if jumps=0 then
else begin;
play(500,100);
play(250,200);
play(125,400);
x0:=x;
y0:=y;
case zn of
chr(71): Begin;if x-2>0 then; x:=x-2;End;
chr(79): Begin;if 81>x+2 then; x:=x+2;End;
chr(83): Begin;if y-2>0 then; y:=y-2;End;
chr(81): Begin;if 25>y+2 then; y:=y+2;End;
end;
jumps:=jumps-1;
mov:=mov-1;
score:=score+5;
End;
end;
procedure teldef(x1,y1,x2,y2,a:byte;znak:char);
begin;
teleporty[1,a] := x1;
teleporty[2,a] := y1;
teleporty[3,a] := x2;
teleporty[4,a] := y2;
pole[x1,y1] := znak;
pole[x2,y2] := znak;
end;
procedure teleport;
var noopak:boolean;
begin;
case pole[x,y] of
'+':begin;
noopak:=false;
if (x=teleporty[3,1])and(y=teleporty[4,1])then begin;
play(100,440);
play(100,220);
x:=teleporty[1,1];
y:=teleporty[2,1];
noopak:=true;
end;
if (x=teleporty[1,1])and(y=teleporty[2,1])and(noopak=false)then begin;
play(100,220);
play(100,440);
x:=teleporty[3,1];
y:=teleporty[4,1];
noopak:=true
end;
end;
'*':begin;
noopak:=false;
if (y=teleporty[3,2])and(x=teleporty[4,2])then begin;
play(100,440);
play(100,220);
x:=teleporty[1,2];
y:=teleporty[2,2];
score:=score+200;
noopak:=true
end;
if (y=teleporty[1,2])and(x=teleporty[2,2])and(noopak=false)then begin;
play(100,220);
play(100,440);
x:=teleporty[3,2];
y:=teleporty[4,2];
score:=score+200;
noopak:=true
end;
end;
end;
end;
procedure open(klicno:byte);
begin;
If klic[klicno]=true then begin;
pole[y,x]:=' ';
Klic[klicno]:=false;
score:=score+50;
End
else begin;
liv:=liv-1;
y:=y0;
x:=x0;
End;
end;
begin;
score:=100;
ANSound:=true;
clrscr;
tim:=0;
liv:=10;
mov:=120;
strel:=20;
jumps:=10;
cleanklic(klic);
randomize;
cleanpole (pole);
razn (100,'#');
razn (10,'L');
razn (10,'l');
razn (10,'s');
razn (10,'k');
razn (10,'~');
razn (10,'@');
razn (10,'S');
razn (10,'K');
razn (10,'J');
razn (10,'j');
razn (10,'$');
razn (1,'}');
razn (1,'{');
razn (1,')');
razn (1,'(');
razn (1,']');
razn (1,'[');
cil[1]:=2;
cil[2]:=2;
pole[cil[1], cil[2]]:='>';
teldef(3,3,12,12,1,'+');
teldef(4,4,11,11,2,'*');
curoff;
pispole;
x0:=1;
y0:=1;
x:=1;
y:=1;
stavrad;
repeat
play (50,100);
gotoxy(y,x);
write('á');
write;
x0:=x;
y0:=y;
zn:=' ';
repeat
zn:=readkey;
until not(zn=' ');
case zn of
chr(72): begin;if mov>0 then begin;x:=x-1;mov:=mov-1;end;end;
chr(80): begin;if mov>0 then begin;x:=x+1;mov:=mov-1;end;end;
chr(75): begin;if mov>0 then begin;y:=y-1;mov:=mov-1;end;end;
chr(77): begin;if mov>0 then begin;y:=y+1;mov:=mov-1;end;end;
'2','4','6','8': strela ;
't','T':teleport;
chr(81),chr(83),chr(71),chr(79): jump ;
end;
if y>80 then y:=80;
if y=0 then y:=1;
if x>24 then x:=24;
if x=0 then x:=1;
if not (pole[y,x]=' ') then begin;
case pole[y,x] of
'#':Begin;liv:=liv-1;y:=y0;x:=x0;End;
'~':liv:=liv-1;
'@':Begin;liv:=liv-1;y:=y0;x:=x0;End;
'L':Begin;liv:=liv+4;pole[y,x]:=' ';End;
'K':Begin;Mov:=Mov+10;pole[y,x]:=' ';End;
'S':Begin;Strel:=Strel+10;pole[y,x]:=' ';End;
'l':Begin;liv:=liv+2;pole[y,x]:=' ';End;
'k':Begin;mov:=mov+5;pole[y,x]:=' ';End;
's':Begin;Strel:=Strel+5;pole[y,x]:=' ';End;
'J':Begin;Jumps:=Jumps+6;pole[y,x]:=' ';End;
'j':Begin;Jumps:=jumps+2;pole[y,x]:=' ';End;
'$':Begin;score:=score+50;pole[y,x]:=' ';End;
'{':Begin;klic[1]:=true;pole[y,x]:=' ';score:=score+20;End;
'(':Begin;klic[2]:=true;pole[y,x]:=' ';score:=score+30;End;
'[':Begin;klic[3]:=true;pole[y,x]:=' ';score:=score+40;End;
'}':open(1);
')':open(2);
']':open(3);
end;
end;
pispole;
tim:=tim+1;
stavrad;
until (liv=0)or((mov=0)and(jumps=0))or((cil[1]=x)and(cil[2]=y));
end.
