From dd8ead6d143983ca6b772f0502fe77b708bfebe3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Mon, 22 Apr 2019 19:42:34 +0200
Subject: Fix events spanning over multiple days.

---
 module/html/html.scm         | 49 +++++++++++++++++++++++++++++++++++---------
 module/srfi/srfi-19/util.scm |  4 ++--
 static/style.css             | 18 ++++++++++++++++
 3 files changed, 59 insertions(+), 12 deletions(-)

diff --git a/module/html/html.scm b/module/html/html.scm
index bb964963..e9628424 100644
--- a/module/html/html.scm
+++ b/module/html/html.scm
@@ -62,20 +62,49 @@ never on absolute times. For that see date->decimal-hour"
   (define cs (char-set-adjoin char-set:letter+digit #\- #\_))
   (string-filter (lambda (c) (char-set-contains? cs c)) str))
 
-(define (vevent->sxml ev)
+(define (vevent->sxml day ev)
+  (define time (date->time-utc day))
   (define style
-    (format #f "top: ~,3f%; height: ~,3f%; width: ~,3f%; left: ~,3f%"
+    (format #f "top: ~,3f%;  left: ~,3f%; height: ~,3f%; width: ~,3f%;"
+            ;; top
+            (if (in-day? day (attr ev 'DTSTART))
+                (* (/ 24) 100
+                   (time->decimal-hour
+                    (time-difference (attr ev 'DTSTART)
+                                     (start-of-day* (attr ev 'DTSTART)))))
+                0)
+
+            ;; left
+            (* 100 (width ev) (x-pos ev))
+
+            ;; height
             (* (/ 24) 100
                (time->decimal-hour
-                (time-difference (attr ev 'DTSTART)
-                                 (start-of-day* (attr ev 'DTSTART)))))
-            (* (/ 24) 100
-               (time->decimal-hour (time-difference (attr ev 'DTEND)
-                                                    (attr ev 'DTSTART))))
+                (if (in-day? day (attr ev 'DTEND))
+                    (if (in-day? day (attr ev 'DTSTART))
+                        ;; regular
+                        (time-difference (attr ev 'DTEND)
+                                         (attr ev 'DTSTART))
+                        ;; end today, start later
+                        (time-difference (attr ev 'DTEND)
+                                         time))
+                    (if (in-day? day (attr ev 'DTSTART))
+                        ;; end today, start earlier
+                        (time-difference (add-day time)
+                                         (attr ev 'DTSTART))
+                        ;; start earlier, end earlier
+                        (time-difference (add-day time)
+                                         time)))))
+
+            ;; width
             (* 100 (width ev))
-            (* 100 (width ev) (x-pos ev))))
+            ))
   `(div (@ (class "event CAL_" ,(html-attr (let ((l (attr (parent ev) 'NAME)))
-                                         (if (pair? l) (car l) l))))
+                                             (if (pair? l) (car l) l)))
+             ,(if (time<? (attr ev 'DTSTART) time)
+                  " continued" "")
+             ,(if (time<? (add-day time) (attr ev 'DTEND))
+                  " continuing" ""))
            (style ,style))
         ,(attr ev 'SUMMARY)))
 
@@ -89,7 +118,7 @@ never on absolute times. For that see date->decimal-hour"
                (span (@ (class "daydate")) ,(date->string date "~Y-~m-~d")))
           (div (@ (class "events"))
                " "
-               ,@(stream->list (stream-map vevent->sxml events))))))
+               ,@(stream->list (stream-map (lambda (e) (vevent->sxml date e)) events))))))
 
 
 (define (time-marker-div)
diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm
index 551f5a12..e2a98c42 100644
--- a/module/srfi/srfi-19/util.scm
+++ b/module/srfi/srfi-19/util.scm
@@ -101,8 +101,7 @@ attribute set to 0. Can also be seen as \"Start of day\""
    (lambda (d)
      (set! (day d) (1+ (day d)))
      (normalize-date d))
-   (#; drop-time identity start-day
-                )))
+   (drop-time start-day)))
 
 (define-public (in-date-range? start-date end-date)
   (format (current-error-port) "Start: ~a~%End: ~a~%"
@@ -112,3 +111,4 @@ attribute set to 0. Can also be seen as \"Start of day\""
       (timespan-overlaps?
        (date->time-utc start-date) (date->time-utc end-date)
        time time))))
+
diff --git a/static/style.css b/static/style.css
index 1a98358b..45574f0f 100644
--- a/static/style.css
+++ b/static/style.css
@@ -80,6 +80,24 @@ body {
 	z-index: 0;
 }
 
+.event.continuing {
+	border-bottom: none;
+	background-image: linear-gradient(to top, #fefcea 0%,#FFF0 20%);
+}
+
+.event.continued {
+	border-top: none;
+	background-image: linear-gradient(to bottom, #fefcea 0%,#FFF0 20%);
+}
+
+.event.continued.continuing {
+	border-top: none;
+	border-top: bottom;
+	background-image:
+		linear-gradient(to bottom, #fefcea 0%, #FFF0   20%,
+		                           #FFF0  80%, #fefcea 100%);
+}
+
 .selected {
 	width: 100% !important;
 	left: 0 !important;
-- 
cgit v1.2.3