diff options
| author | Thomas White <taw@physics.org> | 2021-03-29 17:32:26 +0200 |
|---|---|---|
| committer | Thomas White <taw@physics.org> | 2021-03-31 21:56:36 +0200 |
| commit | 5a08e6dc4f38eb667d170c2dac3261298722f379 (patch) | |
| tree | 9128b3ee2850194d5e82fcf42ee6cfcb9deefb8e /guile | |
| parent | be86b2caebb40eb19bd29f2a01645af88ae86599 (diff) | |
Factorise ensure-number
Diffstat (limited to 'guile')
| -rw-r--r-- | guile/starlet/base.scm | 36 |
1 files changed, 12 insertions, 24 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index 4e47937..a0958e3 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -381,6 +381,14 @@ pre-existing contents." (/ (cdr a) 1000000)))) + +(define (ensure-number value irritating) + (unless (number? value) + (raise-exception (make-exception + (make-exception-with-message "Value is not a number") + (make-exception-with-irritants irritating))))) + + (define scanout-freq 0) (define-generic scanout-fixture) @@ -391,13 +399,7 @@ pre-existing contents." ;; Helper function for scanout functions to set individual DMX values (define (set-dmx universe addr value) - - (unless (number? value) - (raise-exception (make-exception - (make-exception-with-message - "Attempt to set non-number DMX value") - (make-exception-with-irritants - (list universe addr value))))) + (ensure-number value (list universe addr value)) ;; Create DMX array for universe if it doesn't exist already (unless (assq universe universes) @@ -422,26 +424,12 @@ pre-existing contents." ;; Helper function to set 8-bit DMX value (define (set-chan relative-channel-number value) - - (unless (number? value) - (raise-exception (make-exception - (make-exception-with-message - "set-chan: value is not a number") - (make-exception-with-irritants - (list relative-channel-number value))))) - (set-dmx univ - (+ addr relative-channel-number -1) - value)) + (ensure-number value (list fix relative-channel-number value)) + (set-dmx univ (+ addr relative-channel-number -1) value)) ;; Helper function to set 16-bit DMX value (define (set-chan-16bit relative-channel-number value) - (unless (number? value) - (raise-exception (make-exception - (make-exception-with-message - "set-chan16: value is not a number") - (make-exception-with-irritants - (list relative-channel-number - value))))) + (ensure-number value (list fix relative-channel-number value)) (set-chan relative-channel-number (msb value)) (set-chan (+ relative-channel-number 1) (lsb value))) |