Drag and Drop

README.md

@@ -143,6 +143,7 @@ Tutorial Summary
 - 15-tutorial.lisp - Multi-media
 - 16-tutorial.lisp - Bootstrap 4, Loading css files and javascript
 - 17-tutorial.lisp - W3.CSS layout example and Form submit methods
+- 18-tutorial.lisp - Drag and Drop
 
 Demo Summary
 

clog-base.lisp

@@ -224,19 +224,41 @@ result. (Private)"))
      :shift-key  (js-true-p (nth 4 f))
      :meta-key   (js-true-p (nth 5 f)))))
 
+;;;;;;;;;;;;;;;;;;;;;;
+;; parse-drop-event ;;
+;;;;;;;;;;;;;;;;;;;;;;
+
+(defparameter drop-event-script
+  "+ (e.clientX - e.target.getBoundingClientRect().left) + ':' + 
+     (e.clientY - e.target.getBoundingClientRect().top) + ':' +
+     encodeURIComponent(e.originalEvent.dataTransfer.getData('~A'))"
+  "JavaScript to collect drop event data from browser.")
+
+(defun parse-drop-event (data)
+  (let ((f (ppcre:split ":" data)))
+    (list
+     :event-type   :mouse
+     :x            (parse-integer (nth 0 f) :junk-allowed t)
+     :y            (parse-integer (nth 1 f) :junk-allowed t)
+     :drag-data    (quri:url-decode (or (nth 2 f) "")))))
+
 ;;;;;;;;;;;;;;;
 ;; set-event ;;
 ;;;;;;;;;;;;;;;
 
-(defgeneric set-event (clog-obj event handler &key call-back-script)
+(defgeneric set-event (clog-obj event handler
+		       &key call-back-script eval-script)
   (:documentation "Create the hook for incoming events. (Private)"))
 
 (defmethod set-event ((obj clog-obj) event handler
-		      &key (call-back-script "") (cancel-event nil))
+		      &key (call-back-script "")
+			(eval-script "")
+			(cancel-event nil))
   (let ((hook (format nil "~A:~A" (html-id obj) event)))
     (cond (handler
 	   (bind-event-script
-	    obj event (format nil "ws.send('E:~A-'~A)~A"
+	    obj event (format nil "~Aws.send('E:~A-'~A)~A"
+			      eval-script
 			      hook
 			      call-back-script
 			      (if cancel-event
@@ -426,6 +448,120 @@ is nil unbind the event."))
 		 (declare (ignore data))
 		 (funcall handler obj)))))
 
+;;;;;;;;;;;;;;;;;;;;;;;
+;; set-on-drag-start ;;
+;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric set-on-drag-start (clog-obj on-drag-start-handler &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"))
+  (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)))
+
+;;;;;;;;;;;;;;;;;
+;; set-on-drag ;;
+;;;;;;;;;;;;;;;;;
+
+(defgeneric set-on-drag (clog-obj on-drag-handler)
+  (:documentation "Set the ON-DRAG-HANDLER for CLOG-OBJ. If ON-DRAG-HANDLER
+is nil unbind the event."))
+
+(defmethod set-on-drag ((obj clog-obj) handler)
+  (set-event obj "drag"
+	     (when handler
+	       (lambda (data)
+		 (declare (ignore data))
+		 (funcall handler obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; set-on-drag-end ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric set-on-drag-end (clog-obj on-drag-end-handler)
+  (:documentation "Set the ON-DRAG-END-HANDLER for CLOG-OBJ. If ON-DRAG-END-HANDLER
+is nil unbind the event."))
+
+(defmethod set-on-drag-end ((obj clog-obj) handler)
+  (set-event obj "dragend"
+	     (when handler
+	       (lambda (data)
+		 (declare (ignore data))
+		 (funcall handler obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;
+;; set-on-drag-enter ;;
+;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric set-on-drag-enter (clog-obj on-drag-enter-handler)
+  (:documentation "Set the ON-DRAG-ENTER-HANDLER for CLOG-OBJ. If ON-DRAG-ENTER-HANDLER
+is nil unbind the event."))
+
+(defmethod set-on-drag-enter ((obj clog-obj) handler)
+  (set-event obj "dragenter"
+	     (when handler
+	       (lambda (data)
+		 (declare (ignore data))
+		 (funcall handler obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;
+;; set-on-drag-leave ;;
+;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric set-on-drag-leave (clog-obj on-drag-leave-handler)
+  (:documentation "Set the ON-DRAG-LEAVE-HANDLER for CLOG-OBJ. If ON-DRAG-LEAVE-HANDLER
+is nil unbind the event."))
+
+(defmethod set-on-drag-leave ((obj clog-obj) handler)
+  (set-event obj "dragleave"
+	     (when handler
+	       (lambda (data)
+		 (declare (ignore data))
+		 (funcall handler obj)))))
+
+;;;;;;;;;;;;;;;;;;;;;;
+;; set-on-drag-over ;;
+;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric set-on-drag-over (clog-obj on-drag-over-handler)
+  (:documentation "Set the ON-DRAG-OVER-HANDLER for CLOG-OBJ. If ON-DRAG-OVER-HANDLER
+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(); "))
+
+;;;;;;;;;;;;;;;;;
+;; set-on-drop ;;
+;;;;;;;;;;;;;;;;;
+
+(defgeneric set-on-drop (clog-obj on-drop-handler &key drag-type)
+  (:documentation "Set the ON-DROP-HANDLER for CLOG-OBJ. If ON-DROP-HANDLER
+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))
+
 ;;;;;;;;;;;;;;;;;;;;;
 ;; set-on-focus-in ;;
 ;;;;;;;;;;;;;;;;;;;;;

clog-window.lisp

@@ -477,9 +477,9 @@ If ON-ORIENTATION-CHANGE-HANDLER is nil unbind the event."))
   (let ((f (ppcre:split ":" data)))
     (list
      :event-type :storage
-     :key        (quri:url-decode (nth 0 f))
+     :key        (quri:url-decode (or (nth 0 f) ""))
-     :old-value  (quri:url-decode (nth 1 f))
+     :old-value  (quri:url-decode (or (nth 1 f) ""))
-     :value      (quri:url-decode (nth 2 f)))))
+     :value      (quri:url-decode (or (nth 2 f) "")))))
 
 (defgeneric set-on-storage (clog-window on-storage-handler)
   (:documentation "Set the ON-STORAGE-HANDLER for CLOG-OBJ. The

clog.lisp

@@ -88,6 +88,13 @@ embedded in a native template application.)"
   (set-on-focus              generic-function)
   (set-on-blur               generic-function)
   (set-on-change             generic-function)
+  (set-on-drag-start         generic-function)
+  (set-on-drag               generic-function)
+  (set-on-drag-end           generic-function)
+  (set-on-drag-enter         generic-function)
+  (set-on-drag-leave         generic-function)
+  (set-on-drag-over          generic-function) 
+  (set-on-drop               generic-function)
   (set-on-focus-in           generic-function)
   (set-on-focus-out          generic-function)
   (set-on-reset              generic-function)
@@ -119,7 +126,6 @@ embedded in a native template application.)"
   (set-on-copy               generic-function)
   (set-on-cut                generic-function)
   (set-on-paste              generic-function))
-;; need to add drag and drop events
 
 (defsection @clog-element (:title "CLOG Elements")
   "CLOG-Element - Class for CLOG Elements"

tutorial/18-tutorial.lisp

@@ -0,0 +1,57 @@
+(defpackage #:clog-user
+  (:use #:cl #:clog)
+  (:export start-tutorial))
+
+(in-package :clog-user)
+
+(defun on-new-window (body)
+  (let* ((target1 (create-div body))
+	 (target2 (create-div body))
+	 (object  (create-div target1)))
+
+    (setf (positioning target1) :fixed)
+    (setf (top target1) "10px")
+    (setf (left target1) "10px")
+    (setf (width target1) "100px")
+    (setf (height target1) "100px")
+    (setf (background-color target1) :yellow)
+    
+    (setf (positioning target2) :fixed)
+    (setf (top target2) "10px")
+    (setf (left target2) "140px")
+    (setf (width target2) "100px")
+    (setf (height target2) "100px")
+    (setf (background-color target2) :yellow)
+    
+    (setf (positioning object) :absolute)
+    (setf (top object) "10px")
+    (setf (left object) "10px")
+    (setf (width object) "50px")
+    (setf (height object) "50px")
+    (setf (background-color object) :green)
+
+    ;; To allow for drag and drop requires:
+    ;;
+    ;; 1 object is draggable
+    (setf (draggablep object) t)
+    ;; 2 the on-drag-start event is set
+    (set-on-drag-start object (lambda (obj)()) :drag-data "some data")
+
+    ;; 4 the target on-drag-over event is sett
+    (set-on-drag-over target1 (lambda (obj)()))
+    ;; 5 the target on-drop event is set
+    (set-on-drop target1 (lambda (obj data)
+			   (place-inside-bottom-of target1 object)))
+    
+    (set-on-drag-over target2 (lambda (obj)()))
+    (set-on-drop target2 (lambda (obj data)
+			   (print (getf data :drag-data))
+			   (place-inside-bottom-of target2 object)))
+    
+  (run body)))
+
+(defun start-tutorial ()
+  "Start turtorial."
+
+  (initialize #'on-new-window)
+  (open-browser))

tutorial/README.md

@@ -50,3 +50,4 @@ Tutorial Summary
 - 15-tutorial.lisp - Multi-media
 - 16-tutorial.lisp - Bootstrap 4, Loading css files and javascript
 - 17-tutorial.lisp - W3.CSS layout example and Form submit methods
+- 18-tutorial.lisp - Drag and Drop