[legend pt1] legend outside plot area

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

@@ -112,11 +112,14 @@
                 legend-entries-hash (plot-animating?)
                 (flatten-legend-entries
                  (for/list : (Listof (Treeof legend-entry)) ([rend  (in-list renderer-list)])
-                   (match-define (renderer3d rend-bounds-rect _bf _tf render-proc) rend)
+                   (match-define (renderer3d rend-bounds-rect _bf _tf label-proc render-proc) rend)
                    (send area start-renderer (if rend-bounds-rect
                                                  (rect-inexact->exact rend-bounds-rect)
                                                  (unknown-rect 3)))
-                   (if render-proc (render-proc area) empty))))
+                   (when render-proc (render-proc area))
+                   (if label-proc
+                       (label-proc (send area get-bounds-rect))
+                       empty))))
 
                (hash-set! render-tasks-hash (plot-animating?) (send area get-render-tasks))]
               [else

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

@@ -20,7 +20,7 @@
   (cond [(list? renderer-tree)  (append* (map get-renderer-list renderer-tree))]
         [(nonrenderer? renderer-tree)
          (match-define (nonrenderer bounds-rect bounds-fun ticks-fun) renderer-tree)
-         (list (renderer2d bounds-rect bounds-fun ticks-fun #f))]
+         (list (renderer2d bounds-rect bounds-fun ticks-fun #f #f))]
         [(renderer2d? renderer-tree)
          (list renderer-tree)]
         [else
@@ -71,11 +71,16 @@
   (define legend-entries
     (flatten-legend-entries
      (for/list : (Listof (Treeof legend-entry)) ([rend  (in-list renderer-list)])
-       (match-define (renderer2d rend-bounds-rect _bf _tf render-proc) rend)
+       (match-define (renderer2d rend-bounds-rect _bf _tf label-proc render-proc) rend)
        (send area start-renderer (if rend-bounds-rect
                                      (rect-inexact->exact rend-bounds-rect)
                                      (unknown-rect 2)))
-       (if render-proc (render-proc area) empty))))
+       (when render-proc (render-proc area))
+       (cond
+         [(and render-proc label-proc)
+          (define rect (send area get-bounds-rect))
+          (label-proc rect)]
+         [else empty]))))
 
   (send area end-renderers)
 

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

@@ -20,7 +20,7 @@
   (cond [(list? renderer-tree)  (append* (map get-renderer-list renderer-tree))]
         [(nonrenderer? renderer-tree)
          (match-define (nonrenderer bounds-rect bounds-fun ticks-fun) renderer-tree)
-         (list (renderer3d bounds-rect bounds-fun ticks-fun #f))]
+         (list (renderer3d bounds-rect bounds-fun ticks-fun #f #f))]
         [(renderer3d? renderer-tree)
          (list renderer-tree)]
         [else
@@ -81,11 +81,14 @@
   (define legend-entries
     (flatten-legend-entries
      (for/list : (Listof (Treeof legend-entry)) ([rend  (in-list renderer-list)])
-       (match-define (renderer3d rend-bounds-rect _bf _tf render-proc) rend)
+       (match-define (renderer3d rend-bounds-rect _bf _tf label-proc render-proc) rend)
        (send area start-renderer (if rend-bounds-rect
                                      (rect-inexact->exact rend-bounds-rect)
                                      (unknown-rect 3)))
-       (if render-proc (render-proc area) empty))))
+       (when render-proc (render-proc area))
+       (if label-proc
+           (label-proc (send area get-bounds-rect))
+           empty))))
 
   (send area end-renderers)
 

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

@@ -3,7 +3,6 @@
 (require typed/racket/class racket/match racket/math racket/list racket/sequence
          plot/utils
          (only-in typed/pict pict)
-         (only-in math/statistics stddev)
          "../common/type-doc.rkt"
          "../common/utils.rkt")
 
@@ -18,38 +17,30 @@
        Plot-Color Nonnegative-Real Plot-Pen-Style
        Nonnegative-Real
        (U (List '= Nonnegative-Real) Nonnegative-Real) Nonnegative-Real
-       (U String pict #f)
        2D-Render-Proc))
 (define ((arrows-render-fun vs
                             color line-width line-style
                             alpha
-                            arrow-head-size-or-scale arrow-head-angle
-                            label) area)
+                            arrow-head-size-or-scale arrow-head-angle) area)
   (match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
-
-  (cond
-    [(and x-min x-max y-min y-max)  
-     (send area put-alpha alpha)
-     (send area put-pen color line-width line-style)
-     (send area put-arrow-head arrow-head-size-or-scale arrow-head-angle)
-     (for ([x (in-list vs)])
-       (match-define (cons (vector v1x v1y) (vector v2x v2y)) x)
-       (define (f [x : Real][y : Real])
-         (- (* (- v2x v1x) (- y v1y))
-            (* (- v2y v1y) (- x v1x))))
-       (cond
+  (when (and x-min x-max y-min y-max)
+    (send area put-alpha alpha)
+    (send area put-pen color line-width line-style)
+    (send area put-arrow-head arrow-head-size-or-scale arrow-head-angle)
+    (for ([x (in-list vs)])
+      (match-define (cons (vector v1x v1y) (vector v2x v2y)) x)
+      (define (f [x : Real][y : Real])
+        (- (* (- v2x v1x) (- y v1y))
+           (* (- v2y v1y) (- x v1x))))
+      (cond
         ;only draw the arrow head if the endpoint is visible
         ;other option makes little sense since size and angle can be/is plot units-absolute
         [(and (<= x-min v2x x-max) (<= y-min v2y y-max))
          (send area put-arrow (car x) (cdr x) #t)]
         ;only draw the vector line if it is visible
         [(or (<= (* (f x-min y-min) (f x-max y-max)) 0)
              (<= (* (f x-min y-max) (f x-max y-min)) 0))
-         (send area put-lines (list (car x) (cdr x)))]))
-     (cond [label  (arrow-legend-entry label color line-width line-style)]
-           [else   empty])]
-    [else  empty])
-  )
+         (send area put-lines (list (car x) (cdr x)))]))))
 
 ;(Sequenceof (Sequence (Sequenceof Real))) does not work because (sequence? 5) = #t
 ;and so the contract can not know if '((2 2)) is three or two nested sequences
@@ -132,14 +123,14 @@
          (filter vrational? (append p1 p2))))
 
      (cond
-       [(empty? rvs) (renderer2d #f #f #f #f)]
+       [(empty? rvs) empty-renderer2d]
        [else
         (define-values (x- x+ y- y+) (get-bounds x-min x-max y-min y-max rvs))
         (renderer2d (vector (ivl x- x+) (ivl y- y+)) #f default-ticks-fun
+                    (and label (λ (_) (arrow-legend-entry label color width style)))
                     (arrows-render-fun vs*
                                        color width style alpha
-                                       arrow-head-size-or-scale arrow-head-angle
-                                       label))])]))
+                                       arrow-head-size-or-scale arrow-head-angle))])]))
 
 (define (get-bounds [x-min : (Option Real)][x-max : (Option Real)]
                     [y-min : (Option Real)][y-max : (Option Real)]

plot-lib/plot/private/plot2d/color-field.rkt

@@ -29,25 +29,22 @@
 (define ((color-field-render-fun f samples alpha) area)
   (match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
 
-  (cond
-    [(and x-min x-max y-min y-max)
-     (define xs (linear-seq x-min x-max (+ samples 1) #:start? #t #:end? #t))
-     (define ys (linear-seq y-min y-max (+ samples 1) #:start? #t #:end? #t))
+  (when (and x-min x-max y-min y-max)
+    (define xs (linear-seq x-min x-max (+ samples 1) #:start? #t #:end? #t))
+    (define ys (linear-seq y-min y-max (+ samples 1) #:start? #t #:end? #t))
 
-     (send area put-alpha alpha)
-     (send area put-pen 'black 0 'transparent)
-     (for ([x- (in-list xs)]
-           [x+ (in-list (cdr xs))])
-       (define x (/ (+ x- x+) 2))
-       (for ([y- (in-list ys)]
-             [y+ (in-list (cdr ys))])
-         (define y (/ (+ y- y+) 2))
-         (define c (f x y))
-         (send area put-brush c 'solid)
-         (send area put-rect (vector (ivl x- x+)
-                                     (ivl y- y+)))))
-     empty]
-    [else  empty]))
+    (send area put-alpha alpha)
+    (send area put-pen 'black 0 'transparent)
+    (for ([x- (in-list xs)]
+          [x+ (in-list (cdr xs))])
+      (define x (/ (+ x- x+) 2))
+      (for ([y- (in-list ys)]
+            [y+ (in-list (cdr ys))])
+        (define y (/ (+ y- y+) 2))
+        (define c (f x y))
+        (send area put-brush c 'solid)
+        (send area put-rect (vector (ivl x- x+)
+                                    (ivl y- y+)))))))
 
 (:: color-field
     (->* [(U (-> Real Real Plot-Color)
@@ -70,7 +67,7 @@
     [(or (> alpha 1) (not (rational? alpha)))  (fail/kw "real in [0,1]" '#:alpha alpha)]
     [else
      (let ([f ((inst fix-a-field-fun Plot-Color) 'color-field f)])
-       (renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun
+       (renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun #f
                    (color-field-render-fun
                     f samples alpha)))]))