mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

update documentation, remove tabs

Browse source
This commit is contained in:
David Botton 2022-07-18 22:26:37 -04:00
parent 2c9ce0864f
commit 25a9462f1f
84 changed files with 2163 additions and 2278 deletions
Download patch file Download diff file Expand all files Collapse all files

28
tutorial/01-tutorial.lisp
View file

@ -10,22 +10,22 @@
"On-new-window handler." ; Optional docstring to describe function
(let ((hello-element ; hello-element is a local variable that
; will be bound to our new CLOG-Element
;; This application simply creates a CLOG-Element as a child to the
;; CLOG-body object in the browser window.
;; A CLOG-Element represents a block of HTML (we will see later ways to
;; directly create buttons and all sorts of HTML elements in more lisp
;; like ways with no knowledge of HTML or javascript. CREATE-CHILD
;; allows any html element to be created and returned as a CLOG-Element.
(create-child body "<h1>Hello World! (click me!)</h1>")))
; will be bound to our new CLOG-Element
;; This application simply creates a CLOG-Element as a child to the
;; CLOG-body object in the browser window.
;; A CLOG-Element represents a block of HTML (we will see later ways to
;; directly create buttons and all sorts of HTML elements in more lisp
;; like ways with no knowledge of HTML or javascript. CREATE-CHILD
;; allows any html element to be created and returned as a CLOG-Element.
(create-child body "<h1>Hello World! (click me!)</h1>")))
(set-on-click hello-element ; Now we set a function to handle clicks
(lambda (obj) ; In this case we use an anonymous function
(declare (ignore obj))
(setf (color hello-element) :green)))))
(lambda (obj) ; In this case we use an anonymous function
(declare (ignore obj))
(setf (color hello-element) :green)))))
;;; To see all the events one can set and the many properties and styles that
;;; exist, take a look through the CLOG manual or the file clog-element.lisp

38
tutorial/02-tutorial.lisp
View file

@ -14,26 +14,26 @@
;; (window body) is the CLOG-Window object ~ the equivelant html
;; (location body) is the CLOG-Location object ~ objects of same name.
;; (navigator body) is the CLOG-Navigator object ~ See the manual or src.
(let ((hello-element
;; CREATE-SECTION is a lispier way of creating any of the HTML 5
;; section elements:
;;
;; :address :article :aside :header :main :nav :hgroup
;; :p :pre :section :blockquote :h1 :h2 :h3 :h4 :h5 :h6
;;
;; Take a look at clog-element-common.lisp or the clog-manual
(create-section body :h1 :content "Hello World! (click me!)")))
(let ((x 0)) ; A closure - each call to on-new-window by
(let ((hello-element
;; CREATE-SECTION is a lispier way of creating any of the HTML 5
;; section elements:
;;
;; :address :article :aside :header :main :nav :hgroup
;; :p :pre :section :blockquote :h1 :h2 :h3 :h4 :h5 :h6
;;
;; Take a look at clog-element-common.lisp or the clog-manual
(create-section body :h1 :content "Hello World! (click me!)")))
(let ((x 0)) ; A closure - each call to on-new-window by
(set-on-click hello-element ; a new browser window or refresh will
(lambda (obj) ; create a different version of this closure.
(declare (ignore obj))
(incf x)
(dotimes (n x)
(create-child body
(format nil "<p>Clicked ~A times.</p>" x))
(scroll-to (window body) 0 (height body))))))))
(lambda (obj) ; create a different version of this closure.
(declare (ignore obj))
(incf x)
(dotimes (n x)
(create-child body
(format nil "<p>Clicked ~A times.</p>" x))
(scroll-to (window body) 0 (height body))))))))
(defun start-tutorial ()
"Start turtorial."

22
tutorial/03-tutorial.lisp
View file

@ -6,20 +6,20 @@
(defun on-new-window (body)
"On-new-window handler."
(setf (title (html-document body)) "Tutorial 3")
(setf (title (html-document body)) "Tutorial 3")
(let ((hello-element
(create-section body :h1 :content "Hello World! (click me!)")))
(create-section body :h1 :content "Hello World! (click me!)")))
(let ((x 0))
(set-on-click hello-element
(lambda (obj)
(declare (ignorable obj))
;; Add to try non-parallel events:
;; (with-sync-event (obj)
(let ((y (incf x)))
(dotimes (n y)
(create-p body
:content (format nil "Clicked ~A times." y))
(sleep y)))))))) ;)
(lambda (obj)
(declare (ignorable obj))
;; Add to try non-parallel events:
;; (with-sync-event (obj)
(let ((y (incf x)))
(dotimes (n y)
(create-p body
:content (format nil "Clicked ~A times." y))
(sleep y)))))))) ;)
;;; Running this version of the last tutorial and clicking quickly on the (click me!)
;;; will demonstrate an important aspect of CLOG, events can happen in _parallel_.

4
tutorial/04-tutorial.lisp
View file

@ -12,9 +12,9 @@
(setf (title (html-document body)) "Tutorial 4")
;; The same handler #'my-on-click is set on both targets
(set-on-click (create-section body :h1 :content "Hello World! (click me!)")
'my-on-click)
'my-on-click)
(set-on-click (create-section body :h3 :content "Click me too!")
'my-on-click))
'my-on-click))
(defun start-tutorial ()
"Start turtorial."

6
tutorial/05-tutorial.lisp
View file

@ -12,12 +12,12 @@
(setf (color (connection-data-item obj "changer")) "green"))
(defun on-new-window (body)
"On-new-window handler."
"On-new-window handler."
(setf (title (html-document body)) "Tutorial 5")
(set-on-click (create-section body :h1 :content "Hello World! (click me!)")
'my-on-click)
'my-on-click)
(setf (connection-data-item body "changer")
(create-section body :h1 :content "I change")))
(create-section body :h1 :content "I change")))
(defun start-tutorial ()
"Start turtorial."

14
tutorial/06-tutorial.lisp
View file

@ -13,12 +13,12 @@
;; valid to close down the event or thread.
(loop
(if (and (validp obj) (connection-data-item obj "isRunning"))
(progn
(setf (color obj) :green)
(sleep 0.3)
(setf (color obj) :red)
(sleep 0.3))
(return))))
(progn
(setf (color obj) :green)
(sleep 0.3)
(setf (color obj) :red)
(sleep 0.3))
(return))))
(setf (connection-data-item obj "isRunning") nil)
(setf (text obj) "(click me to start!)")
(setf (color obj) "black")
@ -28,7 +28,7 @@
"On-new-window handler."
(setf (title (html-document body)) "Tutorial 6")
(set-on-click (create-section body :h1 :content "(click me to start!)")
'my-on-click))
'my-on-click))
(defun start-tutorial ()
"Start turtorial."

120
tutorial/07-tutorial.lisp
View file

@ -12,67 +12,67 @@
(defun on-new-window (body)
(handler-case ; Disconnects from the browser can be handled gracefully using the condition system.
(progn
(setf (title (html-document body)) "Tutorial 7")
;; Show a "splash" screen
(setf (hiddenp (prog1
(create-section body :h2
:content "KILL Darth's Tie Fighter - Click on it!")
(sleep 2))) t)
;; Setup main game
(let* ((mover (create-div body :content "(-o-)"))
bounds-x bounds-y mover-x mover-y)
(flet ((set-bounds ()
(setf bounds-x (width (window body)))
(setf bounds-y (height (window body)))))
(set-bounds)
(setf mover-x (random bounds-x))
(setf mover-y (random bounds-y))
;; Capture browser size changes to adjust playing field
(set-on-resize (window body)
(lambda (obj)
(declare (ignore obj))
(set-bounds))))
;; Setup our "mover". Darth
(setf (positioning mover) :fixed)
(set-on-click mover 'on-click)
;; Get Darth moving!
(bordeaux-threads:make-thread ; In addtion to the main task (the on-new-window)
(lambda () ; and the task created for each event like clicks
(loop ; threads can be created as needed and used with
(unless (validp body) ; CLOG.
(return))
(when (connection-data-item body "done")
(return))
(sleep .5)
(setf (text mover) ")-o-(")
(sleep .2)
(setf (text mover) "(-o-)"))
(setf (inner-html mover) "<H1>GAME OVER</H1>"))
(setf (title (html-document body)) "Tutorial 7")
;; Show a "splash" screen
(setf (hiddenp (prog1
(create-section body :h2
:content "KILL Darth's Tie Fighter - Click on it!")
(sleep 2))) t)
;; Setup main game
(let* ((mover (create-div body :content "(-o-)"))
bounds-x bounds-y mover-x mover-y)
(flet ((set-bounds ()
(setf bounds-x (width (window body)))
(setf bounds-y (height (window body)))))
(set-bounds)
(setf mover-x (random bounds-x))
(setf mover-y (random bounds-y))
;; Capture browser size changes to adjust playing field
(set-on-resize (window body)
(lambda (obj)
(declare (ignore obj))
(set-bounds))))
;; Setup our "mover". Darth
(setf (positioning mover) :fixed)
(set-on-click mover 'on-click)
;; Get Darth moving!
(bordeaux-threads:make-thread ; In addtion to the main task (the on-new-window)
(lambda () ; and the task created for each event like clicks
(loop ; threads can be created as needed and used with
(unless (validp body) ; CLOG.
(return))
(when (connection-data-item body "done")
(return))
(sleep .5)
(setf (text mover) ")-o-(")
(sleep .2)
(setf (text mover) "(-o-)"))
(setf (inner-html mover) "<H1>GAME OVER</H1>"))
:name "Darth event loop")
;; Check of browser still connected while running game loop
(loop
(unless (validp body)
(return))
(when (connection-data-item body "done")
(return))
(setf (top mover) (unit :px mover-y))
(setf (left mover) (unit :px mover-x))
(if (= (random 2) 0)
(incf mover-y (random 10))
(decf mover-y (random 10)))
(if (= (random 2) 0)
(incf mover-x (random 10))
(decf mover-x (random 10)))
(when (< mover-x 0)
(setf mover-x 0))
(when (> mover-x bounds-x)
(setf mover-x bounds-x))
(when (< mover-y 0)
(setf mover-y 0))
(when (> mover-y bounds-y)
(setf mover-y bounds-y))
(sleep .02))))
;; Check of browser still connected while running game loop
(loop
(unless (validp body)
(return))
(when (connection-data-item body "done")
(return))
(setf (top mover) (unit :px mover-y))
(setf (left mover) (unit :px mover-x))
(if (= (random 2) 0)
(incf mover-y (random 10))
(decf mover-y (random 10)))
(if (= (random 2) 0)
(incf mover-x (random 10))
(decf mover-x (random 10)))
(when (< mover-x 0)
(setf mover-x 0))
(when (> mover-x bounds-x)
(setf mover-x bounds-x))
(when (< mover-y 0)
(setf mover-y 0))
(when (> mover-y bounds-y)
(setf mover-y bounds-y))
(sleep .02))))
(error (c)
(format t "Lost connection.~%~%~A" c))))

46
tutorial/08-tutorial.lisp
View file

@ -21,27 +21,27 @@
(with-sync-event (obj) ; Serialize events to on-mouse-down.
(let ((app (connection-data-item obj "app-data"))) ; Ensure 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 coordinates not
(mouse-y (getf data :screen-y)) ; the coordinates 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))
(if (eq (getf data :event-type) :touch)
(progn
(set-on-touch-move obj 'on-mouse-move)
(set-on-touch-end obj 'stop-obj-grab)
(set-on-touch-cancel obj 'on-mouse-leave))
(progn
(set-on-mouse-move obj 'on-mouse-move)
(set-on-mouse-up obj 'stop-obj-grab)
(set-on-mouse-leave obj 'on-mouse-leave))))))))
(setf (in-drag-p app) t) ; the innermost box is dragged.
(let* ((mouse-x (getf data :screen-x)) ; Use the screen coordinates not
(mouse-y (getf data :screen-y)) ; the coordinates 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))
(if (eq (getf data :event-type) :touch)
(progn
(set-on-touch-move obj 'on-mouse-move)
(set-on-touch-end obj 'stop-obj-grab)
(set-on-touch-cancel obj 'on-mouse-leave))
(progn
(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)))
(x (getf data :screen-x))
(y (getf data :screen-y)))
(setf (top obj) (unit :px (- y (drag-y app))))
(setf (left obj) (unit :px (- x (drag-x app))))))
@ -61,12 +61,12 @@
(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 (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))
(dir (create-div div1 :content "<b>Click and drag the boxes</b>")))
(div2 (create-div div1))
(div3 (create-div div2))
(dir (create-div div1 :content "<b>Click and drag the boxes</b>")))
;; Absolute allows fixed positioning relative to parent
(setf (positioning dir) :absolute)
(setf (bottom dir) 0)
@ -77,7 +77,7 @@
;; sizes
(setf (width div1) 400)
(setf (width div2) 300)
(setf (width div3) 200)
(setf (width div3) 200)
(setf (height div1) 400)
(setf (height div2) 300)
(setf (height div3) 200)

218
tutorial/09-tutorial.lisp
View file

@ -10,62 +10,62 @@
;; reduces rountrip traffic and speeds setup.
(with-connection-cache (body)
(let* (last-tab
;; Note: Since the there is no need to use the tmp objects
;; we reuse the same symbol name (tmp) even though the
;; compiler can mark those for garbage collection early
;; this not an issue as the element is created already
;; in the browser window.
;;
;; See tutorial 33 for a far more elegant approach
;; that uses with-clog-create for this type of code
;; based layout.
;;
;; Create tabs and panels
(t1 (create-button body :content "Tab1"))
(t2 (create-button body :content "Tab2"))
(t3 (create-button body :content "Tab3"))
(tmp (create-br body))
(p1 (create-div body))
(p2 (create-div body))
(p3 (create-div body :content "Panel3 - Type here"))
;; Create form for panel 1
(f1 (create-form p1))
(fe1 (create-form-element f1 :text
:label (create-label f1 :content "Fill in blank:")))
(tmp (create-br f1))
(fe2 (create-form-element f1 :color :value "#ffffff"
:label (create-label f1 :content "Pick a color:")))
(tmp (create-br f1))
(tmp (create-form-element f1 :submit :value "OK"))
(tmp (create-form-element f1 :reset :value "Start Again"))
;; Create for for panel 2
(f2 (create-form p2))
(fs2 (create-fieldset f2 :legend "Stuff"))
(tmp (create-label fs2 :content "Please type here:"))
(ta1 (create-text-area fs2 :columns 60 :rows 8 :label tmp))
(tmp (create-br fs2))
(rd1 (create-form-element fs2 :radio :name "rd"))
(tmp (create-label fs2 :content "To Be" :label-for rd1))
(rd2 (create-form-element fs2 :radio :name "rd"))
(tmp (create-label fs2 :content "No to Be" :label-for rd2))
(tmp (create-br fs2))
(ck1 (create-form-element fs2 :checkbox :name "ck"))
(tmp (create-label fs2 :content "Here" :label-for ck1))
(ck2 (create-form-element fs2 :checkbox :name "ck"))
(tmp (create-label fs2 :content "There" :label-for ck2))
(tmp (create-br fs2))
(sl1 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
(sl2 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
(sl3 (create-select fs2 :multiple t
:label (create-label fs2 :content "Pick some:")))
(o1 (create-option sl3 :content "one"))
(o2 (create-option sl3 :content "two"))
(o3 (create-option sl3 :content "three"))
(og1 (create-optgroup sl3 :content "These are a group"))
(o4 (create-option og1 :content "four"))
(o5 (create-option og1 :content "five"))
(tmp (create-form-element f2 :submit :value "OK"))
(tmp (create-form-element f2 :reset :value "Start Again")))
;; Note: Since the there is no need to use the tmp objects
;; we reuse the same symbol name (tmp) even though the
;; compiler can mark those for garbage collection early
;; this not an issue as the element is created already
;; in the browser window.
;;
;; See tutorial 33 for a far more elegant approach
;; that uses with-clog-create for this type of code
;; based layout.
;;
;; Create tabs and panels
(t1 (create-button body :content "Tab1"))
(t2 (create-button body :content "Tab2"))
(t3 (create-button body :content "Tab3"))
(tmp (create-br body))
(p1 (create-div body))
(p2 (create-div body))
(p3 (create-div body :content "Panel3 - Type here"))
;; Create form for panel 1
(f1 (create-form p1))
(fe1 (create-form-element f1 :text
:label (create-label f1 :content "Fill in blank:")))
(tmp (create-br f1))
(fe2 (create-form-element f1 :color :value "#ffffff"
:label (create-label f1 :content "Pick a color:")))
(tmp (create-br f1))
(tmp (create-form-element f1 :submit :value "OK"))
(tmp (create-form-element f1 :reset :value "Start Again"))
;; Create for for panel 2
(f2 (create-form p2))
(fs2 (create-fieldset f2 :legend "Stuff"))
(tmp (create-label fs2 :content "Please type here:"))
(ta1 (create-text-area fs2 :columns 60 :rows 8 :label tmp))
(tmp (create-br fs2))
(rd1 (create-form-element fs2 :radio :name "rd"))
(tmp (create-label fs2 :content "To Be" :label-for rd1))
(rd2 (create-form-element fs2 :radio :name "rd"))
(tmp (create-label fs2 :content "No to Be" :label-for rd2))
(tmp (create-br fs2))
(ck1 (create-form-element fs2 :checkbox :name "ck"))
(tmp (create-label fs2 :content "Here" :label-for ck1))
(ck2 (create-form-element fs2 :checkbox :name "ck"))
(tmp (create-label fs2 :content "There" :label-for ck2))
(tmp (create-br fs2))
(sl1 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
(sl2 (create-select fs2 :label (create-label fs2 :content "Pick one:")))
(sl3 (create-select fs2 :multiple t
:label (create-label fs2 :content "Pick some:")))
(o1 (create-option sl3 :content "one"))
(o2 (create-option sl3 :content "two"))
(o3 (create-option sl3 :content "three"))
(og1 (create-optgroup sl3 :content "These are a group"))
(o4 (create-option og1 :content "four"))
(o5 (create-option og1 :content "five"))
(tmp (create-form-element f2 :submit :value "OK"))
(tmp (create-form-element f2 :reset :value "Start Again")))
(declare (ignore tmp))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 1 contents
@ -74,21 +74,21 @@
(setf (requiredp fe1) t)
(setf (size fe1) 60)
(make-data-list fe1 '("Cool Title"
"Not So Cool Title"
"Why Not, Another Title"))
"Not So Cool Title"
"Why Not, Another Title"))
(make-data-list fe2 '("#ffffff"
"#ff0000"
"#00ff00"
"#0000ff"
"#ff00ff"))
"#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
"<br><b>Your form has been submitted</b>")))
(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
"<br><b>Your form has been submitted</b>")))
(setf (width p1) "100%")
(setf (width p2) "100%")
(setf (width p3) "100%")
@ -108,30 +108,30 @@
(setf (vertical-align sl3) :top)
(setf (size sl1) 3)
(add-select-options sl1 '("one"
"two"
"three"
"four"
"five"))
"two"
"three"
"four"
"five"))
(add-select-options sl2 '("one"
"two"
"three"
"four"
"five"))
"two"
"three"
"four"
"five"))
(set-on-change sl3 (lambda (obj)
(declare (ignore obj))
(when (selectedp o5)
(alert (window body) "Selected 5"))))
(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 "<br><b>Your form has been submitted:</b>
(lambda (obj)
(declare (ignore obj))
(setf (hiddenp f2) t)
(create-span p2 :content
(format nil "<br><b>Your form has been submitted:</b>
<br>~A<hr>1 - ~A<br>2 - ~A<br>3 - ~A"
(value ta1)
(value sl1)
(value sl2)
(selectedp o2)))))
(value ta1)
(value sl1)
(value sl2)
(selectedp o2)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 3 contents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -140,26 +140,26 @@
;; 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)))))))
(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."

4
tutorial/10-tutorial.lisp
View file

@ -8,8 +8,8 @@
(defun on-new-window (body)
(setf (title (html-document body)) "Tutorial 10")
(let* ((canvas (create-canvas body :width 600 :height 400))
(cx (create-context2d canvas)))
(set-border canvas :thin :solid :black)
(cx (create-context2d canvas)))
(set-border canvas :thin :solid :black)
(fill-style cx :green)
(fill-rect cx 10 10 150 100)
(fill-style cx :blue)

44
tutorial/11-tutorial.lisp
View file

@ -40,30 +40,30 @@
(debug-mode body)
;; Setup form
(let* ((form (attach-as-child body "form1" :clog-type 'clog-form))
(good-button (attach-as-child body "button1id"))
(scary-button (attach-as-child body "button2id")))
(good-button (attach-as-child body "button1id"))
(scary-button (attach-as-child body "button2id")))
(flet ((on-click-good (obj)
(declare (ignore obj))
(let ((alert-div (create-div body)))
(place-before form alert-div)
(setf (hiddenp form) t)
;; Bootstrap specific markup
(setf (css-class-name alert-div) "alert alert-success")
(setf (attribute alert-div "role") "alert")
;; We collect the data from the hidden form elements
;; using radio-value and name-value (for other types if
;; input other than radio buttons) or we could bind each
;; control (using ATTACH-AS-CHILD)and seek their value
;; directly. See tutorial 17 and to deal with forms in
;; the old html page model of "put" and "get"
(setf (inner-html alert-div)
(format nil "<pre>radios value : ~A</pre><br>
(declare (ignore obj))
(let ((alert-div (create-div body)))
(place-before form alert-div)
(setf (hiddenp form) t)
;; Bootstrap specific markup
(setf (css-class-name alert-div) "alert alert-success")
(setf (attribute alert-div "role") "alert")
;; We collect the data from the hidden form elements
;; using radio-value and name-value (for other types if
;; input other than radio buttons) or we could bind each
;; control (using ATTACH-AS-CHILD)and seek their value
;; directly. See tutorial 17 and to deal with forms in
;; the old html page model of "put" and "get"
(setf (inner-html alert-div)
(format nil "<pre>radios value : ~A</pre><br>
<pre>textinput value : ~A</pre><br>"
(radio-value form "radios")
(name-value form "textinput")))))
(on-click-scary (obj)
(declare (ignore obj))
(reset form)))
(radio-value form "radios")
(name-value form "textinput")))))
(on-click-scary (obj)
(declare (ignore obj))
(reset form)))
;; We need to override the boostrap default to submit the form html style
(set-on-submit form (lambda (obj)(declare (ignore obj))()))
(set-on-click good-button #'on-click-good)

58
tutorial/12-tutorial.lisp
View file

@ -26,7 +26,7 @@
(defun on-main (body)
(let ((sb (create-style-block body)))
(add-style sb :element "a" '(("color" :orange)
("text-decoration" :none)))
("text-decoration" :none)))
(add-style sb :element "a:hover" '(("background-color" :gray))))
(create-div body :content
"We are in on-main<br><br>
@ -44,8 +44,8 @@
(defun on-page1 (body)
(create-div body :content
(format nil "You are in on-page1 and got here using ~A"
(path-name (location body)))))
(format nil "You are in on-page1 and got here using ~A"
(path-name (location body)))))
(defun on-page2 (body)
(create-div body :content "You are in on-page2")
@ -53,24 +53,24 @@
(defun on-tutorial11 (body)
(let* ((form (attach-as-child body "form1" :clog-type 'clog-form))
(good-button (attach-as-child body "button1id"))
(scary-button (attach-as-child body "button2id")))
(good-button (attach-as-child body "button1id"))
(scary-button (attach-as-child body "button2id")))
(flet ((on-click-good (obj)
(declare (ignore obj))
(let ((alert-div (create-div body)))
(place-before form alert-div)
(setf (hiddenp form) t)
;; Bootstrap specific markup
(setf (css-class-name alert-div) "alert alert-success")
(setf (attribute alert-div "role") "alert")
(setf (inner-html alert-div)
(format nil "<pre>radios value : ~A</pre><br>
(declare (ignore obj))
(let ((alert-div (create-div body)))
(place-before form alert-div)
(setf (hiddenp form) t)
;; Bootstrap specific markup
(setf (css-class-name alert-div) "alert alert-success")
(setf (attribute alert-div "role") "alert")
(setf (inner-html alert-div)
(format nil "<pre>radios value : ~A</pre><br>
<pre>textinput value : ~A</pre><br>"
(radio-value form "radios")
(name-value form "textinput")))))
(on-click-scary (obj)
(declare (ignore obj))
(reset form)))
(radio-value form "radios")
(name-value form "textinput")))))
(on-click-scary (obj)
(declare (ignore obj))
(reset form)))
;; We need to override the boostrap default to submit the form html style
(set-on-submit form (lambda (obj)(declare (ignore obj))()))
(set-on-click good-button #'on-click-good)
@ -78,10 +78,10 @@
(defun on-default (body)
(cond ((equalp (path-name (location body))
"/tutorial/tut-11.html")
(on-tutorial11 body))
(t
(create-div body :content "No dice! What do I do with you?"))))
"/tutorial/tut-11.html")
(on-tutorial11 body))
(t
(create-div body :content "No dice! What do I do with you?"))))
(defun add-search-optimizations (path content)
;; The default boot.html that comes with CLOG has template
@ -92,8 +92,8 @@
;; aware of these type of dynamic sites.
(if (equal path "/")
(funcall (cl-template:compile-template content)
(list :meta "<meta name='description' content='CLOG Tutorial 12'>"
:body "Tutorial 12 for CLOG"))
(list :meta "<meta name='description' content='CLOG Tutorial 12'>"
:body "Tutorial 12 for CLOG"))
content))
(defun start-tutorial ()
@ -103,9 +103,9 @@
;; for search engine optimization. We choose long-polling-first so
;; our website can be crawled for content by google
(initialize 'on-main
:long-poll-first t
:boot-function 'add-search-optimizations
:extended-routing t)
:long-poll-first t
:boot-function 'add-search-optimizations
:extended-routing t)
;; Navigating to http://127.0.0.1:8080/page1 executes on-page1
;; Since extended-routing is t /page1/any/thing/else also routes to /page1
(set-on-new-window 'on-page1 :path "/page1")
@ -124,7 +124,7 @@
;; from tutorial 11 and make it the boot-file and execute the same code
;; in (on-tutorial11) as in tutorial 11.
(set-on-new-window 'on-tutorial11 :path "/page3"
:boot-file "/tutorial/tut-11.html")
:boot-file "/tutorial/tut-11.html")
;; Setting a "default" path says that any use of an included boot.js
;; file by static html file will route to this function, in this case on-default
;; which will determine if this is coming from the path used in tutorial

4
tutorial/13-tutorial.lisp
View file

@ -11,5 +11,5 @@
to your ~~/common-lisp directory or other asdf / quicklisp~%~
directory. Then follow the directions in the 13-tutorial/README.md ~%~
directory."
(merge-pathnames "./tutorial/13-tutorial/hello-clog/"
(asdf:system-source-directory :clog))))
(merge-pathnames "./tutorial/13-tutorial/hello-clog/"
(asdf:system-source-directory :clog))))

1
tutorial/13-tutorial/hello-clog/hello-clog.asd
View file

@ -9,4 +9,3 @@
:serial t
:depends-on (#:clog)
:components ((:file "hello-clog")))

4
tutorial/13-tutorial/hello-clog/hello-clog.lisp
View file

@ -9,6 +9,6 @@
(defun start-app ()
(initialize 'on-new-window
:static-root (merge-pathnames "./www/"
(asdf:system-source-directory :hello-clog)))
:static-root (merge-pathnames "./www/"
(asdf:system-source-directory :hello-clog)))
(open-browser))

36
tutorial/14-tutorial.lisp
View file

@ -9,29 +9,29 @@
(defun on-new-window (body)
(setf (title (html-document body)) "Tutorial 14")
(set-on-click (create-button body :content "Set Local Key")
(lambda (obj)
(declare (ignore obj))
(setf (storage-element (window body) :local "my-local-key")
(get-universal-time))
(reload (location body))))
(lambda (obj)
(declare (ignore obj))
(setf (storage-element (window body) :local "my-local-key")
(get-universal-time))
(reload (location body))))
(set-on-click (create-button body :content "Set Session Key")
(lambda (obj)
(declare (ignore obj))
(setf (storage-element (window body) :session "my-session-key")
(get-universal-time))
(reload (location body))))
(lambda (obj)
(declare (ignore obj))
(setf (storage-element (window body) :session "my-session-key")
(get-universal-time))
(reload (location body))))
(set-on-storage (window body)
(lambda (obj data)
(declare (ignore obj))
(create-div body :content
(format nil "<br>~A : ~A => ~A<br>"
(getf data ':key)
(getf data ':old-value)
(getf data ':value)))))
(lambda (obj data)
(declare (ignore obj))
(create-div body :content
(format nil "<br>~A : ~A => ~A<br>"
(getf data ':key)
(getf data ':old-value)
(getf data ':value)))))
(create-div body :content (format nil
"<H1>Local Storage vs Session Storage</H1>
<p width=500>
The value of local storage persists in the browser cache even after the browser
The value of local storage persists in the browser cache even after the browser
is closed. If you reset this page the session storage key will remain the same,
but opening this page in another window or tab will be a new session. If the
new window came from a click from this window, the session keys (on some

22
tutorial/15-tutorial.lisp
View file

@ -7,17 +7,17 @@
;;; Brief demonstration of multimedia
(defun on-new-window (body)
(let* ((vid (create-video body :source "https://www.w3schools.com/html/mov_bbb.mp4"))
(tmp (create-br body))
(vpl (create-button body :content ">"))
(vst (create-button body :content "||"))
(vlc (create-form-element body :input))
(tmp (create-hr body))
(aud (create-audio body :source "https://www.w3schools.com/html/horse.ogg"))
(tmp (create-br body))
(apl (create-button body :content ">"))
(ast (create-button body :content "||"))
(alc (create-form-element body :input))
(tmp (create-hr body)))
(tmp (create-br body))
(vpl (create-button body :content ">"))
(vst (create-button body :content "||"))
(vlc (create-form-element body :input))
(tmp (create-hr body))
(aud (create-audio body :source "https://www.w3schools.com/html/horse.ogg"))
(tmp (create-br body))
(apl (create-button body :content ">"))
(ast (create-button body :content "||"))
(alc (create-form-element body :input))
(tmp (create-hr body)))
(declare (ignore tmp))
(set-on-click vpl (lambda (obj)(declare (ignore obj))(play-media vid)))
(set-on-click apl (lambda (obj)(declare (ignore obj))(play-media aud)))

82
tutorial/16-tutorial.lisp
View file

@ -16,41 +16,41 @@
;; Root page setup
(setf (title (html-document body)) "Hello Boostrap")
(let* ((nav (create-section body :nav :class "nav"))
;; Nav Bar
(l1 (create-a nav :content "link1" :class "nav-link"))
(l2 (create-a nav :content "link2" :class "nav-link"))
(l3 (create-a nav :content "link3" :class "nav-link"))
(l4 (create-a nav :content "link3" :class "nav-link" :link "/page2"))
;; Jumbotron message
(jumbo (create-div body :class "jumbotron text-center"))
(jname (create-section jumbo :h1 :content "My First Bootstrap Page"))
(tmp (create-p jumbo :content "Resize this responsive page to see the effect!"))
;; Container for three columns of text
(container (create-div body :class "container"))
(row (create-div container :class "row"))
;; Column 1
(col1 (create-div row :class "col-sm-4"))
(tmp (create-section col1 :h3 :content "Column 1"))
(tmp (create-p col1 :content "Lorem ipsum dolor.."))
;; Column 2
(col2 (create-div row :class "col-sm-4"))
(tmp (create-section col2 :h3 :content "Column 2"))
(tmp (create-p col2 :content "Lorem ipsum dolor.."))
;; Column 3
(col3 (create-div row :class "col-sm-4"))
(tmp (create-section col3 :h3 :content "Column 3"))
(tmp (create-p col3 :content "Lorem ipsum dolor..")))
;; Nav Bar
(l1 (create-a nav :content "link1" :class "nav-link"))
(l2 (create-a nav :content "link2" :class "nav-link"))
(l3 (create-a nav :content "link3" :class "nav-link"))
(l4 (create-a nav :content "link3" :class "nav-link" :link "/page2"))
;; Jumbotron message
(jumbo (create-div body :class "jumbotron text-center"))
(jname (create-section jumbo :h1 :content "My First Bootstrap Page"))
(tmp (create-p jumbo :content "Resize this responsive page to see the effect!"))
;; Container for three columns of text
(container (create-div body :class "container"))
(row (create-div container :class "row"))
;; Column 1
(col1 (create-div row :class "col-sm-4"))
(tmp (create-section col1 :h3 :content "Column 1"))
(tmp (create-p col1 :content "Lorem ipsum dolor.."))
;; Column 2
(col2 (create-div row :class "col-sm-4"))
(tmp (create-section col2 :h3 :content "Column 2"))
(tmp (create-p col2 :content "Lorem ipsum dolor.."))
;; Column 3
(col3 (create-div row :class "col-sm-4"))
(tmp (create-section col3 :h3 :content "Column 3"))
(tmp (create-p col3 :content "Lorem ipsum dolor..")))
(declare (ignore tmp) (ignore l4))
(set-on-click l1 (lambda (obj)(declare (ignore obj))(alert (window body) "Clicked link1")))
(set-on-click l1 (lambda (obj)(declare (ignore obj))(alert (window body) "Clicked link1")))
(set-on-click l2 (lambda (obj)
(declare (ignore obj))
(let* ((alert (create-div body :class "alert alert-warning alert-dismissible fade show"))
(tmp (create-phrase alert :strong :content "Wow! You clicked link 2"))
(btn (create-button alert :class "close" :content "<span>&times;</span>")))
(declare (ignore tmp))
(setf (attribute alert "role") "alert")
(setf (attribute btn "data-dismiss") "alert")
(place-after nav alert))))
(declare (ignore obj))
(let* ((alert (create-div body :class "alert alert-warning alert-dismissible fade show"))
(tmp (create-phrase alert :strong :content "Wow! You clicked link 2"))
(btn (create-button alert :class "close" :content "<span>&times;</span>")))
(declare (ignore tmp))
(setf (attribute alert "role") "alert")
(setf (attribute btn "data-dismiss") "alert")
(place-after nav alert))))
(set-on-click l3 (lambda (obj)(declare (ignore obj))(setf (color jname) (rgb 128 128 0))))))
(defun on-page2 (body)
@ -61,14 +61,14 @@
;; Setup page2
(setf (title (html-document body)) "Hello Boostrap - page2")
(let* ((nav (create-section body :nav :class "nav"))
;; Nav Bar
(l1 (create-a nav :content "link1" :class "nav-link"))
(l2 (create-a nav :content "link2" :class "nav-link"))
(l3 (create-a nav :content "link3" :class "nav-link"))
(l4 (create-a nav :content "page1" :class "nav-link" :link "/"))
;; Jumbotron
(jumbo (create-div body :class "jumbotron text-center"))
(jname (create-section jumbo :h1 :content "You found Page2")))
;; Nav Bar
(l1 (create-a nav :content "link1" :class "nav-link"))
(l2 (create-a nav :content "link2" :class "nav-link"))
(l3 (create-a nav :content "link3" :class "nav-link"))
(l4 (create-a nav :content "page1" :class "nav-link" :link "/"))
;; Jumbotron
(jumbo (create-div body :class "jumbotron text-center"))
(jname (create-section jumbo :h1 :content "You found Page2")))
(declare (ignore l1) (ignore l2) (ignore l3) (ignore l4) (ignore jname))))
(defun start-tutorial ()

132
tutorial/17-tutorial.lisp
View file

@ -15,93 +15,93 @@
;; Setup page
(setf (title (html-document body)) "Hello W3.CSS")
(let* ((header (create-section body :header :class "w3-container w3-card w3-theme"))
(tmp (create-section header :h1 :content "Explore Forms"))
;; Main area of page
(data-area (create-div body :class "w3-container"))
(tmp (create-hr data-area))
;; This is a traditional "post" form that will submit data
;; to a server.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "Post Form"))
(tmp (create-br fcontainer))
(form1 (create-form fcontainer :method :post :action "/page2"))
(finput (create-form-element form1 :input :name "yourname" :label
(create-label form1 :content "Enter name:")))
(fsubmit (create-form-element form1 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
;; This is a traditional "get" form that will submit data
;; to a server.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "Get Form"))
(tmp (create-br fcontainer))
(form2 (create-form fcontainer :method :get :action "/page3"))
(finput (create-form-element form2 :input :name "yourname" :label
(create-label form2 :content "Enter name:")))
(fsubmit (create-form-element form2 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
;; This is a file upload form that will submit data and files
;; to a server.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "File Upload Form"))
(tmp (create-br fcontainer))
(form4 (create-form fcontainer :method :post
:encoding "multipart/form-data"
:action "/page4"))
(finput (create-form-element form4 :file :name "filename"))
(fsubmit (create-form-element form4 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
;; This is a CLOG style form, instead of submitting data
;; to another page it is dealt with in place.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "CLOG Style Form"))
(tmp (create-br fcontainer))
(form3 (create-form fcontainer))
(finput3 (create-form-element form3 :input :name "yourname3" :label
(create-label form3 :content "Enter name:")))
(fsubmit3 (create-form-element form3 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
(footer (create-section body :footer :class "w3-container w3-theme"))
(tmp (create-section footer :p :content "(c) All's well that ends well")))
(tmp (create-section header :h1 :content "Explore Forms"))
;; Main area of page
(data-area (create-div body :class "w3-container"))
(tmp (create-hr data-area))
;; This is a traditional "post" form that will submit data
;; to a server.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "Post Form"))
(tmp (create-br fcontainer))
(form1 (create-form fcontainer :method :post :action "/page2"))
(finput (create-form-element form1 :input :name "yourname" :label
(create-label form1 :content "Enter name:")))
(fsubmit (create-form-element form1 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
;; This is a traditional "get" form that will submit data
;; to a server.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "Get Form"))
(tmp (create-br fcontainer))
(form2 (create-form fcontainer :method :get :action "/page3"))
(finput (create-form-element form2 :input :name "yourname" :label
(create-label form2 :content "Enter name:")))
(fsubmit (create-form-element form2 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
;; This is a file upload form that will submit data and files
;; to a server.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "File Upload Form"))
(tmp (create-br fcontainer))
(form4 (create-form fcontainer :method :post
:encoding "multipart/form-data"
:action "/page4"))
(finput (create-form-element form4 :file :name "filename"))
(fsubmit (create-form-element form4 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
;; This is a CLOG style form, instead of submitting data
;; to another page it is dealt with in place.
(fcontainer (create-div data-area :class "w3-container"))
(tmp (create-section fcontainer :h2 :content "CLOG Style Form"))
(tmp (create-br fcontainer))
(form3 (create-form fcontainer))
(finput3 (create-form-element form3 :input :name "yourname3" :label
(create-label form3 :content "Enter name:")))
(fsubmit3 (create-form-element form3 :submit))
(tmp (create-br fcontainer))
(tmp (create-hr data-area))
(footer (create-section body :footer :class "w3-container w3-theme"))
(tmp (create-section footer :p :content "(c) All's well that ends well")))
(declare (ignore tmp) (ignore finput) (ignore fsubmit))
(set-on-click fsubmit3
(lambda (obj)
(declare (ignore obj))
(setf (hiddenp data-area) t)
(place-before footer
(create-div body
:content (format nil "yourname3 = using NAME-VALUE ~A or VALUE ~A"
(name-value form3 "yourname3")
(value finput3))))))))
(declare (ignore obj))
(setf (hiddenp data-area) t)
(place-before footer
(create-div body
:content (format nil "yourname3 = using NAME-VALUE ~A or VALUE ~A"
(name-value form3 "yourname3")
(value finput3))))))))
(defun on-page2 (body)
(let ((params (form-post-data body)))
(create-div body :content params)
(create-div body :content (format nil "yourname = ~A"
(form-data-item params "yourname")))))
(form-data-item params "yourname")))))
(defun on-page3 (body)
(let ((params (form-get-data body)))
(create-div body :content params)
(create-div body :content (format nil "yourname = ~A"
(form-data-item params "yourname")))))
(form-data-item params "yourname")))))
(defun on-page4 (body)
(let ((params (form-multipart-data body)))
(create-div body :content params)
(destructuring-bind (stream fname content-type)
(form-data-item params "filename")
(form-data-item params "filename")
(create-div body :content (format nil "filename = ~A - (contents printed in REPL)" fname))
(let ((s (flexi-streams:make-flexi-stream stream :external-format :utf-8))
(b (make-string 1000)))
(loop
(let ((c (read-sequence b s)))
(unless (plusp c) (return))
(princ (subseq b 1 c))))))
(b (make-string 1000)))
(loop
(let ((c (read-sequence b s)))
(unless (plusp c) (return))
(princ (subseq b 1 c))))))
(delete-multipart-data body)))
(defun start-tutorial ()

18
tutorial/18-tutorial.lisp
View file

@ -7,10 +7,10 @@
;; Demonstrate drag and drop
(defun on-new-window (body)
(let* ((target1 (create-div body))
(target2 (create-div body))
(object (create-div target1))
(msg (create-div body
:content "Drag green box to other yellow box")))
(target2 (create-div body))
(object (create-div target1))
(msg (create-div body
:content "Drag green box to other yellow box")))
;; Instructions
(setf (positioning msg) :fixed)
(setf (top msg) "125px")
@ -45,14 +45,14 @@
(set-on-drag-over target1 (lambda (obj)(declare (ignore obj))()))
;; 5 the target on-drop event is set
(set-on-drop target1 (lambda (obj data)
(declare (ignore obj) (ignore data))
(place-inside-bottom-of target1 object)))
(declare (ignore obj) (ignore data))
(place-inside-bottom-of target1 object)))
;; Set up other box 1 also as target for returning drag box
(set-on-drag-over target2 (lambda (obj)(declare (ignore obj))()))
(set-on-drop target2 (lambda (obj data)
(declare (ignore obj))
(print (getf data :drag-data))
(place-inside-bottom-of target2 object)))))
(declare (ignore obj))
(print (getf data :drag-data))
(place-inside-bottom-of target2 object)))))
(defun start-tutorial ()
"Start tutorial."

16
tutorial/19-tutorial.lisp
View file

@ -12,19 +12,19 @@
(defun on-new-window (body)
;; First we need to load jslists' JavaScript file and css
(load-css (html-document body) "/tutorial/jslists/jsLists.css")
(load-script (html-document body) "/tutorial/jslists/jsLists.js")
(load-script (html-document body) "/tutorial/jslists/jsLists.js")
;; Second we need to build an example list. jsLists uses an ordered
;; or unordered list for its data.
(let* ((list-top (create-unordered-list body))
(item (create-list-item list-top :content "Top of tree"))
(list-b (create-unordered-list item))
(item (create-list-item list-b :content "Item 1"))
(item (create-list-item list-b :content "Item 2"))
(item (create-list-item list-b :content "Item 3"))
(item (create-list-item list-b :content "Item 4")))
(item (create-list-item list-top :content "Top of tree"))
(list-b (create-unordered-list item))
(item (create-list-item list-b :content "Item 1"))
(item (create-list-item list-b :content "Item 2"))
(item (create-list-item list-b :content "Item 3"))
(item (create-list-item list-b :content "Item 4")))
(declare (ignore item))
(js-execute body (format nil "JSLists.applyToList('~A', 'ALL');"
(html-id list-top)))))
(html-id list-top)))))
(defun start-tutorial ()
"Start tutorial."

36
tutorial/20-tutorial.lisp
View file

@ -5,20 +5,20 @@
(defpackage #:clog-toggler
(:use #:cl #:clog)
(:export clog-toggler
init-toggler
create-toggler
activate))
init-toggler
create-toggler
activate))
(in-package :clog-toggler)
;;; Next we will create a function to initialize the environment
;;; for the component.
(defun init-toggler (body &key (path-to-js "/tutorial/jslists/"))
"Initialize BODY to use clog-toggler components"
"Initialize BODY to use clog-toggler components"
(load-css (html-document body)
(concatenate 'string path-to-js "jsLists.css"))
(concatenate 'string path-to-js "jsLists.css"))
(load-script (html-document body)
(concatenate 'string path-to-js "jsLists.js")))
(concatenate 'string path-to-js "jsLists.js")))
;;; Next we will use the clog-unordered-list as the base for our new
;;; class clog-toggler
@ -29,11 +29,11 @@
(:documentation "Create a toggler."))
(defmethod create-toggler ((obj clog-obj) &key (class nil)
(html-id nil)
(auto-place t))
(html-id nil)
(auto-place t))
(let ((new-obj (create-unordered-list obj :class class
:html-id html-id
:auto-place auto-place)))
:html-id html-id
:auto-place auto-place)))
;; Using change-class we can re-use the parent clog-unordered-lists's
;; create method and its initialization. Otherwise we can use
;; create-child and the needed html.
@ -45,8 +45,8 @@
(defmethod activate ((obj clog-toggler))
(js-execute obj (format nil "JSLists.applyToList('~A', 'ALL');"
(html-id obj))))
(html-id obj))))
(defpackage #:clog-tut-20
(:use #:cl #:clog)
(:export start-tutorial))
@ -59,12 +59,12 @@
;; All create-functions also allow setting the :html-id instead of
;; using a generated id.
(let* ((toggler (clog-toggler:create-toggler body :html-id "myid"))
(item (create-list-item toggler :content "Top of tree"))
(list-b (create-unordered-list item))
(item (create-list-item list-b :content "Item 1"))
(item (create-list-item list-b :content "Item 2"))
(item (create-list-item list-b :content "Item 3"))
(item (create-list-item list-b :content "Item 4")))
(item (create-list-item toggler :content "Top of tree"))
(list-b (create-unordered-list item))
(item (create-list-item list-b :content "Item 1"))
(item (create-list-item list-b :content "Item 2"))
(item (create-list-item list-b :content "Item 3"))
(item (create-list-item list-b :content "Item 4")))
(declare (ignore item))
(clog-toggler:activate toggler)))

54
tutorial/21-tutorial.lisp
View file

@ -5,8 +5,8 @@
(defpackage #:clog-drop-list
(:use #:cl #:clog)
(:export clog-drop-list
create-drop-list
drop-root))
create-drop-list
drop-root))
(in-package :clog-drop-list)
@ -25,22 +25,22 @@ on the drop-root."))
(:documentation "Create a drop-list with CONTENT as the top of tree."))
(defmethod create-drop-list ((obj clog-obj) &key (content "")
(class nil)
(html-id nil)
(auto-place t))
(class nil)
(html-id nil)
(auto-place t))
(let* ((new-obj (create-unordered-list obj :class class
:html-id html-id
:auto-place auto-place))
(header (create-list-item new-obj :content content)))
:html-id html-id
:auto-place auto-place))
(header (create-list-item new-obj :content content)))
(change-class new-obj 'clog-drop-list)
(setf (drop-root new-obj) (create-unordered-list header))
(set-on-mouse-down header
(lambda (obj data)
(declare (ignore obj data))
(if (hiddenp (drop-root new-obj))
(setf (hiddenp (drop-root new-obj)) nil)
(setf (hiddenp (drop-root new-obj)) t)))
:cancel-event t) ; prevent event bubble up tree
(lambda (obj data)
(declare (ignore obj data))
(if (hiddenp (drop-root new-obj))
(setf (hiddenp (drop-root new-obj)) nil)
(setf (hiddenp (drop-root new-obj)) t)))
:cancel-event t) ; prevent event bubble up tree
new-obj))
(defpackage #:clog-tut-21
@ -51,19 +51,19 @@ on the drop-root."))
(defun on-new-window (body)
(let* ((drop-list (clog-drop-list:create-drop-list body :content "Top of tree"))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 2"))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 3"))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 4"))
(drop-list2 (clog-drop-list:create-drop-list item :content "Another Drop"))
(item (create-list-item (clog-drop-list:drop-root drop-list2) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list2) :content "Item 2"))
(drop-list3 (clog-drop-list:create-drop-list item :content "Hidden Drop"))
(item (create-list-item (clog-drop-list:drop-root drop-list3) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list3) :content "Item 2"))
(drop-list4 (clog-drop-list:create-drop-list drop-list :content "One more Drop"))
(item (create-list-item (clog-drop-list:drop-root drop-list4) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list4) :content "Item 2")))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 2"))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 3"))
(item (create-list-item (clog-drop-list:drop-root drop-list) :content "Item 4"))
(drop-list2 (clog-drop-list:create-drop-list item :content "Another Drop"))
(item (create-list-item (clog-drop-list:drop-root drop-list2) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list2) :content "Item 2"))
(drop-list3 (clog-drop-list:create-drop-list item :content "Hidden Drop"))
(item (create-list-item (clog-drop-list:drop-root drop-list3) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list3) :content "Item 2"))
(drop-list4 (clog-drop-list:create-drop-list drop-list :content "One more Drop"))
(item (create-list-item (clog-drop-list:drop-root drop-list4) :content "Item 1"))
(item (create-list-item (clog-drop-list:drop-root drop-list4) :content "Item 2")))
(declare (ignore item))
(setf (hiddenp (clog-drop-list:drop-root drop-list3)) t)))

198
tutorial/22-tutorial.lisp
View file

@ -15,12 +15,12 @@
(defun on-file-browse (obj)
(let ((win (create-gui-window obj :title "Browse")))
(create-child (window-content win)
"<iframe style='width:100%;height:97%;' src='https://common-lisp.net/'></iframe>")))
"<iframe style='width:100%;height:97%;' src='https://common-lisp.net/'></iframe>")))
(defun on-file-drawing (obj)
(let* ((win (create-gui-window obj :title "Drawing"))
(canvas (create-canvas (window-content win) :width 600 :height 400))
(cx (create-context2d canvas)))
(canvas (create-canvas (window-content win) :width 600 :height 400))
(cx (create-context2d canvas)))
(set-border canvas :thin :solid :black)
(fill-style cx :green)
(fill-rect cx 10 10 150 100)
@ -35,18 +35,18 @@
(defun on-file-movies (obj)
(let* ((win (create-gui-window obj :title "Movie"))
(movie (create-video (window-content win)
:source "https://www.w3schools.com/html/mov_bbb.mp4")))
(movie (create-video (window-content win)
:source "https://www.w3schools.com/html/mov_bbb.mp4")))
(set-geometry movie :units "%" :width 100 :height 100)))
(defun on-file-pinned (obj)
(let ((win (create-gui-window obj :title "Pin me!"
:has-pinner t
:keep-on-top t
:top 200
:left 0
:width 200
:height 200)))
:has-pinner t
:keep-on-top t
:top 200
:left 0
:width 200
:height 200)))
(create-div win :content "I can be pinned. Just click the pin on window bar.")))
(defun on-dlg-alert (obj)
@ -54,69 +54,69 @@
(defun on-dlg-confirm (obj)
(confirm-dialog obj "Shall we play a game?"
(lambda (input)
(if input
(alert-dialog obj "How about Global Thermonuclear War.")
(alert-dialog obj "You are no fun!")))
:ok-text "Yes" :cancel-text "No"))
(lambda (input)
(if input
(alert-dialog obj "How about Global Thermonuclear War.")
(alert-dialog obj "You are no fun!")))
:ok-text "Yes" :cancel-text "No"))
(defun on-dlg-input (obj)
(input-dialog obj "Would you like to play a game?"
(lambda (input)
(alert-dialog obj input))))
(lambda (input)
(alert-dialog obj input))))
(defun on-dlg-file (obj)
(server-file-dialog obj "Server files" "./" (lambda (fname)
(alert-dialog obj fname))))
(alert-dialog obj fname))))
(defun on-dlg-form (obj)
(form-dialog obj "Please enter your information."
'(("Title" "title" :select (("Mr." "mr")
("Mrs." "mrs" :selected)
("Ms." "ms")
("Other" "other")))
("Eye Color" "color" :radio (("Blue" "blue")
("Brown" "brown")
("Green" "green" :checked)
("Other" "other")))
("Send Mail" "send-mail" :checkbox t)
("Name" "name" :text "Real Name")
("Address" "address")
("City" "city")
("State" "st")
("Zip" "zip")
("E-Mail" "email" :email))
(lambda (results)
(alert-dialog obj results))
:height 550))
'(("Title" "title" :select (("Mr." "mr")
("Mrs." "mrs" :selected)
("Ms." "ms")
("Other" "other")))
("Eye Color" "color" :radio (("Blue" "blue")
("Brown" "brown")
("Green" "green" :checked)
("Other" "other")))
("Send Mail" "send-mail" :checkbox t)
("Name" "name" :text "Real Name")
("Address" "address")
("City" "city")
("State" "st")
("Zip" "zip")
("E-Mail" "email" :email))
(lambda (results)
(alert-dialog obj results))
:height 550))
(defun on-toast-alert (obj)
(alert-toast obj "Stop!" "To get rid of me, click the X. I have no time-out"))
(defun on-toast-warn (obj)
(alert-toast obj "Warning!" "To get rid of me, click the X. I time-out in 5 seconds"
:color-class "w3-yellow" :time-out 5))
:color-class "w3-yellow" :time-out 5))
(defun on-toast-success (obj)
(alert-toast obj "Success!" "To get rid of me, click the X. I time-out in 2 seconds"
:color-class "w3-green" :time-out 2))
:color-class "w3-green" :time-out 2))
(defun on-help-about (obj)
(let* ((about (create-gui-window obj
:title "About"
:content "<div class='w3-black'>
:title "About"
:content "<div class='w3-black'>
<center><img src='/img/clogwicon.png'></center>
<center>CLOG</center>
<center>The Common Lisp Omnificent GUI</center></div>
<div><p><center>Tutorial 22</center>
<center>CLOG</center>
<center>The Common Lisp Omnificent GUI</center></div>
<div><p><center>Tutorial 22</center>
<center>(c) 2021 - David Botton</center></p></div>"
:hidden t
:width 200
:height 215)))
:hidden t
:width 200
:height 215)))
(window-center about)
(setf (visiblep about) t)
(set-on-window-can-size about (lambda (obj)
(declare (ignore obj))()))))
(declare (ignore obj))()))))
(defun on-new-window (body)
(setf (title (html-document body)) "Tutorial 22")
@ -125,63 +125,63 @@
(clog-gui-initialize body)
(add-class body "w3-cyan")
(let* ((menu (create-gui-menu-bar body))
(tmp (create-gui-menu-icon menu :on-click 'on-help-about))
(file (create-gui-menu-drop-down menu :content "File"))
(tmp (create-gui-menu-item file :content "Count" :on-click 'on-file-count))
(tmp (create-gui-menu-item file :content "Browse" :on-click 'on-file-browse))
(tmp (create-gui-menu-item file :content "Drawing" :on-click 'on-file-drawing))
(tmp (create-gui-menu-item file :content "Movie" :on-click 'on-file-movies))
(tmp (create-gui-menu-item file :content "Pinned" :on-click 'on-file-pinned))
(win (create-gui-menu-drop-down menu :content "Window"))
(tmp (create-gui-menu-item win :content "Maximize All" :on-click 'maximize-all-windows))
(tmp (create-gui-menu-item win :content "Normalize All" :on-click 'normalize-all-windows))
(tmp (create-gui-menu-window-select win))
(dlg (create-gui-menu-drop-down menu :content "Dialogs"))
(tmp (create-gui-menu-item dlg :content "Alert Dialog Box" :on-click 'on-dlg-alert))
(tmp (create-gui-menu-item dlg :content "Input Dialog Box" :on-click 'on-dlg-input))
(tmp (create-gui-menu-item dlg :content "Confirm Dialog Box" :on-click 'on-dlg-confirm))
(tmp (create-gui-menu-item dlg :content "Form Dialog Box" :on-click 'on-dlg-form))
(tmp (create-gui-menu-item dlg :content "Server File Dialog Box" :on-click 'on-dlg-file))
(tst (create-gui-menu-drop-down menu :content "Toasts"))
(tmp (create-gui-menu-item tst :content "Alert Toast" :on-click 'on-toast-alert))
(tmp (create-gui-menu-item tst :content "Warning Toast" :on-click 'on-toast-warn))
(tmp (create-gui-menu-item tst :content "Success Toast" :on-click 'on-toast-success))
(help (create-gui-menu-drop-down menu :content "Help"))
(tmp (create-gui-menu-item help :content "About" :on-click 'on-help-about))
(tmp (create-gui-menu-full-screen menu)))
(tmp (create-gui-menu-icon menu :on-click 'on-help-about))
(file (create-gui-menu-drop-down menu :content "File"))
(tmp (create-gui-menu-item file :content "Count" :on-click 'on-file-count))
(tmp (create-gui-menu-item file :content "Browse" :on-click 'on-file-browse))
(tmp (create-gui-menu-item file :content "Drawing" :on-click 'on-file-drawing))
(tmp (create-gui-menu-item file :content "Movie" :on-click 'on-file-movies))
(tmp (create-gui-menu-item file :content "Pinned" :on-click 'on-file-pinned))
(win (create-gui-menu-drop-down menu :content "Window"))
(tmp (create-gui-menu-item win :content "Maximize All" :on-click 'maximize-all-windows))
(tmp (create-gui-menu-item win :content "Normalize All" :on-click 'normalize-all-windows))
(tmp (create-gui-menu-window-select win))
(dlg (create-gui-menu-drop-down menu :content "Dialogs"))
(tmp (create-gui-menu-item dlg :content "Alert Dialog Box" :on-click 'on-dlg-alert))
(tmp (create-gui-menu-item dlg :content "Input Dialog Box" :on-click 'on-dlg-input))
(tmp (create-gui-menu-item dlg :content "Confirm Dialog Box" :on-click 'on-dlg-confirm))
(tmp (create-gui-menu-item dlg :content "Form Dialog Box" :on-click 'on-dlg-form))
(tmp (create-gui-menu-item dlg :content "Server File Dialog Box" :on-click 'on-dlg-file))
(tst (create-gui-menu-drop-down menu :content "Toasts"))
(tmp (create-gui-menu-item tst :content "Alert Toast" :on-click 'on-toast-alert))
(tmp (create-gui-menu-item tst :content "Warning Toast" :on-click 'on-toast-warn))
(tmp (create-gui-menu-item tst :content "Success Toast" :on-click 'on-toast-success))
(help (create-gui-menu-drop-down menu :content "Help"))
(tmp (create-gui-menu-item help :content "About" :on-click 'on-help-about))
(tmp (create-gui-menu-full-screen menu)))
(declare (ignore tmp)))
;; Alternatively with-clog-create can be used to declartively create the menu
;; see tutorial 33
;; (with-clog-create body
;; (gui-menu-bar ()
;; (gui-menu-icon (:on-click 'on-help-about))
;; (gui-menu-drop-down (:content "File")
;; (gui-menu-item (:content "Count" :on-click 'on-file-count))
;; (gui-menu-item (:content "Browse" :on-click 'on-file-browse))
;; (gui-menu-item (:content "Drawing" :on-click 'on-file-drawing))
;; (gui-menu-item (:content "Movie" :on-click 'on-file-movies))
;; (gui-menu-item (:content "Pinned" :on-click 'on-file-pinned)))
;; (gui-menu-drop-down (:content "Window")
;; (gui-menu-item (:content "Maximize All" :on-click 'maximize-all-windows))
;; (gui-menu-item (:content "Normalize All" :on-click 'normalize-all-windows))
;; (gui-menu-window-select ()))
;; (gui-menu-drop-down (:content "Dialogs")
;; (gui-menu-item (:content "Alert Dialog Box" :on-click 'on-dlg-alert))
;; (gui-menu-item (:content "Input Dialog Box" :on-click 'on-dlg-input))
;; (gui-menu-item (:content "Confirm Dialog Box" :on-click 'on-dlg-confirm))
;; (gui-menu-item (:content "Form Dialog Box" :on-click 'on-dlg-form))
;; (gui-menu-item (:content "Server File Dialog Box" :on-click 'on-dlg-file)))
;; (gui-menu-drop-down (:content "Toasts")
;; (gui-menu-item (:content "Alert Toast" :on-click 'on-toast-alert))
;; (gui-menu-item (:content "Warning Toast" :on-click 'on-toast-warn))
;; (gui-menu-item (:content "Success Toast" :on-click 'on-toast-success)))
;; (gui-menu-drop-down (:content "Help")
;; (gui-menu-item (:content "About" :on-click 'on-help-about)))
;; (gui-menu-full-screen ())))
;; (gui-menu-icon (:on-click 'on-help-about))
;; (gui-menu-drop-down (:content "File")
;; (gui-menu-item (:content "Count" :on-click 'on-file-count))
;; (gui-menu-item (:content "Browse" :on-click 'on-file-browse))
;; (gui-menu-item (:content "Drawing" :on-click 'on-file-drawing))
;; (gui-menu-item (:content "Movie" :on-click 'on-file-movies))
;; (gui-menu-item (:content "Pinned" :on-click 'on-file-pinned)))
;; (gui-menu-drop-down (:content "Window")
;; (gui-menu-item (:content "Maximize All" :on-click 'maximize-all-windows))
;; (gui-menu-item (:content "Normalize All" :on-click 'normalize-all-windows))
;; (gui-menu-window-select ()))
;; (gui-menu-drop-down (:content "Dialogs")
;; (gui-menu-item (:content "Alert Dialog Box" :on-click 'on-dlg-alert))
;; (gui-menu-item (:content "Input Dialog Box" :on-click 'on-dlg-input))
;; (gui-menu-item (:content "Confirm Dialog Box" :on-click 'on-dlg-confirm))
;; (gui-menu-item (:content "Form Dialog Box" :on-click 'on-dlg-form))
;; (gui-menu-item (:content "Server File Dialog Box" :on-click 'on-dlg-file)))
;; (gui-menu-drop-down (:content "Toasts")
;; (gui-menu-item (:content "Alert Toast" :on-click 'on-toast-alert))
;; (gui-menu-item (:content "Warning Toast" :on-click 'on-toast-warn))
;; (gui-menu-item (:content "Success Toast" :on-click 'on-toast-success)))
;; (gui-menu-drop-down (:content "Help")
;; (gui-menu-item (:content "About" :on-click 'on-help-about)))
;; (gui-menu-full-screen ())))
(set-on-before-unload (window body) (lambda(obj)
(declare (ignore obj))
;; return empty string to prevent nav off page
"")))
(declare (ignore obj))
;; return empty string to prevent nav off page
"")))
(defun start-tutorial ()
"Start turtorial."

54
tutorial/23-tutorial.lisp
View file

@ -9,18 +9,18 @@
;; example show a more practical example.
(defun ask (obj)
(let ((result nil)
(hold (bordeaux-threads:make-semaphore))
(q-box (create-div obj)))
(hold (bordeaux-threads:make-semaphore))
(q-box (create-div obj)))
(set-on-click (create-button q-box :content "Yes")
(lambda (obj)
(declare (ignore obj))
(setf result :yes)
(bordeaux-threads:signal-semaphore hold)))
(lambda (obj)
(declare (ignore obj))
(setf result :yes)
(bordeaux-threads:signal-semaphore hold)))
(set-on-click (create-button q-box :content "No")
(lambda (obj)
(declare (ignore obj))
(setf result :no)
(bordeaux-threads:signal-semaphore hold)))
(lambda (obj)
(declare (ignore obj))
(setf result :no)
(bordeaux-threads:signal-semaphore hold)))
(bordeaux-threads:wait-on-semaphore hold :timeout 10)
(destroy q-box)
result))
@ -31,23 +31,23 @@
(clog-gui-initialize body)
(setf (title (html-document body)) "Tutorial 23")
(set-on-click (create-button body :content
"Click for my question. You have 10 seconds to answer.")
(lambda (obj)
(setf (disabledp obj) t)
;; ask returns once an answer is given or times out
(create-div body :content (ask body))
;; once ask returns with its answer (yes no or nil for timeout)
;; the next statment is processed to open a dialog
(let ((hold (bordeaux-threads:make-semaphore)))
(confirm-dialog body "Are you sure?"
(lambda (answer)
(if answer
(create-div body :content "Great!")
(create-div body :content "Next time be sure!"))
(bordeaux-threads:signal-semaphore hold)))
(bordeaux-threads:wait-on-semaphore hold :timeout 60)
(create-div body :content "Thank you for answering!")))
:one-time t))
"Click for my question. You have 10 seconds to answer.")
(lambda (obj)
(setf (disabledp obj) t)
;; ask returns once an answer is given or times out
(create-div body :content (ask body))
;; once ask returns with its answer (yes no or nil for timeout)
;; the next statment is processed to open a dialog
(let ((hold (bordeaux-threads:make-semaphore)))
(confirm-dialog body "Are you sure?"
(lambda (answer)
(if answer
(create-div body :content "Great!")
(create-div body :content "Next time be sure!"))
(bordeaux-threads:signal-semaphore hold)))
(bordeaux-threads:wait-on-semaphore hold :timeout 60)
(create-div body :content "Thank you for answering!")))
:one-time t))
(defun start-tutorial ()
"Start turtorial."

68
tutorial/24-tutorial.lisp
View file

@ -11,67 +11,67 @@
(clog-web-initialize body)
(setf (title (html-document body)) "Tutorial 24")
(let ((side (create-web-sidebar body :class "w3-animate-right"
:hidden t))
(main (create-web-main body)))
:hidden t))
(main (create-web-main body)))
;; Setup sidebar:
(setf (right side) (unit :px 0))
(add-card-look side)
(set-on-click (create-web-sidebar-item side :content "Close &times;"
:class "w3-teal")
(lambda (obj)
(declare (ignore obj))
(setf (display side) :none)))
:class "w3-teal")
(lambda (obj)
(declare (ignore obj))
(setf (display side) :none)))
(set-on-click (create-web-sidebar-item side :content "Google")
(lambda (obj)
(declare (ignore obj))
(setf (url (location body)) "http://google.com")))
(lambda (obj)
(declare (ignore obj))
(setf (url (location body)) "http://google.com")))
(create-web-sidebar-item side :content "item 2")
(create-web-sidebar-item side :content "item 3")
;; Setup main content:
(let* ((com (create-web-compositor main))
(img (create-img com :url-src "/img/kiarash-mansouri-fzoSNcxqtp8-unsplash.jpg"))
(btn (create-button com :content "&#9776;"
:class "w3-button w3-text-white"))
(txt (create-div com :content "CLOG - Beyond Web Frameworks!"
:class "w3-center w3-text-white w3-cursive w3-xlarge"))
(txp (create-img com :url-src "/img/clogwicon.png"))
(url (create-div com :content "https://github.com/rabbibotton/clog"
:hidden t
:class "w3-text-white w3-large")))
(img (create-img com :url-src "/img/kiarash-mansouri-fzoSNcxqtp8-unsplash.jpg"))
(btn (create-button com :content "&#9776;"
:class "w3-button w3-text-white"))
(txt (create-div com :content "CLOG - Beyond Web Frameworks!"
:class "w3-center w3-text-white w3-cursive w3-xlarge"))
(txp (create-img com :url-src "/img/clogwicon.png"))
(url (create-div com :content "https://github.com/rabbibotton/clog"
:hidden t
:class "w3-text-white w3-large")))
;; composite main image
(setf (box-width img) "100%")
(setf (box-height img) "200")
;; composite top-right button to open sidebar
(composite-top-right btn)
(set-on-click btn
(lambda (obj)
(declare (ignore obj))
(setf (display side) :block)))
(lambda (obj)
(declare (ignore obj))
(setf (display side) :block)))
;; composite middle text
(composite-middle txt)
;; composite clog icon
(composite-position txp :top 20 :left 20)
(set-on-click txp (lambda (obj)
(declare (ignore obj))
(setf (url (location body)) "https://github.com/rabbibotton/clog")))
(declare (ignore obj))
(setf (url (location body)) "https://github.com/rabbibotton/clog")))
(composite-top-middle url :padding-class :padding-32)
(set-on-mouse-enter txp (lambda (obj)
(declare (ignore obj))
(setf (visiblep url) t)))
(declare (ignore obj))
(setf (visiblep url) t)))
(set-on-mouse-leave txp (lambda (obj)
(declare (ignore obj))
(setf (visiblep url) nil)))
(declare (ignore obj))
(setf (visiblep url) nil)))
(composite-bottom-middle (create-div com :content "This is a 'compositor' container"
:class "w3-text-white")))
:class "w3-text-white")))
;; Panels
(create-web-panel main :content "<h3>Note:</h3><p>This is a 'panel' container</p>"
:class "w3-yellow")
:class "w3-yellow")
(create-section (create-web-content main :class "w3-teal")
:p :content "This is a 'content' container.
:p :content "This is a 'content' container.
The container is centered and set to a maximum-width.")
;; Using containers and the 12 column grid
(create-section (create-web-content main)
:p :content "Try and adjust size of browser to see reactions.<br>
:p :content "Try and adjust size of browser to see reactions.<br>
These are in a row container and each is a third of the 12 column grid")
(let ((row (create-web-row main)))
(create-web-container row :content "Grid Container 1" :column-size :third :class "w3-border")
@ -79,7 +79,7 @@
(create-web-container row :content "Grid Container 3" :column-size :third :class "w3-border"))
;; As before with padding added between columns and some color
(create-section (create-web-content main)
:p :content "These are in a row container with padding turned on
:p :content "These are in a row container with padding turned on
and each is a third of the 12 column grid")
(let ((row (create-web-row main :padding t)))
(create-web-container row :content "Grid Container 1" :column-size :third :class "w3-border w3-red")
@ -89,13 +89,13 @@
(create-section (create-web-content main) :p :content "These are in an auto-row container")
(let ((row (create-web-auto-row main)))
(create-web-auto-column row :content "Auto Column 1<br>Auto Column 1<br>Auto Column 1"
:vertical-align :middle :class "w3-border")
:vertical-align :middle :class "w3-border")
(create-web-auto-column row :content "Auto Column 2" :vertical-align :top :class "w3-border")
(create-web-auto-column row :content "Auto Column 3" :vertical-align :bottom :class "w3-border"))
;; A "code" block
(create-section (create-web-content main) :p :content "This a code block")
(create-web-code main :content
";; This is a code block<br>
";; This is a code block<br>
(defun start-tutorial ()<br>
\"Start turtorial.\"<br>
(initialize 'on-new-window)<br>

52
tutorial/25-tutorial.lisp
View file

@ -27,41 +27,41 @@
(setf (title (html-document body)) "Tutorial 25")
;; Setup two sections = command and result
(let ((command-section (create-web-content body))
(results-section (create-web-content body :class "w3-monospace")))
(results-section (create-web-content body :class "w3-monospace")))
;; Setup command section
(let* ((form (create-form command-section))
(command (create-form-element form :text :class "w3-input w3-border"
:label (create-label form
:content "Enter Command: ")))
(button (create-form-element form :submit)))
(command (create-form-element form :text :class "w3-input w3-border"
:label (create-label form
:content "Enter Command: ")))
(button (create-form-element form :submit)))
(declare (ignore button))
(set-on-submit form
(lambda (obj)
(declare (ignore obj))
(handler-case
(progn
(setf (inner-html results-section)
(format nil "~A<br><span style='color:blue'>~A</span><br>~A"
(inner-html results-section)
(value command)
(lf-to-br (uiop/run-program:run-program
(value command)
:force-shell t :output :string))))
(setf (scroll-top results-section)
(scroll-height results-section)))
(error (c)
(clog-web-alert command-section "Error" c :time-out 5)))
(setf (value command) ""))))
(lambda (obj)
(declare (ignore obj))
(handler-case
(progn
(setf (inner-html results-section)
(format nil "~A<br><span style='color:blue'>~A</span><br>~A"
(inner-html results-section)
(value command)
(lf-to-br (uiop/run-program:run-program
(value command)
:force-shell t :output :string))))
(setf (scroll-top results-section)
(scroll-height results-section)))
(error (c)
(clog-web-alert command-section "Error" c :time-out 5)))
(setf (value command) ""))))
(setf (overflow results-section) :scroll)
(set-border results-section :thin :solid :black)
(flet ((set-height ()
(setf (height results-section) (- (inner-height (window body))
(height command-section)
20))))
(setf (height results-section) (- (inner-height (window body))
(height command-section)
20))))
(set-height)
(set-on-resize (window body) (lambda (obj)
(declare (ignore obj))
(set-height))))))
(declare (ignore obj))
(set-height))))))
(defun start-tutorial ()
"Start turtorial."

98
tutorial/26-tutorial.lisp
View file

@ -19,25 +19,25 @@
(setf (title (html-document body)) "Tutorial 26")
;; Install a menu
(let* ((menu (create-web-menu-bar body))
(icon (create-web-menu-icon menu :on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(item1 (create-web-menu-item menu :content "item1"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(item2 (create-web-menu-item menu :content "item2"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(item3 (create-web-menu-item menu :content "item3"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(about (create-web-menu-item menu :content "About"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2")))))
(icon (create-web-menu-icon menu :on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(item1 (create-web-menu-item menu :content "item1"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(item2 (create-web-menu-item menu :content "item2"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(item3 (create-web-menu-item menu :content "item3"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2"))))
(about (create-web-menu-item menu :content "About"
:on-click (lambda (obj)
(declare (ignore obj))
(setf (hash (location body)) "rung2")))))
(declare (ignore icon))
(full-row-on-mobile item1)
(full-row-on-mobile item2)
@ -45,52 +45,52 @@
(add-class about "w3-right"))
;; rung-1
(let* ((first-rung (create-web-compositor body :html-id "rung1"))
(image (create-img first-rung :url-src "/img/windmills.jpg"
:class "w3-sepia"))
(clog-txt (create-div first-rung :content "CLOG<br><u>The omnificient gui</u><br>
(image (create-img first-rung :url-src "/img/windmills.jpg"
:class "w3-sepia"))
(clog-txt (create-div first-rung :content "CLOG<br><u>The omnificient gui</u><br>
desktop<br>web<br>mobile"
:class "w3-text-white w3-xlarge")))
:class "w3-text-white w3-xlarge")))
(setf (cursor clog-txt) :pointer)
(set-on-click clog-txt (lambda (obj)
(declare (ignore obj))
(setf (display first-rung) :none)
(setf (hash (location body)) "rung2")))
(declare (ignore obj))
(setf (display first-rung) :none)
(setf (hash (location body)) "rung2")))
(setf (box-width image) "100%")
(setf (text-shadow clog-txt) "2px 2px black")
(composite-top-left clog-txt :padding-class :padding-64))
;; rung-2
(let* ((second-rung (create-web-auto-row body :html-id "rung2"))
(image-cell (create-web-auto-column second-rung))
(image (create-img image-cell :url-src "/img/flower-clogs.jpg"))
(text-cell (create-web-auto-column second-rung :class "w3-cell-top")))
(image-cell (create-web-auto-column second-rung))
(image (create-img image-cell :url-src "/img/flower-clogs.jpg"))
(text-cell (create-web-auto-column second-rung :class "w3-cell-top")))
(hide-on-small-screens image-cell)
(setf (background-color text-cell) (rgb 199 188 160))
(setf (box-width image-cell) "40%")
(setf (box-width image) "100%")
(clog-web-form text-cell
"<H2>Find out more about CLOG:</H2>"
'(("CLOG for" :clog-for :select (("Desktop" "desktop" :selected)
("Web" "web")
("Mobile" "mobile")
("iot" "iot")))
("Name" :name)
("E-mail" :email))
(lambda (data)
(if (equal (cadr (assoc :email data)) "")
(clog-web-alert second-rung "Missing E-Mail"
"Please fill out E-mail" :time-out 2)
(progn
(setf (display second-rung) :none)
(setf (hash (location body)) "rung3")
(setf (inner-html (attach-as-child body "rung3-answer"))
(format nil "<br><br>Thank you ~A<br>Your information will
"<H2>Find out more about CLOG:</H2>"
'(("CLOG for" :clog-for :select (("Desktop" "desktop" :selected)
("Web" "web")
("Mobile" "mobile")
("iot" "iot")))
("Name" :name)
("E-mail" :email))
(lambda (data)
(if (equal (cadr (assoc :email data)) "")
(clog-web-alert second-rung "Missing E-Mail"
"Please fill out E-mail" :time-out 2)
(progn
(setf (display second-rung) :none)
(setf (hash (location body)) "rung3")
(setf (inner-html (attach-as-child body "rung3-answer"))
(format nil "<br><br>Thank you ~A<br>Your information will
NOT be sent shortly.(DEMO)"
(cadr (assoc :name data)))))))))
(cadr (assoc :name data)))))))))
;; rung-3
(let* ((third-rung (create-web-compositor body :html-id "rung3"))
(image (create-img third-rung :url-src "/img/yellow-clogs.jpg"))
(txt (create-div third-rung :html-id "rung3-answer"
:class "w3-text-white w3-xlarge")))
(image (create-img third-rung :url-src "/img/yellow-clogs.jpg"))
(txt (create-div third-rung :html-id "rung3-answer"
:class "w3-text-white w3-xlarge")))
(setf (text-shadow txt) "2px 2px black")
(composite-right txt :padding-class :padding-64)
(setf (box-width image) "100%")))

22
tutorial/27-tutorial.lisp
View file

@ -8,11 +8,11 @@
(defun on-new-window (body)
(let* ((console (create-panel-box-layout body :left-width 200 :right-width 0))
(head (create-div (top-panel console) :content "Image Viewer"))
(lbox (create-select (left-panel console)))
(viewer (create-img (center-panel console)))
(footer (create-div (bottom-panel console)
:content "(c) 2021 David Botton - BSD 3 Lic.")))
(head (create-div (top-panel console) :content "Image Viewer"))
(lbox (create-select (left-panel console)))
(viewer (create-img (center-panel console)))
(footer (create-div (bottom-panel console)
:content "(c) 2021 David Botton - BSD 3 Lic.")))
(declare (ignore footer))
;; Setup Top
(setf (background-color (top-panel console)) :teal)
@ -26,13 +26,13 @@
(setf (size lbox) 2) ;; A size above 1 needed to get listbox
(set-geometry lbox :left 0 :top 0 :bottom 0 :width 200)
(add-select-options lbox '("kiarash-mansouri-fzoSNcxqtp8-unsplash.jpg"
"windmills.jpg"
"yellow-clogs.jpg"
"clogicon.png"))
"windmills.jpg"
"yellow-clogs.jpg"
"clogicon.png"))
(set-on-change lbox (lambda (obj)
(declare (ignore obj))
(setf (url-src viewer) (format nil "/img/~A"
(value lbox)))))
(declare (ignore obj))
(setf (url-src viewer) (format nil "/img/~A"
(value lbox)))))
;; Setup Bottom
(center-children (bottom-panel console) :horizontal nil)))

4
tutorial/28-tutorial.lisp
View file

@ -11,5 +11,5 @@
to your ~~/common-lisp directory or other asdf / quicklisp~%~
directory. Then follow the directions in the 28-tutorial/README.md ~%~
directory."
(merge-pathnames "./tutorial/28-tutorial/hello-builder/"
(asdf:system-source-directory :clog))))
(merge-pathnames "./tutorial/28-tutorial/hello-builder/"
(asdf:system-source-directory :clog))))

3
tutorial/28-tutorial/hello-builder/hello-builder.asd
View file

@ -9,5 +9,4 @@
:serial t
:depends-on (#:clog)
:components ((:file "hello-builder")
(:file "hello")))
(:file "hello")))

4
tutorial/28-tutorial/hello-builder/hello-builder.lisp
View file

@ -10,6 +10,6 @@
(defun start-app ()
(initialize 'create-hello-page
:static-root (merge-pathnames "./www/"
(asdf:system-source-directory :hello-builder)))
:static-root (merge-pathnames "./www/"
(asdf:system-source-directory :hello-builder)))
(open-browser))

48
tutorial/29-tutorial.lisp
View file

@ -13,52 +13,52 @@
(defun on-new-window (body)
(let* ((lisp-obj (make-instance 'my-class))
(i1 (create-form-element body :text
:label (create-label body :content "Form value:")))
(i2 (create-form-element body :text
:label (create-label body :content "(my-slot lisp-obj) value:")))
(b1 (create-button body :content "Set (my-slot lisp-obj) Value"))
(b2 (create-button body :content "Get (my-slot lisp-obj) Value"))
(tmp (create-br body))
(t1 (create-div body :content "[counter]"))
(i3 (create-form-element body :text
:label (create-label body :content "Change my-count:")))
(tmp (create-br body))
(t2 (create-div body :content "'Hello'")))
(i1 (create-form-element body :text
:label (create-label body :content "Form value:")))
(i2 (create-form-element body :text
:label (create-label body :content "(my-slot lisp-obj) value:")))
(b1 (create-button body :content "Set (my-slot lisp-obj) Value"))
(b2 (create-button body :content "Get (my-slot lisp-obj) Value"))
(tmp (create-br body))
(t1 (create-div body :content "[counter]"))
(i3 (create-form-element body :text
:label (create-label body :content "Change my-count:")))
(tmp (create-br body))
(t2 (create-div body :content "'Hello'")))
(declare (ignore tmp))
;; We set up direct relationships between lisp objects and clog objects
;; any change to i1 will change my-slot and any change to my-slot
;; will change i1 and transform it with #'string-upcase
(link-slot-and-form-element lisp-obj my-slot i1
:transform-to-element #'string-upcase)
:transform-to-element #'string-upcase)
;; any change to my-count will change t1
(link-slot-to-element lisp-obj my-count t1)
;; any change to i3 will change my-count
;; and i3's value will be transformed to an integer
(link-form-element-to-slot i3 lisp-obj my-count
:transform #'parse-integer)
:transform #'parse-integer)
;; Clicking on t2 will set my-slot to its text
(link-element-to-slot t2 lisp-obj my-slot :set-event #'set-on-click)
;; This change of my-slot will immediately change in the web page
(setf (my-slot lisp-obj) "First Value")
(set-on-click b1
(lambda (obj)
(declare (ignore obj))
(setf (my-slot lisp-obj) (value i2))))
(lambda (obj)
(declare (ignore obj))
(setf (my-slot lisp-obj) (value i2))))
(set-on-click b2
(lambda (obj)
(declare (ignore obj))
(setf (value i2) (my-slot lisp-obj))))
(lambda (obj)
(declare (ignore obj))
(setf (value i2) (my-slot lisp-obj))))
;; Use jQuery to set all inputs to have a background color
(setf (background-color (create-jquery body "input[type=text]")) :beige)
;; This updates an element on the page by just changing the value of the linked
;; slot and my-count can be adjusted mid loop from web page
(loop
(cond ((> (my-count lisp-obj) 0)
(decf (my-count lisp-obj))
(sleep .2))
(t
(return))))))
(decf (my-count lisp-obj))
(sleep .2))
(t
(return))))))
(defun start-tutorial ()
(initialize 'on-new-window)

42
tutorial/30-tutorial.lisp
View file

@ -13,19 +13,19 @@
(defun init-site (body)
(clog-web-initialize body)
(create-web-site body
;; use the default theme
:theme 'clog-web:default-theme
;; theme settings - in this case w3.css color of menu bar
:settings '(:color-class "w3-black")
:title "CLOG - The Common Lisp Omnificent GUI"
:footer "(c) 2022 David Botton"
:logo "/img/clog-liz.png"))
;; use the default theme
:theme 'clog-web:default-theme
;; theme settings - in this case w3.css color of menu bar
:settings '(:color-class "w3-black")
:title "CLOG - The Common Lisp Omnificent GUI"
:footer "(c) 2022 David Botton"
:logo "/img/clog-liz.png"))
;; This is the menu structure
(defparameter *menu* `(("Content" (("Home" "/" on-main)
("Content from Lambda" "/lambda" on-lambda)
("Content from File" "/readme" on-readme)))
("Help" (("About" "/about" on-about)))))
("Content from Lambda" "/lambda" on-lambda)
("Content from File" "/readme" on-readme)))
("Help" (("About" "/about" on-about)))))
;; Page handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -35,38 +35,38 @@
;; We call init-site on every page to load our theme and settings
(init-site body)
(create-web-page body :main `(:menu ,*menu*
:content "<b>Welcome to tutorial 30</b><p>Any HTML works!")))
:content "<b>Welcome to tutorial 30</b><p>Any HTML works!")))
;; /readme - get content from a text file
(defun on-readme (body)
(init-site body)
(let ((readme (alexandria:read-file-into-string
(format nil "~A~A" (asdf:system-source-directory :clog) "README.md"))))
(format nil "~A~A" (asdf:system-source-directory :clog) "README.md"))))
(create-web-page body :main `(:menu ,*menu*
:content ,(format nil "<pre>~A</pre>" readme)))))
:content ,(format nil "<pre>~A</pre>" readme)))))
;; /lambda - use a function to output to the page content
(defun on-lambda (body)
(init-site body)
(create-web-page body :main `(:menu ,*menu*
:content ,(lambda (obj)
(create-div obj :content "I am in the content area")))))
:content ,(lambda (obj)
(create-div obj :content "I am in the content area")))))
;; /about
(defun on-about (body)
(init-site body)
(create-web-page body :main `(:menu ,*menu*
:content "About Me")))
:content "About Me")))
;; Start the webserver
(defun start-tutorial ()
;; Initialize CLOG and the / url path (since / in our menu could just be nil)
(initialize 'on-main
;; Use long polling technique so pages are crawled by google
:long-poll-first t
;; Supply some meta info
:boot-function (clog-web-meta
"clogpower.com - CLOG - the common lisp omnificent gui"))
;; Use long polling technique so pages are crawled by google
:long-poll-first t
;; Supply some meta info
:boot-function (clog-web-meta
"clogpower.com - CLOG - the common lisp omnificent gui"))
;; clog web helper to set up routes in menu
(clog-web-routes-from-menu *menu*)
(open-browser))

100
tutorial/31-tutorial.lisp
View file

@ -25,11 +25,11 @@
; Menu Menu Item URL Handler Actions Auth
(defparameter *menu* `(("Features" (("Login" "/login" on-login :login)
("Signup" "/signup" on-signup :signup)
("Main" "/main" on-main :main)
("Logout" "/logout" on-logout :logout)))
("Admin" (("User List" "/users" on-users :users)))
("Help" (("About" "/about" on-about))))
("Signup" "/signup" on-signup :signup)
("Main" "/main" on-main :main)
("Logout" "/logout" on-logout :logout)))
("Admin" (("User List" "/users" on-users :users)))
("Help" (("About" "/about" on-about))))
"Setup website menu")
(defun start-tutorial ()
@ -51,9 +51,9 @@
(create-base-tables *sql-connection*)))
;; Setup clog, using long polling for web crawlers and some meta info
(initialize 'on-main
:long-poll-first t
:boot-function (clog-web-meta
"clogpower.com - CLOG - the common lisp omnificent gui"))
:long-poll-first t
:boot-function (clog-web-meta
"clogpower.com - CLOG - the common lisp omnificent gui"))
(clog-web-routes-from-menu *menu*)
(open-browser))
@ -68,24 +68,24 @@
(clog-web-initialize body)
;; Instantly reload other windows open on authentication change
(set-on-authentication-change body (lambda (body)
(url-replace (location body) "/")))
(url-replace (location body) "/")))
;; Initialzie the clog-web-site environment
(let ((profile (get-profile body *sql-connection*)))
(create-web-site body
:settings '(:color-class "w3-blue-gray"
:border-class ""
:signup-link "/signup"
:login-link "/login")
:profile profile
:roles (if profile
(if (equalp "admin"
(getf profile :|username|))
'(:member :admin)
'(:member))
'(:guest))
:title "CLOG - The Common Lisp Omnificent GUI"
:footer "(c) 2022 David Botton"
:logo "/img/clog-liz.png")))
:settings '(:color-class "w3-blue-gray"
:border-class ""
:signup-link "/signup"
:login-link "/login")
:profile profile
:roles (if profile
(if (equalp "admin"
(getf profile :|username|))
'(:member :admin)
'(:member))
'(:guest))
:title "CLOG - The Common Lisp Omnificent GUI"
:footer "(c) 2022 David Botton"
:logo "/img/clog-liz.png")))
;;
;; URL Path Handlers
@ -97,15 +97,15 @@
(create-web-page
body
:login `(:menu ,*menu*
:on-submit ,(lambda (obj)
(if (login body *sql-connection*
(name-value obj "username")
(name-value obj "password"))
;; url-replace removes login from history stack
(url-replace (location body) "/main")
(clog-web-alert obj "Invalid" "The username and password are invalid."
:time-out 3
:place-top t))))
:on-submit ,(lambda (obj)
(if (login body *sql-connection*
(name-value obj "username")
(name-value obj "password"))
;; url-replace removes login from history stack
(url-replace (location body) "/main")
(clog-web-alert obj "Invalid" "The username and password are invalid."
:time-out 3
:place-top t))))
;; don't authorize use of page if logged in
:authorize t))
@ -116,33 +116,33 @@
(defun on-signup (body)
(init-site body)
(create-web-page body
:signup `(:menu ,*menu*
:content ,(lambda (body)
(sign-up body *sql-connection*)))
;; don't authorize use of page if logged in
:authorize t))
:signup `(:menu ,*menu*
:content ,(lambda (body)
(sign-up body *sql-connection*)))
;; don't authorize use of page if logged in
:authorize t))
(defun on-main (body)
(init-site body)
(create-web-page body :main `(:menu ,*menu*
:content "I am the main page")))
:content "I am the main page")))
(defun on-about (body)
(init-site body)
(create-web-page body :about `(:menu ,*menu*
:content "About Me")))
:content "About Me")))
(defun on-users (body)
(init-site body)
(create-web-page body :users
`(:menu ,*menu*
:content ,(lambda (body)
(let ((users (dbi:fetch-all
(dbi:execute
(dbi:prepare
*sql-connection*
"select * from users")))))
(dolist (user users)
(create-div body :content (getf user :|username|))))))
;; don't authorize use of page unless you are the admin
:authorize t))
`(:menu ,*menu*
:content ,(lambda (body)
(let ((users (dbi:fetch-all
(dbi:execute
(dbi:prepare
*sql-connection*
"select * from users")))))
(dolist (user users)
(create-div body :content (getf user :|username|))))))
;; don't authorize use of page unless you are the admin
:authorize t))

148
tutorial/32-tutorial.lisp
View file

@ -32,13 +32,13 @@
; Menu Menu Item URL Handler Actions Auth
(defparameter *menu* `(("Features" (("Home" "/")
("Login" "/login" on-login :login)
("Signup" "/signup" on-signup :signup)
("Change Password" "/pass" on-new-pass :change-password)
("Content" "/content" on-main :content)
("Logout" "/logout" on-logout :logout)))
("Admin" (("User List" "/users" on-users :users)))
("Help" (("About" "/content/about"))))
("Login" "/login" on-login :login)
("Signup" "/signup" on-signup :signup)
("Change Password" "/pass" on-new-pass :change-password)
("Content" "/content" on-main :content)
("Logout" "/logout" on-logout :logout)))
("Admin" (("User List" "/users" on-users :users)))
("Help" (("About" "/content/about"))))
"Setup website menu")
(defun start-tutorial ()
@ -47,8 +47,8 @@
(add-authorization '(:guest :member) '(:content-show-comments))
(add-authorization '(:guest) '(:login :signup))
(add-authorization '(:member) '(:logout
:change-password
:content-comment))
:change-password
:content-comment))
(add-authorization '(:editor) '(:content-edit))
(add-authorization '(:admin) '(:users :content-admin))
;; Setup database connection
@ -65,17 +65,17 @@
(create-base-tables *sql-connection*)
;; A main page was added, but let's also add an about page:
(dbi:do-sql
*sql-connection*
(sql-insert* "content" `(:key "about"
:title "About Tutorial 32"
:value "All about me."
:createdate (,*sqlite-timestamp*))))))
*sql-connection*
(sql-insert* "content" `(:key "about"
:title "About Tutorial 32"
:value "All about me."
:createdate (,*sqlite-timestamp*))))))
;; Setup clog
(initialize 'on-main
:long-poll-first t
:extended-routing t
:boot-function (clog-web-meta
"clogpower.com - CLOG - the common lisp omnificent gui"))
:long-poll-first t
:extended-routing t
:boot-function (clog-web-meta
"clogpower.com - CLOG - the common lisp omnificent gui"))
(clog-web-routes-from-menu *menu*)
(open-browser))
@ -90,27 +90,27 @@
(clog-web-initialize body)
;; Instantly reload other windows open on authentication change
(set-on-authentication-change body (lambda (body)
(url-replace (location body) "/")))
(url-replace (location body) "/")))
;; Initialzie the clog-web-site environment
(let ((profile (get-profile body *sql-connection*)))
(create-web-site body
:settings '(:color-class "w3-blue-gray"
:border-class ""
:signup-link "/signup"
:login-link "/login")
:profile profile
;; We define the roles simply if logged out a :guest
;; if logged in a :member and if username is admin
;; a :member, :editor and :admin.
:roles (if profile
(if (equalp "admin"
(getf profile :|username|))
'(:member :editor :admin)
'(:member))
'(:guest))
:title "CLOG - The Common Lisp Omnificent GUI"
:footer "(c) 2022 David Botton"
:logo "/img/clog-liz.png")))
:settings '(:color-class "w3-blue-gray"
:border-class ""
:signup-link "/signup"
:login-link "/login")
:profile profile
;; We define the roles simply if logged out a :guest
;; if logged in a :member and if username is admin
;; a :member, :editor and :admin.
:roles (if profile
(if (equalp "admin"
(getf profile :|username|))
'(:member :editor :admin)
'(:member))
'(:guest))
:title "CLOG - The Common Lisp Omnificent GUI"
:footer "(c) 2022 David Botton"
:logo "/img/clog-liz.png")))
;;
;; URL Path Handlers
@ -122,14 +122,14 @@
(create-web-page
body
:login `(:menu ,*menu*
:on-submit ,(lambda (obj)
(if (login body *sql-connection*
(name-value obj "username")
(name-value obj "password"))
(url-replace (location body) "/")
(clog-web-alert obj "Invalid" "The username and password are invalid."
:time-out 3
:place-top t))))
:on-submit ,(lambda (obj)
(if (login body *sql-connection*
(name-value obj "username")
(name-value obj "password"))
(url-replace (location body) "/")
(clog-web-alert obj "Invalid" "The username and password are invalid."
:time-out 3
:place-top t))))
:authorize t))
(defun on-logout (body)
@ -139,45 +139,45 @@
(defun on-signup (body)
(init-site body)
(create-web-page body
:signup `(:menu ,*menu*
:content ,(lambda (body)
(sign-up body *sql-connection*)))
:authorize t))
:signup `(:menu ,*menu*
:content ,(lambda (body)
(sign-up body *sql-connection*)))
:authorize t))
(defun on-main (body)
(init-site body)
(create-web-page body :index `(:menu ,*menu*
:content ,(clog-web-content *sql-connection*
:comment-table "content"))))
:content ,(clog-web-content *sql-connection*
:comment-table "content"))))
(defun on-users (body)
(init-site body)
(create-web-page body :users
`(:menu ,*menu*
:content ,(lambda (body)
(let ((users (dbi:fetch-all
(dbi:execute
(dbi:prepare
*sql-connection*
"select * from users")))))
(dolist (user users)
(let* ((box (create-div body))
(suser (create-span box :content (getf user :|username|)))
(rbut (create-button box :content "Reset Password"
:class "w3-margin-left")))
(declare (ignore suser))
(set-on-click rbut (lambda (obj)
(declare (ignore obj))
(reset-password *sql-connection*
(getf user :|username|))
(setf (disabledp rbut) t)
(setf (text rbut) "Done"))))))))
:authorize t))
`(:menu ,*menu*
:content ,(lambda (body)
(let ((users (dbi:fetch-all
(dbi:execute
(dbi:prepare
*sql-connection*
"select * from users")))))
(dolist (user users)
(let* ((box (create-div body))
(suser (create-span box :content (getf user :|username|)))
(rbut (create-button box :content "Reset Password"
:class "w3-margin-left")))
(declare (ignore suser))
(set-on-click rbut (lambda (obj)
(declare (ignore obj))
(reset-password *sql-connection*
(getf user :|username|))
(setf (disabledp rbut) t)
(setf (text rbut) "Done"))))))))
:authorize t))
(defun on-new-pass (body)
(init-site body)
(create-web-page body
:change-password `(:menu ,*menu*
:content ,(lambda (body)
(change-password body *sql-connection*)))
:authorize t))
:change-password `(:menu ,*menu*
:content ,(lambda (body)
(change-password body *sql-connection*)))
:authorize t))

256
tutorial/33-tutorial.lisp
View file

@ -28,148 +28,148 @@
;; :bind var
(with-clog-create body
(div ()
(button (:bind t1 :content "Tab1"))
(button (:bind t1 :content "Tab1"))
(button (:bind t2 :content "Tab2"))
(button (:bind t3 :content "Tab3"))
(br ())
;; Panel 1
;; 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
;; 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")))
;; 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
;; 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
"<br><b>Your form has been submitted</b>")))
(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)
(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
"<br><b>Your form has been submitted</b>")))
(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
;; 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 "<br><b>Your form has been submitted:</b>
(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 "<br><b>Your form has been submitted:</b>
<br>~A<hr>1 - ~A<br>2 - ~A<br>3 - ~A"
(value ta1)
(value sl1)
(value sl2)
(selectedp o2)))))
(value ta1)
(value sl1)
(value sl2)
(selectedp o2)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 3 contents
;; Panel 3 contents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf (editablep p3) t)
(setf (editablep p3) t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tab functionality
;; 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))))))))
(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."