10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
;;======================================================================
(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(use trace)
(declare (uses common))
(declare (uses margs))
|
>
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;;======================================================================
(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(use trace)
(declare (uses common))
(declare (uses margs))
|
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
|
listboxes)))
(loop (car remkeys)
(cdr remkeys)
(append refvals (list selected-value))
(+ indx 1)
(append lbs (list lb))))))))
(define (dashboard:run-controls)
(let* ((targets (make-hash-table))
(runconf-targs (common:get-runconfig-targets))
(tests (make-hash-table))
(action "-runtests")
(cmdln "")
(runlogs (make-hash-table))
(key-listboxes #f)
(update-keyvals (lambda (obj b c d)
(print "obj: " obj ", b " b ", c " c ", d " d)
(dashboard:update-target-selector key-listboxes))))
;; refer to *keys*, *dbkeys* for keys
(iup:vbox
(iup:hbox
;; Target and action
(iup:vbox
;; Target selectors
(apply iup:hbox
(let* ((dat (dashboard:update-target-selector key-listboxes action-proc: update-keyvals))
(key-lb (car dat))
(combos (cadr dat)))
(set! key-listboxes key-lb)
combos)))))))
(trace dashboard:populate-target-dropdown
common:list-is-sublist)
;; ;; key1 key2 key3 ...
;; ;; target entry (wild cards allowed)
;;
|
>
>
|
>
>
|
|
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
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
557
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
|
listboxes)))
(loop (car remkeys)
(cdr remkeys)
(append refvals (list selected-value))
(+ indx 1)
(append lbs (list lb))))))))
;(define (dashboard:display-tests cnv x y)
(define (dashboard:run-controls)
(let* ((targets (make-hash-table))
(runconf-targs (common:get-runconfig-targets))
(test-records (make-hash-table))
(test-names (tests:get-valid-tests *toppath* '()))
(sorted-testnames #f)
(action "-runtests")
(cmdln "")
(runlogs (make-hash-table))
(key-listboxes #f)
(update-keyvals (lambda (obj b c d)
;; (print "obj: " obj ", b " b ", c " c ", d " d)
(dashboard:update-target-selector key-listboxes)))
(test-browse-xoffset 0)
(test-browse-yoffset 0)
(first-time #t))
(tests:get-full-data test-names test-records '())
(set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
;; refer to *keys*, *dbkeys* for keys
(iup:vbox
(iup:hbox
;; Target and action
(iup:frame
#:title "Target"
(iup:vbox
;; Target selectors
(apply iup:hbox
(let* ((dat (dashboard:update-target-selector key-listboxes action-proc: update-keyvals))
(key-lb (car dat))
(combos (cadr dat)))
(set! key-listboxes key-lb)
combos))))
(iup:frame
#:title "Tests and Tasks"
(iup:vbox
(iup:canvas #:action (make-canvas-action
(lambda (cnv xadj yadj)
;; (print "cnv: " cnv " x: " x " y: " y)
(canvas-clear! cnv)
(canvas-font-set! cnv "Courier New, -8")
(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))))))
(print "sizex: " sizex " sizey: " sizey " font: " (canvas-font cnv))
(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))))))
#:size "150x200"
#:scrollbar "YES"
#:posx "0.5"
#:posy "0.5")))))))
(trace dashboard:populate-target-dropdown
common:list-is-sublist)
;; ;; key1 key2 key3 ...
;; ;; target entry (wild cards allowed)
;;
|