Skip to content

Commit

Permalink
Allow pictures to be used as title and axis labels in plots (#65)
Browse files Browse the repository at this point in the history
Updated the 2D and 3D plot procedures to accept a picture (from the pict
library) or a string as the label for the `#:title` and`#:{x,y,z}-label``
keywords, as well as the corresponing parameters, `plot-title` and
`plot-{x,y,z}-label`.

The original request was to allow LaTeX notation for the labels, this
changeset will enable doing that (and more) by installing the additional
`latex-pict` package and using the pictures produced by that package as
labels.

The folowing caveats apply for the implementation:

* the label position for the Y axis **is not** rotated when it is a picture,
  only when it is a string.  This was done to allow full flexibility to users
  who chose to use pictures -- they can easily rotate the picture themselves.
  If the picture would be rotated by the plot package, the user might have to
  supply a rotated picture to have a horizontal picture for the y label, and
  this would result in a double rotation -- depending on the type of graphics
  used for the picture, this might create undesirable artifacts.

* the font used for axis labels and title determines the gap between the label
  and the plot area and axis themselves.

A bug was fixed, where passing incorect parameters to plot procedure could
cause Racket to crash, an explanation for the fix is put as a comment in the
"plot-gui-lib/plot/private/gui/plot2d.rkt" file.

See also:

* #58
* racket/racket#3321
* #64
  • Loading branch information
alex-hhh authored Aug 28, 2020
1 parent 05a3718 commit 18d8eca
Show file tree
Hide file tree
Showing 20 changed files with 368 additions and 201 deletions.
3 changes: 3 additions & 0 deletions .github/workflows/ci.yml
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
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
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

0 comments on commit 18d8eca

Please sign in to comment.