! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar calendar.english combinators
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors calendar calendar.english combinators
formatting grouping io io.streams.string kernel make math
-math.order math.parser math.parser.private math.ranges present
-quotations sequences splitting strings words ;
+math.order math.parser present quotations ranges sequences
+splitting strings words ;
IN: calendar.format
MACRO: formatted ( spec -- quot )
{
{ [ dup word? ] [ 1quotation ] }
{ [ dup quotation? ] [ ] }
- [ [ nip write ] curry [ ] like ]
+ [ [ nip write ] curry ]
} cond
] map [ cleave ] curry ;
: ss ( timestamp -- ) second>> >integer write-00 ;
-! Should be enough for anyone, allows to not do a fancy
-! algorithm to detect infinite decimals (e.g 1/3)
-: ss.SSSSSS ( timestamp -- )
- second>> >float "0" 9 6 "f" "C" format-float write ;
+: ss.SSSSSS ( timestamp -- ) second>> "%09.6f" printf ;
: hhmm ( timestamp -- ) [ hh ] [ mm ] bi ;
[ number>string ] [ month-name ] bi* swap " " glue 20 center. ;
: days-header. ( -- )
- day-abbreviations2 " " join print ;
+ day-abbreviations2 join-words print ;
: days. ( year month -- )
[ 1 (day-of-week) dup [ " " write ] times ]
- [ (days-in-month) ] 2bi [1,b] [
+ [ (days-in-month) ] 2bi [1..b] [
[ day. ] [ + 7 mod zero? [ nl ] [ bl ] if ] bi
] with each nl ;
GENERIC: year. ( obj -- )
M: integer year.
- dup number>string 64 center. nl 12 [1,b] [
+ dup number>string 64 center. nl 12 [1..b] [
[
[ month-name 20 center. ]
[ days-header. days. nl nl ] bi
- ] with-string-writer string-lines
+ ] with-string-writer split-lines
] with map 3 <groups>
[ first3 [ "%-20s %-20s %-20s\n" printf ] 3each ] each ;
: duration>human-readable ( duration -- string )
[
- [
- duration>years >integer
- [
- [ number>string write ]
- [ 1 > " years, " " year, " ? write ] bi
- ] unless-zero
- ] [
- duration>days >integer 365 mod
+ {
[
- [ number>string write ]
- [ 1 > " days, " " day, " ? write ] bi
- ] unless-zero
- ] [ duration>hms write ] tri
- ] with-string-writer ;
+ duration>years >integer
+ [
+ [ number>string ]
+ [ 1 > " years" " year" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>days >integer 365 mod
+ [
+ [ number>string ]
+ [ 1 > " days" " day" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>hours >integer 24 mod
+ [
+ [ number>string ]
+ [ 1 > " hours" " hour" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>minutes >integer 60 mod
+ [
+ [ number>string ]
+ [ 1 > " minutes" " minute" ? append , ] bi
+ ] unless-zero
+ ] [
+ duration>seconds >integer 60 mod
+ [
+ number>string " seconds" append ,
+ ] unless-zero
+ ]
+ } cleave
+ ] { } make [ "0 seconds" ] [
+ unclip-last-slice over empty? [ nip ] [
+ [ ", " join ] [ " and " glue ] bi*
+ ] if
+ ] if-empty ;
GENERIC: elapsed-time ( seconds -- string )
[ first [ /mod ] [ dup ] if* ] [ second ] bi swap
dup 0 > [ number>string prepend , ] [ 2drop ] if
] each drop
- ] { } make [ "0s" ] [ reverse " " join ] if-empty ;
+ ] { } make [ "0s" ] [ reverse join-words ] if-empty ;
M: real elapsed-time
>integer elapsed-time ;
duration>seconds elapsed-time ;
M: timestamp elapsed-time
- now swap time- elapsed-time ;
+ ago elapsed-time ;
-! XXX: Anything up to 2 hours is "about an hour"
: relative-time-offset ( seconds -- string )
abs {
{ [ dup 1 < ] [ drop "just now" ] }
duration>seconds relative-time ;
M: timestamp relative-time
- now swap time- relative-time ;
+ ago relative-time ;