Skip to content

Allow pictures to be used as title and axis labels in plots #65

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

Merged
alex-hhh merged 1 commit into from
Aug 28, 2020
Merged

Allow pictures to be used as title and axis labels in plots #65

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
3 changes: 3 additions & 0 deletions .github/workflows/ci.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,9 @@ jobs:
name: "Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})"
runs-on: ubuntu-latest
strategy:
# Let all jobs run to completion -- this will allow us to determine if
# the failure is specific to a Racket version.
fail-fast: false
matrix:
racket-version: ["7.8", "current"]
racket-variant: ["regular", "CS"]
Expand Down
18 changes: 11 additions & 7 deletions plot-doc/plot/scribblings/plotting.scrbl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,9 +25,9 @@ Each 3D plotting procedure behaves the same way as its corresponding 2D procedur
[#:y-min y-min (or/c rational? #f) #f] [#:y-max y-max (or/c rational? #f) #f]
[#:width width exact-positive-integer? (plot-width)]
[#:height height exact-positive-integer? (plot-height)]
[#:title title (or/c string? #f) (plot-title)]
[#:x-label x-label (or/c string? #f) (plot-x-label)]
[#:y-label y-label (or/c string? #f) (plot-y-label)]
[#:title title (or/c string? pict? #f) (plot-title)]
[#:x-label x-label (or/c string? pict? #f) (plot-x-label)]
[#:y-label y-label (or/c string? pict? #f) (plot-y-label)]
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
[#:out-file out-file (or/c path-string? output-port? #f) #f]
[#:out-kind out-kind plot-file-format/c 'auto]
Expand Down Expand Up @@ -60,6 +60,8 @@ Here, the renderer draws in [-1,1] × [-1,1], but the plot area is [-1.5,1.5] ×
@bold{Deprecated keywords.} The @(racket #:fgcolor) and @(racket #:bgcolor) keyword arguments are currently supported for backward compatibility, but may not be in the future.
Please set the @(racket plot-foreground) and @(racket plot-background) parameters instead of using these keyword arguments.
The @(racket #:lncolor) keyword argument is also accepted for backward compatibility but deprecated. It does nothing.

@history[#:changed "7.9" "Added support for pictures for #:title, #:x-label and #:y-label"]
}

@defproc[(plot3d [renderer-tree (treeof (or/c renderer3d? nonrenderer?))]
Expand All @@ -70,10 +72,10 @@ The @(racket #:lncolor) keyword argument is also accepted for backward compatibi
[#:height height exact-positive-integer? (plot-height)]
[#:angle angle real? (plot3d-angle)]
[#:altitude altitude real? (plot3d-altitude)]
[#:title title (or/c string? #f) (plot-title)]
[#:x-label x-label (or/c string? #f) (plot-x-label)]
[#:y-label y-label (or/c string? #f) (plot-y-label)]
[#:z-label z-label (or/c string? #f) (plot-z-label)]
[#:title title (or/c string? pict? #f) (plot-title)]
[#:x-label x-label (or/c string? pict? #f) (plot-x-label)]
[#:y-label y-label (or/c string? pict? #f) (plot-y-label)]
[#:z-label z-label (or/c string? pict? #f) (plot-z-label)]
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
[#:out-file out-file (or/c path-string? output-port? #f) #f]
[#:out-kind out-kind plot-file-format/c 'auto]
Expand All @@ -91,6 +93,8 @@ Please set the @(racket plot-foreground) and @(racket plot-background) parameter
The @(racket #:lncolor) keyword argument is also accepted for backward compatibility but deprecated. It does nothing.

The @(racket #:az) and @(racket #:alt) keyword arguments are backward-compatible, deprecated aliases for @(racket #:angle) and @(racket #:altitude), respectively.

@history[#:changed "7.9" "Added support for pictures for #:title, #:x-label, #:y-label and #:z-label"]
}

@defproc[(plot-snip [<plot-argument> <plot-argument-contract>] ...)
Expand Down
226 changes: 135 additions & 91 deletions plot-gui-lib/plot/private/gui/plot2d.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,8 +1,38 @@
#lang typed/racket/base
#lang typed/racket/base #:no-optimize

;;;; About `#:no-optimize` and `unsafe-provide`

;; This file provides the toplevel plot functions for 2D plotting and there
;; are two peculiarities in this file: the use of `#:no-optimize` and using
;; `unsafe-provide` to export the symbols.
;;
;; The plot library is written in Typed Racket (TR), but needs to be usable
;; from Racket. TR will attach contracts to all functions it exports (as well
;; as values those functions return) to ensure the values for the parameters
;; are correct when these functions are called from Racket. Unfortunately,
;; when returning the snips for the plots, the attached contracts to the snip
;; interface will slow down interactive programs significantly. To avoid this
;; problem, the plot functions are exported using `unsafe-provide`, which will
;; tell TR to not create contracts for the function parameters and return
;; values.
;;
;; Using `unsafe-provide` leaves the functions vulnerable to bad parameter
;; passing: TR will still assume the parameters have valid values, and will
;; not perform any other checks, which can result in a crash (segmentation
;; fault). To mitigate this problem, there is code inside each plot function
;; to verify that the parameters are correct. Unfortunately, TR will also
;; notice that those checks are redundant (since it knows the types for the
;; parameters) and will remove this parameter verification code during the
;; optimization phase. To prevent this removal, optimizations are disabled in
;; this file using the #:no-optimize line above.
;;
;; The #:no-optimize only applies to this file, which is the "entry point" of
;; the plot package, so the rest of the plot package remains optimized.

(require (only-in typed/mred/mred Snip% Frame%)
(only-in racket/gui/base get-display-backing-scale)
typed/racket/draw typed/racket/class racket/match
(only-in typed/pict pict pict?)
plot/utils
plot/private/common/parameter-group
plot/private/common/draw
Expand Down Expand Up @@ -33,9 +63,9 @@
#:y-min (U Real #f) #:y-max (U Real #f)
#:width Positive-Integer
#:height Positive-Integer
#:title (U String #f)
#:x-label (U String #f)
#:y-label (U String #f)
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:legend-anchor Anchor]
(Instance Snip%)))
(define (plot-snip renderer-tree
Expand All @@ -49,43 +79,50 @@
#:legend-anchor [legend-anchor (plot-legend-anchor)])
(define fail/kw (make-raise-keyword-error 'plot-snip))
(cond
;; check arguments, see note at the top of this file
[(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
(parameterize ([plot-title title]
[plot-x-label x-label]
[plot-y-label y-label]
[plot-legend-anchor legend-anchor])
(define saved-plot-parameters (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))

(: make-bm (-> Boolean Rect Positive-Integer Positive-Integer
(Values (Instance Bitmap%) (U #f (Instance 2D-Plot-Area%)))))
(define (make-bm anim? bounds-rect width height)
(: area (U #f (Instance 2D-Plot-Area%)))
(define area #f)
(define bm (make-bitmap
width height #t
#:backing-scale (or (get-display-backing-scale) 1.0)))
(parameterize/group ([plot-parameters saved-plot-parameters]
[plot-animating? (if anim? #t (plot-animating?))])
(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 new-area
(make-object 2d-plot-area%
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks
dc 0 0 width height))
(set! area new-area)
(plot-area new-area renderer-list))
(values bm area))

(define-values (bm area) (make-bm #f bounds-rect width height))

(make-2d-plot-snip bm saved-plot-parameters make-bm bounds-rect area width height))]))
[(not (and (integer? width) (positive? width))) (fail/kw "positive integer" '#:width width)]
[(not (and (integer? height) (positive? height))) (fail/kw "positive integer" '#:height height)]
[(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)])

(parameterize ([plot-title title]
[plot-x-label x-label]
[plot-y-label y-label]
[plot-legend-anchor legend-anchor])
(define saved-plot-parameters (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))

(: make-bm (-> Boolean Rect Positive-Integer Positive-Integer
(Values (Instance Bitmap%) (U #f (Instance 2D-Plot-Area%)))))
(define (make-bm anim? bounds-rect width height)
(: area (U #f (Instance 2D-Plot-Area%)))
(define area #f)
(define bm (make-bitmap
width height #t
#:backing-scale (or (get-display-backing-scale) 1.0)))
(parameterize/group ([plot-parameters saved-plot-parameters]
[plot-animating? (if anim? #t (plot-animating?))])
(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 new-area
(make-object 2d-plot-area%
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks
dc 0 0 width height))
(set! area new-area)
(plot-area new-area renderer-list))
(values bm area))

(define-values (bm area) (make-bm #f bounds-rect width height))

(make-2d-plot-snip bm saved-plot-parameters make-bm bounds-rect area width height)))

;; ===================================================================================================
;; Plot to a frame
Expand All @@ -96,9 +133,9 @@
#:y-min (U Real #f) #:y-max (U Real #f)
#:width Positive-Integer
#:height Positive-Integer
#:title (U String #f)
#:x-label (U String #f)
#:y-label (U String #f)
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:legend-anchor Anchor]
(Instance Frame%)))
(define (plot-frame renderer-tree
Expand All @@ -112,29 +149,29 @@
#:legend-anchor [legend-anchor (plot-legend-anchor)])
(define fail/kw (make-raise-keyword-error 'plot-frame))
(cond
;; check arguments, see note at the top of this file
[(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
;; make-snip will be called in a separate thread, make sure the
;; parameters have the correct values in that thread as well.
(define saved-plot-parameters (plot-parameters))
(cond ;; check arguments because function is provided unsafely
[(not (and (integer? width) (positive? width))) (fail/kw "positive integer" '#:width width)]
[(not (and (integer? height) (positive? height))) (fail/kw "positive integer" '#:height height)]
[(and title (not (string? title))) (fail/kw "#f or string" '#:title title)]
[(and x-label (not (string? x-label))) (fail/kw "#f or string" '#:x-label x-label)]
[(and y-label (not (string? y-label))) (fail/kw "#f or string" '#:y-label y-label)]
[(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)])
(: make-snip (-> Positive-Integer Positive-Integer (Instance Snip%)))
(define (make-snip width height)
(parameterize/group ([plot-parameters saved-plot-parameters])
(plot-snip
renderer-tree
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor)))
(make-snip-frame make-snip width height (if title (format "Plot: ~a" title) "Plot"))]))
[(not (and (integer? width) (positive? width))) (fail/kw "positive integer" '#:width width)]
[(not (and (integer? height) (positive? height))) (fail/kw "positive integer" '#:height height)]
[(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)])

;; make-snip will be called in a separate thread, make sure the
;; parameters have the correct values in that thread as well.
(define saved-plot-parameters (plot-parameters))
(: make-snip (-> Positive-Integer Positive-Integer (Instance Snip%)))
(define (make-snip width height)
(parameterize/group ([plot-parameters saved-plot-parameters])
(plot-snip
renderer-tree
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor)))
(make-snip-frame make-snip width height (if title (format "Plot: ~a" title) "Plot")))

;; ===================================================================================================
;; Plot to a frame or a snip, depending on (plot-new-window?)
Expand All @@ -145,9 +182,9 @@
#:y-min (U Real #f) #:y-max (U Real #f)
#:width Positive-Integer
#:height Positive-Integer
#:title (U String #f)
#:x-label (U String #f)
#:y-label (U String #f)
#:title (U String pict #f)
#:x-label (U String pict #f)
#:y-label (U String pict #f)
#:legend-anchor Anchor
#:out-file (U Path-String Output-Port #f)
#:out-kind (U 'auto Image-File-Format)
Expand Down Expand Up @@ -178,36 +215,43 @@

(define fail/kw (make-raise-keyword-error 'plot))
(cond
;; check arguments, see note at the top of this file
[(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
(cond ;; check arguments because function is provided unsafely
[(and 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)]
[(and bgcolor (not (plot-color/c bgcolor)))
(fail/kw "plot-color/c" '#:bgcolor bgcolor)])
(parameterize ([plot-foreground (if fgcolor fgcolor (plot-foreground))]
[plot-background (if bgcolor bgcolor (plot-background))])
(when out-file
(plot-file
renderer-tree out-file out-kind
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor))

(cond [(plot-new-window?)
(define frame
(plot-frame
renderer-tree
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor))
(send frame show #t)
(void)]
[else
(plot-snip
renderer-tree
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor)]))]))
[(not (and (integer? width) (positive? width))) (fail/kw "positive integer" '#:width width)]
[(not (and (integer? height) (positive? height))) (fail/kw "positive integer" '#:height height)]
[(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)]
[(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)]
[(and bgcolor (not (plot-color/c bgcolor))) (fail/kw "plot-color/c" '#:bgcolor bgcolor)]
;; NOTE: don't check this one, as it is not used anyway
;; [(and lncolor (not (plot-color/c lncolor))) (fail/kw "plot-color/c" '#:lncolor lncolor)]
[(and out-file (not (or (path-string? out-file) (output-port? out-file))))
(fail/kw "#f, path-string or output port" '#:out-file out-file)])
(parameterize ([plot-foreground (if fgcolor fgcolor (plot-foreground))]
[plot-background (if bgcolor bgcolor (plot-background))])
(when out-file
(plot-file
renderer-tree out-file out-kind
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor))

(cond [(plot-new-window?)
(define frame
(plot-frame
renderer-tree
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor))
(send frame show #t)
(void)]
[else
(plot-snip
renderer-tree
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:width width #:height height
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor)])))
Loading