558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
|
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
|
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv)))
(if first-time
(begin
(set! first-time #f)
(set! test-browse-xoffset (- 20 (* (/ sizex 2) (* 8 xadj))))
(set! test-browse-yoffset (- 20 (* (/ sizey 2) (* 8 (- 1 yadj)))))))
(let* ((xtorig (+ test-browse-xoffset (* (/ sizex 2) (* 8 xadj)))) ;; (- xadj 1))))
(ytorig (+ test-browse-yoffset (* (/ sizey 2) (* 8 (- 1 yadj))))))
(ytorig (+ test-browse-yoffset (* (/ sizey 2) (* 8 (- 1 yadj)))))
(boxw 80)
(boxh 30)
(gapx 20)
(gapy 30))
(print "sizex: " sizex " sizey: " sizey " font: " (canvas-font cnv))
(let loop ((hed (car (reverse sorted-testnames)))
(for-each (lambda (testname)
(canvas-text! cnv (+ xtorig 5)(+ ytorig 5) testname) ;; (conc testname " (" xtorig "," ytorig ")"))
(canvas-rectangle! cnv xtorig (+ 60 xtorig) ytorig (+ ytorig 30))
(set! ytorig (+ ytorig 50)))
(reverse sorted-testnames))))))
(tal (cdr (reverse sorted-testnames)))
(llx xtorig)
(lly ytorig)
(urx (+ xtorig boxw))
(ury (+ ytorig boxh)))
(canvas-text! cnv (+ llx 5)(+ lly 5) hed) ;; (conc testname " (" xtorig "," ytorig ")"))
(canvas-rectangle! cnv llx urx lly ury)
(if (not (null? tal))
;; leave a column of space to the right to list items
(let ((have-room (< urx (- sizex boxw gapx boxw)))) ;; is there room for another column?
(loop (car tal)
(cdr tal)
(if have-room (+ llx boxw gapx) xtorig) ;; have room,
(if have-room lly (+ lly boxh gapy))
(if have-room (+ urx boxw gapx) (+ xtorig boxw))
(if have-room ury (+ ury boxh gapy))))))))))
#:size "150x200"
#:scrollbar "YES"
#:posx "0.5"
#:posy "0.5")))))))
(trace dashboard:populate-target-dropdown
|