Overview
| Comment: | Refactored draw-tests for easier improvements |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.55 |
| Files: | files | file ages | folders |
| SHA1: |
0dd4ebdb1774ddb5776883600bb36f57 |
| User & Date: | matt on 2014-06-22 22:09:43 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-06-22
| ||
| 23:05 | Make all test names fit in the boxes check-in: b8007dd874 user: matt tags: v1.55 | |
| 22:09 | Refactored draw-tests for easier improvements check-in: 0dd4ebdb17 user: matt tags: v1.55 | |
| 19:03 | Made sort of runs on dashboard into a dropdown check-in: ea04a96df6 user: matt tags: v1.55 | |
Changes
Modified dashboard.scm from [5593c1569e] to [6888c13912].
| ︙ | ︙ | |||
693 694 695 696 697 698 699 | (begin (hash-table-set! tests-draw-state 'first-time #f) (hash-table-set! tests-draw-state 'scalef 8) (hash-table-set! tests-draw-state 'tests-info (make-hash-table)) (hash-table-set! tests-draw-state 'selected-tests (make-hash-table)) ;; set these (hash-table-set! tests-draw-state 'test-browse-xoffset 20) ;; (- 0 (* (/ sizex 2) (* 8 xadj)))) | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 |
(begin
(hash-table-set! tests-draw-state 'first-time #f)
(hash-table-set! tests-draw-state 'scalef 8)
(hash-table-set! tests-draw-state 'tests-info (make-hash-table))
(hash-table-set! tests-draw-state 'selected-tests (make-hash-table))
;; set these
(hash-table-set! tests-draw-state 'test-browse-xoffset 20) ;; (- 0 (* (/ sizex 2) (* 8 xadj))))
(hash-table-set! tests-draw-state 'test-browse-yoffset 20) ;; (- 0 (* (/ sizey 2) (* 8 (- 1 yadj)))))))
(dcommon:initial-draw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames))
(dcommon:redraw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames))
))
;;======================================================================
;; R U N C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
|
| ︙ | ︙ |
Modified dcommon.scm from [e880bfbb25] to [f1ad685f19].
| ︙ | ︙ | |||
552 553 554 555 556 557 558 |
(let* ((llx x)
(lly y)
(urx (+ x w))
(ury (+ y h)))
(canvas-text! cnv (+ llx 5)(+ lly 5) name) ;; (conc testname " (" xtorig "," ytorig ")"))
(canvas-rectangle! cnv llx urx lly ury)
(if selected (canvas-box! cnv llx (+ llx 5) lly (+ lly 5)))))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 |
(let* ((llx x)
(lly y)
(urx (+ x w))
(ury (+ y h)))
(canvas-text! cnv (+ llx 5)(+ lly 5) name) ;; (conc testname " (" xtorig "," ytorig ")"))
(canvas-rectangle! cnv llx urx lly ury)
(if selected (canvas-box! cnv llx (+ llx 5) lly (+ lly 5)))))
(define (dcommon:initial-draw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames)
(let* ((scalef (hash-table-ref/default tests-draw-state 'scalef 8))
(test-browse-xoffset (hash-table-ref tests-draw-state 'test-browse-xoffset))
(test-browse-yoffset (hash-table-ref tests-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 90)
(boxh 25)
(gapx 20)
(gapy 30)
(tests-hash (hash-table-ref tests-draw-state 'tests-info))
(selected-tests (hash-table-ref tests-draw-state 'selected-tests )))
;; (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)
(dcommon:draw-test cnv llx lly boxw boxh hed (hash-table-ref/default selected-tests hed #f))
;; (canvas-text! cnv (+ llx 5)(+ lly 5) hed) ;; (conc testname " (" xtorig "," ytorig ")"))
;; (canvas-rectangle! cnv llx urx lly ury)
;; (if (hash-table-ref/default selected-tests hed #f)
;; (canvas-box! cnv llx (+ llx 5) lly (+ lly 5)))
(hash-table-set! tests-hash hed (list llx urx (- sizey ury)(- sizey lly))) ;; NB// Swap ury and lly
(if (not (null? tal))
;; leave a column of space to the right to list items
(let ((have-room
(if #t ;; put "auto" here where some form of auto rearanging can be done
(> (* 3 (+ boxw gapx)) (- urx xtorig))
(< 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 (dcommon:redraw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames)
(let* ((scalef (hash-table-ref/default tests-draw-state 'scalef 8))
(test-browse-xoffset (hash-table-ref tests-draw-state 'test-browse-xoffset))
(test-browse-yoffset (hash-table-ref tests-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 90)
(boxh 25)
(gapx 20)
(gapy 30)
(tests-hash (hash-table-ref tests-draw-state 'tests-info))
(selected-tests (hash-table-ref tests-draw-state 'selected-tests )))
(let loop ((hed (car (reverse sorted-testnames)))
(tal (cdr (reverse sorted-testnames)))
(llx xtorig)
(lly ytorig)
(urx (+ xtorig boxw))
(ury (+ ytorig boxh)))
(dcommon:draw-test cnv llx lly boxw boxh hed (hash-table-ref/default selected-tests hed #f))
(hash-table-set! tests-hash hed (list llx urx (- sizey ury)(- sizey lly))) ;; NB// Swap ury and lly
(if (not (null? tal))
;; leave a column of space to the right to list items
(let ((have-room
(if #t ;; put "auto" here where some form of auto rearanging can be done
(> (* 3 (+ boxw gapx)) (- urx xtorig))
(< 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))))))))
|