From a4a25c96a647669dbd65e688c075ebd23e22766c Mon Sep 17 00:00:00 2001 From: David Botton Date: Sun, 7 Feb 2021 23:53:43 -0500 Subject: [PATCH] improvements to windowing --- clog-base.lisp | 10 +++++---- clog-element.lisp | 10 +++++++++ clog.lisp | 11 +++++----- demos/03-demo.lisp | 39 ++++++++++++++++++------------------ static-files/demo/frame.html | 20 ++++++++++-------- 5 files changed, 54 insertions(+), 36 deletions(-) diff --git a/clog-base.lisp b/clog-base.lisp index 427442b..2ca7ff2 100644 --- a/clog-base.lisp +++ b/clog-base.lisp @@ -885,15 +885,16 @@ is nil unbind the event.")) ;; set-on-mouse-down ;; ;;;;;;;;;;;;;;;;;;;;;;; -(defgeneric set-on-mouse-down (clog-obj on-mouse-down-handler) +(defgeneric set-on-mouse-down (clog-obj on-mouse-down-handler &key one-time) (:documentation "Set the ON-MOUSE-DOWN-HANDLER for CLOG-OBJ. If ON-MOUSE-DOWN-HANDLER is nil unbind the event.")) -(defmethod set-on-mouse-down ((obj clog-obj) handler) +(defmethod set-on-mouse-down ((obj clog-obj) handler &key (one-time nil)) (set-event obj "mousedown" (when handler (lambda (data) (funcall handler obj (parse-mouse-event data)))) + :one-time one-time :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;; @@ -991,12 +992,12 @@ is nil unbind the event.")) ;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-pointer-down (clog-obj on-pointer-down-handler - &key capture-pointer) + &key capture-pointer one-time) (:documentation "Set the ON-POINTER-DOWN-HANDLER for CLOG-OBJ. If ON-POINTER-DOWN-HANDLER is nil unbind the event.")) (defmethod set-on-pointer-down ((obj clog-obj) handler - &key (capture-pointer nil)) + &key (capture-pointer nil) (one-time nil)) (set-event obj "pointerdown" (when handler (lambda (data) @@ -1005,6 +1006,7 @@ ON-POINTER-DOWN-HANDLER is nil unbind the event.")) (format nil "; ~A.setPointerCapture(e.pointerId)" (script-id obj)) "") + :one-time one-time :call-back-script pointer-event-script)) ;;;;;;;;;;;;;;;;;;;;;;; diff --git a/clog-element.lisp b/clog-element.lisp index 96e012a..dd57d17 100644 --- a/clog-element.lisp +++ b/clog-element.lisp @@ -2095,6 +2095,16 @@ A list of standard cursor types can be found at: (defmethod remove-from-dom ((obj clog-element)) (jquery-execute obj "remove()")) +;;;;;;;;;;;;;;;;;;;;;; +;; remove-from-clog ;; +;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric remove-from-clog (clog-element) + (:documentation "Remove CLOG-Element from the clog cache on browser.")) + +(defmethod remove-from-clog ((obj clog-element)) + (js-execute obj (format nil "~A=null;" (script-id obj)))) + ;;;;;;;;;;; ;; click ;; ;;;;;;;;;;; diff --git a/clog.lisp b/clog.lisp index 5792c3d..ef2a353 100644 --- a/clog.lisp +++ b/clog.lisp @@ -306,11 +306,12 @@ embedded in a native template application.)" (vertical-align generic-function) "CLOG-Element - Methods" - (add-class generic-function) - (remove-class generic-function) - (toggle-class generic-function) - (remove-from-dom generic-function) - (click generic-function) + (add-class generic-function) + (remove-class generic-function) + (toggle-class generic-function) + (remove-from-dom generic-function) + (remove-from-clog generic-function) + (click generic-function) "CLOG-Element - DOM Traversal Methods" (parent-element generic-function) diff --git a/demos/03-demo.lisp b/demos/03-demo.lisp index 1d6cc41..d0bf6bb 100644 --- a/demos/03-demo.lisp +++ b/demos/03-demo.lisp @@ -34,7 +34,6 @@ (drag-obj (attach-as-child obj id-drag)) (pointer-x (getf data ':screen-x)) (pointer-y (getf data ':screen-y)) - ;; (z (parse-integer (z-index drag-obj) :junk-allowed t)) (obj-top) (obj-left)) (if (equalp (in-drag app) "m") @@ -53,16 +52,19 @@ (defun on-ide-drag-move (obj data) (let* ((app (connection-data-item obj "app-data")) (drag-obj (attach-as-child obj (attribute obj "data-drag-obj"))) - (x (getf data ':screen-x)) - (y (getf data ':screen-y))) - (if (equalp (in-drag app) "m") - (progn - (setf (top drag-obj) (format nil "~Apx" (- y (drag-y app)))) - (setf (left drag-obj) (format nil "~Apx" (- x (drag-x app))))) - (progn - (js-execute drag-obj (format nil "editor_~A.resize()" (html-id drag-obj))) - (setf (height drag-obj) (format nil "~Apx" (- y (drag-y app)))) - (setf (width drag-obj) (format nil "~Apx" (- x (drag-x app)))))))) + (x (getf data ':screen-x)) + (y (getf data ':screen-y)) + (adj-y (- y (drag-y app))) + (adj-x (- x (drag-x app)))) + (when (and (> adj-x 0) (> adj-y 30)) + (if (equalp (in-drag app) "m") + (progn + (setf (top drag-obj) (format nil "~Apx" adj-y)) + (setf (left drag-obj) (format nil "~Apx" adj-x))) + (progn + (js-execute drag-obj (format nil "editor_~A.resize()" (html-id drag-obj))) + (setf (height drag-obj) (format nil "~Apx" adj-y)) + (setf (width drag-obj) (format nil "~Apx" adj-x))))))) (defun on-ide-drag-stop (obj data) (let ((app (connection-data-item obj "app-data"))) @@ -77,7 +79,6 @@ (defmethod create-window ((obj clog-obj) title &key (html-id nil) - (top-bar "") (content "") (left 60) (top 60) @@ -98,16 +99,15 @@ style='flex-grow:9;user-select:none;cursor:move;'>~A X - ~A -
~A
+
~A
+
" top left width height (incf *last-z*) ; outer div html-id html-id html-id ; title bar - title html-id top-bar ; title + title html-id ; title html-id content ; body html-id html-id) ; size :html-id html-id)) @@ -139,11 +139,12 @@ (defun do-ide-help-about (obj) (let* ((app (connection-data-item obj "app-data")) (about (create-window (body app) "About" - :top-bar "
+ :content "
+
CLOG
-
The Common Lisp Omnificent GUI
" - :content "

Demo 3
-
(c) 2021 - David Botton

" +
The Common Lisp Omnificent GUI
+

Demo 3
+
(c) 2021 - David Botton

" :left (- (/ (width (body app)) 2) 100) :width 200 :height 200))))) diff --git a/static-files/demo/frame.html b/static-files/demo/frame.html index 4d4271f..3f8a26a 100644 --- a/static-files/demo/frame.html +++ b/static-files/demo/frame.html @@ -14,23 +14,24 @@ -
+
- New - Open... - Save - Save as... + New + Open... + Save + Save as...
- Copy - Paste + Copy + Cut + Paste
@@ -39,7 +40,10 @@ About CLOG Demo 3
- ⤢ + ⤢