1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
(define-module (generate-data-svg) #:use-module (srfi srfi-1) ;; map/reduce #:use-module (srfi srfi-19) ;; date #:use-module (srfi srfi-69) ;; hash-tables #:use-module (system-utils) #:export (generate-svg generate-days-table)) (define* (generate-days-table year data #:optional (days (make-hash-table))) (map (lambda (d) (define date-id (date->id (assoc-ref d 'date))) (define current-activity-counter (hash-table-ref/default days date-id (make-hash-table))) (define project (assoc-ref d 'project)) (define link (assoc-ref d 'link)) (hash-table-set! days date-id (increase-day-activity-project current-activity-counter project link)) date-id) data) days) (define (increase-day-activity-project day project link) (if (hash-table? day) (let () (define project-state (hash-table-ref/default day project (new-project-state link))) (define old-value (hash-table-ref project-state 'counter)) (define old-links (hash-table-ref project-state 'links)) (when link (hash-table-set! project-state 'links (cons link old-links))) (hash-table-set! project-state 'counter (+ 1 old-value)) (hash-table-set! day project project-state) day) (let ((table (make-hash-table))) (hash-table-set! table project (new-project-state link)) table))) (define (new-project-state link) (alist->hash-table `((counter . 1) ,(if link `(links . (,link)) `(links . ())) ))) (define (make-tooltip day) (if (hash-table? day) (hash-table-fold day (lambda (project project-state acc) (define activity-count (hash-table-ref project-state 'counter)) (string-append (if acc (string-append acc "\n") "") (or project "") ": " (number->string activity-count))) #f) "no activity")) (define (day-total-count day) (if (hash-table? day) (hash-table-fold day (lambda (k v acc) (+ (hash-table-ref v 'counter) acc)) 0) 0)) (define (day-total-links day) (if (hash-table? day) (hash-table-fold day (lambda (k v acc) (define links (hash-table-ref v 'links)) (if (null? links) acc (append links acc))) '()) '())) (define (date->id date) (string-append (number->string (date-year date)) "-" (number->string (date-year-day date)))) (define (rgba-number-str v) (number->string (inexact->exact (floor v)))) (define (rgba-string r g b a) (string-append "rgba(" (rgba-number-str r) "," (rgba-number-str g) "," (rgba-number-str b) "," (number->string (exact->inexact a)) ")")) (define (generate-svg template year days) (define gen-fn (assoc-ref template 'fn)) (define theme (assoc-ref template 'theme)) (let* ((max-val (hash-table-fold days (lambda (k v acc) (max (day-total-count v) acc)) 1))) (gen-fn year (lambda (date) (let* ((d (date->id date)) (val (day-total-count (hash-table-ref/default days d #f))) (links (day-total-links (hash-table-ref/default days d #f))) (factor (/ val max-val)) (tooltip (make-tooltip (hash-table-ref/default days d #f)))) `(,(if (> val 0) `(fill ,(rgba-string (* factor 10) (* factor 245) (* factor 30) (if (> val 0) 1 0.8))) `(fill ,(assoc-ref theme 'day-bg))) ,(if (> val 0) `(class "day") `(class "day no-event")) (title ,tooltip) ,(if (null? links) `(_ . _) `(desc ,(links-to-text (delete-duplicates links)))))))))) (define (links-to-text links) (if (null? links) "" (string-append "link: " (car links) "\n" (links-to-text (cdr links)))))