steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2010-02-28 20:25:26 -08:00
parent bb58cf4d16 e3ddafbdec
commit 702c4df0da
4 changed files with 19 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/core-foundation/run-loop/run-loop.factor
View File

@ -99,22 +99,18 @@ TUPLE: run-loop fds sources timers ;
<PRIVATE <PRIVATE
: ((reset-timer)) ( timer counter timestamp -- ) : (reset-timer) ( timer timestamp -- )
nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ; >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
: nano-count>timestamp ( x -- timestamp ) : nano-count>micros ( x -- n )
nano-count - nanoseconds now time+ ; nano-count - 1,000 /f system-micros + ;
: (reset-timer) ( timer counter -- )
yield {
{ [ dup 0 = ] [ now ((reset-timer)) ] }
{ [ run-queue deque-empty? not ] [ 1 - (reset-timer) ] }
{ [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
[ sleep-queue heap-peek nip nano-count>timestamp ((reset-timer)) ]
} cond ;
: reset-timer ( timer -- ) : reset-timer ( timer -- )
10 (reset-timer) ; yield {
{ [ run-queue deque-empty? not ] [ yield system-micros (reset-timer) ] }
{ [ sleep-queue heap-empty? ] [ system-micros 1,000,000 + (reset-timer) ] }
[ sleep-queue heap-peek nip nano-count>micros (reset-timer) ]
} cond ;
PRIVATE> PRIVATE>

12
basis/core-foundation/time/time.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: calendar alien.c-types alien.syntax ; USING: calendar math alien.c-types alien.syntax memoize system ;
IN: core-foundation.time IN: core-foundation.time
TYPEDEF: double CFTimeInterval TYPEDEF: double CFTimeInterval
@ -9,6 +9,8 @@ TYPEDEF: double CFAbsoluteTime
: >CFTimeInterval ( duration -- interval ) : >CFTimeInterval ( duration -- interval )
duration>seconds ; inline duration>seconds ; inline
: >CFAbsoluteTime ( timestamp -- time ) MEMO: epoch ( -- micros )
T{ timestamp { year 2001 } { month 1 } { day 1 } } time- T{ timestamp { year 2001 } { month 1 } { day 1 } } timestamp>micros ;
duration>seconds ; inline
: >CFAbsoluteTime ( micros -- time )
epoch - 1,000,000 /f ; inline

4
basis/core-foundation/timers/timers.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax system math kernel calendar USING: alien.c-types alien.syntax system math kernel calendar
core-foundation core-foundation.time ; core-foundation core-foundation.time ;
@ -19,7 +19,7 @@ FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
) ; ) ;
: <CFTimer> ( callback -- timer ) : <CFTimer> ( callback -- timer )
[ f now >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ; [ f system-micros >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ;
FUNCTION: void CFRunLoopTimerInvalidate ( FUNCTION: void CFRunLoopTimerInvalidate (
CFRunLoopTimerRef timer CFRunLoopTimerRef timer

2
extra/game/loop/loop.factor
View File

@ -66,7 +66,7 @@ TUPLE: game-loop-error game-loop error ;
: (run-loop) ( loop -- ) : (run-loop) ( loop -- )
dup running?>> dup running?>>
[ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ 1 milliseconds sleep (run-loop) ] tri ] [ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] [ yield (run-loop) ] tri ]
[ drop ] if ; [ drop ] if ;
: run-loop ( loop -- ) : run-loop ( loop -- )