! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays calendar calendar.english combinators
-formatting io io.streams.string kernel make math math.parser
-math.parser.private present quotations sequences words ;
+formatting grouping io io.streams.string kernel make math
+math.order math.parser math.parser.private math.ranges present
+quotations sequences splitting strings words ;
IN: calendar.format
MACRO: formatted ( spec -- quot )
M: timestamp day.
day>> day. ;
+<PRIVATE
+
+: center. ( str n -- )
+ over length [-] 2/ CHAR: \s <string> write print ;
+
+: month-header. ( year month -- )
+ [ number>string ] [ month-name ] bi* swap " " glue 20 center. ;
+
+: days-header. ( -- )
+ day-abbreviations2 " " join print ;
+
+: days. ( year month -- )
+ [ 1 zeller-congruence dup [ " " write ] times ]
+ [ (days-in-month) ] 2bi [1,b] [
+ [ day. ] [ + 7 mod zero? [ nl ] [ bl ] if ] bi
+ ] with each nl ;
+
+PRIVATE>
+
GENERIC: month. ( obj -- )
M: array month.
- first2
- [ month-name write bl number>string print ]
- [ 1 zeller-congruence ]
- [ (days-in-month) day-abbreviations2 " " join print ] 2tri
- over " " <repetition> "" concat-as write
- [
- [ 1 + day. ] keep
- 1 + + 7 mod zero? [ nl ] [ bl ] if
- ] with each-integer nl ;
+ first2 [ month-header. ] [ days-header. days. ] 2bi ;
M: timestamp month.
[ year>> ] [ month>> ] bi 2array month. ;
GENERIC: year. ( obj -- )
M: integer year.
- 12 [ 1 + 2array month. nl ] with each-integer ;
+ 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 map 3 <groups>
+ [ first3 [ "%-20s %-20s %-20s\n" printf ] 3each ] each ;
M: timestamp year. year>> year. ;
! Copyright (C) 2016 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: accessors calendar calendar.english combinators
-command-line formatting grouping io kernel math.parser
-math.ranges namespaces sequences sequences.extras strings.tables ;
+USING: accessors calendar calendar.format combinators
+command-line kernel math.parser namespaces sequences
+sequences.extras ;
IN: tools.cal
-<PRIVATE
-
-: days ( timestamp -- days )
- start-of-month
- [ day-of-week " " <repetition> ]
- [ days-in-month [1,b] [ "%2d" sprintf ] map ] bi append
- 42 " " pad-tail ;
-
-: month-header ( timestamp -- str )
- "%B %Y" strftime 20 CHAR: \s pad-center ;
-
-: year-header ( timestamp -- str )
- "%Y" strftime 64 CHAR: \s pad-center ;
-
-: month-rows ( timestamp -- rows )
- days 7 group day-abbreviations2 prefix format-table ;
-
-PRIVATE>
-
-: month. ( timestamp -- )
- [ month-header print ] [ month-rows [ print ] each ] bi ;
-
-: year. ( timestamp -- )
- dup year-header print nl 12 [1,b] [
- >>month [ month-rows ] [ month-name ] bi
- 20 CHAR: \s pad-center prefix
- ] with map 3 group
- [ first3 [ "%s %s %s\n" printf ] 3each ] each ;
-
-<PRIVATE
-
: cal-args ( -- timestamp year? )
now command-line get [
f
] dip
] if-empty ;
-PRIVATE>
-
: run-cal ( -- )
cal-args [ year. ] [ month. ] if ;