-
-
Notifications
You must be signed in to change notification settings - Fork 108
/
Copy path33-tutorial.lisp
176 lines (170 loc) · 8.39 KB
/
33-tutorial.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
;; In this tutorial we redo Tutorial 9 using with-clog-create a far
;; more elegant way to set up GUIs in code using a declartive
;; syntax. The with-clog-create macro takes the place of using let*
;; and many temporary variables. This macro was designed by Mariano
;; Montone and illustrates nicely the advantage the programmable
;; language has at all levels of use to simplify complexity.
;;
;; Thanks Mariano!
(defpackage #:clog-tut-33
(:use #:cl #:clog)
(:export start-tutorial))
(in-package :clog-tut-33)
(defun on-new-window (body)
(setf (title (html-document body)) "Tutorial 33")
(with-connection-cache (body)
(let* (last-tab)
;; Create tabs and panels Using with-clog-create allows you to
;; replace using "let" to create your code based gui layout.
;;
;; To use the macro you remove the create- from the create
;; functions. The clog-obj passed as the first parameter of the
;; macro is passed as the parent obj to the declared object,
;; after that nested levels of decleraton are used as the parent
;; clog-obj. To bind a variable to any created clog object using
;; :bind var
(with-clog-create body
(div ()
(button (:bind t1 :content "Tab1"))
(button (:bind t2 :content "Tab2"))
(button (:bind t3 :content "Tab3"))
(br ())
;; Panel 1
(div (:bind p1)
;; Create form for panel 1
(form (:bind f1)
(form-element (:bind fe1 :text :label (create-label f1 :content "Fill in blank:")))
(br ())
(form-element (:bind fe2 :color :value "#ffffff"
:label (create-label f1 :content "Pick a color:")))
(br ())
(form-element (:submit :value "OK"))
(form-element (:reset :value "Start Again"))))
;; Panel 2
(div (:bind p2)
;; Create form for panel 2
(form (:bind f2)
(fieldset (:bind fs2 :legend "Stuff")
(label (:bind lbl :content "Please type here:"))
(text-area (:bind ta1 :columns 60 :rows 8 :label lbl))
(br ())
(form-element (:bind rd1 :radio :name "rd"))
(label (:content "To Be" :label-for rd1))
(form-element (:bind rd2 :radio :name "rd"))
(label (:content "No to Be" :label-for rd2))
(br ())
(form-element (:bind ck1 :checkbox :name "ck"))
(label (:content "Here" :label-for ck1))
(form-element (:bind ck2 :checkbox :name "ck"))
(label (:content "There" :label-for ck2))
(br ())
(select (:bind sl1 :label (create-label fs2 :content "Pick one:")))
(select (:bind sl2 :label (create-label fs2 :content "Pick one:")))
(select (:bind sl3 :multiple t :label (create-label fs2 :content "Pick some:"))
(option (:content "one"))
(option (:bind o2 :content "two"))
(option (:content "three"))
(optgroup (:content "These are a group")
(option (:content "four"))
(option (:bind o5 :content "five")))))
(form-element (:submit :value "OK"))
(form-element (:reset :value "Start Again"))))
;; Panel 3
(div (:bind p3 :content "Panel3 - Type here")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 1 contents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf (place-holder fe1) "type here..")
(setf (requiredp fe1) t)
(setf (size fe1) 60)
(make-data-list fe1 '("Cool Title"
"Not So Cool Title"
"Why Not, Another Title"))
(make-data-list fe2 '("#ffffff"
"#ff0000"
"#00ff00"
"#0000ff"
"#ff00ff"))
(set-on-submit f1
(lambda (obj)
(declare (ignore obj))
(setf (title (html-document body)) (value fe1))
(setf (background-color p1) (value fe2))
(setf (hiddenp f1) t)
(create-span p1 :content
"<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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Panel 3 contents
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf (editablep p3) t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tab functionality
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(flet ((select-tab (obj)
(setf (hiddenp p1) t)
(setf (hiddenp p2) t)
(setf (hiddenp p3) t)
(setf (background-color t1) :lightgrey)
(setf (background-color t2) :lightgrey)
(setf (background-color t3) :lightgrey)
(setf (background-color last-tab) :lightblue)
(setf (hiddenp obj) nil)
(focus obj)))
(setf last-tab t1)
(select-tab p1)
(set-on-click t1 (lambda (obj)
(setf last-tab obj)
(select-tab p1)))
(set-on-click t2 (lambda (obj)
(setf last-tab obj)
(select-tab p2)))
(set-on-click t3 (lambda (obj)
(setf last-tab obj)
(select-tab p3))))))))
(defun start-tutorial ()
"Start tutorial."
(initialize 'on-new-window)
(open-browser))