aboutsummaryrefslogtreecommitdiff
path: root/module/output/terminal.scm
blob: bbe7f04100e935ee1a4fdb54671ffe0a72d2a3ad (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
129
130
131
132
(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 height 0)
  (define width 0)
  (let* ((h w (get-terminal-size)))
    (set! height h
          width w))

  (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))))))