summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2016-01-01 17:39:50 -0500
committerDavid Thompson <dthompson2@worcester.edu>2016-01-01 17:42:38 -0500
commit1c958fb668cb316245ab9f53833960c28fda0f59 (patch)
treedb36ec2dd0c2e94323c10635a55b5b18e1c1edfe
parent23d69fdb85481bfc915bb28ff4dafd4765ac90f8 (diff)
signal: Add hook API for side-effects.
* sly/signal.scm (<signal>)[hook]: New field. (signal-hook): New selector. (add-signal-hook, remove-signal-hook, clear-signal-hook!): New procedures. (%make-signal): Create hook for the signal. (signal-propagate!): Run hook.
-rw-r--r--sly/signal.scm36
1 files changed, 30 insertions, 6 deletions
diff --git a/sly/signal.scm b/sly/signal.scm
index e57e880..a35f042 100644
--- a/sly/signal.scm
+++ b/sly/signal.scm
@@ -33,6 +33,9 @@
define-signal
signal-let signal-let*
hook->signal
+ add-signal-hook!
+ remove-signal-hook!
+ clear-signal-hook!
signal-ref
signal-ref-maybe
signal-set!
@@ -66,12 +69,15 @@
;; programming. State mutation is hidden away and a functional,
;; declarative interface is exposed.
(define-record-type <signal>
- (%%make-signal value proc inputs outputs)
+ (%%make-signal value proc inputs outputs hook)
%signal?
(value %signal-ref %%signal-set!)
(proc signal-proc)
(inputs signal-inputs)
- (outputs signal-outputs))
+ (outputs signal-outputs)
+ ;; Hook for escaping the signal graph to perform side-effects like
+ ;; file I/O, playing sounds, etc.
+ (hook signal-hook))
(define-record-type <signal-box>
(make-signal-box signal)
@@ -92,7 +98,9 @@
(define (%make-signal init proc inputs)
"Create a new signal with initial value INIT."
- (let ((signal (%%make-signal init proc inputs (make-weak-key-hash-table))))
+ (let ((signal (%%make-signal init proc inputs
+ (make-weak-key-hash-table)
+ (make-hook 1))))
(for-each (cut signal-connect! signal <>) inputs)
signal))
@@ -105,6 +113,20 @@
procedure PROC, and a list of INPUTS."
(make-signal-box (%make-signal init proc inputs)))
+(define (add-signal-hook! signal proc)
+ "Add PROC, a procedure that accepts a single argument, to the hook
+associated with SIGNAL. When SIGNAL receives a new value, PROC will
+be applied with that value."
+ (add-hook! (signal-hook (signal-unbox signal)) proc))
+
+(define (remove-signal-hook! signal proc)
+ "Remove the procedure PROC from the hook associated with SIGNAL."
+ (remove-hook! (signal-hook (signal-unbox signal)) proc))
+
+(define (clear-signal-hook! signal)
+ "Remove all hooks associated with SIGNAL."
+ (reset-hook! (signal-hook (signal-unbox signal))))
+
(define (signal-connect! signal-out signal-box-in)
"Attach SIGNAL-OUT to SIGNAL-BOX-IN. When the signal within
SIGNAL-BOX-IN changes, the value will be propagated to SIGNAL-OUT."
@@ -123,9 +145,11 @@ Otherwise, return OBJECT."
(define (signal-propagate! signal)
"Notify all output signals about the current value of SIGNAL."
- (hash-for-each (lambda (output unused)
- ((signal-proc output) output (%signal-ref signal)))
- (signal-outputs signal)))
+ (let ((value (%signal-ref signal)))
+ (run-hook (signal-hook signal) value)
+ (hash-for-each (lambda (output unused)
+ ((signal-proc output) output value))
+ (signal-outputs signal))))
(define (%signal-set! signal value)
"Change the current value of SIGNAL to VALUE and propagate VALUE to