128 lines
3.2 KiB
Factor
128 lines
3.2 KiB
Factor
! Copyright (C) 2008, 2010 Slava Pestov
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors alien alien.c-types alien.syntax
|
|
core-foundation core-foundation.file-descriptors
|
|
core-foundation.strings core-foundation.time
|
|
core-foundation.timers destructors init kernel math namespaces
|
|
sequences threads ;
|
|
FROM: calendar.unix => system-micros ;
|
|
IN: core-foundation.run-loop
|
|
|
|
CONSTANT: kCFRunLoopRunFinished 1
|
|
CONSTANT: kCFRunLoopRunStopped 2
|
|
CONSTANT: kCFRunLoopRunTimedOut 3
|
|
CONSTANT: kCFRunLoopRunHandledSource 4
|
|
|
|
TYPEDEF: void* CFRunLoopRef
|
|
TYPEDEF: void* CFRunLoopSourceRef
|
|
|
|
FUNCTION: CFRunLoopRef CFRunLoopGetMain ( )
|
|
FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( )
|
|
|
|
FUNCTION: SInt32 CFRunLoopRunInMode (
|
|
CFStringRef mode,
|
|
CFTimeInterval seconds,
|
|
Boolean returnAfterSourceHandled
|
|
)
|
|
|
|
FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource (
|
|
CFAllocatorRef allocator,
|
|
CFFileDescriptorRef f,
|
|
CFIndex order
|
|
)
|
|
|
|
FUNCTION: void CFRunLoopAddSource (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopSourceRef source,
|
|
CFStringRef mode
|
|
)
|
|
|
|
FUNCTION: void CFRunLoopRemoveSource (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopSourceRef source,
|
|
CFStringRef mode
|
|
)
|
|
|
|
FUNCTION: void CFRunLoopAddTimer (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopTimerRef timer,
|
|
CFStringRef mode
|
|
)
|
|
|
|
FUNCTION: void CFRunLoopRemoveTimer (
|
|
CFRunLoopRef rl,
|
|
CFRunLoopTimerRef timer,
|
|
CFStringRef mode
|
|
)
|
|
|
|
CFSTRING: CFRunLoopDefaultMode "kCFRunLoopDefaultMode"
|
|
|
|
TUPLE: run-loop-state fds sources timers ;
|
|
|
|
SYMBOL: run-loop
|
|
|
|
: <run-loop> ( -- run-loop )
|
|
V{ } clone V{ } clone V{ } clone \ run-loop-state boa ;
|
|
|
|
: get-run-loop ( -- run-loop )
|
|
\ run-loop [ <run-loop> ] initialize-alien ;
|
|
|
|
: add-source-to-run-loop ( source -- )
|
|
[ get-run-loop sources>> push ]
|
|
[
|
|
CFRunLoopGetMain
|
|
swap CFRunLoopDefaultMode
|
|
CFRunLoopAddSource
|
|
] bi ;
|
|
|
|
: create-fd-source ( CFFileDescriptor -- source )
|
|
f swap 0 CFFileDescriptorCreateRunLoopSource ;
|
|
|
|
: add-fd-to-run-loop ( fd callback -- )
|
|
[
|
|
<CFFileDescriptor> |CFRelease
|
|
[ enable-all-callbacks ]
|
|
[ get-run-loop fds>> push ]
|
|
[ create-fd-source |CFRelease add-source-to-run-loop ]
|
|
tri
|
|
] with-destructors ;
|
|
|
|
: add-timer-to-run-loop ( timer -- )
|
|
[ get-run-loop timers>> push ]
|
|
[
|
|
CFRunLoopGetMain
|
|
swap CFRunLoopDefaultMode
|
|
CFRunLoopAddTimer
|
|
] bi ;
|
|
|
|
: invalidate-run-loop-timers ( -- )
|
|
get-run-loop [
|
|
[ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each
|
|
V{ } clone
|
|
] change-timers drop ;
|
|
|
|
SYMBOL: thread-timer
|
|
[ f thread-timer set-global ]
|
|
"core-foundation.run-loop" add-startup-hook
|
|
|
|
: (reset-thread-timer) ( timer -- )
|
|
sleep-time
|
|
[ 1000 /f ] [ 1,000,000 ] if* system-micros +
|
|
>CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
|
|
|
|
: reset-thread-timer ( -- )
|
|
thread-timer get-global [ (reset-thread-timer) ] when* ;
|
|
|
|
: thread-timer-callback ( -- callback )
|
|
[ drop (reset-thread-timer) yield ] CFRunLoopTimerCallBack ;
|
|
|
|
: init-thread-timer ( -- )
|
|
60 thread-timer-callback <CFTimer>
|
|
[ add-timer-to-run-loop ]
|
|
[ thread-timer set-global ] bi ;
|
|
|
|
: run-one-iteration ( nanos -- handled? )
|
|
CFRunLoopDefaultMode
|
|
swap [ 1,000,000,000 /f ] [ 300 ] if*
|
|
t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;
|