From 029c2233e35a81e50154a1caedfe0041af9fb8b9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Fri, 14 Feb 2020 00:01:25 +0100
Subject: Fix event-length/day.

---
 module/output/html.scm         | 11 ++++++-----
 module/vcomponent/datetime.scm | 22 ++++++++++++++++++----
 2 files changed, 24 insertions(+), 9 deletions(-)

(limited to 'module')

diff --git a/module/output/html.scm b/module/output/html.scm
index 4bb12b45..f30e6338 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -39,7 +39,7 @@
 
 ;; Takes a list of vcomponents, sets their widths and x-positions to optimally
 ;; fill out the space, without any overlaps.
-(define (fix-event-widths! start-of-day lst)
+(define (fix-event-widths! date lst)
   ;; The tree construction is greedy. This means
   ;; that if  a smaller  event preceeds a longer
   ;; event it would capture  the longer event to
@@ -49,7 +49,8 @@
   ;; @var{x} is how for left in the container we are.
   (let inner ((x 0)
               (tree (make-tree overlapping?
-                               (sort* lst time>? (lambda (e) (event-length/day e))))))
+                               (sort* lst time>?
+                                      (lambda (e) (event-length/day date e))))))
     (unless (null? tree)
       (let ((w (/ (- 1 x)
                   (+ 1 (length-of-longst-branch (left-subtree tree))))))
@@ -89,7 +90,7 @@
                 0)
 
             ;; height
-            (* 100/24 (time->decimal-hour (event-length/day ev)))))
+            (* 100/24 (time->decimal-hour (event-length/day date ev)))))
 
   `(a (@ (href "#" ,(UID ev))
          (class "hidelink"))
@@ -126,8 +127,8 @@
     (format (current-error-port) "long=~a, short=~a~%"
             (length long-events)
             (length short-events))
-    (fix-event-widths! time-obj short-events)
-    (fix-event-widths! time-obj long-events)
+    (fix-event-widths! date short-events)
+    (fix-event-widths! date long-events)
     `(div (@ (class "day"))
           (div (@ (class "meta"))
                ,(let ((str (date-link date)))
diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm
index 765c065d..016eeaac 100644
--- a/module/vcomponent/datetime.scm
+++ b/module/vcomponent/datetime.scm
@@ -54,10 +54,24 @@ Event must have the DTSTART and DTEND attribute set."
 ;; starting at the time @var{start-of-day}.
 ;; currently the secund argument is a date, but should possibly be changed
 ;; to a datetime to allow for more explicit TZ handling?
-(define-public (event-length/day e)
-  (time-
-   (time-min #00:00:00 (as-time (attr e 'DTEND)))
-   (time-max #24:00:00 (as-time (attr e 'DTSTART)))))
+(define-public (event-length/day date e)
+  ;; TODO date= > 2 elements
+  (cond [(and (date= (as-date (attr e 'DTSTART))
+                 (as-date (attr e 'DTEND)))
+              (date= (as-date (attr e 'DTSTART))
+                     date))
+         (time- (as-time (attr e 'DTEND))
+                (as-time (attr e 'DTSTART)))]
+        ;; Starts today, end in future day
+        [(date= (as-date (attr e 'DTSTART))
+                date)
+         (time- #24:00:00 (as-time (attr e 'DTSTART)))]
+        ;; Ends today, start earlier day
+        [(date= (as-date (attr e 'DTEND))
+                date)
+         (as-time (attr e 'DTEND))]
+        ;; start earlier date, end later date
+        [else #24:00:00]))
 
 
 ;; 22:00 - 03:00
-- 
cgit v1.2.3