1 ! Copyright (C) 2008, 2010 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.syntax
4 core-foundation core-foundation.file-descriptors
5 core-foundation.strings core-foundation.time
6 core-foundation.timers destructors init kernel math namespaces
8 FROM: calendar.unix => system-micros ;
9 IN: core-foundation.run-loop
11 CONSTANT: kCFRunLoopRunFinished 1
12 CONSTANT: kCFRunLoopRunStopped 2
13 CONSTANT: kCFRunLoopRunTimedOut 3
14 CONSTANT: kCFRunLoopRunHandledSource 4
16 TYPEDEF: void* CFRunLoopRef
17 TYPEDEF: void* CFRunLoopSourceRef
19 FUNCTION: CFRunLoopRef CFRunLoopGetMain ( )
20 FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( )
22 FUNCTION: SInt32 CFRunLoopRunInMode (
24 CFTimeInterval seconds,
25 Boolean returnAfterSourceHandled
28 FUNCTION: CFRunLoopSourceRef CFFileDescriptorCreateRunLoopSource (
29 CFAllocatorRef allocator,
30 CFFileDescriptorRef f,
34 FUNCTION: void CFRunLoopAddSource (
36 CFRunLoopSourceRef source,
40 FUNCTION: void CFRunLoopRemoveSource (
42 CFRunLoopSourceRef source,
46 FUNCTION: void CFRunLoopAddTimer (
48 CFRunLoopTimerRef timer,
52 FUNCTION: void CFRunLoopRemoveTimer (
54 CFRunLoopTimerRef timer,
58 CFSTRING: CFRunLoopDefaultMode "kCFRunLoopDefaultMode"
60 TUPLE: run-loop-state fds sources timers ;
64 : <run-loop> ( -- run-loop )
65 V{ } clone V{ } clone V{ } clone \ run-loop-state boa ;
67 : get-run-loop ( -- run-loop )
68 \ run-loop [ <run-loop> ] initialize-alien ;
70 : add-source-to-run-loop ( source -- )
71 [ get-run-loop sources>> push ]
74 swap CFRunLoopDefaultMode
78 : create-fd-source ( CFFileDescriptor -- source )
79 f swap 0 CFFileDescriptorCreateRunLoopSource ;
81 : add-fd-to-run-loop ( fd callback -- )
83 <CFFileDescriptor> |CFRelease
84 [ enable-all-callbacks ]
85 [ get-run-loop fds>> push ]
86 [ create-fd-source |CFRelease add-source-to-run-loop ]
90 : add-timer-to-run-loop ( timer -- )
91 [ get-run-loop timers>> push ]
94 swap CFRunLoopDefaultMode
98 : invalidate-run-loop-timers ( -- )
100 [ [ CFRunLoopTimerInvalidate ] [ CFRelease ] bi ] each
102 ] change-timers drop ;
105 [ f thread-timer set-global ]
106 "core-foundation.run-loop" add-startup-hook
108 : (reset-thread-timer) ( timer -- )
110 [ 1000 /f ] [ 1,000,000 ] if* system-micros +
111 >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
113 : reset-thread-timer ( -- )
114 thread-timer get-global [ (reset-thread-timer) ] when* ;
116 : thread-timer-callback ( -- callback )
117 [ drop (reset-thread-timer) yield ] CFRunLoopTimerCallBack ;
119 : init-thread-timer ( -- )
120 60 thread-timer-callback <CFTimer>
121 [ add-timer-to-run-loop ]
122 [ thread-timer set-global ] bi ;
124 : run-one-iteration ( nanos -- handled? )
126 swap [ 1,000,000,000 /f ] [ 300 ] if*
127 t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;