Random Bits of Open Code

Check-in [7a7ed4401c]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fleshed out raw basic gui for multiapp demo app teach-learn
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:7a7ed4401c275ffd7a5076808f443ef45ec49b1a
User & Date: matt 2018-07-13 06:01:05
Context
2018-07-15
22:23
Set up for factoring out useful gui stuff into gui.scm check-in: e1291c5839 user: matt tags: trunk
2018-07-13
06:01
fleshed out raw basic gui for multiapp demo app teach-learn check-in: 7a7ed4401c user: matt tags: trunk
05:18
First pass of multiapp check-in: 3e16b01508 user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to multiapp/src/learn-teach.scm.

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
177
178
179
180
181
182
183
  (let* ((bundle-filter-tb   (iup:textbox value: "%"  expand: "HORIZONTAL" action: (lambda (obj a b)(reset-request 'reset))))
	;; (top-controls (iup:hbox
	;; 		(iup:hbox
	;; 		 (iup:vbox (iup:label "row")(iup:label "col"))
	;; 		 (iup:vbox (iup:label "target")(iup:label "test"))
	;; 		 (iup:vbox (iup:label "run-name")(iup:label "items")))))
	 (subjects-tree  (iup:treebox
			#:value 0
			#:title "Subjects" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
			#:expand "YES"
			#:addexpanded "YES"
			#:size "10x"
			#:selection-cb
			(lambda (obj id state)
			  (let* ((path (iuputils:tree-node->path obj id)) ;; will get called twice - click and release
				 (plen (length path)))
			    (reset-request 'reset) ;; flag matrix draw to start over and not finish current draw
			    ;; (print "selection-cb state: " state)
			    (if (<= plen 1)
				(begin
				  (iup:attribute-set! bundle-filter-tb "VALUE" "%")
				  ))
			    (if (> plen 1)(iup:attribute-set! bundle-filter-tb "VALUE" (list-ref path 1)))
			    path))))


















	 (sessions-matrix  (iup:matrix
			 #:alignment1 "ALEFT"
			 ;; #:expand "YES" ;; "HORIZONTAL"
			 #:scrollbar "YES"
			 #:numcol 100
			 #:numlin 200
			 #:numcol-visible 8 ;; (min 8)
			 #:numlin-visible 20
			 #:click-cb
			 (lambda (obj row col status)
			   (cond
			    ((eq? col 0)
			     (let* ((full-test-name (iup:attribute obj (conc row ":0")))
				    (new-test-patt (conc full-test-name "/%")))
			       (iup:attribute-set! bundle-filter-tb  "VALUE" new-test-patt)
			       )))
			   status)))
	 (learn         (iup:split
			 #:orientation "VERTICAL"
			 #:value 100
			 subjects-tree
			 sessions-matrix))












	 (teach         (iup:split




			 #:orientation "VERTICAL"
			 #:value 100
			 (iup:textbox)



			 (iup:textbox)))



	 (gui           (let ((side-tabs (iup:tabs
					  #:tabtype "LEFT"
					  learn
					  teach)))

			  (iup:attribute-set! side-tabs "TABTITLE0" "Learn")
			  (iup:attribute-set! side-tabs "TABTITLE1" "Teach")
			  side-tabs))
	 (cfgdat       (read-learn-teach-config))
	 (mydata       #f) ;; hash table with pointers to all the stuff we need to keep track of, could use a struct but not sure I can safely test it for being compatible
	 (learn-teach-dat   (make-learn-teach ;; we store the state private to this tab in here
			;; top-controls:  top-controls
			subjects-tree:   subjects-tree
			sessions-matrix:  sessions-matrix
			bundle-filter: bundle-filter-tb
			config:        cfgdat
			reset-fn:      reset-request
			))
	 ;; the mydat object can be searched for in alldats
	 (updater      (let ((last-up 0)) ;; last time the matrix was updated
			 (lambda (mytabnum currtabnum alldats)
			   (let* ((mydat   (hash-table-ref/default alldats mytabnum #f))
				  (currsec (current-seconds))
				  (tdelta  (- currsec last-up)))
			     (cond







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|



|
|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|
|
|
>
>
>
|
>
>
>



|
>





|
|
|
|
|
|
|
|







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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
  (let* ((bundle-filter-tb   (iup:textbox value: "%"  expand: "HORIZONTAL" action: (lambda (obj a b)(reset-request 'reset))))
	;; (top-controls (iup:hbox
	;; 		(iup:hbox
	;; 		 (iup:vbox (iup:label "row")(iup:label "col"))
	;; 		 (iup:vbox (iup:label "target")(iup:label "test"))
	;; 		 (iup:vbox (iup:label "run-name")(iup:label "items")))))
	 (subjects-tree  (iup:treebox
			  #:value 0
			  #:title "Subjects" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
			  #:expand "YES"
			  #:addexpanded "YES"
			  #:size "10x"
			  #:selection-cb
			  (lambda (obj id state)
			    (let* ((path (iuputils:tree-node->path obj id)) ;; will get called twice - click and release
				   (plen (length path)))
			      (reset-request 'reset) ;; flag matrix draw to start over and not finish current draw
			      ;; (print "selection-cb state: " state)
			      (if (<= plen 1)
				  (begin
				    (iup:attribute-set! bundle-filter-tb "VALUE" "%")
				    ))
			      (if (> plen 1)(iup:attribute-set! bundle-filter-tb "VALUE" (list-ref path 1)))
			      path))))
	 (my-subjects-tree  (iup:treebox
			  #:value 0
			  #:title "Subjects" ;;  was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute."
			  #:expand "YES"
			  #:addexpanded "YES"
			  #:size "10x"
			  #:selection-cb
			  (lambda (obj id state)
			    (let* ((path (iuputils:tree-node->path obj id)) ;; will get called twice - click and release
				   (plen (length path)))
			      (reset-request 'reset) ;; flag matrix draw to start over and not finish current draw
			      ;; (print "selection-cb state: " state)
			      (if (<= plen 1)
				  (begin
				    (iup:attribute-set! bundle-filter-tb "VALUE" "%")
				    ))
			      (if (> plen 1)(iup:attribute-set! bundle-filter-tb "VALUE" (list-ref path 1)))
			      path))))
	 (sessions-matrix  (iup:matrix
			    #:alignment1 "ALEFT"
			    ;; #:expand "YES" ;; "HORIZONTAL"
			    #:scrollbar "YES"
			    #:numcol 100
			    #:numlin 200
			    #:numcol-visible 8 ;; (min 8)
			    #:numlin-visible 20
			    #:click-cb
			    (lambda (obj row col status)
			      (cond
			       ((eq? col 0)
				(let* ((full-test-name (iup:attribute obj (conc row ":0")))
				       (new-test-patt (conc full-test-name "/%")))
				  (iup:attribute-set! bundle-filter-tb  "VALUE" new-test-patt)
				  )))
			      status)))
	 (learn         (iup:split
			 #:orientation "VERTICAL"
			 #:value 100
			 (iup:hbox subjects-tree)
			 sessions-matrix
			 ))
	 (time-slots    (iup:matrix
			 ;; #:title "Time Slots"
			 #:alignment1 "ALEFT"
			 #:scrollbar "YES"
			 #:numcol 3
			 #:numlin 20))
	 (my-subjects   (iup:matrix
			 #:alignment1 "ALEFT"
			 #:scrollbar "YES"
			 #:numcol 2
			 #:numlin 20))
	 (teach         (iup:hbox
			 (iup:vbox
			  (iup:label "Time Slots")
			  time-slots)
			 (iup:split
			  #:orientation "VERTICAL"
			  #:value 100
			  (iup:vbox
			   my-subjects-tree
			   (iup:label "Add subject")
			   (iup:hbox
			    (iup:textbox)
			    (iup:button "Add")))
			  my-subjects
			  )))
	 (gui           (let ((side-tabs (iup:tabs
					  #:tabtype "LEFT"
					  learn
					  teach
					  )))
			  (iup:attribute-set! side-tabs "TABTITLE0" "Learn")
			  (iup:attribute-set! side-tabs "TABTITLE1" "Teach")
			  side-tabs))
	 (cfgdat       (read-learn-teach-config))
	 (mydata       #f) ;; hash table with pointers to all the stuff we need to keep track of, could use a struct but not sure I can safely test it for being compatible
	 (learn-teach-dat (make-learn-teach ;; we store the state private to this tab in here
			   ;; top-controls:  top-controls
			   subjects-tree:   subjects-tree
			   sessions-matrix:  sessions-matrix
			   bundle-filter: bundle-filter-tb
			   config:        cfgdat
			   reset-fn:      reset-request
			   ))
	 ;; the mydat object can be searched for in alldats
	 (updater      (let ((last-up 0)) ;; last time the matrix was updated
			 (lambda (mytabnum currtabnum alldats)
			   (let* ((mydat   (hash-table-ref/default alldats mytabnum #f))
				  (currsec (current-seconds))
				  (tdelta  (- currsec last-up)))
			     (cond