Megatest

Check-in [dfa2cc9171]
Login
Overview
Comment:Copied in Ritika's graph label changes and hacked a little
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: dfa2cc917156aacf418be513478a2e68ed065253
User & Date: matt on 2016-08-01 23:59:41
Other Links: branch diff | manifest | tags
Context
2016-08-02
15:43
Merged with v1.61 check-in: a05a9a1fd3 user: ritikaag tags: popup_menu
09:53
fixed couple display issues check-in: 66b05abf57 user: mrwellan tags: v1.61
2016-08-01
23:59
Copied in Ritika's graph label changes and hacked a little check-in: dfa2cc9171 user: matt tags: v1.61
22:50
Fixed scaling bug check-in: 30789f6be7 user: matt tags: v1.61
Changes

Modified common.scm from [62abc5daf1] to [1aafdfd6ed].

977
978
979
980
981
982
983




984
985
986
987
988
989
990
991
992
993


































994
995
996
997
998
999
1000
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038







+
+
+
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







  (time->string
   (seconds->local-time sec) "%yww%V.%w"))

(define (seconds->year-work-week/day-time sec)
  (time->string
   (seconds->local-time sec) "%Yww%V.%w %H:%M"))

(define (seconds->year-week/day-time sec)
  (time->string
   (seconds->local-time sec) "%Yw%V.%w %H:%M"))

(define (seconds->quarter sec)
  (case (string->number
	 (time->string 
	  (seconds->local-time sec)
	  "%m"))
    ((1 2 3) 1)
    ((4 5 6) 2)
    ((7 8 9) 3)
    ((10 11 12) 4)
    (else #f)))

;; given span of seconds tstart to tend
;; find start time to mark and mark delta
;;
(define (common:find-start-mark-and-mark-delta tstart tend)
  (let* ((deltat   (- tend tstart))
	 (result   #f)
	 (min      60)
	 (hr       (* 60 60))
	 (day      (* 24 hr))
	 (yr       (* 365 day)) ;; year
	 (mo       (/ yr 12))
	 (wk       (* day 7)))
    (for-each
     (lambda (max-blks)
       (for-each
	(lambda (span) ;; 5 2 1
	  (if (not result)
	      (for-each 
	       (lambda (timeunit timesym) ;; year month day hr min sec
		 (if (not result)
		     (let* ((time-blk (* span timeunit))
			    (num-blks (quotient deltat time-blk)))
		       (if (and (> num-blks 4)(< num-blks max-blks))
			   (let ((first (* (quotient tstart time-blk) time-blk)))
			     (set! result (list span timeunit time-blk first timesym))
			     )))))
	       (list yr mo wk day hr min 1)
	       '(     y  mo w  d   h  m   s))))
	(list 8 6 5 2 1)))
     '(5 10 15 20 30 40 50 500))
    (apply values result)))
	    
	  

;;======================================================================
;; C O L O R S
;;======================================================================
      
(define (common:name->iup-color name)
  (case (string->symbol (string-downcase name))

Modified dashboard.scm from [0391d85ac4] to [28cbba327c].

2715
2716
2717
2718
2719
2720
2721




















2722

2723
2724
2725

2726
2727
2728
2729
2730
2731
2732
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741

2742
2743
2744

2745
2746
2747
2748
2749
2750
2751
2752







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+


-
+







							fill-color: stdcolor
							line-color: stdcolor))
				     (print "ERROR: curr-tval is not > last-tval; curr-tval " curr-tval ", last-tval " last-tval))))
			   next)
			 ;; for init create vector tstart,0
			 #f ;; (vector tstart minval minval)
			 dat)
			 (vg:add-obj-to-comp
			  cmp
			  (vg:make-text-obj (- (tfn tstart) 10)(- lly 10)(seconds->year-week/day-time tstart)))
			 (let*-values (((span timeunit time-blk first timesym) (common:find-start-mark-and-mark-delta tstart tend)))
			   (let loop ((mark  first)
				      (count 0))
			     (let* ((smark (tfn mark))           ;; scale the mark
				    (mark-delta (quotient (- mark tstart) time-blk)) ;; how far from first mark
				    (label      (conc mark-delta timesym)))
			       (if (> count 2)
				   (begin
				     (vg:add-obj-to-comp
				      cmp
				      (vg:make-rect-obj (- smark 1)(- lly 2)(+ smark 1) lly))
				     (vg:add-obj-to-comp
				      cmp
				      (vg:make-text-obj (- smark 1)(- lly 10) label))))
			       (if (< mark (- tend time-blk))
				   (loop (+ mark time-blk)(+ count 1))))))
			   
			;; (for-each
			 ;; (for-each
			;;  (lambda (dpt)
			;;    (let* ((tval  (vector-ref dpt 0))
			;; 	  (yval  (vector-ref dpt 2))
			 ;; 	  (yval  (vector-ref dpt 2))
			;; 	  (stval (tfn tval))
			;; 	  (syval (yfunc yval)))
			;;      (vg:add-obj-to-comp
			;;       cmp 
			;;       (vg:make-rect-obj (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
			;; 			fill-color: stdcolor))))
			;;  dat)