diff options
author | Thomas White <taw@physics.org> | 2021-04-02 17:43:39 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2021-04-02 17:43:39 +0200 |
commit | 348885be43fd8c97b2eea6623ab3632939d77dcf (patch) | |
tree | 5953352bcd74e5764b46c5b5110bce6bded6217f /guile | |
parent | add2b58c8aac92f6ab1f9f3b134b0279faa2494c (diff) |
Replace merging of states with search through list of states
This is LOADS faster.
Diffstat (limited to 'guile')
-rw-r--r-- | guile/starlet/base.scm | 108 | ||||
-rw-r--r-- | guile/starlet/midi-control/faders.scm | 2 |
2 files changed, 38 insertions, 72 deletions
diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm index cd54d0d..d53720e 100644 --- a/guile/starlet/base.scm +++ b/guile/starlet/base.scm @@ -204,8 +204,8 @@ (define (register-state! new-state) (atomic-box-set! state-list - (cons new-state - (atomic-box-ref state-list)))) + (append (atomic-box-ref state-list) + (list new-state)))) ;; Patch a new fixture (define* (patch-real name @@ -278,37 +278,16 @@ (get-state-hash-table state))) -;; Add the contents of state "new" to "combined-state" -(define (add-state-to-state! merge-rule new combined-state) - (state-for-each (lambda (fix attr incoming-value) - (unless (eq? 'no-value incoming-value) - (let ((current-value (state-find fix - attr - combined-state))) - (if (eq? 'no-value current-value) - (set-in-state! combined-state - fix - attr - incoming-value) - (set-in-state! combined-state - fix - attr - (merge-rule attr - current-value - incoming-value)))))) - new)) - - (define (apply-state state) "Apply the contents of 'state' to the current state, on top of the \ pre-existing contents." - (add-state-to-state! merge-rule-ltp state (current-state))) + (state-for-each at state)) (define (show-state state) "Clear the current state, and apply the contents of 'state'" (clear-state! (current-state)) - (add-state-to-state! merge-rule-ltp state (current-state))) + (state-for-each at state)) ;; Coerce something from a state object into a number for scanout @@ -322,38 +301,6 @@ pre-existing contents." (hash-clear! (get-state-hash-table state))) -(define (merge-rule-ltp attr a b) b) - -(define (merge-rule-htp attr a b) - (if (intensity? attr) - - ;; HTP only for intensity attributes - (lambda (time) - (max (value->number a time) - (value->number b time))) - - ;; LTP for all non-intensity attributes - b)) - -(define (merge-states-htp list-of-states) - (merge-states merge-rule-htp - list-of-states)) - -(define (merge-states-ltp list-of-states) - (merge-states merge-rule-ltp - list-of-states)) - -;; Combine states -(define (merge-states merge-rule list-of-states) - (let ((combined-state (make <starlet-state>))) - (for-each (lambda (state) - (add-state-to-state! merge-rule - state - combined-state)) - list-of-states) - combined-state)) - - ;; Scanout (define (bytevec->string bv) (string-join @@ -423,7 +370,7 @@ pre-existing contents." ;; Helper function to get a value for this ;; fixture in the current state (define (get-attr attr-name) - (current-value fix attr-name)) + (current-value fix attr-name (hirestime))) ;; Helper function to set 8-bit DMX value (define (set-chan relative-channel-number value) @@ -480,19 +427,38 @@ pre-existing contents." #:unwind? #f)))))) -(define (current-value fix attr-name) - (let ((combined-state (merge-states-ltp - (list - (merge-states-htp - (atomic-box-ref state-list)) - programmer-state)))) - (let ((val (state-find fix attr-name combined-state))) - (if (eq? 'no-value val) - (get-attr-home-val fix attr-name) - (let ((rv (value->number val (hirestime)))) - (if (eq? 'no-value rv) - (get-attr-home-val fix attr-name) - rv)))))) +(define (state-has-fix-attr fix attr tnow state) + (let ((val (state-find fix attr state))) + (if (eq? 'no-value val) + #f + (not (eq? 'no-value (value->number val tnow)))))) + +(define (first-val fix attr tnow state-list) + (let ((first-state (find (lambda (state) + (state-has-fix-attr fix attr tnow state)) + state-list))) + (if first-state + (state-find fix attr first-state) + 'no-value))) + +(define (current-value fix attr-name tnow) + (if (intensity? attr-name) + + ;; HTP for intensity + (fold (lambda (state prev) + (let ((val (state-find fix attr-name state))) + (if (eq? 'no-value val) + prev + (let ((real-val (value->number val tnow))) + (max real-val prev))))) + 0.0 + (atomic-box-ref state-list)) + + ;; Priority order for everything else + (let ((val (first-val fix attr-name tnow (atomic-box-ref state-list)))) + (if (eq? 'no-value val) + (get-attr-home-val fix attr-name) + (value->number val tnow))))) (define-syntax attr-continuous diff --git a/guile/starlet/midi-control/faders.scm b/guile/starlet/midi-control/faders.scm index ae8162a..ab3ca38 100644 --- a/guile/starlet/midi-control/faders.scm +++ b/guile/starlet/midi-control/faders.scm @@ -44,7 +44,7 @@ (define (current-values fixture-list attr-name) (map (lambda (fix) - (current-value fix attr-name)) + (current-value fix attr-name (hirestime))) fixture-list)) |