summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--2d/signals.scm208
1 files changed, 208 insertions, 0 deletions
diff --git a/2d/signals.scm b/2d/signals.scm
new file mode 100644
index 0000000..ac083a3
--- /dev/null
+++ b/2d/signals.scm
@@ -0,0 +1,208 @@
+;;; guile-2d
+;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Guile-2d is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-2d is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Simple functional reactive programming API.
+;;
+;;; Code:
+
+(define-module (2d signals)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:export (<signal>
+ signal?
+ make-signal
+ signal-ref
+ signal-transformer
+ signal-listeners
+ signal-connect!
+ signal-disconnect!
+ signal-clear!
+ signal-set!
+ signal-identity
+ signal-constant
+ signal-lift
+ signal-lift2
+ signal-merge
+ signal-combine
+ signal-count
+ signal-if
+ signal-and
+ signal-or))
+
+;;;
+;;; Signals
+;;;
+
+;; Signals are time-varying values. For example, a signal could
+;; represent the mouse position at the current point in time. The
+;; signals API provides an abstraction over regular event-based
+;; programming. State mutation is hidden away and a functional,
+;; declarative interface is exposed.
+(define-record-type <signal>
+ (%make-signal value transformer listeners)
+ signal?
+ (value signal-ref %signal-set!)
+ (transformer signal-transformer)
+ (listeners signal-listeners %set-signal-listeners!))
+
+(define* (make-signal transformer #:optional (init #f))
+ "Create a new signal with initial value INIT that uses the given
+TRANSFORMER procedure to process incoming values from another signal."
+ (%make-signal init transformer '()))
+
+(define (%signal-transform signal value)
+ "Call the transform procedure for SIGNAL with VALUE."
+ ((signal-transformer signal) value (signal-ref signal)))
+
+(define (signal-connect! signal listener)
+ "Attach LISTENER to SIGNAL. When the value of SIGNAL changes, the
+value will be propagated to LISTENER."
+ (%set-signal-listeners!
+ signal
+ (cons listener (signal-listeners signal)))
+ (signal-set! listener (signal-ref signal)))
+
+(define (signal-disconnect! signal listener)
+ "Detach LISTENER from SIGNAL."
+ (%set-signal-listeners!
+ signal
+ (delete listener (signal-listeners signal) eq?)))
+
+(define (signal-clear! signal)
+ "Detach all listeners from SIGNAL."
+ (%set-signal-listeners! signal '()))
+
+(define (signal-set! signal value)
+ "Modify SIGNAL to store VALUE and propagate VALUE to all listening
+signals."
+ (let ((value (%signal-transform signal value)))
+ (%signal-set! signal value)
+ (for-each (cut signal-set! <> value)
+ (signal-listeners signal))))
+
+;;;
+;;; Primitive signals
+;;;
+
+(define* (signal-identity #:optional (init #f))
+ "Create a new signal with initial value INIT whose transformer procedure
+returns the given value unchanged."
+ (make-signal (lambda (value old-value) value) init))
+
+(define (signal-constant constant)
+ "Create a new signal with a value CONSTANT that cannot be changed."
+ (make-signal (lambda (value old-value signal) constant) constant))
+
+;; TODO: Write a macro for generating lifts
+(define (signal-lift transformer signal)
+ "Create a new signal that lifts the procedure TRANSFORMER of arity 1
+onto SIGNAL."
+ (let ((new-signal (make-signal (lambda (value old-value)
+ (transformer value)))))
+ (signal-connect! signal new-signal)
+ new-signal))
+
+(define (signal-lift2 transformer signal1 signal2)
+ "Create a new signal that lifts the procedure TRANSFORMER of arity 2
+onto SIGNAL1 and SIGNAL2."
+ (define (transform value old-value)
+ (transformer (signal-ref signal1)
+ (signal-ref signal2)))
+
+ (let ((new-signal (make-signal transform)))
+ (signal-connect! signal1 new-signal)
+ (signal-connect! signal2 new-signal)
+ new-signal))
+
+(define (signal-merge signal1 signal2)
+ "Create a new signal that merges SIGNAL1 and SIGNAL2 into one. The
+value of the new signal is the value of the most recently changed
+parent signal."
+ (let ((merged (signal-identity)))
+ (signal-connect! signal1 merged)
+ (signal-connect! signal2 merged)
+ merged))
+
+(define (signal-combine . signals)
+ "Create a new signal that combines the values of SIGNALS into a
+list."
+ (define (combiner value old-value)
+ (map signal-ref signals))
+
+ (let ((combined (make-signal combiner)))
+ (for-each (cut signal-connect! <> combined) signals)
+ combined))
+
+(define (signal-count signal)
+ "Create a new signal that increments a counter every time the value
+of SIGNAL changes."
+ (define (increment value old-value)
+ (1+ old-value))
+
+ (let ((counter (make-signal increment -1)))
+ (signal-connect! signal counter)
+ counter))
+
+(define (signal-if predicate consequent alternate)
+ "Create a new signal that emits the value of the signal CONSEQUENT
+when the value of the signal PREDICATE is true and the value of the
+signal ALTERNATE otherwise."
+ (define (transform value old-value)
+ (if (signal-ref predicate)
+ (signal-ref consequent)
+ (signal-ref alternate)))
+
+ (let ((signal (make-signal transform)))
+ (signal-connect! predicate signal)
+ (signal-connect! consequent signal)
+ (signal-connect! alternate signal)
+ signal))
+
+(define (signal-and . signals)
+ "Create a new signal that performs a logical AND operation on the
+values of SIGNALS."
+ (define (do-and signals prev)
+ (cond ((null? signals)
+ (signal-ref prev))
+ ((signal-ref (car signals))
+ (do-and (cdr signals) (car signals)))
+ (else
+ #f)))
+
+ (let ((signal (make-signal (lambda (value old-value)
+ (do-and signals #t)))))
+ (for-each (cut signal-connect! <> signal) signals)
+ signal))
+
+(define (signal-or . signals)
+ "Create a new signal that performs a logicla OR operation the values
+of SIGNALS."
+ (define (do-or signals)
+ (cond ((null? signals)
+ #f)
+ ((signal-ref (car signals))
+ (signal-ref (car signals)))
+ (else
+ (do-or (cdr signals)))))
+
+ (let ((signal (make-signal (lambda (value old-value)
+ (do-or signals)))))
+ (for-each (cut signal-connect! <> signal) signals)
+ signal))