Random Bits of Open Code

Check-in [3b13ca7aa9]
Login

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

Overview
Comment:Added help to first tab
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:3b13ca7aa934913125e9849ff452c140d6d51629
User & Date: matt 2018-08-03 06:10:30
Context
2018-08-03
06:14
Tweaked some wording on help page check-in: 81b0c51fed user: matt tags: trunk
06:10
Added help to first tab check-in: 3b13ca7aa9 user: matt tags: trunk
00:01
Couple tweaks to not-yet-finished help view. check-in: 01ff80395e user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to multiapp/Makefile.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# Need to run as follows:
#
# CSC_OPTIONS="-I$PREFIX/include -L$PREFIX/lib" make deploy

SHELL = /bin/bash
CSCOPTS=

SRCFILES      = src/gui.scm
APPFILES      = src/learn-teach.scm
OFILES        = $(SRCFILES:%.scm=%.o)
APPOFILES     = $(APPFILES:%.scm=%.o)
EXTRASOFILES  = pkts.so dbi.so vg.so margs.so mtconfigf.so mtcommon.so mtdb.so iuputils.so
EXTRAS = $(EXTRASOFILES:%=deploytarg/%)

all : multiapp







|







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# Need to run as follows:
#
# CSC_OPTIONS="-I$PREFIX/include -L$PREFIX/lib" make deploy

SHELL = /bin/bash
CSCOPTS=

SRCFILES      = src/gui.scm src/help.scm
APPFILES      = src/learn-teach.scm
OFILES        = $(SRCFILES:%.scm=%.o)
APPOFILES     = $(APPFILES:%.scm=%.o)
EXTRASOFILES  = pkts.so dbi.so vg.so margs.so mtconfigf.so mtcommon.so mtdb.so iuputils.so
EXTRAS = $(EXTRASOFILES:%=deploytarg/%)

all : multiapp

Added multiapp/src/help.scm.



















































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
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
;;======================================================================
;; Copyright 2006-2016, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(declare (unit help))

(module help
    *
  
(import scheme chicken data-structures extras)

(use canvas-draw iup foof-loop srfi-18)
(import canvas-draw-iup)
(import canvas-draw-client)

;; (load "vg.scm")
(use vgcanvas)
(use vg) ;; (prefix vg vg:))
(use (prefix geolib geolib:))

;; make a big arrow outline (will add fill later
;;  l = length base to tip
;;  t = base thickness. tip is 1.5t long and 1.5t wide
;;  a = angle from vertical
;;  returns a list of points `( x0 y0 x1 y1 x2 y2 ... xn yn )
;;
(define (big-arrow l t angle #!key (xoff 0)(yoff 0))
  (let* ((t/2    (/ t 2))
	 (t/4    (/ t 4))
	 (hl     (* 1.5 t))       ;; arrow head length
	 (l-h    (- l hl))        ;; length of arrow body
	 (a      `(,(- t/2) 0))
	 (b      `(,(- t/2) ,l-h))
	 (c      `(,(- 0 t/2 t/4) ,l-h))
	 (d      `(0  ,l))
	 (e      `(,(+ t/2 t/4) ,l-h))
	 (f      `(,t/2 ,l-h))
	 (g      `(,t/2 0))
	 (all    (map (lambda (pt)
			;; (print "pt: " pt " (car pt): " (car pt) " (cadr pt): " (cadr pt))
			(geolib:rotate-pt angle (car pt)(cadr pt)))
		      (list a b c d e f g)))
	 (allofs (map (lambda (pt)
			(let* ((newx (+ xoff (car pt)))
			       (newy (+ yoff (cadr pt))))
			  (list newx newy)))
		      all))
	 (flat   (apply append allofs)))
    flat))

(define (add-learn hlib learn)
  (let* ((idelta 10)
	 (x1 10)
	 (y1 190)          ;; top line
	 (x2 (+ x1 5))
	 (y2 (- y1 10))    ;; second line
	 (x3 (+ x1 20))
	 (y3 150)          ;; bottom of drawing ...
	 (x4 (+ x3 5))
	 (x5 (+ x3 20))
	 (y4 (- y2 5))     ;; 175)
	 (y5 150)
	 (y6 (- y4 5))
	 (x6 (+ x5 5))
	 (font "Helvetica, -20"))
    (add-objs-to-comp
     learn
     (text 20 210 "Click \"Learn\" tab to find tutorial sessions." font: "Helvetica, -40")
     (polygon (big-arrow 60 8 (geolib:deg->rad 90) xoff: 18 yoff: 216))
     ;; this is the subject selection stuff
     (rectangle 0 140 90 200) ;; bounding box
     (line x1 y1 x2 y1)      ;; first h-line
     (text (+ x2 2)(- y1 2) "category" font: font)
     (line x3 (- y1 3 ) x3 y3)
     (line x3 y2 x4 y2)
     (text (+ x4 2)(- y2 2) "subject" font: font)
     (line x5 y4 x5 y5)      ;; vertical line
     (line x5 y6 x6 y6)
     (rectangle (- x6 2)(- y6 3)(+ x6 30)(+ y6 6)
		fill-color: (rgb->number 200 250 200))
     (text (+ x6 2) (- y6
		       2) "time" font: font)
     (text 0 (- y6 55) "(1) Select a \"session\" (a" font: font)
     (text 0 (- y6 65) "combination of subject" font: font)
     (text 0 (- y6 75) "and time)" font: font)
     ;; this is the vote box
     (rectangle 91 140 140 180) ;; bounding box
     (text 92 143 "Vote:  Yes")
     (rectangle 115 142 133 152)
     ;; this is the message for the second arrow
     (text 120 (- y6 55) "(2) Click the \"Yes\" to" font: font)
     (text 120 (- y6 65) "indicate you are interested" font: font)
     (text 120 (- y6 75) "in this session" font: font)
     ;; arrow 1
     (polygon (big-arrow 37 6 (geolib:deg->rad -5) xoff: (+ x6 0) yoff: (- y6 44)))
     ;; arrow 2
     (polygon (big-arrow 15 4 (geolib:deg->rad 5) xoff: (+ x6 75) yoff: (- y6 44)))
     )
    (add-comp-to-lib hlib "learn" learn)
    ))

(define (add-teach hlib teach)
  (let* ((idelta 10)
	 (x1 5)
	 (y1 (- 190 0))          ;; top line
	 (x2 x1)
	 (y2 (- y1 2))    ;; second line
	 (x3 (+ x2 46))
	 (y3 150)          ;; bottom of drawing ...
	 (x4 (+ x2 81))
	 (x5 (+ x3 20))
	 (y4 (- y2 5))     ;; 175)
	 (y5 150)
	 (y6 160) ;; (- y4 5))
	 (x6 (+ x5 25))
	 (x7 (+ x6 32))
	 (x8 (+ x7 32))
	 (font "Helvetica, -20"))
    (add-objs-to-comp
     teach
     (text 20 210 "Click \"Teach\" tab to offer tutorials" font: "Helvetica, -40")
     (polygon (big-arrow 100 8 (geolib:deg->rad 15) xoff: 10 yoff: 216))
     ;; this is the subject selection stuff
     (rectangle 0 140 90 200) ;; bounding box
     (text x2 y1        "Category:" font: font)
     (rectangle x3 y2        x4 (+ y2 9))
     (text x2 (- y1 10) "Subject:"  font: font)
     (rectangle x3 (- y2 10) x4 (+ y2 -1))
     (text x2 (- y1 20) "Level:"    font: font)
     (rectangle x3 (- y2 20) x4 (+ y2 -11))
     (text x2 (- y1 30) "Details:"  font: font)
     (rectangle x3 (- y2 30) x4 (+ y2 -21))
     (text (+ x2 2)(- y1 45) "ADD"       font: font)
     (rectangle x2 (- y1 46)(+ x2 24)(- y1 36))
     
     (text 0 (- y6 55) "(1) Fill in the Add/Edit " font: font)
     (text 0 (- y6 65) "Subject form and hit \"Add\"" font: font)
     (text 0 (- y6 75) "button to set subjects you" font: font)
     (text 0 (- y6 85) "can teach" font: font)

     ;; Add/Edit for time slots
     (rectangle 91 140 (+ 91 90) 200) ;; bounding box
     (text x6 y1        "Date:" font: font)
     (rectangle x7 y2        x8 (+ y2 9))
     (text x6 (- y1 10) "Time:"  font: font)
     (rectangle x7 (- y2 10) x8 (+ y2 -1))
     (text x6 (- y1 20) "Day:"    font: font)
     (rectangle x7 (- y2 20) x8 (+ y2 -11))
     (text x6 (- y1 30) "TZone:"  font: font)
     (rectangle x7 (- y2 30) x8 (+ y2 -21))
     (text (+ x6 2)(- y1 45) "ADD"       font: font)
     (rectangle x6 (- y1 46)(+ x6 24)(- y1 36))
     

     ;; message for the second arrow
     (text 140 (- y6 55) "(2) Fill in the Add/Edit" font: font)
     (text 140 (- y6 65) "Time Slots form to set the times" font: font)
     (text 140 (- y6 75) "you are available to teach." font: font)
     ;; arrow 1
     (polygon (big-arrow 37 6 (geolib:deg->rad 0) xoff: (+ x6 0 -14) yoff: (- y6 44)))
     (polygon (big-arrow 32 6 (geolib:deg->rad 35) xoff: (+ x6 -28 -14) yoff: (- y6 44)))
     ;; arrow 2
     (polygon (big-arrow 37 6 (geolib:deg->rad 20) xoff: (+ x6 75 -5) yoff: (- y6 44)))
     )
    (add-comp-to-lib hlib "teach" teach)
    ))

(define (help-drawing)
  (let* ((c1           #f)
	 (help-drawing (make-drawing))
	 (hlib         (make-lib))
	 ;; components
	 (learn     (make-comp))
	 (teach     (make-comp)))
    (add-lib help-drawing "hlib" hlib) ;; add library hlib to drawing
    ;; add objects to learn tree sketch

    (add-learn hlib learn)
    (add-teach hlib teach)

    ;; instantiate component teach from library hlib in drawing help-drawing
    (instantiate help-drawing "hlib" "learn" "s1" 50 140)
    ;; instantiate component learn from library hlib in drawing help-drawing
    (instantiate help-drawing "hlib" "teach" "s2" 30 -20)
    
    (drawing-scalex-set! help-drawing 1.5)
    (drawing-scaley-set! help-drawing 1.5)
    
    (drawing-update-proc-set!
     help-drawing
     (lambda (dwg c xadj yadj)
       (set! c1 c)
       (canvas-clear! c)
       (draw dwg #t)))
    
    (let ((c (drawing-init help-drawing)))
      (print "c:   " c)
      #;(show
       (dialog
	(vbox
	 #:expand "YES"
	 (label "The drawing")
      c)))
      (thread-start! (make-thread (lambda ()(thread-sleep! 1)(draw help-drawing #t)) "Init drawing"))
      (cons c c1) ;; return the canvas and the lowerlevel accessor of that canvas
      )))

)
;; (main-loop)

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

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
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
...
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
...
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
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
(import canvas-draw-iup)
(import canvas-draw-client)

;; (load "vg.scm")
(use vgcanvas)
(use vg) ;; (prefix vg vg:))
(use (prefix geolib geolib:))

(define numtorun 1000)
;; (if (> (length (argv)) 1)
;; 		     (string->number (cadr (argv)))
;; 		     1000))

 (use trace)
 ;; (trace 
 ;;  ;; vg:draw-rect
 ;;  ;; vg:grow-rect
 ;;  vg:get-extents-for-objs
 ;;  vg:components-get-extents
 ;;  vg:instances-get-extents
 ;;  vg:get-extents-for-two-rects
;;  canvas-line!)


;; make a big arrow outline (will add fill later
;;  l = length base to tip
;;  t = base thickness. tip is 1.5t long and 1.5t wide
;;  a = angle from vertical
;;  returns a list of points `( x0 y0 x1 y1 x2 y2 ... xn yn )
;;
................................................................................
			(let* ((newx (+ xoff (car pt)))
			       (newy (+ yoff (cadr pt))))
			  (list newx newy)))
		      all))
	 (flat   (apply append allofs)))
    flat))

(define (add-learn learn)
  (let* ((idelta 10)
	 (x1 10)
	 (y1 190)          ;; top line
	 (x2 (+ x1 5))
	 (y2 (- y1 10))    ;; second line
	 (x3 (+ x1 20))
	 (y3 150)          ;; bottom of drawing ...
................................................................................
     (polygon (big-arrow 37 6 (geolib:deg->rad -5) xoff: (+ x6 0) yoff: (- y6 44)))
     ;; arrow 2
     (polygon (big-arrow 15 4 (geolib:deg->rad 5) xoff: (+ x6 75) yoff: (- y6 44)))
     )
    (add-comp-to-lib hlib "learn" learn)
    ))

(define (add-teach learn)
  (let* ((idelta 10)
	 (x1 10)
	 (y1 190)          ;; top line
	 (x2 (+ x1 5))
	 (y2 (- y1 10))    ;; second line
	 (x3 (+ x1 20))
	 (y3 150)          ;; bottom of drawing ...
................................................................................
     (polygon (big-arrow 37 6 (geolib:deg->rad -5) xoff: (+ x6 0) yoff: (- y6 44)))
     ;; arrow 2
     (polygon (big-arrow 15 4 (geolib:deg->rad 5) xoff: (+ x6 75) yoff: (- y6 44)))
     )
    (add-comp-to-lib hlib "teach" teach)
    ))

(define c1 #f)
(define
  cnv

  (let* ((help-drawing (make-drawing))
	 (hlib         (make-lib))
	 ;; components
	 (learn     (make-comp))
	 (teach     (make-comp)))
    (add-lib help-drawing "hlib" hlib) ;; add library hlib to drawing
    ;; add objects to learn tree sketch

    (add-learn learn)
    (add-teach teach)

    ;; instantiate component teach from library hlib in drawing help-drawing
    (instantiate help-drawing "hlib" "learn" "s1" 20 40)
    ;; instantiate component learn from library hlib in drawing help-drawing
    (instantiate help-drawing "hlib" "teach" "s1" 20 40)
    
    (drawing-scalex-set! help-drawing 1.5)
................................................................................
      (print "c:   " c)
      (show
       (dialog
	(vbox
	 #:expand "YES"
	 (label "The drawing")
	 c)))
      c
      )))

(main-loop)


;; (define d1 (make-drawing))
;; (define l1 (make-lib))
;; (define c1 (make-comp))
;; (define c2 (make-comp))
;; (define c3 (make-comp))
;; (define bt1 (rectangle 10 40 20 50 text: "A long piece of text" font: "Helvetica, -10"))
;; 
;; (let ((r1 (rectangle 20 20 30 30 text: "r1" font: "Helvetica, -20"))
;;       (r2 (rectangle 30 30 60 60 text: "r2" font: "Helvetica, -10"))
;;       (t1 (text 60 60 "The middle" font: "Helvetica, -10")))
;;   (add-objs-to-comp c1 r1 r2 t1 bt1))
;; 
;; (loop ((for x (up-from 0 (to 20))))
;;        (loop ((for y (up-from 0 (to 20))))
;; 	     (add-objs-to-comp c1 (rectangle x y (+ x 5)(+ y 5)))))
;;       
;; (let ((start (current-seconds)))
;;   (let loop ((i 0))
;;     (add-obj-to-comp c1 (rectangle 0 0 100 100))
;;     (if (< i numtorun)(loop (+ i 1))))
;;   (print "Run time: " (- (current-seconds) start)))
;; 
;; (add-obj-to-comp c1 (line 0 0 100 100))
;; (add-obj-to-comp c3 (sect 0 0 80 80 0 360))
;; 
;; ;; add the c1 component to lib l1 with name firstcomp
;; (add-comp-to-lib l1 "firstcomp"  c1)
;; (add-comp-to-lib l1 "secondcomp" c2)
;; (add-comp-to-lib l1 "thirdcomp"  c3)
;; 
;; ;; add the l1 lib to drawing with name firstlib
;; (add-lib d1 "firstlib" l1)
;; 
;; ;; instantiate firstlib/firstcomp as inst1 in drawing d1 at 0,0
;; (instantiate d1 "firstlib" "firstcomp" "inst1"   0   0)
;; (instantiate d1 "firstlib" "firstcomp" "inst2" 200 200)
;; 
;; ;; (drawing-scalex-set! d1 1.1)
;; ;; (drawing-scaley-set! d1 0.5)
;; 
;; ;; (define xtnts (scale-offset-xy 
;; ;; 	       (component-get-extents c1)
;; ;; 	       1.1 1.1 -2 -2))
;; 
;; ;; get extents of c1 and put a rectange around it
;; ;;
;; (define xtnts (apply grow-rect 10 10 (components-get-extents d1 c1)))
;; (add-objs-to-comp c1 (apply rectangle xtnts))
;; 
;; (define bt1xt (obj-get-extents d1 bt1))
;; (print "bt1xt: " bt1xt)
;; (add-objs-to-comp c1 (apply rectangle bt1xt))
;; 
;; (add-objs-to-comp c1 (polygon
;;  			 (list  20 10
;;  			        80 25
;; 			        40 30)))
;; 
;; (add-objs-to-comp c1 (polygon
;;  			 (list  40  10
;;  			        100 25
;; 			        60  30)
;; 			 fill-color: (rgb->number 0 250 0)))
;; 
;; ;; get extents of all objects and put rectangle around it
;; ;;
;; (define big-xtnts (instances-get-extents d1))
;; (add-objs-to-comp c2 (apply rectangle big-xtnts))
;; (instantiate d1 "firstlib" "secondcomp" "inst3" 0 0)
;; 
;; (drawing-scalex-set! d1 1.5)
;; (drawing-scaley-set! d1 1.5)
;; 
;; (drawing-update-proc-set!
;;  d1
;;  (lambda (dwg c xadj yadj)
;;    (canvas-clear! c)
;;    ;; (print "xadj: " xadj " yadj: " yadj " cnv: " (drawing-cnv dwg))
;;    (draw dwg #t)))
;; 
;; (let ((c (drawing-init d1)))
;;   (print "c:   " c)
;;   (show
;;    (dialog
;;     (vbox
;;      #:expand "YES"
;;      (label "The drawing")
;;      c)))) ;; the-cnv)))
;; 
;; (define *tim*
;;   (let ((tmr  (timer))
;; 	(bkg  #f) ;; store the background in here
;; 	(lth  0)) ;; last theta
;;     (attribute-set! tmr "TIME" 50)
;;     (attribute-set! tmr "RUN" "YES")
;;     (callback-set! tmr "ACTION_CB"
;; 		   (lambda (time-obj)
;; 		     (let ((cnv   (drawing-cnv d1))
;; 			   (xsize 1000) ;; (inexact->exact (round (* 1.5 (drawing-xsize d1)))))  ;; compensate for scale used above
;; 			   (ysize 1000)) ;; (inexact->exact (round (* 1.5 (drawing-ysize d1))))))
;; 		       ;; you can save your background view as an rgb bitmap and redisplay it
;; 		       (if (not bkg)
;; 			   (begin
;; 			     (draw d1 #t)
;; 			     (set! bkg (canvas-image/rgb cnv 0 0 xsize ysize))
;; 			     (instantiate d1 "firstlib" "thirdcomp" "mvinst"  0   0)))
;; 		       (let* ((new-theta (modulo (+ lth 3) 360)) 
;; 			      (r1 (geolib:make-ray 100 100 100 (geolib:deg->rad new-theta)))
;; 			      (x  (list-ref r1 2))
;; 			      (y  (list-ref r1 3)))
;; 			 (set! lth new-theta)
;; 			 (instance-move d1 "mvinst" x y))
;; 		       ;; if we have saved a background use it ...
;; 		       (if bkg
;; 			   (begin
;; 			     (canvas-image-put/rgb! cnv 0 0 xsize ysize bkg)
;; 			     (draw d1 #t "mvinst"))
;; 			   (draw d1 #t))
;; 		       tmr)))))
;; 
;; (main-loop)







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







|







 







<
|
<
>
|







|
|







 







|


|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
2
3
4
5
6
7
8
















9
10
11
12
13
14
15
..
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
..
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
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
...
171
172
173
174
175
176
177
178
179
180
181
182


























































































































(import canvas-draw-iup)
(import canvas-draw-client)

;; (load "vg.scm")
(use vgcanvas)
(use vg) ;; (prefix vg vg:))
(use (prefix geolib geolib:))

















;; make a big arrow outline (will add fill later
;;  l = length base to tip
;;  t = base thickness. tip is 1.5t long and 1.5t wide
;;  a = angle from vertical
;;  returns a list of points `( x0 y0 x1 y1 x2 y2 ... xn yn )
;;
................................................................................
			(let* ((newx (+ xoff (car pt)))
			       (newy (+ yoff (cadr pt))))
			  (list newx newy)))
		      all))
	 (flat   (apply append allofs)))
    flat))

(define (add-learn hlib learn)
  (let* ((idelta 10)
	 (x1 10)
	 (y1 190)          ;; top line
	 (x2 (+ x1 5))
	 (y2 (- y1 10))    ;; second line
	 (x3 (+ x1 20))
	 (y3 150)          ;; bottom of drawing ...
................................................................................
     (polygon (big-arrow 37 6 (geolib:deg->rad -5) xoff: (+ x6 0) yoff: (- y6 44)))
     ;; arrow 2
     (polygon (big-arrow 15 4 (geolib:deg->rad 5) xoff: (+ x6 75) yoff: (- y6 44)))
     )
    (add-comp-to-lib hlib "learn" learn)
    ))

(define (add-teach hlib teach)
  (let* ((idelta 10)
	 (x1 10)
	 (y1 190)          ;; top line
	 (x2 (+ x1 5))
	 (y2 (- y1 10))    ;; second line
	 (x3 (+ x1 20))
	 (y3 150)          ;; bottom of drawing ...
................................................................................
     (polygon (big-arrow 37 6 (geolib:deg->rad -5) xoff: (+ x6 0) yoff: (- y6 44)))
     ;; arrow 2
     (polygon (big-arrow 15 4 (geolib:deg->rad 5) xoff: (+ x6 75) yoff: (- y6 44)))
     )
    (add-comp-to-lib hlib "teach" teach)
    ))


(define (help)

  (let* ((c1           #f)
	 (help-drawing (make-drawing))
	 (hlib         (make-lib))
	 ;; components
	 (learn     (make-comp))
	 (teach     (make-comp)))
    (add-lib help-drawing "hlib" hlib) ;; add library hlib to drawing
    ;; add objects to learn tree sketch

    (add-learn hlib learn)
    (add-teach hlib teach)

    ;; instantiate component teach from library hlib in drawing help-drawing
    (instantiate help-drawing "hlib" "learn" "s1" 20 40)
    ;; instantiate component learn from library hlib in drawing help-drawing
    (instantiate help-drawing "hlib" "teach" "s1" 20 40)
    
    (drawing-scalex-set! help-drawing 1.5)
................................................................................
      (print "c:   " c)
      (show
       (dialog
	(vbox
	 #:expand "YES"
	 (label "The drawing")
	 c)))
      (values c c1) ;; return the canvas and the lowerlevel accessor of that canvas
      )))

;; (main-loop)



























































































































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

24
25
26
27
28
29
30




31
32
33
34
35
36
37
...
852
853
854
855
856
857
858

859
860

861
862
863
864
865

866
867
868
869
870
871
872
;;      read-my-time-slots
;;      read-time-slots
;;      read-subjects
;;      )

(import scheme chicken data-structures extras)
(declare (uses gui))




(import  (prefix gui gui:))

(use (prefix iup iup:)
     srfi-69 regex typed-records files matchable
     canvas-draw 
     posix vg simple-exceptions
     (prefix mtconfigf configf:)
................................................................................
			     (iup:frame
			      ;; (iup:label  "Specify Your Time Slots" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title: "      Specify Your Time Slots" fontsize: "13"
			      (iup:vbox
			       time-slots
			       add/edit-slot)))
			    ))

	    (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







>
>
>
>







 







>


>



|
|
>







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
...
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
;;      read-my-time-slots
;;      read-time-slots
;;      read-subjects
;;      )

(import scheme chicken data-structures extras)
(declare (uses gui))
 
(declare (uses help))
(import help)

(import  (prefix gui gui:))

(use (prefix iup iup:)
     srfi-69 regex typed-records files matchable
     canvas-draw 
     posix vg simple-exceptions
     (prefix mtconfigf configf:)
................................................................................
			     (iup:frame
			      ;; (iup:label  "Specify Your Time Slots" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title: "      Specify Your Time Slots" fontsize: "13"
			      (iup:vbox
			       time-slots
			       add/edit-slot)))
			    ))
	    (help          (help-drawing))
	    (gui           (let ((side-tabs (iup:tabs
					     #:tabtype "LEFT"
					     (car help)
					     learn
					     teach
					     )))
			     (iup:attribute-set! side-tabs "TABTITLE0" "Help")
			     (iup:attribute-set! side-tabs "TABTITLE1" "Learn")
			     (iup:attribute-set! side-tabs "TABTITLE2" "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