Update all plot-hover-callback functions to the new interface

The new interface uses plot renderers to draw overlays and uses
`set-overlay-renderers` to install them in the plot snip.

rkt/inspect-best-avg.rkt

@@ -364,6 +364,9 @@
 
     (define (plot-hover-callback snip event x y)
       (define info '())
+      (define renderers '())
+      (define markers '())
+      (define (add-renderer r) (set! renderers (cons r renderers)))
 
       (define (add-info tag value)
         (set! info (cons (list tag value) info)))
@@ -373,11 +376,10 @@
           (let ((py (yfn x)))
             (when py
               (add-info name (format-fn py))
-              (add-mark-overlay snip x py)))))
+              (set! markers (cons (vector x py) markers))))))
 
-      (send snip clear-overlays)
       (when (and x y)
-        (add-vrule-overlay snip x)
+        (add-renderer (pu-vrule x))
 
         ;; The aux values need special treatment: they are scaled to match the
         ;; main axis coordinate system, this works for the plot itself, but we
@@ -389,7 +391,7 @@
             (when ay
               (let ((actual-ay ((invertible-function-f best-avg-aux-invfn) ay)))
                 (add-info (send aux-axis name) (format-value actual-ay))
-                (add-mark-overlay snip x ay)))))
+                (set! markers (cons (vector x ay) markers))))))
 
         (define axis (get-series-axis))
         (define format-value (send axis value-formatter))
@@ -408,8 +410,11 @@
         (add-data-point (send axis name) best-avg-plot-fn format-value)
         (add-info "Duration" (duration->string x))
         (unless (empty? info)
-          (add-pict-overlay snip x y (make-hover-badge (reverse info)))))
-      (send snip refresh-overlays))
+          (add-renderer (pu-markers markers))
+          (add-renderer (pu-label x y (make-hover-badge (reverse info))))))
+
+      (set-overlay-renderers snip renderers))
+
 
     (define (put-plot-snip)
       (when plot-rt
@@ -440,7 +445,7 @@
                                                    #:x-min min-x #:x-max max-x
                                                    #:y-min min-y #:y-max max-y
                                                    ))
-                      (set-mouse-callback snip plot-hover-callback)))
+                      (set-mouse-event-callback snip plot-hover-callback)))
                 (parameterize ([plot-x-ticks (best-avg-ticks)]
                                [plot-x-label "Duration"]
                                [plot-x-transform log-transform]
@@ -451,7 +456,7 @@
                   (define snip (plot-snip/hack plot-pb rt
                                                #:x-min min-x #:x-max max-x
                                                #:y-min min-y #:y-max max-y))
-                  (set-mouse-callback snip plot-hover-callback)))
+                  (set-mouse-event-callback snip plot-hover-callback)))
               (when (and cp-data (send best-avg-axis have-cp-estimate?) best-avg-data)
                 ;; NOTE: this is inefficient, as the plot-fn is already
                 ;; computed in the `make-best-avg-renderer` and we are

rkt/inspect-graphs.rkt

@@ -626,21 +626,32 @@
 
     (define/public (draw-marker-at x)
       (when (and the-plot-snip show-graph?)
-        (clear-plot-overlays the-plot-snip)
-        ;; Add the highlight overlay back in...
-        (when (pd-hlivl plot-data)
-          (match-define (list xmin xmax color) (pd-hlivl plot-data))
-          (add-vrange-overlay the-plot-snip xmin xmax color))
-        (when x
-          (let ((y1 (find-y (pd-sdata plot-data) x))
-                (format-value (send (ps-y-axis plot-state) value-formatter))
-                (y2 (and pd-sdata2 (find-y (pd-sdata2 plot-data) x))))
-            (when y1
-              (add-label-overlay the-plot-snip x y1 (format-value y1)))
-            (when y2
-              (add-label-overlay the-plot-snip x y2 (format-value y2))))
-          (add-vrule-overlay the-plot-snip x))
-        (refresh-plot-overlays the-plot-snip)))
+        (let ((rt '()))
+          (define (add-renderer r) (set! rt (cons r rt)))
+          ;; Add the highlight overlay back in...
+          (when (pd-hlivl plot-data)
+            (match-define (list xmin xmax color) (pd-hlivl plot-data))
+            (add-renderer (pu-vrange xmin xmax color)))
+          (when x
+            (let ((y1 (find-y (pd-sdata plot-data) x))
+                  (format-value (send (ps-y-axis plot-state) value-formatter))
+                  (x-format-value (send (ps-x-axis plot-state) value-formatter))
+                  (y2 (and pd-sdata2 (find-y (pd-sdata2 plot-data) x))))
+              (cond ((and y1 y2)
+                     (let ((label (string-append (format-value y1) "/"
+                                                 (format-value y2) " @ "
+                                                 (x-format-value x))))
+                       (add-renderer (pu-label x (max y1 y2) label))))
+                    (y1
+                     (let ((label (string-append (format-value y1) " @ "
+                                                 (x-format-value x))))
+                       (add-renderer (pu-label x y1 label))))
+                    (y2
+                     (let ((label (string-append (format-value y2) " @ "
+                                                 (x-format-value x))))
+                       (add-renderer (pu-label x y2 label))))))
+            (add-renderer (pu-vrule x)))
+          (set-overlay-renderers the-plot-snip rt))))
 
     (define (plot-hover-callback snip event x y)
       (hover-callback x))
@@ -659,11 +670,10 @@
                     (begin
                       (when (pd-plot-rt npdata)
                         (set! the-plot-snip (put-plot/canvas graph-canvas npdata pstate))
-                        (set-mouse-callback the-plot-snip plot-hover-callback)
+                        (set-mouse-event-callback the-plot-snip plot-hover-callback)
                         (when (pd-hlivl npdata)
                           (match-define (list xmin xmax color) (pd-hlivl npdata))
-                          (add-vrange-overlay the-plot-snip xmin xmax color)
-                          (refresh-plot-overlays the-plot-snip)))
+                          (set-overlay-renderers the-plot-snip (list (pu-vrange xmin xmax color)))))
                       (set! previous-plot-state pstate)
                       (set! plot-state pstate)
                       (set! plot-data npdata)
@@ -683,11 +693,10 @@
                 (if (= (pd-token pdata) cached-bitmap-token)
                     (begin
                       (set! the-plot-snip (put-plot/canvas graph-canvas pdata pstate))
-                      (set-mouse-callback the-plot-snip plot-hover-callback)
+                      (set-mouse-event-callback the-plot-snip plot-hover-callback)
                       (when (pd-hlivl pdata)
                         (match-define (list xmin xmax color) (pd-hlivl pdata))
-                        (add-vrange-overlay the-plot-snip xmin xmax color)
-                        (refresh-plot-overlays the-plot-snip)))
+                        (set-overlay-renderers the-plot-snip (list (pu-vrange xmin xmax color)))))
                     (void)))))))))
 
     (define (refresh)
@@ -751,14 +760,17 @@
 
     (define/public (highlight-interval start-timestamp end-timestamp)
       (set! plot-state (struct-copy ps plot-state [ivl (cons start-timestamp end-timestamp)]))
-      (set! plot-data (update-plot-data plot-data previous-plot-state plot-state))
-      (set! previous-plot-state plot-state)
-      (when the-plot-snip
-        (clear-plot-overlays the-plot-snip)
-        (when (pd-hlivl plot-data)
-          (match-define (list xmin xmax color) (pd-hlivl plot-data))
-          (add-vrange-overlay the-plot-snip xmin xmax color))
-        (refresh-plot-overlays the-plot-snip)))
+      ;; need full refresh if zoom to lap is set, as the actual plotted data will change.
+      (if (ps-zoom? plot-state)
+          (refresh)
+          (begin
+            (set! plot-data (update-plot-data plot-data previous-plot-state plot-state))
+            (set! previous-plot-state plot-state)
+            (when the-plot-snip
+              (if (pd-hlivl plot-data)
+                  (match-let (((list xmin xmax color) (pd-hlivl plot-data)))
+                    (set-overlay-renderers the-plot-snip (list (pu-vrange xmin xmax color))))
+                  (set-overlay-renderers #f))))))
 
     (define/public (get-data-frame) (ps-df plot-state))
 

rkt/inspect-histogram.rkt

@@ -267,6 +267,7 @@
 
     (define (plot-hover-callback snip event x y)
       (send snip clear-overlays)
+      (define renderer #f)
       (when (and x y)
         (define dual?
           (list? (list-ref axis-choices y-axis-index)))
@@ -282,8 +283,8 @@
               (let ((tag (if show-as-percentage?
                              (format "~a %" (~r value #:precision 1))
                              (duration->string value))))
-                (add-label-overlay snip x y tag))))))
-      (send snip refresh-overlays))
+                (set! renderer (list (pu-label x y tag))))))))
+      (set-overlay-renderers snip renderer))
 
     ;; Prepare the plot snip and insert it into the pasteboard. Assumes the
     ;; render tree is ready (if it is #f, there is no data for the plot).
@@ -301,7 +302,7 @@
                            [plot-x-ticks (send y-axis plot-ticks)]
                            [plot-x-label (send y-axis axis-label)])
               (define snip (plot-snip/hack plot-pb rt))
-              (set-mouse-callback snip plot-hover-callback))))))
+              (set-mouse-event-callback snip plot-hover-callback))))))
 
     ;; Build a plot render tree (PLOT-RT) based on current selections.  Note
     ;; that procesing happens in a separate task, and the render tree will

rkt/plot-util.rkt

@@ -23,20 +23,19 @@
          pict
          pict/snip
          plot
+         plot/utils
          embedded-gui
          "utilities.rkt")
 
 (provide/contract
  ;; NOTE all these are actually instances of 2d-plot-snip%, but the plot
  ;; library does not export that type.
- (set-mouse-callback (-> (is-a?/c snip%) (-> (is-a?/c snip%) (is-a?/c mouse-event%) (or/c #f number?) (or/c #f number?) any/c) any/c))
- (clear-plot-overlays (-> (is-a?/c snip%) any/c))
- (refresh-plot-overlays (-> (is-a?/c snip%) any/c))
- (add-vrule-overlay (-> (is-a?/c snip%) number? any/c))
- (add-mark-overlay (->* ((is-a?/c snip%) number? number?) ((or/c #f string?)) any/c))
- (add-label-overlay (-> (is-a?/c snip%) number? number? string? any/c))
- (add-pict-overlay (-> (is-a?/c snip%) number? number? pict? any/c))
- (add-vrange-overlay (-> (is-a?/c snip%) number? number? any/c any/c))
+ (set-mouse-event-callback (-> (is-a?/c snip%) (-> (is-a?/c snip%) (is-a?/c mouse-event%) (or/c #f number?) (or/c #f number?) any/c) any/c))
+ (set-overlay-renderers (-> (is-a?/c snip%) (or/c (treeof renderer2d?) #f null) any/c))
+ (pu-vrule (-> real? renderer2d?))
+ (pu-label (-> real? real? (or/c string? pict?) renderer2d?))
+ (pu-vrange (-> real? real? (is-a?/c color%) renderer2d?))
+ (pu-markers (-> (listof (vector/c real? real?)) renderer2d?))
  (make-hover-badge (-> (listof (listof (or/c #f string?))) pict?))
  (move-snip-to (-> (is-a?/c snip%) (or/c #f (cons/c number? number?)) any/c))
  (get-snip-location (-> (or/c #f (is-a?/c snip%)) (or/c #f (cons/c number? number?))))
@@ -77,61 +76,60 @@
 (define (can-use-plot-overlays? plot-snip)
   (when (eq? have-plot-overlays? 'unknown)
     (set! have-plot-overlays?
-          (object-method-arity-includes? plot-snip 'set-mouse-callback 1))
+          (object-method-arity-includes? plot-snip 'set-mouse-event-callback 1))
     (unless have-plot-overlays?
       (dbglog "plot overlays disabled")))
   have-plot-overlays?)
 
 ;; Add CALLBACK as a mouse hover callback to PLOT-SNIP.  The plot snip is
 ;; checked to see if it actually has that method (since this is only present
 ;; in a development branch of the plot package).
-(define (set-mouse-callback plot-snip callback)
+(define (set-mouse-event-callback plot-snip callback)
   (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip set-mouse-callback callback)))
+    (send plot-snip set-mouse-event-callback callback)))
 
-(define (clear-plot-overlays plot-snip)
+(define (set-overlay-renderers plot-snip renderer-tree)
   (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip clear-overlays)))
-
-(define (refresh-plot-overlays plot-snip)
-  (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip refresh-overlays)))
-
-;; Add a pict overlay on PLOT-SNIP at X, Y.
-(define (add-pict-overlay plot-snip x y pict)
-  (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip add-general-overlay x y
-          (lambda (dc x y) (draw-pict pict dc x y))
-          (pict-width pict)
-          (pict-height pict))))
-
-(define (add-vrule-overlay plot-snip x)
-  (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip add-vrule-overlay x #:pen vrule-pen)))
-
-(define (add-mark-overlay plot-snip x y (label #f))
-  (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip add-mark-overlay x y
-          #:pen marker-pen
-          #:label label
-          #:label-font hover-tag-item-font
-          #:label-fg-color hover-tag-item-color
-          #:label-bg-color hover-tag-background)))
-
-(define (add-label-overlay plot-snip x y label)
-  (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip add-mark-overlay x y
-          #:pen marker-pen
-          #:radius 0                      ; won't draw a marker
-          #:label label
-          #:label-font hover-tag-item-font
-          #:label-fg-color hover-tag-item-color
-          #:label-bg-color hover-tag-background)))
-
-(define (add-vrange-overlay plot-snip xmin xmax color)
-  (when (can-use-plot-overlays? plot-snip)
-    (send plot-snip add-vrange-overlay xmin xmax
-          #:brush (send the-brush-list find-or-create-brush color 'solid))))
+    (send plot-snip set-overlay-renderers
+          (if (null? renderer-tree) #f renderer-tree))))
+
+;; Create a vertical rule renderer at position X to be used as an overlay.
+;; This is the renderer used for all VRULES in our plots, ensuring
+;; consistency.
+(define (pu-vrule x)
+  (vrule x #:width 1 #:style 'short-dash #:color "black"))
+
+;; Create a renderer that draws label, which can be either a string or a pict,
+;; to be used as an overlay.  The label is drawn at position X, Y in plot
+;; coordinates.
+(define (pu-label x y label)
+  (define p
+    (if (pict? label)
+        label
+        (let ((p0 (text label hover-tag-item-font)))
+          (cc-superimpose
+           (filled-rounded-rectangle (+ (pict-width p0) 10)
+                                     (+ (pict-height p0) 10) -0.1
+                                     #:draw-border? #f
+                                     #:color hover-tag-background)
+           p0))))
+    (point-pict (vector x y) p #:point-sym 'none #:anchor 'auto))
+
+;; Create a vertical rectangle overlay renderer between XMIN and XMAX using
+;; COLOR.  The rectangle will cover the entire height of the plot between XMIN
+;; and XMAX. This can be used as an overlay to highlight a region, so COLOR
+;; should have an alpha channel to ensure it is transparent.
+(define (pu-vrange xmin xmax color)
+  (rectangles
+   (list (vector (ivl xmin xmax) (ivl -inf.0 +inf.0)))
+   #:line-style 'transparent
+   #:alpha (send color alpha)
+   #:color color))
+
+;; Create a renderer that draws the MARKERS, which are a list of 2d positions.
+;; These can be used as overlays.
+(define (pu-markers markers)
+  (points markers #:sym 'circle #:size 10 #:color "red" #:line-width 3))
 
 ;; Return a pict object representing a badge for displaying information on a
 ;; plot.  The ITEMS is a list of key-value string pairs and these are arranged

rkt/series-meta.rkt

@@ -263,6 +263,11 @@
          (define/override (series-name) "distance")
          (define/override (fractional-digits) 2)
          (define/override (name) "Distance")
+         (define/override (value-formatter)
+           ;; Unfortunate hack!
+           (if (eq? (al-pref-measurement-system) 'metric)
+               (lambda (x) (distance->string (* x 1000) #t))
+               (lambda (x) (distance->string (* x 1609) #t))))
          )))
 
 (provide axis-distance)
@@ -275,6 +280,7 @@
          (define/override (axis-label) "Elapsed Time (hour:min)")
          (define/override (series-name) "elapsed")
          (define/override (name) "Elapsed Time")
+         (define/override (value-formatter) duration->string)
          )))
 (provide axis-elapsed-time)
 
@@ -285,7 +291,9 @@
          (define/override (filter-width) 5.0)
          (define/override (axis-label) "Time (hour:min)")
          (define/override (name) "Time")
-         (define/override (series-name) "timer"))))
+         (define/override (series-name) "timer")
+         (define/override (value-formatter) duration->string)
+         )))
 (provide axis-timer-time)
 
 (define axis-speed
@@ -1198,15 +1206,23 @@
          (define/override (axis-label)
            (if (eq? (al-pref-measurement-system) 'metric)
                "Distance (meters)" "Distance (yards)"))
-         (define/override (series-name) "distance"))))
+         (define/override (series-name) "distance")
+         (define/override (value-formatter)
+           ;; This is a hack!
+           (if (eq? (al-pref-measurement-system) 'metric)
+               (lambda (x) (short-distance->string x #t))
+               (lambda (x) (short-distance->string (* x 0.9144) #t))))
+         )))
 (provide axis-swim-distance)
 
 (define axis-swim-time
   (new (class series-metadata% (init) (super-new)
          (define/override (plot-ticks) (time-ticks #:formats '("~H:~M")))
          (define/override (axis-label) "Time (hour:min)")
          (define/override (name) "Time")
-         (define/override (series-name) "elapsed"))))
+         (define/override (series-name) "elapsed")
+         (define/override (value-formatter) duration->string)
+         )))
 (provide axis-swim-time)
 
 (define all-series-meta