(define-module (nanolight state)
  #:export (combine-states print-state int flash))

(use-modules (nanolight fixture))
(use-modules (srfi srfi-1))


(define (find-fixture-attr fixture attr state)
  (find (lambda (a) (and
                      (eq? (car a) fixture)
                      (eq? (cadr a) attr)))
    state))


; Combine two states.  Return combined list
(define (merge-states a b)
  (let ((c '()))

    (define (add-to-state add)

      ; Already in state?
      (let ((attr (find-fixture-attr (car add) (cadr add) c)))
        (if attr
          (set-cdr! (last-pair attr) (cddr add))  ; add to existing list
          (set! c (cons add c)))))   ; add fixture+attr to state

    (for-each add-to-state a)
    (for-each add-to-state b)

    c))


; Combine the first two states in the list
; Return a new list, one shorter than the input
(define (merge-first-two-states a)
  (cons (merge-states (car a) (cadr a)) (cddr a)))


; Each argument is a "state", i.e. a list of these: (fixture attr function)
; Returns a combined state, with non-unique fixtures combined
(define (combine-states . a)
  (cond
    [(= (length a) 0) '()]
    [(= (length a) 1) (car a)]
    [else (apply combine-states (merge-first-two-states a))]))


(define (print-state st)

  (define (print-statelet a)
    (display (car a))
    (display " ")
    (display (cadr a))
    (newline)
    (for-each (lambda (b)
                (display "       ")
                (display b)
                (display "  --->  ")
                (display (b))
                (newline))
      (cddr a)))

  (for-each print-statelet st))


; Helper functions

(define (hirestime)
  (let ((a (gettimeofday)))
    (+
      (car a)
      (/
        (cdr a)
        1000000))))

(define pi 3.141592653589793)

(define (square-wave hz)
  (if (> (sin (* 2 pi hz (hirestime))) 0) 100 0))

(define (static-value attr value fixture)
  (list (list fixture attr (lambda () value))))


; Useful source functions

(define (int value fixture)
  (static-value 'intensity value fixture))

(define (pan value fixture)
  (static-value 'pan value fixture))

(define (tilt value fixture)
  (static-value 'tilt value fixture))

(define (flash hz fixture)
  (list (list fixture 'intensity (lambda () (square-wave hz)))))