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

style warning corrections

Browse source
This commit is contained in:
David Botton 2021-02-02 01:29:28 -05:00
parent f4b0abe422
commit c2789b85e2
11 changed files with 84 additions and 98 deletions
Download patch file Download diff file Expand all files Collapse all files

32
demos/01-demo.lisp
View file

@ -47,7 +47,6 @@
<br /><br />
Use the arrow keys or a,w,s,d for direction keys.<br/><br/>"))
(ticker (create-span splash)))
(setf (width splash) "100%")
(setf (text-alignment splash) :center)
(dotimes (n 10)
@ -58,19 +57,16 @@
(defun paint (body cx app)
(let ((game-over nil)
(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)))))
(cond ((eq :right (snake-direction app))
(setf head-cell (list (1+ (car head-cell))
(cadr head-cell))))
@ -83,14 +79,11 @@
((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)
@ -101,35 +94,26 @@
(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)))))
(setf (snake app) (butlast (snake app)))))
(fill-style cx :brown)
(draw-segment (food app))))
(draw-segment (food app))))
game-over)))
(defun on-key-down (obj event)
(let ((app (connection-data-item obj "app-data"))
(key-code (getf event :key-code)))
(cond ((or (eql key-code 65) (eql key-code 37)) (setf (snake-direction app) :left))
((or (eql key-code 87) (eql key-code 38)) (setf (snake-direction app) :up))
((or (eql key-code 83) (eql key-code 40)) (setf (snake-direction app) :down))
@ -155,35 +139,29 @@
(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)
(set-border disp :thin :solid :white)
(setf (border-radius disp) "10px")
(setf (box-shadow disp) "3px 3px 5px")
;; Initialize snake
(dotimes (n initial-length)
(push (list n 0) (snake app)))
(setf context (create-context2d disp))
(font-style context "normal 20px sans-serif")
(fill-style context :green)
(fill-text context (format nil "Score: ~A" (score app))
5 (- display-height 15))
(set-on-key-down body #'on-key-down)
(set-on-click left-btn #'on-click)
(set-on-click right-btn #'on-click)
(set-on-click up-btn #'on-click)
(set-on-click down-btn #'on-click)
(play-media (create-audio body :source "/demo/start.wav" :controls nil))
;; Game loop
(loop
(unless (validp body) (return))
@ -193,12 +171,10 @@
(defun on-new-window (body)
(let ((app (make-instance 'app-data)))
(setf (connection-data-item body "app-data") app))
(display-splash body)
(start-game body))
(defun start-demo ()
"Start demo."
(initialize #'on-new-window)
(open-browser))

17
demos/02-demo.lisp
View file

@ -9,6 +9,7 @@
(defun send-message (user msg)
(maphash (lambda (key value)
(declare (ignore key))
(create-span value :content (format nil "~A : ~A<br>" user msg))
(setf (scroll-top value) (scroll-height value)))
*global-list-box-hash*))
@ -16,18 +17,15 @@
(defun on-new-window (body)
(load-css (html-document body) "/css/w3.css")
(setf (title (html-document body)) "CLOG Chat")
(let* ((backdrop (create-div body :class "w3-container w3-cyan"))
(form-box (create-div backdrop :class "w3-container w3-white"))
(start-form (create-form form-box))
(caption (create-section start-form :h3 :content "Sign In"))
(name-entry (create-form-element start-form :input :label
(create-label start-form :content "Chat Handle:")))
(ok-button (create-button start-form :content "OK"))
(tmp (create-p start-form))
(chat-box (create-form form-box))
(tmp (create-br chat-box))
(messages (create-div chat-box))
@ -36,42 +34,37 @@
(out-ok (create-button chat-box :content "OK"))
(tmp (create-p chat-box))
(user-name))
(declare (ignore caption)(ignore tmp))
(setf (hiddenp chat-box) t)
(setf (background-color backdrop) :blue)
(setf (height backdrop) "100vh")
(setf (display backdrop) :flex)
(setf (justify-content backdrop) :center)
(setf (align-items backdrop) :center)
(setf (background-color form-box) :white)
(setf (display backdrop) :flex)
(setf (justify-content backdrop) :center)
(setf (width form-box) "60vh")
(setf (height messages) "70vh")
(setf (width messages) "100%")
(set-border messages :thin :solid :black)
(setf (overflow messages) :scroll)
(set-on-click ok-button
(lambda (obj)
(declare (ignore obj))
(setf (hiddenp start-form) t)
(setf user-name (value name-entry))
(setf (gethash user-name *global-list-box-hash*) messages)
(setf (hiddenp chat-box) nil)))
(set-on-click out-ok
(lambda (obj)
(declare (ignore obj))
(send-message user-name (value out-entry))
(setf (value out-entry) "")))
(run body)
(remhash user-name *global-list-box-hash*)))
(defun start-demo ()
"Start demo."
(initialize #'on-new-window)
(open-browser))