refactor calendar a bit, add initial docs
Doug Coleman
parent
5f12667788
commit
24bfa90a04
|
|
@ -0,0 +1,31 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math strings help.markup help.syntax
|
||||
calendar.backend ;
|
||||
IN: calendar
|
||||
|
||||
HELP: duration
|
||||
{ $description "A duration is a period of time years, months, days, hours, minutes, and seconds. All duration slots can store " { $link real } " numbers." } ;
|
||||
|
||||
HELP: timestamp
|
||||
{ $description "A timestamp is a date and a time with a timezone offset. Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } "." } ;
|
||||
|
||||
{ timestamp duration } related-words
|
||||
|
||||
HELP: gmt-offset-duration
|
||||
{ $values { "duration" duration } }
|
||||
{ $description "Returns a " { $link duration } " object with the GMT offset returned by " { $link gmt-offset } "." } ;
|
||||
|
||||
HELP: <date>
|
||||
{ $values { "year" real } { "month" real } { "day" real } }
|
||||
{ $description "Returns a timestamp object representing the start of the specified day in your current timezone." }
|
||||
{ $examples
|
||||
{ $example "USE: calendar"
|
||||
"12 25 2010 <date> ."
|
||||
"T{ timestamp f 12 25 2010 0 0 0 T{ duration f 0 0 0 -5 0 0 }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: month-names
|
||||
{ $values { "array" array } }
|
||||
{ $description "Returns an array with the English names of all the months. January has a index of 1 instead of 0." } ;
|
||||
|
|
@ -1,52 +1,90 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: arrays kernel math math.functions namespaces sequences
|
||||
strings system vocabs.loader calendar.backend threads
|
||||
accessors combinators locals classes.tuple math.order
|
||||
memoize ;
|
||||
memoize summary combinators.short-circuit ;
|
||||
IN: calendar
|
||||
|
||||
TUPLE: timestamp year month day hour minute second gmt-offset ;
|
||||
|
||||
C: <timestamp> timestamp
|
||||
|
||||
TUPLE: duration year month day hour minute second ;
|
||||
TUPLE: duration
|
||||
{ year real }
|
||||
{ month real }
|
||||
{ day real }
|
||||
{ hour real }
|
||||
{ minute real }
|
||||
{ second real } ;
|
||||
|
||||
C: <duration> duration
|
||||
|
||||
TUPLE: timestamp
|
||||
{ year integer }
|
||||
{ month integer }
|
||||
{ day integer }
|
||||
{ hour integer }
|
||||
{ minute integer }
|
||||
{ second real }
|
||||
{ gmt-offset duration } ;
|
||||
|
||||
C: <timestamp> timestamp
|
||||
|
||||
: gmt-offset-duration ( -- duration )
|
||||
0 0 0 gmt-offset <duration> ;
|
||||
|
||||
: <date> ( year month day -- timestamp )
|
||||
0 0 0 gmt-offset-duration <timestamp> ;
|
||||
|
||||
: month-names
|
||||
ERROR: not-a-month n ;
|
||||
M: not-a-month summary
|
||||
drop "Months are indexed starting at 1" ;
|
||||
|
||||
<PRIVATE
|
||||
: check-month ( n -- n )
|
||||
dup zero? [ not-a-month ] when ;
|
||||
PRIVATE>
|
||||
|
||||
: month-names ( -- array )
|
||||
{
|
||||
"Not a month" "January" "February" "March" "April" "May" "June"
|
||||
"January" "February" "March" "April" "May" "June"
|
||||
"July" "August" "September" "October" "November" "December"
|
||||
} ;
|
||||
|
||||
: month-abbreviations
|
||||
: month-name ( n -- string )
|
||||
check-month 1- month-names nth ;
|
||||
|
||||
: month-abbreviations ( -- array )
|
||||
{
|
||||
"Not a month"
|
||||
"Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"
|
||||
"Jan" "Feb" "Mar" "Apr" "May" "Jun"
|
||||
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec"
|
||||
} ;
|
||||
|
||||
: day-names
|
||||
: month-abbreviation ( n -- array )
|
||||
check-month 1- month-abbreviations nth ;
|
||||
|
||||
: day-names ( -- array )
|
||||
{
|
||||
"Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"
|
||||
} ;
|
||||
|
||||
: day-abbreviations2 { "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ;
|
||||
: day-abbreviations3 { "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ;
|
||||
: day-name ( n -- string ) day-names nth ;
|
||||
|
||||
: average-month 30+5/12 ; inline
|
||||
: months-per-year 12 ; inline
|
||||
: days-per-year 3652425/10000 ; inline
|
||||
: hours-per-year 876582/100 ; inline
|
||||
: minutes-per-year 5259492/10 ; inline
|
||||
: seconds-per-year 31556952 ; inline
|
||||
: day-abbreviations2 ( -- array )
|
||||
{ "Su" "Mo" "Tu" "We" "Th" "Fr" "Sa" } ;
|
||||
|
||||
: day-abbreviation2 ( n -- string )
|
||||
day-abbreviations2 nth ;
|
||||
|
||||
: day-abbreviations3 ( -- array )
|
||||
{ "Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat" } ;
|
||||
|
||||
: day-abbreviation3 ( n -- string )
|
||||
day-abbreviations3 nth ;
|
||||
|
||||
: average-month ( -- ratio ) 30+5/12 ; inline
|
||||
: months-per-year ( -- integer ) 12 ; inline
|
||||
: days-per-year ( -- ratio ) 3652425/10000 ; inline
|
||||
: hours-per-year ( -- ratio ) 876582/100 ; inline
|
||||
: minutes-per-year ( -- ratio ) 5259492/10 ; inline
|
||||
: seconds-per-year ( -- integer ) 31556952 ; inline
|
||||
|
||||
:: julian-day-number ( year month day -- n )
|
||||
#! Returns a composite date number
|
||||
|
|
@ -113,10 +151,12 @@ GENERIC: +second ( timestamp x -- timestamp )
|
|||
[ floor >integer ] keep over - ;
|
||||
|
||||
: adjust-leap-year ( timestamp -- timestamp )
|
||||
dup day>> 29 = over month>> 2 = pick leap-year? not and and
|
||||
dup
|
||||
{ [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&&
|
||||
[ 3 >>month 1 >>day ] when ;
|
||||
|
||||
: unless-zero >r dup zero? [ drop ] r> if ; inline
|
||||
: unless-zero ( n quot -- )
|
||||
[ dup zero? [ drop ] ] dip if ; inline
|
||||
|
||||
M: integer +year ( timestamp n -- timestamp )
|
||||
[ [ + ] curry change-year adjust-leap-year ] unless-zero ;
|
||||
|
|
|
|||
|
|
@ -26,11 +26,11 @@ IN: calendar.format
|
|||
|
||||
: DD ( time -- ) day>> write-00 ;
|
||||
|
||||
: DAY ( time -- ) day-of-week day-abbreviations3 nth write ;
|
||||
: DAY ( time -- ) day-of-week day-abbreviation3 write ;
|
||||
|
||||
: MM ( time -- ) month>> write-00 ;
|
||||
|
||||
: MONTH ( time -- ) month>> month-abbreviations nth write ;
|
||||
: MONTH ( time -- ) month>> month-abbreviation write ;
|
||||
|
||||
: YYYY ( time -- ) year>> write-0000 ;
|
||||
|
||||
|
|
@ -57,7 +57,7 @@ GENERIC: month. ( obj -- )
|
|||
|
||||
M: array month. ( pair -- )
|
||||
first2
|
||||
[ month-names nth write bl number>string print ]
|
||||
[ month-name write bl number>string print ]
|
||||
[ 1 zeller-congruence ]
|
||||
[ (days-in-month) day-abbreviations2 " " join print ] 2tri
|
||||
over " " <repetition> concat write
|
||||
|
|
@ -191,7 +191,7 @@ ERROR: invalid-timestamp-format ;
|
|||
"," read-token day-abbreviations3 member? check-timestamp drop
|
||||
read1 CHAR: \s assert=
|
||||
read-sp checked-number >>day
|
||||
read-sp month-abbreviations index check-timestamp >>month
|
||||
read-sp month-abbreviations index 1+ check-timestamp >>month
|
||||
read-sp checked-number >>year
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
|
|
@ -206,7 +206,7 @@ ERROR: invalid-timestamp-format ;
|
|||
"," read-token day-abbreviations3 member? check-timestamp drop
|
||||
read1 CHAR: \s assert=
|
||||
"-" read-token checked-number >>day
|
||||
"-" read-token month-abbreviations index check-timestamp >>month
|
||||
"-" read-token month-abbreviations index 1+ check-timestamp >>month
|
||||
read-sp checked-number >>year
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
|
|
@ -219,7 +219,7 @@ ERROR: invalid-timestamp-format ;
|
|||
: (cookie-string>timestamp-2) ( -- timestamp )
|
||||
timestamp new
|
||||
read-sp day-abbreviations3 member? check-timestamp drop
|
||||
read-sp month-abbreviations index check-timestamp >>month
|
||||
read-sp month-abbreviations index 1+ check-timestamp >>month
|
||||
read-sp checked-number >>day
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
|
|
|
|||
Loading…
Reference in New Issue