Rename alarms -> timers
Doug Coleman
parent
6d63be4168
commit
a6f0abb9a2
|
|
@ -1,74 +0,0 @@
|
|||
USING: help.markup help.syntax calendar quotations system ;
|
||||
IN: alarms
|
||||
|
||||
HELP: alarm
|
||||
{ $class-description "An alarm. Can be passed to " { $link stop-alarm } "." } ;
|
||||
|
||||
HELP: start-alarm
|
||||
{ $values { "alarm" alarm } }
|
||||
{ $description "Starts an alarm." } ;
|
||||
|
||||
HELP: restart-alarm
|
||||
{ $values { "alarm" alarm } }
|
||||
{ $description "Starts or restarts an alarm. Restarting an alarm causes the a sleep of initial delay nanoseconds before looping. An alarm's parameters may be modified and restarted with this word." } ;
|
||||
|
||||
HELP: stop-alarm
|
||||
{ $values { "alarm" alarm } }
|
||||
{ $description "Prevents an alarm from calling its quotation again. Has no effect on alarms that are not currently running." } ;
|
||||
|
||||
HELP: every
|
||||
{ $values
|
||||
{ "quot" quotation } { "interval-duration" duration }
|
||||
{ "alarm" alarm } }
|
||||
{ $description "Creates an alarm that calls the quotation repeatedly, using " { $snippet "duration" } " as the frequency. The first call of " { $snippet "quot" } " will happen immediately. If the quotation throws an exception, the alarm will stop." }
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
"USING: alarms io calendar ;"
|
||||
"""[ "Hi Buddy." print flush ] 10 seconds every drop"""
|
||||
""
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: later
|
||||
{ $values { "quot" quotation } { "delay-duration" duration } { "alarm" alarm } }
|
||||
{ $description "Sleeps for " { $snippet "duration" } " and then calls a " { $snippet "quot" } ". The user may cancel the alarm before " { $snippet "quot" } " runs. This alarm is not repeated." }
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
"USING: alarms io calendar ;"
|
||||
"""[ "Break's over!" print flush ] 15 minutes later drop"""
|
||||
""
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: delayed-every
|
||||
{ $values
|
||||
{ "quot" quotation } { "duration" duration }
|
||||
{ "alarm" alarm } }
|
||||
{ $description "Creates an alarm that calls " { $snippet "quot" } " repeatedly, waiting " { $snippet "duration" } " before calling " { $snippet "quot" } " the first time and then waiting " { $snippet "duration" } " between further calls. If the quotation throws an exception, the alarm will stop." }
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
"USING: alarms io calendar ;"
|
||||
"""[ "Hi Buddy." print flush ] 10 seconds every drop"""
|
||||
""
|
||||
}
|
||||
} ;
|
||||
|
||||
ARTICLE: "alarms" "Alarms"
|
||||
"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks. Alarms run in a single green thread per alarm and consist of a quotation, a delay duration, and an interval duration. After starting an alarm, the alarm thread sleeps for the delay duration and calls the quotation. Then it waits out the interval duration and calls the quotation again until something stops the alarm. If a recurring alarm's quotation would be scheduled to run again before the previous quotation has finished processing, the alarm will be run again immediately afterwards. This may result in the alarm falling behind indefinitely, in which case the it will run as often as possible while still allowing other green threads to run. Recurring alarms that execute 'on time' or 'catch up' will always be scheduled for an exact multiple of the interval from the original starting time to prevent the alarm from drifting over time. Alarms use " { $link nano-count } " as the timing primitive, so they will continue to work across system clock changes." $nl
|
||||
"The alarm class:"
|
||||
{ $subsections alarm }
|
||||
"Create an alarm before starting it:"
|
||||
{ $subsections <alarm> }
|
||||
"Starting an alarm:"
|
||||
{ $subsections start-alarm restart-alarm }
|
||||
"Stopping an alarm:"
|
||||
{ $subsections stop-alarm }
|
||||
|
||||
"A recurring alarm without an initial delay:"
|
||||
{ $subsections every }
|
||||
"A one-time alarm with an initial delay:"
|
||||
{ $subsections later }
|
||||
"A recurring alarm with an initial delay:"
|
||||
{ $subsections delayed-every } ;
|
||||
|
||||
ABOUT: "alarms"
|
||||
|
|
@ -1,119 +1,5 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
|
||||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs calendar combinators.short-circuit fry
|
||||
heaps init kernel math math.functions math.parser namespaces
|
||||
quotations sequences system threads ;
|
||||
USING: ;
|
||||
IN: alarms
|
||||
|
||||
TUPLE: alarm
|
||||
{ quot callable initial: [ ] }
|
||||
start-nanos
|
||||
delay-nanos
|
||||
interval-nanos
|
||||
iteration-start-nanos
|
||||
quotation-running?
|
||||
restart?
|
||||
thread ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: >nanoseconds ( obj -- duration/f )
|
||||
M: f >nanoseconds ;
|
||||
M: real >nanoseconds >integer ;
|
||||
M: duration >nanoseconds duration>nanoseconds >integer ;
|
||||
|
||||
: set-next-alarm-time ( alarm -- alarm )
|
||||
! start + delay + ceiling((now - (start + delay)) / interval) * interval
|
||||
nano-count
|
||||
over start-nanos>> -
|
||||
over delay-nanos>> [ - ] when*
|
||||
over interval-nanos>> / ceiling
|
||||
over interval-nanos>> *
|
||||
over start-nanos>> +
|
||||
over delay-nanos>> [ + ] when*
|
||||
>>iteration-start-nanos ;
|
||||
|
||||
: stop-alarm? ( alarm -- ? )
|
||||
{ [ thread>> self eq? not ] [ restart?>> ] } 1|| ;
|
||||
|
||||
DEFER: call-alarm-loop
|
||||
|
||||
: loop-alarm ( alarm -- )
|
||||
nano-count over
|
||||
[ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
|
||||
[ set-next-alarm-time ] dip
|
||||
[ dup iteration-start-nanos>> ] [ 0 ] if
|
||||
0 or sleep-until call-alarm-loop ;
|
||||
|
||||
: maybe-loop-alarm ( alarm -- )
|
||||
dup { [ stop-alarm? ] [ interval-nanos>> not ] } 1||
|
||||
[ drop ] [ loop-alarm ] if ;
|
||||
|
||||
: call-alarm-loop ( alarm -- )
|
||||
dup stop-alarm? [
|
||||
drop
|
||||
] [
|
||||
[
|
||||
[ t >>quotation-running? drop ]
|
||||
[ quot>> call( -- ) ]
|
||||
[ f >>quotation-running? drop ] tri
|
||||
] keep
|
||||
maybe-loop-alarm
|
||||
] if ;
|
||||
|
||||
: sleep-delay ( alarm -- )
|
||||
dup stop-alarm? [
|
||||
drop
|
||||
] [
|
||||
nano-count >>start-nanos
|
||||
delay-nanos>> [ sleep ] when*
|
||||
] if ;
|
||||
|
||||
: alarm-loop ( alarm -- )
|
||||
[ sleep-delay ]
|
||||
[ nano-count >>iteration-start-nanos call-alarm-loop ]
|
||||
[ dup restart?>> [ f >>restart? alarm-loop ] [ drop ] if ] tri ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: <alarm> ( quot delay-duration/f interval-duration/f -- alarm )
|
||||
alarm new
|
||||
swap >nanoseconds >>interval-nanos
|
||||
swap >nanoseconds >>delay-nanos
|
||||
swap >>quot ; inline
|
||||
|
||||
: start-alarm ( alarm -- )
|
||||
[
|
||||
'[ _ alarm-loop ] "Alarm execution" spawn
|
||||
] keep thread<< ;
|
||||
|
||||
: stop-alarm ( alarm -- )
|
||||
dup quotation-running?>> [
|
||||
f >>thread drop
|
||||
] [
|
||||
[ [ interrupt ] when* f ] change-thread drop
|
||||
] if ;
|
||||
|
||||
: restart-alarm ( alarm -- )
|
||||
t >>restart?
|
||||
dup quotation-running?>> [
|
||||
drop
|
||||
] [
|
||||
dup thread>> [ nip interrupt ] [ start-alarm ] if*
|
||||
] if ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (start-alarm) ( quot start-duration interval-duration -- alarm )
|
||||
<alarm> [ start-alarm ] keep ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: every ( quot interval-duration -- alarm )
|
||||
[ f ] dip (start-alarm) ;
|
||||
|
||||
: later ( quot delay-duration -- alarm )
|
||||
f (start-alarm) ;
|
||||
|
||||
: delayed-every ( quot duration -- alarm )
|
||||
dup (start-alarm) ;
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
One-time and recurring events
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: deques threads kernel arrays sequences alarms fry ;
|
||||
USING: deques threads kernel arrays sequences timers fry ;
|
||||
IN: concurrency.conditions
|
||||
|
||||
: notify-1 ( deque -- )
|
||||
|
|
@ -9,8 +9,8 @@ IN: concurrency.conditions
|
|||
: notify-all ( deque -- )
|
||||
[ resume-now ] slurp-deque ; inline
|
||||
|
||||
: queue-timeout ( queue timeout -- alarm )
|
||||
#! Add an alarm which removes the current thread from the
|
||||
: queue-timeout ( queue timeout -- timer )
|
||||
#! Add an timer which removes the current thread from the
|
||||
#! queue, and resumes it, passing it a value of t.
|
||||
[
|
||||
[ self swap push-front* ] keep '[
|
||||
|
|
@ -28,7 +28,7 @@ ERROR: wait-timeout ;
|
|||
: wait ( queue timeout status -- )
|
||||
over [
|
||||
[ queue-timeout ] dip suspend
|
||||
[ wait-timeout ] [ stop-alarm ] if
|
||||
[ wait-timeout ] [ stop-timer ] if
|
||||
] [
|
||||
[ drop queue ] dip suspend drop
|
||||
] if ; inline
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences db.tuples alarms calendar db fry
|
||||
USING: kernel sequences db.tuples timers calendar db fry
|
||||
furnace.db
|
||||
furnace.cache
|
||||
furnace.asides
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: assocs kernel math.intervals math.parser namespaces
|
||||
strings random accessors quotations hashtables sequences
|
||||
continuations fry calendar combinators combinators.short-circuit
|
||||
destructors alarms io.sockets db db.tuples db.types
|
||||
destructors io.sockets db db.tuples db.types
|
||||
http http.server http.server.dispatchers http.server.filters
|
||||
furnace.cache furnace.scopes furnace.utilities ;
|
||||
IN: furnace.sessions
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov, Doug Coleman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel calendar alarms io io.encodings accessors
|
||||
USING: kernel calendar timers io io.encodings accessors
|
||||
namespaces fry io.streams.null ;
|
||||
IN: io.timeouts
|
||||
|
||||
|
|
@ -13,11 +13,11 @@ M: encoder set-timeout stream>> set-timeout ;
|
|||
|
||||
GENERIC: cancel-operation ( obj -- )
|
||||
|
||||
: queue-timeout ( obj timeout -- alarm )
|
||||
: queue-timeout ( obj timeout -- timer )
|
||||
[ '[ _ cancel-operation ] ] dip later ;
|
||||
|
||||
: with-timeout* ( obj timeout quot -- )
|
||||
3dup drop queue-timeout [ nip call ] dip stop-alarm ;
|
||||
3dup drop queue-timeout [ nip call ] dip stop-timer ;
|
||||
inline
|
||||
|
||||
: with-timeout ( obj quot -- )
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: logging.analysis logging.server logging smtp kernel
|
||||
io.files io.streams.string namespaces make alarms assocs
|
||||
io.files io.streams.string namespaces make timers assocs
|
||||
io.encodings.utf8 accessors calendar sequences ;
|
||||
QUALIFIED: io.sockets
|
||||
IN: logging.insomniac
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alarms fry kernel models ;
|
||||
USING: accessors timers fry kernel models ;
|
||||
IN: models.delay
|
||||
|
||||
TUPLE: delay < model model timeout alarm ;
|
||||
TUPLE: delay < model model timeout timer ;
|
||||
|
||||
: update-delay-model ( delay -- )
|
||||
[ model>> value>> ] keep set-model ;
|
||||
|
|
@ -15,13 +15,13 @@ TUPLE: delay < model model timeout alarm ;
|
|||
[ add-dependency ] keep ;
|
||||
|
||||
: stop-delay ( delay -- )
|
||||
alarm>> [ stop-alarm ] when* ;
|
||||
timer>> [ stop-timer ] when* ;
|
||||
|
||||
: start-delay ( delay -- )
|
||||
dup
|
||||
[ '[ _ f >>alarm update-delay-model ] ] [ timeout>> ] bi
|
||||
[ '[ _ f >>timer update-delay-model ] ] [ timeout>> ] bi
|
||||
later
|
||||
>>alarm drop ;
|
||||
>>timer drop ;
|
||||
|
||||
M: delay model-changed nip dup stop-delay start-delay ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
One-time and recurring timers for relative time offsets
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
USING: help.markup help.syntax calendar quotations system ;
|
||||
IN: timers
|
||||
|
||||
HELP: timer
|
||||
{ $class-description "A timer. Can be passed to " { $link stop-timer } "." } ;
|
||||
|
||||
HELP: start-timer
|
||||
{ $values { "timer" timer } }
|
||||
{ $description "Starts a timer." } ;
|
||||
|
||||
HELP: restart-timer
|
||||
{ $values { "timer" timer } }
|
||||
{ $description "Starts or restarts a timer. Restarting a timer causes the a sleep of initial delay nanoseconds before looping. An timer's parameters may be modified and restarted with this word." } ;
|
||||
|
||||
HELP: stop-timer
|
||||
{ $values { "timer" timer } }
|
||||
{ $description "Prevents a timer from calling its quotation again. Has no effect on timers that are not currently running." } ;
|
||||
|
||||
HELP: every
|
||||
{ $values
|
||||
{ "quot" quotation } { "interval-duration" duration }
|
||||
{ "timer" timer } }
|
||||
{ $description "Creates a timer that calls the quotation repeatedly, using " { $snippet "duration" } " as the frequency. The first call of " { $snippet "quot" } " will happen immediately. If the quotation throws an exception, the timer will stop." }
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
"USING: timers io calendar ;"
|
||||
"""[ "Hi Buddy." print flush ] 10 seconds every drop"""
|
||||
""
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: later
|
||||
{ $values { "quot" quotation } { "delay-duration" duration } { "timer" timer } }
|
||||
{ $description "Sleeps for " { $snippet "duration" } " and then calls a " { $snippet "quot" } ". The user may cancel the timer before " { $snippet "quot" } " runs. This timer is not repeated." }
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
"USING: timers io calendar ;"
|
||||
"""[ "Break's over!" print flush ] 15 minutes later drop"""
|
||||
""
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: delayed-every
|
||||
{ $values
|
||||
{ "quot" quotation } { "duration" duration }
|
||||
{ "timer" timer } }
|
||||
{ $description "Creates a timer that calls " { $snippet "quot" } " repeatedly, waiting " { $snippet "duration" } " before calling " { $snippet "quot" } " the first time and then waiting " { $snippet "duration" } " between further calls. If the quotation throws an exception, the timer will stop." }
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
"USING: timers io calendar ;"
|
||||
"""[ "Hi Buddy." print flush ] 10 seconds every drop"""
|
||||
""
|
||||
}
|
||||
} ;
|
||||
|
||||
ARTICLE: "timers" "Alarms"
|
||||
"The " { $vocab-link "timers" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks. Alarms run in a single green thread per timer and consist of a quotation, a delay duration, and an interval duration. After starting a timer, the timer thread sleeps for the delay duration and calls the quotation. Then it waits out the interval duration and calls the quotation again until something stops the timer. If a recurring timer's quotation would be scheduled to run again before the previous quotation has finished processing, the timer will be run again immediately afterwards. This may result in the timer falling behind indefinitely, in which case the it will run as often as possible while still allowing other green threads to run. Recurring timers that execute 'on time' or 'catch up' will always be scheduled for an exact multiple of the interval from the original starting time to prevent the timer from drifting over time. Alarms use " { $link nano-count } " as the timing primitive, so they will continue to work across system clock changes." $nl
|
||||
"The timer class:"
|
||||
{ $subsections timer }
|
||||
"Create a timer before starting it:"
|
||||
{ $subsections <timer> }
|
||||
"Starting a timer:"
|
||||
{ $subsections start-timer restart-timer }
|
||||
"Stopping a timer:"
|
||||
{ $subsections stop-timer }
|
||||
|
||||
"A recurring timer without an initial delay:"
|
||||
{ $subsections every }
|
||||
"A one-time timer with an initial delay:"
|
||||
{ $subsections later }
|
||||
"A recurring timer with an initial delay:"
|
||||
{ $subsections delayed-every } ;
|
||||
|
||||
ABOUT: "timers"
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
USING: alarms alarms.private calendar concurrency.count-downs
|
||||
USING: timers timers.private calendar concurrency.count-downs
|
||||
concurrency.promises fry kernel math math.order sequences
|
||||
threads tools.test tools.time ;
|
||||
IN: alarms.tests
|
||||
IN: timers.tests
|
||||
|
||||
[ ] [
|
||||
1 <count-down>
|
||||
{ f } clone 2dup
|
||||
[ first stop-alarm count-down ] 2curry 1 seconds later
|
||||
[ first stop-timer count-down ] 2curry 1 seconds later
|
||||
swap set-first
|
||||
await
|
||||
] unit-test
|
||||
|
|
@ -28,20 +28,20 @@ IN: alarms.tests
|
|||
{ 3 } dup
|
||||
'[ 4 _ set-first ] 2 seconds later
|
||||
1/2 seconds sleep
|
||||
stop-alarm
|
||||
stop-timer
|
||||
] unit-test
|
||||
|
||||
[ { 1 } ] [
|
||||
{ 0 }
|
||||
dup '[ 0 _ [ 1 + ] change-nth ] 3 seconds later
|
||||
[ stop-alarm ] [ start-alarm ] bi
|
||||
[ stop-timer ] [ start-timer ] bi
|
||||
4 seconds sleep
|
||||
] unit-test
|
||||
|
||||
[ { 0 } ] [
|
||||
{ 0 }
|
||||
dup '[ 3 seconds sleep 1 _ set-first ] 1 seconds later
|
||||
2 seconds sleep stop-alarm
|
||||
2 seconds sleep stop-timer
|
||||
1/2 seconds sleep
|
||||
] unit-test
|
||||
|
||||
|
|
@ -49,19 +49,19 @@ IN: alarms.tests
|
|||
{ 0 }
|
||||
dup '[ 1 _ set-first ] 300 milliseconds later
|
||||
150 milliseconds sleep
|
||||
[ restart-alarm ] [ 200 milliseconds sleep stop-alarm ] bi
|
||||
[ restart-timer ] [ 200 milliseconds sleep stop-timer ] bi
|
||||
] unit-test
|
||||
|
||||
[ { 1 } ] [
|
||||
{ 0 }
|
||||
dup '[ 0 _ [ 1 + ] change-nth ] 200 milliseconds later
|
||||
100 milliseconds sleep restart-alarm 300 milliseconds sleep
|
||||
100 milliseconds sleep restart-timer 300 milliseconds sleep
|
||||
] unit-test
|
||||
|
||||
[ { 4 } ] [
|
||||
{ 0 }
|
||||
dup '[ 0 _ [ 1 + ] change-nth ] 300 milliseconds 300 milliseconds
|
||||
<alarm> dup start-alarm
|
||||
700 milliseconds sleep dup restart-alarm
|
||||
700 milliseconds sleep stop-alarm 500 milliseconds sleep
|
||||
<timer> dup start-timer
|
||||
700 milliseconds sleep dup restart-timer
|
||||
700 milliseconds sleep stop-timer 500 milliseconds sleep
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,119 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs calendar combinators.short-circuit fry
|
||||
heaps init kernel math math.functions math.parser namespaces
|
||||
quotations sequences system threads ;
|
||||
IN: timers
|
||||
|
||||
TUPLE: timer
|
||||
{ quot callable initial: [ ] }
|
||||
start-nanos
|
||||
delay-nanos
|
||||
interval-nanos
|
||||
iteration-start-nanos
|
||||
quotation-running?
|
||||
restart?
|
||||
thread ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: >nanoseconds ( obj -- duration/f )
|
||||
M: f >nanoseconds ;
|
||||
M: real >nanoseconds >integer ;
|
||||
M: duration >nanoseconds duration>nanoseconds >integer ;
|
||||
|
||||
: set-next-timer-time ( timer -- timer )
|
||||
! start + delay + ceiling((now - (start + delay)) / interval) * interval
|
||||
nano-count
|
||||
over start-nanos>> -
|
||||
over delay-nanos>> [ - ] when*
|
||||
over interval-nanos>> / ceiling
|
||||
over interval-nanos>> *
|
||||
over start-nanos>> +
|
||||
over delay-nanos>> [ + ] when*
|
||||
>>iteration-start-nanos ;
|
||||
|
||||
: stop-timer? ( timer -- ? )
|
||||
{ [ thread>> self eq? not ] [ restart?>> ] } 1|| ;
|
||||
|
||||
DEFER: call-timer-loop
|
||||
|
||||
: loop-timer ( timer -- )
|
||||
nano-count over
|
||||
[ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
|
||||
[ set-next-timer-time ] dip
|
||||
[ dup iteration-start-nanos>> ] [ 0 ] if
|
||||
0 or sleep-until call-timer-loop ;
|
||||
|
||||
: maybe-loop-timer ( timer -- )
|
||||
dup { [ stop-timer? ] [ interval-nanos>> not ] } 1||
|
||||
[ drop ] [ loop-timer ] if ;
|
||||
|
||||
: call-timer-loop ( timer -- )
|
||||
dup stop-timer? [
|
||||
drop
|
||||
] [
|
||||
[
|
||||
[ t >>quotation-running? drop ]
|
||||
[ quot>> call( -- ) ]
|
||||
[ f >>quotation-running? drop ] tri
|
||||
] keep
|
||||
maybe-loop-timer
|
||||
] if ;
|
||||
|
||||
: sleep-delay ( timer -- )
|
||||
dup stop-timer? [
|
||||
drop
|
||||
] [
|
||||
nano-count >>start-nanos
|
||||
delay-nanos>> [ sleep ] when*
|
||||
] if ;
|
||||
|
||||
: timer-loop ( timer -- )
|
||||
[ sleep-delay ]
|
||||
[ nano-count >>iteration-start-nanos call-timer-loop ]
|
||||
[ dup restart?>> [ f >>restart? timer-loop ] [ drop ] if ] tri ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: <timer> ( quot delay-duration/f interval-duration/f -- timer )
|
||||
timer new
|
||||
swap >nanoseconds >>interval-nanos
|
||||
swap >nanoseconds >>delay-nanos
|
||||
swap >>quot ; inline
|
||||
|
||||
: start-timer ( timer -- )
|
||||
[
|
||||
'[ _ timer-loop ] "Alarm execution" spawn
|
||||
] keep thread<< ;
|
||||
|
||||
: stop-timer ( timer -- )
|
||||
dup quotation-running?>> [
|
||||
f >>thread drop
|
||||
] [
|
||||
[ [ interrupt ] when* f ] change-thread drop
|
||||
] if ;
|
||||
|
||||
: restart-timer ( timer -- )
|
||||
t >>restart?
|
||||
dup quotation-running?>> [
|
||||
drop
|
||||
] [
|
||||
dup thread>> [ nip interrupt ] [ start-timer ] if*
|
||||
] if ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (start-timer) ( quot start-duration interval-duration -- timer )
|
||||
<timer> [ start-timer ] keep ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: every ( quot interval-duration -- timer )
|
||||
[ f ] dip (start-timer) ;
|
||||
|
||||
: later ( quot delay-duration -- timer )
|
||||
f (start-timer) ;
|
||||
|
||||
: delayed-every ( quot duration -- timer )
|
||||
dup (start-timer) ;
|
||||
|
|
@ -64,7 +64,7 @@ $nl
|
|||
HELP: deploy-threads?
|
||||
{ $description "Deploy flag. If set, thread support will be included in the final image."
|
||||
$nl
|
||||
"On by default. Most programs depend on libraries which use threads even if they don't use threads directly; for example, alarms, non-blocking I/O, and the UI are built on top of threads. If after testing your program still works without threads, you can disable this feature to save some space." } ;
|
||||
"On by default. Most programs depend on libraries which use threads even if they don't use threads directly; for example, timers, non-blocking I/O, and the UI are built on top of threads. If after testing your program still works without threads, you can disable this feature to save some space." } ;
|
||||
|
||||
HELP: deploy-ui?
|
||||
{ $description "Deploy flag. If set, the Factor UI will be included in the deployed image."
|
||||
|
|
|
|||
|
|
@ -317,7 +317,7 @@ IN: tools.deploy.shaker
|
|||
strip-io? [ io-backend , ] when
|
||||
|
||||
{ } {
|
||||
"alarms"
|
||||
"timers"
|
||||
"tools"
|
||||
"io.launcher"
|
||||
"random"
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ io.encodings.utf8 hashtables kernel namespaces sequences
|
|||
vocabs.loader vocabs.metadata io combinators calendar accessors
|
||||
math.parser io.streams.string ui.tools.operations quotations
|
||||
strings arrays prettyprint words vocabs sorting sets classes
|
||||
math alien urls splitting ascii combinators.short-circuit alarms
|
||||
math alien urls splitting ascii combinators.short-circuit timers
|
||||
words.symbol system summary ;
|
||||
IN: tools.scaffold
|
||||
|
||||
|
|
@ -128,7 +128,7 @@ M: bad-developer-name summary
|
|||
{ "ch" "a character" }
|
||||
{ "word" word }
|
||||
{ "array" array }
|
||||
{ "alarm" alarm }
|
||||
{ "timers" timer }
|
||||
{ "duration" duration }
|
||||
{ "path" "a pathname string" }
|
||||
{ "vocab" "a vocabulary specifier" }
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alarms arrays assocs calendar colors.constants
|
||||
USING: accessors timers arrays assocs calendar colors.constants
|
||||
combinators combinators.short-circuit documents
|
||||
documents.elements fry grouping kernel locals make math
|
||||
math.functions math.order math.ranges math.rectangles
|
||||
|
|
@ -15,7 +15,7 @@ IN: ui.gadgets.editors
|
|||
TUPLE: editor < line-gadget
|
||||
caret-color
|
||||
caret mark
|
||||
focused? blink blink-alarm ;
|
||||
focused? blink blink-timer ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -60,11 +60,11 @@ SYMBOL: blink-interval
|
|||
750 milliseconds blink-interval set-global
|
||||
|
||||
: stop-blinking ( editor -- )
|
||||
blink-alarm>> [ stop-alarm ] when* ;
|
||||
blink-timer>> [ stop-timer ] when* ;
|
||||
|
||||
: start-blinking ( editor -- )
|
||||
t >>blink
|
||||
blink-alarm>> [ restart-alarm ] when* ;
|
||||
blink-timer>> [ restart-timer ] when* ;
|
||||
|
||||
: restart-blinking ( editor -- )
|
||||
dup focused?>> [
|
||||
|
|
@ -80,12 +80,12 @@ M: editor graft*
|
|||
[ dup mark>> activate-editor-model ]
|
||||
[
|
||||
[
|
||||
'[ _ blink-caret ] blink-interval get dup <alarm>
|
||||
] keep blink-alarm<<
|
||||
'[ _ blink-caret ] blink-interval get dup <timer>
|
||||
] keep blink-timer<<
|
||||
] tri ;
|
||||
|
||||
M: editor ungraft*
|
||||
[ [ stop-blinking ] [ f >>blink-alarm drop ] bi ]
|
||||
[ [ stop-blinking ] [ f >>blink-timer drop ] bi ]
|
||||
[ dup caret>> deactivate-editor-model ]
|
||||
[ dup mark>> deactivate-editor-model ] tri ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs kernel math math.order models
|
||||
namespaces make sequences words strings system hashtables math.parser
|
||||
math.vectors classes.tuple classes boxes calendar alarms combinators
|
||||
math.vectors classes.tuple classes boxes calendar timers combinators
|
||||
sets columns fry deques ui.gadgets ui.gadgets.private ascii
|
||||
combinators.short-circuit ;
|
||||
FROM: namespaces => set ;
|
||||
|
|
@ -188,15 +188,15 @@ SYMBOL: drag-timer
|
|||
[ drag-gesture ]
|
||||
300 milliseconds
|
||||
100 milliseconds
|
||||
<alarm>
|
||||
<timer>
|
||||
[ drag-timer get-global >box ]
|
||||
[ start-alarm ] bi
|
||||
[ start-timer ] bi
|
||||
] when ;
|
||||
|
||||
: stop-drag-timer ( -- )
|
||||
hand-buttons get-global empty? [
|
||||
drag-timer get-global ?box
|
||||
[ stop-alarm ] [ drop ] if
|
||||
[ stop-timer ] [ drop ] if
|
||||
] when ;
|
||||
|
||||
: fire-motion ( -- )
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: accessors alien audio classes.struct fry calendar alarms
|
||||
USING: accessors alien audio classes.struct fry calendar timers
|
||||
combinators combinators.short-circuit destructors generalizations
|
||||
kernel literals locals math openal sequences
|
||||
sequences.generalizations specialized-arrays strings ;
|
||||
|
|
@ -70,7 +70,7 @@ TUPLE: audio-engine < disposable
|
|||
listener
|
||||
{ next-source integer }
|
||||
clips
|
||||
update-alarm ;
|
||||
update-timer ;
|
||||
|
||||
TUPLE: audio-clip < disposable
|
||||
{ audio-engine audio-engine }
|
||||
|
|
@ -226,20 +226,20 @@ DEFER: update-audio
|
|||
|
||||
: start-audio ( audio-engine -- )
|
||||
dup start-audio*
|
||||
dup '[ _ update-audio ] 20 milliseconds every >>update-alarm
|
||||
dup '[ _ update-audio ] 20 milliseconds every >>update-timer
|
||||
drop ;
|
||||
|
||||
: stop-audio ( audio-engine -- )
|
||||
dup al-sources>> [
|
||||
{
|
||||
[ make-engine-current ]
|
||||
[ update-alarm>> [ stop-alarm ] when* ]
|
||||
[ update-timer>> [ stop-timer ] when* ]
|
||||
[ clips>> clone [ dispose ] each ]
|
||||
[ al-sources>> free-sources ]
|
||||
[
|
||||
f >>al-sources
|
||||
f >>clips
|
||||
f >>update-alarm
|
||||
f >>update-timer
|
||||
drop
|
||||
]
|
||||
[ al-context>> alcSuspendContext ]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: accessors alarms audio audio.engine audio.loader calendar
|
||||
USING: accessors timers audio audio.engine audio.loader calendar
|
||||
destructors io kernel locals math math.functions math.ranges specialized-arrays
|
||||
sequences random math.vectors ;
|
||||
FROM: alien.c-types => short ;
|
||||
|
|
@ -41,10 +41,10 @@ M: noise-generator dispose
|
|||
] when
|
||||
|
||||
engine update-audio
|
||||
] 20 milliseconds every :> alarm
|
||||
] 20 milliseconds every :> timer
|
||||
"Press Enter to stop the test." print
|
||||
readln drop
|
||||
alarm stop-alarm
|
||||
timer stop-timer
|
||||
engine dispose ;
|
||||
|
||||
MAIN: audio-engine-test
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: ui ui.gadgets sequences kernel arrays math colors
|
||||
colors.constants ui.render ui.pens.polygon ui.pens.solid math.vectors
|
||||
accessors fry ui.gadgets.packs game.input ui.gadgets.labels
|
||||
ui.gadgets.borders alarms calendar locals strings ui.gadgets.buttons
|
||||
ui.gadgets.borders timers calendar locals strings ui.gadgets.buttons
|
||||
combinators math.parser assocs threads ;
|
||||
IN: game.input.demos.joysticks
|
||||
|
||||
|
|
@ -73,7 +73,7 @@ CONSTANT: pov-polygons
|
|||
COLOR: red <indicator-gadget> [ >>indicator ] [ add-gadget ] bi
|
||||
dup [ 0.0 0.0 0.0 move-axis ] [ f move-pov ] bi ;
|
||||
|
||||
TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
|
||||
TUPLE: joystick-demo-gadget < pack axis raxis controller buttons timer ;
|
||||
|
||||
: add-gadget-with-border ( parent child -- parent )
|
||||
{ 2 2 } <border> COLOR: gray <solid> >>boundary add-gadget ;
|
||||
|
|
@ -108,7 +108,7 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
|
|||
|
||||
: kill-update-axes ( gadget -- )
|
||||
COLOR: gray <solid> >>interior
|
||||
[ [ stop-alarm ] when* f ] change-alarm
|
||||
[ [ stop-timer ] when* f ] change-timer
|
||||
relayout-1 ;
|
||||
|
||||
: (update-axes) ( gadget controller-state -- )
|
||||
|
|
@ -125,11 +125,11 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
|
|||
[ (update-axes) ] [ kill-update-axes ] if* ;
|
||||
|
||||
M: joystick-demo-gadget graft*
|
||||
dup '[ _ update-axes ] FREQUENCY every >>alarm
|
||||
dup '[ _ update-axes ] FREQUENCY every >>timer
|
||||
drop ;
|
||||
|
||||
M: joystick-demo-gadget ungraft*
|
||||
alarm>> [ stop-alarm ] when* ;
|
||||
timer>> [ stop-timer ] when* ;
|
||||
|
||||
: joystick-window ( controller -- )
|
||||
[ <joystick-demo-gadget> ] [ product-string ] bi
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: game.input game.input.scancodes
|
||||
kernel ui.gadgets ui.gadgets.buttons sequences accessors
|
||||
words arrays assocs math calendar fry alarms ui
|
||||
words arrays assocs math calendar fry timers ui
|
||||
ui.gadgets.borders ui.gestures literals ;
|
||||
IN: game.input.demos.key-caps
|
||||
|
||||
|
|
@ -134,7 +134,7 @@ CONSTANT: key-locations H{
|
|||
CONSTANT: KEYBOARD-SIZE { 230 65 }
|
||||
CONSTANT: FREQUENCY $[ 1/30 seconds ]
|
||||
|
||||
TUPLE: key-caps-gadget < gadget keys alarm ;
|
||||
TUPLE: key-caps-gadget < gadget keys timer ;
|
||||
|
||||
: make-key-gadget ( scancode dim array -- )
|
||||
[
|
||||
|
|
@ -163,11 +163,11 @@ M: key-caps-gadget pref-dim* drop KEYBOARD-SIZE ;
|
|||
|
||||
M: key-caps-gadget graft*
|
||||
open-game-input
|
||||
dup '[ _ update-key-caps-state ] FREQUENCY every >>alarm
|
||||
dup '[ _ update-key-caps-state ] FREQUENCY every >>timer
|
||||
drop ;
|
||||
|
||||
M: key-caps-gadget ungraft*
|
||||
alarm>> [ stop-alarm ] when*
|
||||
timer>> [ stop-timer ] when*
|
||||
close-game-input ;
|
||||
|
||||
M: key-caps-gadget handle-gesture
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c)2009 Joe Groff bsd license
|
||||
USING: accessors alarms alien.c-types calendar classes.struct
|
||||
USING: accessors timers alien.c-types calendar classes.struct
|
||||
continuations destructors fry kernel math math.order memory
|
||||
namespaces sequences specialized-vectors system
|
||||
tools.memory ui ui.gadgets.worlds vm vocabs.loader arrays
|
||||
|
|
@ -14,7 +14,7 @@ TUPLE: game-loop
|
|||
{ running? boolean }
|
||||
{ tick# integer }
|
||||
{ frame# integer }
|
||||
alarm
|
||||
timer
|
||||
benchmark-data ;
|
||||
|
||||
STRUCT: game-loop-benchmark
|
||||
|
|
@ -110,12 +110,12 @@ PRIVATE>
|
|||
[
|
||||
[ '[ _ game-tick ] f ]
|
||||
[ tick-interval-nanos>> nanoseconds ] bi
|
||||
<alarm>
|
||||
] keep [ alarm<< ] [ drop start-alarm ] 2bi ;
|
||||
<timer>
|
||||
] keep [ timer<< ] [ drop start-timer ] 2bi ;
|
||||
|
||||
: stop-loop ( loop -- )
|
||||
f >>running?
|
||||
alarm>> stop-alarm ;
|
||||
timer>> stop-timer ;
|
||||
|
||||
: <game-loop*> ( tick-interval-nanos tick-delegate draw-delegate -- loop )
|
||||
nano-count f 0 0 f
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: fry irc.client irc.client.chats kernel namespaces
|
||||
sequences threads io.launcher io splitting
|
||||
make mason.common mason.updates calendar math alarms
|
||||
make mason.common mason.updates calendar math timers
|
||||
io.encodings.8-bit.latin1 debugger ;
|
||||
IN: irc.gitbot
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2010 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alarms bit-arrays calendar game.input io
|
||||
USING: accessors timers bit-arrays calendar game.input io
|
||||
io.binary io.encodings.binary io.files kernel literals math
|
||||
namespaces system threads ;
|
||||
IN: key-logger
|
||||
|
|
@ -28,7 +28,7 @@ SYMBOL: key-logger
|
|||
] unless ;
|
||||
|
||||
: stop-key-logger ( -- )
|
||||
key-logger get-global [ stop-alarm ] when*
|
||||
key-logger get-global [ stop-timer ] when*
|
||||
f key-logger set-global
|
||||
close-game-input ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alarms arrays calendar combinators
|
||||
USING: accessors timers arrays calendar combinators
|
||||
combinators.smart continuations debugger http.client fry
|
||||
init io.streams.string kernel locals math math.parser db
|
||||
namespaces sequences site-watcher.db site-watcher.email ;
|
||||
|
|
@ -48,4 +48,4 @@ PRIVATE>
|
|||
] unless ;
|
||||
|
||||
: stop-site-watcher ( -- )
|
||||
running-site-watcher get [ stop-alarm ] when* ;
|
||||
running-site-watcher get [ stop-timer ] when* ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,13 @@
|
|||
! Copyright (C) 2006, 2007, 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alarms arrays calendar kernel make math math.rectangles math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ;
|
||||
USING: accessors timers arrays calendar kernel make math math.rectangles
|
||||
math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets
|
||||
ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures
|
||||
ui.render ui ;
|
||||
FROM: tetris.game => level>> ;
|
||||
IN: tetris
|
||||
|
||||
TUPLE: tetris-gadget < gadget { tetris tetris } { alarm } ;
|
||||
TUPLE: tetris-gadget < gadget { tetris tetris } { timer } ;
|
||||
|
||||
: <tetris-gadget> ( tetris -- gadget )
|
||||
tetris-gadget new swap >>tetris ;
|
||||
|
|
@ -52,10 +55,10 @@ tetris-gadget H{
|
|||
[ tetris>> ?update ] [ relayout-1 ] bi ;
|
||||
|
||||
M: tetris-gadget graft* ( gadget -- )
|
||||
[ [ tick ] curry 100 milliseconds every ] keep alarm<< ;
|
||||
[ [ tick ] curry 100 milliseconds every ] keep timer<< ;
|
||||
|
||||
M: tetris-gadget ungraft* ( gadget -- )
|
||||
[ stop-alarm f ] change-alarm drop ;
|
||||
[ stop-timer f ] change-timer drop ;
|
||||
|
||||
: tetris-window ( -- )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors sequences sorting math math.order
|
||||
calendar alarms logging concurrency.combinators namespaces
|
||||
calendar timers logging concurrency.combinators namespaces
|
||||
db.types db.tuples db fry locals hashtables
|
||||
syndication urls xml.writer validators
|
||||
html.forms
|
||||
|
|
|
|||
Loading…
Reference in New Issue