Skip to content

[legend pt4] Plot+legend picts #73

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

Closed
bdeket wants to merge 1 commit into from
Closed

[legend pt4] Plot+legend picts #73

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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-lib/plot/no-gui.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@
(provide
plot/dc
plot-bitmap
plot-pict
plot-pict legend-pict plot+legend-picts
plot-file)

(require "private/plot2d/point.rkt")
Expand Down Expand Up @@ -125,7 +125,7 @@
(provide
plot3d/dc
plot3d-bitmap
plot3d-pict
plot3d-pict legend3d-pict plot+legend3d-picts
plot3d-file)

(require "private/plot3d/surface.rkt")
Expand Down
78 changes: 76 additions & 2 deletions plot-lib/plot/private/no-gui/plot2d.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#lang typed/racket/base

(require typed/racket/draw typed/racket/class
(require typed/racket/draw typed/racket/class racket/match
(only-in typed/pict pict)
"../common/type-doc.rkt"
"../common/types.rkt"
Expand All @@ -12,6 +12,8 @@
"../common/nonrenderer.rkt"
"../common/file-type.rkt"
"../common/utils.rkt"
"../common/plot-device.rkt"
"../common/math.rkt"
"../plot2d/plot-area.rkt"
"../plot2d/renderer.rkt"
"plot2d-utils.rkt"
Expand All @@ -20,7 +22,7 @@

(unsafe-provide plot/dc
plot-bitmap
plot-pict
plot-pict legend-pict plot+legend-picts
plot-file)

;; ===================================================================================================
Expand Down Expand Up @@ -131,6 +133,78 @@
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor)))
width height))

(:: legend-pict
(->* [(Treeof (U renderer2d nonrenderer))]
[#:x-min (U Real #f) #:x-max (U Real #f)
#:y-min (U Real #f) #:y-max (U Real #f)]
Pict))
(define (legend-pict renderer-tree

@alex-hhh alex-hhh Sep 18, 2020

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.

The name legend-pict is a bit confusing (in my opinion anyway). I think plot-legend-as-pict would be a better option, but perhaps there are other possibilities?

I also feel that using the x-min ... arguments is a bit counter-intuitive, but I understand why it is necessary.

#:x-min [x-min #f] #:x-max [x-max #f]
#:y-min [y-min #f] #:y-max [y-max #f])
(define fail/kw (make-raise-keyword-error 'plot/dc))
(cond
[(and x-min (not (rational? x-min))) (fail/kw "#f or rational" '#:x-min x-min)]
[(and x-max (not (rational? x-max))) (fail/kw "#f or rational" '#:x-max x-max)]
[(and y-min (not (rational? y-min))) (fail/kw "#f or rational" '#:y-min y-min)]
[(and y-max (not (rational? y-max))) (fail/kw "#f or rational" '#:y-max y-max)]
[else
(define saved-values (plot-parameters))

(define renderer-list (get-renderer-list renderer-tree))
(define bounds-rect (get-bounds-rect renderer-list x-min x-max y-min y-max))
(define legend (get-legend-entry-list renderer-list bounds-rect))

(define-values (width height)
(parameterize/group ([plot-parameters saved-values])

@alex-hhh alex-hhh Sep 18, 2020

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 don't think we need parameterize/group here -- this code runs in the same thread that captured the parameters.

(define width : Nonnegative-Real 0)
(define height : Nonnegative-Real 0)
(dc (λ (dc x y)
(define dummy (make-object plot-device% dc x y 1 1))
(send dummy reset-drawing-params)
(match-define (vector (ivl x- x+) (ivl y- y+))
(send dummy calculate-legend-rect legend (vector (ivl x 1) (ivl y 1)) 'top-left))
(send dummy restore-drawing-params)
(when (and x- x+) (let ([w (- x+ x-)]) (when (< 0 w) (set! width w))))
(when (and y- y+) (let ([h (- y+ y-)]) (when (< 0 h) (set! height h)))))
1 1)
(values width height)))

(dc (λ (dc x y)
(parameterize/group ([plot-parameters saved-values])
(define pd (make-object plot-device% dc x y width height))
(send pd reset-drawing-params)
(send pd clear)
(send pd draw-legend legend (vector (ivl x (+ x width)) (ivl y (+ y height))))
(send pd restore-drawing-params)))
width height)]))

(:: plot+legend-picts

@alex-hhh alex-hhh Sep 18, 2020

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 don't think this function is necessary, as it does not provide any more functionality than calling plot-pict and legend-pict separately, and I would prefer to keep the new API functions to a minimum

(->* [(Treeof (U renderer2d nonrenderer))]
[#:x-min (U Real #f) #:x-max (U Real #f)
#:y-min (U Real #f) #:y-max (U Real #f)
#:width Positive-Integer
#:height Positive-Integer
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)]
(Values Pict Pict)))
(define (plot+legend-picts renderer-tree
#:x-min [x-min #f] #:x-max [x-max #f]
#:y-min [y-min #f] #:y-max [y-max #f]
#:width [width (plot-width)]
#:height [height (plot-height)]
#:title [title (plot-title)]
#:x-label [x-label (plot-x-label)]
#:y-label [y-label (plot-y-label)])
(define saved-values (plot-parameters))
(values
(dc (λ (dc x y)
(parameterize/group ([plot-parameters saved-values])
(plot/dc renderer-tree dc x y width height
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max
#:title title #:x-label x-label #:y-label y-label #:legend-anchor #f)))
width height)
(legend-pict renderer-tree #:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max)))
;; ===================================================================================================
;; Plot to a file

Expand Down
82 changes: 80 additions & 2 deletions plot-lib/plot/private/no-gui/plot3d.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#lang typed/racket/base

(require typed/racket/draw typed/racket/class
(require typed/racket/draw typed/racket/class racket/match
(only-in typed/pict pict)
"../common/type-doc.rkt"
"../common/types.rkt"
Expand All @@ -12,6 +12,8 @@
"../common/nonrenderer.rkt"
"../common/file-type.rkt"
"../common/utils.rkt"
"../common/math.rkt"
"../common/plot-device.rkt"
"../plot3d/plot-area.rkt"
"../plot3d/renderer.rkt"
"plot3d-utils.rkt"
Expand All @@ -22,7 +24,7 @@

(unsafe-provide plot3d/dc
plot3d-bitmap
plot3d-pict
plot3d-pict legend3d-pict plot+legend3d-picts
plot3d-file)

;; ===================================================================================================
Expand Down Expand Up @@ -171,6 +173,82 @@
#:y-label y-label #:z-label z-label #:legend-anchor legend-anchor)))
width height))

(:: legend3d-pict
(->* [(Treeof (U renderer3d nonrenderer))]
[#:x-min (U Real #f) #:x-max (U Real #f)
#:y-min (U Real #f) #:y-max (U Real #f)]
Pict))
(define (legend3d-pict renderer-tree

@alex-hhh alex-hhh Sep 18, 2020

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.

Same remark about the naming, perhaps plot3d-legend-as-pict?

#:x-min [x-min #f] #:x-max [x-max #f]
#:y-min [y-min #f] #:y-max [y-max #f]
#:z-min [z-min #f] #:z-max [z-max #f])
(define fail/kw (make-raise-keyword-error 'plot/dc))
(cond
[(and x-min (not (rational? x-min))) (fail/kw "#f or rational" '#:x-min x-min)]
[(and x-max (not (rational? x-max))) (fail/kw "#f or rational" '#:x-max x-max)]
[(and y-min (not (rational? y-min))) (fail/kw "#f or rational" '#:y-min y-min)]
[(and y-max (not (rational? y-max))) (fail/kw "#f or rational" '#:y-max y-max)]
[(and z-min (not (rational? y-min))) (fail/kw "#f or rational" '#:z-min z-min)]
[(and z-max (not (rational? y-max))) (fail/kw "#f or rational" '#:z-max z-max)]
[else
(define saved-values (plot-parameters))

(define renderer-list (get-renderer-list renderer-tree))
(define bounds-rect (get-bounds-rect renderer-list x-min x-max y-min y-max z-min z-max))
(define legend (get-legend-entry-list renderer-list bounds-rect))

(define-values (width height)
(parameterize/group ([plot-parameters saved-values])
(define width : Nonnegative-Real 0)
(define height : Nonnegative-Real 0)
(dc (λ (dc x y)
(define dummy (make-object plot-device% dc x y 1 1))
(send dummy reset-drawing-params)
(match-define (vector (ivl x- x+) (ivl y- y+))
(send dummy calculate-legend-rect legend (vector (ivl x 1) (ivl y 1)) 'top-left))
(send dummy restore-drawing-params)
(when (and x- x+) (let ([w (- x+ x-)]) (when (< 0 w) (set! width w))))
(when (and y- y+) (let ([h (- y+ y-)]) (when (< 0 h) (set! height h)))))
1 1)
(values width height)))

(dc (λ (dc x y)
(parameterize/group ([plot-parameters saved-values])
(define pd (make-object plot-device% dc x y width height))
(send pd reset-drawing-params)
(send pd clear)
(send pd draw-legend legend (vector (ivl x (+ x width)) (ivl y (+ y height))))
(send pd restore-drawing-params)))
width height)]))

(:: plot+legend3d-picts
(->* [(Treeof (U renderer3d nonrenderer))]
[#:x-min (U Real #f) #:x-max (U Real #f)
#:y-min (U Real #f) #:y-max (U Real #f)
#:width Positive-Integer
#:height Positive-Integer
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)]
(Values Pict Pict)))
(define (plot+legend3d-picts renderer-tree

@alex-hhh alex-hhh Sep 18, 2020

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.

Same remark as for 2D plots -- I don't think this function is necessary

#:x-min [x-min #f] #:x-max [x-max #f]
#:y-min [y-min #f] #:y-max [y-max #f]
#:width [width (plot-width)]
#:height [height (plot-height)]
#:title [title (plot-title)]
#:x-label [x-label (plot-x-label)]
#:y-label [y-label (plot-y-label)])
(define saved-values (plot-parameters))
(values
(dc (λ (dc x y)
(parameterize/group ([plot-parameters saved-values])
(plot3d/dc renderer-tree dc x y width height
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max
#:title title #:x-label x-label #:y-label y-label #:legend-anchor #f)))
width height)
(legend3d-pict renderer-tree #:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max)))

;; ===================================================================================================
;; Plot to any supported kind of file

Expand Down