Uses CRT,Graph; Var C :char; W : word; Dir, b, e : byte; Num : integer; en : array [1..2] of byte; bg : array [1..2] of byte; a : array [1..79, 1..24] of integer; i,j,k : byte; {-----------------======================-----------------} Procedure Apple; Var i,j,k,b1,b2 : byte; begin randomize; repeat i := random(77); j := random(24); k := random(9); until (i > 2) and (i < 78) and (j > 2 ) and (j < 22) and (k <> 0) and (a[i,j] = 0); b1 := WhereX; b2 := WhereY; GotoXY(i,j); Write(k); a[i,j] := - k; GotoXY(b1,b2); end; {-------------------------------------------------------} Procedure Ext; var Gd, Gm :integer; begin {Sound(100); Delay(2000); Nosound;} Gd := Detect; InitGraph(Gd, Gm, ''); if GraphResult <> grOk then Halt(1); ClearDevice; SetColor(Magenta); SetTextStyle(TriplexFont, HorizDir,10); OutTextXY(150,100,'Game'); OutTextXY(170,200,'OveR'); ReadKey; CloseGraph; Halt end; {Ext} {-------------------------------------------------------} Procedure StartUp; var Gd, Gm : Integer; begin Gd := Detect; InitGraph(Gd, Gm, ''); if GraphResult <> grOk then Halt(1); ClearDevice; SetColor(Blue); SetTextStyle(3, HorizDir,8); OutTextXY(80,100,'Game Piton'); SetColor(White); SetTextStyle(1,HorizDir,2); OutTextXY(200,450,'///Press any key\\\'); ReadKey; CloseGraph end; {StartUp} {------------------==================-------------------} Procedure Game; begin ClrScr; for i := 1 to 79 do for j := 1 to 24 do a[i,j] := 0; e := 1; en[1] := 39; en[2] := 13; Num := 1; Dir := 1; b := 10; a[39,13] := 1; GotoXY(40,13); repeat if keypressed then begin c := readkey; if c = #0 then Begin w := ord(readkey); case w of 77 : case dir of 1 : begin if a[whereX,WhereY] > 0 then ext; Write('╗'); Num := num + 1; a[WhereX-1,WhereY] := Num; dir := 2 end; 2 : begin if a[whereX-1,WhereY+1] > 0 then ext; GotoXY(WhereX-1,WhereY+1); Write('╝'); Num := num + 1; a[WhereX-1,WhereY] := Num; dir := 3; end; 3 : begin if a[whereX-2,WhereY] > 0 then ext; GotoXY(WhereX-2,WhereY); Write('╚'); Num := num + 1; a[WhereX-1,WhereY] := num; Dir := 4 end; 4 : begin if a[whereX-1,WhereY-1] > 0 then ext; GotoXY(WhereX-1,WhereY-1); Write('╔'); Num := num + 1; a[WhereX-1,WhereY] := Num; Dir := 1 end; end; 75 : case dir of 1 : begin if a[whereX,WhereY] > 0 then ext; Write('╝'); num := num +1; a[WhereX-1,WhereY] := Num ; dir := 4 end; 2 : begin if a[whereX-1,WhereY+1] > 0 then ext; GotoXY(WhereX-1,WhereY + 1); Write('╚'); Num := num + 1; a[WhereX-1,WhereY] := Num; dir := 1; end; 3 : begin if a[whereX-2,WhereY] > 0 then ext; GotoXY(WhereX-2,WhereY); Write('╔'); num := num + 1; a[WhereX-1,WhereY] := num; Dir := 2 end; 4 : begin if a[whereX-1,WhereY-1] > 0 then ext; GotoXY(WhereX-1,WhereY - 1); Write('╗'); num := num + 1; a[WhereX-1,WhereY] := num ; Dir := 3 end; end; 27 : ext end; end; end else begin case dir of 1 : if WhereX > 77 then ext else if a[WhereX,WhereY] > 0 then ext else begin if a[WhereX,WhereY] < 0 then b := b + abs(a[WhereX,WhereY]); Write('═'); Num := num + 1; a[WhereX-1,WhereY] := Num; if b > 0 then b := b - 1; end; 2: if (WhereY + 1) > 23 then ext else if a[WhereX-1,WhereY+1] > 0 then ext else begin if a[WhereX-1,WhereY+1] < 0 then b := b + abs(a[WhereX-1,WhereY+1]); GotoXY(WhereX-1,WhereY+1); Write('║'); Num := num + 1; a[WhereX-1,WhereY] := Num; if b > 0 then b := b - 1; end; 3 : if (WhereX-2) < 2 then ext else if a[WhereX-2,WhereY] > 0 then ext else begin if a[WhereX-2,WhereY] < 0 then b :=b+abs(a[WhereX-2,WhereY]); GotoXY(Wherex-2,WhereY); Write('═'); Num := Num + 1; a[WhereX-1,WhereY] := Num ; if b > 0 then b := b - 1; end; 4 : if (WhereY - 1) < 2 then ext else if a[WhereX-1,WhereY-1] > 0 then ext else begin if a[WhereX-1,WhereY-1] < 0 then b := b + abs(a[WhereX-1,WhereY-1]); GotoXY(WhereX-1,WhereY-1); Write('║'); Num := Num +1; a[WhereX-1,WhereY] := Num ; if b > 0 then b := b - 1; end; end; end; if b = 0 then begin bg[1] := WhereX; bg[2] := WhereY; GotoXY(en[1],en[2]); Write(' '); a[WhereX-1,WhereY] := 0; if a[WhereX,WhereY] = e + 1 then begin en[1] := WhereX; en[2] := WhereY; e := e + 1; end; if a[WhereX-2,WhereY] = e + 1 then begin en[1] := WhereX-2; en[2] := WhereY; e := e + 1 ; end; if a[WhereX-1,WhereY+1] = e + 1 then begin en[1] := WhereX-1; en[2] := WhereY+1; e := e + 1; end; if a[WhereX-1,WhereY-1] = e + 1 then begin en[1] := WhereX-1; en[2] := WhereY-1; e := e + 1 end; GotoXY(bg[1],bg[2]); end; Delay(2000); k := 0; for i := 1 to 79 do for j := 1 to 24 do if a[i,j] < 0 then k := 1; if k = 0 then apple; until false; end; Begin StartUp; Game end.