Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions plot-compat/plot/private/compat.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -165,7 +165,7 @@
(define bm (make-bitmap (ceiling width) (ceiling height)))
(define dc (make-object bitmap-dc% bm))
(define area (make-object 2d-plot-area%
bounds-rect x-ticks x-ticks y-ticks y-ticks dc 0 0 width height))
bounds-rect x-ticks x-ticks y-ticks y-ticks '() dc 0 0 width height))

(define data+axes (mix x-axis-data y-axis-data data))

Expand Down Expand Up @@ -214,7 +214,7 @@
(define bm (make-bitmap (ceiling width) (ceiling height)))
(define dc (make-object bitmap-dc% bm))
(define area (make-object 3d-plot-area%
bounds-rect x-ticks x-ticks y-ticks y-ticks z-ticks z-ticks dc 0 0 width height))
bounds-rect x-ticks x-ticks y-ticks y-ticks z-ticks z-ticks '() dc 0 0 width height))

(send area start-plot)
(send area start-renderer bounds-rect)
Expand Down
17 changes: 9 additions & 8 deletions plot-gui-lib/plot/private/gui/plot2d.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@
plot)

(require/typed plot/utils
(anchor/c (-> Any Boolean))
(legend-anchor/c (-> Any Boolean))
(plot-color/c (-> Any Boolean))
(plot-file-format/c (-> Any Boolean)))

Expand All @@ -66,7 +66,7 @@
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:legend-anchor Anchor]
#:legend-anchor Legend-Anchor]
(Instance Snip%)))
(define (plot-snip renderer-tree
#:x-min [x-min #f] #:x-max [x-max #f]
Expand All @@ -89,7 +89,7 @@
[(and title (not (or (string? title) (pict? title)))) (fail/kw "#f, string or pict" '#:title title)]
[(and x-label (not (or (string? x-label) (pict? x-label)))) (fail/kw "#f, string or pict" '#:x-label x-label)]
[(and y-label (not (or (string? y-label) (pict? y-label)))) (fail/kw "#f, string or pict" '#:y-label y-label)]
[(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)])
[(not (legend-anchor/c legend-anchor)) (fail/kw "legend-anchor/c" '#:legend-anchor legend-anchor)])

(parameterize ([plot-title title]
[plot-x-label x-label]
Expand All @@ -112,9 +112,10 @@
(define dc (make-object bitmap-dc% bm))
(define-values (x-ticks x-far-ticks y-ticks y-far-ticks)
(get-ticks renderer-list bounds-rect))
(define legend (get-legend-entry-list renderer-list bounds-rect))
(define new-area
(make-object 2d-plot-area%
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks legend
dc 0 0 width height))
(set! area new-area)
(plot-area new-area renderer-list))
Expand All @@ -136,7 +137,7 @@
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:legend-anchor Anchor]
#:legend-anchor Legend-Anchor]
(Instance Frame%)))
(define (plot-frame renderer-tree
#:x-min [x-min #f] #:x-max [x-max #f]
Expand All @@ -159,7 +160,7 @@
[(and title (not (or (string? title) (pict? title)))) (fail/kw "#f, string or pict" '#:title title)]
[(and x-label (not (or (string? x-label) (pict? x-label)))) (fail/kw "#f, string or pict" '#:x-label x-label)]
[(and y-label (not (or (string? y-label) (pict? y-label)))) (fail/kw "#f, string or pict" '#:y-label y-label)]
[(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)])
[(not (legend-anchor/c legend-anchor)) (fail/kw "legend-anchor/c" '#:legend-anchor legend-anchor)])

;; make-snip will be called in a separate thread, make sure the
;; parameters have the correct values in that thread as well.
Expand All @@ -185,7 +186,7 @@
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:legend-anchor Anchor
#:legend-anchor Legend-Anchor
#:out-file (U Path-String Output-Port #f)
#:out-kind (U 'auto Image-File-Format)
#:fgcolor Plot-Color
Expand Down Expand Up @@ -225,7 +226,7 @@
[(and title (not (or (string? title) (pict? title)))) (fail/kw "#f, string or pict" '#:title title)]
[(and x-label (not (or (string? x-label) (pict? x-label)))) (fail/kw "#f, string or pict" '#:x-label x-label)]
[(and y-label (not (or (string? y-label) (pict? y-label)))) (fail/kw "#f, string or pict" '#:y-label y-label)]
[(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)]
[(not (legend-anchor/c legend-anchor)) (fail/kw "legend-anchor/c" '#:legend-anchor legend-anchor)]
[(and out-kind (not (plot-file-format/c out-kind))) (fail/kw "plot-file-format/c" '#:out-kind out-kind)]
[(not (plot-file-format/c out-kind)) (fail/kw "plot-file-format/c" '#:out-kind out-kind)]
[(and fgcolor (not (plot-color/c fgcolor))) (fail/kw "plot-color/c" '#:fgcolor fgcolor)]
Expand Down
38 changes: 15 additions & 23 deletions plot-gui-lib/plot/private/gui/plot3d.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@
plot3d)

(require/typed plot/utils
(anchor/c (-> Any Boolean))
(legend-anchor/c (-> Any Boolean))
(plot-color/c (-> Any Boolean))
(plot-file-format/c (-> Any Boolean)))

Expand All @@ -44,7 +44,7 @@
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:z-label (U String pict #f)
#:legend-anchor Anchor]
#:legend-anchor Legend-Anchor]
(Instance Snip%)))
(define (plot3d-snip renderer-tree
#:x-min [x-min #f] #:x-max [x-max #f]
Expand Down Expand Up @@ -76,7 +76,7 @@
[(and x-label (not (or (string? x-label) (pict? x-label)))) (fail/kw "#f, string or pict" '#:x-label x-label)]
[(and y-label (not (or (string? y-label) (pict? y-label)))) (fail/kw "#f, string or pict" '#:y-label y-label)]
[(and z-label (not (or (string? z-label) (pict? z-label)))) (fail/kw "#f, string or pict" '#:y-label z-label)]
[(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)])
[(not (legend-anchor/c legend-anchor)) (fail/kw "legend-anchor/c" '#:legend-anchor legend-anchor)])

(parameterize ([plot-title title]
[plot-x-label x-label]
Expand All @@ -90,7 +90,8 @@
(get-ticks renderer-list bounds-rect))

(define render-tasks-hash ((inst make-hash Boolean render-tasks)))
(define legend-entries-hash ((inst make-hash Boolean (Listof legend-entry))))
;; For 3D legend can be calculated once since we don't change the bounding box
(define legend (get-legend-entry-list renderer-list bounds-rect))

(: make-bm (-> Boolean Real Real Positive-Integer Positive-Integer (Instance Bitmap%)))
(define (make-bm anim? angle altitude width height)
Expand All @@ -102,35 +103,26 @@
width height #t
#:backing-scale (or (get-display-backing-scale) 1.0)))
(define dc (make-object bitmap-dc% bm))

(define area (make-object 3d-plot-area%
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks legend
dc 0 0 width height))
(send area start-plot)

(cond [(not (hash-ref render-tasks-hash (plot-animating?) #f))
(hash-set!
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 label-proc render-proc) rend)
(for ([rend (in-list renderer-list)])
(match-define (renderer3d rend-bounds-rect _bf _tf label-proc render-proc) rend)
(when render-proc
(send area start-renderer (if rend-bounds-rect
(rect-inexact->exact rend-bounds-rect)
(unknown-rect 3)))
(when render-proc (render-proc area))
(if label-proc
(label-proc (send area get-bounds-rect))
empty))))
(render-proc area)))

(hash-set! render-tasks-hash (plot-animating?) (send area get-render-tasks))]
[else
(send area set-render-tasks (hash-ref render-tasks-hash (plot-animating?)))])

(send area end-renderers)

(define legend-entries (hash-ref legend-entries-hash (plot-animating?) #f))
(when (and legend-entries (not (empty? legend-entries)))
(send area draw-legend legend-entries))

(send area end-plot)
bm))

Expand All @@ -153,7 +145,7 @@
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:z-label (U String pict #f)
#:legend-anchor Anchor]
#:legend-anchor Legend-Anchor]
(Instance Frame%)))
(define (plot3d-frame renderer-tree
#:x-min [x-min #f] #:x-max [x-max #f]
Expand Down Expand Up @@ -185,7 +177,7 @@
[(and x-label (not (or (string? x-label) (pict? x-label)))) (fail/kw "#f, string or pict" '#:x-label x-label)]
[(and y-label (not (or (string? y-label) (pict? y-label)))) (fail/kw "#f, string or pict" '#:y-label y-label)]
[(and z-label (not (or (string? z-label) (pict? z-label)))) (fail/kw "#f, string or pict" '#:y-label z-label)]
[(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)])
[(not (legend-anchor/c legend-anchor)) (fail/kw "legend-anchor/c" '#:legend-anchor legend-anchor)])

;; make-snip will be called in a separate thread, make sure the
;; parameters have the correct values in that thread as well.
Expand Down Expand Up @@ -216,7 +208,7 @@
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:z-label (U String pict #f)
#:legend-anchor Anchor
#:legend-anchor Legend-Anchor
#:out-file (U Path-String Output-Port #f)
#:out-kind (U 'auto Image-File-Format)
#:fgcolor Plot-Color
Expand Down Expand Up @@ -272,7 +264,7 @@
[(and x-label (not (or (string? x-label) (pict? x-label)))) (fail/kw "#f, string or pict" '#:x-label x-label)]
[(and y-label (not (or (string? y-label) (pict? y-label)))) (fail/kw "#f, string or pict" '#:y-label y-label)]
[(and z-label (not (or (string? z-label) (pict? z-label)))) (fail/kw "#f, string or pict" '#:y-label z-label)]
[(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)]
[(not (legend-anchor/c legend-anchor)) (fail/kw "legend-anchor/c" '#:legend-anchor legend-anchor)]
[(and out-kind (not (plot-file-format/c out-kind))) (fail/kw "plot-file-format/c" '#:out-kind out-kind)]
[(not (plot-file-format/c out-kind)) (fail/kw "plot-file-format/c" '#:out-kind out-kind)]
[(and fgcolor (not (plot-color/c fgcolor))) (fail/kw "plot-color/c" '#:fgcolor fgcolor)]
Expand Down
2 changes: 2 additions & 0 deletions plot-lib/plot/private/common/contract.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,8 @@
(define anchor/c (one-of/c 'top-left 'top 'top-right
'left 'center 'right
'bottom-left 'bottom 'bottom-right))
(define legend-anchor/c (or/c #f anchor/c
(list/c (one-of/c 'inside 'outside) anchor/c)))

Copy link
Copy Markdown
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am not sure I understand your choice for defining the legend-anchor/c contract and Legend-Anchor type. I don't understand what the #f value is for, and the list definition produces values which don't make sense to me. E.g. where would the legend be placed when the anchor is (outside center) ? Also, the inside entries overlap with the plain one (e.g. (inside top) is the same as top?)

My thought was to make the legend anchor values a type completely independent from anchor/c, some symbols are common, with some additional ones:

(define legend-anchor/c (one-of/c 'top-left    'top    'top-right
                           'left        'center 'right
                           'bottom-left 'bottom 'bottom-right
                           'outer-top-left 'outer-center-left 'outer-bottom-left
                           'outer-top-right 'outer-center-right 'outer-bottom-right
))

This would allow placing the legend to the left or right of the plot area. I am not sure that it is worth adding legends at the top and bottom of the plot, did you intend to add that feature?

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

  • #f: This allows to not print the legend at all. Which makes it easy to implement the original question of legend outside the plot area (return legend as pict?) #49. You now can create a render tree. Pass it to a function that will extract the legend, and later pass this render tree to a plot function (with #f as legend anchor) and only plot it without the legend.
  • '(outside top/bottom): if the legend is only one item, the legend will be much wider than high. Being able to print it at the top or bottom will reduce the space lost for the actual plot. And it looks better in the top-center than the top-left. So yes this was an intended addition. Especially thinking about a future parameter that allows a horizontal layout for the legend.
  • '(inside anchor/c) is indeed equivalent with anchor/c. When I started I was thinking it might make sense to instead of an anchor, pass coordinates to place it at an exact position. In the end I didn't go further with this.

In general: '(outside ...) means it's drawn together with the title, before anything else, and (inside ...) means it's drawn after all other plot items, so indeed '(outside center) makes less sense since it will result in a legend in the middle of the width/height of the plot, but below all other drawn items. Whereas '(inside center) will result in a legend in the middle of the area-width/area-height of the plot, and above al other items.

Also: according to the documentation anchor/c should allow 'auto, which it doesn't, and use 'bottom-left for things that are not a text-label, whereas the legend implementation uses 'top-left.

Copy link
Copy Markdown
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

'auto is used for renders such as point-label, to select an anchor which ensures that the entire label fits inside the plot area, the value does not make sense for the legend, and I forgot to add the documentation. There is also a confusion that the anchor/c contract is not actually used for the point-label and related functions, since they are exported directly from Typed-Racket with the Anchor type -- by the way I use this parameter a lot in my own programs.

the #f case is indeed something I did not thing about, but you are correct that we need it if we want to render the legend as a separate pict. Until now, if the user did not want a legend, they could just not provide a #:label entry for any of their renderers.

also, your explanation for 'inside and 'outside makes sense -- I didn't think about all the possible cases. Leave them as they are, and we see if they need changing.

BTW, I think we should add a todo list on #49 for all the small things that we find, to get to them later. I will add a note about the missing 'auto documentation as well as the note about not beginning the plot when there are no renderers.


(define color/c (or/c (list/c real? real? real?)
string? symbol?
Expand Down
2 changes: 1 addition & 1 deletion plot-lib/plot/private/common/parameter-groups.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -100,7 +100,7 @@
(U False Nonnegative-Real)
(U False String)
(U False Font-Family)
Anchor
Legend-Anchor
Nonnegative-Real
(List Boolean Boolean Boolean Boolean Boolean Boolean)
(List Boolean Anchor Real (U Boolean 'auto) Anchor Real Boolean Anchor Real (U Boolean 'auto) Anchor Real)
Expand Down
2 changes: 1 addition & 1 deletion plot-lib/plot/private/common/parameters.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@
(defparam plot-legend-font-size size (U Nonnegative-Real #f) #f)
(defparam plot-legend-font-face face (U String #f) #f)
(defparam plot-legend-font-family family (U Font-Family #f) #f)
(defparam plot-legend-anchor anchor Anchor 'top-left)
(defparam plot-legend-anchor anchor Legend-Anchor 'top-left)
(defparam2 plot-legend-box-alpha alpha Real Nonnegative-Real 2/3 (unit-ivl 'plot-legend-box-alpha))
(defparam plot-animating? Boolean #f)

Expand Down
120 changes: 61 additions & 59 deletions plot-lib/plot/private/common/plot-device.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -614,11 +614,11 @@
;; the understanding is that Rect will be the complete dc for a legend outside the plot-area
;; and the plot-area otherwise

(: calculate-legend-parameters (-> (Listof legend-entry) Rect
(: calculate-legend-parameters (-> (Listof legend-entry) Rect Anchor
(Values Rect Exact-Rational Exact-Rational Exact-Rational
Nonnegative-Exact-Rational Real Real
Nonnegative-Exact-Rational Real)))
(define/private (calculate-legend-parameters [legend-entries : (Listof legend-entry)][rect : Rect])
(define/private (calculate-legend-parameters legend-entries rect legend-anchor)
(define n (length legend-entries))
(define labels (map legend-entry-label legend-entries))
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) rect)
Expand Down Expand Up @@ -650,7 +650,7 @@
(define legend-x-min
(cond
[(and x-min x-max)
(case (plot-legend-anchor)
(case legend-anchor
[(top-left left bottom-left auto) x-min]
[(top-right right bottom-right) (- x-max legend-x-size)]
[(center bottom top) (- (* 1/2 (+ x-min x-max))
Expand All @@ -661,7 +661,7 @@
(define legend-y-min
(cond
[(and y-min y-max)
(case (plot-legend-anchor)
(case legend-anchor
[(top-left top top-right auto) y-min]
[(bottom-left bottom bottom-right) (- y-max legend-y-size)]
[(center left right) (- (* 1/2 (+ y-min y-max))
Expand All @@ -679,7 +679,7 @@
draw-x-size label-x-min draw-x-min
draw-y-size legend-y-min))

(define/public (calculate-legend-rect legend-entries rect)
(define/public (calculate-legend-rect legend-entries rect legend-anchor)
;; Change font for correct size calculation in calculate-legend-parameters
(define old-size (send (send dc get-font) get-point-size))
(define old-face (send (send dc get-font) get-face))
Expand All @@ -692,64 +692,66 @@
(define-values (legend-rect top-gap baseline-skip max-label-height
draw-x-size label-x-min draw-x-min
draw-y-size legend-y-min)
(calculate-legend-parameters legend-entries rect))
(calculate-legend-parameters legend-entries rect legend-anchor))

;; Undo change font
(set-font-attribs old-size old-face old-family)

legend-rect)

(define/public (draw-legend legend-entries rect)
(match-define (list (legend-entry #{labels : (Listof (U String pict))}
#{draw-procs : (Listof Legend-Draw-Proc)})
...)
legend-entries)

;; Change font early for correct size calculation in calculate-legend-parameters
(define old-size (send (send dc get-font) get-point-size))
(define old-face (send (send dc get-font) get-face))
(define old-family (send (send dc get-font) get-family))
(set-font-attribs
(or (plot-legend-font-size) old-size)
(or (plot-legend-font-face) old-face)
(or (plot-legend-font-family) old-family))

(define-values (legend-rect top-gap baseline-skip max-label-height
draw-x-size label-x-min draw-x-min
draw-y-size legend-y-min)
(calculate-legend-parameters legend-entries rect))

;; legend background
(set-pen (plot-foreground) 1 'transparent)
(set-brush (plot-background) 'solid)
(set-alpha (plot-legend-box-alpha))
(draw-rect legend-rect)

;; legend border
(set-minor-pen)
(set-brush (plot-background) 'transparent)
(set-alpha 3/4)
(draw-rect legend-rect)

(set-alpha (plot-foreground-alpha))
(set-clipping-rect legend-rect)
(for ([label (in-list labels)] [draw-proc (in-list draw-procs)] [i (in-naturals)])
(define-values (_1 label-height _2 _3) (get-text-extent label))
(define legend-entry-y-min (+ legend-y-min top-gap (* i baseline-skip)))
(define label-y-min (+ legend-entry-y-min (* 1/2 (- max-label-height label-height))))
(if (pict? label)
(draw-pict label (vector (ann label-x-min Real) (ann label-y-min Real)) 'top-left 0)
(draw-text label (vector (ann label-x-min Real) (ann label-y-min Real)) 'top-left 0 0 #t))

(define draw-y-min (+ legend-entry-y-min (* 1/2 (- max-label-height draw-y-size))))

(define entry-pd (make-object plot-device% dc draw-x-min draw-y-min draw-x-size draw-y-size))
(send entry-pd reset-drawing-params #f)
(draw-proc this draw-x-size draw-y-size)
(send entry-pd restore-drawing-params))

;; reset plot font attributes
(set-font-attribs old-size old-face old-family)

(clear-clipping-rect))
)) ; end class
(define legend-anchor (plot-legend-anchor))
(when legend-anchor
(match-define (list (legend-entry #{labels : (Listof (U String pict))}
#{draw-procs : (Listof Legend-Draw-Proc)})
...)
legend-entries)

;; Change font early for correct size calculation in calculate-legend-parameters
(define old-size (send (send dc get-font) get-point-size))
(define old-face (send (send dc get-font) get-face))
(define old-family (send (send dc get-font) get-family))
(set-font-attribs
(or (plot-legend-font-size) old-size)
(or (plot-legend-font-face) old-face)
(or (plot-legend-font-family) old-family))

(define-values (legend-rect top-gap baseline-skip max-label-height
draw-x-size label-x-min draw-x-min
draw-y-size legend-y-min)
(calculate-legend-parameters legend-entries rect (if (list? legend-anchor) (cadr legend-anchor) legend-anchor)))

;; legend background
(set-pen (plot-foreground) 1 'transparent)
(set-brush (plot-background) 'solid)
(set-alpha (plot-legend-box-alpha))
(draw-rect legend-rect)

;; legend border
(set-minor-pen)
(set-brush (plot-background) 'transparent)
(set-alpha 3/4)
(draw-rect legend-rect)

(set-alpha (plot-foreground-alpha))
(set-clipping-rect legend-rect)
(for ([label (in-list labels)] [draw-proc (in-list draw-procs)] [i (in-naturals)])
(define-values (_1 label-height _2 _3) (get-text-extent label))
(define legend-entry-y-min (+ legend-y-min top-gap (* i baseline-skip)))
(define label-y-min (+ legend-entry-y-min (* 1/2 (- max-label-height label-height))))
(if (pict? label)
(draw-pict label (vector (ann label-x-min Real) (ann label-y-min Real)) 'top-left 0)
(draw-text label (vector (ann label-x-min Real) (ann label-y-min Real)) 'top-left 0 0 #t))

(define draw-y-min (+ legend-entry-y-min (* 1/2 (- max-label-height draw-y-size))))

(define entry-pd (make-object plot-device% dc draw-x-min draw-y-min draw-x-size draw-y-size))
(send entry-pd reset-drawing-params #f)
(draw-proc this draw-x-size draw-y-size)
(send entry-pd restore-drawing-params))

;; reset plot font attributes
(set-font-attribs old-size old-face old-family)

(clear-clipping-rect))
))) ; end class
Loading