Time constraints

3 files changed, 108 insertions, 90 deletions

diff --git a/emacsconf-publish.el b/emacsconf-publish.el
index c1b3b55..286b1ff 100644
--- a/emacsconf-publish.el
+++ b/emacsconf-publish.el
@@ -214,11 +214,6 @@ ${chapter-list}
                       "")))
       "<div class=\"files resources\"><ul>${video-download}${other-files}${toobnix-info}</ul></div>"))))
 
-(condition-case nil
-    (when (featurep 'memoize)
-      (memoize #'compile-media-get-file-duration-ms))
-  nil)
-
 (defun emacsconf-format-public-email (o &optional email)
   (format "[%s](mailto:%s?subject=%s)"
           (or email (plist-get o :public-email))
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
diff --git a/emacsconf.el b/emacsconf.el
index 9628872..1844713 100644
--- a/emacsconf.el
+++ b/emacsconf.el
@@ -718,30 +718,7 @@ Include some other things, too, such as emacsconf-year, title, name, email, url,
       (error "%s is missing %s" (org-entry-get (point) "SLUG") field)))
   nil)
 
-(defun emacsconf-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-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)))))))
 
 (defvar emacsconf-time-constraints
   '(("saturday morning break" "10:00" "11:30")
@@ -765,30 +742,7 @@ Both start and end time are tested."
                           (format-time-string "%H:%M" (plist-get (cadr info) :start-time)))))
     (setq info (cdr info))))
 
-(defun emacsconf-validate-time-constraints (&optional info)
-  (interactive)
-  (let* ((info (or info (emacsconf-get-talk-info)))
-         (results (delq nil
-                        (append
-                         (mapcar
-                          (lambda (o)
-                            (apply #'emacsconf-check-time
-                                   (car o)
-                                   (emacsconf-search-talk-info (car o) info)
-                                   (cdr o)))
-                          emacsconf-time-constraints)
-                         (mapcar
-                          (lambda (o)
-                            (let ((constraint (emacsconf-get-time-constraint o)))
-                              (when constraint
-                                (apply #'emacsconf-check-time
-                                       (plist-get o :slug)
-                                       o
-                                       constraint))))
-                          info)))))
-    (if (called-interactively-p 'any)
-        (message "%s" (string-join results "\n"))
-      results)))
+
 
 (provide 'emacsconf)
 ;;; emacsconf.el ends here