From 24bfa90a04f25e04bb552de9b8cdaaec0aaaeb98 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 29 Aug 2008 15:17:15 -0500 Subject: [PATCH] refactor calendar a bit, add initial docs --- basis/calendar/calendar-docs.factor | 31 +++++++++++ basis/calendar/calendar.factor | 86 +++++++++++++++++++++-------- basis/calendar/format/format.factor | 12 ++-- 3 files changed, 100 insertions(+), 29 deletions(-) create mode 100644 basis/calendar/calendar-docs.factor diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor new file mode 100644 index 0000000000..0d335d1b41 --- /dev/null +++ b/basis/calendar/calendar-docs.factor @@ -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: +{ $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 ." + "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." } ; diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 0abc00b4a4..402542de3b 100755 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -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 - -TUPLE: duration year month day hour minute second ; +TUPLE: duration + { year real } + { month real } + { day real } + { hour real } + { minute real } + { second real } ; C: duration +TUPLE: timestamp + { year integer } + { month integer } + { day integer } + { hour integer } + { minute integer } + { second real } + { gmt-offset duration } ; + +C: timestamp + : gmt-offset-duration ( -- duration ) 0 0 0 gmt-offset ; : ( year month day -- timestamp ) 0 0 0 gmt-offset-duration ; -: month-names +ERROR: not-a-month n ; +M: not-a-month summary + drop "Months are indexed starting at 1" ; + + + +: 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 ; diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index e2b6a280ef..36849d4ae3 100755 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -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 " " 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