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

Fix calendar

db4
Slava Pestov 2008-01-10 23:06:23 -05:00
parent afd4732409
commit 0a6aff794b
1 changed files with 12 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
extra/calendar/calendar.factor
View File

@ -4,7 +4,7 @@
USING: arrays hashtables io io.streams.string kernel math USING: arrays hashtables io io.streams.string kernel math
math.vectors math.functions math.parser namespaces sequences 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 ; calendar.backend structs alien.c-types ;
IN: calendar IN: calendar
TUPLE: timestamp year month day hour minute second gmt-offset ; TUPLE: timestamp year month day hour minute second gmt-offset ;
@ -229,16 +229,6 @@ M: timestamp <=> ( ts1 ts2 -- n )
[ timeval-sec ] keep [ timeval-sec ] keep
timeval-usec 1000000 / + unix-time>timestamp ; 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 ( -- timestamp )
#! GMT time, right now #! GMT time, right now
@ -382,23 +372,6 @@ M: timestamp <=> ( ts1 ts2 -- n )
: friday ( timestamp -- timestamp ) 5 day-this-week ; : friday ( timestamp -- timestamp ) 5 day-this-week ;
: saturday ( timestamp -- timestamp ) 6 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" ] } { [ unix? ] [ "calendar.unix" ] }
{ [ windows? ] [ "calendar.windows" ] } { [ windows? ] [ "calendar.windows" ] }