(define-module (nanolight fixture)
  #:export (<fixture> <fixture-attribute>
             patch-fixture
             fixture-string get-address-string)
  #:use-module (oop goops))


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

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

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


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


; List of all patched fixtures (for scanout)
(define fixtures (list))

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


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


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