clog-presentations

This commit is contained in:
David Botton 2022-02-13 19:06:48 -05:00
parent f0574c33fb
commit 44f96ffca7
4 changed files with 101 additions and 4 deletions

View file

@ -30,6 +30,7 @@
(:file "clog-body")
(:file "clog-system")
(:file "clog-panel")
(:file "clog-presentations")
(:file "clog-gui")
(:file "clog-web")
(:file "clog-helpers")))

View file

@ -0,0 +1,56 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; CLOG - The Common Lisp Omnificent GUI ;;;;
;;;; (c) 2020-2022 David Botton ;;;;
;;;; License BSD 3 Clause ;;;;
;;;; ;;;;
;;;; clog-presentations.lisp ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(cl:in-package :clog)
;;; clog-presentations - link Lisp classes to CLOG objects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog-presentations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; link-form-element-to-slot ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro link-form-element-to-slot (clog-obj object accessor)
"Link changes to (value CLOG-OBJ) to (ACESSOR OBJECT)"
`(set-on-change ,clog-obj
(lambda (obj)
(declare (ignore obj))
(setf (,slot-name ,object) (value ,clog-obj)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; link-element-to-slot ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro link-element-to-slot (clog-obj object slot-name)
"Link changes to (text CLOG-OBJ) to (ACESSOR OBJECT)"
`(set-on-change ,clog-obj
(lambda (obj)
(declare (ignore obj))
(setf (,slot-name ,object) (text ,clog-obj)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; link-slot-to-form-element ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro link-slot-to-form-element (object accessor clog-obj)
"Link changes to lisp (ACCESSOR OBJECT) to (value CLOG-OBJ)"
`(defmethod (setf ,accessor) :after (new-value (obj (eql ,object)))
(setf (value ,clog-obj) new-value)))
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; link-slot-to-element ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro link-slot-to-element (object accessor clog-obj)
"Link changes to lisp (ACCESSOR OBJECT) to (text CLOG-OBJ)"
`(defmethod (setf ,accessor) :after (new-value (obj (eql ,object)))
(setf (text ,clog-obj) new-value)))

View file

@ -37,7 +37,8 @@ embedded in a native template application.)"
(@clog-obj section)
(@clog-element section)
(@clog-element-common section)
(@clog-panel section)
(@clog-presentations section)
(@clog-panels section)
(@clog-style-block section)
(@clog-form section)
(@clog-canvas section)
@ -492,13 +493,20 @@ embedded in a native template application.)"
(clog-table-column-group-item class)
(create-table-column-group-item generic-function))
(defsection @clog-panel (:title "CLOG Panels")
(defsection @clog-presentations (:title "CLOG Presentations")
"CLOG-Presentations - CLOG Presentations"
(link-form-element-to-slot macro)
(link-element-to-slot macro)
(link-slot-to-form-element macro)
(link-slot-to-element macro))
(defsection @clog-panels (:title "CLOG Panels")
"CLOG-Panel - CLOG Panels"
(clog-panel class)
(clog-panel class)
(create-panel generic-function)
"CLOG-Panel-Box - CLOG Panel Box"
(clog-panel-box class)
(clog-panel-box class)
(create-panel-box generic-function)
(panel-box generic-function)

32
tutorial/29-tutorial.lisp Normal file
View file

@ -0,0 +1,32 @@
;; Demonstrate CLOG presentations
;; links established between CLOG objects and Lisp objects
(defpackage #:clog-tut-29
(:use #:cl #:clog)
(:export start-tutorial))
(in-package :clog-tut-29)
(defclass my-class ()
((my-slot :accessor my-slot :initform "")))
(defun on-new-window (body)
(let* ((lisp-obj (make-instance 'my-class))
(l1 (create-label body :content "Form value:"))
(i1 (create-form-element body :text))
(l2 (create-label body :content "(my-slot lisp-obj) value:"))
(i2 (create-form-element body :text))
(b1 (create-button body :content "Set (my-slot lisp-obj) Value"))
(b2 (create-button body :content "Get (my-slot lisp-obj) Value")))
(link-form-element-to-slot i1 lisp-obj my-slot)
(link-slot-to-form-element lisp-obj my-slot i1)
(set-on-click b1
(lambda (obj)
(setf (my-slot lisp-obj) (value i2))))
(set-on-click b2
(lambda (obj)
(setf (value i2) (my-slot lisp-obj))))))
(defun start-tutorial ()
(initialize 'on-new-window)
(open-browser))