Update plot functions to return information about the plot (#90, #83)

The `Plot-Metrics<%>` interface implements functions to query information about the plot.  Currently, `get-plot-bounds`, `plot->dc` and `dc->plot` methods are implemented.   Objects returned by plot/dc, `plot-bitmap` and `plot-snip` implement this interface in addition to their respective types (e.g. a `bitmap%` for `plot-bitmap` and `snip%` for `plot-snip`).  `plot-pict` returns a `pict` which is extended with these new interface functions as well.

Author: bdeket

plot-gui-lib/plot/private/gui/lazy-snip-typed.rkt

@@ -6,7 +6,8 @@
 
 (provide make-2d-plot-snip
          make-3d-plot-snip
-         make-snip-frame)
+         make-snip-frame
+         Plot-Snip%)
 
 (type-environment
  [make-2d-plot-snip  (parse-type #'Make-2D-Plot-Snip)]

plot-gui-lib/plot/private/gui/lazy-snip-types.rkt

@@ -5,6 +5,8 @@
 
 (provide (all-defined-out))
 
+(define-type Plot-Snip% (Class #:implements Snip% #:implements Plot-Metrics<%>))
+
 (define-type Make-2D-Plot-Snip
   (-> (Instance Bitmap%)
       Plot-Parameters
@@ -14,7 +16,7 @@
       (U #f (Instance 2D-Plot-Area%))
       Positive-Integer
       Positive-Integer
-      (Instance Snip%)))
+      (Instance Plot-Snip%)))
 
 (define-type Make-3D-Plot-Snip
   (-> (Instance Bitmap%)
@@ -26,7 +28,7 @@
       (U #f (Instance 3D-Plot-Area%))
       Positive-Integer
       Positive-Integer
-      (Instance Snip%)))
+      (Instance Plot-Snip%)))
 
 (define-type Make-Snip-Frame
   (-> (-> Positive-Integer Positive-Integer (Instance Snip%))

plot-gui-lib/plot/private/gui/plot2d.rkt

@@ -68,7 +68,7 @@
           #:y-label (U String pict #f)
           #:aspect-ratio (U Nonnegative-Real #f)
           #:legend-anchor Legend-Anchor]
-         (Instance Snip%)))
+         (Instance Plot-Snip%)))
 (define (plot-snip renderer-tree
                    #:x-min [x-min #f] #:x-max [x-max #f]
                    #:y-min [y-min #f] #:y-max [y-max #f]

plot-gui-lib/plot/private/gui/plot3d.rkt

@@ -46,7 +46,7 @@
           #:z-label (U String pict #f)
           #:aspect-ratio (U Nonnegative-Real #f)
           #:legend-anchor Legend-Anchor]
-         (Instance Snip%)))
+         (Instance Plot-Snip%)))
 (define (plot3d-snip renderer-tree
                      #:x-min [x-min #f] #:x-max [x-max #f]
                      #:y-min [y-min #f] #:y-max [y-max #f]

plot-gui-lib/plot/private/gui/snip2d.rkt

@@ -13,6 +13,7 @@
          plot/private/plot2d/renderer
          plot/private/no-gui/plot2d-utils
          plot/private/common/contract
+         (submod plot/private/common/plotmetrics untyped)
          "worker-thread.rkt"
          "snip.rkt")
 
@@ -35,7 +36,7 @@
 (struct draw-command (animating? plot-bounds-rect width height) #:transparent)
 
 (define 2d-plot-snip%
-  (class plot-snip%
+  (class* plot-snip% (plot-metrics<%>)
     (init init-bm saved-plot-parameters)
     (init-field make-bm plot-bounds-rect area width height)
 
@@ -140,6 +141,7 @@
                 (worker-thread-try-get rth (λ () (values #f #f))))
               (cond [(is-a? new-bm bitmap%)
                      (set! area new-area)
+                     (set! plot-metrics-ok? #f)
                      (set-bitmap new-bm)
                      (set-message-center)
                      #t]
@@ -372,6 +374,23 @@
         (start-update-thread #f)
         (set-update #t))
       (super resize w h))
+
+    (define plot-metrics-ok? #f)
+    (match-define (list bounds ->dc ->plot plane)
+      (send area get-plot-metrics-functions))
+    (define (update-metrics)
+      (match-define (list new-bounds new-->dc new-->plot new-plane)
+        (send area get-plot-metrics-functions))
+      (set! bounds new-bounds)
+      (set! ->dc new-->dc)
+      (set! ->plot new-->plot)
+      (set! plane new-plane)
+      (set! plot-metrics-ok? #t))
+    (define/public (get-plot-bounds) (unless plot-metrics-ok? (update-metrics)) (bounds))
+    (define/public (plot->dc coords) (unless plot-metrics-ok? (update-metrics)) (->dc coords))
+    (define/public (dc->plot coords) (unless plot-metrics-ok? (update-metrics)) (->plot coords))
+    (define/public (plane-vector)    (unless plot-metrics-ok? (update-metrics)) (plane))
+    (define/public (get-plot-metrics-functions) (unless plot-metrics-ok? (update-metrics)) (list bounds ->dc ->plot plane))
     ))
 
 (define (make-2d-plot-snip

plot-gui-lib/plot/private/gui/snip3d.rkt

@@ -3,6 +3,7 @@
 (require racket/gui/base racket/class racket/match
          plot/private/common/math
          plot/private/common/parameters
+         (submod plot/private/common/plotmetrics untyped)
          "worker-thread.rkt"
          "snip.rkt")
 
@@ -15,7 +16,7 @@
 (define (clamp x mn mx) (min* (max* x mn) mx))
 
 (define 3d-plot-snip%
-  (class plot-snip%
+  (class* plot-snip% (plot-metrics<%>)
     (init init-bm saved-plot-parameters)
     (init-field make-bm angle altitude area width height)
 
@@ -68,6 +69,7 @@
                 (worker-thread-try-get rth (λ () (values #f #f))))
               (cond [(is-a? new-bm bitmap%)
                      (set! area new-area)
+                     (set! plot-metrics-ok? #f)
                      (set-bitmap new-bm)
                      (set-message-center)
                      (when (not (and (= last-angle angle)
@@ -140,6 +142,23 @@
           (start-update-thread #t))
         (set-update #t))
       (super resize w h))
+
+    (define plot-metrics-ok? #f)
+    (match-define (list bounds ->dc ->plot plane)
+      (send area get-plot-metrics-functions))
+    (define (update-metrics)
+      (match-define (list new-bounds new-->dc new-->plot new-plane)
+        (send area get-plot-metrics-functions))
+      (set! bounds new-bounds)
+      (set! ->dc new-->dc)
+      (set! ->plot new-->plot)
+      (set! plane new-plane)
+      (set! plot-metrics-ok? #t))
+    (define/public (get-plot-bounds) (unless plot-metrics-ok? (update-metrics)) (bounds))
+    (define/public (plot->dc coords) (unless plot-metrics-ok? (update-metrics)) (->dc coords))
+    (define/public (dc->plot coords) (unless plot-metrics-ok? (update-metrics)) (->plot coords))
+    (define/public (plane-vector)    (unless plot-metrics-ok? (update-metrics)) (plane))
+    (define/public (get-plot-metrics-functions) (unless plot-metrics-ok? (update-metrics)) (list bounds ->dc ->plot plane))
     ))
 
 (define (make-3d-plot-snip

plot-lib/plot/private/common/contract.rkt

@@ -121,3 +121,6 @@
 (define (treeof elem-contract)
   (or/c elem-contract
         (listof (recursive-contract (treeof elem-contract) #:flat))))
+
+(require (submod "plotmetrics.rkt" untyped))
+(provide plot-metrics-object/c)

plot-lib/plot/private/common/plotmetrics.rkt

@@ -0,0 +1,97 @@
+#lang typed/racket/base
+
+;; Untyped interface / contract
+(module untyped racket/base
+  (require racket/class
+           racket/contract
+           racket/match
+           racket/draw)
+
+  (provide plot-metrics<%>
+           plot-metrics-object/c)
+
+  (define plot-metrics<%> (interface ()
+                            get-plot-bounds
+                            dc->plot
+                            plot->dc
+                            plane-vector
+                            get-plot-metrics-functions))
+
+  (define plot-metrics-object/c
+    (object/c [get-plot-bounds            (->m (vectorof (vector/c real? real?)))]
+              [plot->dc                   (->m (vectorof real?) (vectorof real?))]
+              [dc->plot                   (->m (vectorof real?) (vectorof real?))]
+              [plane-vector               (->m (vectorof real?))]
+              [get-plot-metrics-functions (->m (values (-> (vectorof (vector/c real? real?)))
+                                                       (-> (vectorof real?) (vectorof real?))
+                                                       (-> (vectorof real?) (vectorof real?))
+                                                       (-> (vectorof real?))))]))
+  )
+
+;; Typed  Types / mixin / structures
+(require typed/pict
+         typed/racket/class
+         racket/match)
+  
+(provide plot-metrics-mixin Plot-Metrics-Functions Plot-Metrics<%> plot-metrics%
+         (struct-out plot-pict) Plot-Pict pict->pp)
+
+(define-type Metrics-Object (Object [get-plot-metrics-functions (-> Plot-Metrics-Functions)]))
+(define-type Plot-Metrics-Functions (List (-> (Vectorof (Vectorof Real)))
+                                          (-> (Vectorof Real) (Vectorof Real))
+                                          (-> (Vectorof Real) (Vectorof Real))
+                                          (-> (Vectorof Real))))
+(define-type Plot-Metrics<%>
+  (Class
+   [get-plot-bounds (-> (Vectorof (Vectorof Real)))]
+   [plot->dc        (-> (Vectorof Real) (Vectorof Real))]
+   [dc->plot        (-> (Vectorof Real) (Vectorof Real))]
+   [plane-vector    (-> (Vectorof Real))]
+   [get-plot-metrics-functions (-> Plot-Metrics-Functions)]))
+
+(: plot-metrics-mixin (All (A #:row) (-> (Class #:row-var A)
+                                         (Class [init [->metrics-object (-> Metrics-Object)]]
+                                                #:row-var A
+                                                #:implements Plot-Metrics<%>))))
+(define (plot-metrics-mixin %)
+  (class %
+    (init ->metrics-object)
+    (define (load) : Void
+      (match-define (list new-bounds new-->dc new-->plot new-plane)
+        (send (->metrics-object) get-plot-metrics-functions))
+      (set! bounds new-bounds)
+      (set! ->dc new-->dc)
+      (set! ->plot new-->plot)
+      (set! plane new-plane)
+      (set! getall (λ () (list bounds ->dc ->plot plane)))
+      (set! load void))
+
+    (define (bounds) : (Vectorof (Vectorof Real)) (load)(bounds))
+    (define (plane)  : (Vectorof Real)            (load)(plane))
+    (define (getall) : Plot-Metrics-Functions     (load)(list bounds ->dc ->plot plane))
+    (define (->dc   [v : (Vectorof Real)]) : (Vectorof Real) (load)(->dc v))
+    (define (->plot [v : (Vectorof Real)]) : (Vectorof Real) (load)(->plot v))
+      
+    (super-make-object)
+    (define/public (get-plot-bounds) (bounds))
+    (define/public (dc->plot coords) (->plot coords))
+    (define/public (plot->dc coords) (->dc coords))
+    (define/public (plane-vector) (plane))
+    (define/public (get-plot-metrics-functions) (getall))))
+
+(define plot-metrics% (plot-metrics-mixin object%))
+
+
+(struct plot-pict pict ([bounds : (Vectorof (Vectorof Real))]
+                        [plot->dc : (-> (Vectorof Real) (Vectorof Real))]
+                        [dc->plot : (-> (Vectorof Real) (Vectorof Real))]
+                        [plane-vector : (Vectorof Real)]))
+(define-type Plot-Pict plot-pict)
+(define (pict->pp [P : pict]
+                  [metrics-object : Metrics-Object]) : plot-pict
+  (match-define (list bounds ->dc ->plot plane)
+    (send metrics-object get-plot-metrics-functions))
+  
+  (plot-pict (pict-draw P) (pict-width P) (pict-height P) (pict-ascent P)
+             (pict-descent P) (pict-children P) (pict-panbox P) (pict-last P)
+             (bounds) ->dc ->plot (plane)))

plot-lib/plot/private/common/types.rkt

@@ -162,3 +162,6 @@
    [draw-pict (->* [pict (Vectorof Real)] (Anchor Real) Void)]
    [calculate-legend-rect (-> (Listof legend-entry) Rect Anchor Rect)]
    [draw-legend (-> (Listof legend-entry) Rect Void)]))
+
+(require "plotmetrics.rkt")
+(provide Plot-Metrics<%> Plot-Pict Plot-Metrics-Functions)

plot-lib/plot/private/no-gui/evil-types.rkt

@@ -1,7 +1,7 @@
 #lang typed/racket
 
+(require typed/pict)
+
 (provide Pict pict?)
 
-(require/typed
- pict
- [#:opaque Pict pict?])
+(define-type Pict pict)