Random Bits of Open Code

Check-in [237f2b7191]
Login

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

Overview
Comment:Dunno
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:237f2b719146e4cefa566a6bf8180645e5fe8223
User & Date: mrwellan 2018-08-02 00:39:34
Context
2018-08-03
00:01
Couple tweaks to not-yet-finished help view. check-in: 01ff80395e user: mrwellan tags: trunk
2018-08-02
00:39
Dunno check-in: 237f2b7191 user: mrwellan tags: trunk
2018-08-01
05:44
Added big arrow polygon generator check-in: 6915e3fe7e user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to multiapp/run.sh.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

18
19


20
21
22
23
24






#!/bin/bash

origpath=$(dirname $0)

$origpath/multiapp &

if [[ -e $origpath/options.cfg ]];then
    # set the var SYNCPATH in options.cfg
    echo sourcing configuration from $origpath/options.cfg
    source $origpath/options.cfg
    mkdir -p pkts
else
    echo Please create file $origpath/options.cfg and set the variable SYNCPATH pointing to a directory where pkts will be shared.
    exit
fi

function sync_all () {

    rsync -t $SYNCPATH/*.pkt pkts/
    rsync -t pkts/*.pkt $SYNCPATH/


}

while sync_all;do
    sleep 30
done










<












>
|
|
>
>


|
<
<
>
>
>
>
>
>
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
#!/bin/bash

origpath=$(dirname $0)



if [[ -e $origpath/options.cfg ]];then
    # set the var SYNCPATH in options.cfg
    echo sourcing configuration from $origpath/options.cfg
    source $origpath/options.cfg
    mkdir -p pkts
else
    echo Please create file $origpath/options.cfg and set the variable SYNCPATH pointing to a directory where pkts will be shared.
    exit
fi

function sync_all () {
    while true;do
	rsync -t $SYNCPATH/*.pkt pkts/
	rsync -t pkts/*.pkt $SYNCPATH/
	sleep 30
    done
}

sync_all &


pid=$!

echo "Sync is running as pid $pid"
$origpath/multiapp

kill $pid

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

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
	 (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)))
	 (flat   (apply append all)))
    flat))




(let* ((help-drawing (make-drawing))
       (hlib         (make-lib))
       ;; components
       (title        (make-comp))    ;; title block
       (subjects     (make-comp))    ;; subjects tree

       (active       (make-comp))    ;; most active sessions
       (arrow        (make-comp)))
  (add-lib help-drawing "hlib" hlib) ;; add library hlib to drawing
  ;; build up the title
  (add-objs-to-comp title (rectangle 0 0 158 18 text: "Learn Something!" font: "Helvetica, -40"))

  (add-comp-to-lib hlib "title" title) ;; add component help-learn to library help-lib

  ;; add objects to subjects tree sketch














  (add-objs-to-comp
   subjects
















   (rectangle 0 80 80 200)
   (line 10 190 20 190)
   (line 20 190 20 150)
   (line 20 180 30 180)
   (text 32 176 "unix" font: "Helvetica, -20")
   (line 40 175 40 170)
   (text 32 162 "11:00" font: "Helvetica, -20")
   )
  (add-comp-to-lib hlib "subj" subjects)
  
;;   (let ((l (vector 50 20 100 120)))
;;     (apply add-objs-to-comp subjects
;; 	   (map (lambda (angle)
;; 		  (let ((newl (geolib:rotate-line angle l 0 0)))
;; 		    (apply line (vector->list newl))))
  ;; 		'(0 22.5 45))))

  (add-objs-to-comp
   arrow
   (polygon (big-arrow 80 8 (deg->rad 45))))
  (add-comp-to-lib hlib "arrow1" arrow)

  



  (instantiate help-drawing "hlib" "title" "t1" 20 220)  ;; instantiate component title from library hlib in drawing help-drawing
  (instantiate help-drawing "hlib" "subj"  "s1" 20 10) ;; instantiate component subj  from library hlib in drawing help-drawing
  (instantiate help-drawing "hlib" "arrow1" "a1" 135 110)
  (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))))
  


  (main-loop))


;; (define d1 (make-drawing))
;; (define l1 (make-lib))
;; (define c1 (make-comp))
;; (define c2 (make-comp))
;; (define c3 (make-comp))







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

|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
<
<
<
|
|
<
<
<
<
<
<
<
<
|
|
|
|
>
|
>
>
>
|
|
<
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|







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
	 (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)))
	 (flat   (apply append all)))
    flat))

(define c1 #f)
(define
  cnv
  (let* ((help-drawing (make-drawing))
	 (hlib         (make-lib))
	 ;; components
	 (title        (make-comp))    ;; title block
	 (subjects     (make-comp))    ;; subjects tree
	 (active       (make-comp))   ;; most active sessions
	 (active       (make-comp))    ;; most active sessions
	 (arrow        (make-comp)))
    (add-lib help-drawing "hlib" hlib) ;; add library hlib to drawing
    ;; build up the title
    (add-objs-to-comp title ;; (rectangle 0 0 158 18 text: "Learn Something!" font: "Helvetica, -40"))
		      (text 0 0 "Learn Something!" font: "Helvetica, -40"))
    (add-comp-to-lib hlib "title" title) ;; add component help-learn to library help-lib

    ;; add objects to subjects tree sketch
    (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
       subjects
       ;; 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 0 250 0))
       (text (+ x6 2) (- y6 2) "time" font: font)
       (text 0 (- y6 55) "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 90 180 140 140)






       )
      (add-comp-to-lib hlib "subj" subjects)








      (add-objs-to-comp
       arrow
       (polygon (big-arrow 35 8 (geolib:deg->rad 0))))
      (add-comp-to-lib hlib "arrow1" arrow)
      (instantiate help-drawing "hlib" "arrow1" "a1" (+ x6 40)(- y6 34))
      
      )
    
    
    (instantiate help-drawing "hlib" "title" "t1" 20 220)  ;; instantiate component title from library hlib in drawing help-drawing
    (instantiate help-drawing "hlib" "subj"  "s1" 20 10) ;; instantiate component subj  from library hlib 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)
       (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)))
      c
      )))

(main-loop)


;; (define d1 (make-drawing))
;; (define l1 (make-lib))
;; (define c1 (make-comp))
;; (define c2 (make-comp))
;; (define c3 (make-comp))

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

530
531
532
533
534
535
536

537
538
539
540
541
542
543
544




545
546
547
548
549
550
551
...
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697

(define (setup-vote-form vf)
  (let ((btn (iup:button "Yes"
			 action: (lambda (obj)
				   (let* ((curr-val  (iup:attribute obj "TITLE"))
					  (new-vote  (if (equal? curr-val "Yes") 1 0)) ;; if Yes we are voting a 1, else vote a 0
					  (new-title (if (eq? new-vote 1) "Yes" "No"))

					  (path      (cons "Subjects"
							   (map (lambda (x)
								  (iup:attribute x "TITLE"))
								(list (vf-category vf)(vf-subject vf)(vf-level vf)(vf-datetime vf)))))
					  ;; (path2     (append (take path 3)(list (conc (last path) " y"))))
					  )
				     (print "new-vote: " new-vote " curr-val: " curr-val " new-title: " new-title)
				     (iup:attribute-set! obj "TITLE" new-title)




				     (set-vote (vf-data vf) new-vote (get-my-id)(vf-sZ vf)(vf-tZ vf) path))))))
    (vf-votebutton-set! vf btn)
    (vf-form-set!
     vf
     (iup:frame
      title: "Vote to attend a tutorial, change your vote with the button below."
      (iup:vbox
................................................................................
	(set-node-color subjects-tree path vote)
	(pkts:write-alist->pkt learn-teach-pkts-dir plist pktspec: pkt-spec ptype: 'vote)
	(load-pkts)
	(hash-table-set! data 'need-redraw #t)
	)))

;; (use trace)(trace-call-sites #t)(trace read-subjects)

;;======================================================================
;; Code graveyard
;;======================================================================
						      
						    ;; 	      (buttonfn  (lambda (vote) ;; vote is 1 or 0
						    ;; 			   (lambda (b-obj)
						    ;; 			     (if (and sZ tZ)
						    ;; 				 (let* ((plist `((app     . "tnl")
						    ;; 						 (person  . ,my-id)
						    ;; 						 (sZ      . ,sZ)
						    ;; 						 (tZ      . ,tZ)
						    ;; 						 (vote    . ,vote))))
						    ;; 				   ;; (print "spkt: ")(pp spkt)(print " tpkt: ")(pp tpkt)
						    ;; 				   (load-pkts)
						    ;; 				   (hash-table-clear! (get-add-ht data 'all-subjects))
						    ;; 				   (hash-table-set! data 'sessions-matrix-rownum 1)
						    ;; 				   (iup:attribute-set! mobj "CLEARVALUE" "CONTENTS")
						    ;; 				   (pkts:write-alist->pkt learn-teach-pkts-dir plist pktspec: pkt-spec ptype: 'vote)
						    ;; 				   (iup:destroy! tdlog))
						    ;; 				 (print "ERROR: bad values for sZ or tZ.")))))
						    ;; 	      (tdlog   (iup:dialog
						    ;; 			(iup:vbox
						    ;; 			 (iup:label (conc "Vote for the class "  (alist-ref 'name spkt) " level " (alist-ref 'level spkt) "\n"
						    ;; 					  "at date/time "  (alist-ref 'datetime tpkt)))
						    ;; 			 (iup:label (conc "Your current vote: " (if (equal? (hash-table-ref/default votes my-id 0) 1) "yes" "no")))
						    ;; 			 (iup:label (conc "Total votes: " tot-votes))
						    ;; 			 (iup:hbox
						    ;; 			  (iup:button "Yes"
						    ;; 				      expand: "HORIZONTAL"
						    ;; 				      action: (buttonfn 1))
						    ;; 			  (iup:button "No"
						    ;; 				      expand: "HORIZONTAL"
						    ;; 				      action: (buttonfn 0)
						    ;; 				      ))))))

;;   (iup:show tdlog))))
				;;(if (not (hash-table-exists? combos dispkey))
				;;	   (begin
				;;	     (hash-table-set! data 'sessions-matrix-rownum (+ rownum 1))
				;;	     (hash-table-set! combos dispkey rownum)
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":1") (list-ref datetimelst 2))
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":2") (list-ref datetimelst 0))
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":3") weekday)
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":4") (list-ref datetimelst 1))
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":5") subject)
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":6") level)
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":7") tutor)
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":8") "")
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":9") "")
				;;	     (iup:attribute-set! sessions-matrix (conc rownum ":10") "")
				;;	     (for-each (lambda (x)(iup:attribute-set! sessions-matrix "FITTOTEXT" (conc "C" x)))
				;;		       '(1 2 3 4 5 6 7 8 9 10 11))
				;;	     (iup:attribute-set! sessions-matrix "REDRAW" "YES")))
				       ;; (print "stype: " stype " ttype: " ttype " datetimelst: " datetimelst " state: " state)


;;======================================================================
;; Main
;;======================================================================

(define (make-tab)
  (letrec* ((data               (make-hash-table)) ;; more flexible than a record, over time migrate items from this to defstructs







>






|

>
>
>
>







 







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







530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
...
633
634
635
636
637
638
639
























































640
641
642
643
644
645
646

(define (setup-vote-form vf)
  (let ((btn (iup:button "Yes"
			 action: (lambda (obj)
				   (let* ((curr-val  (iup:attribute obj "TITLE"))
					  (new-vote  (if (equal? curr-val "Yes") 1 0)) ;; if Yes we are voting a 1, else vote a 0
					  (new-title (if (eq? new-vote 1) "Yes" "No"))
					  (new-btn-t (if (eq? new-vote 1) "No"  "Yes"))
					  (path      (cons "Subjects"
							   (map (lambda (x)
								  (iup:attribute x "TITLE"))
								(list (vf-category vf)(vf-subject vf)(vf-level vf)(vf-datetime vf)))))
					  ;; (path2     (append (take path 3)(list (conc (last path) " y"))))
					  )
				     (print "new-vote: " new-vote " curr-val: " curr-val " new-title: " new-title " new-btn-t: " new-btn-t)
				     (iup:attribute-set! obj "TITLE" new-title)
				     (iup:attribute-set! (vf-myvote vf) "TITLE" new-btn-t) ;; set button to *opposite* of the vote
				     (iup:attribute-set! (vf-votes vf)  "TITLE" (conc ((if (eq? new-vote 1) + -)
										       (string->number (iup:attribute (vf-votes vf) "TITLE"))
										       1)))
				     (set-vote (vf-data vf) new-vote (get-my-id)(vf-sZ vf)(vf-tZ vf) path))))))
    (vf-votebutton-set! vf btn)
    (vf-form-set!
     vf
     (iup:frame
      title: "Vote to attend a tutorial, change your vote with the button below."
      (iup:vbox
................................................................................
	(set-node-color subjects-tree path vote)
	(pkts:write-alist->pkt learn-teach-pkts-dir plist pktspec: pkt-spec ptype: 'vote)
	(load-pkts)
	(hash-table-set! data 'need-redraw #t)
	)))

;; (use trace)(trace-call-sites #t)(trace read-subjects)

























































;;======================================================================
;; Main
;;======================================================================

(define (make-tab)
  (letrec* ((data               (make-hash-table)) ;; more flexible than a record, over time migrate items from this to defstructs