Random Bits of Open Code

Check-in [cd8d29c34c]
Login

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

Overview
Comment:Added template for help drawing.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:cd8d29c34cef155eba4d49c58a31940d24ef40b0
User & Date: matt 2018-07-30 04:39:03
Context
2018-07-31
05:58
Trying out vg for help graphics check-in: e00c2f28be user: matt tags: trunk
2018-07-30
04:39
Added template for help drawing. check-in: cd8d29c34c user: matt tags: trunk
2018-07-24
16:26
Added simple wrapper for doing a crude sync, fixed couple minor bugs in learn-teach. check-in: 5e7b010a46 user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added multiapp/src/learn-teach-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
(use canvas-draw iup foof-loop)
(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!)

(define help-drawing (make-drawing))
(define help-lib     (make-lib))
(define help-learn   (make-comp))
(define help-teach   (make-comp))
(add-objs-to-comp help-learn
		  (rectangle 0 0 100 20 text: "Learn Something!"))
(add-comp-to-lib help-lib "help-learn" help-learn) ;; add component help-learn to library help-lib
(add-lib help-drawing "help-lib" help-lib)         ;; add library help-lib to drawing
(instantiate help-drawing "help-lib" "help-learn" "help1" 20 20)  ;; instantiate component help-learn from library help-lib in drawing help-drawing

(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)
   (canvas-clear! c)
   (draw dwg #t)))

(let ((c (drawing-init help-drawing)))
  (print "c:   " c)
  (show
   (dialog
    (vbox
     #:expand "YES"
     (label "The drawing")
     c))))

;; (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)