Merge branch 'master' of git://factorcode.org/git/factor
commit
702c4df0da
|
@ -99,22 +99,18 @@ TUPLE: run-loop fds sources timers ;
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: ((reset-timer)) ( timer counter timestamp -- )
|
||||
nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
|
||||
: (reset-timer) ( timer timestamp -- )
|
||||
>CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
|
||||
|
||||
: nano-count>timestamp ( x -- timestamp )
|
||||
nano-count - nanoseconds now time+ ;
|
||||
|
||||
: (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 ;
|
||||
: nano-count>micros ( x -- n )
|
||||
nano-count - 1,000 /f system-micros + ;
|
||||
|
||||
: 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>
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! 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
|
||||
|
||||
TYPEDEF: double CFTimeInterval
|
||||
|
@ -9,6 +9,8 @@ TYPEDEF: double CFAbsoluteTime
|
|||
: >CFTimeInterval ( duration -- interval )
|
||||
duration>seconds ; inline
|
||||
|
||||
: >CFAbsoluteTime ( timestamp -- time )
|
||||
T{ timestamp { year 2001 } { month 1 } { day 1 } } time-
|
||||
duration>seconds ; inline
|
||||
MEMO: epoch ( -- micros )
|
||||
T{ timestamp { year 2001 } { month 1 } { day 1 } } timestamp>micros ;
|
||||
|
||||
: >CFAbsoluteTime ( micros -- time )
|
||||
epoch - 1,000,000 /f ; inline
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax system math kernel calendar
|
||||
core-foundation core-foundation.time ;
|
||||
|
@ -19,7 +19,7 @@ FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
|
|||
) ;
|
||||
|
||||
: <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 (
|
||||
CFRunLoopTimerRef timer
|
||||
|
|
|
@ -66,7 +66,7 @@ TUPLE: game-loop-error game-loop error ;
|
|||
|
||||
: (run-loop) ( loop -- )
|
||||
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 ;
|
||||
|
||||
: run-loop ( loop -- )
|
||||
|
|
Loading…
Reference in New Issue