Megatest

Check-in [02ff025715]
Login
Overview
Comment:Added scroll mechanism for dashboard
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 02ff025715ffc5d55c6e59803ad3571fffceca17
User & Date: mrwellan on 2011-09-06 01:01:02
Other Links: manifest | tags
Context
2011-09-06
09:05
Fixed left-right scrollbar action check-in: 69bcb818b8 user: mrwellan tags: trunk, v1.23
01:01
Added scroll mechanism for dashboard check-in: 02ff025715 user: mrwellan tags: trunk
2011-09-05
23:16
Added a valuator to dashboard for scrolling but don't see how to use it :( check-in: af7195daa4 user: matt tags: trunk
Changes

Modified dashboard.scm from [1206c5ab3a] to [d0d7d6f5a3].

80
81
82
83
84
85
86
87

88
89
90
91
92
93
94
80
81
82
83
84
85
86

87
88
89
90
91
92
93
94







-
+







(define dbkeys   (map (lambda (x)(vector-ref x 0))
		      (append *keys* (list (vector "runname" "blah")))))
(define *header*       #f)
(define *allruns*     '())
(define *buttondat*    (make-hash-table)) ;; <run-id color text test run-key>
(define *alltestnamelst* '())
(define *searchpatts*  (make-hash-table))
(define *num-runs*      6)
(define *num-runs*      8)
(define *num-tests*     15)
(define *start-run-offset*  0)
(define *start-test-offset* 0)
(define *examine-test-dat* (make-hash-table))
(define *exit-started* #f)

(define *verbosity* (cond
400
401
402
403
404
405
406





407
408
409
410
411
412
413
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418







+
+
+
+
+







			#:action (lambda (obj unk val)
				   (update-search "item-name" val)))
	   (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
	   (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
	   (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
	   (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
	   (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset*  (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))
	   (iup:valuator #:valuechanged_cb (lambda (obj)
					     (let ((val (iup:attribute obj "VALUE")))
					       (set! *start-run-offset* (inexact->exact (round (string->number val))))
					       (iup:attribute-set! obj "MAX" (length *allruns*))))
			 #:expand "YES")
	   ;(iup:button "inc rows" #:action (lambda (obj)(set! *num-tests* (+ *num-tests* 1))))
	   ;(iup:button "dec rows" #:action (lambda (obj)(set! *num-tests* (if (> *num-tests* 0)(- *num-tests* 1) 0))))
	   )
	  )
    
    ;; create the left most column for the run key names and the test names 
    (set! lftlst (list (iup:hbox
424
425
426
427
428
429
430
431





432
433
434
435
436
437
438
429
430
431
432
433
434
435

436
437
438
439
440
441
442
443
444
445
446
447







-
+
+
+
+
+







				    keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (iup:hbox 
					   (iup:valuator #:action (lambda (obj val)(print "Got: " obj ", " val)) 
					   (iup:valuator #:valuechanged_cb (lambda (obj)
									     (let ((val (iup:attribute obj "VALUE")))
									       (set! *start-test-offset* (inexact->exact (round (string->number val))))
									       (iup:attribute-set! obj "MAX" (length *alltestnamelst*))
									       ) )
							 #:expand "YES" 
							 #:orientation "VERTICAL")
					   (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" 
				 #:flat "YES" 
				 ; #:image img1