Írjunk
programot, mely az itt látható játéktéren lévő csillagokat kikapcsolja. Oldal
vagy átlós irányokban ugorhatjuk át a csillagokat, miáltal az eltűnik. Cél:
csak egyetlen csillag maradjon. „D” billentyűre Demo
indítható.
Program Hamm;
Uses NewDelay, Crt, CrtPlus, Drivers;
Var Ch: Char;
H: Array[0..8,0..8] Of Byte;
Procedure Jatekter;
Var I, J: Byte;
Begin
HideMouse; Szinek(7,15); ClrScr; WriteXY(33,25,'D: Demo');
Racs(17,5,1,1,3,7); Racs(13,9,1,1,7,3);
For I:= 1 To 4 Do
Begin WriteXY(15+2*i,9,Chr(197)); WriteXY(15+2*i,15,Chr(197)) End;
For I:= 0 To 8 Do For J:= 0 To 8 Do H[I, J]:= 0; Szinek(7,1);
For I:= 1 To 7 Do For J:= 1 To 7 Do If (I In [3..5]) Or (J In [3..5]) Then
If Not((I=4) And (J=4)) Then
Begin WriteXY(12+2*I,4+2*J, Chr(15)); H[I, J]:=1 End; ShowMouse; Tunj;
End;
Function BentK(A, B: Byte): Boolean;
Begin
BentK:=((A In [18, 20, 22]) And (B In [ 6, 8, 10, 12, 14, 16, 18])) Or
((A In [14, 16, 18, 20, 22, 24, 26]) And (B In [10, 12, 14]));
End;
Function BentH(A, B: Byte): Boolean;
Begin
BentH:=((A In [3..5]) And (B In [1..7])) Or
((A In [1..7]) And (B In [3..5]));
End;
Function Lephet(A, B: Byte): Boolean;
Begin
Lephet:= False; If H[A, B]= 0 Then Exit;
If BentH(A-1,B) And BentH(A-2,B) And (H[A-1,B]=1) And (H[A-2,B]=0)
Then Begin Lephet:= True; Exit End;
If BentH(A-1,B-1) And BentH(A-2,B-2) And (H[A-1,B-1]=1) And (H[A-2,B-2]=0)
Then Begin Lephet:= True; Exit End;
If BentH(A,B-1) And BentH(A,B-2) And (H[A,B-1]=1) And (H[A,B-2]=0)
Then Begin Lephet:= True; Exit End;
If BentH(A+1,B-1) And BentH(A+2,B-2) And (H[A+1,B-1]=1) And (H[A+2,B-2]=0)
Then Begin Lephet:= True; Exit End;
If BentH(A+1,B) And BentH(A+2,B) And (H[A+1,B]=1) And (H[A+2,B]=0)
Then Begin Lephet:= True; Exit End;
If BentH(A+1,B+1) And BentH(A+2,B+2) And (H[A+1,B+1]=1) And (H[A+2,B+2]=0)
Then Begin Lephet:= True; Exit End;
If BentH(A,B+1) And BentH(A,B+2) And (H[A,B+1]=1) And (H[A,B+2]=0)
Then Begin Lephet:= True; Exit End;
If BentH(A-1,B+1) And BentH(A-2,B+2) And (H[A-1,B+1]=1) And (H[A-2,B+2]=0)
Then Begin Lephet:= True; Exit End;
End;
Function Vege: Boolean;
Var I, J: Byte;
Begin
Vege:= True;
For I:= 1 To 7 Do For J:= 1 To 7 Do If BentH(I, J) And Lephet(I, J) Then
Begin Vege:= False; Exit End;
End;
Procedure Jatek;
Var X, Y, Px, Py, Hx, Hy, PHx, PHy, V: Byte;
Begin
Repeat
While Not KeyPressed And (MouseButtons=0) Do; If KeyPressed Then Exit;
X:= MouseWhere.X + 1; Y:= MouseWhere.Y + 1;
If BentK(X, Y) Then
Begin
Hx:= X Div 2 - 6; Hy:= Y Div 2 - 2;
If Lephet(Hx, Hy) Then
Begin
Px:= X; Py:= Y; PHx:= Hx; PHy:= Hy;
Duda; Szinek(7, 1+Blink);
HideMouse; WriteXY(X, Y, Chr(15)); Szinek(7, 1); Tunj; ShowMouse;
While MouseButtons=1 Do;
While Not KeyPressed And (MouseButtons=0) Do; If KeyPressed Then Exit;
X:= MouseWhere.X + 1; Y:= MouseWhere.Y + 1;
If BentK(X,Y) Then
Begin
Hx:= X Div 2 - 6; Hy:= Y Div 2 - 2; V:=0;
If H[Hx, Hy]=0 Then
Begin
If (Hx= PHx-2) And (Hy= PHy ) And (H[PHx-1, PHy ]=1) Then V:=1;
If (Hx= PHx-2) And (Hy= PHy-2) And (H[PHx-1, PHy-1]=1) Then V:=2;
If (Hx= PHx-2) And (Hy= PHy+2) And (H[PHx-1, PHy+1]=1) Then V:=3;
If (Hx= PHx+2) And (Hy= PHy ) And (H[PHx+1, PHy ]=1) Then V:=4;
If (Hx= PHx+2) And (Hy= PHy-2) And (H[PHx+1, PHy-1]=1) Then V:=5;
If (Hx= PHx+2) And (Hy= PHy+2) And (H[PHx+1, PHy+1]=1) Then V:=6;
If (Hx= PHx ) And (Hy= PHy-2) And (H[PHx , PHy-1]=1) Then V:=7;
If (Hx= PHx ) And (Hy= PHy+2) And (H[PHx , PHy+1]=1) Then V:=8;
End;
If V>0 Then
Begin
H[PHx, PHy]:=0; HideMouse; WriteXY(PX, PY, ' '); ShowMouse;
Case V Of
1: Begin H[PHx - 1, PHy ]:= 0; WriteXY(Px-2, Py , ' ') End;
2: Begin H[PHx - 1, PHy - 1]:= 0; WriteXY(Px-2, Py-2, ' ') End;
3: Begin H[PHx - 1, PHy + 1]:= 0; WriteXY(Px-2, Py+2, ' ') End;
4: Begin H[PHx + 1, PHy ]:= 0; WriteXY(Px+2, Py , ' ') End;
5: Begin H[PHx + 1, PHy - 1]:= 0; WriteXY(Px+2, Py-2, ' ') End;
6: Begin H[PHx + 1, PHy + 1]:= 0; WriteXY(Px+2, Py+2, ' ') End;
7: Begin H[PHx , PHy - 1]:= 0; WriteXY(Px , Py-2, ' ') End;
8: Begin H[PHx , PHy + 1]:= 0; WriteXY(Px , Py+2, ' ') End;
End;
H[Hx, Hy]:= 1; HideMouse; WriteXY(X, Y, Chr(15)); ShowMouse;
While MouseButtons=1 Do;
End
Else
Begin
HideMouse; WriteXY(PX, PY, Chr(15)); ShowMouse;
While MouseButtons=1 Do;
End; Tunj;
End
Else
Begin
HideMouse; WriteXY(PX, PY, Chr(15)); ShowMouse;
While MouseButtons=1 Do;
End; Tunj;
End;
End;
If Vege Then
Begin
PX:= 0; Szinek(7,1+Blink); HideMouse;
For X:= 1 To 7 Do For Y:= 1 To 7 Do PX:= PX + H[X, Y];
If PX=1 Then WriteXY(14,2, 'G Y Ő Z T É L') Else
WriteXY(12,2, 'V E S Z T E T T É L'); Tunj; ShowMouse;
Repeat Until KeyPressed;
End;
Until False;
End;
Procedure Demo;
Const L: Array[1..31,1..3,1..2] Of Byte=
(((6,4),(4,4),(5,4)), ((4,2),(6,4),(5,3)),
((2,4),(4,2),(3,3)), ((4,6),(2,4),(3,5)),
((6,4),(4,6),(5,5)), ((3,1),(5,3),(4,2)),
((1,5),(3,3),(2,4)), ((5,7),(3,5),(4,6)),
((5,2),(5,4),(5,3)), ((4,4),(6,4),(5,4)),
((7,3),(5,5),(6,4)), ((7,5),(7,3),(7,4)),
((7,3),(5,3),(6,3)), ((3,4),(5,2),(4,3)),
((2,3),(4,3),(3,3)), ((5,1),(3,1),(4,1)),
((3,1),(3,3),(3,2)), ((3,6),(5,4),(4,5)),
((6,5),(4,5),(5,5)), ((3,7),(5,7),(4,7)),
((5,7),(5,5),(5,6)), ((5,2),(3,4),(4,3)),
((3,4),(3,6),(3,5)), ((1,3),(1,5),(1,4)),
((1,5),(3,5),(2,5)), ((3,6),(3,4),(3,5)),
((3,3),(3,5),(3,4)), ((4,5),(6,5),(5,5)),
((5,3),(5,5),(5,4)), ((6,5),(4,5),(5,5)),
((3,5),(5,5),(4,5)));
Var I: Byte;
Begin
JatekTer;
For I:=1 To 31 Do
Begin
If KeyPressed Or (MouseButtons=1) Then Exit;
HideMouse;
Szinek(7,1+Blink); WriteXY(12+2*L[i,1,1],4+2*L[i,1,2], Chr(15));
Szinek(7,14);WriteXY(12+2*L[i,3,1],4+2*L[i,3,2], Chr(15)); Tunj;
ShowMouse; Delay(1500); HideMouse;
WriteXY(12+2*L[i,1,1],4+2*L[i,1,2], ' ');
WriteXY(12+2*L[i,3,1],4+2*L[i,3,2], ' ');
Szinek(7,1); WriteXY(12+2*L[i,2,1],4+2*L[i,2,2], Chr(15)); ShowMouse;
End;
WriteXY(18,1,'Kész');
Tunj;
While Not KeyPressed And (MouseButtons=0) Do;
End;
Begin
TextMode(CO80); InitEvents;
Repeat
JatekTer; Jatek; Ch:= Readkey; If Ch='D' Then Demo;
Until Ch=#27; TextMode(CO80);
End.
