diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-20 21:39:44 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-21 01:53:21 +0100 |
commit | ed287bf2e7c171fc74796af541316342d55a6e3b (patch) | |
tree | bebaf0e30dfc135224f24649c62b95d5e3b98591 | |
parent | Fix crash when day has 0 events. (diff) | |
download | calp-ed287bf2e7c171fc74796af541316342d55a6e3b.tar.gz calp-ed287bf2e7c171fc74796af541316342d55a6e3b.tar.xz |
Move time procedures from main to where they belong.
Diffstat (limited to '')
-rwxr-xr-x | main.scm | 39 | ||||
-rw-r--r-- | srfi/srfi-19/util.scm | 25 | ||||
-rw-r--r-- | vcalendar/datetime.scm | 20 |
3 files changed, 44 insertions, 40 deletions
@@ -12,6 +12,7 @@ (texinfo string-utils) ; string->wrapped-lines (util) (vcalendar) + (vcalendar datetime) (vcalendar output) (terminal escape) (terminal util)) @@ -25,44 +26,6 @@ #; (define pizza-event (search cal "pizza")) -;; A B C D ¬E -;; |s1| : |s2| : |s1| : |s2| : |s1| -;; | | : | | : | ||s2| : |s1|| | : | | -;; | ||s2| : |s1|| | : | || | : | || | : -;; | | : | | : | || | : | || | : |s2| -;; | | : | | : | | : | | : | | -(define (timespan-overlaps? s1-begin s1-end s2-begin s2-end) - "Return whetever or not two timespans overlap." - (or - ;; A - (and (time<=? s2-begin s1-end) - (time<=? s1-begin s2-end)) - - ;; B - (and (time<=? s1-begin s2-end) - (time<=? s2-begin s1-end)) - - ;; C - (and (time<=? s1-begin s2-begin) - (time<=? s2-end s1-end)) - - ;; D - (and (time<=? s2-begin s1-begin) - (time<=? s1-end s2-end)))) - -(define (event-overlaps? event begin end) - "Returns if the event overlaps the timespan. -Event must have the DTSTART and DTEND attribute set." - (timespan-overlaps? (attr event 'DTSTART) - (attr event 'DTEND) - begin end)) - -(define-public (event-in? ev time) - (let* ((date (time-utc->date time)) - (start (date->time-utc (drop-time date))) - (end (add-duration start (make-duration (* 60 60 24))))) - (event-overlaps? ev start end))) - (define (trim-to-width str len) (let ((trimmed (string-pad-right str len))) (if (< (string-length trimmed) diff --git a/srfi/srfi-19/util.scm b/srfi/srfi-19/util.scm index 2ec7140d..f1346f78 100644 --- a/srfi/srfi-19/util.scm +++ b/srfi/srfi-19/util.scm @@ -56,3 +56,28 @@ attribute set to 0. Can also be seen as \"Start of day\"" (define (remove-day time) (add-duration time (make-time time-duration 0 (- (* 60 60 24))))) + +;; A B C D ¬E +;; |s1| : |s2| : |s1| : |s2| : |s1| +;; | | : | | : | ||s2| : |s1|| | : | | +;; | ||s2| : |s1|| | : | || | : | || | : +;; | | : | | : | || | : | || | : |s2| +;; | | : | | : | | : | | : | | +(define-public (timespan-overlaps? s1-begin s1-end s2-begin s2-end) + "Return whetever or not two timespans overlap." + (or + ;; A + (and (time<=? s2-begin s1-end) + (time<=? s1-begin s2-end)) + + ;; B + (and (time<=? s1-begin s2-end) + (time<=? s2-begin s1-end)) + + ;; C + (and (time<=? s1-begin s2-begin) + (time<=? s2-end s1-end)) + + ;; D + (and (time<=? s2-begin s1-begin) + (time<=? s1-end s2-end)))) diff --git a/vcalendar/datetime.scm b/vcalendar/datetime.scm index 9f47f5c3..360b8348 100644 --- a/vcalendar/datetime.scm +++ b/vcalendar/datetime.scm @@ -1,14 +1,16 @@ (define-module (vcalendar datetime) + #:use-module (vcalendar) #:use-module (srfi srfi-19) #:use-module (srfi srfi-19 util) - #:export (parse-datetime) + #:export (parse-datetime + event-overlaps? + event-in?) ) (define (parse-datetime dtime) "Parse the given date[time] string into a date object." ;; localize-date - (date->time-utc (string->date dtime @@ -16,3 +18,17 @@ ((8) "~Y~m~d") ((15) "~Y~m~dT~H~M~S") ((16) "~Y~m~dT~H~M~S~z"))))) + +(define (event-overlaps? event begin end) + "Returns if the event overlaps the timespan. +Event must have the DTSTART and DTEND attribute set." + (timespan-overlaps? (attr event 'DTSTART) + (attr event 'DTEND) + begin end)) + +(define (event-in? ev time) + "Does event overlap the date that contains time." + (let* ((date (time-utc->date time)) + (start (date->time-utc (drop-time date))) + (end (add-duration start (make-duration (* 60 60 24))))) + (event-overlaps? ev start end))) |