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

Fix touch events to work properly on mobile and desktop and redo tutorial 8

Browse source
This commit is contained in:
David Botton 2024-01-22 00:30:33 -05:00
parent 7e3c5954df
commit dab3046544
2 changed files with 308 additions and 279 deletions
Download patch file Download diff file Expand all files Collapse all files

94
tutorial/08-tutorial.lisp
View file

@ -5,11 +5,11 @@
(in-package :clog-tut-8)
(defclass app-data ()
((in-drag
:accessor in-drag-p
((drag-type
:accessor drag-type
:initform nil
:documentation "Ensure only one box is dragged at a time.")
(drag-x
:documentation "Ensure only pointer or touch events.")
(drag-x
:accessor drag-x
:documentation "The location of the left side of the box relative to mouse during drag.")
(drag-y
@ -17,56 +17,55 @@
:documentation "The location of the top of the box relative to mouse during drag."))
(:documentation "App data specific to each instance of our tutorial 8 app"))
(defun stop-tracking (obj)
(set-on-pointer-move obj nil)
(set-on-pointer-up obj nil)
(set-on-touch-move obj nil)
(set-on-touch-end obj nil)
(let ((app (connection-data-item obj "app-data")))
(setf (drag-type app) nil)))
(defun on-mouse-down (obj data)
(with-sync-event (obj) ; Serialize events to on-mouse-down.
(let ((app (connection-data-item obj "app-data"))) ; Ensure the first event received
(unless (in-drag-p app) ; to drag is the only one, ie only
(setf (in-drag-p app) t) ; the innermost box is dragged.
(let* ((mouse-x (getf data :screen-x)) ; Use the screen coordinates not
(mouse-y (getf data :screen-y)) ; the coordinates relative to the obj
(obj-top (parse-integer (top obj) :junk-allowed t))
(obj-left (parse-integer (left obj) :junk-allowed t)))
(setf (drag-x app) (- mouse-x obj-left))
(setf (drag-y app) (- mouse-y obj-top))
(if (eq (getf data :event-type) :touch)
(progn
(set-on-touch-move obj 'on-mouse-move)
(set-on-touch-end obj 'stop-obj-grab)
(set-on-touch-cancel obj 'on-mouse-leave))
(progn
(set-on-mouse-move obj 'on-mouse-move)
(set-on-mouse-up obj 'stop-obj-grab)
(set-on-mouse-leave obj 'on-mouse-leave))))))))
(let ((app (connection-data-item obj "app-data")))
(with-sync-event (obj) ; Process one event at a time
(when (eq (drag-type app) :pointer) ; Prefer touch events to pointer events
(stop-tracking obj)) ; to accomidate mobile devices emulating mice
(setf (drag-type app) (getf data :event-type))
(let* ((mouse-x (getf data :screen-x)) ; Use the screen coordinates not
(mouse-y (getf data :screen-y)) ; the coordinates relative to the obj
(obj-top (parse-integer (top obj) :junk-allowed t))
(obj-left (parse-integer (left obj) :junk-allowed t)))
(setf (drag-x app) (- mouse-x obj-left))
(setf (drag-y app) (- mouse-y obj-top))
(cond ((eq (getf data :event-type) :touch)
(set-on-touch-move obj 'on-mouse-move)
(set-on-touch-end obj 'on-touch-end))
(t
(set-on-pointer-move obj 'on-mouse-move)
(set-on-pointer-up obj 'on-mouse-up)))))))
(defun on-mouse-move (obj data)
(let* ((app (connection-data-item obj "app-data"))
(x (getf data :screen-x))
(y (getf data :screen-y)))
(x (getf data :screen-x))
(y (getf data :screen-y)))
(setf (top obj) (unit :px (- y (drag-y app))))
(setf (left obj) (unit :px (- x (drag-x app))))))
(defun on-mouse-leave (obj)
(let ((app (connection-data-item obj "app-data")))
(setf (in-drag-p app) nil)
(set-on-touch-move obj nil)
(set-on-touch-end obj nil)
(set-on-touch-cancel obj nil)
(set-on-mouse-move obj nil)
(set-on-mouse-up obj nil)
(set-on-mouse-leave obj nil)))
(defun on-mouse-up (obj data)
(declare (ignore data))
(stop-tracking obj))
(defun stop-obj-grab (obj data)
(on-mouse-move obj data)
(on-mouse-leave obj))
(defun on-touch-end (obj)
(stop-tracking obj))
(defun on-new-window (body)
(let ((app (make-instance 'app-data))) ; Create our "App-Data" for this instance
(setf (connection-data-item body "app-data") app)) ; of our App.
(setf (title (html-document body)) "Tutorial 08")
(let* ((div1 (create-div body))
(div2 (create-div div1))
(div3 (create-div div2))
(dir (create-div div1 :content "<b>Click and drag the boxes</b>")))
(div2 (create-div div1))
(div3 (create-div div2))
(dir (create-div div1 :content "<b>Click and drag the boxes</b>")))
;; Absolute allows fixed positioning relative to parent
(setf (positioning dir) :absolute)
(setf (bottom dir) 0)
@ -85,15 +84,18 @@
;; to the entire window.
(setf (positioning div1) :fixed) ; Its location relative to window
(setf (overflow div1) :hidden) ; Clip the contents
(set-on-touch-start div1 'on-mouse-down)
(set-on-mouse-down div1 'on-mouse-down)
(setf (positioning div2) :absolute) ; Its location relative to its parent container
(setf (overflow div2) :hidden)
(set-on-touch-start div2 'on-mouse-down)
(set-on-mouse-down div2 'on-mouse-down)
(setf (positioning div3) :absolute)
(set-on-touch-start div3 'on-mouse-down)
(set-on-mouse-down div3 'on-mouse-down)))
;; Setup mouse/touch/pointer events
;; Since our divs are embedded on with in the other we use cancel-event so events do
;; not bubble up from one div to another
(set-on-touch-start div1 'on-mouse-down :cancel-event t)
(set-on-touch-start div2 'on-mouse-down :cancel-event t)
(set-on-touch-start div3 'on-mouse-down :cancel-event t)
(set-on-pointer-down div1 'on-mouse-down :cancel-event t :capture-pointer t)
(set-on-pointer-down div2 'on-mouse-down :cancel-event t :capture-pointer t)
(set-on-pointer-down div3 'on-mouse-down :cancel-event t :capture-pointer t)))
(defun start-tutorial ()
"Start turtorial."