File: cal.ml

package info (click to toggle)
wyrd 1.4.6-4
  • links: PTS
  • area: main
  • in suites: buster, stretch
  • size: 1,820 kB
  • ctags: 1,969
  • sloc: ml: 11,059; sh: 5,531; ansic: 760; makefile: 304; python: 44
file content (127 lines) | stat: -rw-r--r-- 4,732 bytes parent folder | download | duplicates (3)
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
(*  Wyrd -- a curses-based front-end for Remind
 *  Copyright (C) 2005, 2006, 2007, 2008, 2010, 2011-2013 Paul Pelzl
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License, Version 2,
 *  as published by the Free Software Foundation.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 *  Bug reports can be entered at http://bugs.launchpad.net/wyrd .
 *  For anything else, feel free to contact Paul Pelzl at <pelzlpj@gmail.com>.
 *)

(* cal.ml
 * Because cal(1) cannot be relied upon to be uniform across various operating
 * systems (sigh), it seemed best to provide a generic calendar layout
 * algorithm. *)


open Utility

type t = {
   title    : string;
   weekdays : string;
   days     : string list;
   weeknums : string list
}


(* compute the ISO-8601 week number for the given day *)
let weeknum_of_tm day =
   let (_, normalized_day) = Unix.mktime day in
   (* iso weeks start on Monday *)
   let iso_wday = (normalized_day.Unix.tm_wday + 6) mod 7 in
   (* find Thursday of the same week *)
   let thurs = {normalized_day with
      Unix.tm_mday = normalized_day.Unix.tm_mday + 3 - iso_wday
   } in
   let (_, normalized_thurs) = Unix.mktime thurs in
   (* which Thursday of the year is it? *)
   (normalized_thurs.Unix.tm_yday / 7) + 1



(* Create a Cal.t data structure for the desired timestamp.  If
 * start_monday = true then the first day of the week will be
 * Monday. *)
let make timestamp start_monday =
   let tm = Unix.localtime timestamp in
   (* compute the weekday of the first day of the month *)
   let first_weekday =
      let temp = {tm with Unix.tm_mday = 1} in
      let (_, first) = Unix.mktime temp in
      first.Unix.tm_wday
   in
   (* compute the last day of the month *)
   let last_day = 
      let temp = {tm with Unix.tm_mday = 32} in
      let (_, nextmonth) = Unix.mktime temp in
      32 - nextmonth.Unix.tm_mday
   in
   (* generate the title *)
   let year_s    = string_of_int (tm.Unix.tm_year + 1900) in
   let mon_year  = (full_string_of_tm_mon tm.Unix.tm_mon) ^ " " ^ year_s in
   let pad_len   = (20 - (String.length mon_year)) / 2 in
   let cal_title = (String.make pad_len ' ') ^ mon_year in
   (* generate the weekday strings *)
   let rec build_weekdays wkd_str wd_num count =
      if count > 7 then
         wkd_str
      else
         build_weekdays (wkd_str ^ " " ^ (short_string_of_tm_wday wd_num)) 
            ((succ wd_num) mod 7) (succ count)
   in
   let week_start_day = if start_monday then 1 else 0 in
   let cal_weekdays = build_weekdays (short_string_of_tm_wday week_start_day)
       ((succ week_start_day) mod 7) 2
   in
   (* generate the days of the month *)
   let rec build_monthdays weeks_list week_str weeknum_list mday wday =
      if mday > last_day then
         let weeknum_str = 
            let last_weekday = {tm with Unix.tm_mday = pred mday} in
            let weeknum = weeknum_of_tm last_weekday in
            Printf.sprintf "%2d" weeknum
         in
         (List.rev (week_str :: weeks_list), List.rev (weeknum_str :: weeknum_list))
      else
         if wday = week_start_day then
            let weeknum_str = 
               let last_weekday = {tm with Unix.tm_mday = pred mday} in
               let weeknum = weeknum_of_tm last_weekday in
               Printf.sprintf "%2d" weeknum
            in
            build_monthdays (week_str :: weeks_list) (Printf.sprintf "%2d" mday)
               (weeknum_str :: weeknum_list) (succ mday) ((succ wday) mod 7)
         else
            build_monthdays weeks_list (week_str ^ (Printf.sprintf " %2d" mday))
               weeknum_list (succ mday) ((succ wday) mod 7)
   in
   (* create the padding for the first few empty days of the calendar *)
   let padding =
      if first_weekday >= week_start_day then
         String.make ((first_weekday - week_start_day) * 3) ' '
      else
         String.make ((first_weekday + 7 - week_start_day) * 3) ' '
   in
   let (cal_monthdays, cal_weeknums) = 
      build_monthdays [] (padding ^ " 1") [] 2 ((succ first_weekday) mod 7)
   in {
      title    = cal_title;
      weekdays = cal_weekdays;
      days     = cal_monthdays;
      weeknums = cal_weeknums
   }



      
(* arch-tag: DO_NOT_CHANGE_4909df7f-9801-448d-9030-fb4b0232408d *)