Overview
| Comment: | Improved scaling and mapping for displaying tests on canvas |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | runcontrol |
| Files: | files | file ages | folders |
| SHA1: |
e26711edf536b1e5e0580f51e6480670 |
| User & Date: | mrwellan on 2013-04-22 11:10:01 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-04-22
| ||
| 19:47 | Merged dev into runcontrol check-in: df98c96bb1 user: matt tags: runcontrol | |
| 11:10 | Improved scaling and mapping for displaying tests on canvas check-in: e26711edf5 user: mrwellan tags: runcontrol | |
| 01:25 | Draw test/task boxes in rows to keep compact interface check-in: df77e9f1bd user: matt tags: runcontrol | |
Changes
Modified dashboard.scm from [0c39bd9508] to [f334b951f8].
| ︙ | ︙ | |||
508 509 510 511 512 513 514 | listboxes))) (loop (car remkeys) (cdr remkeys) (append refvals (list selected-value)) (+ indx 1) (append lbs (list lb)))))))) | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | > | 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 |
listboxes)))
(loop (car remkeys)
(cdr remkeys)
(append refvals (list selected-value))
(+ indx 1)
(append lbs (list lb))))))))
(define (dashboard:draw-tests cnv xadj yadj test-draw-state sorted-testnames)
(canvas-clear! cnv)
(canvas-font-set! cnv "Courier New, -8")
(let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv)))
(if (hash-table-ref/default test-draw-state 'first-time #t)
(begin
(hash-table-set! test-draw-state 'first-time #f)
(hash-table-set! test-draw-state 'scalef 8)
;; set these
(hash-table-set! test-draw-state 'test-browse-xoffset 20) ;; (- 0 (* (/ sizex 2) (* 8 xadj))))
(hash-table-set! test-draw-state 'test-browse-yoffset 20))) ;; (- 0 (* (/ sizey 2) (* 8 (- 1 yadj)))))))
(let* ((scalef (hash-table-ref/default test-draw-state 'scalef 8))
(test-browse-xoffset (hash-table-ref test-draw-state 'test-browse-xoffset))
(test-browse-yoffset (hash-table-ref test-draw-state 'test-browse-yoffset))
(xtorig (+ test-browse-xoffset (* (/ sizex 2) scalef (- 0.5 xadj)))) ;; (- xadj 1))))
(ytorig (+ test-browse-yoffset (* (/ sizey 2) scalef (- yadj 0.5))))
(boxw 80)
(boxh 30)
(gapx 20)
(gapy 30))
(print "sizex: " sizex " sizey: " sizey " font: " (canvas-font cnv) " originx: " originx " originy: " originy " xtorig: " xtorig " ytorig: " ytorig " xadj: " xadj " yadj: " yadj)
(let loop ((hed (car (reverse sorted-testnames)))
(tal (cdr (reverse sorted-testnames)))
(llx xtorig)
(lly ytorig)
(urx (+ xtorig boxw))
(ury (+ ytorig boxh)))
; (print "hed " hed " llx " llx " lly " lly " urx " urx " ury " ury)
(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)))))))))
(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)
))
(tests-draw-state (make-hash-table))) ;; use for keeping state of the test canvas
(hash-table-set! tests-draw-state 'first-time #t)
(hash-table-set! tests-draw-state 'scalef 8)
(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
|
| ︙ | ︙ | |||
549 550 551 552 553 554 555 |
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)
| | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 |
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)
(dashboard:draw-tests cnv xadj yadj tests-draw-state sorted-testnames)))
#:size "150x200"
#:scrollbar "YES"
#:posx "0.5"
#:posy "0.5")))))))
(trace dashboard:populate-target-dropdown
|
| ︙ | ︙ |