diff options
| -rw-r--r-- | guile/starlet/engine.scm | 40 | ||||
| -rw-r--r-- | guile/starlet/state.scm | 7 |
2 files changed, 28 insertions, 19 deletions
diff --git a/guile/starlet/engine.scm b/guile/starlet/engine.scm index 6c43cf1..ca6f1cf 100644 --- a/guile/starlet/engine.scm +++ b/guile/starlet/engine.scm @@ -181,25 +181,27 @@ ;; Combine all the active attributes and send it out (atomic-box-swap! current-values - (let ((states (atomic-box-ref state-list))) - (for-each update-state! states) - (fold - (lambda (incoming-state combined-state) - (state-for-each - (lambda (fix attr val) - (let ((incoming-val (value->number val)) - (current-val (state-find fix attr combined-state))) - (unless (eq? incoming-val 'no-value) - (if (eq? current-val 'no-value) - (set-in-state! combined-state fix attr incoming-val) - (set-in-state! combined-state fix attr - (if (htp-attr? attr) - (max incoming-val current-val) - incoming-val)))))) - incoming-state) - combined-state) - (make-empty-state) - (append states (list programmer-state))))) + (combine-states + (let ((states (atomic-box-ref state-list))) + (for-each update-state! states) + (fold + (lambda (incoming-state combined-state) + (state-for-each + (lambda (fix attr val) + (let ((incoming-val (value->number val)) + (current-val (state-find fix attr combined-state))) + (unless (eq? incoming-val 'no-value) + (if (eq? current-val 'no-value) + (set-in-state! combined-state fix attr incoming-val) + (set-in-state! combined-state fix attr + (if (htp-attr? attr) + (max incoming-val current-val) + incoming-val)))))) + incoming-state) + combined-state) + (make-empty-state) + states)) + programmer-state)) (usleep 10000) diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm index dbc7e38..5844b3f 100644 --- a/guile/starlet/state.scm +++ b/guile/starlet/state.scm @@ -47,6 +47,7 @@ current-state at apply-state + combine-states show-state lighting-state programmer-state @@ -329,6 +330,12 @@ pre-existing contents." (current-state))))) +(define (combine-states a b) + (lighting-state + (apply-state a) + (apply-state b))) + + (define (print-state a) (pretty-print (state-source a))) |