From 64d7723702bd33346314f49c9c041a71a523ddcc Mon Sep 17 00:00:00 2001 From: David Botton Date: Sun, 14 Feb 2021 20:01:50 -0500 Subject: [PATCH] windows menu support --- clog-form.lisp | 67 ++++++++++++---- clog-gui.lisp | 156 ++++++++++++++++++++++++++++++++------ clog.lisp | 21 +++-- tutorial/22-tutorial.lisp | 12 +-- 4 files changed, 204 insertions(+), 52 deletions(-) diff --git a/clog-form.lisp b/clog-form.lisp index 0a811f7..3ca7dcb 100644 --- a/clog-form.lisp +++ b/clog-form.lisp @@ -175,7 +175,7 @@ elements.")) :reset :search :submit :tel :text :time :url :week)) (defgeneric create-form-element (clog-obj element-type - &key name value label html-id) + &key name value label class html-id) (:documentation "Create a new clog-form-element as child of CLOG-OBJ. It is importamt that clog-form-elements are a child or descendant of a clog-form in the DOM. The radio ELEMENT-TYPE groups by NAME.")) @@ -184,10 +184,15 @@ clog-form in the DOM. The radio ELEMENT-TYPE groups by NAME.")) &key (name nil) (value nil) (label nil) + (class nil) (html-id nil)) (let ((element (create-child - obj (format nil "" + obj (format nil "" (escape-string element-type) + (if class + (format nil " class='~A'" + (escape-string class)) + "") (if value (format nil " value='~A'" value) "") @@ -648,16 +653,21 @@ virtual keyboards.")) ;;;;;;;;;;;;;;;;;; -(defgeneric create-label (clog-obj &key content label-for html-id) +(defgeneric create-label (clog-obj &key content label-for class html-id) (:documentation "Create a new clog-label as child of CLOG-OBJ.")) (defmethod create-label ((obj clog-obj) &key (content "") (label-for nil) + (class nil) (html-id nil)) - (create-child obj (format nil "" + (create-child obj (format nil "" (if label-for (html-id label-for) "") + (if class + (format nil " class='~A'" + (escape-string class)) + "") (escape-string content)) :clog-type 'clog-label :html-id html-id :auto-place t)) @@ -682,11 +692,17 @@ virtual keyboards.")) ;; create-fieldset ;; ;;;;;;;;;;;;;;;;;;;;; -(defgeneric create-fieldset (clog-obj &key legend html-id) +(defgeneric create-fieldset (clog-obj &key legend class html-id) (:documentation "Create a new clog-fieldset as child of CLOG-OBJ.")) -(defmethod create-fieldset ((obj clog-obj) &key (legend nil) (html-id nil)) - (create-child obj (format nil "
~A
" +(defmethod create-fieldset ((obj clog-obj) &key (legend nil) + (class nil) + (html-id nil)) + (create-child obj (format nil "~A" + (if class + (format nil " class='~A'" + (escape-string class)) + "") (if legend (format nil "~A" legend) "")) @@ -750,7 +766,7 @@ optionally fill in with contents of data-list.")) ;;;;;;;;;;;;;;;;;;;;;; (defgeneric create-text-area (clog-obj - &key columns rows name value label html-id) + &key columns rows name value label class html-id) (:documentation "Create a new clog-text-area as child of CLOG-OBJ.")) (defmethod create-text-area ((obj clog-obj) @@ -759,11 +775,17 @@ optionally fill in with contents of data-list.")) (name "") (value "") (label nil) + (class nil) (html-id nil)) (let ((element (create-child obj - (format nil "" - name columns rows (escape-string value)) + (format nil "" + name columns rows + (if class + (format nil " class='~A'" + (escape-string class)) + "") + (escape-string value)) :clog-type 'clog-text-area :html-id html-id :auto-place t))) (when label @@ -859,21 +881,26 @@ optionally fill in with contents of data-list.")) ;; create-select ;; ;;;;;;;;;;;;;;;;;;; -(defgeneric create-select (clog-obj &key name multiple label html-id) +(defgeneric create-select (clog-obj &key name multiple label class html-id) (:documentation "Create a new clog-select as child of CLOG-OBJ.")) (defmethod create-select ((obj clog-obj) &key (name nil) (multiple nil) (label nil) + (class nil) (html-id nil)) (let ((element (create-child - obj (format nil "" + obj (format nil "" (if multiple " multiple" "") (if name (format nil " name='~A'" name) + "") + (if class + (format nil " class='~A'" + (escape-string class)) "")) :clog-type 'clog-select :html-id html-id :auto-place t))) (when label @@ -916,7 +943,7 @@ optionally fill in with contents of data-list.")) ;;;;;;;;;;;;;;;;;;; (defgeneric create-option (clog-obj - &key content value selected disabled html-id) + &key content value selected disabled class html-id) (:documentation "Create a new clog-option as child of CLOG-OBJ.")) (defmethod create-option ((obj clog-obj) &key @@ -924,8 +951,9 @@ optionally fill in with contents of data-list.")) (value nil) (selected nil) (disabled nil) + (class nil) (html-id nil)) - (create-child obj (format nil "~A" + (create-child obj (format nil "~A" (if selected " selected" "") @@ -935,6 +963,10 @@ optionally fill in with contents of data-list.")) (if value (format nil " value='~A'" value) "") + (if class + (format nil " class='~A'" + (escape-string class)) + "") content) :clog-type 'clog-option :html-id html-id :auto-place t)) @@ -971,9 +1003,14 @@ optionally fill in with contents of data-list.")) (defmethod create-optgroup ((obj clog-obj) &key (content "") (disabled nil) + (class nil) (html-id nil)) - (create-child obj (format nil "" + (create-child obj (format nil "" content + (if class + (format nil " class='~A'" + (escape-string class)) + "") (if disabled " disabled" "")) diff --git a/clog-gui.lisp b/clog-gui.lisp index 3d5ab6c..5fb54d7 100644 --- a/clog-gui.lisp +++ b/clog-gui.lisp @@ -26,7 +26,7 @@ (windows :accessor windows :initform (make-hash-table :test 'equalp) - :documentation "Window collection") + :documentation "Window collection indexed by html-id") (last-z :accessor last-z :initform -9999 @@ -57,6 +57,10 @@ (drag-y :accessor drag-y :documentation "Location of the top or height relative to pointer during drag") + (window-select + :accessor window-select + :initform nil + :documentation "If installed a drop down that selects window to maximize") (on-window-change :accessor on-window-change :initform nil @@ -137,7 +141,7 @@ clog-body.")) ;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass clog-gui-menu-item (clog-span)() - (:documentation "Menu bar")) + (:documentation "Menu item")) (defgeneric create-gui-menu-item (clog-gui-menu-drop-down &key content @@ -156,6 +160,34 @@ clog-body.")) (set-on-click span on-click) (change-class span 'clog-gui-menu-item))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; create-gui-menu-window-select ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-gui-menu-window-select (clog-select)() + (:documentation "Drop down containing windows. Selecting a window +will maximize it on top.")) + +(defgeneric create-gui-menu-window-select (clog-gui-menu-drop-down + &key class + html-id) + (:documentation "Attached a menu item to a CLOG-GUI-MENU-DROP-DOWN")) + +(defmethod create-gui-menu-window-select + ((obj clog-obj) + &key (class "w3-select") + (html-id nil)) + (let ((window-select (create-select obj :class class :html-id html-id)) + (app (connection-data-item obj "clog-gui"))) + (change-class window-select 'clog-gui-menu-window-select) + (setf (window-select app) window-select) + (set-on-change window-select (lambda (obj) + (let ((win (gethash (value obj) (windows app)))) + (when win + (window-maximize win))))) + (create-option window-select :content "Select Window") + window-select)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; create-gui-menu-full-screen ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -278,6 +310,10 @@ The on-window-change clog-obj received is the new window")) :accessor last-y :initform nil :documentation "Last y before maximize") + (window-select-item + :accessor window-select-item + :initform nil + :documentation "Item in window select") (on-window-can-close :accessor on-window-can-close :initform nil @@ -455,26 +491,16 @@ on-window-resize-done at end of resize.")) (setf (closer win) (attach-as-child win (format nil "~A-closer" html-id))) (setf (sizer win) (attach-as-child win (format nil "~A-sizer" html-id))) (setf (content win) (attach-as-child win (format nil "~A-body" html-id))) - (flet ((maximize-window (obj) - (cond ((last-width win) - (setf (width win) (last-width win)) - (setf (height win) (last-height win)) - (setf (top win) (last-y win)) - (setf (left win) (last-x win)) - (setf (last-width win) nil)) - (t - (setf (last-x win) (left win)) - (setf (last-y win) (top win)) - (setf (last-height win) (height win)) - (setf (last-width win) (width win)) - (setf (top win) (unit :px menu-bar-height)) - (setf (left win) (unit :px 0)) - (setf (width win) (unit :vw 100)) - (setf (height win) - (- (inner-height (window (body app))) 30)))))) - (set-on-double-click (win-title win) #'maximize-window) - (when maximize - (maximize-window win))) + (setf (gethash (format nil "~A" html-id) (windows app)) win) + (if maximize + (window-maximize win) + (fire-on-window-change win app)) + (when (window-select app) + (setf (window-select-item win) (create-option (window-select app) + :content title + :value html-id))) + (set-on-double-click (win-title win) (lambda (obj) + (window-toggle-maximize win))) (set-on-click (closer win) (lambda (obj) (declare (ignore obj)) (when (fire-on-window-can-close win) @@ -483,27 +509,30 @@ on-window-resize-done at end of resize.")) (remove-from-dom win) (fire-on-window-change nil app) (fire-on-window-close win)))) - (setf (gethash (format nil "~A" html-id) (windows app)) win) - (fire-on-window-change win app) (cond (client-movement (jquery-execute win (format nil "draggable({handle:'#~A-title-bar'})" html-id)) (jquery-execute win "resizable({handles:'se'})") (set-on-pointer-down (win-title win) (lambda (obj data) + (declare (ignore obj) (ignore data)) (setf (z-index win) (incf (last-z app))) (fire-on-window-change win app))) (set-on-event win "dragstart" (lambda (obj) + (declare (ignore obj)) (fire-on-window-move win))) (set-on-event win "dragstop" (lambda (obj) + (declare (ignore obj)) (fire-on-window-move-done win))) (set-on-event win "resizestart" (lambda (obj) + (declare (ignore obj)) (fire-on-window-size win))) (set-on-event win "resizestop" (lambda (obj) + (declare (ignore obj)) (fire-on-window-size-done win)))) (t (set-on-pointer-down @@ -526,6 +555,8 @@ on-window-resize-done at end of resize.")) (:documentation "Set window title")) (defmethod set-window-title ((obj clog-gui-window) value) + (when (window-select-item obj) + (setf (inner-html (window-select-item obj)) value)) (setf (inner-html (win-title obj)) value)) (defsetf window-title set-window-title) @@ -539,6 +570,83 @@ on-window-resize-done at end of resize.")) (defmethod window-content ((obj clog-gui-window)) (content obj)) +;;;;;;;;;;;;;;;;;; +;; window-focus ;; +;;;;;;;;;;;;;;;;;; + +(defgeneric window-focus (clog-gui-window) + (:documentation "Set CLOG-GUI-WINDOW as focused window.")) + +(defmethod window-focus ((obj clog-gui-window)) + (let ((app (connection-data-item obj "clog-gui"))) + (setf (z-index obj) (incf (last-z app))) + (fire-on-window-change obj app))) + +;;;;;;;;;;;;;;;;;;;;; +;; window-maximize ;; +;;;;;;;;;;;;;;;;;;;;; + +(defgeneric window-maximize (clog-gui-window) + (:documentation "Set CLOG-GUI-WINDOW as maximized window.")) + +(defmethod window-maximize ((obj clog-gui-window)) + (let ((app (connection-data-item obj "clog-gui"))) + (window-focus obj) + (unless (last-width obj) + (setf (last-x obj) (left obj)) + (setf (last-y obj) (top obj)) + (setf (last-height obj) (height obj)) + (setf (last-width obj) (width obj)) + (setf (top obj) (unit :px menu-bar-height)) + (setf (left obj) (unit :px 0)) + (setf (width obj) (unit :vw 100)) + (setf (height obj) + (- (inner-height (window (body app))) menu-bar-height))))) + +;;;;;;;;;;;;;;;;;;;;;; +;; window-normalize ;; +;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric window-normalize (clog-gui-window) + (:documentation "Set CLOG-GUI-WINDOW as maximize window.")) + +(defmethod window-normalize ((obj clog-gui-window)) + (window-focus obj) + (when (last-width obj) + (setf (width obj) (last-width obj)) + (setf (height obj) (last-height obj)) + (setf (top obj) (last-y obj)) + (setf (left obj) (last-x obj)) + (setf (last-width obj) nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; window-toggle-maximize ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric window-toggle-maximize (clog-gui-window) + (:documentation "Set CLOG-GUI-WINDOW as maximize window.")) + +(defmethod window-toggle-maximize ((obj clog-gui-window)) + (let ((app (connection-data-item obj "clog-gui"))) + (window-focus obj) + (cond ((last-width obj) + (setf (width obj) (last-width obj)) + (setf (height obj) (last-height obj)) + (setf (top obj) (last-y obj)) + (setf (left obj) (last-x obj)) + (setf (last-width obj) nil)) + (t + (setf (last-x obj) (left obj)) + (setf (last-y obj) (top obj)) + (setf (last-height obj) (height obj)) + (setf (last-width obj) (width obj)) + (setf (top obj) (unit :px menu-bar-height)) + (setf (left obj) (unit :px 0)) + (setf (width obj) (unit :vw 100)) + (setf (height obj) + (- (inner-height (window (body app))) menu-bar-height)))))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-window-can-close ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/clog.lisp b/clog.lisp index 83950b9..9b4e1d4 100644 --- a/clog.lisp +++ b/clog.lisp @@ -656,14 +656,15 @@ embedded in a native template application.)" (clog-gui-initialize function) "CLOG-GUI - Menus" - (clog-gui-menu-bar class) - (create-gui-menu-bar generic-function) - (clog-gui-menu-drop-down class) - (create-gui-menu-drop-down generic-function) - (clog-gui-menu-item class) - (create-gui-menu-item generic-function) - (create-gui-menu-full-screen generic-function) - (create-gui-menu-icon generic-function) + (clog-gui-menu-bar class) + (create-gui-menu-bar generic-function) + (clog-gui-menu-drop-down class) + (create-gui-menu-drop-down generic-function) + (clog-gui-menu-item class) + (create-gui-menu-item generic-function) + (create-gui-menu-window-select generic-function) + (create-gui-menu-full-screen generic-function) + (create-gui-menu-icon generic-function) "CLOG-GUI - Window System" (current-window generic-function) @@ -674,6 +675,10 @@ embedded in a native template application.)" (create-gui-window generic-function) (window-title generic-function) (window-content generic-function) + (window-focus generic-function) + (window-maximize generic-function) + (window-normalize generic-function) + (window-toggle-maximize generic-function) (set-on-window-can-close generic-function) (set-on-window-close generic-function) (set-on-window-can-move generic-function) diff --git a/tutorial/22-tutorial.lisp b/tutorial/22-tutorial.lisp index 1ba3ea9..f95c7bf 100644 --- a/tutorial/22-tutorial.lisp +++ b/tutorial/22-tutorial.lisp @@ -12,19 +12,19 @@ ;; and :client-movement is set to nil. This mode offers numerous events ;; for fine control and is best for local applications although will be a bit ;; more choppy cross continent or via satellite. - (let ((win (create-gui-window body :client-movement t))) + (let ((win (create-gui-window body :title "Count" :client-movement t))) (dotimes (n 100) ;; window-content is the root element for the clog-gui ;; windows (create-div (window-content win) :content n)))) (defun on-file-browse (body) - (let* ((win (create-gui-window body :client-movement t)) + (let* ((win (create-gui-window body :title "Browse" :client-movement t)) (browser (create-child (window-content win) ""))))) (defun on-file-drawing (body) - (let* ((win (create-gui-window body :client-movement nil)) + (let* ((win (create-gui-window body :title "Drawing" :client-movement t)) (canvas (create-canvas (window-content win) :width 600 :height 400)) (cx (create-context2d canvas))) (set-border canvas :thin :solid :black) @@ -40,7 +40,7 @@ (path-fill cx))) (defun on-file-movies (body) - (let ((win (create-gui-window body :client-movement t))) + (let ((win (create-gui-window body :title "Movie" :client-movement t))) (create-video (window-content win) :source "https://www.w3schools.com/html/mov_bbb.mp4"))) (defun on-help-about (body) @@ -67,7 +67,9 @@ (tmp (create-gui-menu-item file :content "Count" :on-click #'on-file-count)) (tmp (create-gui-menu-item file :content "Browse" :on-click #'on-file-browse)) (tmp (create-gui-menu-item file :content "Drawing" :on-click #'on-file-drawing)) - (tmp (create-gui-menu-item file :content "Movies" :on-click #'on-file-movies)) + (tmp (create-gui-menu-item file :content "Movie" :on-click #'on-file-movies)) + (win (create-gui-menu-drop-down menu :content "Window")) + (tmp (create-gui-menu-window-select win)) (help (create-gui-menu-drop-down menu :content "Help")) (tmp (create-gui-menu-item help :content "About" :on-click #'on-help-about)) (tmp (create-gui-menu-full-screen menu))))