Add interactive terminal UI.term-ui

3 files changed, 81 insertions, 23 deletions

diff --git a/config.scm b/config.scm
new file mode 100644
index 00000000..3c6ebbb0
--- /dev/null
+++ b/config.scm
@@ -0,0 +1,12 @@
+;;; Preliminary config file for the system.
+;;; Currently loaded by main, and requires that `calendar-files`
+;;; is set to a list of files (or directories).
+
+
+(use-modules (srfi srfi-26)
+             (ice-9 ftw))
+
+(define calendar-files
+    (let ((path (string-append (getenv "HOME") "/.calendars/")))
+      (map (cut string-append path <>)
+           (scandir path (lambda (str) (not (char=? #\. (string-ref str 0))))))))
diff --git a/main.scm b/main.scm
index 7a33b06f..5bf8b6d2 100755
--- a/main.scm
+++ b/main.scm
@@ -6,31 +6,67 @@
 
 (use-modules (srfi srfi-19)
              (srfi srfi-19 util)
+             (srfi srfi-26)
+             (ice-9 format)
+             (util)
              (vcalendar)
              (vcalendar output)
-             (util))
-
-;;; This function borrowed from web-ics (calendar util) 
-(define* (sort* items comperator #:optional (get identity))
-  "A sort function more in line with how python's sorted works"
-  (sort items (lambda (a b)
-                (comperator (get a)
-                            (get b)))))
+             (terminal escape)
+             (terminal util))
 
 ;;; ------------------------------------------------------------
 
+#; (define pizza-event (search cal "pizza"))
+
+
+(define-public (event-in? ev time)
+  (in-day? (time-utc->date time)
+           (attr ev 'DTSTART)))
+
+(define (main-loop calendars)
+  (define time (date->time-utc (current-date)))
+  (let loop ((char #\nul))
+
+    (case char
+      ((#\L #\l) (set! time (add-day time)))
+      ((#\h #\H) (set! time (remove-day time))))
+
+    (cls)
+    (display-calendar-header! (time-utc->date time))
+    (line)
+
+    (let ((events
+           (sort* (concat
+                   (map (lambda (cal)
+                          (filter (cut event-in? <> time)
+                                  (children cal 'VEVENT)))
+                        calendars))
+                  time<? (extract "DTSTART"))))
+
+      (for-each-in events
+       (lambda (ev)
+         (format #t "~a~a | ~a | ~a~a~%"
+                 (color-escape (attr (parent ev) 'COLOR))
+                 (time->string (attr ev 'DTSTART) "~1 ~3") ; TODO show truncated string
+                 (string-pad-right (attr ev 'SUMMARY) 30) ; TODO show truncated string
+                 (or (attr ev 'LOCATION) "[INGEN LOKAL]")
+                 STR-RESET))))
+
+    ;; (format #t "c = ~c (~d)~%" char (char->integer char))
+
+    (unless (or (eof-object? char)
+                (memv char (list #\q (ctrl #\C))))
+      (loop (read-char (current-input-port))))))
+
+(load "config.scm")
+
 (define (main args)
-  (define path (cadr (append args '("testcal/repeating-event.ics"))))
-  (define cal (make-vcomponent path))
 
-  ;; Sort the events, and print a simple agenda.
-  (for-each-in (sort* (children cal 'VEVENT)
-                      time<? (extract "DTSTART"))
-               (lambda (ev) (format #t "~a | ~a~%"
-                               (let ((start (attr ev "DTSTART")))
-                                 (color-if (today? start) STR-YELLOW
-                                           (time->string start "~1 ~H:~M")))
-                               (attr ev "SUMMARY")))))
+  (define calendars (map make-vcomponent calendar-files))
+
+  (display calendar-files) (newline)
+
+  (with-vulgar
+   (lambda () (main-loop calendars))))
 
 
-  #; (define pizza-event (search cal "pizza"))
diff --git a/util.scm b/util.scm
index 54addb4c..672f1ddc 100644
--- a/util.scm
+++ b/util.scm
@@ -3,7 +3,7 @@
   #:export (destructure-lambda let-multi fold-lists catch-let
                                for-each-in
                                define-quick-record define-quick-record!
-                               mod!)
+                               mod! sort*)
   #:replace (let*)
   )
 
@@ -12,7 +12,7 @@
 (define-public symbol-upcase (compose string->symbol string-upcase symbol->string))
 
 (define-public symbol-downcase (compose string->symbol string-downcase symbol->string))
-       
+
 (define-syntax destructure-lambda
   (syntax-rules ()
     ((_ expr-list body ...)
@@ -74,7 +74,7 @@
 ;;        [e 5])                           ; Regular
 ;;   (list e d c b a))
 ;; ;; => (5 4 3 2 1)
-;;; 
+;;;
 
 (define-syntax let*
   (syntax-rules ()
@@ -97,7 +97,7 @@
        (let* (rest ...)
          body ...))]
 
-    ;; SRFI-71 let-values 
+    ;; SRFI-71 let-values
     [(_ ((k k* ... values) rest ...) body ...)
      (call-with-values (lambda () values)
        (lambda (k k* ...)
@@ -109,3 +109,13 @@
 ;; Like set!, but applies a transformer on the already present value.
 (define-syntax-rule (mod! field transform-proc)
   (set! field (transform-proc field)))
+
+(define-public (concat lists)
+  (apply append lists))
+
+;;; This function borrowed from web-ics (calendar util)
+(define* (sort* items comperator #:optional (get identity))
+  "A sort function more in line with how python's sorted works"
+  (sort items (lambda (a b)
+                (comperator (get a)
+                            (get b)))))