#lang racket

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

(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)]
                       [delta-x parameter?] [delta-y parameter?])
         live-dashboard-one-ft)

(define delta-x (make-parameter 3600)) ; 3600 s
(define delta-y (make-parameter 0.02)) ; 2%

(struct world (labels fts values))

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

(define (new-data label ft data)
  (local [(define d (ft))]
    (if (>= d 0)
        (cons (vector (- (current-seconds) date-begin) d) data)
        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)))
                         0 
                         (- t date-begin (delta-x)))]
          [define y0 (abs (vector-ref (first data) 1))])
    (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))