Uses CRT,Graph,DOS; Type main = record n : integer; c : byte; end; Type Hiscore = record Name : string[13]; Score : Word; Sp : byte; end; const rt : byte = 77; lt : byte = 72; Var s : SearchRec; Tbl : file of HiScore; MAX,col : HiScore; C : char; W, e : word; Dir, b,cl : byte; Num : integer; en : array [1..2] of byte; bg : array [1..2] of byte; a : array [20..80, 2..25] of main; i,j,k,l,r : byte; {-----------------======================-----------------} Procedure Setup; forward; Procedure Stat(bg1,bg2:byte); forward; Procedure Apple ; forward; Procedure Ext ; forward; Procedure StartUp; forward; Procedure DrawTable; forward; Procedure Game(lt,rt:byte); forward; {---------------------------------------------------------} Procedure Setup; begin CloseGraph; ClrScr; TextMode(CO80); GotoXY(10, 5); Write('1 : Скорость'); GotoXY(10, 10); Write('2 : Установить Клавиши'); GotoXY(10, 15); Write('3 : Завершить настроики'); GotoXY(1,1); Case readkey of '1' : begin GotoXY(12,20); Write('Введите скорость 1..10 (5) '); repeat Readln(max.sp); until (max.sp > 0) and (max.sp < 11); end; '2' : begin GotoXY(12,20); Write('Лево '); c := readkey; if c = #0 then begin lt := ord(readkey); write(lt); end else begin lt := ord(c); Write(lt); end; GotoXY(12,21); Write('Право '); c := readkey; if c = #0 then begin rt := ord(readkey); write(rt); end else begin rt := ord(c); Write(rt); end; end; end; end; {--------------------------------------------------------} Procedure Stat; Var g,h,n :byte; begin n := 0; TextColor(7); GotoXY(2,5); Write('X : ',bg1-1); GotoXY(2,7); Write(' '); GotoXY(WhereX-18,WhereY); Write('Y : ',bg2); GotoXY(2,9); Write('Длина змея : ', col.score); GotoXY(2,11); Write('Число ходов : ',num); GotoXY(6,13); Write('Лучший '); GotoXY(2,14); Write(max.name); GotoXY(16,14); Write(Max.score); GotoXY(bg1,bg2); TextColor(cl); end; {stat} {--------------------------------------------------------} Procedure Apple; Var i,j,k,b1,b2 : byte; begin randomize; repeat i := random(78); j := random(23); k := random(9); r := random(14); until (i > 20) and (i < 80) and (j > 2 ) and (j < 25) and (k <> 0) and (a[i,j].n = 0) and (r <> 0) and (r <> 7) and (r <> cl); b1 := WhereX; b2 := WhereY; GotoXY(i,j); TextColor(r); Write(k); TextColor(cl); a[i,j].n := - k; a[i,j].c := r; GotoXY(b1,b2); end; {-------------------------------------------------------} Procedure Ext; var Gd, Gm :integer; begin {Sound(100); Delay(2000); Nosound;} if col.score > max.score then begin ClrScr; GotoXY(30,10); max.score := col.score; TextColor(cyan); Write('П О З Д Р А В Л Я Ю'); GotoXY(30,12); TextColor(Blue); Write('Вы поставили рекорд'); GotoXY(12,17); TextColor(Yellow); Write('Введите свое имя до 13 символов '); TextColor(lightgreen); Read(max.name); TextColor(7); end; Seek(tbl,0); Write(tbl,max); 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'); SetColor(Green); SetTextStyle(SmallFont, HorizDir,20); OutTextXY(180,430,'Another Game ? '); if (readkey = 'y') or (readkey = 'Y') then begin CloseGraph; Game(lt,rt); end; Close(Tbl); 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(20,450,'Press "S" for Setup, "Q" to Quit, any other to continue'); case ReadKey of 's','S' : setup; 'q','Q' : begin CloseGraph; halt; end; end; CloseGraph; Game(lt,rt); end; {StartUp} {------------------==================-------------------} Procedure DrawTable; var y:integer; begin clrscr; TextColor(blue); GotoXY(40,2); Write('Game PITON'); TextColor(7); for y := 20 to 79 do begin GotoXY(y, 3); Write('═'); GotoXY(y, 25); Write('═'); end; Write('╝'); GotoXY(80, 2); Write('╗'); For y := 3 to 23 do begin GotoXY(20, y); Write ('║'); GotoXY(WhereX-1, WhereY + 1); Write('╚'); GotoXY(80, y); Write ('║') end; GotoXY(20,2); Write('╔'); end; {DrawTable} {-------------------------------------------------------} Procedure Game; begin ClrScr; TextBackGround(0); DrawTable; assign(Tbl,'hiscr.dat'); {$I-} Reset(Tbl); {$I+} if IOResult <> 0 then ReWrite(tbl); FindFirst('Hiscore.dat',AnyFile,s); if s.size = 0 then begin if max.sp = 0 then max.sp := 5 ; max.Score := 9; max.name := 'Coder'; Seek(tbl,0); Write(tbl,max); Close(tbl); Reset(tbl); end; {$I-} Read(tbl,max); {$I+} If IOResult <> 0 then Halt; for i := 20 to 80 do for j := 2 to 25 do begin a[i,j].c := 7; a[i,j].n := 0; end; cl := 7; e := 1; en[1] := 39; en[2] := 13; Num := 1; Dir := 1; b := 10; col.score := 9; a[39,13].n := 1; GotoXY(40,13); repeat l := 0; if keypressed then begin c := readkey; if c = #0 then w := ord(readkey) else w := ord(c); if (w = rt) or (w = lt) then begin l := 1; case w of 11 : case dir of 1 : begin if WhereX > 79 then ext; if a[whereX,WhereY].n > 0 then ext; if a[WhereX,WhereY].n < 0 then begin b := b - a[WhereX,WhereY].n; inc(col.score,-a[whereX,WhereY].n); end; If a[WhereX,WhereY].c <> 7 then begin TextColor(a[WhereX,WhereY].c); cl := a[WhereX,WhereY].c; end; Write('╗'); inc(num); a[WhereX-1,WhereY].n := Num; dir := 2 end; 2 : begin if (WhereY + 1) > 24 then ext; if a[whereX-1,WhereY+1].n > 0 then ext; if a[WhereX-1,WhereY+1].n < 0 then begin b := b - a[WhereX-1,WhereY+1].n; inc(col.score, -a[WhereX-1,WhereY+1].n); end; If a[WhereX-1,WhereY+1].c <> 7 then begin TextColor(a[WhereX-1,WhereY+1].c); cl := a[WhereX-1,WhereY + 1].c; end; GotoXY(WhereX-1,WhereY+1); Write('╝'); inc(num); a[WhereX-1,WhereY].n := Num; a[WhereX-1,WhereY].c := a[WhereX-1,WhereY-1].c; dir := 3; end; 3 : begin if (WhereX - 2) < 21 then ext; if a[whereX-2,WhereY].n > 0 then ext; if a[WhereX-2,WhereY].n < 0 then begin b := b - a[WhereX-2,WhereY].n; inc(col.score, -a[WhereX-2,WhereY].n); end; If a[WhereX-2,WhereY].c <> 7 then begin TextColor(a[WhereX-2,WhereY].c); cl := a[WhereX-2,WhereY].c; end; GotoXY(WhereX-2,WhereY); Write('╚'); inc(num); a[WhereX-1,WhereY].n := num; a[WhereX-1,WhereY].c := a[WhereX,WhereY].c; Dir := 4 end; 4 : begin if (WhereY - 1) < 3 then ext; if a[whereX-1,WhereY-1].n > 0 then ext; if a[WhereX-1,WhereY-1].n < 0 then begin b := b - a[WhereX-1,WhereY-1].n; inc(col.score, -a[WhereX-1,WhereY-1].n); end; If a[WhereX - 1,WhereY - 1].c <> 7 then begin TextColor(a[WhereX-1,WhereY-1].c); cl := a[WhereX-1,WhereY - 1].c; end; GotoXY(WhereX-1,WhereY-1); Write('╔'); inc(num); a[WhereX-1,WhereY].n := Num; a[WhereX-1,WhereY].c := a[WhereX-1,WhereY+1].c; Dir := 1 end; end; 12 : case dir of 1 : begin if WhereX > 79 then ext; if a[whereX,WhereY].n > 0 then ext; if a[WhereX,WhereY].n < 0 then begin b := b - a[WhereX,WhereY].n; inc(col.score, -a[WhereX,WhereY].n); end; If a[WhereX,WhereY].c <> 7 then begin TextColor(a[WhereX,WhereY].c); cl := a[WhereX,WhereY].c; end; Write('╝'); inc(num); a[WhereX-1,WhereY].n := Num ; dir := 4 end; 2 : begin if WhereY + 1 > 23 then ext; if a[whereX-1,WhereY+1].n > 0 then ext; if a[WhereX-1,WhereY+1].n < 0 then begin b := b - a[WhereX-1,WhereY+1].n; inc(col.score, -a[WhereX-1,WhereY+1].n); end; If a[WhereX-1,WhereY+1].c <> 7 then begin TextColor(a[WhereX-1,WhereY+1].c); cl := a[WhereX-1,WhereY + 1].c; end; GotoXY(WhereX-1,WhereY + 1); Write('╚'); inc(num); a[WhereX-1,WhereY].c := a[WhereX-1,WhereY-1].c; a[WhereX-1,WhereY].n := Num; dir := 1; end; 3 : begin if WhereX - 2 < 21 then ext; if a[whereX-2,WhereY].n > 0 then ext; if a[WhereX-2,WhereY].n < 0 then begin b := b - a[WhereX-2,WhereY].n; inc(col.score, -a[WhereX-2,WhereY].n); end; If a[WhereX-2,WhereY].c <> 7 then begin TextColor(a[WhereX-2,WhereY].c); cl := a[WhereX-2,WhereY].c; end; GotoXY(WhereX-2,WhereY); Write('╔'); inc(num); a[WhereX-1,WhereY].n := num; a[WhereX-1,WhereY].c := a[WhereX,WhereY].c; Dir := 2 end; 4 : begin if WhereY - 1 < 3 then ext; if a[whereX-1,WhereY-1].n > 0 then ext; if a[WhereX-1,WhereY-1].n < 0 then begin b := b - a[WhereX-1,WhereY-1].n; inc(col.score, -a[WhereX-1,WhereY-1].n); end; If a[WhereX-1,WhereY-1].c <> 7 then begin TextColor(a[WhereX-1,WhereY-1].c); cl := a[WhereX-1,WhereY - 1].c; end; GotoXY(WhereX-1,WhereY - 1); Write('╗'); inc(num); a[WhereX-1,WhereY].n := num ; a[WhereX-1,WhereY].c := a[WhereX-1,WhereY+1].c; Dir := 3 end; end; end; end; end; begin if l = 0 then begin case dir of 1 : if WhereX > 79 then ext else if a[WhereX,WhereY].n > 0 then ext else begin if a[WhereX,WhereY].n < 0 then begin b:=b-a[WhereX,WhereY].n; inc(col.score,-a[whereX,WhereY].n); end; If a[WhereX,WhereY].c <> 7 then begin TextColor(a[WhereX,WhereY].c); cl := a[WhereX,WhereY].c; end; Write('═'); inc(num); a[WhereX-1,WhereY].n := Num; a[WhereX-1,WhereY].c := a[WhereX-2,WhereY].c; if b > 0 then b := b - 1; end; 2: if (WhereY + 1) > 23 then ext else if a[WhereX-1,WhereY+1].n > 0 then ext else begin if a[WhereX-1,WhereY+1].n < 0 then begin b := b-a[WhereX-1,WhereY+1].n; inc(col.score, -a[WhereX-1,WhereY+1].n); end; If a[WhereX-1,WhereY+1].c <> 7 then begin TextColor(a[WhereX-1,WhereY+1].c); cl := a[WhereX-1,WhereY + 1].c; end; GotoXY(WhereX-1,WhereY+1); Write('║'); inc(num); a[WhereX-1,WhereY].n := Num; a[WhereX-1,WhereY].c := a[WhereX-1,WhereY-1].c; if b > 0 then b := b - 1; end; 3 : if (WhereX-2) < 21 then ext else if a[WhereX-2,WhereY].n > 0 then ext else begin if a[WhereX-2,WhereY].n < 0 then begin b:=b-a[WhereX-2,WhereY].n; inc(col.score, -a[WhereX-2,WhereY].n); end; If a[WhereX-2,WhereY].c <> 7 then begin TextColor(a[WhereX-2,WhereY].c); cl := a[WhereX-2,WhereY].c; end; GotoXY(Wherex-2,WhereY); Write('═'); inc(Num); a[WhereX-1,WhereY].n := Num ; a[WhereX-1,WhereY].c := a[WhereX,WhereY].c; if b > 0 then b := b - 1; end; 4 : if (WhereY - 1) < 3 then ext else if a[WhereX-1,WhereY-1].n > 0 then ext else begin if a[WhereX-1,WhereY-1].n < 0 then begin b := b - a[WhereX-1,WhereY-1].n; inc(col.score, -a[WhereX-1,WhereY-1].n); end; If a[WhereX-1,WhereY-1].c <> 7 then begin TextColor(a[WhereX-1,WhereY-1].c); cl := a[WhereX-1,WhereY - 1].c; end; GotoXY(WhereX-1,WhereY-1); Write('║'); inc(Num); a[WhereX-1,WhereY].n := Num ; a[WhereX-1,WhereY].c := a[WhereX-1,WhereY+1].c; if b > 0 then b := b - 1; end; end; end; end; Stat(WhereX,WhereY); if b = 0 then begin bg[1] := WhereX; bg[2] := WhereY; GotoXY(en[1],en[2]); Write(' '); a[WhereX-1,WhereY].n := 0; a[WhereX-1,WhereY].c := 7; if a[WhereX,WhereY].n = e + 1 then begin en[1] := WhereX; en[2] := WhereY; inc(e); end; if a[WhereX-2,WhereY].n = e + 1 then begin en[1] := WhereX-2; en[2] := WhereY; inc(e); end; if a[WhereX-1,WhereY+1].n = e + 1 then begin en[1] := WhereX-1; en[2] := WhereY+1; inc(e); end; if a[WhereX-1,WhereY-1].n = e + 1 then begin en[1] := WhereX-1; en[2] := WhereY-1; inc(e) end; GotoXY(bg[1],bg[2]); end; Delay(1000 + max.sp * 100); k := 0; for i := 21 to 79 do for j := 3 to 24 do if a[i,j].n < 0 then k := 1; if k = 0 then apple; until false; end; Begin StartUp; end.