From 68bdf3a78383cbc2073f916178e30df6d84bd3cc Mon Sep 17 00:00:00 2001 From: bdeket Date: Fri, 11 Sep 2020 13:07:37 +0200 Subject: [PATCH 1/5] legend: reserve space outside of plot-area for legend --- plot-lib/plot/private/plot2d/plot-area.rkt | 52 ++++++++++++++++++-- plot-lib/plot/private/plot3d/plot-area.rkt | 56 +++++++++++++++++++--- 2 files changed, 96 insertions(+), 12 deletions(-) diff --git a/plot-lib/plot/private/plot2d/plot-area.rkt b/plot-lib/plot/private/plot2d/plot-area.rkt index 30d113cc..5168b1b7 100644 --- a/plot-lib/plot/private/plot2d/plot-area.rkt +++ b/plot-lib/plot/private/plot2d/plot-area.rkt @@ -226,18 +226,57 @@ (vector (+ area-x-min (* x area-per-view-x)) (- area-y-max (* y area-per-view-y)))))) + (: init-left-margin Real) + (: init-right-margin Real) (: init-top-margin Real) - (define init-top-margin + (: init-bottom-margin Real) + (: 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]))) + (define-values (init-left-margin init-right-margin init-top-margin init-bottom-margin) + (let* ([legend-anchor (outside-anchor (plot-legend-anchor))] + [legend-rect (and 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))] + [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 x-size-left (- dc-x-size width)) + (define y-size-left (- dc-y-size title-margin height)) + (define (left) (if (< x-size-left 0) (none) (values width 0 title-margin 0))) + (define (top) (if (< y-size-left 0) (none) (values 0 0 (+ title-margin height) 0))) + (define (bottom) (if (< y-size-left 0) (none) (values 0 0 title-margin height))) + (define (right) (if (< x-size-left 0) (none) (values 0 width title-margin 0))) + (case legend-anchor + [(top-left auto) (if (< y-size-left x-size-left) (left) (top))] + [(left) (left)] + [(bottom-left) (if (< y-size-left x-size-left) (left) (bottom))] + [(bottom) (bottom)] + [(bottom-right) (if (< y-size-left x-size-left) (right) (bottom))] + [(right) (right)] + [(top-right) (if (< y-size-left x-size-left) (right) (top))] + [(top) (top)] + ; center : no space reservation + [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 @@ -553,7 +592,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) @@ -680,11 +721,12 @@ (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)) (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)) diff --git a/plot-lib/plot/private/plot3d/plot-area.rkt b/plot-lib/plot/private/plot3d/plot-area.rkt index 65e9c47d..f3e66886 100644 --- a/plot-lib/plot/private/plot3d/plot-area.rkt +++ b/plot-lib/plot/private/plot3d/plot-area.rkt @@ -372,19 +372,58 @@ (vector (fl+ area-x-mid (fl* x area-per-view-x)) (fl- area-y-mid (fl* z area-per-view-z)))))) + (: init-left-margin Real) + (: init-right-margin Real) (: init-top-margin Real) - (define init-top-margin + (: init-bottom-margin Real) + (: 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]))) - + (define-values (init-left-margin init-right-margin init-top-margin init-bottom-margin) + (let* ([legend-anchor (outside-anchor (plot-legend-anchor))] + [legend-rect (and 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))] + [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 x-size-left (- dc-x-size width)) + (define y-size-left (- dc-y-size title-margin height)) + (define (left) (if (< x-size-left 0) (none) (values width 0 title-margin 0))) + (define (top) (if (< y-size-left 0) (none) (values 0 0 (+ title-margin height) 0))) + (define (bottom) (if (< y-size-left 0) (none) (values 0 0 title-margin height))) + (define (right) (if (< x-size-left 0) (none) (values 0 width title-margin 0))) + (case legend-anchor + [(top-left auto) (if (< y-size-left x-size-left) (left) (top))] + [(left) (left)] + [(bottom-left) (if (< y-size-left x-size-left) (left) (bottom))] + [(bottom) (bottom)] + [(bottom-right) (if (< y-size-left x-size-left) (right) (bottom))] + [(right) (right)] + [(top-right) (if (< y-size-left x-size-left) (right) (top))] + [(top) (top)] + ; center : no space reservation + [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)) @@ -914,7 +953,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) @@ -1289,11 +1330,12 @@ (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)) (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)) From 261a3f5981f296632af21d0351206dcf2212a2f3 Mon Sep 17 00:00:00 2001 From: bdeket Date: Wed, 16 Sep 2020 21:16:40 +0200 Subject: [PATCH 2/5] legend: align with plot area when possible --- plot-lib/plot/private/plot2d/plot-area.rkt | 85 ++++++++++++++++------ 1 file changed, 61 insertions(+), 24 deletions(-) diff --git a/plot-lib/plot/private/plot2d/plot-area.rkt b/plot-lib/plot/private/plot2d/plot-area.rkt index 5168b1b7..ef550d8c 100644 --- a/plot-lib/plot/private/plot2d/plot-area.rkt +++ b/plot-lib/plot/private/plot2d/plot-area.rkt @@ -226,10 +226,7 @@ (vector (+ area-x-min (* x area-per-view-x)) (- area-y-max (* y area-per-view-y)))))) - (: init-left-margin Real) - (: init-right-margin Real) - (: init-top-margin Real) - (: init-bottom-margin Real) + (: title-margin Real) (define title-margin (let ([title (plot-title)]) @@ -238,7 +235,14 @@ (+ (pict-height title) (* 1/2 char-height)) (* 3/2 char-height))] [else 0]))) - (define-values (init-left-margin init-right-margin init-top-margin init-bottom-margin) + + ;; 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 (outside-anchor (plot-legend-anchor))] [legend-rect (and legend-anchor (not (empty? legend)) @@ -247,19 +251,53 @@ (vector (ivl dc-x-min (+ dc-x-min dc-x-size)) (ivl dc-y-min (+ dc-y-min dc-y-size))) legend-anchor))] - [none (λ () (values 0 0 title-margin 0))]) + [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 2*gap (* 2 gap)) + (define 3*gap (* 3 gap)) + + ;; legend with and height (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 width (if (and x- x+) (+ 2*gap (- x+ x-)) 0)) + (define height (if (and y- y+) (+ 2*gap (- y+ y-)) 0)) + + ;; the maximum width/height for the plot+axis-labels (define x-size-left (- dc-x-size width)) (define y-size-left (- dc-y-size title-margin height)) - (define (left) (if (< x-size-left 0) (none) (values width 0 title-margin 0))) - (define (top) (if (< y-size-left 0) (none) (values 0 0 (+ title-margin height) 0))) - (define (bottom) (if (< y-size-left 0) (none) (values 0 0 title-margin height))) - (define (right) (if (< x-size-left 0) (none) (values 0 width title-margin 0))) + + ;; the print-functions try to align with the plot-area, but if they are to wide + ;; they fall back to the complete dc + (define v-print + (make-print + (λ () + (define area-height (- area-y-max area-y-min)) + (if (< height area-height) + (list dc-x-min (+ dc-x-min dc-x-size) (- area-y-min gap) (+ area-y-max gap) gap) + (list dc-x-min (+ dc-x-min dc-x-size) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap))))) + (define h-print + (make-print + (λ () + (define area-width (- area-x-max area-x-min)) + (if (< width area-width) + (list (- area-x-min gap) (+ area-x-max gap) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap) + (list dc-x-min (+ dc-x-min dc-x-size) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap))))) + + (define (top) (if (< y-size-left 0) (none) (values h-print 0 0 (+ title-margin height 3*gap) 0))) + (define (bottom) (if (< y-size-left 0) (none) (values h-print 0 0 title-margin (+ height 3*gap)))) + (define (left) (if (< x-size-left 0) (none) (values v-print (+ width 3*gap) 0 title-margin 0))) + (define (right) (if (< x-size-left 0) (none) (values v-print 0 (+ width 3*gap) title-margin 0))) (case legend-anchor [(top-left auto) (if (< y-size-left x-size-left) (left) (top))] [(left) (left)] @@ -270,7 +308,15 @@ [(top-right) (if (< y-size-left x-size-left) (right) (top))] [(top) (top)] ; center : no space reservation - [else (none)])] + [else + (make-none + (λ () + (append (if (< x-size-left 0) + (list dc-x-min (+ dc-x-min dc-x-size)) + (list area-x-min area-x-max)) + (if (< y-size-left 0) + (list (+ dc-y-min title-margin) (+ dc-y-min dc-y-size) gap) + (list area-y-min area-y-max (+ gap tick-radius))))))])] [else (none)]))) (: view->dc (-> (Vectorof Real) (Vectorof Real))) @@ -721,16 +767,7 @@ (draw-legend legend))) (define/public (draw-legend legend-entries) - (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)) - (values dc-x-min (+ dc-x-min dc-x-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)) - (ivl (+ y-min gap-size) (- y-max gap-size))))) + (legend-print legend-entries)) (define/public (end-plot) (send pd restore-drawing-params)) From bae34cfd9ee5ac419208565ea491f36f73576ef7 Mon Sep 17 00:00:00 2001 From: bdeket Date: Sat, 19 Sep 2020 17:46:48 +0200 Subject: [PATCH 3/5] legend: change Legend-Anchor --- plot-lib/plot/private/common/contract.rkt | 9 +++- plot-lib/plot/private/common/plot-device.rkt | 2 +- plot-lib/plot/private/common/types.rkt | 30 ++++++++---- plot-lib/plot/private/plot2d/plot-area.rkt | 41 +++++++--------- plot-lib/plot/private/plot3d/plot-area.rkt | 49 +++++++++----------- 5 files changed, 71 insertions(+), 60 deletions(-) diff --git a/plot-lib/plot/private/common/contract.rkt b/plot-lib/plot/private/common/contract.rkt index d814c0e6..5a5536e9 100644 --- a/plot-lib/plot/private/common/contract.rkt +++ b/plot-lib/plot/private/common/contract.rkt @@ -34,8 +34,13 @@ (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-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? diff --git a/plot-lib/plot/private/common/plot-device.rkt b/plot-lib/plot/private/common/plot-device.rkt index ba3c4399..dfe864d5 100644 --- a/plot-lib/plot/private/common/plot-device.rkt +++ b/plot-lib/plot/private/common/plot-device.rkt @@ -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) diff --git a/plot-lib/plot/private/common/types.rkt b/plot-lib/plot/private/common/types.rkt index 0b4bae6d..535868ba 100644 --- a/plot-lib/plot/private/common/types.rkt +++ b/plot-lib/plot/private/common/types.rkt @@ -93,14 +93,28 @@ (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-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) '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 diff --git a/plot-lib/plot/private/plot2d/plot-area.rkt b/plot-lib/plot/private/plot2d/plot-area.rkt index ef550d8c..b2eea89a 100644 --- a/plot-lib/plot/private/plot2d/plot-area.rkt +++ b/plot-lib/plot/private/plot2d/plot-area.rkt @@ -243,14 +243,14 @@ (: 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 (outside-anchor (plot-legend-anchor))] - [legend-rect (and legend-anchor + (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))] + (legend-anchor->anchor legend-anchor)))] [gap (pen-gap)] [make-print (λ ([get-bounds : (-> (Listof Real))]) @@ -274,8 +274,8 @@ (define height (if (and y- y+) (+ 2*gap (- y+ y-)) 0)) ;; the maximum width/height for the plot+axis-labels - (define x-size-left (- dc-x-size width)) - (define y-size-left (- dc-y-size title-margin height)) + (define remaining-x-size (- dc-x-size width)) + (define remaining-y-size (- dc-y-size title-margin height)) ;; the print-functions try to align with the plot-area, but if they are to wide ;; they fall back to the complete dc @@ -294,27 +294,22 @@ (list (- area-x-min gap) (+ area-x-max gap) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap) (list dc-x-min (+ dc-x-min dc-x-size) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap))))) - (define (top) (if (< y-size-left 0) (none) (values h-print 0 0 (+ title-margin height 3*gap) 0))) - (define (bottom) (if (< y-size-left 0) (none) (values h-print 0 0 title-margin (+ height 3*gap)))) - (define (left) (if (< x-size-left 0) (none) (values v-print (+ width 3*gap) 0 title-margin 0))) - (define (right) (if (< x-size-left 0) (none) (values v-print 0 (+ width 3*gap) title-margin 0))) + (define (top) (if (< remaining-y-size 0) (none) (values h-print 0 0 (+ title-margin height 3*gap) 0))) + (define (bottom) (if (< remaining-y-size 0) (none) (values h-print 0 0 title-margin (+ height 3*gap)))) + (define (left) (if (< remaining-x-size 0) (none) (values v-print (+ width 3*gap) 0 title-margin 0))) + (define (right) (if (< remaining-x-size 0) (none) (values v-print 0 (+ width 3*gap) title-margin 0))) (case legend-anchor - [(top-left auto) (if (< y-size-left x-size-left) (left) (top))] - [(left) (left)] - [(bottom-left) (if (< y-size-left x-size-left) (left) (bottom))] - [(bottom) (bottom)] - [(bottom-right) (if (< y-size-left x-size-left) (right) (bottom))] - [(right) (right)] - [(top-right) (if (< y-size-left x-size-left) (right) (top))] - [(top) (top)] - ; center : no space reservation - [else + [(outside-top-left outside-top outside-top-right) (top)] + [(outside-left-top outside-left outside-left-bottom) (left)] + [(outside-right-top outside-right outside-right-bottom) (right)] + [(outside-bottom-left outside-bottom outside-bottom-right) (bottom)] + [else ;; unreachable code, but TR complains about 1 vs 5 values if not present (make-none (λ () - (append (if (< x-size-left 0) + (append (if (< remaining-x-size 0) (list dc-x-min (+ dc-x-min dc-x-size)) (list area-x-min area-x-max)) - (if (< y-size-left 0) + (if (< remaining-y-size 0) (list (+ dc-y-min title-margin) (+ dc-y-min dc-y-size) gap) (list area-y-min area-y-max (+ gap tick-radius))))))])] [else (none)]))) @@ -745,7 +740,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) @@ -763,7 +758,7 @@ (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) diff --git a/plot-lib/plot/private/plot3d/plot-area.rkt b/plot-lib/plot/private/plot3d/plot-area.rkt index f3e66886..bb5f1c65 100644 --- a/plot-lib/plot/private/plot3d/plot-area.rkt +++ b/plot-lib/plot/private/plot3d/plot-area.rkt @@ -372,10 +372,6 @@ (vector (fl+ area-x-mid (fl* x area-per-view-x)) (fl- area-y-mid (fl* z area-per-view-z)))))) - (: init-left-margin Real) - (: init-right-margin Real) - (: init-top-margin Real) - (: init-bottom-margin Real) (: title-margin Real) (define title-margin (let ([title (plot-title)]) @@ -384,15 +380,20 @@ (+ (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 (outside-anchor (plot-legend-anchor))] - [legend-rect (and legend-anchor + (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))] + (legend-anchor->anchor legend-anchor)))] [none (λ () (values 0 0 title-margin 0))]) (cond [legend-rect @@ -400,22 +401,18 @@ (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 x-size-left (- dc-x-size width)) - (define y-size-left (- dc-y-size title-margin height)) - (define (left) (if (< x-size-left 0) (none) (values width 0 title-margin 0))) - (define (top) (if (< y-size-left 0) (none) (values 0 0 (+ title-margin height) 0))) - (define (bottom) (if (< y-size-left 0) (none) (values 0 0 title-margin height))) - (define (right) (if (< x-size-left 0) (none) (values 0 width title-margin 0))) + (define remaining-x-size (- dc-x-size width)) + (define remaining-y-size (- dc-y-size title-margin height)) + (define (left) (if (< remaining-x-size 0) (none) (values width 0 title-margin 0))) + (define (top) (if (< remaining-y-size 0) (none) (values 0 0 (+ title-margin height) 0))) + (define (bottom) (if (< remaining-y-size 0) (none) (values 0 0 title-margin height))) + (define (right) (if (< remaining-x-size 0) (none) (values 0 width title-margin 0))) (case legend-anchor - [(top-left auto) (if (< y-size-left x-size-left) (left) (top))] - [(left) (left)] - [(bottom-left) (if (< y-size-left x-size-left) (left) (bottom))] - [(bottom) (bottom)] - [(bottom-right) (if (< y-size-left x-size-left) (right) (bottom))] - [(right) (right)] - [(top-right) (if (< y-size-left x-size-left) (right) (top))] - [(top) (top)] - ; center : no space reservation + [(outside-top-left outside-top outside-top-right) (top)] + [(outside-left-top outside-left outside-left-bottom) (left)] + [(outside-right-top outside-right outside-right-bottom) (right)] + [(outside-bottom-left outside-bottom outside-bottom-right) (bottom)] + ;; unreachable code ... [else (none)])] [else (none)]))) @@ -1304,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)) @@ -1326,14 +1323,14 @@ (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 outside? (outside-anchor (plot-legend-anchor))) + (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) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size)) (values area-x-min area-x-max area-y-min area-y-max))) From e25e9e0c1e3ae87d8111e4140fcac0fb7ab5555d Mon Sep 17 00:00:00 2001 From: bdeket Date: Sun, 20 Sep 2020 23:30:24 +0200 Subject: [PATCH 4/5] legend: overflow/align with plot area --- plot-lib/plot/private/common/contract.rkt | 1 + plot-lib/plot/private/common/types.rkt | 3 +- plot-lib/plot/private/plot2d/plot-area.rkt | 63 +++++++++++----------- plot-lib/plot/private/plot3d/plot-area.rkt | 16 +++--- 4 files changed, 43 insertions(+), 40 deletions(-) diff --git a/plot-lib/plot/private/common/contract.rkt b/plot-lib/plot/private/common/contract.rkt index 5a5536e9..dfdd0dae 100644 --- a/plot-lib/plot/private/common/contract.rkt +++ b/plot-lib/plot/private/common/contract.rkt @@ -37,6 +37,7 @@ (define legend-anchor/c (or/c anchor/c (one-of/c '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 diff --git a/plot-lib/plot/private/common/types.rkt b/plot-lib/plot/private/common/types.rkt index 535868ba..45542e9e 100644 --- a/plot-lib/plot/private/common/types.rkt +++ b/plot-lib/plot/private/common/types.rkt @@ -95,6 +95,7 @@ (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 @@ -107,7 +108,7 @@ a (case a [(outside-top-left outside-left-top) 'top-left] - [(outside-top) 'top] + [(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] diff --git a/plot-lib/plot/private/plot2d/plot-area.rkt b/plot-lib/plot/private/plot2d/plot-area.rkt index b2eea89a..84a4e763 100644 --- a/plot-lib/plot/private/plot2d/plot-area.rkt +++ b/plot-lib/plot/private/plot2d/plot-area.rkt @@ -265,53 +265,54 @@ (+ gap tick-radius)))))]) (cond [legend-rect - (define 2*gap (* 2 gap)) - (define 3*gap (* 3 gap)) + (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+) (+ 2*gap (- x+ x-)) 0)) - (define height (if (and y- y+) (+ 2*gap (- y+ y-)) 0)) + (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)) - ;; the print-functions try to align with the plot-area, but if they are to wide - ;; they fall back to the complete dc + ;; 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 (λ () - (define area-height (- area-y-max area-y-min)) - (if (< height area-height) - (list dc-x-min (+ dc-x-min dc-x-size) (- area-y-min gap) (+ area-y-max gap) gap) - (list dc-x-min (+ dc-x-min dc-x-size) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap))))) + (list dc-x-min (+ dc-x-min dc-x-size) + (- area-y-min gap) (+ area-y-max gap) gap)))) (define h-print (make-print (λ () - (define area-width (- area-x-max area-x-min)) - (if (< width area-width) - (list (- area-x-min gap) (+ area-x-max gap) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap) - (list dc-x-min (+ dc-x-min dc-x-size) (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap))))) + (list (- area-x-min gap) (+ area-x-max gap) + (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap)))) - (define (top) (if (< remaining-y-size 0) (none) (values h-print 0 0 (+ title-margin height 3*gap) 0))) - (define (bottom) (if (< remaining-y-size 0) (none) (values h-print 0 0 title-margin (+ height 3*gap)))) - (define (left) (if (< remaining-x-size 0) (none) (values v-print (+ width 3*gap) 0 title-margin 0))) - (define (right) (if (< remaining-x-size 0) (none) (values v-print 0 (+ width 3*gap) title-margin 0))) (case legend-anchor - [(outside-top-left outside-top outside-top-right) (top)] - [(outside-left-top outside-left outside-left-bottom) (left)] - [(outside-right-top outside-right outside-right-bottom) (right)] - [(outside-bottom-left outside-bottom outside-bottom-right) (bottom)] - [else ;; unreachable code, but TR complains about 1 vs 5 values if not present - (make-none - (λ () - (append (if (< remaining-x-size 0) - (list dc-x-min (+ dc-x-min dc-x-size)) - (list area-x-min area-x-max)) - (if (< remaining-y-size 0) - (list (+ dc-y-min title-margin) (+ dc-y-min dc-y-size) gap) - (list area-y-min area-y-max (+ gap tick-radius))))))])] + [(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))) diff --git a/plot-lib/plot/private/plot3d/plot-area.rkt b/plot-lib/plot/private/plot3d/plot-area.rkt index bb5f1c65..e06df024 100644 --- a/plot-lib/plot/private/plot3d/plot-area.rkt +++ b/plot-lib/plot/private/plot3d/plot-area.rkt @@ -403,15 +403,15 @@ (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)) - (define (left) (if (< remaining-x-size 0) (none) (values width 0 title-margin 0))) - (define (top) (if (< remaining-y-size 0) (none) (values 0 0 (+ title-margin height) 0))) - (define (bottom) (if (< remaining-y-size 0) (none) (values 0 0 title-margin height))) - (define (right) (if (< remaining-x-size 0) (none) (values 0 width title-margin 0))) (case legend-anchor - [(outside-top-left outside-top outside-top-right) (top)] - [(outside-left-top outside-left outside-left-bottom) (left)] - [(outside-right-top outside-right outside-right-bottom) (right)] - [(outside-bottom-left outside-bottom outside-bottom-right) (bottom)] + [(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)]))) From d164bd421fed71d9f6d383de23040bcd563f2d0a Mon Sep 17 00:00:00 2001 From: bdeket Date: Mon, 21 Sep 2020 19:25:58 +0200 Subject: [PATCH 5/5] legend: change legend-anchor name --- plot-lib/plot/private/common/contract.rkt | 2 +- plot-lib/plot/private/common/types.rkt | 4 ++-- plot-lib/plot/private/plot2d/plot-area.rkt | 2 +- plot-lib/plot/private/plot3d/plot-area.rkt | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/plot-lib/plot/private/common/contract.rkt b/plot-lib/plot/private/common/contract.rkt index dfdd0dae..ba4e881e 100644 --- a/plot-lib/plot/private/common/contract.rkt +++ b/plot-lib/plot/private/common/contract.rkt @@ -37,7 +37,7 @@ (define legend-anchor/c (or/c anchor/c (one-of/c 'no-legend - 'outside-top-center-dc + 'outside-global-top 'outside-top-left 'outside-top 'outside-top-right 'outside-left-top 'outside-left 'outside-left-bottom 'outside-right-top 'outside-right 'outside-right-bottom diff --git a/plot-lib/plot/private/common/types.rkt b/plot-lib/plot/private/common/types.rkt index 45542e9e..9b6fb2ba 100644 --- a/plot-lib/plot/private/common/types.rkt +++ b/plot-lib/plot/private/common/types.rkt @@ -95,7 +95,7 @@ (deftype Legend-Anchor (U Anchor 'no-legend - 'outside-top-center-dc + 'outside-global-top 'outside-top-left 'outside-top 'outside-top-right 'outside-left-top 'outside-left 'outside-left-bottom 'outside-right-top 'outside-right 'outside-right-bottom @@ -108,7 +108,7 @@ a (case a [(outside-top-left outside-left-top) 'top-left] - [(outside-top outside-top-center-dc) 'top] + [(outside-top outside-global-top) 'top] [(outside-top-right outside-right-top) 'top-right] [(outside-right) 'right] [(outside-bottom-right outside-right-bottom) 'bottom-right] diff --git a/plot-lib/plot/private/plot2d/plot-area.rkt b/plot-lib/plot/private/plot2d/plot-area.rkt index 84a4e763..a489801a 100644 --- a/plot-lib/plot/private/plot2d/plot-area.rkt +++ b/plot-lib/plot/private/plot2d/plot-area.rkt @@ -296,7 +296,7 @@ (+ title-margin dc-y-min) (+ dc-y-min dc-y-size) gap)))) (case legend-anchor - [(outside-top-center-dc) + [(outside-global-top) (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) diff --git a/plot-lib/plot/private/plot3d/plot-area.rkt b/plot-lib/plot/private/plot3d/plot-area.rkt index e06df024..550277d5 100644 --- a/plot-lib/plot/private/plot3d/plot-area.rkt +++ b/plot-lib/plot/private/plot3d/plot-area.rkt @@ -404,7 +404,7 @@ (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) + [(outside-top-left outside-top outside-top-right outside-global-top) (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))]