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

add some buttons for iphone

Browse source
This commit is contained in:
David Botton 2021-01-17 14:01:06 -05:00
parent 1f78c38f69
commit 4a2e6eb1e9
1 changed files with 25 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -5,8 +5,8 @@
(in-package :clog-user) (in-package :clog-user)
;; Game Display ;; Game Display
(defconstant display-width 400) (defconstant display-width 375)
(defconstant display-height 400) (defconstant display-height 375)
;; Snake Parameters ;; Snake Parameters
(defconstant initial-length 5) (defconstant initial-length 5)
@ -132,13 +132,26 @@
((or (eql key-code 83) (eql key-code 40)) (setf (snake-direction app) :down)) ((or (eql key-code 83) (eql key-code 40)) (setf (snake-direction app) :down))
((or (eql key-code 68) (eql key-code 39)) (setf (snake-direction app) :right))))) ((or (eql key-code 68) (eql key-code 39)) (setf (snake-direction app) :right)))))
(defun on-click (obj)
(let ((app (connection-data-item obj "app-data"))
(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)))))
(defun start-game (body) (defun start-game (body)
(let ((app (connection-data-item body "app-data")) (let* ((app (connection-data-item body "app-data"))
(disp (create-canvas body (disp (create-canvas body
:width display-width :width display-width
:height display-height)) :height display-height))
context) (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)
;; Initialize display ;; Initialize display
(setf (background-color body) :orange) (setf (background-color body) :orange)
@ -160,7 +173,11 @@
(fill-text context (format nil "Score: ~A" (score app)) (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) (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)
;; Game loop ;; Game loop
(loop (loop