mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
update documentation, remove tabs
This commit is contained in:
David Botton
parent
2c9ce0864f
commit
25a9462f1f
84 changed files with 2163 additions and 2278 deletions
|
|
@ -15,8 +15,8 @@
|
|||
(deftype snake-direction-type () '(member :left :right :up :down))
|
||||
|
||||
(defun new-food ()
|
||||
(list (random (floor (- (/ display-width segment-size) 1)))
|
||||
(random (floor (- (/ display-height segment-size) 1)))))
|
||||
(list (random (floor (- (/ display-width segment-size) 1)))
|
||||
(random (floor (- (/ display-height segment-size) 1)))))
|
||||
|
||||
(defclass app-data ()
|
||||
((snake-direction
|
||||
|
|
@ -34,7 +34,7 @@
|
|||
|
||||
(defun display-splash (body)
|
||||
(let* ((splash
|
||||
(create-div body :content
|
||||
(create-div body :content
|
||||
"<H1>(Sparky The Snake)</H1>
|
||||
<br />
|
||||
<p>Use your keyboard to move Sparky to pick up batteries.</p>
|
||||
|
|
@ -42,7 +42,7 @@
|
|||
If sparky hits his tail he electrocute himself to <b>death!!</b>
|
||||
<br /><br />
|
||||
Use the arrow keys or a,w,s,d for direction keys.<br/><br/>"))
|
||||
(ticker (create-span splash)))
|
||||
(ticker (create-span splash)))
|
||||
(setf (width splash) "100%")
|
||||
(setf (text-alignment splash) :center)
|
||||
(dotimes (n 10)
|
||||
|
|
@ -52,96 +52,96 @@
|
|||
|
||||
(defun paint (body cx app)
|
||||
(let ((game-over nil)
|
||||
(head-cell (car (snake app))))
|
||||
(head-cell (car (snake app))))
|
||||
(flet ((draw-segment (cell)
|
||||
(fill-rect cx
|
||||
(* (car cell) segment-size)
|
||||
(* (cadr cell) segment-size)
|
||||
segment-size
|
||||
segment-size))
|
||||
(self-collision ()
|
||||
(dolist (cell (snake app))
|
||||
(when (equal cell head-cell)
|
||||
(return t)))))
|
||||
(fill-rect cx
|
||||
(* (car cell) segment-size)
|
||||
(* (cadr cell) segment-size)
|
||||
segment-size
|
||||
segment-size))
|
||||
(self-collision ()
|
||||
(dolist (cell (snake app))
|
||||
(when (equal cell head-cell)
|
||||
(return t)))))
|
||||
(cond ((eq :right (snake-direction app))
|
||||
(setf head-cell (list (1+ (car head-cell))
|
||||
(cadr head-cell))))
|
||||
((eq :left (snake-direction app))
|
||||
(setf head-cell (list (1- (car head-cell))
|
||||
(cadr head-cell))))
|
||||
((eq :up (snake-direction app))
|
||||
(setf head-cell (list (car head-cell)
|
||||
(1- (cadr head-cell)))))
|
||||
((eq :down (snake-direction app))
|
||||
(setf head-cell (list (car head-cell)
|
||||
(1+ (cadr head-cell))))))
|
||||
(setf head-cell (list (1+ (car head-cell))
|
||||
(cadr head-cell))))
|
||||
((eq :left (snake-direction app))
|
||||
(setf head-cell (list (1- (car head-cell))
|
||||
(cadr head-cell))))
|
||||
((eq :up (snake-direction app))
|
||||
(setf head-cell (list (car head-cell)
|
||||
(1- (cadr head-cell)))))
|
||||
((eq :down (snake-direction app))
|
||||
(setf head-cell (list (car head-cell)
|
||||
(1+ (cadr head-cell))))))
|
||||
(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))
|
||||
(fill-style cx :red)
|
||||
(font-style cx "bold 20px sans-serif")
|
||||
(fill-text cx "GAME OVER" 30 30)
|
||||
(play-media (create-audio body :source "/demo/game-over.wav" :controls nil))
|
||||
(setf game-over t))
|
||||
(t
|
||||
(fill-style cx :purple)
|
||||
(push head-cell (snake app))
|
||||
(dolist (cell (snake app))
|
||||
(draw-segment cell))
|
||||
(fill-style cx :white)
|
||||
(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))
|
||||
(fill-style cx :green)
|
||||
(fill-text cx (format nil "Score: ~A" (score app))
|
||||
5 (- display-height 15))
|
||||
(play-media (create-audio body :source "/demo/eat.wav" :controls nil))
|
||||
(setf (food app) (new-food)))
|
||||
(t
|
||||
(draw-segment (car (last (snake app))))
|
||||
(setf (snake app) (butlast (snake app)))))
|
||||
(fill-style cx :brown)
|
||||
(draw-segment (food app))))
|
||||
game-over)))
|
||||
(< (cadr head-cell) 0)
|
||||
(>= (* (car head-cell) segment-size) display-width)
|
||||
(>= (* (cadr head-cell) segment-size) display-height)
|
||||
(self-collision))
|
||||
(fill-style cx :red)
|
||||
(font-style cx "bold 20px sans-serif")
|
||||
(fill-text cx "GAME OVER" 30 30)
|
||||
(play-media (create-audio body :source "/demo/game-over.wav" :controls nil))
|
||||
(setf game-over t))
|
||||
(t
|
||||
(fill-style cx :purple)
|
||||
(push head-cell (snake app))
|
||||
(dolist (cell (snake app))
|
||||
(draw-segment cell))
|
||||
(fill-style cx :white)
|
||||
(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))
|
||||
(fill-style cx :green)
|
||||
(fill-text cx (format nil "Score: ~A" (score app))
|
||||
5 (- display-height 15))
|
||||
(play-media (create-audio body :source "/demo/eat.wav" :controls nil))
|
||||
(setf (food app) (new-food)))
|
||||
(t
|
||||
(draw-segment (car (last (snake app))))
|
||||
(setf (snake app) (butlast (snake app)))))
|
||||
(fill-style cx :brown)
|
||||
(draw-segment (food app))))
|
||||
game-over)))
|
||||
|
||||
(defun on-key-down (obj event)
|
||||
(let ((app (connection-data-item obj "app-data"))
|
||||
(key (getf event :key)))
|
||||
(key (getf event :key)))
|
||||
(cond ((or (equalp key "ArrowLeft") (equalp key "a"))
|
||||
(setf (snake-direction app) :left))
|
||||
((or (equalp key "ArrowUp") (equalp key "w"))
|
||||
(setf (snake-direction app) :up))
|
||||
((or (equalp key "ArrowDown") (equalp key "s"))
|
||||
(setf (snake-direction app) :down))
|
||||
((or (equalp key "ArrowRight") (equalp key "d"))
|
||||
(setf (snake-direction app) :right)))))
|
||||
|
||||
(setf (snake-direction app) :left))
|
||||
((or (equalp key "ArrowUp") (equalp key "w"))
|
||||
(setf (snake-direction app) :up))
|
||||
((or (equalp key "ArrowDown") (equalp key "s"))
|
||||
(setf (snake-direction app) :down))
|
||||
((or (equalp key "ArrowRight") (equalp key "d"))
|
||||
(setf (snake-direction app) :right)))))
|
||||
|
||||
(defun on-click (obj)
|
||||
(let ((app (connection-data-item obj "app-data"))
|
||||
(btn-txt (text obj)))
|
||||
(btn-txt (text obj)))
|
||||
(cond ((equal btn-txt "<--") (setf (snake-direction app) :left))
|
||||
((equal btn-txt "-->") (setf (snake-direction app) :right))
|
||||
((equal btn-txt "-^-") (setf (snake-direction app) :up))
|
||||
((equal btn-txt "-v-") (setf (snake-direction app) :down)))))
|
||||
((equal btn-txt "-->") (setf (snake-direction app) :right))
|
||||
((equal btn-txt "-^-") (setf (snake-direction app) :up))
|
||||
((equal btn-txt "-v-") (setf (snake-direction app) :down)))))
|
||||
|
||||
(defun start-game (body)
|
||||
(let* ((app (connection-data-item body "app-data"))
|
||||
(disp (create-canvas body
|
||||
:width display-width
|
||||
:height display-height))
|
||||
(br (create-br body))
|
||||
(controls (create-div body))
|
||||
(left-btn (create-button controls :content "<--"))
|
||||
(right-btn (create-button controls :content "-->"))
|
||||
(up-btn (create-button controls :content "-^-"))
|
||||
(down-btn (create-button controls :content "-v-"))
|
||||
context)
|
||||
(disp (create-canvas body
|
||||
:width display-width
|
||||
:height display-height))
|
||||
(br (create-br body))
|
||||
(controls (create-div body))
|
||||
(left-btn (create-button controls :content "<--"))
|
||||
(right-btn (create-button controls :content "-->"))
|
||||
(up-btn (create-button controls :content "-^-"))
|
||||
(down-btn (create-button controls :content "-v-"))
|
||||
context)
|
||||
(declare (ignore br))
|
||||
;; Initialize display
|
||||
(setf (background-color body) :orange)
|
||||
(setf (background-color body) :orange)
|
||||
(setf (display disp) :block)
|
||||
(setf (background-color disp) :white)
|
||||
(set-margin disp :auto :auto :auto :auto)
|
||||
|
|
@ -155,7 +155,7 @@
|
|||
(font-style context "normal 20px sans-serif")
|
||||
(fill-style context :green)
|
||||
(fill-text context (format nil "Score: ~A" (score app))
|
||||
5 (- display-height 15))
|
||||
5 (- display-height 15))
|
||||
(set-on-key-down body #'on-key-down :disable-default t)
|
||||
(set-on-click left-btn #'on-click)
|
||||
(set-on-click right-btn #'on-click)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue