Time constraints

1 files changed, 107 insertions, 38 deletions

diff --git a/emacsconf-schedule.el b/emacsconf-schedule.el
index 23bdc86..c1534fa 100644
--- a/emacsconf-schedule.el
+++ b/emacsconf-schedule.el
@@ -110,8 +110,8 @@ Each function should take the info and manipulate it as needed, returning the ne
           info))
 
 (defun emacsconf-schedule-validate-and-summarize (schedule)
-  (let ((validation-results (emacsconf-validate-time-constraints schedule))
-        (sched (emacsconf-summarize-schedule schedule)))
+  (let ((validation-results (emacsconf-schedule-validate-time-constraints schedule))
+        (sched (emacsconf-schedule-summarize schedule)))
     (append
      (list (list (format "%d talks" (length (emacsconf-filter-talks arranged)))))
      (mapcar (lambda (o) (list nil nil nil nil nil o)) validation-results)
@@ -239,10 +239,7 @@ Each function should take the info and manipulate it as needed, returning the ne
             (emacsconf-filter-talks info)))))
 
 
-
-
-
-(defun emacsconf-summarize-track-as-svg (svg base-x base-y width height start-time end-time info &optional vertical)
+(defun emacsconf-schedule-svg-track (svg base-x base-y width height start-time end-time info &optional vertical)
   (let ((scale (/ (if vertical height width)
                   (float-time (time-subtract end-time start-time)))))
     (mapc
@@ -259,12 +256,18 @@ Each function should take the info and manipulate it as needed, returning the ne
              (title . ,(plist-get o :title)))
            (dom-node
             'rect
-            `((x . ,x)
-              (y . ,y)
+             `((x . ,x)
+               (y . ,y)
               (width . ,(if vertical width size))
               (height . ,(1- (if vertical size height)))
               (stroke . "black")
-              (fill . ,(if (plist-get o :invalid) "red" "gray"))))
+              (fill . ,(cond
+                        ((string-match "BREAK\\|LUNCH" (plist-get o :title)) nil)
+                        ((plist-get o :invalid) "red")
+                        ((string-match "EST"
+                                       (or (plist-get o :availability) ""))
+                         "lightgray")
+                        (t "lightgreen")))))
            (dom-node
             'g
             `((transform . ,(format "translate(%d,%d)"
@@ -277,51 +280,64 @@ Each function should take the info and manipulate it as needed, returning the ne
                (font-size . 10)
                (transform . "rotate(-90)"))
              (svg--encode-text (or (plist-get o :slug) (plist-get o :title)))))))))
-     (emacsconf-filter-talks info))))
-
-(defun emacsconf-summarize-schedule-as-svg (width height start end tracks &optional vertical)
-  (let* ((svg (svg-create width height :background "white"))
-         (track-width (if vertical (/ width (length tracks)) width))
-         (grid-margin 10)
-         (track-height (if vertical height (/ (- height grid-margin) (length tracks))))
-         (x 0) (y 0)
-         (scale (/ (if vertical height width)
-                   (float-time (time-subtract end start))))
+     info)))
+
+(defun emacsconf-schedule-svg-day (elem label width height start end tracks)
+  (let* ((label-margin 15)
+         (track-height (/ (- height (* 2 label-margin)) (length tracks)))
+         (x 0) (y label-margin)
+         (scale (/ width (float-time (time-subtract end start))))
          (time start))
-    (svg-rectangle svg 0 0 width height :fill "white")
+    (svg-rectangle elem 0 0 width height :fill "white")
+    (svg-text elem label :x 3 :y (- label-margin 3) :fill "black" :font-size "10")
+    (mapc (lambda (track)
+            (emacsconf-schedule-svg-track
+             elem x y width track-height
+             start end track)
+            (setq y (+ y track-height)))
+          tracks)
     ;; draw grid
     (while (time-less-p time end)
       (let ((x (* (float-time (time-subtract time start)) scale)))
         (dom-append-child
-         svg
+         elem
          (dom-node
           'g
-          `((transform . ,(format "translate(%d,0)" x)))
+          `((transform . ,(format "translate(%d,%d)" x label-margin)))
           (dom-node
            'line
-           `((stroke . "gray")
+           `((stroke . "lightgray")
              (x1 . 0)
              (y1 . 0)
              (x2 . 0)
-             (y2 . ,(- height grid-margin))))
+             (y2 . ,(- height label-margin label-margin))))
           (dom-node
            'text
-           `((fill . "gray")
+           `((fill . "darkgray")
              (x . 0)
-             (y . ,(- height 2))
-             (font-size . 5))
+             (y . ,(- height 2 label-margin))
+             (font-size . 10)
+             (text-anchor . "middle"))
            (svg--encode-text (format-time-string "%-l" time)))))
-        (setq time (time-add time (seconds-to-time 3600))))
-      
-      )
-    (mapc (lambda (track)
-            (emacsconf-summarize-track-as-svg
-             svg x y track-width track-height
-             start end track vertical)
-            (if vertical
-                (setq x (+ x track-width))
-              (setq y (+ y track-height))))
-          tracks)
+        (setq time (time-add time (seconds-to-time 3600)))))
+    elem))
+
+(defun emacsconf-schedule-svg (width height days)
+  (let ((svg (svg-create width height :background "white"))
+        (day-height (/ height (length days)))
+        (y 0))
+    (mapc
+     (lambda (day)
+       (let ((group (dom-node 'g `((transform . ,(format "translate(0,%d)" y))))))
+         (dom-append-child svg group)
+         (emacsconf-schedule-svg-day group
+                                     (plist-get day :label)
+                                     width day-height
+                                     (date-to-time (plist-get day :start))
+                                     (date-to-time (plist-get day :end))
+                                     (plist-get day :tracks)))
+       (setq y (+ y day-height)))
+     days)
     svg))
 
 (defun emacsconf-schedule-get-subsequence (info start &optional end)
@@ -425,5 +441,58 @@ Talks with a FIXED_TIME property are not moved."
                 (setq end-time (time-add (org-get-scheduled-time (point)) (seconds-to-time duration)))
                 (setq current-time (time-add end-time (* (string-to-number (or (plist-get talk :buffer) "0")) 60))))))))))))
 
+(defun emacsconf-schedule-validate-time-constraints (&optional info)
+  (interactive)
+  (let* ((info (or info (emacsconf-get-talk-info)))
+         (results (delq nil
+                        (append
+                         (mapcar
+                          (lambda (o)
+                            (apply #'emacsconf-schedule-check-time
+                                   (car o)
+                                   (emacsconf-search-talk-info (car o) info)
+                                   (cdr o)))
+                          emacsconf-time-constraints)
+                         (mapcar
+                          (lambda (o)
+                            (let (result
+                                  (constraint (emacsconf-schedule-get-time-constraint o)))
+                              (when constraint
+                                (setq result (apply #'emacsconf-schedule-check-time
+                                                      (plist-get o :slug)
+                                                      o
+                                                      constraint))
+                                (when result (plist-put o :invalid result))
+                                result)))
+                          info)))))
+    (if (called-interactively-p 'any)
+        (message "%s" (string-join results "\n"))
+      results)))
+
+(defun emacsconf-schedule-check-time (label o &optional from-time to-time)
+  "FROM-TIME and TO-TIME should be strings like HH:MM in EST.
+Both start and end time are tested."
+  (let* ((start-time (format-time-string "%H:%M" (plist-get o :start-time)))
+         (end-time (format-time-string "%H:%M" (plist-get o :end-time)))
+         result)
+    (setq result
+          (or
+           (and (null o) (format "%s: Not found" label))
+           (and from-time (string< start-time from-time)
+                (format "%s: Starts at %s before %s" label start-time from-time))
+           (and to-time (string< to-time end-time)
+                (format "%s: Ends at %s after %s" label end-time to-time))))
+    (when result (plist-put o :invalid result))
+    result))
+
+(defun emacsconf-schedule-get-time-constraint (o)
+  (unless (string-match "after the event" (or (plist-get o :q-and-a) ""))
+    (let ((avail (or (plist-get o :availability) ""))
+          hours)
+      (when (string-match "\\([<>]\\)=? *\\([0-9]+:[0-9]+\\) *EST" avail)
+        (if (string= (match-string 1 avail) ">")
+            (list (match-string 2 avail) nil)
+          (list nil (match-string 2 avail)))))))
+
 (provide 'emacsconf-schedule)
 ;;; emacsconf-schedule.el ends here