Автор: APAL 12.10.2003 16:56
А вот мое детище, написанное около 2-3 лет назад :
Код
Uses Crt,Dos{,MyServis,MyCrt},Graph; {640x480 == 80x60}
Const
MaxPiton = 4800;
MaxPrize = 8;
Type
Piton = Record
x : Byte;
y : Byte;
End;
Var
Priz : Array [1..MaxPrize,1..3] of Byte;
CurPiton : Word;
Prirost : Byte;
Zaderhka : Word;
Ch : Char;
grDriver : Integer;
grMode : Integer;
ErrCode : Integer;
i : Word;
Kompas : Byte; {1-Up; 2-Right; 3-Down; 4-Left}
G,H : Word;
Pit : Array [1..MaxPiton] of Piton;
FlagStop : Boolean;
Procedure ClearHv(x,y : Byte);
Begin
SetColor(0);
SetFillStyle(0,0);
Bar(x*8-8,y*8-8,x*8-1,y*8-1);
SetColor(14);
Case x of
80 : Line(x*8-1,y*8-1,x*8-1,y*8-8);
1 : Line(x*8-8,y*8-1,x*8-8,y*8-8);
End;
Case y of
1 : Line(x*8-1,y*8-8,x*8-8,y*8-8);
60 : Line(x*8-1,y*8-1,x*8-1,y*8-1);
End;
Case y of
1 : Line(x*8-1,y*8-8,x*8-1,y*8-8);
60 : Line(x*8-1,y*8-1,x*8-1,y*8-1);
End;
SetColor(7);
End;
Procedure GolU(x,y : Byte);
Begin
PutPixel(x*8-7,y*8-1,7);
PutPixel(x*8-2,y*8-1,7);
PutPixel(x*8-8,y*8-2,7);
PutPixel(x*8-1,y*8-2,7);
PutPixel(x*8-8,y*8-3,7);
PutPixel(x*8-1,y*8-3,7);
PutPixel(x*8-8,y*8-4,7);
PutPixel(x*8-1,y*8-4,7);
PutPixel(x*8-7,y*8-5,7);
PutPixel(x*8-2,y*8-5,7);
PutPixel(x*8-7,y*8-6,7);
PutPixel(x*8-2,y*8-6,7);
PutPixel(x*8-6,y*8-7,7);
PutPixel(x*8-3,y*8-7,7);
PutPixel(x*8-5,y*8-8,7);
PutPixel(x*8-4,y*8-8,7);
PutPixel(x*8-6,y*8-3,2);
PutPixel(x*8-3,y*8-3,2);
PutPixel(x*8-5,y*8-7,Red);
PutPixel(x*8-4,y*8-7,Red);
End;
Procedure GolD(x,y : Byte);
Begin
PutPixel(x*8-7,y*8-8,7);
PutPixel(x*8-2,y*8-8,7);
PutPixel(x*8-8,y*8-7,7);
PutPixel(x*8-1,y*8-7,7);
PutPixel(x*8-8,y*8-6,7);
PutPixel(x*8-1,y*8-6,7);
PutPixel(x*8-8,y*8-5,7);
PutPixel(x*8-1,y*8-5,7);
PutPixel(x*8-7,y*8-4,7);
PutPixel(x*8-2,y*8-4,7);
PutPixel(x*8-7,y*8-3,7);
PutPixel(x*8-2,y*8-3,7);
PutPixel(x*8-6,y*8-2,7);
PutPixel(x*8-3,y*8-2,7);
PutPixel(x*8-5,y*8-1,7);
PutPixel(x*8-4,y*8-1,7);
PutPixel(x*8-6,y*8-6,2);
PutPixel(x*8-3,y*8-6,2);
PutPixel(x*8-5,y*8-2,Red);
PutPixel(x*8-4,y*8-2,Red);
End;
Procedure GolR(x,y : Byte);
Begin
PutPixel(x*8-8,y*8-7,7);
PutPixel(x*8-8,y*8-2,7);
PutPixel(x*8-7,y*8-8,7);
PutPixel(x*8-7,y*8-1,7);
PutPixel(x*8-6,y*8-8,7);
PutPixel(x*8-6,y*8-1,7);
PutPixel(x*8-5,y*8-8,7);
PutPixel(x*8-5,y*8-1,7);
PutPixel(x*8-4,y*8-7,7);
PutPixel(x*8-4,y*8-2,7);
PutPixel(x*8-3,y*8-7,7);
PutPixel(x*8-3,y*8-2,7);
PutPixel(x*8-2,y*8-6,7);
PutPixel(x*8-2,y*8-3,7);
PutPixel(x*8-1,y*8-5,7);
PutPixel(x*8-1,y*8-4,7);
PutPixel(x*8-6,y*8-6,2);
PutPixel(x*8-6,y*8-3,2);
PutPixel(x*8-2,y*8-5,Red);
PutPixel(x*8-2,y*8-4,Red);
End;
Procedure GolL(x,y : Byte);
Begin
PutPixel(x*8-1,y*8-7,7);
PutPixel(x*8-1,y*8-2,7);
PutPixel(x*8-2,y*8-8,7);
PutPixel(x*8-2,y*8-1,7);
PutPixel(x*8-3,y*8-8,7);
PutPixel(x*8-3,y*8-1,7);
PutPixel(x*8-4,y*8-8,7);
PutPixel(x*8-4,y*8-1,7);
PutPixel(x*8-5,y*8-7,7);
PutPixel(x*8-5,y*8-2,7);
PutPixel(x*8-6,y*8-7,7);
PutPixel(x*8-6,y*8-2,7);
PutPixel(x*8-7,y*8-6,7);
PutPixel(x*8-7,y*8-3,7);
PutPixel(x*8-8,y*8-5,7);
PutPixel(x*8-8,y*8-4,7);
PutPixel(x*8-3,y*8-3,2);
PutPixel(x*8-3,y*8-6,2);
PutPixel(x*8-7,y*8-4,Red);
PutPixel(x*8-7,y*8-5,Red);
End;
Procedure HvU(x,y : Byte);
Begin
Line(x*8-8,y*8-1,x*8-5,y*8-8);
Line(x*8-4,y*8-8,x*8-1,y*8-1);
PutPixel(x*8-2,y*8-1,6);
PutPixel(x*8-2,y*8-2,6);
PutPixel(x*8-3,y*8-1,6);
End;
Procedure HvD(x,y : Byte);
Begin
Line(x*8-8,y*8-8,x*8-5,y*8-1);
Line(x*8-4,y*8-1,x*8-1,y*8-8);
PutPixel(x*8-2,y*8-8,6);
PutPixel(x*8-2,y*8-7,6);
PutPixel(x*8-3,y*8-8,6);
End;
Procedure HvL(x,y : Byte);
Begin
Line(x*8-1,y*8-1,x*8-8,y*8-4);
Line(x*8-8,y*8-5,x*8-1,y*8-8);
PutPixel(x*8-1,y*8-2,6);
PutPixel(x*8-1,y*8-3,6);
PutPixel(x*8-2,y*8-2,6);
End;
Procedure HvR(x,y : Byte);
Begin
Line(x*8-8,y*8-1,x*8-1,y*8-4);
Line(x*8-1,y*8-5,x*8-8,y*8-8);
PutPixel(x*8-8,y*8-2,6);
PutPixel(x*8-8,y*8-3,6);
PutPixel(x*8-7,y*8-2,6);
End;
Procedure gor(x,y : Byte);
Begin
Line(x*8-8,y*8-8,x*8-1,y*8-8);
Line(x*8-8,y*8-1,x*8-1,y*8-1);
PutPixel(x*8-6,y*8-7,6);
PutPixel(x*8-5,y*8-7,6);
PutPixel(x*8-4,y*8-7,6);
PutPixel(x*8-3,y*8-7,6);
PutPixel(x*8-5,y*8-6,6);
PutPixel(x*8-4,y*8-6,6);
PutPixel(x*8-8,y*8-2,6);
PutPixel(x*8-7,y*8-2,6);
PutPixel(x*8-8,y*8-3,6);
PutPixel(x*8-2,y*8-2,6);
PutPixel(x*8-1,y*8-2,6);
PutPixel(x*8-1,y*8-3,6);
End;
Procedure ver(x,y : Byte);
Begin
Line(x*8-8,y*8-8,x*8-8,y*8-1);
Line(x*8-1,y*8-8,x*8-1,y*8-1);
PutPixel(x*8-7,y*8-6,6);
PutPixel(x*8-7,y*8-5,6);
PutPixel(x*8-7,y*8-4,6);
PutPixel(x*8-7,y*8-3,6);
PutPixel(x*8-6,y*8-5,6);
PutPixel(x*8-6,y*8-4,6);
PutPixel(x*8-2,y*8-8,6);
PutPixel(x*8-2,y*8-7,6);
PutPixel(x*8-3,y*8-8,6);
PutPixel(x*8-2,y*8-1,6);
PutPixel(x*8-2,y*8-2,6);
PutPixel(x*8-3,y*8-1,6);
End;
Procedure lu(x,y : Byte);
Begin
PutPixel(x*8-8,y*8-8,7);
Arc(x*8-8,y*8-8,270,360,7);
PutPixel(x*8-5,y*8-5,6);
PutPixel(x*8-4,y*8-5,6);
PutPixel(x*8-5,y*8-4,6);
End;
Procedure ur(x,y : Byte);
Begin
PutPixel(x*8-1,y*8-8,7);
Arc(x*8-1,y*8-8,180,270,7);
PutPixel(x*8-5,y*8-5,6);
PutPixel(x*8-4,y*8-5,6);
PutPixel(x*8-4,y*8-4,6);
End;
Procedure rd(x,y : Byte);
Begin
PutPixel(x*8-1,y*8-1,7);
Arc(x*8-1,y*8-1,90,180,7);
PutPixel(x*8-4,y*8-4,6);
PutPixel(x*8-4,y*8-5,6);
PutPixel(x*8-5,y*8-4,6);
End;
Procedure dl(x,y : Byte);
Begin
PutPixel(x*8-8,y*8-1,7);
Arc(x*8-8,y*8-1,0,90,7);
PutPixel(x*8-5,y*8-5,6);
PutPixel(x*8-4,y*8-4,6);
PutPixel(x*8-5,y*8-4,6);
End;
Function Stop : Boolean;
Begin
Stop:=False;
For i:=1 to MaxPiton do
If i=G then Continue else
If (Pit[i].x=Pit[G].x) and (Pit[i].y=Pit[G].y) then Stop:=True;
End;
Function PredGolX : Byte;
Begin
If G<MaxPiton then PredGolX:=Pit[G+1].x
else PredGolX:=Pit[1].x
End;
Function PredGolY : Byte;
Begin
If G<MaxPiton then PredGolY:=Pit[G+1].y
else PredGolY:=Pit[1].y
End;
Function PredHvX : Byte;
Begin
If H>1 then PredHvX:=Pit[H-1].x
else PredHvX:=Pit[MaxPiton].x
End;
Function PredHvY : Byte;
Begin
If H>1 then PredHvY:=Pit[H-1].y
else PredHvY:=Pit[MaxPiton].y
End;
Procedure Pri(x,y : Byte; tip : Byte);
Begin
Case tip of
1 : Begin
PutPixel(x*8-4,y*8-4,Green);
PutPixel(x*8-5,y*8-5,Green);
PutPixel(x*8-5,y*8-4,Green);
PutPixel(x*8-4,y*8-5,Green);
PutPixel(x*8-6,y*8-6,Green);
PutPixel(x*8-6,y*8-3,Green);
PutPixel(x*8-3,y*8-6,Green);
PutPixel(x*8-3,y*8-3,Green);
End;
2 : Begin
PutPixel(x*8-4,y*8-4,Blue);
PutPixel(x*8-5,y*8-5,Blue);
PutPixel(x*8-5,y*8-4,Blue);
PutPixel(x*8-4,y*8-5,Blue);
PutPixel(x*8-6,y*8-6,Blue);
PutPixel(x*8-6,y*8-3,Blue);
PutPixel(x*8-3,y*8-6,Blue);
PutPixel(x*8-3,y*8-3,Blue);
End;
3 : Begin
PutPixel(x*8-4,y*8-4,Red);
PutPixel(x*8-5,y*8-5,Red);
PutPixel(x*8-5,y*8-4,Red);
PutPixel(x*8-4,y*8-5,Red);
PutPixel(x*8-6,y*8-6,Red);
PutPixel(x*8-6,y*8-3,Red);
PutPixel(x*8-3,y*8-6,Red);
PutPixel(x*8-3,y*8-3,Red);
End;
4 : Begin
PutPixel(x*8-4,y*8-4,14);
PutPixel(x*8-5,y*8-5,14);
PutPixel(x*8-5,y*8-4,14);
PutPixel(x*8-4,y*8-5,14);
PutPixel(x*8-6,y*8-6,14);
PutPixel(x*8-6,y*8-3,14);
PutPixel(x*8-3,y*8-6,14);
PutPixel(x*8-3,y*8-3,14);
End;
End;
End;
Procedure Init;
Label go;
Var j : Word;
Begin
For i:=1 to MaxPrize do
If Priz[i,3]=0 then
Begin
go:
Priz[i,1]:=Random(80)+1;
Priz[i,2]:=Random(60)+1;
Priz[i,3]:=Random(4)+1;
For j:=1 to MaxPiton do
If (Priz[i,1]=Pit[j].x) and (Priz[i,2]=Pit[j].y) then Goto go;
For j:=1 to i do
If ((Priz[i,1]=Priz[j,1]) and (Priz[i,2]=Priz[j,2]))
and (j<>i) then Goto go;
Pri(Priz[i,1],Priz[i,2],Priz[i,3]);
End;
End;
Procedure CheckPriz;
Begin
For i:=1 to MaxPrize do
If (Pit[G].x=Priz[i,1]) and (Pit[G].y=Priz[i,2]) then
Begin
Inc(Prirost,Priz[i,3]);
Priz[i,3]:=0;
Dec(Zaderhka);
If Zaderhka>10 then Dec(Zaderhka,2);
Init;
End;
End;
Begin { ---==== MAIN PROGRAMM ===--- }
grDriver:=Detect;
InitGraph(grDriver, grMode, '');
ErrCode:=GraphResult;
If ErrCode = grOk Then
Begin
Zaderhka:=500;
CurPiton:=4;
SetColor(7);
Kompas:=4;
FlagStop:=False;
Prirost:=0;
G:=1;
H:=4;
Pit[1].x:=40; Pit[1].y:=30;
Pit[2].x:=41; Pit[2].y:=30;
Pit[3].x:=42; Pit[3].y:=30;
Pit[4].x:=43; Pit[4].y:=30;
SetColor(14);
Line(0,0,639,0);
Line(639,0,639,479);
Line(639,479,0,479);
Line(0,479,0,0);
SetColor(7);
For i:=1 to MaxPrize do Priz[i,3]:=0;
Init;
GolL(40,30);
Gor(41,30);
Gor(42,30);
HvR(43,30);
Repeat
Delay(Zaderhka);
If KeyPressed then
Begin
Ch:=ReadKey;
If Ch=#0 then Ch:=ReadKey; {72 77 80 75}
Case Ch of
{ Up } #72 : If PredGolY>=Pit[G].y then Kompas:=1;
{ Down } #80 : If PredGolY<=Pit[G].y then Kompas:=3;
{ Left } #75 : If PredGolX>=Pit[G].x then Kompas:=4;
{ Right } #77 : If PredGolX<=Pit[G].x then Kompas:=2;
#27 : Begin
CloseGraph;
Exit;
End;
#43 : Inc(Prirost);
End;
End;
If Prirost=0 then
Begin
ClearHv(Pit[H].x,Pit[H].y);
Pit[H].x:=0;
Pit[H].y:=0;
If H=1 then H:=MaxPiton else Dec(H);
ClearHv(Pit[H].x,Pit[H].y);
End
else
Begin
Dec(Prirost);
Inc(CurPiton);
End;
If PredHvX<Pit[H].x then HvR(Pit[H].x,Pit[H].y);
If PredHvX>Pit[H].x then HvL(Pit[H].x,Pit[H].y);
If PredHvY<Pit[H].y then HvD(Pit[H].x,Pit[H].y);
If PredHvY>Pit[H].y then HvU(Pit[H].x,Pit[H].y);
If PredGolX<Pit[G].x then GolU(Pit[G].x,Pit[G].y);
If PredGolX>Pit[G].x then GolD(Pit[G].x,Pit[G].y);
If PredGolY<Pit[G].y then GolR(Pit[G].x,Pit[G].y);
If PredGolY>Pit[G].y then GolL(Pit[G].x,Pit[G].y);
ClearHv(Pit[G].x,Pit[G].y);
Case Kompas of
1 : Begin
If PredGolX>Pit[G].x then UR(Pit[G].x,Pit[G].y);
If PredGolX<Pit[G].x then LU(Pit[G].x,Pit[G].y);
If PredGolY>Pit[G].y then VER(Pit[G].x,Pit[G].y);
If G=1 then G:=MaxPiton else Dec(G);
Pit[G].y:=PredGolY-1; If PredGolY=1 then FlagStop:=True;
Pit[G].x:=PredGolX;
ClearHv(Pit[G].x,Pit[G].y);
If Not FlagStop then GolU(Pit[G].x,Pit[G].y);
End;
3 : Begin
If PredGolX<Pit[G].x then DL(Pit[G].x,Pit[G].y);
If PredGolY<Pit[G].y then VER(Pit[G].x,Pit[G].y);
If PredGolX>Pit[G].x then RD(Pit[G].x,Pit[G].y);
If G=1 then G:=MaxPiton else Dec(G);
Pit[G].y:=PredGolY+1; If PredGolY=60 then FlagStop:=True;
Pit[G].x:=PredGolX;
ClearHv(Pit[G].x,Pit[G].y);
If Not FlagStop then GolD(Pit[G].x,Pit[G].y);
End;
2 : Begin
If PredGolY>Pit[G].y then RD(Pit[G].x,Pit[G].y);
If PredGolX<Pit[G].x then GOR(Pit[G].x,Pit[G].y);
If PredGolY<Pit[G].y then UR(Pit[G].x,Pit[G].y);
If G=1 then G:=MaxPiton else Dec(G);
Pit[G].x:=PredGolX+1; If PredGolX=80 then FlagStop:=True;
Pit[G].y:=PredGolY;
ClearHv(Pit[G].x,Pit[G].y);
If Not FlagStop then GolR(Pit[G].x,Pit[G].y);
End;
4 : Begin
If PredGolX>Pit[G].x then GOR(Pit[G].x,Pit[G].y);
If PredGolY<Pit[G].y then LU(Pit[G].x,Pit[G].y);
If PredGolY>Pit[G].y then DL(Pit[G].x,Pit[G].y);
If G=1 then G:=MaxPiton else Dec(G);
Pit[G].x:=PredGolX-1; If PredGolX=1 then FlagStop:=True;
Pit[G].y:=PredGolY;
ClearHv(Pit[G].x,Pit[G].y);
If Not FlagStop then GolL(Pit[G].x,Pit[G].y);
End;
End;
CheckPriz;
Until Stop or FlagStop;
Readln;
CloseGraph;
End
Else WriteLn('ЋиЁЎЄ ЁЁжЁ «Ё§ жЁЁ Ја дЁЄЁ:', GraphErrorMsg(ErrCode));
End.