]> gitweb.factorcode.org Git - factor.git/commitdiff
calendar.format: format year. in 3 columns, use in tools.cal.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 10 Dec 2020 22:26:58 +0000 (14:26 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 10 Dec 2020 22:26:58 +0000 (14:26 -0800)
basis/calendar/format/format.factor
extra/tools/cal/cal.factor

index 617fff66f86770cf0cad5259f7aacad145c05abe..440c4aeed5c201a77ba638d0fb0026db03c6e948 100644 (file)
@@ -1,8 +1,9 @@
 ! 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 )
@@ -63,18 +64,29 @@ M: integer day.
 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. ;
@@ -82,7 +94,13 @@ M: timestamp 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. ;
 
index 5554aa866a0a8823c077e2c8e690c94f431b0533..5fce897dd31ee8a7dcd73947e65d893f833b629e 100644 (file)
@@ -1,41 +1,10 @@
 ! 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
@@ -51,8 +20,6 @@ PRIVATE>
         ] dip
     ] if-empty ;
 
-PRIVATE>
-
 : run-cal ( -- )
     cal-args [ year. ] [ month. ] if ;