From e1da63276dc159532c0e5258f69a5365568f598f Mon Sep 17 00:00:00 2001 From: Hans-Christoph Steiner Date: Thu, 15 Dec 2005 07:43:25 +0000 Subject: This commit was generated by cvs2svn to compensate for changes in r4219, which included commits to RCS files with non-trunk default branches. svn path=/trunk/externals/pdp/; revision=4220 --- guile/pdp_guile.scm | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 guile/pdp_guile.scm (limited to 'guile/pdp_guile.scm') diff --git a/guile/pdp_guile.scm b/guile/pdp_guile.scm new file mode 100644 index 0000000..8ca17f2 --- /dev/null +++ b/guile/pdp_guile.scm @@ -0,0 +1,37 @@ +; pdp_guile.scm - a simple event dispatcher to be used with pdp_guile + +; some global variables +(define input-hash (make-hash-table 31)) +(define input-loop-flag #t) +(define input-loop-interval-ms 10) + +; add an input handler +(define (add-input! tag handler) + (hashq-create-handle! input-hash tag handler)) + +; the main input dispatcher loop +(define (input-loop) + (while input-loop-flag + (usleep (* input-loop-interval-ms 1000)) + (let nextmsg ((msg (in))) + (if msg + (begin + (let ((fn (hashq-ref input-hash (car msg)))) + (if fn (fn (cadr msg)))) + (nextmsg (in))))))) + +(define (start) + (set! input-loop-flag #t) + (out 'start 'bang) + (input-loop)) + + +; the control message handler +(add-input! 'control + (lambda (thing) + (case thing + ('stop (set! input-loop-flag #f)) ; stop the input loop and return to interpreter + ('gc (gc))))) ; call the garbage collector + + + -- cgit v1.2.1