1#lang racket/base
2
3;; A compatibility module for the old 'plot'.
4
5(require racket/contract racket/class racket/snip racket/draw racket/vector
6         ;; Plotting
7         plot/private/common/math
8         plot/private/common/contract
9         plot/private/common/ticks
10         plot/private/plot2d/plot-area
11         plot/private/plot2d/renderer
12         plot/private/plot3d/plot-area
13         plot/private/plot3d/renderer
14         (prefix-in new. (only-in plot
15                                  x-axis y-axis
16                                  plot-x-ticks plot-y-ticks plot-z-ticks
17                                  points error-bars vector-field
18                                  plot-title plot-x-label plot-y-label plot-z-label
19                                  plot-foreground plot-background
20                                  plot3d-angle plot3d-altitude))
21         plot/private/deprecated/renderers
22         ;; Miscellaneous
23         plot/private/deprecated/math)
24
25(provide
26 mix
27 (contract-out
28  [plot-color?  (-> any/c boolean?)]
29  [plot
30   (->* [((is-a?/c 2d-plot-area%) . -> . void?)]
31        [#:width real?
32         #:height real?
33         #:x-min real?
34         #:x-max real?
35         #:y-min real?
36         #:y-max real?
37         #:x-label string?
38         #:y-label string?
39         #:title string?
40         #:fgcolor (list/c byte? byte? byte?)
41         #:bgcolor (list/c byte? byte? byte?)
42         #:lncolor (list/c byte? byte? byte?)
43         #:out-file (or/c path-string? output-port? #f)]
44        (is-a?/c image-snip%))]
45  [plot3d
46   (->* [((is-a?/c 3d-plot-area%) . -> . void?)]
47        [#:width real?
48         #:height real?
49         #:x-min real?
50         #:x-max real?
51         #:y-min real?
52         #:y-max real?
53         #:z-min real?
54         #:z-max real?
55         #:alt real?
56         #:az real?
57         #:x-label string?
58         #:y-label string?
59         #:z-label string?
60         #:title string?
61         #:fgcolor (list/c byte? byte? byte?)
62         #:bgcolor (list/c byte? byte? byte?)
63         #:lncolor (list/c byte? byte? byte?)
64         #:out-file (or/c path-string? output-port? #f)]
65        (is-a?/c image-snip%))]
66  [points
67   (->* [(listof (vectorof real?))]
68        [#:sym (or/c char? string? exact-integer? symbol?)
69         #:color plot-color?]
70        ((is-a?/c 2d-plot-area%) . -> . void?))]
71  [vector-field
72   (->* [((vector/c real? real?) . -> . (vector/c real? real?))]
73        [#:samples (and/c exact-integer? (>=/c 2))
74         #:width exact-positive-integer?
75         #:color plot-color?
76         #:style (one-of/c 'scaled 'normalized 'real)]
77        ((is-a?/c 2d-plot-area%) . -> . void?))]
78  [error-bars
79   (->* [(listof (vector/c real? real? real?))]
80        [#:color plot-color?]
81        ((is-a?/c 2d-plot-area%) . -> . void?))]
82  [line
83   (->* [(real? . -> . (or/c real? (vector/c real? real?)))]
84        [#:samples (and/c exact-integer? (>=/c 2))
85         #:width (>=/c 0)
86         #:color plot-color/c
87         #:mode (one-of/c 'standard 'parametric)
88         #:mapping (one-of/c 'cartesian 'polar)
89         #:t-min real?
90         #:t-max real?]
91        ((is-a?/c 2d-plot-area%) . -> . void?))]
92  [contour
93   (->* [(real? real? . -> . real?)]
94        [#:samples exact-nonnegative-integer?
95         #:width (>=/c 0)
96         #:color plot-color/c
97         #:levels (or/c (and/c exact-integer? (>=/c 2)) (listof real?))]
98        ((is-a?/c 2d-plot-area%) . -> . void?))]
99  [shade
100   (->* [(real? real? . -> . real?)]
101        [#:samples (and/c exact-integer? (>=/c 2))
102         #:levels (or/c (and/c exact-integer? (>=/c 2)) (listof real?))]
103        ((is-a?/c 2d-plot-area%) . -> . void?))]
104  [surface
105   (->* [(real? real? . -> . real?)]
106        [#:samples (and/c exact-integer? (>=/c 2))
107         #:width (>=/c 0)
108         #:color plot-color/c]
109        ((is-a?/c 3d-plot-area%) . -> . void?))]
110  )
111 ;; Miscellaneous
112 make-vec
113 derivative
114 gradient)
115
116(define (mix . data)
117  (for/fold ([f  (λ (area) (void))]) ([d  (in-list data)])
118    (λ (area)
119      (f area)
120      (d area)
121      (void))))
122
123(define (plot-color? v)
124  (and (member v '(white black yellow green aqua pink wheat gray brown blue violet cyan
125                         turquoise magenta salmon red))
126       #t))
127
128(define ((renderer2d->plot-data r) area)
129  ((renderer2d-render-proc r) area)
130  (void))
131
132(define ((renderer3d->plot-data r) area)
133  ((renderer3d-render-proc r) area)
134  (void))
135
136;; ===================================================================================================
137;; Plotting
138
139(define x-axis-data (renderer2d->plot-data (new.x-axis)))
140(define y-axis-data (renderer2d->plot-data (new.y-axis)))
141
142(define (plot data
143              #:width [width 400]
144              #:height [height 400]
145              #:x-min [x-min -5]
146              #:x-max [x-max 5]
147              #:y-min [y-min -5]
148              #:y-max [y-max 5]
149              #:x-label [x-label "X axis"]
150              #:y-label [y-label "Y axis"]
151              #:title [title ""]
152              #:fgcolor [fgcolor '(0 0 0)]
153              #:bgcolor [bgcolor '(255 255 255)]
154              #:lncolor [lncolor '(255 0 0)]
155              #:out-file [out-file #f])
156  (define x-ticks (ticks-generate (new.plot-x-ticks) x-min x-max))
157  (define y-ticks (ticks-generate (new.plot-y-ticks) y-min y-max))
158  (define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max)))
159
160  (parameterize ([new.plot-title       title]
161                 [new.plot-x-label     x-label]
162                 [new.plot-y-label     y-label]
163                 [new.plot-foreground  fgcolor]
164                 [new.plot-background  bgcolor])
165    (define bm (make-bitmap (ceiling width) (ceiling height)))
166    (define dc (make-object bitmap-dc% bm))
167    (define area (make-object 2d-plot-area%
168                   bounds-rect x-ticks x-ticks y-ticks y-ticks '() dc 0 0 width height #f))
169
170    (define data+axes (mix x-axis-data y-axis-data data))
171
172    (send area start-plot)
173    (send area start-renderer bounds-rect)
174    (data+axes area)
175    (send area end-renderers)
176    (send area end-plot)
177
178    (when out-file (send bm save-file out-file 'png))
179
180    (make-object image-snip% bm)))
181
182(define (plot3d data
183                #:width [width 400]
184                #:height [height 400]
185                #:x-min [x-min -5]
186                #:x-max [x-max 5]
187                #:y-min [y-min -5]
188                #:y-max [y-max 5]
189                #:z-min [z-min -5]
190                #:z-max [z-max 5]
191                #:alt [alt 30]
192                #:az [az 45]
193                #:x-label [x-label "X axis"]
194                #:y-label [y-label "Y axis"]
195                #:z-label [z-label "Z axis"]
196                #:title [title ""]
197                #:fgcolor [fgcolor '(0 0 0)]
198                #:bgcolor [bgcolor '(255 255 255)]
199                #:lncolor [lncolor '(255 0 0)]
200                #:out-file [out-file #f])
201  (define x-ticks (ticks-generate (new.plot-x-ticks) x-min x-max))
202  (define y-ticks (ticks-generate (new.plot-y-ticks) y-min y-max))
203  (define z-ticks (ticks-generate (new.plot-z-ticks) z-min z-max))
204  (define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)))
205
206  (parameterize ([new.plot-title       title]
207                 [new.plot-x-label     x-label]
208                 [new.plot-y-label     y-label]
209                 [new.plot-z-label     z-label]
210                 [new.plot-foreground  fgcolor]
211                 [new.plot-background  bgcolor]
212                 [new.plot3d-angle     az]
213                 [new.plot3d-altitude  alt])
214    (define bm (make-bitmap (ceiling width) (ceiling height)))
215    (define dc (make-object bitmap-dc% bm))
216    (define area (make-object 3d-plot-area%
217                   bounds-rect x-ticks x-ticks y-ticks y-ticks z-ticks z-ticks '() dc 0 0 width height #f))
218
219    (send area start-plot)
220    (send area start-renderer bounds-rect)
221    (data area)
222    (send area end-renderers)
223    (send area end-plot)
224
225    (when out-file (send bm save-file out-file 'png))
226
227    (make-object image-snip% bm)))
228
229;; ===================================================================================================
230;; Functions that generate "plot data"
231
232(define (points vecs #:sym [sym 'square] #:color [color 'black])
233  (renderer2d->plot-data (new.points (map (λ (v) (vector-take v 2)) vecs)
234                                     #:sym sym #:size 6 #:color color)))
235
236(define (vector-field f
237                      #:samples [samples 20]
238                      #:width [width 1]
239                      #:color [color 'red]
240                      #:style [style 'scaled])
241  (define scale (case style
242                  [(scaled)      'auto]
243                  [(normalized)  'normalized]
244                  [(real)        1.0]))
245  (renderer2d->plot-data
246   (new.vector-field f #:samples samples #:line-width width #:color color #:scale scale)))
247
248(define (error-bars vecs #:color [color 'black])
249  (renderer2d->plot-data (new.error-bars vecs #:color color #:alpha 1 #:width 4)))
250
251(define (line f
252              #:samples [samples 150]
253              #:width [width 1]
254              #:color [color 'red]
255              #:mode [mode 'standard]
256              #:mapping [mapping 'cartesian]
257              #:t-min [t-min -5]
258              #:t-max [t-max 5])
259  (renderer2d->plot-data (line-renderer f samples width color mode mapping t-min t-max)))
260
261(define (contour f
262                 #:samples [samples 50]
263                 #:width [width 1]
264                 #:color [color 'black]
265                 #:levels [levels 10])
266  (renderer2d->plot-data (contour-renderer f samples width color levels)))
267
268(define (shade f #:samples [samples 50] #:levels [levels 10])
269  (renderer2d->plot-data (shade-renderer f samples levels)))
270
271(define (surface f #:samples [samples 50] #:width [width 1] #:color [color 'black])
272  (renderer3d->plot-data (surface-renderer f samples width color)))
273