forked from racket/racket
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathplot2d.rkt
More file actions
134 lines (115 loc) · 6.77 KB
/
plot2d.rkt
File metadata and controls
134 lines (115 loc) · 6.77 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#lang racket/base
(require racket/snip racket/contract racket/class racket/match
unstable/contract
unstable/parameter-group
racket/lazy-require
unstable/latent-contract/defthing
plot/private/common/contract
plot/private/common/math
plot/private/common/draw
plot/private/common/parameters
plot/private/common/plot-element
plot/private/common/deprecation-warning
plot/private/plot2d/plot-area
plot/private/no-gui/plot2d
plot/private/no-gui/plot2d-utils)
;; Require lazily, in case someone wants to just (require plot) in a headless setup
(lazy-require ["snip2d.rkt" (make-2d-plot-snip)]
["gui.rkt" (make-snip-frame with-new-eventspace)])
(provide plot-snip plot-frame plot)
;; ===================================================================================================
;; Plot to a snip
(defproc (plot-snip [renderer-tree (treeof (or/c renderer2d? nonrenderer?))]
[#:x-min x-min (or/c rational? #f) #f] [#:x-max x-max (or/c rational? #f) #f]
[#: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)]
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
) (is-a?/c image-snip%)
(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))
(define (make-bm anim? bounds-rect width height)
(define area #f)
(define bm
(parameterize/group ([plot-parameters saved-plot-parameters]
[plot-animating? (if anim? #t (plot-animating?))])
((if (plot-animating?) draw-bitmap draw-bitmap/supersampling)
(λ (dc)
(define-values (x-ticks x-far-ticks y-ticks y-far-ticks)
(get-ticks renderer-list bounds-rect))
(set! area (make-object 2d-plot-area%
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks
dc 0 0 width height))
(plot-area area renderer-list))
width height)))
(define (area-bounds->plot-bounds rect)
(match-define (vector (ivl area-x-min area-x-max) (ivl area-y-min area-y-max)) rect)
(match-define (vector x-min y-min) (send area dc->plot (vector area-x-min area-y-min)))
(match-define (vector x-max y-max) (send area dc->plot (vector area-x-max area-y-max)))
(vector (ivl x-min x-max) (ivl y-min y-max)))
(values bm (send area get-area-bounds-rect) area-bounds->plot-bounds))
(define-values (bm area-bounds-rect area-bounds->plot-bounds)
(make-bm #f bounds-rect width height))
(make-2d-plot-snip
bm saved-plot-parameters
make-bm bounds-rect area-bounds-rect area-bounds->plot-bounds width height)))
;; ===================================================================================================
;; Plot to a frame
(defproc (plot-frame [renderer-tree (treeof (or/c renderer2d? nonrenderer?))]
[#:x-min x-min (or/c rational? #f) #f] [#:x-max x-max (or/c rational? #f) #f]
[#: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)]
[#:legend-anchor legend-anchor anchor/c (plot-legend-anchor)]
) (is-a?/c object%)
(define snip
(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 snip width height (if title (format "Plot: ~a" title) "Plot")))
;; ===================================================================================================
;; Plot to a frame or a snip, depending on (plot-new-window?)
(defproc (plot [renderer-tree (treeof (or/c renderer2d? nonrenderer?))]
[#:x-min x-min (or/c rational? #f) #f] [#:x-max x-max (or/c rational? #f) #f]
[#: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)]
[#: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 (one-of/c 'auto 'png 'jpeg 'xmb 'xpm 'bmp 'ps 'pdf 'svg) 'auto]
[#:fgcolor fgcolor plot-color/c #f] [#:bgcolor bgcolor plot-color/c #f]
[#:lncolor lncolor plot-color/c #f] ; unused
) (or/c (is-a?/c snip%) void?)
(when fgcolor
(deprecation-warning "the plot #:fgcolor keyword argument" "plot-foreground"))
(when bgcolor
(deprecation-warning "the plot #:bgcolor keyword argument" "plot-background"))
(when lncolor
(deprecation-warning "the plot #:lncolor keyword argument"))
(define (call f . args)
(apply f renderer-tree args
#: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))
(parameterize ([plot-foreground (if fgcolor fgcolor (plot-foreground))]
[plot-background (if bgcolor bgcolor (plot-background))])
(when out-file
(call plot-file out-file out-kind))
(cond [(plot-new-window?) (define frame (with-new-eventspace (λ () (call plot-frame))))
(send frame show #t)
(void)]
[else (call plot-snip)])))