diff options
| -rw-r--r-- | 2d/signals.scm | 208 |
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)) |