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: |
dfa2cc917156aacf418be513478a2e68 |
| 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 |
(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->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)))
;;======================================================================
;; C O L O R S
;;======================================================================
(define (common:name->iup-color name)
(case (string->symbol (string-downcase name))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | 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) | > > > > > > > > > > > > > > > > > > > > | | | 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 ;; (lambda (dpt) ;; (let* ((tval (vector-ref dpt 0)) ;; (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) |
| ︙ | ︙ |