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 calendar.english combinators
   4 command-line formatting grouping io kernel math.parser
   5 math.ranges namespaces sequences sequences.extras strings.tables ;
   6 IN: tools.cal
   7
   8 <PRIVATE
   9
  10 : days ( timestamp -- days )
  11     start-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 20 CHAR: \s pad-center ;
  18
  19 : year-header ( timestamp -- str )
  20     "%Y" strftime 64 CHAR: \s pad-center ;
  21
  22 : month-rows ( timestamp -- rows )
  23     days 7 group day-abbreviations2 prefix format-table ;
  24
  25 PRIVATE>
  26
  27 : month. ( timestamp -- )
  28     [ month-header print ] [ month-rows [ print ] each ] bi ;
  29
  30 : year. ( timestamp -- )
  31     dup year-header print nl 12 [1,b] [
  32         >>month [ month-rows ] [ month-name ] bi
  33         20 CHAR: \s pad-center prefix
  34     ] with map 3 group
  35     [ first3 [ "%s  %s  %s\n" printf ] 3each ] each ;
  36
  37 <PRIVATE
  38
  39 : cal-args ( -- timestamp year? )
  40     now command-line get [
  41         f
  42     ] [
  43         dup first {
  44             { "-m" [ rest ?first2 swap f ] }
  45             { "-y" [ rest ?first2 dup [ swap ] when t ] }
  46             [ drop ?first2 dup [ swap ] when dup not ]
  47         } case [
  48             [ string>number ] bi@
  49             [ [ >>year ] when* ]
  50             [ [ >>month ] when* ] bi*
  51         ] dip
  52     ] if-empty ;
  53
  54 PRIVATE>
  55
  56 : run-cal ( -- )
  57     cal-args [ year. ] [ month. ] if ;
  58
  59 MAIN: run-cal