Udpate calendar to remove some circular dependencies
parent
3546f5150d
commit
54ccb0f48c
|
@ -0,0 +1,5 @@
|
|||
USING: kernel ;
|
||||
IN: calendar.backend
|
||||
|
||||
SYMBOL: calendar-backend
|
||||
HOOK: gmt-offset calendar-backend
|
|
@ -3,13 +3,10 @@
|
|||
|
||||
USING: arrays hashtables io io.streams.string kernel math
|
||||
math.vectors math.functions math.parser namespaces sequences
|
||||
strings tuples system debugger combinators vocabs.loader ;
|
||||
strings tuples system debugger combinators vocabs.loader
|
||||
calendar.backend structs alien.c-types unix ;
|
||||
IN: calendar
|
||||
|
||||
SYMBOL: calendar-impl
|
||||
|
||||
HOOK: gmt-offset calendar-impl ( -- n )
|
||||
|
||||
TUPLE: timestamp year month day hour minute second gmt-offset ;
|
||||
|
||||
C: <timestamp> timestamp
|
||||
|
@ -225,6 +222,24 @@ M: timestamp <=> ( ts1 ts2 -- n )
|
|||
: timestamp>unix-time ( timestamp -- n )
|
||||
unix-1970 timestamp- >bignum ;
|
||||
|
||||
: timestamp>timeval ( timestamp -- timeval )
|
||||
timestamp>unix-time 1000 * make-timeval ;
|
||||
|
||||
: timeval>timestamp ( timeval -- timestamp )
|
||||
[ timeval-sec ] keep
|
||||
timeval-usec 1000000 / + unix-time>timestamp ;
|
||||
|
||||
: timestamp>timespec ( timestamp -- timespec )
|
||||
timestamp>unix-time "timespec" <c-object>
|
||||
[ set-timespec-sec ] keep ;
|
||||
|
||||
: timespec>timestamp ( timespec -- timestamp )
|
||||
[ timespec-sec ] keep
|
||||
timespec-nsec 1000000000 / +
|
||||
unix-time>timestamp ;
|
||||
|
||||
|
||||
|
||||
: gmt ( -- timestamp )
|
||||
#! GMT time, right now
|
||||
unix-1970 millis 1000 /f seconds +dt ;
|
||||
|
@ -353,6 +368,37 @@ M: timestamp <=> ( ts1 ts2 -- n )
|
|||
] if
|
||||
] string-out ;
|
||||
|
||||
: day-offset ( timestamp m -- timestamp n )
|
||||
over day-of-week - ; inline
|
||||
|
||||
: day-this-week ( timestamp n -- timestamp )
|
||||
day-offset days +dt ;
|
||||
|
||||
: sunday ( timestamp -- timestamp ) 0 day-this-week ;
|
||||
: monday ( timestamp -- timestamp ) 1 day-this-week ;
|
||||
: tuesday ( timestamp -- timestamp ) 2 day-this-week ;
|
||||
: wednesday ( timestamp -- timestamp ) 3 day-this-week ;
|
||||
: thursday ( timestamp -- timestamp ) 4 day-this-week ;
|
||||
: friday ( timestamp -- timestamp ) 5 day-this-week ;
|
||||
: saturday ( timestamp -- timestamp ) 6 day-this-week ;
|
||||
|
||||
: beginning-of-day ( timestamp -- new-timestamp )
|
||||
clone dup >r 0 0 0 r>
|
||||
{ set-timestamp-hour set-timestamp-minute set-timestamp-second }
|
||||
set-slots ; inline
|
||||
|
||||
: beginning-of-month ( timestamp -- new-timestamp )
|
||||
clone dup beginning-of-day dup >r 1 r> { set-timestamp-day } set-slots ;
|
||||
|
||||
: beginning-of-week ( timestamp -- new-timestamp )
|
||||
clone dup sunday beginning-of-day ;
|
||||
|
||||
: beginning-of-year ( timestamp -- new-timestamp )
|
||||
clone dup beginning-of-month dup >r 1 r> { set-timestamp-month } set-slots ;
|
||||
|
||||
: seconds-since-midnight ( timestamp -- x )
|
||||
dup beginning-of-day timestamp- ;
|
||||
|
||||
{
|
||||
{ [ unix? ] [ "calendar.unix" ] }
|
||||
{ [ windows? ] [ "calendar.windows" ] }
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
USING: alien alien.c-types arrays kernel structs
|
||||
math unix calendar namespaces ;
|
||||
USING: alien alien.c-types arrays calendar.backend
|
||||
kernel structs math unix namespaces ;
|
||||
IN: calendar.unix
|
||||
|
||||
TUPLE: unix-calendar ;
|
||||
|
||||
T{ unix-calendar } calendar-impl set-global
|
||||
T{ unix-calendar } calendar-backend set-global
|
||||
|
||||
: get-time
|
||||
f time <uint> localtime ;
|
||||
|
@ -14,19 +14,3 @@ T{ unix-calendar } calendar-impl set-global
|
|||
|
||||
M: unix-calendar gmt-offset
|
||||
get-time tm-gmtoff 3600 / ;
|
||||
|
||||
: timestamp>timeval ( timestamp -- timeval )
|
||||
timestamp>unix-time 1000 * make-timeval ;
|
||||
|
||||
: timeval>timestamp ( timeval -- timestamp )
|
||||
[ timeval-sec ] keep
|
||||
timeval-usec 1000000 / + unix-time>timestamp ;
|
||||
|
||||
: timestamp>timespec ( timestamp -- timespec )
|
||||
timestamp>unix-time "timespec" <c-object>
|
||||
[ set-timespec-sec ] keep ;
|
||||
|
||||
: timespec>timestamp ( timespec -- timestamp )
|
||||
[ timespec-sec ] keep
|
||||
timespec-nsec 1000000000 / +
|
||||
unix-time>timestamp ;
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
USING: alien alien.c-types kernel math
|
||||
windows windows.kernel32 calendar namespaces ;
|
||||
windows windows.kernel32 namespaces ;
|
||||
IN: calendar.windows
|
||||
|
||||
TUPLE: windows-calendar ;
|
||||
|
||||
T{ windows-calendar } calendar-impl set-global
|
||||
T{ windows-calendar } calendar-backend set-global
|
||||
|
||||
M: windows-calendar gmt-offset ( -- float )
|
||||
"TIME_ZONE_INFORMATION" <c-object>
|
||||
|
@ -45,4 +45,3 @@ M: windows-calendar gmt-offset ( -- float )
|
|||
|
||||
: FILETIME>timestamp ( FILETIME -- timestamp/f )
|
||||
FILETIME>windows-time windows-time>timestamp ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue