Overview
| Comment: | Draw test/task boxes in rows to keep compact interface |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | runcontrol |
| Files: | files | file ages | folders |
| SHA1: |
df77e9f1bdd7e8db515862cbc3689bc6 |
| User & Date: | matt on 2013-04-22 01:25:35 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-04-22
| ||
| 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 | |
| 00:59 | Display of tests on canvas partially implemented check-in: efa1af53d5 user: matt tags: runcontrol | |
Changes
Modified dashboard.scm from [3061b16302] to [0c39bd9508].
| ︙ | ︙ | |||
558 559 560 561 562 563 564 | (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)))) | | > > > > > | > > > > | | > > > > > > > | | | 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)))))
(boxw 80)
(boxh 30)
(gapx 20)
(gapy 30))
(print "sizex: " sizex " sizey: " sizey " font: " (canvas-font cnv))
(let loop ((hed (car (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
|
| ︙ | ︙ |
Modified runs.scm from [0d071f8e6c] to [6964d1aab5].
| ︙ | ︙ | |||
249 250 251 252 253 254 255 256 257 258 259 260 261 262 |
;; A failed for some reason then on re-run using -keepgoing the run can never complete.
(cdb:delete-tests-in-state *runremote* run-id "NOT_STARTED")
(cdb:remote-run db:set-tests-state-status #f run-id test-names #f "FAIL" "NOT_STARTED" "FAIL")))
;; from here on out the db will be opened and closed on every call runs:run-tests-queue
;; (sqlite3:finalize! db)
;; now add non-directly referenced dependencies (i.e. waiton)
(if (not (null? test-names))
(let loop ((hed (car test-names))
(tal (cdr test-names))) ;; 'return-procs tells the config reader to prep running system but return a proc
(debug:print-info 4 "hed=" hed " at top of loop")
(let* ((config (tests:get-testconfig hed 'return-procs))
(waitons (let ((instr (if config
(config-lookup config "requirements" "waiton")
| > > > | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 |
;; A failed for some reason then on re-run using -keepgoing the run can never complete.
(cdb:delete-tests-in-state *runremote* run-id "NOT_STARTED")
(cdb:remote-run db:set-tests-state-status #f run-id test-names #f "FAIL" "NOT_STARTED" "FAIL")))
;; from here on out the db will be opened and closed on every call runs:run-tests-queue
;; (sqlite3:finalize! db)
;; now add non-directly referenced dependencies (i.e. waiton)
;;======================================================================
;; refactoring this block into tests:get-full-data
;;======================================================================
(if (not (null? test-names))
(let loop ((hed (car test-names))
(tal (cdr test-names))) ;; 'return-procs tells the config reader to prep running system but return a proc
(debug:print-info 4 "hed=" hed " at top of loop")
(let* ((config (tests:get-testconfig hed 'return-procs))
(waitons (let ((instr (if config
(config-lookup config "requirements" "waiton")
|
| ︙ | ︙ |