(define-module (nanolight fixture)
  #:use-module (oop goops)
  #:use-module (ice-9 threads)
  #:export (<fixture> <fixture-attribute>
             make-output
             patch-fixture show-state
             fixture-string get-address-string
             percent->dmxval
             get-start-addr get-universe))


(define-class <fixture-attribute> (<object>)

  (name
    #:init-value 'unnamed-attribute
    #:init-keyword #:name
    #:getter name)

  (offset
    #:init-value 0
    #:init-keyword #:offset
    #:getter offset)

  (continuous
    #:init-value #t
    #:init-keyword #:continuous
    #:getter continuous)

  (steps
    #:init-value '()
    #:init-keyword #:steps
    #:getter steps
    #:setter set-steps!))


(define-class <fixture> (<object>)

  (attributes
    #:init-value '()
    #:init-keyword #:attributes)

  (universe
    #:init-value #f
    #:init-keyword #:uni
    #:getter get-universe
    #:setter set-universe!)

  (start-addr
    #:init-value #f
    #:init-keyword #:sa
    #:getter get-start-addr
    #:setter set-start-addr!)

  (friendly-name
    #:init-value "Fixture"
    #:init-keyword #:friendly-name
    #:getter get-friendly-name
    #:setter set-friendly-name!)

  (address-string
    #:init-value #f
    #:allocation #:virtual
    #:getter get-address-string
    #:slot-ref (lambda (a)
                 (string-append
                   (number->string (slot-ref a 'universe))
                   "."
                   (number->string (slot-ref a 'start-addr))))
    #:slot-set! (lambda (a s) #f)))


(define (fixture-string fixture)
  (string-append
    (get-friendly-name fixture)
    " at "
    (get-address-string fixture)))


(define (patch-fixture output attributes universe start-addr friendly-name)
  (let ((new-fixture (make <fixture>
                       #:attributes attributes
                       #:uni universe
                       #:sa start-addr
                       #:friendly-name friendly-name)))
    (output 'add-fixture new-fixture)
    new-fixture))


; FIXME: Clamp to range
(define (percent->dmxval val)
  (/ (* 256 val) 100))


(define (show-state output state)
  (output 'show-state state))


(define (scanout fixture-list)

  (define (set-dmx universe addr nbytes value)
    #f)

  (define (scanout-fixture fixture)
    #f)

  (for-each scanout-fixture fixture-list))


(define (make-output)

  ; List of all patched fixtures (for scanout)
  (let ((fixtures '()))

    (define (run-scanout)
      (scanout fixtures)
      (yield)
      (run-scanout))

    (make-thread run-scanout)

    (define (show-state state)
      (display "Applying state:\n"))

    (define (add-fixture fixture)
      (set! fixtures (cons fixture fixtures)))

    (lambda args
      (apply
        (case (car args)
          ((show-state) show-state)
          ((add-fixture) add-fixture)
          (else => (error "Invalid method")))
        (cdr args)))))