From c8374abfe9896eb326a333f649407ce47740a766 Mon Sep 17 00:00:00 2001 From: David Botton Date: Sun, 15 May 2022 11:24:36 -0400 Subject: [PATCH] Declerative syntax macro with-clog-create and tutorial 33 --- tutorial/33-tutorial.lisp | 177 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 tutorial/33-tutorial.lisp diff --git a/tutorial/33-tutorial.lisp b/tutorial/33-tutorial.lisp new file mode 100644 index 0000000..6fdf8c7 --- /dev/null +++ b/tutorial/33-tutorial.lisp @@ -0,0 +1,177 @@ +;; In this tutorial we redo Tutorial 9 using with-clog-create a far +;; more elegant way to set up GUIs in code using a declartive +;; syntax. The with-clog-create macro takes the place of using let* +;; and many temporary variables. This macro was designed by Mariano +;; Montone and illustrates nicely the advantage the programmable +;; language has at all levels of use to simplify complexity. +;; +;; Thanks Mariano! + +(defpackage #:clog-tut-33 + (:use #:cl #:clog) + (:export start-tutorial)) + +(in-package :clog-tut-33) + +(defun on-new-window (body) + (setf (title (html-document body)) "Tutorial 33") + (with-connection-cache (body) + (let* (last-tab) + ;; Create tabs and panels Using with-clog-create allows you to + ;; replace using "let" to create your code based gui layout. + ;; + ;; To use the macro you remove the create- from the create + ;; functions. The clog-obj passed as the first parameter of the + ;; macro is passed as the parent obj to the declared object, + ;; after that nested levels of decleraton are used as the parent + ;; clog-obj. To bind a variable to any created clog object using + ;; :bind var + (with-clog-create body + (div () + (button (:bind t1 :content "Tab1")) + (button (:bind t2 :content "Tab2")) + (button (:bind t3 :content "Tab3")) + (br ()) + + ;; Panel 1 + (div (:bind p1) + ;; Create form for panel 1 + (form (:bind f1) + (form-element (:bind fe1 :text :label (create-label f1 :content "Fill in blank:"))) + (br ()) + (form-element (:bind fe2 :color :value "#ffffff" + :label (create-label f1 :content "Pick a color:"))) + (br ()) + (form-element (:submit :value "OK")) + (form-element (:reset :value "Start Again")))) + + ;; Panel 2 + (div (:bind p2) + ;; Create form for panel 2 + (form (:bind f2) + (fieldset (:bind fs2 :legend "Stuff") + (label (:bind lbl :content "Please type here:")) + (text-area (:bind ta1 :columns 60 :rows 8 :label lbl)) + (br ()) + (form-element (:bind rd1 :radio :name "rd")) + (label (:content "To Be" :label-for rd1)) + (form-element (:bind rd2 :radio :name "rd")) + (label (:content "No to Be" :label-for rd2)) + (br ()) + (form-element (:bind ck1 :checkbox :name "ck")) + (label (:content "Here" :label-for ck1)) + (form-element (:bind ck2 :checkbox :name "ck")) + (label (:content "There" :label-for ck2)) + (br ()) + (select (:bind sl1 :label (create-label fs2 :content "Pick one:"))) + (select (:bind sl2 :label (create-label fs2 :content "Pick one:"))) + (select (:bind sl3 :multiple t :label (create-label fs2 :content "Pick some:")) + (option (:content "one")) + (option (:bind o2 :content "two")) + (option (:content "three")) + (optgroup (:content "These are a group") + (option (:content "four")) + (option (:bind o5 :content "five"))))) + (form-element (:submit :value "OK")) + (form-element (:reset :value "Start Again")))) + + ;; Panel 3 + (div (:bind p3 :content "Panel3 - Type here"))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Panel 1 contents + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (setf (place-holder fe1) "type here..") + (setf (requiredp fe1) t) + (setf (size fe1) 60) + (make-data-list fe1 '("Cool Title" + "Not So Cool Title" + "Why Not, Another Title")) + (make-data-list fe2 '("#ffffff" + "#ff0000" + "#00ff00" + "#0000ff" + "#ff00ff")) + (set-on-submit f1 + (lambda (obj) + (declare (ignore obj)) + (setf (title (html-document body)) (value fe1)) + (setf (background-color p1) (value fe2)) + (setf (hiddenp f1) t) + (create-span p1 :content + "
Your form has been submitted"))) + (setf (width p1) "100%") + (setf (width p2) "100%") + (setf (width p3) "100%") + (setf (height p1) 400) + (setf (height p2) 400) + (setf (height p3) 400) + (set-border p1 :thin :solid :black) + (set-border p2 :thin :solid :black) + (set-border p3 :thin :solid :black) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Panel 2 contents + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (setf (vertical-align ta1) :top) + (disable-resize ta1) + (setf (vertical-align sl1) :top) + (setf (vertical-align sl2) :top) + (setf (vertical-align sl3) :top) + (setf (size sl1) 3) + (add-select-options sl1 '("one" + "two" + "three" + "four" + "five")) + (add-select-options sl2 '("one" + "two" + "three" + "four" + "five")) + (set-on-change sl3 (lambda (obj) + (declare (ignore obj)) + (when (selectedp o5) + (alert (window body) "Selected 5")))) + (set-on-submit f2 + (lambda (obj) + (declare (ignore obj)) + (setf (hiddenp f2) t) + (create-span p2 :content + (format nil "
Your form has been submitted: +
~A
1 - ~A
2 - ~A
3 - ~A" + (value ta1) + (value sl1) + (value sl2) + (selectedp o2))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Panel 3 contents + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (setf (editablep p3) t) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Tab functionality + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (flet ((select-tab (obj) + (setf (hiddenp p1) t) + (setf (hiddenp p2) t) + (setf (hiddenp p3) t) + (setf (background-color t1) :lightgrey) + (setf (background-color t2) :lightgrey) + (setf (background-color t3) :lightgrey) + (setf (background-color last-tab) :lightblue) + (setf (hiddenp obj) nil) + (focus obj))) + (setf last-tab t1) + (select-tab p1) + (set-on-click t1 (lambda (obj) + (setf last-tab obj) + (select-tab p1))) + (set-on-click t2 (lambda (obj) + (setf last-tab obj) + (select-tab p2))) + (set-on-click t3 (lambda (obj) + (setf last-tab obj) + (select-tab p3)))))))) + +(defun start-tutorial () + "Start turtorial." + (initialize 'on-new-window) + (open-browser))