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 31char-rename
parent
d015f028db
commit
4387da41d5
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
|
@ -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
|
|
@ -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 }
|
||||
}
|
Loading…
Reference in New Issue