aboutsummaryrefslogtreecommitdiff
path: root/module/output/terminal.scm
blob: bfe5d2abe0433320c1008594e8b23fa02e46faa8 (plain)
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
128
(define-module (output terminal)
  #:use-module (output general)
  #:use-module (output text)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (srfi srfi-19 util)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-41)
  #:use-module (srfi srfi-41 util)
  #:use-module (util)
  #:use-module (terminal escape)
  #:use-module (terminal util)
  #:use-module (vcomponent output)

  #:use-module (vcomponent)
  #:use-module (vcomponent datetime)

  #:use-module (ice-9 format)
  #:use-module (ice-9 getopt-long)
  #:use-module (parameters)
  #:use-module (config)

  #:export (terminal-main))

(define (box-top intersection line . lengths)
  (reduce (lambda (str done) (string-append done (string intersection) str))
          "" (map (cut make-string <> line) lengths)))

(define* (display-event-table events #:key
                              (cur-event -1)
                              (summary-width 30)
                              (location-width 20))
 (for-each
  (lambda (ev i)
    (format #t "~a │ ~a~a~a~a │ ~a~a~a~%"
            (time->string (attr ev 'DTSTART) "~1 ~3") ; TODO show truncated string
            (if (= i cur-event) "\x1b[7m" "")
            (color-escape (attr (parent ev) 'COLOR))
            ;; Summary filter is a hook for the user
            (trim-to-width ((summary-filter) ev (attr ev 'SUMMARY)) summary-width)
            STR-RESET
            (if (attr ev 'LOCATION) "" "\x1b[1;30m")
            (trim-to-width
             (or (attr ev 'LOCATION) "INGEN LOKAL") location-width)
            STR-RESET))
  events
  (iota (length events))))

(define (displayln a)
  (display a) (newline))

(define (main-loop time event-stream)
  (define cur-event 0)

  (define-values (height width) (get-terminal-size))

  (while #t
    (let ((events
           (stream->list
            (filter-sorted-stream
             (cut event-in? <> time)
             event-stream))))

      (cls)
      (display-calendar-header! (time-utc->date time))

      (let* ((date-width 20)
             (location-width 15)
             (summary-width (- width date-width location-width 6)))
        (displayln
         (box-top #\┬ #\─ date-width (+ summary-width 2) (1+ location-width)))
        (display-event-table
         events
         #:cur-event cur-event
         #:location-width location-width
         #:summary-width summary-width)
        (displayln
         (box-top #\┴ #\─ date-width (+ summary-width 2) (1+ location-width))))

      (unless (null? events)
        (let ((ev (list-ref events cur-event)))
          (format #t "~a~%~a~%~aStart: ~a	Slut: ~a~%~%~a~%"
                  (attr ev 'X-HNH-FILENAME)
                  (attr ev 'SUMMARY)
                  (or (and=> (attr ev 'LOCATION) (cut string-append "Plats: " <> "\n")) "")
                  (time->string (attr ev 'DTSTART) "~1 ~3")
                  (time->string (attr ev 'DTEND) "~1 ~3")
                  (unlines (take-to (flow-text (or (attr ev 'DESCRIPTION) "")
                                               #:width (min 70 width))
                                    (- height 8 2 (length events) 5))))))

      (let ((char (read-char)))
        ;; (format (current-error-port)
        ;;         "c = ~c (~d)~%" char (char->integer char))
        (case char
          ((#\L #\l)
           (set! time (add-day time)
                 cur-event 0))
          ((#\h #\H)
           (set! time (remove-day time)
                 cur-event 0))
          ((#\t)
           (set! time (date->time-utc (current-date))
                 cur-event 0))
          ((#\j #\J) (unless (= cur-event (1- (length events)))
		       (mod! cur-event 1+)))
          ((#\k #\K) (unless (= cur-event 0)
		       (mod! cur-event 1-)))
          ((#\p) (print-vcomponent (list-ref events cur-event)
                                   (current-error-port)))
	  ((#\g) (set! cur-event 0))
	  ((#\G) (set! cur-event (1- (length events)))))

        (when (or (eof-object? char)
                  (memv char (list #\q (ctrl #\C))))
          (break)))
      )))

(define options
  '((date (value #t) (single-char #\d))))

(define (terminal-main calendars events args)
  (let ((opts (getopt-long args options)))
    (let ((time (date->time-utc
                 (or (and=> (option-ref opts 'date #f) parse-freeform-date)
                     (current-date)))))
      (with-vulgar
       (lambda () (main-loop time events))))))