231 lines
9.1 KiB
Common Lisp
231 lines
9.1 KiB
Common Lisp
[let TILE 16]
|
|
[let GRID_X 20]
|
|
[let GRID_Y 12]
|
|
|
|
[let snake nil]
|
|
[let direction nil]
|
|
[let direction-id nil]
|
|
[let apple nil]
|
|
[let game-running nil]
|
|
[let score nil]
|
|
|
|
[let tile-head-left [q [1 1 1 3 3 3 1 1 1 2 3 4 5 4 3 3 1 3 4 6 5 5 5 5 1 3 4 4 5 5 5 5 1 3 4 4 5 5 5 5 1 3 4 6 5 5 5 5 1 2 3 4 5 4 3 3 1 1 1 3 3 3 1 1]]]
|
|
[let tile-head-right [q [1 1 3 3 3 1 1 1 3 3 4 5 4 3 2 1 5 5 5 5 6 4 3 1 5 5 5 5 4 4 3 1 5 5 5 5 4 4 3 1 5 5 5 5 6 4 3 1 3 3 4 5 4 3 2 1 1 1 3 3 3 1 1 1]]]
|
|
[let tile-head-down [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 3 4 5 5 5 5 4 3 3 5 5 5 5 5 5 3 3 4 6 4 4 6 4 3 1 3 4 4 4 4 3 1 1 2 3 3 3 3 2 1 1 1 1 1 1 1 1 1]]]
|
|
[let tile-head-up [q [1 1 1 1 1 1 1 1 1 2 3 3 3 3 2 1 1 3 4 4 4 4 3 1 3 4 6 4 4 6 4 3 3 5 5 5 5 5 5 3 3 4 5 5 5 5 4 3 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]]
|
|
[let tile-tail-left [q [1 1 1 1 1 1 1 1 3 3 2 1 1 2 2 1 5 5 4 3 1 1 2 1 5 5 5 5 4 3 1 1 5 5 5 5 4 3 1 1 5 5 4 3 1 1 2 1 3 3 2 1 1 2 2 1 1 1 1 1 1 1 1 1]]]
|
|
[let tile-tail-right [q [1 1 1 1 1 1 1 1 1 2 2 1 1 2 3 3 1 2 1 1 3 4 5 5 1 1 3 4 5 5 5 5 1 1 3 4 5 5 5 5 1 2 1 1 3 4 5 5 1 2 2 1 1 2 3 3 1 1 1 1 1 1 1 1]]]
|
|
[let tile-tail-down [q [1 1 1 1 1 1 1 1 1 2 2 1 1 2 2 1 1 2 1 3 3 1 2 1 1 1 1 4 4 1 1 1 1 1 3 5 5 3 1 1 1 2 4 5 5 4 2 1 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]]
|
|
[let tile-tail-up [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 1 2 4 5 5 4 2 1 1 1 3 5 5 3 1 1 1 1 1 4 4 1 1 1 1 2 1 3 3 1 2 1 1 2 2 1 1 2 2 1 1 1 1 1 1 1 1 1]]]
|
|
[let tile-body-h [q [1 1 1 1 1 1 1 1 3 3 3 1 1 3 3 3 5 5 4 3 3 4 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 4 3 3 4 5 5 3 3 3 1 1 3 3 3 1 1 1 1 1 1 1 1]]]
|
|
[let tile-body-v [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1 1 3 4 5 5 4 3 1 1 1 3 5 5 3 1 1 1 1 3 5 5 3 1 1 1 3 4 5 5 4 3 1 1 3 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]]
|
|
[let tile-body-nw [q [1 3 5 5 5 5 3 1 3 4 5 5 5 5 3 1 5 5 5 5 5 5 3 1 5 5 5 5 5 4 3 1 5 5 5 5 4 3 1 1 5 5 5 4 3 1 2 1 3 3 3 3 1 2 2 1 1 1 1 1 1 1 1 1]]]
|
|
[let tile-body-ne [q [1 3 5 5 5 5 3 1 1 3 5 5 5 5 4 3 1 3 5 5 5 5 5 5 1 3 4 5 5 5 5 5 1 1 3 4 5 5 5 5 1 2 1 3 4 5 5 5 1 2 2 1 3 3 3 3 1 1 1 1 1 1 1 1]]]
|
|
[let tile-body-sw [q [1 1 1 1 1 1 1 1 3 3 3 3 1 2 2 1 5 5 5 4 3 1 2 1 5 5 5 5 4 3 1 1 5 5 5 5 5 4 3 1 5 5 5 5 5 5 3 1 3 4 5 5 5 5 3 1 1 3 5 5 5 5 3 1]]]
|
|
[let tile-body-se [q [1 1 1 1 1 1 1 1 1 2 2 1 3 3 3 3 1 2 1 3 4 5 5 5 1 1 3 4 5 5 5 5 1 3 4 5 5 5 5 5 1 3 5 5 5 5 5 5 1 3 5 5 5 5 4 3 1 3 5 5 5 5 3 1]]]
|
|
[let tile-background [q [1 1 1 1 1 1 1 1 1 2 2 1 1 2 2 1 1 2 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 2 1 1 2 2 1 1 2 2 1 1 1 1 1 1 1 1 1]]]
|
|
[let tile-apple [q [1 1 1 9 1 1 1 1 1 2 2 1 9 2 2 1 1 7 7 7 9 8 8 1 7 7 9 7 7 8 8 8 7 9 9 7 7 8 8 8 7 7 7 7 7 8 8 8 1 7 7 7 7 8 8 1 1 1 7 7 8 8 1 1]]]
|
|
[let tile-digit-0 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 7 7 8 7 7 7 8 2 7 7 7 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2]]]
|
|
[let tile-digit-1 [q [2 2 2 7 7 2 2 2 2 2 7 7 7 8 2 2 2 2 7 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2]]]
|
|
[let tile-digit-2 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 8 2 7 7 8 2 7 7 8 2 2 8 2 2 7 7 8 2 2 7 7 7 7 8 2 2 7 7 8 8 8 2 2 2 7 7 8 2 7 7 2 2 7 7 7 7 7 7 8]]]
|
|
[let tile-digit-3 [q [2 2 7 7 7 7 2 2 2 2 2 8 8 7 7 2 2 2 2 2 2 7 7 8 2 2 2 7 7 7 7 8 2 2 2 2 8 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 7 7 7 7 8 2]]]
|
|
[let tile-digit-4 [q [2 2 7 2 2 7 7 2 2 2 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 7 7 7 7 8 2 2 8 8 8 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8]]]
|
|
[let tile-digit-5 [q [2 2 7 7 7 7 7 2 2 2 7 7 8 8 8 2 2 2 7 7 2 2 2 2 2 2 7 7 7 7 2 2 2 2 2 8 8 7 7 2 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 7 7 7 7 8 2]]]
|
|
[let tile-digit-6 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 2 2 7 7 8 2 7 7 2 2 2 8 8 2 7 7 7 7 7 7 2 2 7 7 8 8 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2]]]
|
|
[let tile-digit-7 [q [2 7 7 7 7 7 7 2 2 7 7 8 8 7 7 8 2 2 8 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2 2 2 2 2 7 7 8 2]]]
|
|
[let tile-digit-8 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 7 7 8 2 7 7 8 2 2 7 7 7 7 8 2]]]
|
|
[let tile-digit-9 [q [2 2 7 7 7 7 2 2 2 7 7 8 8 7 7 2 2 7 7 8 2 7 7 8 2 2 7 7 7 7 7 8 2 2 2 8 8 7 7 8 2 2 2 2 2 7 7 8 2 7 7 2 2 7 7 8 2 2 7 7 7 7 8 2]]]
|
|
|
|
[let tile-digits [list tile-digit-0 tile-digit-1 tile-digit-2 tile-digit-3 tile-digit-4 tile-digit-5 tile-digit-6 tile-digit-7 tile-digit-8 tile-digit-9]]
|
|
|
|
[defun tile-overlap [x y] [and [is [car x] [car y]] [is [cdr x] [cdr y]]]]
|
|
|
|
[defun draw-tile [x y tile] [do
|
|
[let i 0]
|
|
[while [< i TILE] [do
|
|
[let p [+ [* x TILE] [* [+ i [* y TILE]] 320]]]
|
|
[let j 0]
|
|
[let ts tile]
|
|
[while [< j TILE] [do
|
|
[let col [car tile]]
|
|
[= tile [cdr tile]]
|
|
[poke 10 p col]
|
|
[inc j]
|
|
[inc p]
|
|
[poke 10 p col]
|
|
[inc j]
|
|
[inc p]
|
|
]]
|
|
[inc i]
|
|
[= p [+ [* x TILE] [* [+ i [* y TILE]] 320]]]
|
|
[= j 0]
|
|
[= tile ts]
|
|
[while [< j TILE] [do
|
|
[let col [car tile]]
|
|
[= tile [cdr tile]]
|
|
[poke 10 p col]
|
|
[inc j]
|
|
[inc p]
|
|
[poke 10 p col]
|
|
[inc j]
|
|
[inc p]
|
|
]]
|
|
[inc i]
|
|
]]
|
|
]]
|
|
|
|
[defun draw-apple [] [do
|
|
[draw-tile [car apple] [cdr apple] tile-apple]
|
|
]]
|
|
|
|
[defun draw-snake-body [before pos after] [do
|
|
[draw-tile [car pos] [cdr pos] [if
|
|
[is [car before] [car after]] tile-body-v
|
|
[is [cdr before] [cdr after]] tile-body-h
|
|
[and [is [car before] [- [car pos] 1]] [is [cdr after] [- [cdr pos] 1]]] tile-body-nw
|
|
[and [is [car after] [- [car pos] 1]] [is [cdr before] [- [cdr pos] 1]]] tile-body-nw
|
|
[and [is [car before] [- [car pos] 1]] [is [cdr after] [+ [cdr pos] 1]]] tile-body-sw
|
|
[and [is [car after] [- [car pos] 1]] [is [cdr before] [+ [cdr pos] 1]]] tile-body-sw
|
|
[and [is [car before] [+ [car pos] 1]] [is [cdr after] [- [cdr pos] 1]]] tile-body-ne
|
|
[and [is [car after] [+ [car pos] 1]] [is [cdr before] [- [cdr pos] 1]]] tile-body-ne
|
|
tile-body-se
|
|
]]
|
|
]]
|
|
|
|
[defun draw-snake-head [p] [do
|
|
[draw-tile [car p] [cdr p] [if
|
|
[is direction-id 0] tile-head-left
|
|
[is direction-id 1] tile-head-down
|
|
[is direction-id 2] tile-head-right
|
|
tile-head-up]]
|
|
]]
|
|
|
|
[defun draw-snake-tail [before pos] [do
|
|
[draw-tile [car pos] [cdr pos] [if
|
|
[is [car before] [- [car pos] 1]] tile-tail-left
|
|
[is [car before] [+ [car pos] 1]] tile-tail-right
|
|
[is [cdr before] [- [cdr pos] 1]] tile-tail-up
|
|
tile-tail-down
|
|
]]
|
|
]]
|
|
|
|
[defun draw-background-piece [p] [do
|
|
[draw-tile [car p] [cdr p] tile-background]
|
|
]]
|
|
|
|
[defun draw-background [] [do
|
|
[let i 0]
|
|
[while [< i GRID_X] [do
|
|
[let j 0]
|
|
[while [< j GRID_Y] [do
|
|
[draw-background-piece [cons i j]]
|
|
[inc j]
|
|
]]
|
|
[inc i]
|
|
]]
|
|
]]
|
|
|
|
[defun move-apple [] [do
|
|
[= apple [cons [mod [random] GRID_X] [mod [random] GRID_Y]]]
|
|
[inc score]
|
|
]]
|
|
|
|
[defun wrap [x y] [if [< x 0] -1 [is x y] -1 x]]
|
|
|
|
[defun move-snake [] [do
|
|
[let head [car snake]]
|
|
[let moved-head [cons [wrap [+ [car head] [car direction]] GRID_X] [wrap [+ [cdr head] [cdr direction]] GRID_Y]]]
|
|
[= snake [cons moved-head snake]]
|
|
]]
|
|
|
|
[defun process-input [] [do
|
|
[let x [last-scancode]]
|
|
[if [is x 72] [do [= direction [cons 0 -1]] [= direction-id 3]] 0]
|
|
[if [is x 77] [do [= direction [cons 1 0]] [= direction-id 2]] 0]
|
|
[if [is x 80] [do [= direction [cons 0 1]] [= direction-id 1]] 0]
|
|
[if [is x 75] [do [= direction [cons -1 0]] [= direction-id 0]] 0]
|
|
]]
|
|
|
|
[defun game-over [] [do
|
|
[if game-running [= game-running nil] 0]
|
|
]]
|
|
|
|
[defun check-collision [] [do
|
|
[let s snake]
|
|
[let head [car s]]
|
|
[if [or [is [car head] -1] [is [cdr head] -1]] [game-over] 0]
|
|
[while s [do
|
|
[let t [cdr s]]
|
|
[while t [do
|
|
[if [tile-overlap [car s] [car t]]
|
|
[game-over] 0
|
|
]
|
|
[= t [cdr t]]
|
|
]]
|
|
[= s [cdr s]]
|
|
]]
|
|
]]
|
|
|
|
[defun show-score [] [do
|
|
[draw-tile 9 4 [nth tile-digits [mod [/ score 100] 10]]]
|
|
[draw-tile 10 4 [nth tile-digits [mod [/ score 10 ] 10]]]
|
|
[draw-tile 11 4 [nth tile-digits [mod [/ score 1 ] 10]]]
|
|
]]
|
|
|
|
[defun set-color [i r g b] [do
|
|
[outb 968 i]
|
|
[outb 969 r]
|
|
[outb 969 g]
|
|
[outb 969 b]
|
|
]]
|
|
|
|
[defun set-palette [] [do
|
|
[set-color 1 24 20 20]
|
|
[set-color 2 30 25 26]
|
|
[set-color 3 27 44 31]
|
|
[set-color 4 32 48 31]
|
|
[set-color 5 36 52 31]
|
|
[set-color 6 12 7 11]
|
|
[set-color 7 57 36 29]
|
|
[set-color 8 44 23 20]
|
|
[set-color 9 56 48 43]
|
|
]]
|
|
|
|
[defun before-last [x] [if [cdr [cdr x]] [before-last [cdr x]] x]]
|
|
|
|
[defun start-game [] [do
|
|
[set-graphics 1]
|
|
[set-palette]
|
|
[= game-running 1]
|
|
[= score 0]
|
|
[= snake [list [q [8 . 5]] [q [7 . 5]] [q [6 . 5]] [q [5. 5]]]]
|
|
[= direction [q [1 . 0]]]
|
|
[= direction-id 2]
|
|
[draw-background]
|
|
[move-apple]
|
|
[while game-running [do
|
|
[let tail [last snake]]
|
|
[draw-background-piece tail]
|
|
[move-snake]
|
|
[let head [car snake]]
|
|
[let body [car [cdr snake]]]
|
|
[let body-after [car [cdr [cdr snake]]]]
|
|
[draw-snake-body head body body-after]
|
|
[draw-snake-head head]
|
|
[if [tile-overlap head apple] [move-apple] [del-last snake]]
|
|
[let tail-before [before-last snake]]
|
|
[draw-snake-tail [car tail-before] [car [cdr tail-before]]]
|
|
[draw-apple]
|
|
[process-input]
|
|
[check-collision]
|
|
[pause]
|
|
[pause]
|
|
]]
|
|
[show-score]
|
|
[wait-key]
|
|
[set-graphics nil]
|
|
[print "Type [start-game] to play again!"]
|
|
]]
|
|
|
|
[start-game]
|