diff options
| -rw-r--r-- | 2d/signal.scm | 40 | ||||
| -rw-r--r-- | 2d/time.scm | 54 |
2 files changed, 36 insertions, 58 deletions
diff --git a/2d/signal.scm b/2d/signal.scm index 272cbfb..53f676a 100644 --- a/2d/signal.scm +++ b/2d/signal.scm @@ -25,15 +25,13 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (2d agenda) #:export (signal? signal-box? make-signal - make-boxed-signal define-signal - %signal-ref signal-ref signal-ref-maybe - %signal-set! signal-set! signal-proc signal-merge @@ -44,7 +42,10 @@ signal-reject signal-constant signal-count - signal-do)) + signal-do + signal-sample + signal-delay + signal-throttle)) ;;; ;;; Signals @@ -227,3 +228,34 @@ from SIGNAL. The value of the new signal will always be the value of SIGNAL. This signal is a convenient way to sneak a procedure that has a side-effect into a signal chain." (signal-map (lambda (x) (proc x) x) signal)) + +(define (signal-sample agenda delay signal) + "Create a new signal that emits the value contained within SIGNAL +every DELAY ticks of AGENDA." + (let ((sampler (%make-signal (signal-ref signal) #f '()))) + (define (tick) + (%signal-set! sampler (signal-ref signal))) + (schedule-interval agenda tick delay) + (make-signal-box sampler))) + +(define (signal-delay agenda delay signal) + "Create a new signal that delays propagation of SIGNAL by DELAY +ticks of AGENDA." + (make-boxed-signal (signal-ref signal) + (lambda (self value) + (schedule agenda + (lambda () + (%signal-set! self value)) + delay)) + (list signal))) + +(define (signal-throttle agenda delay signal) + "Return a new signal that propagates SIGNAL at most once every DELAY +ticks of AGENDA." + (make-boxed-signal (signal-ref signal) + (let ((last-time (agenda-time agenda))) + (lambda (self value) + (when (>= (- (agenda-time agenda) last-time) delay) + (%signal-set! self value) + (set! last-time (agenda-time agenda))))) + (list signal))) diff --git a/2d/time.scm b/2d/time.scm deleted file mode 100644 index e17be49..0000000 --- a/2d/time.scm +++ /dev/null @@ -1,54 +0,0 @@ -;;; 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: -;; -;; Time-based signals. -;; -;;; Code: - -(define-module (2d time) - #:use-module (2d agenda) - #:use-module (2d coroutine) - #:use-module (2d signals) - #:export (time-every - time-each - time-delay)) - -(define (time-every agenda delay value) - "Create a new signal that emits VALUE every DELAY ticks of AGENDA. -VALUE may be a signal, in which case the stored value of the signal -will be emitted." - (let ((ticker (make-root-signal (signal-ref-maybe value)))) - (define (tick) - (signal-set! ticker (signal-ref-maybe value))) - (schedule-interval agenda tick delay) - ticker)) - -(define (time-each agenda value) - "Create a new signal that emits VALUE every agenda update." - (time-every agenda 1 value)) - -(define (time-delay agenda delay signal) - "Create a new signal that delays propagation of values received from -SIGNAL by DELAY ticks of AGENDA." - (make-signal (signal-ref signal) - (colambda (self from) - (let ((value (signal-ref from))) - (wait agenda delay) - (signal-set! self value))) - (list signal))) |