diff --git a/clog-form.lisp b/clog-form.lisp new file mode 100644 index 0000000..58cc850 --- /dev/null +++ b/clog-form.lisp @@ -0,0 +1,53 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; CLOG - The Common Lisp Omnificent GUI ;;;; +;;;; (c) 2020-2021 David Botton ;;;; +;;;; License BSD 3 Clause ;;;; +;;;; ;;;; +;;;; clog-form.lisp ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(cl:in-package :clog) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-form +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-form (clog-obj)() + (:documentation "CLOG Form Objecs is the base class for all html forms.")) + + +;;;;;;;;;;;;;;;;; +;; create-form ;; +;;;;;;;;;;;;;;;;; + +(defgeneric create-form (clog-obj &key auto-place) + (:documentation "Create a new CLOG-Form as child of CLOG-OBJ that organizes +a collection of form elements in to a singnle form if :AUTO-PLACE (default t) +place-inside-bottom-of CLOG-OBJ. In CLOG a form's on-submit handler should be +set and the form elelement values handled in that handler as opposed to the +HTML model of submitting to a new \"page\".")) + +(defmethod create-form ((obj clog-obj) &key (auto-place t)) + (create-child obj "
" :clog-type 'clog-form :auto-place auto-place)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-form-clement +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-form-element (clog-element)() + (:documentation "CLOG Form Element Object is the base class for all form +elements.")) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; create-form-elemnt ;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric create-form-element (clog-form) + (:documentation "Create a new CLOG-Form-Element as child of CLOG-FORM. +CLOG-Form-Elements are always placed with in the CLOG-FORM in the DOM")) + +(defmethod create-form-element (clog-form) + (create-child obj "" :clog-type 'clog-form-element :auto-place auto-place)) + diff --git a/tutorial/08-tutorial.lisp b/tutorial/08-tutorial.lisp new file mode 100644 index 0000000..f8fd5d7 --- /dev/null +++ b/tutorial/08-tutorial.lisp @@ -0,0 +1,100 @@ +(defpackage #:clog-user + (:use #:cl #:clog) + (:export start-tutorial)) + +(in-package :clog-user) + +(defclass app-data () + ((drag-mutex + :reader drag-mutex + :initform (bordeaux-threads:make-lock) + :documentation "Serialize access to the on-mouse-down event.") + (in-drag + :accessor in-drag-p + :initform nil + :documentation "Insure only one box is dragged at a time.") + (drag-x + :accessor drag-x + :documentation "The location of the left side of the box relative to mouse during drag.") + (drag-y + :accessor drag-y + :documentation "The location of the top of the box relative to mouse during drag.")) + (:documentation "App data specific to each instance of our tutorial 8 app")) + +(defun on-mouse-down (obj data) + (let ((app (connection-data-item obj "app-data"))) ; Access our instance of App-Data + (bordeaux-threads:with-lock-held ((drag-mutex app)) ; Insurce the first event received + (unless (in-drag-p app) ; to drag is the only one, ie only + (setf (in-drag-p app) t) ; the innermost box is dragged. + + (let* ((mouse-x (getf data ':screen-x)) ; Use the screen coordinents not + (mouse-y (getf data ':screen-y)) ; the coordents relative to the obj + (obj-top (parse-integer (top obj) :junk-allowed t)) + (obj-left (parse-integer (left obj) :junk-allowed t))) + + (setf (drag-x app) (- mouse-x obj-left)) + (setf (drag-y app) (- mouse-y obj-top)) + + (set-on-mouse-move obj 'on-mouse-move) + (set-on-mouse-up obj 'stop-obj-grab) + (set-on-mouse-leave obj 'on-mouse-leave))))) + +(defun on-mouse-move (obj data) + (let* ((app (connection-data-item obj "app-data")) + (x (getf data ':screen-x)) + (y (getf data ':screen-y)) + (new-x (- x (drag-x app))) + (new-y (- y (drag-y app)))) + + (setf (top obj) (format nil "~Apx" new-y)) + (setf (left obj) (format nil "~Apx" new-x))))) + +(defun on-mouse-leave (obj) + (let ((app (connection-data-item obj "app-data"))) + (setf (in-drag-p app) nil) + (set-on-mouse-move obj nil) + (set-on-mouse-up obj nil) + (set-on-mouse-leave obj nil))) + +(defun stop-obj-grab (obj data) + (on-mouse-move obj data) + (on-mouse-leave obj)) + +(defun on-new-window (body) + (let ((app (make-instance 'app-data))) ; Create our "App-Data" for this instance + (setf (connection-data-item body "app-data") app)) ; of our App. + + (setf (title (html-document body)) "Tutorial 8") + + (let* ((div1 (create-div body)) + (div2 (create-div div1)) + (div3 (create-div div2))) + + (set-border div1 :medium :solid :blue) + (set-border div2 :thin :dotted :red) + (set-border div3 :thick :dashed :green) + + (setf (width div1) 400) + (setf (width div2) 300) + (setf (width div3) 200) + + (setf (height div1) 400) + (setf (height div2) 300) + (setf (height div3) 200) + + (setf (positioning div1) :fixed) ; It's location relative to window + (setf (overflow div1) :hidden) ; Clip the contents + (set-on-mouse-down div1 'on-mouse-down) + + (setf (positioning div2) :absolute) ; It's location relative to is parent container + (setf (overflow div2) :hidden) + (set-on-mouse-down div2 'on-mouse-down) + + (setf (positioning div3) :absolute) + (set-on-mouse-down div3 'on-mouse-down))) + +(defun start-tutorial () + "Start turtorial." + + (initialize #'on-new-window) + (open-browser))