From 89a657ed98e70efaeef566b0876b406bbcdb2255 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 4 Aug 2020 13:35:52 +0200 Subject: Start work on long event layout for months. --- module/datetime.scm | 4 +-- module/output/html.scm | 66 ++++++++++++++++++++++++++++-------------- module/vcomponent/datetime.scm | 11 ++++++- static/style.css | 50 ++++++++++++++++++++++++++++++-- 4 files changed, 105 insertions(+), 26 deletions(-) diff --git a/module/datetime.scm b/module/datetime.scm index fdab2fe6..1141aa64 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -554,10 +554,10 @@ ;; Returns a list of all dates from start to end. ;; both inclusive ;; date, date → [list date] -(define-public (date-range start end) +(define*-public (date-range start end optional: (increment (date day: 1))) (stream->list (stream-take-while (lambda (d) (date<= d end)) - (day-stream start)))) + (date-stream increment start)))) ;;; Output diff --git a/module/output/html.scm b/module/output/html.scm index 167ae78d..a92299d8 100644 --- a/module/output/html.scm +++ b/module/output/html.scm @@ -451,35 +451,58 @@ ;; (stream event-group) -> sxml (define*-public (render-calendar-table key: events start-date end-date pre-start post-end #:allow-other-keys) - (define event-groups (get-groups-between (group-stream events) - pre-start post-end)) + (define-values (long-events short-events) + (partition really-long-event? (stream->list (events-between pre-start post-end events)))) + + (define short-event-groups + (get-groups-between (group-stream (list->stream short-events)) + pre-start post-end)) `((header (@ (class "table-head")) ,(string-titlecase (date->string start-date "~B ~Y"))) (div (@ (class "caltable")) ,@(map (lambda (d) `(div (@ (class "thead")) ,(string-titlecase (week-day-name d)))) (weekday-list (get-config 'week-start))) + ,@(map (lambda (d i) + (define e (date+ d (date day: 6))) + `(div (@ (class "cal-cell cal-cell-long") + (style "grid-area: long " ,i ";" + "grid-column: 1 / span 7;")) + ,@(lay-out-long-events + d e (stream->list + (events-between d e (list->stream long-events)))))) + (date-range pre-start post-end (date day: 7)) + ;; date range limits, 100 ≫ days in month + (iota 100 1)) + ,@(map (lambda (day-date i) + `(div (@ (style "grid-area:time " ,(floor i)) + (class "cal-cell cal-cell-time")) + (time (@ (class "date-info " + ,(if (or (date< day-date start-date) + (date< end-date day-date)) + "non-current" + "current")) + (datetime ,(date->string day-date "~1"))) + (span (@ (class "day-number")) + ,(date->string day-date "~e")) + ,(when (= 1 (day day-date)) + `(span (@ (class "month-name")) + ,(date->string day-date "~b"))) + ,(when (= 1 (month day-date) (day day-date)) + `(span (@ (class "year-number")) + ", " ,(date->string day-date "~Y")))))) + (date-range pre-start post-end) + (iota (length (date-range pre-start post-end)) 1 1/7)) + ,@(stream->list (stream-map - (match-lambda - [(day-date . events) - `(div (@ (class "cal-cell")) - (time (@ (class "date-info " - ,(if (or (date< day-date start-date) - (date< end-date day-date)) - "non-current" - "current")) - (datetime ,(date->string day-date "~1"))) - (span (@ (class "day-number")) - ,(date->string day-date "~e")) - ,(when (= 1 (day day-date)) - `(span (@ (class "month-name")) - ,(date->string day-date "~b"))) - ,(when (= 1 (month day-date) (day day-date)) - `(span (@ (class "year-number")) - ", " ,(date->string day-date "~Y")))) + (match-lambda* + [((day-date . events) i) + `(div (@ (style "grid-area:short " ,(floor (/ i 7))) + (class "cal-cell cal-cell-short")) ,@(stream->list (stream-map make-small-block events)))]) - event-groups))))) + short-event-groups + (stream-from 1)))))) @@ -601,7 +624,8 @@ (error 'html-generate "Prev-start needs to be a procedure")) ;; (display "\n") - ((@ (sxml simple) sxml->xml) + (;;(@ (ice-9 pretty-print) pretty-print) + (@ (sxml simple) sxml->xml) `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"UTF-8\"") ;; "" diff --git a/module/vcomponent/datetime.scm b/module/vcomponent/datetime.scm index 3f81c359..faeae70a 100644 --- a/module/vcomponent/datetime.scm +++ b/module/vcomponent/datetime.scm @@ -122,6 +122,15 @@ Event must have the DTSTART and DTEND protperty set." (datetime-difference it (prop ev 'DTSTART))) #f))) +(define-public (really-long-event? ev) + (let ((start (prop ev 'DTSTART)) + (end (prop ev 'DTEND))) + (if (date? start) + (and end (date< (date+ start (date day: 1)) end)) + (and end + (datetime< (datetime date: (date day: 1)) + (datetime-difference end start)))))) + ;; DTEND of the last instance of this event. ;; event → (or datetime #f) @@ -136,7 +145,7 @@ Event must have the DTSTART and DTEND protperty set." (as-datetime final)) #f)))) -;; date, date, [sorted-stream events] → [list events] +;; date, date, [sorted-stream events] → [sorted-stream events] (define-public (events-between start-date end-date events) (define (overlaps e) (timespan-overlaps? start-date (date+ end-date (date day: 1)) diff --git a/static/style.css b/static/style.css index 793ed366..f1bdc6fb 100644 --- a/static/style.css +++ b/static/style.css @@ -323,8 +323,9 @@ along with their colors. /* This is for the first name, the week days. NOTE that I'm not sure this is actually the correct way to do it. */ - grid-template-rows: 2em; - grid-auto-rows: 1fr; + /* grid-template-rows: 2em; */ + /* grid-auto-rows: 1fr; */ + grid-template-rows: 2em repeat(6, [time] 15pt [long] 1fr [short] 1fr); max-height: 100%; /* Apparently needed to ensure that parent can contain all its children */ @@ -343,8 +344,48 @@ along with their colors. border: 1px solid var(--gray); } +.caltable .cal-cell-time { + border-bottom: none; +} + +.caltable .cal-cell-short { + border-top: none +} + +.caltable .cal-cell-long .event { + margin: 0; + /* TODO use other border rules */ + border: 1px solid black; +} + +.caltable .cal-cell-long .continuing { + border-radius: 1cm 0 0 1cm; +} + +.caltable .cal-cell-long .continued { + border-radius: 0 1cm 1cm 0; +} + +.caltable .cal-cell-long .continuing.continued { + border-radius: 0; +} + +.caltable .cal-cell-long { + border-bottom: none; + border-top: none; + position: relative; +} + +.caltable .cal-cell-long .event { + position: absolute; + box-sizing: border-box; + padding: 0; +} + .caltable .cal-cell { overflow-y: auto; + /* for long events */ + overflow-x: hidden; } .cal-cell .event { @@ -355,11 +396,16 @@ along with their colors. font-family: arial; } + .date-info .day-number { font-size: 150%; padding: 2pt; } +.caltable .day-number { + font-size: initial; +} + .date-info.current .day-number { color: black; } -- cgit v1.2.3