mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Fix touch events to work properly on mobile and desktop and redo tutorial 8
This commit is contained in:
David Botton
parent
7e3c5954df
commit
dab3046544
2 changed files with 308 additions and 279 deletions
|
|
@ -118,7 +118,7 @@ flushed with FLUSH-CONNECTION-CACHE or a query is made."
|
|||
(when *connection-cache*
|
||||
(dolist (script (reverse *connection-cache*))
|
||||
(unless (eq script :cache)
|
||||
(clog-connection:execute (connection-id clog-obj) script)))
|
||||
(clog-connection:execute (connection-id clog-obj) script)))
|
||||
(setf *connection-cache* (list :cache))))
|
||||
|
||||
;;;;;;;;;;;;;;
|
||||
|
|
@ -131,7 +131,7 @@ flushed with FLUSH-CONNECTION-CACHE or a query is made."
|
|||
(defmethod js-query ((obj clog-obj) script &key (default-answer nil))
|
||||
(flush-connection-cache obj)
|
||||
(clog-connection:query (connection-id obj) script
|
||||
:default-answer default-answer))
|
||||
:default-answer default-answer))
|
||||
|
||||
;;;;;;;;;;;;;
|
||||
;; execute ;;
|
||||
|
|
@ -154,7 +154,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
|
|||
|
||||
(defmethod query ((obj clog-obj) method &key (default-answer nil))
|
||||
(js-query obj (format nil "~A.~A" (script-id obj) method)
|
||||
:default-answer default-answer))
|
||||
:default-answer default-answer))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; bind-event-script ;;
|
||||
|
|
@ -166,7 +166,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
|
|||
|
||||
(defmethod bind-event-script ((obj clog-obj) event call-back)
|
||||
(jquery-execute obj (format nil "on('~A',function (e, data){~A})"
|
||||
event call-back)))
|
||||
event call-back)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; unbind-event-script ;;
|
||||
|
|
@ -218,18 +218,18 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
|
|||
|
||||
(defparameter touch-event-script
|
||||
"+ (e.touches[0].clientX -
|
||||
e.touches[0].currentTarget.getBoundingClientRect().left +
|
||||
e.touches[0].currentTarget.scrollLeft) + ':' +
|
||||
e.touches[0].target.getBoundingClientRect().left +
|
||||
e.touches[0].target.scrollLeft) + ':' +
|
||||
(e.touches[0].clientY -
|
||||
e.touches[0].currentTarget.getBoundingClientRect().top +
|
||||
e.touches[0].currentTarget.scrollTop) + ':' +
|
||||
e.touches[0].target.getBoundingClientRect().top +
|
||||
e.touches[0].target.scrollTop) + ':' +
|
||||
e.touches[0].screenX + ':' + e.touches[0].screenY + ':' + e.touches.length + ':' +
|
||||
e.altKey + ':' +
|
||||
e.ctrlKey + ':' +
|
||||
e.shiftKey + ':' +
|
||||
e.metaKey + ':' +
|
||||
e.touches[0].clientX + ':' + e.touches[0].clientY + ':' +
|
||||
e..touches[0].pageX + ':' + e.touches[0].pageY"
|
||||
e.touches[0].pageX + ':' + e.touches[0].pageY"
|
||||
"JavaScript to collect touch event data from browser.")
|
||||
|
||||
(defun parse-touch-event (data)
|
||||
|
|
@ -301,8 +301,8 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
|
|||
:shift-key (js-true-p (nth 4 f))
|
||||
:meta-key (js-true-p (nth 5 f))
|
||||
:key (if (equal (nth 6 f) "colon")
|
||||
":"
|
||||
(nth 6 f)))))
|
||||
":"
|
||||
(nth 6 f)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; parse-drop-event ;;
|
||||
|
|
@ -333,39 +333,39 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
|
|||
;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-event (clog-obj event handler
|
||||
&key call-back-script
|
||||
eval-script
|
||||
post-eval
|
||||
cancel-event
|
||||
one-time)
|
||||
&key call-back-script
|
||||
eval-script
|
||||
post-eval
|
||||
cancel-event
|
||||
one-time)
|
||||
(:documentation "Create the hook for incoming events. (Private)"))
|
||||
|
||||
(defmethod set-event ((obj clog-obj) event handler
|
||||
&key (call-back-script "")
|
||||
(eval-script "")
|
||||
(post-eval "")
|
||||
(cancel-event nil)
|
||||
(one-time nil))
|
||||
&key (call-back-script "")
|
||||
(eval-script "")
|
||||
(post-eval "")
|
||||
(cancel-event nil)
|
||||
(one-time nil))
|
||||
(let ((hook (format nil "~A:~A" (html-id obj) event))
|
||||
(cd (connection-data obj)))
|
||||
(cd (connection-data obj)))
|
||||
(if cd
|
||||
(cond (handler
|
||||
(bind-event-script
|
||||
obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]"
|
||||
eval-script
|
||||
hook
|
||||
call-back-script
|
||||
post-eval
|
||||
(when one-time
|
||||
(format nil "; ~A.off('~A')"
|
||||
(jquery obj)
|
||||
event))
|
||||
(when cancel-event "; return false")))
|
||||
(setf (gethash hook cd) handler))
|
||||
(t
|
||||
(unbind-event-script obj event)
|
||||
(remhash hook cd)))
|
||||
(format t "Attempt to set event on non-existant connection.~%"))))
|
||||
(cond (handler
|
||||
(bind-event-script
|
||||
obj event (format nil "~Aws.send('E:~A '~A)~A~@[~A~]~@[~A~]"
|
||||
eval-script
|
||||
hook
|
||||
call-back-script
|
||||
post-eval
|
||||
(when one-time
|
||||
(format nil "; ~A.off('~A')"
|
||||
(jquery obj)
|
||||
event))
|
||||
(when cancel-event "; return false")))
|
||||
(setf (gethash hook cd) handler))
|
||||
(t
|
||||
(unbind-event-script obj event)
|
||||
(remhash hook cd)))
|
||||
(format t "Attempt to set event on non-existant connection.~%"))))
|
||||
|
||||
;;;;;;;;;;;;;;
|
||||
;; property ;;
|
||||
|
|
@ -376,15 +376,15 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)"))
|
|||
|
||||
(defmethod property ((obj clog-obj) property-name &key (default-answer nil))
|
||||
(jquery-query obj (format nil "prop('~A')" property-name)
|
||||
:default-answer default-answer))
|
||||
:default-answer default-answer))
|
||||
|
||||
(defgeneric (setf property) (value clog-obj property-name)
|
||||
(:documentation "Set html property."))
|
||||
|
||||
(defmethod (setf property) (value (obj clog-obj) property-name)
|
||||
(jquery-execute obj (format nil "prop('~A','~A')"
|
||||
property-name
|
||||
(escape-string value)))
|
||||
property-name
|
||||
(escape-string value)))
|
||||
value)
|
||||
|
||||
;;;;;;;;;;;;
|
||||
|
|
@ -529,21 +529,21 @@ an application share per connection the same queue of serialized events."
|
|||
;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-event (clog-obj event-name handler
|
||||
&key cancel-event one-time)
|
||||
&key cancel-event one-time)
|
||||
(:documentation "Set a HANDLER for EVENT-NAME on CLOG-OBJ. If handler is
|
||||
nil unbind all event handlers. (Internal)"))
|
||||
|
||||
(defmethod set-on-event ((obj clog-obj) event-name handler
|
||||
&key
|
||||
(cancel-event nil)
|
||||
(one-time nil))
|
||||
&key
|
||||
(cancel-event nil)
|
||||
(one-time nil))
|
||||
(set-event obj event-name
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event cancel-event
|
||||
:one-time one-time))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event cancel-event
|
||||
:one-time one-time))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -551,23 +551,23 @@ nil unbind all event handlers. (Internal)"))
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-event-with-data (clog-obj event-name handler
|
||||
&key cancel-event one-time)
|
||||
&key cancel-event one-time)
|
||||
(:documentation "Set a HANDLER for EVENT-NAME on CLOG-OBJ.
|
||||
If handler is nil unbind all event handlers. Handler is called with a data
|
||||
option passed from javascript calling the jQuery custom event mechanism
|
||||
.trigger('event_name', data) (Internal)"))
|
||||
|
||||
(defmethod set-on-event-with-data ((obj clog-obj) event-name handler
|
||||
&key
|
||||
(cancel-event nil)
|
||||
(one-time nil))
|
||||
&key
|
||||
(cancel-event nil)
|
||||
(one-time nil))
|
||||
(set-event obj event-name
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj data)))
|
||||
:call-back-script "+data"
|
||||
:cancel-event cancel-event
|
||||
:one-time one-time))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj data)))
|
||||
:call-back-script "+data"
|
||||
:cancel-event cancel-event
|
||||
:one-time one-time))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-resize ;;
|
||||
|
|
@ -630,21 +630,21 @@ is nil unbind the event."))
|
|||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-drag-start (clog-obj on-drag-start-handler
|
||||
&key drag-data drag-type)
|
||||
&key drag-data drag-type)
|
||||
(:documentation "Set the ON-DRAG-START-HANDLER for CLOG-OBJ.
|
||||
If ON-DRAG-START-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-drag-start ((obj clog-obj) handler
|
||||
&key (drag-data "") (drag-type "text/plain"))
|
||||
&key (drag-data "") (drag-type "text/plain"))
|
||||
(set-event obj "dragstart"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:eval-script (format nil
|
||||
"e.originalEvent.dataTransfer.setData('~A','~A'); "
|
||||
drag-type
|
||||
drag-data)))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:eval-script (format nil
|
||||
"e.originalEvent.dataTransfer.setData('~A','~A'); "
|
||||
drag-type
|
||||
drag-data)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;
|
||||
;; set-on-drag ;;
|
||||
|
|
@ -701,12 +701,12 @@ is nil unbind the event."))
|
|||
|
||||
(defmethod set-on-drag-over ((obj clog-obj) handler)
|
||||
(set-event obj "dragover"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event t
|
||||
:eval-script "e.preventDefault(); "))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event t
|
||||
:eval-script "e.preventDefault(); "))
|
||||
|
||||
;;;;;;;;;;;;;;;;;
|
||||
;; set-on-drop ;;
|
||||
|
|
@ -718,12 +718,12 @@ is nil unbind the event."))
|
|||
|
||||
(defmethod set-on-drop ((obj clog-obj) handler &key (drag-type "text/plain"))
|
||||
(set-event obj "drop"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-drop-event data))))
|
||||
:call-back-script (format nil drop-event-script drag-type)
|
||||
:eval-script "e.preventDefault(); "
|
||||
:cancel-event t))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-drop-event data))))
|
||||
:call-back-script (format nil drop-event-script drag-type)
|
||||
:eval-script "e.preventDefault(); "
|
||||
:cancel-event t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-focus-in ;;
|
||||
|
|
@ -758,11 +758,11 @@ this event is bound, you must call the form reset manually."))
|
|||
|
||||
(defmethod set-on-reset ((obj clog-obj) handler)
|
||||
(set-event obj "reset"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event t))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-search ;;
|
||||
|
|
@ -798,18 +798,18 @@ form action to be run. See CLOG-Form SUBMIT for more details."))
|
|||
|
||||
(defmethod set-on-submit ((obj clog-obj) handler)
|
||||
(set-event obj "submit"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event t))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:cancel-event t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-context-menu ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-context-menu (clog-obj on-context-menu-handler
|
||||
&key one-time)
|
||||
&key one-time)
|
||||
(:documentation "Set the ON-CONTEXT-MENU-HANDLER for CLOG-OBJ. If
|
||||
ON-CONTEXT-MENU-HANDLER is nil unbind the event. Setting
|
||||
on-mouse-right-click will replace this handler. If :ONE-TIME unbind
|
||||
|
|
@ -817,29 +817,29 @@ event on right click."))
|
|||
|
||||
(defmethod set-on-context-menu ((obj clog-obj) handler &key (one-time nil))
|
||||
(set-event obj "contextmenu"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:one-time one-time
|
||||
:cancel-event t))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:one-time one-time
|
||||
:cancel-event t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-click ;;
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-click (clog-obj on-click-handler &key one-time)
|
||||
(defgeneric set-on-click (clog-obj on-click-handler &key one-time cancel-event)
|
||||
(:documentation "Set the ON-CLICK-HANDLER for CLOG-OBJ. If ON-CLICK-HANDLER
|
||||
is nil unbind the event. Setting this event will replace an on-mouse click if
|
||||
set. If :ONE-TIME unbind event on click."))
|
||||
|
||||
(defmethod set-on-click ((obj clog-obj) handler &key one-time cancel-event)
|
||||
(set-event obj "click"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:one-time one-time
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -847,18 +847,18 @@ set. If :ONE-TIME unbind event on click."))
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-double-click (clog-obj on-double-click-handler
|
||||
&key one-time cancel-event)
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If
|
||||
ON-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting the
|
||||
on-mouse-double-click event will replace this handler."))
|
||||
|
||||
(defmethod set-on-double-click ((obj clog-obj) handler &key one-time cancel-event)
|
||||
(set-event obj "dblclick"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:one-time one-time
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore data))
|
||||
(funcall handler obj)))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -872,50 +872,50 @@ on an on-click event."))
|
|||
|
||||
(defmethod set-on-mouse-click ((obj clog-obj) handler &key one-time cancel-event)
|
||||
(set-event obj "click"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script mouse-event-script))
|
||||
:call-back-script mouse-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-mouse-double-click ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-mouse-double-click (clog-obj on-mouse-double-click-handler
|
||||
&key one-time)
|
||||
&key one-time)
|
||||
(:documentation "Set the ON-MOUSE-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If
|
||||
ON-MOUSE-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting this event will
|
||||
replace on an on-double-click event."))
|
||||
|
||||
(defmethod set-on-mouse-double-click ((obj clog-obj) handler &key (one-time nil))
|
||||
(set-event obj "dblclick"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:call-back-script mouse-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:call-back-script mouse-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-mouse-right-click ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-mouse-right-click (clog-obj on-mouse-right-click-handler
|
||||
&key one-time)
|
||||
&key one-time)
|
||||
(:documentation "Set the ON-MOUSE-RIGHT-CLICK-HANDLER for CLOG-OBJ. If
|
||||
ON-MOUSE-RIGHT-CLICK-HANDLER is nil unbind the event. Setting this event will
|
||||
replace on an on-context-menu event."))
|
||||
|
||||
(defmethod set-on-mouse-right-click ((obj clog-obj) handler
|
||||
&key (one-time nil))
|
||||
&key (one-time nil))
|
||||
(set-event obj "contextmenu"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:call-back-script mouse-event-script
|
||||
:cancel-event t))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:call-back-script mouse-event-script
|
||||
:cancel-event t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-mouse-enter ;;
|
||||
|
|
@ -966,50 +966,58 @@ If ON-MOUSE-OVER-HANDLER is nil unbind the event."))
|
|||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-mouse-down (clog-obj on-mouse-down-handler
|
||||
&key one-time cancel-event)
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-MOUSE-DOWN-HANDLER for CLOG-OBJ. If
|
||||
ON-MOUSE-DOWN-HANDLER is nil unbind the event. If cancel-event is true event
|
||||
does not bubble."))
|
||||
|
||||
(defmethod set-on-mouse-down ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "mousedown"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script mouse-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script mouse-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-mouse-up ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-mouse-up (clog-obj on-mouse-up-handler)
|
||||
(defgeneric set-on-mouse-up (clog-obj on-mouse-up-handler
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-MOUSE-UP-HANDLER for CLOG-OBJ. If
|
||||
ON-MOUSE-UP-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-mouse-up ((obj clog-obj) handler)
|
||||
(defmethod set-on-mouse-up ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "mouseup"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:call-back-script mouse-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script mouse-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-mouse-move ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-mouse-move (clog-obj on-mouse-move-handler)
|
||||
(defgeneric set-on-mouse-move (clog-obj on-mouse-move-handler
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-MOUSE-MOVE-HANDLER for CLOG-OBJ. If
|
||||
ON-MOUSE-MOVE-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-mouse-move ((obj clog-obj) handler)
|
||||
(defmethod set-on-mouse-move ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "mousemove"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:call-back-script mouse-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-mouse-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script mouse-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-pointer-enter ;;
|
||||
|
|
@ -1060,104 +1068,123 @@ ON-MOUSE-MOVE-HANDLER is nil unbind the event."))
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-pointer-down (clog-obj on-pointer-down-handler
|
||||
&key capture-pointer one-time cancel-event)
|
||||
&key capture-pointer one-time cancel-event)
|
||||
(:documentation "Set the ON-POINTER-DOWN-HANDLER for CLOG-OBJ. If
|
||||
ON-POINTER-DOWN-HANDLER is nil unbind the event. If cancel event is t the
|
||||
even does not bubble."))
|
||||
|
||||
(defmethod set-on-pointer-down ((obj clog-obj) handler
|
||||
&key (capture-pointer nil)
|
||||
(one-time nil)
|
||||
(cancel-event nil))
|
||||
&key (capture-pointer nil)
|
||||
(one-time nil)
|
||||
(cancel-event nil))
|
||||
(set-event obj "pointerdown"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-pointer-event data))))
|
||||
:post-eval (if capture-pointer
|
||||
(format nil "; ~A.setPointerCapture(e.pointerId)"
|
||||
(script-id obj))
|
||||
"")
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script pointer-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-pointer-event data))))
|
||||
:post-eval (if capture-pointer
|
||||
(format nil "; ~A.setPointerCapture(e.pointerId)"
|
||||
(script-id obj))
|
||||
"")
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script pointer-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-pointer-up ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-pointer-up (clog-obj on-pointer-up-handler)
|
||||
(defgeneric set-on-pointer-up (clog-obj on-pointer-up-handler
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-POINTER-UP-HANDLER for CLOG-OBJ. If
|
||||
ON-POINTER-UP-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-pointer-up ((obj clog-obj) handler)
|
||||
(defmethod set-on-pointer-up ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "pointerup"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-pointer-event data))))
|
||||
:post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)"
|
||||
(script-id obj))
|
||||
:call-back-script pointer-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-pointer-event data))))
|
||||
:post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)"
|
||||
(script-id obj))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script pointer-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-pointer-move ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-pointer-move (clog-obj on-pointer-move-handler)
|
||||
(defgeneric set-on-pointer-move (clog-obj on-pointer-move-handler
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-POINTER-MOVE-HANDLER for CLOG-OBJ. If
|
||||
ON-POINTER-MOVE-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-pointer-move ((obj clog-obj) handler)
|
||||
(defmethod set-on-pointer-move ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "pointermove"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-pointer-event data))))
|
||||
:call-back-script pointer-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-pointer-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script pointer-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-touch-start ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-touch-start (clog-obj on-touch-start-handler &key one-time)
|
||||
(defgeneric set-on-touch-start (clog-obj on-touch-start-handler
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-TOUCH-START-HANDLER for CLOG-OBJ. If
|
||||
ON-TOUCH-START-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-touch-start ((obj clog-obj) handler &key (one-time nil))
|
||||
(defmethod set-on-touch-start ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "touchstart"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-touch-event data))))
|
||||
:one-time one-time
|
||||
:call-back-script touch-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-touch-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script touch-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-touch-move ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-touch-move (clog-obj on-touch-move-handler)
|
||||
(defgeneric set-on-touch-move (clog-obj on-touch-move-handler
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-TOUCH-MOVE-HANDLER for CLOG-OBJ. If
|
||||
ON-TOUCH-MOVE-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-touch-move ((obj clog-obj) handler)
|
||||
(defmethod set-on-touch-move ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "touchmove"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-touch-event data))))
|
||||
:call-back-script touch-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-touch-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event
|
||||
:call-back-script touch-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-touch-end ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-touch-end (clog-obj on-touch-end-handler)
|
||||
(defgeneric set-on-touch-end (clog-obj on-touch-end-handler
|
||||
&key one-time cancel-event)
|
||||
(:documentation "Set the ON-TOUCH-END-HANDLER for CLOG-OBJ. If
|
||||
ON-TOUCH-END-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-touch-end ((obj clog-obj) handler)
|
||||
(defmethod set-on-touch-end ((obj clog-obj) handler
|
||||
&key (one-time nil) (cancel-event nil))
|
||||
(set-event obj "touchend"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-touch-event data))))
|
||||
:call-back-script touch-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore dara))
|
||||
(funcall handler obj)))
|
||||
:one-time one-time
|
||||
:cancel-event cancel-event))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-touch-cancel ;;
|
||||
|
|
@ -1169,52 +1196,52 @@ ON-TOUCH-CANCEL-HANDLER is nil unbind the event."))
|
|||
|
||||
(defmethod set-on-touch-cancel ((obj clog-obj) handler)
|
||||
(set-event obj "touchcancel"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-touch-event data))))
|
||||
:call-back-script touch-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(declare (ignore dara))
|
||||
(funcall handler obj)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-character ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-character (clog-obj on-character-handler
|
||||
&key one-time disable-default)
|
||||
&key one-time disable-default)
|
||||
(:documentation "Set the ON-CHARACTER-HANDLER for CLOG-OBJ. If
|
||||
ON-CHARACTER-HANDLER is nil unbind the event. If disable-default is t
|
||||
default key bindings in browser will not occur. Setting this event to
|
||||
nil will unbind on-key-press also."))
|
||||
|
||||
(defmethod set-on-character ((obj clog-obj) handler
|
||||
&key (one-time nil) (disable-default nil))
|
||||
&key (one-time nil) (disable-default nil))
|
||||
(set-event obj "keypress"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(let ((f (parse-keyboard-event data)))
|
||||
(funcall handler obj (code-char (getf f :char-code))))))
|
||||
:one-time one-time
|
||||
:cancel-event disable-default
|
||||
:call-back-script keyboard-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(let ((f (parse-keyboard-event data)))
|
||||
(funcall handler obj (code-char (getf f :char-code))))))
|
||||
:one-time one-time
|
||||
:cancel-event disable-default
|
||||
:call-back-script keyboard-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-key-down ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-key-down (clog-obj on-key-down-handler
|
||||
&key one-time disable-default)
|
||||
&key one-time disable-default)
|
||||
(:documentation "Set the ON-KEY-DOWN-HANDLER for CLOG-OBJ. If
|
||||
disable-default is t default key bindings in browser will not occur.
|
||||
If ON-KEY-DOWN-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-key-down ((obj clog-obj) handler
|
||||
&key (one-time nil) (disable-default nil))
|
||||
&key (one-time nil) (disable-default nil))
|
||||
(set-event obj "keydown"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-keyboard-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event disable-default
|
||||
:call-back-script keyboard-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-keyboard-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event disable-default
|
||||
:call-back-script keyboard-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-key-up ;;
|
||||
|
|
@ -1226,30 +1253,30 @@ ON-KEY-UP-HANDLER is nil unbind the event."))
|
|||
|
||||
(defmethod set-on-key-up ((obj clog-obj) handler &key (one-time nil))
|
||||
(set-event obj "keyup"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-keyboard-event data))))
|
||||
:one-time one-time
|
||||
:call-back-script keyboard-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-keyboard-event data))))
|
||||
:one-time one-time
|
||||
:call-back-script keyboard-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; set-on-key-press ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric set-on-key-press (clog-obj on-key-press-handler
|
||||
&key one-time disable-default)
|
||||
&key one-time disable-default)
|
||||
(:documentation "Set the ON-KEY-PRESS-HANDLER for CLOG-OBJ. If
|
||||
ON-KEY-PRESS-HANDLER is nil unbind the event."))
|
||||
|
||||
(defmethod set-on-key-press ((obj clog-obj) handler
|
||||
&key (one-time nil) (disable-default nil))
|
||||
&key (one-time nil) (disable-default nil))
|
||||
(set-event obj "keypress"
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-keyboard-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event disable-default
|
||||
:call-back-script keyboard-event-script))
|
||||
(when handler
|
||||
(lambda (data)
|
||||
(funcall handler obj (parse-keyboard-event data))))
|
||||
:one-time one-time
|
||||
:cancel-event disable-default
|
||||
:call-back-script keyboard-event-script))
|
||||
|
||||
;;;;;;;;;;;;;;;;;
|
||||
;; set-on-copy ;;
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue