tools.cal: adding the "cal" utility.

Example usage:
$ ./factor -run=tools.cal
    August 2016
Su Mo Tu We Th Fr Sa
    1  2  3  4  5  6
 7  8  9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31

diff --git a/extra/tools/cal/authors.txt b/extra/tools/cal/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/tools/cal/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/tools/cal/cal.factor b/extra/tools/cal/cal.factor
new file mode 100644 (file)
index 0000000..c0be27e
--- /dev/null
+++ b/extra/tools/cal/cal.factor
@@ -0,0 +1,62 @@
+! Copyright (C) 2016 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: accessors calendar combinators command-line formatting
+grouping io kernel math.parser math.ranges namespaces sequences
+sequences.extras strings.tables ;
+
+IN: tools.cal
+
+<PRIVATE
+
+: days ( timestamp -- days )
+    beginning-of-month
+    [ day-of-week "  " <repetition> ]
+    [ days-in-month [1,b] [ "%2d" sprintf ] map ] bi append
+    42 "  " pad-tail ;
+
+: month-header ( timestamp -- str )
+    [ month-name ] [ year>> ] bi "%s %s" sprintf
+    20 CHAR: \s pad-center ;
+
+: year-header ( timestamp -- str )
+    year>> "%s" sprintf 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
+    ] [
+        dup first {
+            { "-m" [ rest ?first2 swap f ] }
+            { "-y" [ rest ?first2 dup [ swap ] when t ] }
+            [ drop ?first2 dup [ swap ] when dup not ]
+        } case [
+            [ string>number ] bi@
+            [ [ >>year ] when* ]
+            [ [ >>month ] when* ] bi*
+        ] dip
+    ] if-empty ;
+
+PRIVATE>
+
+: run-cal ( -- )
+    cal-args [ year. ] [ month. ] if ;
+
+MAIN: run-cal

diff --git a/extra/tools/cal/deploy.factor b/extra/tools/cal/deploy.factor
new file mode 100644 (file)
index 0000000..2e49fb1
--- /dev/null
+++ b/extra/tools/cal/deploy.factor
@@ -0,0 +1,15 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-name "cal" }
+    { deploy-ui? f }
+    { deploy-c-types? f }
+    { deploy-console? t }
+    { deploy-unicode? f }
+    { "stop-after-last-window?" t }
+    { deploy-io 3 }
+    { deploy-reflection 6 }
+    { deploy-word-props? f }
+    { deploy-math? t }
+    { deploy-threads? t }
+    { deploy-word-defs? f }
+}