Offer client side move and resize

This commit is contained in:
David Botton 2021-02-12 14:54:48 -05:00
parent 7c7d33a795
commit f0d96e022c
4 changed files with 20049 additions and 10 deletions

View file

@ -67,10 +67,14 @@
;; clog-gui-initialize ;; ;; clog-gui-initialize ;;
;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun clog-gui-initialize (clog-body &key (w3-css-url "/css/w3.css")) (defun clog-gui-initialize (clog-body &key (w3-css-url "/css/w3.css")
(jquery-ui-css "/css/jquery-ui.css")
(jquery-ui "/js/jquery-ui.js"))
"Initializes clog-gui loading w3.css from :W3-CSS-URL and installs a "Initializes clog-gui loading w3.css from :W3-CSS-URL and installs a
clog-gui object on connection." clog-gui object on connection."
(create-clog-gui clog-body) (create-clog-gui clog-body)
(load-script (html-document clog-body) jquery-ui)
(load-css (html-document clog-body) jquery-ui-css)
(load-css (html-document clog-body) w3-css-url)) (load-css (html-document clog-body) w3-css-url))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -362,8 +366,10 @@ The on-window-change clog-obj received is the new window"))
(defgeneric create-gui-window (clog-obj &key title (defgeneric create-gui-window (clog-obj &key title
content content
left top width height left top width height
client-movement
html-id) html-id)
(:documentation "Create a clog-gui-window")) (:documentation "Create a clog-gui-window. If client-movement is t then
use jquery-ui to move/resize."))
(defmethod create-gui-window ((obj clog-obj) &key (title "New Window") (defmethod create-gui-window ((obj clog-obj) &key (title "New Window")
(content "") (content "")
@ -371,6 +377,7 @@ The on-window-change clog-obj received is the new window"))
(top 60) (top 60)
(width 400) (width 400)
(height 300) (height 300)
(client-movement nil)
(html-id nil)) (html-id nil))
(unless html-id (unless html-id
(setf html-id (clog-connection:generate-id))) (setf html-id (clog-connection:generate-id)))
@ -407,20 +414,31 @@ The on-window-change clog-obj received is the new window"))
(setf (closer win) (attach-as-child win (format nil "~A-closer" html-id))) (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 (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))) (setf (content win) (attach-as-child win (format nil "~A-body" html-id)))
(set-on-pointer-down (win-title win) 'on-gui-drag-down :capture-pointer t)
(set-on-double-click (win-title win) (lambda (obj) (set-on-double-click (win-title win) (lambda (obj)
(setf (width win) (unit :px 800)) (setf (width win) (unit :px 800))
(setf (height win) (unit :px 600)))) (setf (height win) (unit :px 600))))
(set-on-pointer-down (sizer win) 'on-gui-drag-down :capture-pointer t)
(set-on-click (closer win) (lambda (obj) (set-on-click (closer win) (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(when (fire-on-window-can-close win) (when (fire-on-window-can-close win)
(remhash (format nil "~A" html-id) (windows app)) (remhash (format nil "~A" html-id)
(windows app))
(remove-from-dom win) (remove-from-dom win)
(fire-on-window-change nil app) (fire-on-window-change nil app)
(fire-on-window-close win)))) (fire-on-window-close win))))
(setf (gethash (format nil "~A" html-id) (windows app)) win) (setf (gethash (format nil "~A" html-id) (windows app)) win)
(fire-on-window-change win app) (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)
(setf (z-index win) (incf (last-z app)))
(fire-on-window-change win app))))
(t
(set-on-pointer-down
(win-title win) 'on-gui-drag-down :capture-pointer t)
(set-on-pointer-down
(sizer win) 'on-gui-drag-down :capture-pointer t)))
win)) win))
;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;

1311
static-files/css/jquery-ui.css vendored Normal file

File diff suppressed because it is too large Load diff

18706
static-files/js/jquery-ui.js vendored Normal file

File diff suppressed because it is too large Load diff

View file

@ -5,19 +5,22 @@
(in-package :clog-user) (in-package :clog-user)
(defun on-file-count (body) (defun on-file-count (body)
(let ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400))))) (let ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400))
:client-movement t)))
(dotimes (n 100) (dotimes (n 100)
;; window-content is the root element for the clog-gui ;; window-content is the root element for the clog-gui
;; windows ;; windows
(create-div (window-content win) :content n)))) (create-div (window-content win) :content n))))
(defun on-file-browse (body) (defun on-file-browse (body)
(let* ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400)))) (let* ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400))
:client-movement t))
(browser (create-child (window-content win) (browser (create-child (window-content win)
"<iframe width=100% height=98% src='https://common-lisp.net/'></iframe>"))))) "<iframe width=100% height=98% src='https://common-lisp.net/'></iframe>")))))
(defun on-file-drawing (body) (defun on-file-drawing (body)
(let* ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400)))) (let* ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400))
:client-movement nil))
(canvas (create-canvas (window-content win) :width 600 :height 400)) (canvas (create-canvas (window-content win) :width 600 :height 400))
(cx (create-context2d canvas))) (cx (create-context2d canvas)))
(set-border canvas :thin :solid :black) (set-border canvas :thin :solid :black)
@ -33,7 +36,8 @@
(path-fill cx))) (path-fill cx)))
(defun on-file-movies (body) (defun on-file-movies (body)
(let* ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400))))) (let ((win (create-gui-window body :left (random 600) :top (+ 40 (random 400))
:client-movement t)))
(create-video (window-content win) :source "https://www.w3schools.com/html/mov_bbb.mp4"))) (create-video (window-content win) :source "https://www.w3schools.com/html/mov_bbb.mp4")))
(defun on-help-about (body) (defun on-help-about (body)