(use-modules (srfi srfi-1))

(define set-level
  (lambda (fix level)
    (cond
      [(list? fix) (for-each (lambda (q)
                               (set-level q level))
                             fix)]
      [(symbol? fix) (set-intensity
                       (find-fixture fixtures fix)
                       level)]
      [else (set-intensity fix level)])))


(define find-fixture
  (lambda (fixtures name)
    (cond
      [(null? fixtures) #f]
      [(eq? (fixture-name (car fixtures)) name) (car fixtures)]
      [else (find-fixture (cdr fixtures) name)])))


(define find-fixture-class
  (lambda (fixture-classes name)
    (cond
      [(null? fixture-classes) #f]
      [(string-ci=? (fixture-class-name (car fixture-classes)) name) (car fixture-classes)]
      [else (find-fixture-class (cdr fixture-classes) name)])))


(define patch-many
  (lambda (fixcls prefix n universe start-addr)
    (define f (lambda (i)
                 (patch-fixture (symbol-append prefix (string->symbol (number->string i)))
                                fixcls universe (+ start-addr (- i 1)))
                 (if (< i n)
                   (f (+ i 1)))))
    (if fixcls
      (f 1)
      (display "Fixture class not available\n"))))


(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)))))


; ********** Demo **********

(patch-many (find-fixture-class fixture-class-library "Robe Robin DL7S Profile Mode 1") 'mh 4 0 51)
(patch-many (find-fixture-class fixture-class-library "Generic dimmer") 'dim 6 0 1)

(define (exstate)
  (combine-states
    (flash 2 'mh1)
    (int 0 'mh2)
    (int (+ 30 30) 'mh3)
    (int 32 'mh4)
    (int 100 'dim1)
    (int 12 'dim2)))

; (def-cue lx5.7
;  (xf 'up 10 'down 5 example-state))