{ SNAKE.PAS Copyright (c) Mohamad } { } { Hra had. Mate za ulohu zbierat rozhadzane cisla. Kazdym zjedenym } { cislom sa predlzi chvost hada. Pozor nesmiete za zahryznut do } { vlastneho chvosta. } { } { Author: Mohamad } { Date : 18.12.2006 http://www.trsek.com } program SNAKE; uses crt; type TWORM=record L:byte; W:array [1..46,1..2]of integer; EOG:boolean; D:INTEGER; end; var N:integer; S:byte; K:byte; MW:TWORM; C:char; F:boolean; I, J:integer; SCREEN:array[1..25,1..80] of word absolute $B800:0000; {This instruction will read your key} function FUN_KEY (var C:char):boolean; begin FUN_KEY:=FALSE; F:=FALSE; C:=Readkey; if C=#0 then begin FUN_KEY:=true; F:=TRUE; C:=readkey; end; end; procedure INIT; var X,Y:integer; I:integer; begin for I:=1 to 23 do for J:=1 to 73 do SCREEN[I,J]:=15*256+219; for I:=1 to 25 do for J:=74 to 80 do SCREEN[I,J]:=0; for I:=24 to 25 do for J:=1 to 80 do SCREEN[I,J]:=0; end; {**************************************************************** {******************************************************************} procedure SETSEED(S:byte); var X,Y:byte; begin randomize; X:=random(23)+1; Y:=random(73)+1; while SCREEN[X,Y]<>15*256+219 do begin X:=random(23)+1; Y:=random(73)+1; end; SCREEN[X,Y]:=4*256+(48+S); end; procedure NGAME; begin randomize; INIT; MW.L:=1; MW.W[1,1]:=22; MW.W[1,2]:=40; K:=0; S:=1; MW.D:=1; SETSEED(S); N:=N div 2; end; {*******************************************************************} procedure MOVE; begin SCREEN[MW.W[MW.L,1],MW.W[MW.L,2]]:=15*256+219; if K>0 then begin MW.L:=MW.L+1; dec(K); end; for J:=MW.L downto 2 do begin MW.W[J,1]:=MW.W[J-1,1]; MW.W[J,2]:=MW.W[J-1,2]; SCREEN[MW.W[J,1],MW.W[J,2]]:=11*256+7; end; if MW.D= 1 then begin if MW.W[1,1]=1 then MW.W[1,1]:=24; MW.W[1,1]:=MW.W[1,1]-1; end else if MW.D= 2 then begin if MW.W[1,1]=23 then MW.W[1,1]:=0; MW.W[1,1]:=MW.W[1,1]+1; end else if MW.D= 3 then begin if MW.W[1,2]=73 then MW.W[1,2]:=0; MW.W[1,2]:=MW.W[1,2]+1; end else if MW.D= 4 then begin if MW.W[1,2]=1 then MW.W[1,2]:=74; MW.W[1,2]:=MW.W[1,2]-1; end; if SCREEN[MW.W[1,1],MW.W[1,2]]=11*256+7 then begin gotoxy(1,24); textcolor(green); write('Game Over...'); delay(100); MW.EOG:=false; end; if SCREEN[MW.W[1,1],MW.W[1,2]]=4*256+(48+S) then begin MW.L:=MW.L+1; K:=S-1+K; inc(S); MW.W[MW.L,1]:=MW.W[MW.L-1,1]; MW.W[MW.L,2]:=MW.W[MW.L-1,2]; if S=10 then NGAME else SETSEED(S); end else SCREEN[MW.W[1,1],MW.W[1,2]]:=3*256+42; end; {****************************************************************} procedure EVENT(C:char;F:boolean); begin if F and (C=#72) then if MW.D<>2 then MW.D:=1; if F and (C=#80) then if MW.D<>1 then MW.D:=2; if F and (C=#77) then if MW.D<>4 then MW.D:=3; if F and (C=#75) then if MW.D<>3 then MW.D:=4; end; {***************************************************************} begin Randomize; INIT; FOR I:=2 to 46 do begin MW.W[I,1]:=1; MW.W[I,2]:=1; end; MW.L:=1; MW.W[1,1]:=22; MW.W[1,2]:=40; MW.D:=1; MW.EOG:=true; S:=1; SETSEED(S); N:=60; while (MW.EOG and not((not F) and (C=#27))) do begin MOVE; if keypressed then F:=FUN_KEY(C); EVENT(C,F); mem[$40:$1C]:=mem[$40:$1A]; delay(N); end; end.