Added plot-pict and plot3d-pict for slideshow plots
Added x, y, width, height arguments to plot/dc and plot3d/dc
This commit is contained in:
Neil Toronto
parent
c9ffe2830b
commit
20987fc320
|
|
@ -89,21 +89,38 @@
|
|||
|
||||
(define plot-area%
|
||||
(class object%
|
||||
(init-field dc)
|
||||
(init-field dc dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
|
||||
(super-new)
|
||||
|
||||
;; Like the dc's get-size, but ensures the result is exact (for plotting exact rational functions)
|
||||
(define/public (get-size)
|
||||
(define-values (x-size y-size) (send dc get-size))
|
||||
(values (inexact->exact x-size) (inexact->exact y-size)))
|
||||
|
||||
;; ===============================================================================================
|
||||
;; Drawing parameters
|
||||
|
||||
(define old-smoothing (send dc get-smoothing))
|
||||
(define old-text-mode (send dc get-text-mode))
|
||||
(define old-clipping-region (send dc get-clipping-region))
|
||||
(define old-font (send dc get-font))
|
||||
(define old-text-foreground (send dc get-text-foreground))
|
||||
(define old-pen (send dc get-pen))
|
||||
(define old-brush (send dc get-brush))
|
||||
(define old-background (send dc get-background))
|
||||
(define old-alpha (send dc get-alpha))
|
||||
|
||||
(define/public (restore-drawing-params)
|
||||
(send dc set-smoothing old-smoothing)
|
||||
(send dc set-text-mode old-text-mode)
|
||||
(send dc set-clipping-region old-clipping-region)
|
||||
(send dc set-font old-font)
|
||||
(send dc set-text-foreground old-text-foreground)
|
||||
(send dc set-pen old-pen)
|
||||
(send dc set-brush old-brush)
|
||||
(send dc set-background old-background)
|
||||
(send dc set-alpha old-alpha))
|
||||
|
||||
(define/public (reset-drawing-params)
|
||||
(send dc set-smoothing 'smoothed)
|
||||
(send dc set-text-mode 'transparent)
|
||||
(send dc set-clipping-rect dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
(set-font (plot-font-size) (plot-font-family))
|
||||
(set-text-foreground (plot-foreground))
|
||||
(set-pen (plot-foreground) (plot-line-width) 'solid)
|
||||
|
|
@ -219,7 +236,8 @@
|
|||
;; ===============================================================================================
|
||||
;; Drawing primitives
|
||||
|
||||
(define/public (clear) (send dc clear))
|
||||
(define/public (clear)
|
||||
(send dc clear))
|
||||
|
||||
(define/public (draw-point v)
|
||||
(match-define (vector x y) v)
|
||||
|
|
|
|||
|
|
@ -38,9 +38,7 @@
|
|||
(define (mix . data)
|
||||
(for/fold ([f (λ (area) (void))]) ([d (in-list data)])
|
||||
(λ (area)
|
||||
(send area reset-drawing-params)
|
||||
(f area)
|
||||
(send area reset-drawing-params)
|
||||
(d area)
|
||||
(void))))
|
||||
|
||||
|
|
@ -84,13 +82,12 @@
|
|||
[new.plot-background bgcolor])
|
||||
(define bm (make-bitmap (ceiling width) (ceiling height)))
|
||||
(define dc (make-object bitmap-dc% bm))
|
||||
(define area (make-object 2d-plot-area% x-ticks y-ticks x-min x-max y-min y-max dc))
|
||||
(define area (make-object 2d-plot-area% x-ticks y-ticks x-min x-max y-min y-max
|
||||
dc 0 0 width height))
|
||||
|
||||
(send area start-plot)
|
||||
(send area clip-to-bounds x-min x-max y-min y-max)
|
||||
(x-axis-data area)
|
||||
(y-axis-data area)
|
||||
(data area)
|
||||
(send area start-renderer x-min x-max y-min y-max)
|
||||
((mix x-axis-data y-axis-data data) area)
|
||||
(send area end-plot)
|
||||
|
||||
(when out-file (send bm save-file out-file 'png))
|
||||
|
|
@ -128,10 +125,11 @@
|
|||
(define bm (make-bitmap (ceiling width) (ceiling height)))
|
||||
(define dc (make-object bitmap-dc% bm))
|
||||
(define area
|
||||
(make-object 3d-plot-area% x-ticks y-ticks z-ticks x-min x-max y-min y-max z-min z-max dc))
|
||||
(make-object 3d-plot-area% x-ticks y-ticks z-ticks x-min x-max y-min y-max z-min z-max
|
||||
dc 0 0 width height))
|
||||
|
||||
(send area start-plot)
|
||||
(send area clip-to-bounds x-min x-max y-min y-max z-min z-max)
|
||||
(send area start-renderer x-min x-max y-min y-max z-min z-max)
|
||||
(data area)
|
||||
(send area end-plot)
|
||||
|
||||
|
|
|
|||
|
|
@ -18,16 +18,16 @@
|
|||
(define 2d-plot-area%
|
||||
(class plot-area%
|
||||
(init-field x-ticks y-ticks x-min x-max y-min y-max)
|
||||
(init dc)
|
||||
(init dc dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
(inherit
|
||||
set-alpha set-pen set-major-pen set-minor-pen set-brush set-background set-text-foreground
|
||||
set-font reset-drawing-params
|
||||
get-size get-text-width get-text-extent get-char-height get-char-baseline
|
||||
set-font restore-drawing-params reset-drawing-params
|
||||
get-text-width get-text-extent get-char-height get-char-baseline
|
||||
set-clipping-rect clear-clipping-rect
|
||||
clear draw-polygon draw-rectangle draw-line draw-lines draw-text draw-glyphs draw-arrow
|
||||
draw-tick draw-legend)
|
||||
|
||||
(super-make-object dc)
|
||||
(super-make-object dc dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
|
||||
(reset-drawing-params)
|
||||
|
||||
|
|
@ -51,37 +51,38 @@
|
|||
w]
|
||||
[else 0])]))
|
||||
|
||||
(define-values (dc-x-size dc-y-size) (get-size))
|
||||
(define dc-x-max (+ dc-x-min dc-x-size))
|
||||
(define dc-y-max (+ dc-y-min dc-y-size))
|
||||
|
||||
(define x-margin
|
||||
(+ (* 1/2 (plot-tick-size)) ; y ticks
|
||||
(define area-x-min
|
||||
(+ dc-x-min
|
||||
(* 1/2 (plot-tick-size)) ; y ticks
|
||||
(pen-gap) max-y-tick-label-width ; y tick labels
|
||||
(if (plot-y-label) (* 3/2 char-height) 0) ; y label
|
||||
))
|
||||
|
||||
(define area-x-size
|
||||
(- dc-x-size x-margin
|
||||
(define area-x-max
|
||||
(- dc-x-max
|
||||
(max (* 1/2 last-x-tick-label-width) ; protruding x tick label
|
||||
(* 1/2 (plot-tick-size))) ; y ticks
|
||||
))
|
||||
|
||||
(define y-margin
|
||||
(+ (* 1/2 (plot-tick-size)) ; x ticks
|
||||
(define area-y-min
|
||||
(+ dc-y-min
|
||||
(if (plot-title) (* 3/2 char-height) 0) ; title
|
||||
(max (* 1/2 char-height) ; protruding y tick label
|
||||
(* 1/2 (plot-tick-size))) ; x ticks
|
||||
))
|
||||
|
||||
(define area-y-max
|
||||
(- dc-y-max
|
||||
(* 1/2 (plot-tick-size)) ; x ticks
|
||||
(pen-gap) char-height ; x tick labels
|
||||
(if (plot-x-label) (* 3/2 char-height) 0) ; x label
|
||||
))
|
||||
|
||||
(define area-y-size
|
||||
(- dc-y-size y-margin
|
||||
(max (* 1/2 char-height) ; protruding y tick label
|
||||
(* 1/2 (plot-tick-size))) ; x ticks
|
||||
(if (plot-title) (* 3/2 char-height) 0) ; title
|
||||
))
|
||||
|
||||
(define area-x-min x-margin)
|
||||
(define area-x-max (+ x-margin area-x-size))
|
||||
(define area-y-max (- dc-y-size y-margin))
|
||||
(define area-y-min (- area-y-max area-y-size))
|
||||
(define area-x-size (- area-x-max area-x-min))
|
||||
(define area-y-size (- area-y-max area-y-min))
|
||||
(define area-x-mid (* 1/2 (+ area-x-min area-x-max)))
|
||||
(define area-y-mid (* 1/2 (+ area-y-min area-y-max)))
|
||||
|
||||
|
|
@ -182,12 +183,12 @@
|
|||
;; -------------------------------------------------------------------------
|
||||
;; Plot decoration
|
||||
|
||||
(define/private (draw-borders)
|
||||
(define (draw-borders)
|
||||
(set-minor-pen)
|
||||
(draw-rectangle (vector area-x-min area-y-min)
|
||||
(vector area-x-max area-y-max)))
|
||||
|
||||
(define/private (draw-x-ticks)
|
||||
(define (draw-x-ticks)
|
||||
(define half (* 1/2 (plot-tick-size)))
|
||||
(for ([t (in-list x-ticks)])
|
||||
(match-define (tick x x-str major?) t)
|
||||
|
|
@ -195,7 +196,7 @@
|
|||
(put-tick (vector x y-min) half 1/2pi)
|
||||
(put-tick (vector x y-max) half 1/2pi)))
|
||||
|
||||
(define/private (draw-y-ticks)
|
||||
(define (draw-y-ticks)
|
||||
(define half (* 1/2 (plot-tick-size)))
|
||||
(for ([t (in-list y-ticks)])
|
||||
(match-define (tick y y-str major?) t)
|
||||
|
|
@ -203,47 +204,52 @@
|
|||
(put-tick (vector x-min y) half 0)
|
||||
(put-tick (vector x-max y) half 0)))
|
||||
|
||||
(define/private (draw-x-tick-labels)
|
||||
(define (draw-x-tick-labels)
|
||||
(define offset (vector 0 (+ (pen-gap) (* 1/2 (plot-tick-size)))))
|
||||
(for ([t (in-list (filter tick-major? x-ticks))])
|
||||
(match-define (tick x x-str major?) t)
|
||||
(draw-text x-str (v+ (plot->dc (vector x y-min)) offset) 'top)))
|
||||
|
||||
(define/private (draw-y-tick-labels)
|
||||
(define (draw-y-tick-labels)
|
||||
(define offset (vector (+ (pen-gap) (* 1/2 (plot-tick-size))) 0))
|
||||
(for ([t (in-list (filter tick-major? y-ticks))])
|
||||
(match-define (tick y y-str major?) t)
|
||||
(draw-text y-str (v- (plot->dc (vector x-min y)) offset) 'right)))
|
||||
|
||||
(define/private (draw-title)
|
||||
(define (draw-title)
|
||||
(define-values (title-x-size _1 _2 _3)
|
||||
(get-text-extent (plot-title)))
|
||||
(draw-text (plot-title) (vector (/ dc-x-size 2) 0) 'top))
|
||||
(draw-text (plot-title) (vector (* 1/2 (+ dc-x-min dc-x-max)) dc-y-min) 'top))
|
||||
|
||||
(define/private (draw-x-label)
|
||||
(define (draw-x-label)
|
||||
(match-define (vector x _)
|
||||
(view->dc (vector (* 1/2 (+ x-min x-max)) 0)))
|
||||
(draw-text (plot-x-label) (vector x dc-y-size) 'bottom))
|
||||
(draw-text (plot-x-label) (vector x dc-y-max) 'bottom))
|
||||
|
||||
(define/private (draw-y-label)
|
||||
(define (draw-y-label)
|
||||
(match-define (vector _ y)
|
||||
(view->dc (vector 0 (* 1/2 (+ y-min y-max)))))
|
||||
(draw-text (plot-y-label) (vector 0 y) 'bottom (/ pi -2)))
|
||||
(draw-text (plot-y-label) (vector dc-x-min y) 'bottom (/ pi -2)))
|
||||
|
||||
;; -------------------------------------------------------------------------
|
||||
;; Drawing
|
||||
|
||||
(define/public (start-plot)
|
||||
(reset-drawing-params)
|
||||
(clear)
|
||||
(draw-borders)
|
||||
(draw-x-ticks)
|
||||
(draw-y-ticks)
|
||||
(draw-x-tick-labels)
|
||||
(draw-y-tick-labels)
|
||||
(draw-y-tick-labels))
|
||||
|
||||
(define/public (start-renderer rx-min rx-max ry-min ry-max)
|
||||
(reset-drawing-params)
|
||||
(set-clipping-rect (vector (- area-x-min (plot-line-width))
|
||||
(- area-y-min (plot-line-width)))
|
||||
(vector (+ area-x-max (plot-line-width))
|
||||
(+ area-y-max (plot-line-width)))))
|
||||
(+ area-y-max (plot-line-width))))
|
||||
(clip-to-bounds rx-min rx-max ry-min ry-max))
|
||||
|
||||
(define/public (end-plot)
|
||||
(clear-clipping-rect)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
;; Procedures that plot 2D renderers.
|
||||
|
||||
(require racket/draw racket/snip racket/contract racket/list racket/class racket/match
|
||||
slideshow/pict
|
||||
unstable/lazy-require
|
||||
(for-syntax racket/base
|
||||
syntax/strip-context
|
||||
|
|
@ -22,13 +23,14 @@
|
|||
;; cannot instantiate `racket/gui/base' a second time in the same process
|
||||
(lazy-require ["../common/gui.rkt" (make-snip-frame)])
|
||||
|
||||
(provide plot/dc plot plot-bitmap plot-snip plot-frame plot-file)
|
||||
(provide plot/dc plot plot-bitmap plot-pict plot-snip plot-frame plot-file)
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Plot to a given device context
|
||||
|
||||
(defproc (plot/dc [renderer-tree (treeof renderer2d?)]
|
||||
[dc (is-a?/c dc<%>)]
|
||||
[x real?] [y real?] [width (real>=/c 0)] [height (real>=/c 0)]
|
||||
[#:x-min x-min (or/c real? #f) #f]
|
||||
[#:x-max x-max (or/c real? #f) #f]
|
||||
[#:y-min y-min (or/c real? #f) #f]
|
||||
|
|
@ -68,7 +70,7 @@
|
|||
[plot-y-label y-label]
|
||||
[plot-legend-anchor legend-anchor])
|
||||
(define area (make-object 2d-plot-area%
|
||||
x-ticks y-ticks x-min x-max y-min y-max dc))
|
||||
x-ticks y-ticks x-min x-max y-min y-max dc x y width height))
|
||||
(send area start-plot)
|
||||
|
||||
(define legend-entries
|
||||
|
|
@ -76,14 +78,15 @@
|
|||
(match-define (renderer2d render-proc ticks-fun bounds-fun
|
||||
rx-min rx-max ry-min ry-max)
|
||||
renderer)
|
||||
(send area reset-drawing-params)
|
||||
(send area clip-to-bounds rx-min rx-max ry-min ry-max)
|
||||
(send area start-renderer rx-min rx-max ry-min ry-max)
|
||||
(render-proc area))))
|
||||
|
||||
(send area end-plot)
|
||||
|
||||
(when (not (empty? legend-entries))
|
||||
(send area put-legend legend-entries))))))
|
||||
(send area put-legend legend-entries))
|
||||
|
||||
(send area restore-drawing-params)))))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Plot to various other backends
|
||||
|
|
@ -101,11 +104,48 @@
|
|||
) (is-a?/c bitmap%)
|
||||
(define bm (make-bitmap width height))
|
||||
(define dc (make-object bitmap-dc% bm))
|
||||
(plot/dc renderer-tree dc
|
||||
(plot/dc renderer-tree dc 0 0 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 legend-anchor)
|
||||
bm)
|
||||
|
||||
(defproc (plot-pict [renderer-tree (treeof renderer2d?)]
|
||||
[#:x-min x-min (or/c real? #f) #f] [#:x-max x-max (or/c real? #f) #f]
|
||||
[#:y-min y-min (or/c real? #f) #f] [#:y-max y-max (or/c real? #f) #f]
|
||||
[#:width width (integer>=/c 1) (plot-width)]
|
||||
[#:height height (integer>=/c 1) (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)]
|
||||
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
|
||||
) pict?
|
||||
(define foreground (plot-foreground))
|
||||
(define background (plot-background))
|
||||
(define font-size (plot-font-size))
|
||||
(define font-family (plot-font-family))
|
||||
(define line-width (plot-line-width))
|
||||
(define legend-box-alpha (plot-legend-box-alpha))
|
||||
(define tick-size (plot-tick-size))
|
||||
(define tick-skip (plot-tick-skip))
|
||||
(define x-transform (plot-x-transform))
|
||||
(define y-transform (plot-y-transform))
|
||||
|
||||
(dc (λ (dc x y)
|
||||
(parameterize ([plot-foreground foreground]
|
||||
[plot-background background]
|
||||
[plot-font-size font-size]
|
||||
[plot-font-family font-family]
|
||||
[plot-line-width line-width]
|
||||
[plot-legend-box-alpha legend-box-alpha]
|
||||
[plot-tick-size tick-size]
|
||||
[plot-tick-skip tick-skip]
|
||||
[plot-x-transform x-transform]
|
||||
[plot-y-transform y-transform])
|
||||
(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 legend-anchor)))
|
||||
width height))
|
||||
|
||||
;; Plot to a snip
|
||||
(defproc (plot-snip [renderer-tree (treeof renderer2d?)]
|
||||
[#:x-min x-min (or/c real? #f) #f] [#:x-max x-max (or/c real? #f) #f]
|
||||
|
|
@ -174,9 +214,12 @@
|
|||
[width width] [height height] [output output])]
|
||||
[(svg) (new svg-dc%
|
||||
[width width] [height height] [output output] [exists 'truncate/replace])]))
|
||||
(define-values (x-scale y-scale) (send dc get-device-scale))
|
||||
(send dc start-doc "Rendering plot")
|
||||
(send dc start-page)
|
||||
(plot/dc renderer-tree dc #:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max
|
||||
(plot/dc renderer-tree dc 0 0
|
||||
(inexact->exact (/ width x-scale)) (inexact->exact (/ height y-scale))
|
||||
#: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 legend-anchor)
|
||||
(send dc end-page)
|
||||
(send dc end-doc)])
|
||||
|
|
|
|||
|
|
@ -19,16 +19,16 @@
|
|||
(define 3d-plot-area%
|
||||
(class plot-area%
|
||||
(init-field x-ticks y-ticks z-ticks x-min x-max y-min y-max z-min z-max)
|
||||
(init dc)
|
||||
(init dc dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
(inherit
|
||||
set-alpha set-pen set-major-pen set-minor-pen set-brush set-background set-text-foreground
|
||||
set-font reset-drawing-params
|
||||
get-size get-text-width get-text-extent get-char-height get-char-baseline
|
||||
get-text-width get-text-extent get-char-height get-char-baseline
|
||||
set-clipping-rect clear-clipping-rect
|
||||
clear draw-polygon draw-rectangle draw-line draw-lines draw-text draw-glyphs draw-arrow-glyph
|
||||
draw-tick draw-legend)
|
||||
|
||||
(super-make-object dc)
|
||||
(super-make-object dc dc-x-min dc-y-min dc-x-size dc-y-size)
|
||||
|
||||
(reset-drawing-params)
|
||||
|
||||
|
|
@ -130,8 +130,6 @@
|
|||
(define plot-right-dir (m3-apply invtransform-matrix (vector 1 0 0)))
|
||||
(define plot-up-dir (m3-apply invtransform-matrix (vector 0 0 1)))
|
||||
|
||||
(define-values (dc-x-size dc-y-size) (get-size))
|
||||
|
||||
(define view->dc* #f)
|
||||
(define (plot->dc v) (view->dc* (plot->view v)))
|
||||
|
||||
|
|
@ -143,13 +141,16 @@
|
|||
|
||||
(define/public (view->dc v) (view->dc* v))
|
||||
|
||||
(define dc-x-max (+ dc-x-min dc-x-size))
|
||||
(define dc-y-max (+ dc-y-min dc-y-size))
|
||||
|
||||
;; Initial plot area margins leave enough room for the ticks
|
||||
(define init-left-margin (* 1/2 (plot-tick-size)))
|
||||
(define init-right-margin (* 1/2 (plot-tick-size)))
|
||||
(define init-top-margin (if (plot-title) (* 3/2 (get-char-height)) 0))
|
||||
(define init-bottom-margin (* 1/2 (plot-tick-size)))
|
||||
|
||||
(define (make-view->dc area-x-min right area-y-min bottom)
|
||||
(define (make-view->dc left right top bottom)
|
||||
(define corners (list (vector x-min y-min z-min) (vector x-min y-min z-max)
|
||||
(vector x-min y-max z-min) (vector x-min y-max z-max)
|
||||
(vector x-max y-min z-min) (vector x-max y-min z-max)
|
||||
|
|
@ -162,8 +163,10 @@
|
|||
(define view-z-min (apply min zs))
|
||||
(define view-z-max (apply max zs))
|
||||
|
||||
(define area-x-max (- dc-x-size right))
|
||||
(define area-y-max (- dc-y-size bottom))
|
||||
(define area-x-min (+ dc-x-min left))
|
||||
(define area-x-max (- dc-x-max right))
|
||||
(define area-y-min (+ dc-y-min top))
|
||||
(define area-y-max (- dc-y-max bottom))
|
||||
(define area-x-mid (* 1/2 (+ area-x-min area-x-max)))
|
||||
(define area-x-size (- area-x-max area-x-min))
|
||||
(define area-y-mid (* 1/2 (+ area-y-min area-y-max)))
|
||||
|
|
@ -302,15 +305,15 @@
|
|||
(match-define (list (vector label-xs label-ys) ...)
|
||||
(append* (map (λ (params) (send/apply this get-text-corners params)) axis-label-params)))
|
||||
|
||||
(define label-x-min (apply min 0 label-xs))
|
||||
(define label-x-max (apply max (sub1 dc-x-size) label-xs))
|
||||
(define label-y-min (apply min 0 label-ys))
|
||||
(define label-y-max (apply max (sub1 dc-y-size) label-ys))
|
||||
(define label-x-min (apply min dc-x-min label-xs))
|
||||
(define label-x-max (apply max (sub1 dc-x-max) label-xs))
|
||||
(define label-y-min (apply min dc-y-min label-ys))
|
||||
(define label-y-max (apply max (sub1 dc-y-max) label-ys))
|
||||
|
||||
(values (+ left (- label-x-min))
|
||||
(+ right (- label-x-max (sub1 dc-x-size)))
|
||||
(+ top (- label-y-min))
|
||||
(+ bottom (- label-y-max (sub1 dc-y-size)))))
|
||||
(values (+ left (- dc-x-min label-x-min))
|
||||
(- right (- (sub1 dc-x-max) label-x-max))
|
||||
(+ top (- dc-y-min label-y-min))
|
||||
(- bottom (- (sub1 dc-y-max) label-y-max))))
|
||||
|
||||
(define-values (area-x-min right area-y-min bottom)
|
||||
(for/fold ([left init-left-margin]
|
||||
|
|
@ -386,7 +389,7 @@
|
|||
|
||||
(define (draw-title)
|
||||
(define title-x-size (get-text-width (plot-title)))
|
||||
(draw-text (plot-title) (vector (* 1/2 dc-x-size) 0) 'top))
|
||||
(draw-text (plot-title) (vector (* 1/2 (+ dc-x-min dc-x-max)) dc-y-min) 'top))
|
||||
|
||||
(define/public (start-plot)
|
||||
(clear)
|
||||
|
|
@ -397,6 +400,10 @@
|
|||
(put-z-ticks)
|
||||
(set! do-axis-transforms? #t))
|
||||
|
||||
(define/public (start-renderer rx-min rx-max ry-min ry-max rz-min rz-max)
|
||||
(reset-drawing-params)
|
||||
(clip-to-bounds rx-min rx-max ry-min ry-max rz-min rz-max))
|
||||
|
||||
(define/public (end-plot)
|
||||
(set! do-axis-transforms? #f)
|
||||
(draw-render-list)
|
||||
|
|
@ -405,7 +412,7 @@
|
|||
(when (plot-title) (draw-title))
|
||||
(draw-labels))
|
||||
|
||||
(define/public (put-angles)
|
||||
(define (put-angles*)
|
||||
(define angle-str (format " angle = ~a " (number->string (round angle))))
|
||||
(define alt-str (format " altitude = ~a " (number->string (round altitude))))
|
||||
(define-values (angle-width angle-height baseline _angle2) (get-text-extent angle-str))
|
||||
|
|
@ -413,8 +420,8 @@
|
|||
|
||||
(define box-x-size (max angle-width alt-width))
|
||||
(define box-y-size (+ angle-height alt-height (* 3 baseline)))
|
||||
(define box-x-min (* 1/2 (- dc-x-size box-x-size)))
|
||||
(define box-y-min (* 1/2 (- dc-y-size box-y-size)))
|
||||
(define box-x-min (+ dc-x-min (* 1/2 (- dc-x-size box-x-size))))
|
||||
(define box-y-min (+ dc-y-min (* 1/2 (- dc-y-size box-y-size))))
|
||||
(define box-x-max (+ box-x-min box-x-size))
|
||||
(define box-y-max (+ box-y-min box-y-size))
|
||||
|
||||
|
|
@ -429,9 +436,15 @@
|
|||
(draw-text alt-str (vector box-x-min (+ box-y-min baseline char-height))
|
||||
'top-left #:outline? #t))
|
||||
|
||||
(define/public (put-legend legend-entries)
|
||||
(define/public (put-angles) (put-angles*))
|
||||
|
||||
(define (put-legend* legend-entries)
|
||||
(define gap (plot-line-width))
|
||||
(draw-legend legend-entries (+ 0 gap) (- dc-x-size gap) (+ area-y-min gap) (- dc-y-size gap)))
|
||||
(draw-legend legend-entries
|
||||
(+ dc-x-min gap) (- dc-x-max gap)
|
||||
(+ area-y-min gap) (- dc-y-max gap)))
|
||||
|
||||
(define/public (put-legend legend-entries) (put-legend* legend-entries))
|
||||
|
||||
(define light (plot->view (vector x-mid y-mid (+ z-max (* 5 z-size)))))
|
||||
(define view-dir (vector 0 -50 0))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/draw racket/snip racket/match racket/list racket/class racket/contract
|
||||
slideshow/pict
|
||||
unstable/lazy-require
|
||||
(for-syntax racket/base)
|
||||
"../common/math.rkt"
|
||||
|
|
@ -18,13 +19,14 @@
|
|||
(lazy-require ["snip.rkt" (make-3d-plot-snip)]
|
||||
["../common/gui.rkt" (make-snip-frame)])
|
||||
|
||||
(provide plot3d/dc plot3d plot3d-bitmap plot3d-snip plot3d-frame plot3d-file)
|
||||
(provide plot3d/dc plot3d plot3d-bitmap plot3d-pict plot3d-snip plot3d-frame plot3d-file)
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Plot to a given device context
|
||||
|
||||
(defproc (plot3d/dc [renderer-tree (treeof renderer3d?)]
|
||||
[dc (is-a?/c dc<%>)]
|
||||
[x real?] [y real?] [width (real>=/c 0)] [height (real>=/c 0)]
|
||||
[#:x-min x-min (or/c real? #f) #f] [#:x-max x-max (or/c real? #f) #f]
|
||||
[#:y-min y-min (or/c real? #f) #f] [#:y-max y-max (or/c real? #f) #f]
|
||||
[#:z-min z-min (or/c real? #f) #f] [#:z-max z-max (or/c real? #f) #f]
|
||||
|
|
@ -76,7 +78,8 @@
|
|||
[plot-z-label z-label]
|
||||
[plot-legend-anchor legend-anchor])
|
||||
(define area (make-object 3d-plot-area%
|
||||
x-ticks y-ticks z-ticks x-min x-max y-min y-max z-min z-max dc))
|
||||
x-ticks y-ticks z-ticks x-min x-max y-min y-max z-min z-max
|
||||
dc x y width height))
|
||||
(send area start-plot)
|
||||
|
||||
(define legend-entries
|
||||
|
|
@ -84,8 +87,7 @@
|
|||
(match-define (renderer3d render-proc ticks-fun bounds-fun
|
||||
rx-min rx-max ry-min ry-max rz-min rz-max)
|
||||
renderer)
|
||||
(send area reset-drawing-params)
|
||||
(send area clip-to-bounds rx-min rx-max ry-min ry-max rz-min rz-max)
|
||||
(send area start-renderer rx-min rx-max ry-min ry-max rz-min rz-max)
|
||||
(render-proc area))))
|
||||
|
||||
(send area end-plot)
|
||||
|
|
@ -95,7 +97,9 @@
|
|||
(not (equal? (plot-legend-anchor) 'center))))
|
||||
(send area put-legend legend-entries))
|
||||
|
||||
(when (plot3d-animating?) (send area put-angles))))))
|
||||
(when (plot3d-animating?) (send area put-angles))
|
||||
|
||||
(send area restore-drawing-params)))))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Plot to various other backends
|
||||
|
|
@ -117,12 +121,67 @@
|
|||
) (is-a?/c bitmap%)
|
||||
(define bm (make-bitmap width height))
|
||||
(define dc (make-object bitmap-dc% bm))
|
||||
(plot3d/dc renderer-tree dc
|
||||
(plot3d/dc renderer-tree dc 0 0 width height
|
||||
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:z-min z-min #:z-max z-max
|
||||
#:angle angle #:altitude altitude #:title title #:x-label x-label #:y-label y-label
|
||||
#:z-label z-label #:legend-anchor legend-anchor)
|
||||
bm)
|
||||
|
||||
(defproc (plot3d-pict [renderer-tree (treeof renderer3d?)]
|
||||
[#:x-min x-min (or/c real? #f) #f] [#:x-max x-max (or/c real? #f) #f]
|
||||
[#:y-min y-min (or/c real? #f) #f] [#:y-max y-max (or/c real? #f) #f]
|
||||
[#:z-min z-min (or/c real? #f) #f] [#:z-max z-max (or/c real? #f) #f]
|
||||
[#:width width (integer>=/c 1) (plot-width)]
|
||||
[#:height height (integer>=/c 1) (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)]
|
||||
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
|
||||
) pict?
|
||||
(define foreground (plot-foreground))
|
||||
(define background (plot-background))
|
||||
(define font-size (plot-font-size))
|
||||
(define font-family (plot-font-family))
|
||||
(define line-width (plot-line-width))
|
||||
(define legend-box-alpha (plot-legend-box-alpha))
|
||||
(define tick-size (plot-tick-size))
|
||||
(define tick-skip (plot-tick-skip))
|
||||
(define x-transform (plot-x-transform))
|
||||
(define y-transform (plot-y-transform))
|
||||
(define z-transform (plot-z-transform))
|
||||
(define samples (plot3d-samples))
|
||||
(define animating? (plot3d-animating?))
|
||||
(define ambient-light-value (plot3d-ambient-light-value))
|
||||
(define diffuse-light? (plot3d-diffuse-light?))
|
||||
(define specular-light? (plot3d-specular-light?))
|
||||
|
||||
(dc (λ (dc x y)
|
||||
(parameterize ([plot-foreground foreground]
|
||||
[plot-background background]
|
||||
[plot-font-size font-size]
|
||||
[plot-font-family font-family]
|
||||
[plot-line-width line-width]
|
||||
[plot-legend-box-alpha legend-box-alpha]
|
||||
[plot-tick-size tick-size]
|
||||
[plot-tick-skip tick-skip]
|
||||
[plot-x-transform x-transform]
|
||||
[plot-y-transform y-transform]
|
||||
[plot-z-transform z-transform]
|
||||
[plot3d-samples samples]
|
||||
[plot3d-animating? animating?]
|
||||
[plot3d-ambient-light-value ambient-light-value]
|
||||
[plot3d-diffuse-light? diffuse-light?]
|
||||
[plot3d-specular-light? specular-light?])
|
||||
(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 #:z-min z-min #:z-max z-max
|
||||
#:angle angle #:altitude altitude #:title title #:x-label x-label #:y-label y-label
|
||||
#:z-label z-label #:legend-anchor legend-anchor)))
|
||||
width height))
|
||||
|
||||
;; Plot to a snip
|
||||
(defproc (plot3d-snip [renderer-tree (treeof renderer3d?)]
|
||||
[#:x-min x-min (or/c real? #f) #f] [#:x-max x-max (or/c real? #f) #f]
|
||||
|
|
@ -208,9 +267,11 @@
|
|||
[width width] [height height] [output output])]
|
||||
[(svg) (new svg-dc%
|
||||
[width width] [height height] [output output] [exists 'truncate/replace])]))
|
||||
(define-values (x-scale y-scale) (send dc get-device-scale))
|
||||
(send dc start-doc "Rendering plot")
|
||||
(send dc start-page)
|
||||
(plot3d/dc renderer-tree dc
|
||||
(plot3d/dc renderer-tree dc 0 0
|
||||
(inexact->exact (/ width x-scale)) (inexact->exact (/ height y-scale))
|
||||
#:x-min x-min #:x-max x-max #:y-min y-min #:y-max y-max #:z-min z-min #:z-max z-max
|
||||
#:angle angle #:altitude altitude #:title title #:x-label x-label #:y-label y-label
|
||||
#:z-label z-label #:legend-anchor legend-anchor)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
(require scribble/eval
|
||||
(for-label racket
|
||||
racket/gui/base
|
||||
slideshow/pict
|
||||
plot
|
||||
plot/utils)
|
||||
plot
|
||||
|
|
@ -13,6 +14,7 @@
|
|||
(all-from-out scribble/eval)
|
||||
(for-label (all-from-out racket
|
||||
racket/gui/base
|
||||
slideshow/pict
|
||||
plot
|
||||
plot/utils))
|
||||
(all-from-out plot)
|
||||
|
|
|
|||
|
|
@ -44,21 +44,6 @@ When given, the @(racket x-min), @(racket x-max), @(racket y-min) and @(racket y
|
|||
|
||||
Here, the renderer draws in [-1,1] × [-1,1], but the plot area is [-1.5,1.5] × [-1.5,1.5].
|
||||
|
||||
The @(racket plot) function easily generates plots for slideshows. For example,
|
||||
|
||||
@racketmod[slideshow
|
||||
(require plot)
|
||||
|
||||
(plot-font-size (current-font-size))
|
||||
(plot-width (current-para-width))
|
||||
(plot-height 600)
|
||||
|
||||
(slide
|
||||
#:title "A 2D Parabola"
|
||||
(bitmap (plot (function sqr -1 1 #:label "y = x^2"))))]
|
||||
|
||||
creates a slide containing a 2D plot of a parabola.
|
||||
|
||||
@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.
|
||||
|
|
@ -69,10 +54,11 @@ The @(racket #:lncolor) keyword argument is also accepted for backward compatibi
|
|||
[output (or/c path-string? output-port?)]
|
||||
[kind (one-of/c 'auto 'png 'jpeg 'xmb 'xpm 'bmp 'ps 'pdf 'svg) 'auto]
|
||||
[#:<plot-keyword> <plot-keyword> <plot-keyword-contract>] ...) void?]
|
||||
@defproc[(plot-pict [renderer-tree (treeof renderer2d?)] ...) pict?]
|
||||
@defproc[(plot-bitmap [renderer-tree (treeof renderer2d?)] ...) (is-a?/c bitmap%)]
|
||||
@defproc[(plot-snip [renderer-tree (treeof renderer2d?)] ...) (is-a?/c image-snip%)]
|
||||
@defproc[(plot-frame [renderer-tree (treeof renderer2d?)] ...) (is-a?/c frame%)])]{
|
||||
Plot to different backends. Each of these procedures has the same keyword arguments as @(racket plot).
|
||||
Plot to different backends. Each of these procedures has the same keyword arguments as @(racket plot), except for deprecated keywords.
|
||||
|
||||
Use @(racket plot-file) to save a plot to a file.
|
||||
When creating a JPEG file, the parameter @(racket plot-jpeg-quality) determines its quality.
|
||||
|
|
@ -80,6 +66,21 @@ When creating a PostScript or PDF file, the parameters @(racket plot-ps-interact
|
|||
(See @(racket post-script-dc%) and @(racket pdf-dc%).)
|
||||
When @(racket kind) is @(racket 'auto), @(racket plot-file) tries to determine the kind of file to write from the file name extension.
|
||||
|
||||
Use @(racket plot-pict) to create plots in slideshows. For example,
|
||||
|
||||
@racketmod[slideshow
|
||||
(require plot)
|
||||
|
||||
(plot-font-size (current-font-size))
|
||||
(plot-width (current-para-width))
|
||||
(plot-height 600)
|
||||
|
||||
(slide
|
||||
#:title "A 2D Parabola"
|
||||
(plot-pict (function sqr -1 1 #:label "y = x^2")))]
|
||||
|
||||
creates a slide containing a 2D plot of a parabola.
|
||||
|
||||
Use @(racket plot-bitmap) to create a bitmap.
|
||||
|
||||
Use @(racket plot-frame) to create a frame regardless of the value of @(racket plot-new-window?). The frame is initially hidden.
|
||||
|
|
|
|||
|
|
@ -44,12 +44,13 @@ The @(racket #:az) and @(racket #:alt) keyword arguments are backward-compatible
|
|||
[output (or/c path-string? output-port?)]
|
||||
[kind (one-of/c 'auto 'png 'jpeg 'xmb 'xpm 'bmp 'ps 'pdf 'svg) 'auto]
|
||||
[#:<plot-keyword> <plot-keyword> <plot-keyword-contract>] ...) void?]
|
||||
@defproc[(plot3d-pict [renderer-tree (treeof renderer3d?)] ...) pict?]
|
||||
@defproc[(plot3d-bitmap [renderer-tree (treeof renderer3d?)] ...) (is-a?/c bitmap%)]
|
||||
@defproc[(plot3d-snip [renderer-tree (treeof renderer3d?)] ...) (is-a?/c image-snip%)]
|
||||
@defproc[(plot3d-frame [renderer-tree (treeof renderer3d?)] ...) (is-a?/c frame%)])]{
|
||||
Plot to different backends. Each of these procedures has the same keyword arguments as @(racket plot3d).
|
||||
Plot to different backends. Each of these procedures has the same keyword arguments as @(racket plot3d), except for deprecated keywords.
|
||||
|
||||
These procedures correspond with @(racket plot-file), @(racket plot-bitmap), @(racket plot-snip) and @(racket plot-frame).
|
||||
These procedures correspond with @(racket plot-file), @(racket plot-pict), @(racket plot-bitmap), @(racket plot-snip) and @(racket plot-frame).
|
||||
}
|
||||
|
||||
@doc-apply[plot3d/dc]{
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#reader(lib"read.ss""wxme")WXME0108 ##
|
||||
#|
|
||||
This file uses the GRacket editor format.
|
||||
Open this file in DrRacket version 5.1.3.11 or later to read it.
|
||||
Open this file in DrRacket version 5.1.3.12 or later to read it.
|
||||
|
||||
Most likely, it was created by saving a program in DrRacket,
|
||||
and it probably contains a program with non-text elements
|
||||
|
|
@ -221,15 +221,15 @@
|
|||
0 71 1 #"\0"
|
||||
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 100 0 0 0 0 -1
|
||||
-1 0 1 #"\0"
|
||||
0 -1 1 #"\0"
|
||||
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 200 0 0 0 0 0 -1 -1 4 1
|
||||
#"\0"
|
||||
0 -1 1 #"\0"
|
||||
1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 255 255 0 -1 -1 0
|
||||
1 #"\0"
|
||||
0 75 10 #"Monospace\0"
|
||||
0.0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255
|
||||
255 255 1 -1 0 1 #"\0"
|
||||
0 -1 1 #"\0"
|
||||
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 200 0 0 0 0
|
||||
0 -1 -1 4 1 #"\0"
|
||||
0 -1 1 #"\0"
|
||||
1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 1 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255
|
||||
255 0 -1 -1 0 1 #"\0"
|
||||
0 75 1 #"\0"
|
||||
0.0 11 90 -1 90 -1 3 -1 0 1 0 1 0 0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255
|
||||
255 255 1 -1 0 1 #"\0"
|
||||
|
|
@ -446,7 +446,7 @@
|
|||
255 255 -1 -1 43 1 #"\0"
|
||||
0 -1 1 #"\0"
|
||||
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 1 0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255
|
||||
255 255 -1 -1 0 754 0 26 3 12 #"#lang racket"
|
||||
255 255 -1 -1 0 752 0 26 3 12 #"#lang racket"
|
||||
0 0 4 29 1 #"\n"
|
||||
0 0 4 29 1 #"\n"
|
||||
0 0 17 3 81
|
||||
|
|
@ -856,8 +856,7 @@
|
|||
0 0 22 3 1 #"("
|
||||
0 0 14 3 9 #"displayln"
|
||||
0 0 4 3 1 #" "
|
||||
0 0 19 3 1 #"\""
|
||||
0 0 19 3 41 #"The old plot library produced this plot:\""
|
||||
0 0 19 3 42 #"\"The old plot library produced this plot:\""
|
||||
0 0 22 3 1 #")"
|
||||
0 0 4 29 1 #"\n"
|
||||
0 2 35 4 1 #"\0"
|
||||
|
|
@ -1251,7 +1250,7 @@
|
|||
0 0 22 3 5 #"#:sym"
|
||||
0 0 4 3 1 #" "
|
||||
0 0 20 3 1 #"'"
|
||||
0 0 14 3 6 #"circle"
|
||||
0 0 14 3 6 #"square"
|
||||
0 0 22 3 1 #")"
|
||||
0 0 4 29 1 #"\n"
|
||||
0 0 4 3 11 #" "
|
||||
|
|
@ -1413,8 +1412,7 @@
|
|||
0 0 19 3 3 #"old"
|
||||
0 0 19 3 1 #" "
|
||||
0 0 19 3 7 #"library"
|
||||
0 0 19 3 1 #" "
|
||||
0 0 19 3 20 #"produced this plot:\""
|
||||
0 0 19 3 21 #" produced this plot:\""
|
||||
0 0 22 3 1 #")"
|
||||
0 0 4 29 1 #"\n"
|
||||
0 2 83 4 1 #"\0"
|
||||
|
|
|
|||
|
|
@ -1,18 +1,44 @@
|
|||
#lang slideshow
|
||||
|
||||
(require "../main.rkt")
|
||||
(require plot plot/utils)
|
||||
|
||||
(plot-font-size (current-font-size))
|
||||
(plot-width (current-para-width))
|
||||
(plot-title "Untitled")
|
||||
(plot-width 600)
|
||||
(plot-height 600)
|
||||
(plot-background '(192 255 192))
|
||||
(plot-foreground '(255 64 255))
|
||||
|
||||
(slide
|
||||
#:title "Two Small 2D Parabolas"
|
||||
(para "A small, aliased parabola:"
|
||||
(scale (bitmap (plot (function sqr -1 1 #:label "y = x^2"))) 1/3))
|
||||
(para "A small, smooth parabola:"
|
||||
(rotate (scale (plot-pict (function sqr -1 1 #:label "y = x^2")) 1/3)
|
||||
(degrees->radians 15))))
|
||||
|
||||
(slide
|
||||
#:title "A 2D Parabola"
|
||||
(bitmap (plot (function sqr -1 1 #:label "y = x^2"))))
|
||||
(parameterize ([plot-background 1]
|
||||
[plot-foreground 1])
|
||||
(plot-pict (function sqr -1 1 #:label "y = x^2")
|
||||
#:legend-anchor 'center)))
|
||||
|
||||
(define (parabola2d x y) (+ (sqr x) (sqr y)))
|
||||
|
||||
(slide
|
||||
#:title "Two Small 3D Parabolas"
|
||||
(para "A small, aliased parabola:"
|
||||
(scale (bitmap (plot3d (surface3d parabola2d -1 1 -1 1 #:label "z = x^2 + y^2"))) 1/3))
|
||||
(para "A small, smooth parabola:"
|
||||
(rotate (scale (plot3d-pict (surface3d parabola2d -1 1 -1 1 #:label "z = x^2 + y^2")) 1/3)
|
||||
(degrees->radians 15))))
|
||||
|
||||
(slide
|
||||
#:title "A 3D Parabola"
|
||||
(bitmap (plot3d (list (surface3d (λ (x y) (+ (sqr x) (sqr y))) -2 2 -2 2
|
||||
#:label "z = x^2 + y^2" #:color 3)
|
||||
(contours3d (λ (x y) (+ (sqr x) (sqr y))) -2 2 -2 2))
|
||||
#:legend-anchor 'top-left)))
|
||||
(parameterize ([plot-background 1]
|
||||
[plot-foreground 1])
|
||||
(plot3d-pict (list (surface3d parabola2d -1 1 -1 1
|
||||
#:label "z = x^2 + y^2" #:color 3)
|
||||
(contours3d parabola2d -1 1 -1 1))
|
||||
#:legend-anchor 'center)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user