diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 9c230963..6cbc409d 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -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"] diff --git a/plot-doc/plot/scribblings/plotting.scrbl b/plot-doc/plot/scribblings/plotting.scrbl index a376ea86..cd95b841 100644 --- a/plot-doc/plot/scribblings/plotting.scrbl +++ b/plot-doc/plot/scribblings/plotting.scrbl @@ -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] @@ -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?))] @@ -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] @@ -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 [ ] ...) diff --git a/plot-gui-lib/plot/private/gui/plot2d.rkt b/plot-gui-lib/plot/private/gui/plot2d.rkt index ec12801d..88344f6c 100644 --- a/plot-gui-lib/plot/private/gui/plot2d.rkt +++ b/plot-gui-lib/plot/private/gui/plot2d.rkt @@ -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 @@ -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 @@ -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 @@ -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 @@ -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?) @@ -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) @@ -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)]))) diff --git a/plot-gui-lib/plot/private/gui/plot3d.rkt b/plot-gui-lib/plot/private/gui/plot3d.rkt index c1ea638a..9b9c2d96 100644 --- a/plot-gui-lib/plot/private/gui/plot3d.rkt +++ b/plot-gui-lib/plot/private/gui/plot3d.rkt @@ -1,8 +1,12 @@ -#lang typed/racket/base +#lang typed/racket/base #:no-optimize + +;; See note at the top of plot2d.rkt for the use of `#:no-optimize` and +;; `unsafe-provide` (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 racket/list + (only-in typed/pict pict pict?) plot/utils plot/private/common/parameter-group plot/private/common/draw @@ -36,10 +40,10 @@ #:width Positive-Integer #:height Positive-Integer #:angle Real #:altitude Real - #:title (U String #f) - #:x-label (U String #f) - #:y-label (U String #f) - #:z-label (U String #f) + #:title (U String pict #f) + #:x-label (U String pict #f) + #:y-label (U String pict #f) + #:z-label (U String pict #f) #:legend-anchor Anchor] (Instance Snip%))) (define (plot3d-snip renderer-tree @@ -57,15 +61,23 @@ #:legend-anchor [legend-anchor (plot-legend-anchor)]) (define fail/kw (make-raise-keyword-error 'plot3d-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)] [(and z-min (not (rational? z-min))) (fail/kw "#f or rational" '#:z-min z-min)] - [(and z-max (not (rational? z-max))) (fail/kw "#f or rational" '#:z-max z-max)]) - (cond ;; because this function is exported via `unsafe-provide` - [(not (anchor/c legend-anchor)) (fail/kw "anchor/c" '#:legend-anchor legend-anchor)]) - + [(and z-max (not (rational? z-max))) (fail/kw "#f or rational" '#:z-max z-max)] + [(not (real? angle)) (fail/kw "real" '#:angle angle)] + [(not (real? altitude)) (fail/kw "real" '#:altitude altitude)] + [(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)] + [(and z-label (not (or (string? z-label) (pict? z-label)))) (fail/kw "#f, string or pict" '#:y-label z-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] @@ -76,10 +88,10 @@ (define bounds-rect (get-bounds-rect renderer-list x-min x-max y-min y-max z-min z-max)) (define-values (x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks) (get-ticks renderer-list bounds-rect)) - + (define render-tasks-hash ((inst make-hash Boolean render-tasks))) (define legend-entries-hash ((inst make-hash Boolean (Listof legend-entry)))) - + (: make-bm (-> Boolean Real Real Positive-Integer Positive-Integer (Instance Bitmap%))) (define (make-bm anim? angle altitude width height) (parameterize/group ([plot-parameters saved-plot-parameters] @@ -94,7 +106,7 @@ bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks z-ticks z-far-ticks dc 0 0 width height)) (send area start-plot) - + (cond [(not (hash-ref render-tasks-hash (plot-animating?) #f)) (hash-set! legend-entries-hash (plot-animating?) @@ -105,20 +117,20 @@ (rect-inexact->exact rend-bounds-rect) (unknown-rect 3))) (if render-proc (render-proc area) empty)))) - + (hash-set! render-tasks-hash (plot-animating?) (send area get-render-tasks))] [else (send area set-render-tasks (hash-ref render-tasks-hash (plot-animating?)))]) - + (send area end-renderers) - + (define legend-entries (hash-ref legend-entries-hash (plot-animating?) #f)) (when (and legend-entries (not (empty? legend-entries))) (send area draw-legend legend-entries)) - + (send area end-plot) bm)) - + (make-3d-plot-snip (make-bm #f angle altitude width height) saved-plot-parameters make-bm angle altitude width height))) @@ -134,10 +146,10 @@ #:width Positive-Integer #:height Positive-Integer #:angle Real #:altitude Real - #:title (U String #f) - #:x-label (U String #f) - #:y-label (U String #f) - #:z-label (U String #f) + #:title (U String pict #f) + #:x-label (U String pict #f) + #:y-label (U String pict #f) + #:z-label (U String pict #f) #:legend-anchor Anchor] (Instance Frame%))) (define (plot3d-frame renderer-tree @@ -155,12 +167,22 @@ #:legend-anchor [legend-anchor (plot-legend-anchor)]) (define fail/kw (make-raise-keyword-error 'plot3d-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)] [(and z-min (not (rational? z-min))) (fail/kw "#f or rational" '#:z-min z-min)] - [(and z-max (not (rational? z-max))) (fail/kw "#f or rational" '#:z-max z-max)]) + [(and z-max (not (rational? z-max))) (fail/kw "#f or rational" '#:z-max z-max)] + [(not (real? angle)) (fail/kw "real" '#:angle angle)] + [(not (real? altitude)) (fail/kw "real" '#:altitude altitude)] + [(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)] + [(and z-label (not (or (string? z-label) (pict? z-label)))) (fail/kw "#f, string or pict" '#:y-label z-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. @@ -187,10 +209,10 @@ #:height Positive-Integer #:angle Real #:altitude Real #:az Real #:alt Real - #:title (U String #f) - #:x-label (U String #f) - #:y-label (U String #f) - #:z-label (U String #f) + #:title (U String pict #f) + #:x-label (U String pict #f) + #:y-label (U String pict #f) + #:z-label (U String pict #f) #:legend-anchor Anchor #:out-file (U Path-String Output-Port #f) #:out-kind (U 'auto Image-File-Format) @@ -230,12 +252,33 @@ (define fail/kw (make-raise-keyword-error 'plot3d)) (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)] [(and z-min (not (rational? z-min))) (fail/kw "#f or rational" '#:z-min z-min)] - [(and z-max (not (rational? z-max))) (fail/kw "#f or rational" '#:z-max z-max)]) + [(and z-max (not (rational? z-max))) (fail/kw "#f or rational" '#:z-max z-max)] + [(and angle (not (real? angle))) (fail/kw "#f or real" '#:angle angle)] + [(and altitude (not (real? altitude))) (fail/kw "#f or real" '#:altitude altitude)] + [(and az (not (real? az))) (fail/kw "#f or real" '#:az az)] + [(and alt (not (real? alt))) (fail/kw "#f or real" '#:alt alt)] + [(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)] + [(and z-label (not (or (string? z-label) (pict? z-label)))) (fail/kw "#f, string or pict" '#:y-label z-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)]) + (cond ;; because this function is exported via `unsafe-provide` [(and out-kind (not (plot-file-format/c out-kind))) (fail/kw "plot-file-format/c" '#:out-kind out-kind)] @@ -243,7 +286,7 @@ (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 @@ -253,7 +296,7 @@ #:width width #:height height #:title title #:angle (or angle az (plot3d-angle)) #:altitude (or altitude alt (plot3d-altitude)) #:x-label x-label #:y-label y-label #:z-label z-label #:legend-anchor legend-anchor)) - + (cond [(plot-new-window?) (define frame (plot3d-frame diff --git a/plot-lib/plot/private/common/draw.rkt b/plot-lib/plot/private/common/draw.rkt index 9c7a5def..024216a0 100644 --- a/plot-lib/plot/private/common/draw.rkt +++ b/plot-lib/plot/private/common/draw.rkt @@ -114,13 +114,18 @@ (send dc draw-text str (- x rdx) (- y rdy) #t 0 angle))) -(: get-text-corners/anchor (->* [(Instance DC<%>) String Real Real] +(: get-text-corners/anchor (->* [(Instance DC<%>) (U String pict) Real Real] [Anchor Real Real] (Listof (Vector Real Real)))) (define (get-text-corners/anchor dc str x y [anchor 'top-left] [angle 0] [dist 0]) - (define-values (width height _1 _2) (send dc get-text-extent str #f #t 0)) + (define-values (width height _1 _2) + (if (string? str) + (send dc get-text-extent str #f #t 0) + (values (pict-width str) (pict-height str) 0 0))) (define nanchor (if (eq? anchor 'auto) - (resolve-auto-anchor/str dc str x y angle dist) + (if (string? str) + (resolve-auto-anchor/str dc str x y angle dist) + (resolve-auto-anchor/pict dc str x y dist)) anchor)) (get-box-corners/anchor x y width height nanchor angle dist)) diff --git a/plot-lib/plot/private/common/parameter-groups.rkt b/plot-lib/plot/private/common/parameter-groups.rkt index b92fdfb6..94e1b09f 100644 --- a/plot-lib/plot/private/common/parameter-groups.rkt +++ b/plot-lib/plot/private/common/parameter-groups.rkt @@ -71,6 +71,7 @@ (module typed-defs typed/racket/base (require typed/racket/draw + (only-in typed/pict pict) (submod ".." untyped-defs) "type-doc.rkt" "types.rkt" @@ -106,13 +107,13 @@ (U Symbol #f)) (List Positive-Integer Real Real Nonnegative-Real Boolean Boolean) (List - (U False String) - (U False String) - (U False String) - (U False String) - (U False String) - (U False String) - (U False String)) + (U False String pict) + (U False String pict) + (U False String pict) + (U False String pict) + (U False String pict) + (U False String pict) + (U False String pict)) (List Boolean Nonnegative-Integer Boolean (Instance PS-Setup%)) (List (List Axis-Transform ticks ticks) diff --git a/plot-lib/plot/private/common/parameters.rkt b/plot-lib/plot/private/common/parameters.rkt index c9c38395..cc278c3d 100644 --- a/plot-lib/plot/private/common/parameters.rkt +++ b/plot-lib/plot/private/common/parameters.rkt @@ -4,6 +4,7 @@ (require typed/racket/class typed/racket/draw + (only-in typed/pict pict) "type-doc.rkt" "types.rkt" "draw-attribs.rkt" @@ -141,14 +142,14 @@ ;; Labels -(defparam plot-title (U String #f) #f) -(defparam plot-x-label (U String #f) "x axis") -(defparam plot-y-label (U String #f) "y axis") -(defparam plot-z-label (U String #f) #f) +(defparam plot-title (U String pict #f) #f) +(defparam plot-x-label (U String pict #f) "x axis") +(defparam plot-y-label (U String pict #f) "y axis") +(defparam plot-z-label (U String pict #f) #f) -(defparam plot-x-far-label (U String #f) #f) -(defparam plot-y-far-label (U String #f) #f) -(defparam plot-z-far-label (U String #f) #f) +(defparam plot-x-far-label (U String pict #f) #f) +(defparam plot-y-far-label (U String pict #f) #f) +(defparam plot-z-far-label (U String pict #f) #f) ;; Axes: transform, ticks diff --git a/plot-lib/plot/private/common/plot-device.rkt b/plot-lib/plot/private/common/plot-device.rkt index f30bb5d7..69575d05 100644 --- a/plot-lib/plot/private/common/plot-device.rkt +++ b/plot-lib/plot/private/common/plot-device.rkt @@ -97,7 +97,7 @@ (full8star . 8star))) (define-type Tick-Params (List Boolean (Vectorof Real) Real Real)) -(define-type Label-Params (List (U #f String) (Vectorof Real) Anchor Real)) +(define-type Label-Params (List (U #f String pict) (Vectorof Real) Anchor Real)) (: plot-device% Plot-Device%) (define plot-device% diff --git a/plot-lib/plot/private/common/types.rkt b/plot-lib/plot/private/common/types.rkt index 6fc16c56..394ff78e 100644 --- a/plot-lib/plot/private/common/types.rkt +++ b/plot-lib/plot/private/common/types.rkt @@ -125,7 +125,7 @@ [draw-lines (-> (Listof (Vectorof Real)) Void)] [draw-line (-> (Vectorof Real) (Vectorof Real) Void)] [draw-text (->* [String (Vectorof Real)] [Anchor Real Real Boolean] Void)] - [get-text-corners (->* [String (Vectorof Real)] [Anchor Real Real] (Listof (Vectorof Real)))] + [get-text-corners (->* [(U String pict) (Vectorof Real)] [Anchor Real Real] (Listof (Vectorof Real)))] [draw-arrow (-> (Vectorof Real) (Vectorof Real) Void)] [get-tick-endpoints (-> (Vectorof Real) Real Real (List (Vectorof Real) (Vectorof Real)))] [draw-tick (-> (Vectorof Real) Real Real Void)] diff --git a/plot-lib/plot/private/no-gui/plot2d-untyped.rkt b/plot-lib/plot/private/no-gui/plot2d-untyped.rkt index 1eaeef61..95c62323 100644 --- a/plot-lib/plot/private/no-gui/plot2d-untyped.rkt +++ b/plot-lib/plot/private/no-gui/plot2d-untyped.rkt @@ -23,9 +23,9 @@ #:x-max (or/c real? #f) #:y-min (or/c real? #f) #:y-max (or/c real? #f) - #:title (or/c string? #f) - #:x-label (or/c string? #f) - #:y-label (or/c string? #f) + #:title (or/c string? pict? #f) + #:x-label (or/c string? pict? #f) + #:y-label (or/c string? pict? #f) #:legend-anchor anchor/c] void?)] [untyped-plot-bitmap @@ -34,11 +34,11 @@ #:x-max (or/c real? #f) #:y-min (or/c real? #f) #:y-max (or/c real? #f) - #:title (or/c string? #f) + #:title (or/c string? pict? #f) #:height (or/c real? #f) #:width (or/c real? #f) - #:x-label (or/c string? #f) - #:y-label (or/c string? #f) + #:x-label (or/c string? pict? #f) + #:y-label (or/c string? pict? #f) #:legend-anchor anchor/c] (is-a?/c bitmap%))] [untyped-plot-pict @@ -47,11 +47,11 @@ #:x-max (or/c real? #f) #:y-min (or/c real? #f) #:y-max (or/c real? #f) - #:title (or/c string? #f) - #:x-label (or/c string? #f) + #:title (or/c string? pict? #f) + #:x-label (or/c string? pict? #f) #:height (or/c real? #f) #:width (or/c real? #f) - #:y-label (or/c string? #f) + #:y-label (or/c string? pict? #f) #:legend-anchor anchor/c] pict?)])) diff --git a/plot-lib/plot/private/no-gui/plot2d.rkt b/plot-lib/plot/private/no-gui/plot2d.rkt index 96c54e09..47c0592d 100644 --- a/plot-lib/plot/private/no-gui/plot2d.rkt +++ b/plot-lib/plot/private/no-gui/plot2d.rkt @@ -1,6 +1,7 @@ #lang typed/racket/base (require typed/racket/draw typed/racket/class + (only-in typed/pict pict) "../common/type-doc.rkt" "../common/types.rkt" "../common/draw.rkt" @@ -31,9 +32,9 @@ Real Real Nonnegative-Real Nonnegative-Real] [#:x-min (U Real #f) #:x-max (U Real #f) #:y-min (U Real #f) #:y-max (U Real #f) - #: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] Void)) (define (plot/dc renderer-tree dc x y width height @@ -77,9 +78,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 Bitmap%))) (define (plot-bitmap renderer-tree @@ -107,9 +108,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] Pict)) (define (plot-pict renderer-tree @@ -140,9 +141,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] Void)) (define (plot-file renderer-tree output [kind 'auto] diff --git a/plot-lib/plot/private/no-gui/plot3d-untyped.rkt b/plot-lib/plot/private/no-gui/plot3d-untyped.rkt index 2d411f98..8b16e7a1 100644 --- a/plot-lib/plot/private/no-gui/plot3d-untyped.rkt +++ b/plot-lib/plot/private/no-gui/plot3d-untyped.rkt @@ -4,6 +4,7 @@ racket/contract racket/class racket/draw + (only-in pict pict?) (for-syntax racket/base "plot3d-evil-box.rkt") "../../utils.rkt" "../common/contract.rkt" @@ -27,10 +28,10 @@ #:z-max (or/c real? #f) #:angle real? #:altitude real? - #:title (or/c string? #f) - #:x-label (or/c string? #f) - #:y-label (or/c string? #f) - #:z-label (or/c string? #f) + #:title (or/c string? pict? #f) + #:x-label (or/c string? pict? #f) + #:y-label (or/c string? pict? #f) + #:z-label (or/c string? pict? #f) #:legend-anchor anchor/c] void?)])) diff --git a/plot-lib/plot/private/no-gui/plot3d.rkt b/plot-lib/plot/private/no-gui/plot3d.rkt index 3ce0b10b..ad3bf441 100644 --- a/plot-lib/plot/private/no-gui/plot3d.rkt +++ b/plot-lib/plot/private/no-gui/plot3d.rkt @@ -1,6 +1,7 @@ #lang typed/racket/base (require typed/racket/draw typed/racket/class + (only-in typed/pict pict) "../common/type-doc.rkt" "../common/types.rkt" "../common/draw.rkt" @@ -35,10 +36,10 @@ #:y-min (U Real #f) #:y-max (U Real #f) #:z-min (U Real #f) #:z-max (U Real #f) #:angle Real #:altitude Real - #:title (U String #f) - #:x-label (U String #f) - #:y-label (U String #f) - #:z-label (U String #f) + #:title (U String pict #f) + #:x-label (U String pict #f) + #:y-label (U String pict #f) + #:z-label (U String pict #f) #:legend-anchor Anchor] Void)) (define (plot3d/dc renderer-tree dc x y width height @@ -102,10 +103,10 @@ #:width Positive-Integer #:height Positive-Integer #:angle Real #:altitude Real - #:title (U String #f) - #:x-label (U String #f) - #:y-label (U String #f) - #:z-label (U String #f) + #:title (U String pict #f) + #:x-label (U String pict #f) + #:y-label (U String pict #f) + #:z-label (U String pict #f) #:legend-anchor Anchor] (Instance Bitmap%))) (define (plot3d-bitmap renderer-tree @@ -140,10 +141,10 @@ #:width Positive-Integer #:height Positive-Integer #:angle Real #:altitude Real - #:title (U String #f) - #:x-label (U String #f) - #:y-label (U String #f) - #:z-label (U String #f) + #:title (U String pict #f) + #:x-label (U String pict #f) + #:y-label (U String pict #f) + #:z-label (U String pict #f) #:legend-anchor Anchor] Pict)) (define (plot3d-pict renderer-tree @@ -181,10 +182,10 @@ #:width Positive-Integer #:height Positive-Integer #:angle Real #:altitude Real - #:title (U String #f) - #:x-label (U String #f) - #:y-label (U String #f) - #:z-label (U String #f) + #:title (U String pict #f) + #:x-label (U String pict #f) + #:y-label (U String pict #f) + #:z-label (U String pict #f) #:legend-anchor Anchor] Void)) (define (plot3d-file renderer-tree output [kind 'auto] diff --git a/plot-lib/plot/private/plot2d/plot-area.rkt b/plot-lib/plot/private/plot2d/plot-area.rkt index bfcdaeea..a1ecc7ee 100644 --- a/plot-lib/plot/private/plot2d/plot-area.rkt +++ b/plot-lib/plot/private/plot2d/plot-area.rkt @@ -226,8 +226,12 @@ (: init-top-margin Real) (define init-top-margin - (cond [(and (plot-decorations?) (plot-title)) (* 3/2 char-height)] - [else 0])) + (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]))) (: view->dc (-> (Vectorof Real) (Vectorof Real))) ;; Initial view->dc (draws labels and half of every tick off the allotted space on the dc) @@ -469,9 +473,15 @@ (: get-y-label-params (-> Label-Params)) (define (get-y-label-params) - (define offset (vector (+ max-y-tick-offset max-y-tick-label-width half-char-height) + (define label (plot-y-label)) + (define half-label-width (if (pict? label) + (* 1/2 (pict-width label)) + half-char-height)) + (define offset (vector (+ max-y-tick-offset max-y-tick-label-width half-label-width) (ann 0 Real))) - (list (plot-y-label) (v- (view->dc (vector 0.0 0.5)) offset) 'bottom (/ pi 2))) + (if (string? label) + (list label (v- (view->dc (vector 0.0 0.5)) offset) 'bottom (/ pi 2)) + (list label (v- (view->dc (vector 0.0 0.5)) offset) 'center 0))) (: get-x-far-label-params (-> Label-Params)) (define (get-x-far-label-params) @@ -481,9 +491,15 @@ (: get-y-far-label-params (-> Label-Params)) (define (get-y-far-label-params) - (define offset (vector (+ max-y-far-tick-offset max-y-far-tick-label-width half-char-height) + (define label (plot-y-far-label)) + (define half-label-width (if (pict? label) + (* 1/2 (pict-width label)) + half-char-height)) + (define offset (vector (+ max-y-far-tick-offset max-y-far-tick-label-width half-label-width) (ann 0 Real))) - (list (plot-y-far-label) (v+ (view->dc (vector 1.0 0.5)) offset) 'top (/ pi 2))) + (if (string? label) + (list label (v+ (view->dc (vector 1.0 0.5)) offset) 'top (/ pi 2)) + (list label (v+ (view->dc (vector 1.0 0.5)) offset) 'center 0))) ;; ----------------------------------------------------------------------------------------------- @@ -593,7 +609,9 @@ (define (draw-title) (define title (plot-title)) (when (and (plot-decorations?) title) - (send pd draw-text title (vector (* 1/2 dc-x-size) (ann 0 Real)) 'top))) + (if (string? title) + (send pd draw-text title (vector (* 1/2 dc-x-size) (ann 0 Real)) 'top) + (send pd draw-pict title (vector (* 1/2 dc-x-size) (ann 0 Real)) 'top)))) (: draw-axes (-> Void)) (define (draw-axes) @@ -627,8 +645,10 @@ (define (draw-labels) (for ([p (in-list (get-all-label-params))]) (match-define (list label v anchor angle) p) - (when label - (send pd draw-text label v anchor angle 0 #t)))) + (cond ((pict? label) + (send pd draw-pict label v anchor 0)) + ((string? label) + (send pd draw-text label v anchor angle 0 #t))))) ;; =============================================================================================== ;; Public drawing control (used by plot/dc) diff --git a/plot-lib/plot/private/plot3d/plot-area.rkt b/plot-lib/plot/private/plot3d/plot-area.rkt index 65a9793d..40613f8b 100644 --- a/plot-lib/plot/private/plot3d/plot-area.rkt +++ b/plot-lib/plot/private/plot3d/plot-area.rkt @@ -2,6 +2,7 @@ (require typed/racket/class typed/racket/draw racket/match racket/list racket/math racket/flonum (only-in math fl vector->flvector) + (only-in typed/pict pict?) "../common/type-doc.rkt" "../common/types.rkt" "../common/math.rkt" @@ -927,7 +928,9 @@ (define/private (draw-title) (define title (plot-title)) (when (and (plot-decorations?) title) - (send pd draw-text title (vector (* 1/2 dc-x-size) (ann 0 Real)) 'top))) + (if (string? title) + (send pd draw-text title (vector (* 1/2 dc-x-size) (ann 0 Real)) 'top) + (send pd draw-pict title (vector (* 1/2 dc-x-size) (ann 0 Real)) 'top 0)))) (: draw-back-axes (-> Void)) (define/private (draw-back-axes) @@ -974,8 +977,10 @@ (define/private (draw-labels ps) (for ([p (in-list ps)]) (match-define (list label v anchor angle) p) - (when label - (send pd draw-text label v anchor angle 0 #t)))) + (cond ((string? label) + (send pd draw-text label v anchor angle 0 #t)) + ((pict? label) + (send pd draw-pict label v anchor 0))))) ;; =============================================================================================== ;; Render list and its BSP representation diff --git a/plot-test/plot/tests/PRs/58.rkt b/plot-test/plot/tests/PRs/58.rkt index 50ad5968..0da06d0b 100644 --- a/plot-test/plot/tests/PRs/58.rkt +++ b/plot-test/plot/tests/PRs/58.rkt @@ -55,16 +55,54 @@ #:line-width 1.5 #:label (standard-fish 50 30)))) + +(define (do-plot-2d-title+axes output-fn) + (parameterize ((plot-title (hc-append 15 + (standard-fish 50 30 #:color "DarkGoldenRod") + (text "Fishy Plot" null 24) + (standard-fish 50 30 #:color "DarkGoldenRod"))) + (plot-x-label (standard-fish 75 30 #:color "RoyalBlue")) + (plot-x-far-label (standard-fish 75 30 #:color "Teal")) + (plot-y-label (standard-fish 75 30 #:color "Coral")) + (plot-y-far-label (standard-fish 75 30 #:color "DarkSalmon")) + (plot-z-label (standard-fish 75 30 #:color "DarkOrchid")) + (plot-z-far-label (standard-fish 75 30 #:color "Plum"))) + (output-fn (function sin -3 3)))) + +(define (do-plot-3d-title+axes output-fn) + (parameterize ((plot-title (hc-append 15 + (standard-fish 50 30 #:color "DarkGoldenRod") + (text "Fishy Plot" null 24) + (standard-fish 50 30 #:color "DarkGoldenRod"))) + (plot-x-label (standard-fish 75 30 #:color "RoyalBlue")) + (plot-x-far-label (standard-fish 75 30 #:color "Teal")) + (plot-y-label (standard-fish 75 30 #:color "Coral")) + (plot-y-far-label (standard-fish 75 30 #:color "DarkSalmon")) + (plot-z-label (standard-fish 75 30 #:color "DarkOrchid")) + (plot-z-far-label (standard-fish 75 30 #:color "Plum"))) + (output-fn (surface3d (λ (x y) (+ (/ 1.0 x)) + (/ 1.0 y)) + -2 2 -2 2 + #:color '(255 128 128) + #:line-color '(255 128 128) + #:line-width 1.5)))) + (define-runtime-path pr58-2d "./test-data/pr58-2d.dat") (define-runtime-path pr58-3d "./test-data/pr58-3d.dat") +(define-runtime-path pr58-2d-t "./test-data/pr58-2d-t.dat") +(define-runtime-path pr58-3d-t "./test-data/pr58-3d-t.dat") (define pr58-test-suite (test-suite - "PR#58: add support for pict legend entries" + "PR#58: add support for pict legend entries, title and axes" (test-case "pr58 2d plots" (check-draw-steps do-plot-2d pr58-2d)) (test-case "pr58 3d plots" - (check-draw-steps-3d do-plot-3d pr58-3d)))) + (check-draw-steps-3d do-plot-3d pr58-3d)) + (test-case "pr58 2d plots title+axes" + (check-draw-steps do-plot-2d-title+axes pr58-2d-t)) + (test-case "pr58 3d plots title+axes" + (check-draw-steps-3d do-plot-3d-title+axes pr58-3d-t)))) (module+ test (require rackunit/text-ui) diff --git a/plot-test/plot/tests/PRs/test-data/pr58-2d-t.dat b/plot-test/plot/tests/PRs/test-data/pr58-2d-t.dat new file mode 100644 index 00000000..07587e1d Binary files /dev/null and b/plot-test/plot/tests/PRs/test-data/pr58-2d-t.dat differ diff --git a/plot-test/plot/tests/PRs/test-data/pr58-2d-t.png b/plot-test/plot/tests/PRs/test-data/pr58-2d-t.png new file mode 100644 index 00000000..843ab005 Binary files /dev/null and b/plot-test/plot/tests/PRs/test-data/pr58-2d-t.png differ diff --git a/plot-test/plot/tests/PRs/test-data/pr58-3d-t.dat b/plot-test/plot/tests/PRs/test-data/pr58-3d-t.dat new file mode 100644 index 00000000..49b023de Binary files /dev/null and b/plot-test/plot/tests/PRs/test-data/pr58-3d-t.dat differ diff --git a/plot-test/plot/tests/PRs/test-data/pr58-3d-t.png b/plot-test/plot/tests/PRs/test-data/pr58-3d-t.png new file mode 100644 index 00000000..5b12cd1a Binary files /dev/null and b/plot-test/plot/tests/PRs/test-data/pr58-3d-t.png differ