diff --git a/clog-helpers.lisp b/clog-helpers.lisp index 726aa75..96a6826 100644 --- a/clog-helpers.lisp +++ b/clog-helpers.lisp @@ -8,10 +8,6 @@ (cl:in-package :clog) -(defpackage #:clog-user - (:use #:cl #:clog) - (:export start-tutorial start-demo)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - CLOG Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -42,7 +38,7 @@ (defun run-tutorial (num) "Run tutorial NUM" (load-tutorial num) - (clog-user:start-tutorial)) + (funcall (symbol-function (find-symbol "START-TUTORIAL" "CLOG-USER")))) ;;;;;;;;;;;;;;;;;;; ;; load-tutorial ;; @@ -62,7 +58,7 @@ (defun run-demo (num) "Run demo NUM" (load-demo num) - (clog-user:start-demo)) + (funcall (symbol-function (find-symbol "START-DEMO" "CLOG-USER")))) ;;;;;;;;;;;;;;; ;; load-demo ;; diff --git a/demos/01-demo.lisp b/demos/01-demo.lisp index fa9af58..b2a14aa 100644 --- a/demos/01-demo.lisp +++ b/demos/01-demo.lisp @@ -47,7 +47,6 @@

Use the arrow keys or a,w,s,d for direction keys.

")) (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)) diff --git a/demos/02-demo.lisp b/demos/02-demo.lisp index beda948..c95d2f5 100644 --- a/demos/02-demo.lisp +++ b/demos/02-demo.lisp @@ -9,6 +9,7 @@ (defun send-message (user msg) (maphash (lambda (key value) + (declare (ignore key)) (create-span value :content (format nil "~A : ~A
" 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)) diff --git a/doc/clog-manual.html b/doc/clog-manual.html index a51ea06..7c29749 100644 --- a/doc/clog-manual.html +++ b/doc/clog-manual.html @@ -349,6 +349,14 @@ function. If BOOT-FILE is nil path is removed.

Shutdown CLOG.

+

+ + +

← ↑ → ↺

@@ -974,11 +982,11 @@ element objects.

@@ -2313,7 +2321,7 @@ to no actual HTML elemen.