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
char-rename
John Benediktsson 2016-08-03 11:28:28 -07:00
parent d015f028db
commit 4387da41d5
3 changed files with 78 additions and 0 deletions

View File

@ -0,0 +1 @@
John Benediktsson

View File

@ -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

View File

@ -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 }
}