From e5b4177487e7af28bd98056cb8bb985f8b02d6e7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 6 Nov 2007 15:51:50 -0600 Subject: [PATCH] Port alarms to the new modules system --- extra/alarms/alarms.factor | 87 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 extra/alarms/alarms.factor diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor new file mode 100644 index 0000000000..4842f8b7ae --- /dev/null +++ b/extra/alarms/alarms.factor @@ -0,0 +1,87 @@ +! Copyright (C) 2007 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays calendar combinators concurrency generic +init kernel math namespaces sequences threads ; +IN: alarms + +TUPLE: alarm time quot ; + +C: alarm + + 0 > ] curry* subset ; + +: unexpired-alarms ( -- seq ) + now alarms get-global + [ alarm-time <=> 0 <= ] curry* subset ; + +: call-alarm ( alarm -- ) + alarm-quot spawn drop ; + +: do-alarms ( -- ) + expired-alarms [ call-alarm ] each + unexpired-alarms alarms set-global ; + +: alarm-receive-loop ( -- ) + receive dup alarm? [ handle-alarm ] [ drop ] if + alarm-receive-loop ; + +: start-alarm-receiver ( -- ) + [ + alarm-receive-loop + ] spawn alarm-receiver set-global ; + +: alarm-loop ( -- ) + alarms get-global empty? [ + do-alarms + ] unless 100 sleep alarm-loop ; + +: start-alarm-looper ( -- ) + [ + alarm-loop + ] spawn alarm-looper set-global ; + +: send-alarm ( str alarm -- ) + over set-delegate + alarm-receiver get-global send ; + +: start-alarm-daemon ( -- ) + alarms get-global [ V{ } clone alarms set-global ] unless + start-alarm-looper + start-alarm-receiver ; + +[ start-alarm-daemon ] "alarms" add-init-hook +PRIVATE> + +: register-alarm ( alarm -- ) + "register" send-alarm ; + +: unregister-alarm ( alarm -- ) + "unregister" send-alarm ; + +: change-alarm ( alarm-old alarm-new -- ) + "register" send-alarm + "unregister" send-alarm ; + +! Example: +! 5 seconds from-now [ "hi" print flush ] register-alarm