diff options
author | Thomas White <taw@bitwiz.me.uk> | 2021-01-11 17:49:52 +0100 |
---|---|---|
committer | Thomas White <taw@bitwiz.me.uk> | 2021-01-11 17:49:52 +0100 |
commit | 27e29284b86f69a1eeb23138b29b0079972e41d2 (patch) | |
tree | 1d4aac73d68a8834cb073cf1161ffefe3eef19d5 | |
parent | 7200a3802e06e9a3dadd6cad0d209387a0149f86 (diff) |
More consistent behaviour between 8-bit and 16-bit setters
-rw-r--r-- | guile/starlet/base.scm | 29 | ||||
-rw-r--r-- | guile/starlet/fixture-library/generic.scm | 14 | ||||
-rw-r--r-- | guile/starlet/fixture-library/robe.scm | 32 |
3 files changed, 45 insertions, 30 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index dc683e5..93cec6d 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -15,7 +15,9 @@ scanout-freq make-empty-state register-state! - percent->dmxval + percent->dmxval8 + percent->dmxval16 + scale-to-range hirestime state-for-each get-attributes @@ -216,8 +218,22 @@ (inexact->exact (min 255 (max 0 (round a))))) -(define (percent->dmxval val) - (round-dmx (/ (* 256 val) 100))) +(define (scale-to-range val orig-range dest-range) + + (define (range r) + (- (cadr r) (car r))) + + (+ (car dest-range) + (* (range dest-range) + (/ (- val (car orig-range)) + (range orig-range))))) + +(define (percent->dmxval8 val) + (round-dmx + (scale-to-range val '(0 100) '(0 255)))) + +(define (percent->dmxval16 val) + (scale-to-range val '(0 100) '(0 65535))) (define (msb val) (round-dmx (euclidean-quotient val 256))) @@ -386,11 +402,10 @@ value))) ;; Helper function to set 16-bit DMX value - (define (set-chan-16bit relative-channel-number value max-value) + (define (set-chan-16bit relative-channel-number value) (when value - (let ((val16 (* (min value max-value) (/ 65535 max-value)))) - (set-chan relative-channel-number (msb val16)) - (set-chan (+ relative-channel-number 1) (lsb val16))))) + (set-chan relative-channel-number (msb value)) + (set-chan (+ relative-channel-number 1) (lsb value)))) (scanout-fixture fix get-attr set-chan set-chan-16bit)) diff --git a/guile/starlet/fixture-library/generic.scm b/guile/starlet/fixture-library/generic.scm index 5806788..69f92f7 100644 --- a/guile/starlet/fixture-library/generic.scm +++ b/guile/starlet/fixture-library/generic.scm @@ -11,10 +11,10 @@ (define-method (scanout-fixture (fixture <generic-dimmer>) - get-attr set-chan set-chan-16bit) + get-attr set-chan8 set-chan16) ;; Set DMX value for intensity - (set-chan 1 (percent->dmxval (get-attr 'intensity)))) + (set-chan8 1 (percent->dmxval8 (get-attr 'intensity)))) (define (chan->attr chan) @@ -33,7 +33,7 @@ (add-method! scanout-fixture - (method ((fix new-class) get-attr set-chan set-chan-16bit) + (method ((fix new-class) get-attr set-chan8 set-chan16) (for-each (lambda (chan offset) @@ -41,13 +41,13 @@ (cond ((eq? chan '0) - (set-chan offset 0)) + (set-chan8 offset 0)) ((eq? chan 'FL) - (set-chan offset 255)) + (set-chan8 offset 255)) - (else (set-chan offset - (percent->dmxval + (else (set-chan8 offset + (percent->dmxval8 (get-attr chan)))))) chans (iota (length chans) 1)))) diff --git a/guile/starlet/fixture-library/robe.scm b/guile/starlet/fixture-library/robe.scm index 7ad12a6..5a19286 100644 --- a/guile/starlet/fixture-library/robe.scm +++ b/guile/starlet/fixture-library/robe.scm @@ -21,25 +21,25 @@ (define-method (scanout-fixture (fixture <robe-dl7s-mode1>) - get-attr set-chan set-chan-16bit) + get-attr set-chan8 set-chan16) - (set-chan-16bit 50 (get-attr 'intensity) 100) + (set-chan16 50 (percent->dmxval16 (get-attr 'intensity))) - (set-chan-16bit 1 (get-attr 'pan) 540) - (set-chan-16bit 3 (get-attr 'tilt) 270) + (set-chan16 1 (scale-to-range (get-attr 'pan) '(0 540) '(0 65535))) + (set-chan16 3 (scale-to-range (get-attr 'tilt) (0 270) '(0 65535))) - (set-chan 49 (if (get-attr 'strobe) 95 32)) + (set-chan8 49 (if (get-attr 'strobe) 95 32)) - (set-chan 28 (if (get-attr 'prism) 50 0)) + (set-chan8 28 (if (get-attr 'prism) 50 0)) - (set-chan 7 (assv-ref '((750 . 82) - (1000 . 88) - (1200 . 92) - (2000 . 97) - (2500 . 102) - (#f . 107)) - (get-attr 'tungsten-watts-emulation))) + (set-chan8 7 (assv-ref '((750 . 82) + (1000 . 88) + (1200 . 92) + (2000 . 97) + (2500 . 102) + (#f . 107)) + (get-attr 'tungsten-watts-emulation))) - (set-chan-16bit 9 (get-attr 'cyan) 100) - (set-chan-16bit 11 (get-attr 'magenta) 100) - (set-chan-16bit 13 (get-attr 'yellow) 100)) + (set-chan16 9 (percent->dmxval16 (get-attr 'cyan))) + (set-chan16 11 (percent->dmxval16 (get-attr 'magenta))) + (set-chan16 13 (percent->dmxval16 (get-attr 'yellow)))) |