Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[legend pt5] Reserve space for outside legend #74

Merged
merged 5 commits into from
Sep 21, 2020
Merged

[legend pt5] Reserve space for outside legend #74

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
68bdf3a
legend: reserve space outside of plot-area for legend
bdeket Sep 11, 2020
261a3f5
legend: align with plot area when possible
bdeket Sep 16, 2020
bae34cf
legend: change Legend-Anchor
bdeket Sep 19, 2020
e25e9e0
legend: overflow/align with plot area
bdeket Sep 20, 2020
d164bd4
legend: change legend-anchor name
bdeket Sep 21, 2020
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
10 changes: 8 additions & 2 deletions plot-lib/plot/private/common/contract.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,8 +34,14 @@
(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)))
(define legend-anchor/c (or/c anchor/c
(one-of/c
'no-legend
'outside-top-center-dc
Copy link
Collaborator

Choose a reason for hiding this comment

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

This anchor position needs a better name. The term dc will not mean anything to a user of the plot package. Maybe outside-top-center-plot, but I am not sure?

Also, given all the refactoring that was done, I think it will be relatively easy to add new anchor locations in the future.

Copy link
Contributor Author

Choose a reason for hiding this comment

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

maybe outside-global-top-center?

Copy link
Collaborator

Choose a reason for hiding this comment

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

sounds good.

'outside-top-left 'outside-top 'outside-top-right
'outside-left-top 'outside-left 'outside-left-bottom
'outside-right-top 'outside-right 'outside-right-bottom
'outside-bottom-left 'outside-bottom 'outside-bottom-right)))

(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/plot-device.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -719,7 +719,7 @@
(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)))
(calculate-legend-parameters legend-entries rect (legend-anchor->anchor legend-anchor)))

;; legend background
(set-pen (plot-foreground) 1 'transparent)
Expand Down
31 changes: 23 additions & 8 deletions plot-lib/plot/private/common/types.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -93,14 +93,29 @@

(struct legend-entry ([label : (U String pict)] [draw : Legend-Draw-Proc]) #:transparent)

(deftype Legend-Anchor (U #f Anchor (List (U 'inside 'outside) Anchor)))
(define (inside-anchor [a : Legend-Anchor])
(and a
(if (list? a)
(and (eq? (car a) 'inside) (cadr a))
a)))
(define (outside-anchor [a : Legend-Anchor])
(and a (list? a) (eq? (car a) 'outside) (cadr a)))
(deftype Legend-Anchor (U Anchor
'no-legend
'outside-top-center-dc
'outside-top-left 'outside-top 'outside-top-right
'outside-left-top 'outside-left 'outside-left-bottom
'outside-right-top 'outside-right 'outside-right-bottom
'outside-bottom-left 'outside-bottom 'outside-bottom-right))
(define (inside-anchor? [a : Legend-Anchor]) (anchor? a))
(define (outside-anchor? [a : Legend-Anchor])
(and (not (anchor? a)) (not (eq? a 'no-legend))))
(define (legend-anchor->anchor [a : Legend-Anchor]) : Anchor
(if (anchor? a)
a
(case a
[(outside-top-left outside-left-top) 'top-left]
[(outside-top outside-top-center-dc) 'top]
[(outside-top-right outside-right-top) 'top-right]
[(outside-right) 'right]
[(outside-bottom-right outside-right-bottom) 'bottom-right]
[(outside-bottom) 'bottom]
[(outside-bottom-left outside-left-bottom) 'bottom-left]
[(outside-left) 'left]
[else 'auto])))

(define-type Plot-Device%
(Class
Expand Down
105 changes: 90 additions & 15 deletions plot-lib/plot/private/plot2d/plot-area.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -226,18 +226,99 @@
(vector (+ area-x-min (* x area-per-view-x))
(- area-y-max (* y area-per-view-y))))))

(: init-top-margin Real)
(define init-top-margin

(: title-margin Real)
(define title-margin
(let ([title (plot-title)])
(cond [(and (plot-decorations?) title)
(if (pict? title)
(+ (pict-height title) (* 1/2 char-height))
(* 3/2 char-height))]
[else 0])))

;; legend margin calculation and preparation of draw function
(: legend-print (-> (Listof legend-entry) Void))
(: init-left-margin Real)
(: init-right-margin Real)
(: init-top-margin Real)
(: init-bottom-margin Real)
(define-values (legend-print init-left-margin init-right-margin init-top-margin init-bottom-margin)
(let* ([legend-anchor (plot-legend-anchor)]
[legend-rect (and (outside-anchor? legend-anchor)
(not (empty? legend))
(send pd calculate-legend-rect
legend
(vector (ivl dc-x-min (+ dc-x-min dc-x-size))
(ivl dc-y-min (+ dc-y-min dc-y-size)))
(legend-anchor->anchor legend-anchor)))]
[gap (pen-gap)]
[make-print
(λ ([get-bounds : (-> (Listof Real))])
(λ ([legend-entries : (Listof legend-entry)])
(match-define (list x-min x-max y-min y-max gap-size) (get-bounds))
(send pd draw-legend legend-entries
(vector (ivl (+ x-min gap-size) (- x-max gap-size))
(ivl (+ y-min gap-size) (- y-max gap-size))))))]
[make-none (λ ([get-bounds : (-> (Listof Real))])
(values (make-print get-bounds) 0 0 title-margin 0))]
[none (λ () (make-none (λ () (list area-x-min area-x-max area-y-min area-y-max
(+ gap tick-radius)))))])
(cond
[legend-rect
(define double-gap (* 2 gap))
(define tripple-gap (* 3 gap))

;; legend with and height
(match-define (vector (ivl x- x+) (ivl y- y+)) legend-rect)
(define width (if (and x- x+) (+ double-gap (- x+ x-)) 0))
(define height (if (and y- y+) (+ double-gap (- y+ y-)) 0))

;; the maximum width/height for the plot+axis-labels
(define remaining-x-size (- dc-x-size width))
(define remaining-y-size (- dc-y-size title-margin height))

;; Align with dc/title
(define t-print
(make-print
(λ ()
(list dc-x-min (+ dc-x-min dc-x-size)
(+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap))))
;; Align with plot-area
(define v-print
(make-print
(λ ()
(list dc-x-min (+ dc-x-min dc-x-size)
(- area-y-min gap) (+ area-y-max gap) gap))))
(define h-print
(make-print
(λ ()
(list (- area-x-min gap) (+ area-x-max gap)
(+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap))))

(case legend-anchor
[(outside-top-center-dc)
(values t-print 0 0
(+ title-margin (if (< remaining-y-size 0) 0 height) tripple-gap) 0)]
[(outside-top-left outside-top outside-top-right)
(values h-print 0 0
(+ title-margin (if (< remaining-y-size 0) 0 height) tripple-gap) 0)]
[(outside-left-top outside-left outside-left-bottom)
(values v-print (+ (if (< remaining-x-size 0) 0 width) tripple-gap) 0
title-margin 0)]
[(outside-right-top outside-right outside-right-bottom)
(values v-print 0 (+ (if (< remaining-x-size 0) 0 width) tripple-gap)
title-margin 0)]
[(outside-bottom-left outside-bottom outside-bottom-right)
(values h-print 0 0
title-margin (+ (if (< remaining-y-size 0) 0 height) tripple-gap))]
;; unreachable code, but TR complains about 1 vs 5 values if not present
[else (none)])]
[else (none)])))

(: view->dc (-> (Vectorof Real) (Vectorof Real)))
;; Initial view->dc (draws labels and half of every tick off the allotted space on the dc)
(define view->dc (make-view->dc 0 0 init-top-margin 0))
(define view->dc (make-view->dc init-left-margin init-right-margin
init-top-margin init-bottom-margin))

;; ===============================================================================================
;; Tick and label constants
Expand Down Expand Up @@ -553,7 +634,9 @@
(define: top : Real 0)
(define: bottom : Real 0)
(let-values ([(left-val right-val top-val bottom-val)
(margin-fixpoint 0 dc-x-size 0 dc-y-size 0 0 init-top-margin 0
(margin-fixpoint 0 dc-x-size 0 dc-y-size
init-left-margin init-right-margin
init-top-margin init-bottom-margin
(λ ([left : Real] [right : Real] [top : Real] [bottom : Real])
(get-param-vs/set-view->dc! left right top bottom)))])
(set! left left-val)
Expand Down Expand Up @@ -658,7 +741,7 @@
(define/public (start-plot)
(send pd reset-drawing-params)
(send pd clear)
(when (and (not (empty? legend)) (outside-anchor (plot-legend-anchor)))
(when (and (not (empty? legend)) (outside-anchor? (plot-legend-anchor)))
(draw-legend legend))
(draw-title)
(draw-axes)
Expand All @@ -676,19 +759,11 @@
(define/public (end-renderers)
(clear-clip-rect)
(send pd reset-drawing-params)
(when (and (not (empty? legend)) (inside-anchor (plot-legend-anchor)))
(when (and (not (empty? legend)) (inside-anchor? (plot-legend-anchor)))
(draw-legend legend)))

(define/public (draw-legend legend-entries)
(define gap-size (+ (pen-gap) tick-radius))
(define-values (x-min x-max y-min y-max)
(if (outside-anchor (plot-legend-anchor))
(values dc-x-min (+ dc-x-min dc-x-size)
dc-y-min (+ dc-y-min dc-y-size))
(values area-x-min area-x-max area-y-min area-y-max)))
(send pd draw-legend legend-entries
(vector (ivl (+ x-min gap-size) (- x-max gap-size))
(ivl (+ y-min gap-size) (- y-max gap-size)))))
(legend-print legend-entries))

(define/public (end-plot)
(send pd restore-drawing-params))
Expand Down
61 changes: 50 additions & 11 deletions plot-lib/plot/private/plot3d/plot-area.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -372,19 +372,55 @@
(vector (fl+ area-x-mid (fl* x area-per-view-x))
(fl- area-y-mid (fl* z area-per-view-z))))))

(: init-top-margin Real)
(define init-top-margin
(: title-margin Real)
(define title-margin
(let ([title (plot-title)])
(cond [(and (plot-decorations?) title)
(if (pict? title)
(+ (pict-height title) (* 1/2 char-height))
(* 3/2 char-height))]
[else 0])))


(: init-left-margin Real)
(: init-right-margin Real)
(: init-top-margin Real)
(: init-bottom-margin Real)
(define-values (init-left-margin init-right-margin init-top-margin init-bottom-margin)
(let* ([legend-anchor (plot-legend-anchor)]
[legend-rect (and (outside-anchor? legend-anchor)
(not (empty? legend))
(send pd calculate-legend-rect
legend
(vector (ivl dc-x-min (+ dc-x-min dc-x-size))
(ivl dc-y-min (+ dc-y-min dc-y-size)))
(legend-anchor->anchor legend-anchor)))]
[none (λ () (values 0 0 title-margin 0))])
(cond
[legend-rect
(match-define (vector (ivl x- x+) (ivl y- y+)) legend-rect)
(define gap (* 2 (pen-gap)))
(define width (if (and x- x+) (+ gap (- x+ x-)) 0))
(define height (if (and y- y+) (+ gap (- y+ y-)) 0))
(define remaining-x-size (- dc-x-size width))
(define remaining-y-size (- dc-y-size title-margin height))
(case legend-anchor
[(outside-top-left outside-top outside-top-right outside-top-center-dc)
(if (< remaining-y-size 0) (none) (values 0 0 (+ title-margin height) 0))]
[(outside-left-top outside-left outside-left-bottom)
(if (< remaining-x-size 0) (none) (values width 0 title-margin 0))]
[(outside-right-top outside-right outside-right-bottom)
(if (< remaining-x-size 0) (none) (values 0 width title-margin 0))]
[(outside-bottom-left outside-bottom outside-bottom-right)
(if (< remaining-y-size 0) (none) (values 0 0 title-margin height))]
;; unreachable code ...
[else (none)])]
[else (none)])))

;; Initial view->dc
(: view->dc (-> FlVector (Vectorof Real)))
(define view->dc (make-view->dc 0 0 init-top-margin 0))

(define view->dc (make-view->dc init-left-margin init-right-margin
init-top-margin init-bottom-margin))

(: x-axis-angle (-> Real))
(define (x-axis-angle)
(match-define (vector dx dy) (v- (norm->dc (flvector 0.5 0.0 0.0))
Expand Down Expand Up @@ -914,7 +950,9 @@
(define: top : Real 0)
(define: bottom : Real 0)
(let-values ([(left-val right-val top-val bottom-val)
(margin-fixpoint 0 dc-x-size 0 dc-y-size 0 0 init-top-margin 0
(margin-fixpoint 0 dc-x-size 0 dc-y-size
init-left-margin init-right-margin
init-top-margin init-bottom-margin
(λ ([left : Real] [right : Real] [top : Real] [bottom : Real])
(get-param-vs/set-view->dc! left right top bottom)))])
(set! left left-val)
Expand Down Expand Up @@ -1263,7 +1301,7 @@
(define/public (start-plot)
(send pd reset-drawing-params)
(send pd clear)
(when (and (not (empty? legend)) (outside-anchor (plot-legend-anchor)))
(when (and (not (empty? legend)) (outside-anchor? (plot-legend-anchor)))
(draw-legend legend))
(draw-title)
(draw-labels (get-back-label-params))
Expand All @@ -1285,15 +1323,16 @@
(draw-front-axes)
(draw-ticks (get-front-tick-params))
(draw-labels (get-front-label-params))
(when (and (not (empty? legend)) (inside-anchor (plot-legend-anchor)))
(when (and (not (empty? legend)) (inside-anchor? (plot-legend-anchor)))
(draw-legend legend)))

(define/public (draw-legend legend-entries)
(define gap-size (+ (pen-gap) tick-radius))
(define outside? (outside-anchor? (plot-legend-anchor)))
(define gap-size (+ (pen-gap) (if outside? 0 tick-radius)))
(define-values (x-min x-max y-min y-max)
(if (outside-anchor (plot-legend-anchor))
(if outside?
(values dc-x-min (+ dc-x-min dc-x-size)
dc-y-min (+ dc-y-min dc-y-size))
(+ title-margin dc-y-min) (+ dc-y-min dc-y-size))
(values area-x-min area-x-max area-y-min area-y-max)))
(send pd draw-legend legend-entries
(vector (ivl (+ x-min gap-size) (- x-max gap-size))
Expand Down