#lang racket

(require 2htdp/universe 2htdp/image (prefix-in p: plot) db)

(provide (all-from-out plot))

(provide (contract-out [live-graph (-> string? (-> number?) number? string? any/c)] 
                       [live-dashboard (-> (listof (listof string?))
                                           (listof (listof (-> number?)))
                                           number? 
                                           string?
                                           any/c)]
                       [struct db-struct ((connection connection?) 
                                          (table-name string?)                 
                                          (field-label string?) 
                                          (field-date-time string?) 
                                          (field-value string?))]
                       [insert-into-db (-> db-struct? string? exact-integer? number? void?)]
                       [error-value parameter?]
                       [new-value-event parameter?]
                       [delta-x parameter?] [delta-y parameter?])
         live-dashboard-one-ft)

(define error-value (make-parameter 0))
(define new-value-event (make-parameter (lambda (label seconds value) '()))) 
(define delta-x (make-parameter 3600)) ; 3600 s
(define delta-y (make-parameter 0.02)) ; 2%

(struct world (labels fts values))
(struct db-struct (connection table-name field-label field-date-time field-value))

(define date-begin (current-seconds))
(define date-end (+ date-begin (delta-x)))

(define (insert-into-db db label seconds value)
  (let ([t (seconds->date seconds)])
    (query-exec (db-struct-connection db)
                (string-append "insert into " 
                               (db-struct-table-name db) "(" 
                               (db-struct-field-label db) ","
                               (db-struct-field-date-time db) ","
                               (db-struct-field-value db) ") values ('"
                               label "','"
                               (number->string (date-year t)) "-"  
                               (number->string (date-month t)) "-"  
                               (number->string (date-day t)) " " 
                               (number->string (date-hour t)) ":" 
                               (number->string (date-minute t)) ":" 
                               (number->string (date-second t)) "',"
                               (number->string value) ")"))))

(define (new-data label ft data)
  (local [(define d (ft))
          (define evt (new-value-event))
          (define t (current-seconds))]
    (if (= d (error-value))
        data
        (begin 
          (evt label t d)
          (cons (vector t d) data)))))

(define (new-data-h labels fts values)
  (map new-data labels fts values))

(define (tick w)
  (world (world-labels w)
         (world-fts w)
         (map new-data-h (world-labels w) (world-fts w) (world-values w))))

(define (graph data label)
  (local ([define t (current-seconds)]
          [define x0 (if (< t (+ date-begin (delta-x)))
                         date-begin 
                         (+ (- t date-begin (delta-x)) date-begin))]
          [define y0 (abs (vector-ref (first data) 1))])
    (parameterize ([p:plot-x-ticks (p:time-ticks #:formats '("~H:~M"))])
      (p:plot (p:lines data)
              #:x-min x0 #:x-max (+ x0 (delta-x)) 
              #:y-min (if (= y0 0)
                          -1
                          (- y0 (* y0 (delta-y))))
              #:y-max (if (= y0 0)
                          1
                          (+ y0 (* y0 (delta-y)))) 
              #:title label #:x-label "" #:y-label ""))))

(define (render-h labels values)
  (if (empty? (rest labels))
      (graph (first values) (first labels))
      (apply beside (map graph values labels))))

(define (render w)
  (if (empty? (rest (world-labels w)))
      (render-h (first (world-labels w)) (first (world-values w)))
      (apply above (map render-h (world-labels w) (world-values w)))))

(define (init-values-h fts-h)
  (map (lambda (q) (list (vector (- (current-seconds) date-begin) (q))))
       fts-h))

(define (live-graph label ft rate title)
  (live-dashboard (list (list label)) (list (list ft)) rate title))

(define (live-dashboard labels fts rate title)
  (big-bang (world labels
                   fts                     
                   (map init-values-h fts))
            (on-tick tick rate)   
            (to-draw render)
            (name title)))

(define-syntax-rule (live-dashboard-one-ft labels ft rate title)
  (live-dashboard labels 
                  (map (lambda (l) 
                         (map (lambda (s) 
                                (lambda () (ft s)))
                              l)) 
                       labels)
                  rate
                  title))