mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
clog-gui-window start
This commit is contained in:
David Botton
parent
22b64dafe0
commit
c691b40578
7 changed files with 270 additions and 12 deletions
|
|
@ -411,7 +411,8 @@ result or if time out DEFAULT-ANSWER (Private)"))
|
|||
(:documentation "Get connection-data that is associated with
|
||||
clog-obj that will persist regardless of thread. The event hooks
|
||||
are stored in this string based hash in the format of:
|
||||
\"html-id:event-name\" => #'event-handler."))
|
||||
\"html-id:event-name\" => #'event-handler. clog-* keys are reserved
|
||||
for internal use of clog."))
|
||||
|
||||
(defmethod connection-data ((obj clog-obj))
|
||||
(cc:get-connection-data (connection-id obj)))
|
||||
|
|
|
|||
247
clog-gui.lisp
247
clog-gui.lisp
|
|
@ -12,8 +12,53 @@
|
|||
;; Implementation - clog-gui - Desktop GUI abstraction
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defclass clog-gui ()
|
||||
((body
|
||||
:accessor body
|
||||
:documentation "Top level access to browser window")
|
||||
(current-win
|
||||
:accessor current-win
|
||||
:initform nil
|
||||
:documentation "The current window at front.")
|
||||
(last-z
|
||||
:accessor last-z
|
||||
:initform -9999
|
||||
:documentation "Top z-order for windows")
|
||||
(copy-buf
|
||||
:accessor copy-buf
|
||||
:initform ""
|
||||
:documentation "Copy buffer")
|
||||
(in-drag
|
||||
:accessor in-drag
|
||||
:initform nil
|
||||
:documentation "Drag window or Size window.")
|
||||
(drag-x
|
||||
:accessor drag-x
|
||||
:documentation "Location of the left side or width relative to pointer during drag.")
|
||||
(drag-y
|
||||
:accessor drag-y
|
||||
:documentation "Location of the top or height relative to pointer during drag.")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; create-clog-gui ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun create-clog-gui (clog-body)
|
||||
"Create a clog-gui object and places it in CLOG-BODY's connection-data as
|
||||
\"clog-gui\". (private)"
|
||||
(let ((clog-gui (make-instance 'clog-gui)))
|
||||
(setf (connection-data-item clog-body "clog-gui") clog-gui)
|
||||
(setf (body clog-gui) clog-body)
|
||||
clog-gui))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; clog-gui-initialize ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun clog-gui-initialize (clog-body &key (w3-css-url "/css/w3.css"))
|
||||
"Initializes clog-gui loading w3.css from :W3-CSS-URL"
|
||||
"Initializes clog-gui loading w3.css from :W3-CSS-URL and installs a
|
||||
clog-gui object on connection."
|
||||
(create-clog-gui clog-body)
|
||||
(load-css (html-document clog-body) w3-css-url))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -55,6 +100,7 @@ clog-body."))
|
|||
(let* ((hover (create-div obj :class "w3-dropdown-hover"))
|
||||
(button (create-button hover :class "w3-button" :content content))
|
||||
(div (create-div hover :class class :html-id html-id)))
|
||||
(declare (ignore button))
|
||||
(change-class div 'clog-gui-menu-drop-down)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -122,3 +168,202 @@ icon ⤢ and full screen mode."))
|
|||
:html-id html-id
|
||||
:clog-type 'clog-gui-menu-item)
|
||||
on-click))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Implementation - Windows
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defclass clog-gui-window (clog-element)
|
||||
((win-title
|
||||
:accessor win-title
|
||||
:documentation "Window title clog-element")
|
||||
(title-bar
|
||||
:accessor title-bar
|
||||
:documentation "Window title-bar clog-element")
|
||||
(content
|
||||
:accessor content
|
||||
:documentation "Window body clog-element")
|
||||
(closer
|
||||
:accessor closer
|
||||
:documentation "Window closer clog-element")
|
||||
(sizer
|
||||
:accessor sizer
|
||||
:documentation "Window sizer clog-element")
|
||||
(on-window-can-close
|
||||
:accessor set-on-window-can-close
|
||||
:initform nil
|
||||
:documentation "Return t to allow close of window")
|
||||
(on-window-can-move
|
||||
:accessor set-on-window-can-move
|
||||
:initform nil
|
||||
:documentation "Return t to allow move of window")
|
||||
(on-window-can-size
|
||||
:accessor set-on-window-can-size
|
||||
:initform nil
|
||||
:documentation "Return t to allow close of window")
|
||||
(on-window-close
|
||||
:accessor set-on-window-close
|
||||
:initform nil
|
||||
:documentation "Fired on window closed")
|
||||
(on-window-move
|
||||
:accessor set-on-window-move
|
||||
:initform nil
|
||||
:documentation "Fired during move of window")
|
||||
(on-window-size
|
||||
:accessor set-on-window-size
|
||||
:initform nil
|
||||
:documentation "Fired during size change of window")
|
||||
(on-window-move-done
|
||||
:accessor set-on-window-move-done
|
||||
:initform nil
|
||||
:documentation "Fired after move of window")
|
||||
(on-window-size-done
|
||||
:accessor set-on-window-size-done
|
||||
:initform nil
|
||||
:documentation "Fired after size change of window")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; on-gui-drag-down ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun on-gui-drag-down (obj data)
|
||||
"Handle mouse down on drag items"
|
||||
(let ((app (connection-data-item obj "clog-gui")))
|
||||
(unless (in-drag app)
|
||||
(setf (in-drag app) (attribute obj "data-drag-type"))
|
||||
(let* ((id-drag (attribute obj "data-drag-obj"))
|
||||
(drag-obj (attach-as-child obj id-drag))
|
||||
(pointer-x (getf data ':screen-x))
|
||||
(pointer-y (getf data ':screen-y))
|
||||
(obj-top)
|
||||
(obj-left))
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
(setf obj-top (parse-integer (top drag-obj) :junk-allowed t))
|
||||
(setf obj-left (parse-integer (left drag-obj) :junk-allowed t)))
|
||||
((equalp (in-drag app) "s")
|
||||
(setf obj-top (height drag-obj))
|
||||
(setf obj-left (width drag-obj)))
|
||||
(t
|
||||
(format t "Warning - invalid data-drag-type attribute")))
|
||||
(setf (z-index drag-obj) (incf (last-z app)))
|
||||
(setf (current-win app) drag-obj)
|
||||
(setf (drag-y app) (- pointer-y obj-top))
|
||||
(setf (drag-x app) (- pointer-x obj-left))
|
||||
(set-on-pointer-move obj 'on-gui-drag-move)
|
||||
(set-on-pointer-up obj 'on-gui-drag-stop)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; on-gui-drag-move ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun on-gui-drag-move (obj data)
|
||||
"Handle mouse tracking on drag object"
|
||||
(let* ((app (connection-data-item obj "clog-gui"))
|
||||
(drag-obj (attach-as-child obj (attribute obj "data-drag-obj")))
|
||||
(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))
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
;; send on-window-move
|
||||
(setf (top drag-obj) (unit :px adj-y))
|
||||
(setf (left drag-obj) (unit :px adj-x)))
|
||||
((equalp (in-drag app) "s")
|
||||
;; send on-window-resize
|
||||
(setf (height drag-obj) (unit :px adj-y))
|
||||
(setf (width drag-obj) (unit :px adj-x)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; on-gui-drag-stop ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun on-gui-drag-stop (obj data)
|
||||
"Handle end of drag object"
|
||||
(let ((app (connection-data-item obj "clog-gui"))
|
||||
(drag-obj (attach-as-child obj (attribute obj "data-drag-obj"))))
|
||||
(on-gui-drag-move obj data)
|
||||
(setf (in-drag app) nil)
|
||||
(set-on-pointer-move obj nil)
|
||||
(set-on-pointer-up obj nil)
|
||||
(cond ((equalp (in-drag app) "m")
|
||||
(when (set-on-window-move-done app)
|
||||
(funcall (set-on-window-move-done app) drag-obj)))
|
||||
((equalp (in-drag app) "s")
|
||||
(when (set-on-window-size-done app)
|
||||
(funcall (set-on-window-size-done app) drag-obj))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; create-gui-window ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric create-gui-window (clog-obj &key title
|
||||
content
|
||||
left top width height
|
||||
html-id)
|
||||
(:documentation "Create a clog-gui-window"))
|
||||
|
||||
(defmethod create-gui-window ((obj clog-obj) &key (title "New Window")
|
||||
(content "")
|
||||
(left 60)
|
||||
(top 60)
|
||||
(width 400)
|
||||
(height 300)
|
||||
(html-id nil))
|
||||
(unless html-id
|
||||
(setf html-id (clog-connection:generate-id)))
|
||||
|
||||
(let* ((app (connection-data-item obj "clog-gui"))
|
||||
(win (create-child (body app)
|
||||
(format nil
|
||||
"<div style='position:fixed;top:~Apx;left:~Apx;width:~Apx;height:~Apx;
|
||||
flex-container;display:flex;flex-direction:column;z-index:~A'
|
||||
class='w3-card-4 w3-white w3-border'>
|
||||
<div id='~A-title-bar' class='w3-container w3-black'
|
||||
style='flex-container;display:flex;align-items:stretch;'>
|
||||
<span data-drag-obj='~A' data-drag-type='m' id='~A-title'
|
||||
style='flex-grow:9;user-select:none;cursor:move;'>~A</span>
|
||||
<span id='~A-closer'
|
||||
style='cursor:pointer;user-select:none;'>X</span>
|
||||
</div>
|
||||
<div id='~A-body' style='flex-grow:9;'>~A</div>
|
||||
<div id='~A-sizer' style='user-select:none;height:1px;
|
||||
cursor:se-resize;opacity:0'
|
||||
class='w3-right' data-drag-obj='~A' data-drag-type='s'>+</div>
|
||||
</div>"
|
||||
top left width height (incf (last-z app)) ; outer div
|
||||
html-id html-id html-id ; title bar
|
||||
title html-id ; title
|
||||
html-id content ; body
|
||||
html-id html-id) ; size
|
||||
:clog-type 'clog-gui-window
|
||||
:html-id html-id)))
|
||||
(setf (win-title win)
|
||||
(attach-as-child win (format nil "~A-title" html-id)))
|
||||
(setf (title-bar win)
|
||||
(attach-as-child win (format nil "~A-title-bar" 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 (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-pointer-down (sizer win) 'on-gui-drag-down :capture-pointer t)
|
||||
(set-on-click (closer win) (lambda (obj)
|
||||
(remove-from-dom win)))
|
||||
win))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
;; window-title ;;
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-title (clog-gui-window)
|
||||
(:documentation "Get/setf window title"))
|
||||
|
||||
(defmethod window-title ((obj clog-gui-window))
|
||||
(inner-html (win-title obj)))
|
||||
|
||||
(defgeneric set-window-title (clog-gui-window value)
|
||||
(:documentation "Set window title"))
|
||||
|
||||
(defmethod set-window-title ((obj clog-gui-window) value)
|
||||
(setf (inner-html (win-title obj)) value))
|
||||
(defsetf window-title set-window-title)
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@
|
|||
(:documentation "Get/Setf media in seconds property."))
|
||||
|
||||
(defmethod media-duration ((obj clog-multimedia))
|
||||
(parse-integer (property obj "loop")))
|
||||
(parse-float (property obj "duration")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;
|
||||
;; media-source ;;
|
||||
|
|
@ -72,7 +72,7 @@
|
|||
(:documentation "Get/Setf postion of media in seconds."))
|
||||
|
||||
(defmethod media-position ((obj clog-multimedia))
|
||||
(property obj "currentTime"))
|
||||
(parse-float (property obj "currentTime")))
|
||||
|
||||
(defgeneric set-media-position (clog-multimedia value)
|
||||
(:documentation "Set media source VALUE for CLOG-MULTIMEDIA"))
|
||||
|
|
@ -166,7 +166,7 @@ duration."))
|
|||
(:documentation "Get/Setf media volume, not system volume. 0.0 .. 1.0"))
|
||||
|
||||
(defmethod media-volume ((obj clog-multimedia))
|
||||
(parse-integer (property obj "volume")))
|
||||
(parse-float (property obj "volume")))
|
||||
|
||||
(defgeneric set-media-volume (clog-multimedia value)
|
||||
(:documentation "Set media source VALUE for CLOG-MULTIMEDIA"))
|
||||
|
|
|
|||
|
|
@ -153,6 +153,8 @@ alpha 0.0 - 1.0"
|
|||
;; vmin Relative to 1% of viewport's* smaller dimension
|
||||
;; vmax Relative to 1% of viewport's* larger dimension
|
||||
;; % Relative to the parent element
|
||||
;;
|
||||
;; * Viewport = the browser window size. If the viewport is 50cm wide, 1vw = 0.5cm.
|
||||
|
||||
(deftype unit-type () '(member :cm :mm :in :px :pt :pc :em :ex :ch :rem :vw
|
||||
:vh :vmin :vmax :%))
|
||||
|
|
@ -169,9 +171,7 @@ alpha 0.0 - 1.0"
|
|||
;; radial-gradient(shape size at position, start-color, ..., last-color);
|
||||
;; repeating-linear-gradient(angle | to side-or-corner, color-stop1, color-stop2, ...);
|
||||
;; epeating-radial-gradient(shape size at position, start-color, ..., last-color);
|
||||
|
||||
;;
|
||||
;; * Viewport = the browser window size. If the viewport is 50cm wide, 1vw = 0.5cm.
|
||||
;;
|
||||
;; The following list are the best web safe fonts for HTML and CSS:
|
||||
;;
|
||||
|
|
|
|||
2
clog.asd
2
clog.asd
|
|
@ -8,7 +8,7 @@
|
|||
:version "0.9.0"
|
||||
:serial t
|
||||
:depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre
|
||||
#:bordeaux-threads #:trivial-open-browser #:cl-dbi
|
||||
#:bordeaux-threads #:trivial-open-browser #:cl-dbi #:parse-float
|
||||
#:lack-middleware-static #:mgl-pax #:quri)
|
||||
:components ((:file "clog-connection")
|
||||
(:file "clog")
|
||||
|
|
|
|||
11
clog.lisp
11
clog.lisp
|
|
@ -14,7 +14,7 @@
|
|||
(mgl-pax:define-package :clog
|
||||
(:documentation "The Common List Omnificent GUI - CLOG")
|
||||
(:local-nicknames (:cc :clog-connection))
|
||||
(:use #:cl #:mgl-pax))
|
||||
(:use #:cl #:parse-float #:mgl-pax))
|
||||
|
||||
(in-package :clog)
|
||||
|
||||
|
|
@ -655,6 +655,7 @@ embedded in a native template application.)"
|
|||
"CLOG-GUI - Desktop GUI abstraction for CLOG"
|
||||
(clog-gui-initialize function)
|
||||
|
||||
"CLOG-GUI - Menus"
|
||||
(clog-gui-menu-bar class)
|
||||
(create-gui-menu-bar generic-function)
|
||||
(clog-gui-menu-drop-down class)
|
||||
|
|
@ -662,7 +663,13 @@ embedded in a native template application.)"
|
|||
(clog-gui-menu-item class)
|
||||
(create-gui-menu-item generic-function)
|
||||
(create-gui-menu-full-screen generic-function)
|
||||
(create-gui-menu-icon generic-function))
|
||||
(create-gui-menu-icon generic-function)
|
||||
|
||||
"CLOG-GUI - Windows"
|
||||
(create-gui-window generic-function)
|
||||
(window-title generic-function)
|
||||
(set-on-window-move-done generic-function)
|
||||
(set-on-window-size-done generic-function))
|
||||
|
||||
(defsection @clog-body (:title "CLOG Body Objects")
|
||||
"CLOG-Body - CLOG Body Objects"
|
||||
|
|
|
|||
|
|
@ -4,19 +4,24 @@
|
|||
|
||||
(in-package :clog-user)
|
||||
|
||||
(defun on-file-new (body)
|
||||
(setf (set-on-window-size-done (create-gui-window body))
|
||||
(lambda (obj)
|
||||
(print "sized"))))
|
||||
|
||||
(defun on-new-window (body)
|
||||
(clog-gui-initialize body)
|
||||
(add-class body "w3-teal")
|
||||
(let* ((menu (create-gui-menu-bar body))
|
||||
(icon (create-gui-menu-icon menu))
|
||||
(file (create-gui-menu-drop-down menu :content "File"))
|
||||
(new (create-gui-menu-item file :content "New"))
|
||||
(new (create-gui-menu-item file :content "New" :on-click #'on-file-new))
|
||||
(open (create-gui-menu-item file :content "Open"))
|
||||
(save (create-gui-menu-item file :content "Save"))
|
||||
(help (create-gui-menu-drop-down menu :content "Help"))
|
||||
(about (create-gui-menu-item help :content "About"))
|
||||
(fs (create-gui-menu-full-screen menu))))
|
||||
|
||||
|
||||
(run body))
|
||||
|
||||
(defun start-tutorial ()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue