mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -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

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

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