extra/tools/cal/cal.factor

   1 ! Copyright (C) 2016 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3 USING: accessors calendar combinators command-line
   4 formatting grouping io kernel math.parser math.ranges namespaces
   5 sequences sequences.extras strings.tables ;
   6 IN: tools.cal
   7
   8 <PRIVATE
   9
  10 : days ( timestamp -- days )
  11     beginning-of-month
  12     [ day-of-week "  " <repetition> ]
  13     [ days-in-month [1,b] [ "%2d" sprintf ] map ] bi append
  14     42 "  " pad-tail ;
  15
  16 : month-header ( timestamp -- str )
  17     "%B %Y" strftime
  18     20 CHAR: \s pad-center ;
  19
  20 : year-header ( timestamp -- str )
  21     "%Y" strftime 64 CHAR: \s pad-center ;
  22
  23 : month-rows ( timestamp -- rows )
  24     days 7 group day-abbreviations2 prefix format-table ;
  25
  26 PRIVATE>
  27
  28 : month. ( timestamp -- )
  29     [ month-header print ] [ month-rows [ print ] each ] bi ;
  30
  31 : year. ( timestamp -- )
  32     dup year-header print nl 12 [1,b] [
  33         >>month [ month-rows ] [ month-name ] bi
  34         20 CHAR: \s pad-center prefix
  35     ] with map 3 group
  36     [ first3 [ "%s  %s  %s\n" printf ] 3each ] each ;
  37
  38 <PRIVATE
  39
  40 : cal-args ( -- timestamp year? )
  41     now command-line get [
  42         f
  43     ] [
  44         dup first {
  45             { "-m" [ rest ?first2 swap f ] }
  46             { "-y" [ rest ?first2 dup [ swap ] when t ] }
  47             [ drop ?first2 dup [ swap ] when dup not ]
  48         } case [
  49             [ string>number ] bi@
  50             [ [ >>year ] when* ]
  51             [ [ >>month ] when* ] bi*
  52         ] dip
  53     ] if-empty ;
  54
  55 PRIVATE>
  56
  57 : run-cal ( -- )
  58     cal-args [ year. ] [ month. ] if ;
  59
  60 MAIN: run-cal