mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 10:40:45 -08:00
Code Issues Projects Releases Wiki Activity

Snake Game Demo improvements

Browse source
This commit is contained in:
David Botton 2021-01-17 10:40:50 -05:00
parent cffea6af69
commit d06ce51f44
1 changed files with 32 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

20
demos/01-snake-game.lisp
View file

@ -21,15 +21,19 @@
(defclass app-data ()
((snake-direction
:initform :right
:type snake-direction-type
:accessor snake-direction)
(score
:initform 0
:type number
:accessor score)
(food
:initform (new-food)
:type cons
:accessor food)
(snake
:initform nil
:type cons
:accessor snake)))
(defun display-splash (body)
@ -81,17 +85,17 @@
(1+ (cadr head-cell))))))
(if (or (< (car head-cell) 0)
(cond ((or (< (car head-cell) 0)
(< (cadr head-cell) 0)
(>= (* (car head-cell) segment-size) display-width)
(>= (* (cadr head-cell) segment-size) display-height)
(self-collision))
(progn
(fill-style cx :red)
(font-style cx "bold 20px sans-serif")
(fill-text cx "GAME OVER" 30 30)
(setf game-over t))
(progn
(t
(fill-style cx :purple)
(push head-cell (snake app))
(dolist (cell (snake app))
@ -99,8 +103,8 @@
(fill-style cx :white)
(if (equal head-cell (food app))
(progn
(cond ((equal head-cell (food app))
(fill-text cx (format nil "Score: ~A" (score app))
5 (- display-height 15))
(setf (score app) (+ (score app) 10))
@ -110,14 +114,14 @@
5 (- display-height 15))
(setf (food app) (new-food)))
(progn
(t
(draw-segment (car (last (snake app))))
(setf (snake app) (butlast (snake app))))))
(setf (snake app) (butlast (snake app)))))
(fill-style cx :brown)
(draw-segment (food app)))
game-over)))
game-over))))
(defun on-key-down (obj event)
(let ((app (connection-data-item obj "app-data"))