Skip to content

Commit 4b8f3ae

Browse files
bdeketbdeket
committed
Lazy evaluation and mixin
1 parent c9af130 commit 4b8f3ae

File tree

13 files changed

+264
-100
lines changed

13 files changed

+264
-100
lines changed

‎plot-gui-lib/plot/private/gui/snip2d.rkt‎

Lines changed: 19 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@
1313
plot/private/plot2d/renderer
1414
plot/private/no-gui/plot2d-utils
1515
plot/private/common/contract
16+
(submod plot/private/common/plotmetrics untyped)
1617
"worker-thread.rkt"
1718
"snip.rkt")
1819

@@ -35,7 +36,7 @@
3536
(struct draw-command (animating? plot-bounds-rect width height) #:transparent)
3637

3738
(define 2d-plot-snip%
38-
(class plot-snip%
39+
(class* plot-snip% (plot-metrics<%>)
3940
(init init-bm saved-plot-parameters)
4041
(init-field make-bm plot-bounds-rect area width height)
4142

@@ -140,6 +141,7 @@
140141
(worker-thread-try-get rth (λ () (values #f #f))))
141142
(cond [(is-a? new-bm bitmap%)
142143
(set! area new-area)
144+
(set! plot-metrics-ok? #f)
143145
(set-bitmap new-bm)
144146
(set-message-center)
145147
#t]
@@ -373,11 +375,22 @@
373375
(set-update #t))
374376
(super resize w h))
375377

376-
(define/public (get-plot-bounds)
377-
(match-define (vector (ivl xmin xmax) (ivl ymin ymax))
378-
(send area get-bounds-rect))
379-
(vector (vector xmin xmax) (vector ymin ymax)))
380-
(define/public (plot->dc coords) (send area plot->dc coords))
378+
(define plot-metrics-ok? #f)
379+
(match-define (list bounds ->dc ->plot plane)
380+
(send area get-plot-metrics-functions))
381+
(define (update-metrics)
382+
(match-define (list new-bounds new-->dc new-->plot new-plane)
383+
(send area get-plot-metrics-functions))
384+
(set! bounds new-bounds)
385+
(set! ->dc new-->dc)
386+
(set! ->plot new-->plot)
387+
(set! plane new-plane)
388+
(set! plot-metrics-ok? #t))
389+
(define/public (get-plot-bounds) (unless plot-metrics-ok? (update-metrics)) (bounds))
390+
(define/public (plot->dc coords) (unless plot-metrics-ok? (update-metrics)) (->dc coords))
391+
(define/public (dc->plot coords) (unless plot-metrics-ok? (update-metrics)) (->plot coords))
392+
(define/public (plane-vector coords) (unless plot-metrics-ok? (update-metrics)) (plane))
393+
(define/public (get-plot-metrics-functions) (unless plot-metrics-ok? (update-metrics)) (list bounds ->dc ->plot plane))
381394
))
382395

383396
(define (make-2d-plot-snip

‎plot-gui-lib/plot/private/gui/snip3d.rkt‎

Lines changed: 19 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
(require racket/gui/base racket/class racket/match
44
plot/private/common/math
55
plot/private/common/parameters
6+
(submod plot/private/common/plotmetrics untyped)
67
"worker-thread.rkt"
78
"snip.rkt")
89

@@ -15,7 +16,7 @@
1516
(define (clamp x mn mx) (min* (max* x mn) mx))
1617

1718
(define 3d-plot-snip%
18-
(class plot-snip%
19+
(class* plot-snip% (plot-metrics<%>)
1920
(init init-bm saved-plot-parameters)
2021
(init-field make-bm angle altitude area width height)
2122

@@ -68,6 +69,7 @@
6869
(worker-thread-try-get rth (λ () (values #f #f))))
6970
(cond [(is-a? new-bm bitmap%)
7071
(set! area new-area)
72+
(set! plot-metrics-ok? #f)
7173
(set-bitmap new-bm)
7274
(set-message-center)
7375
(when (not (and (= last-angle angle)
@@ -141,11 +143,22 @@
141143
(set-update #t))
142144
(super resize w h))
143145

144-
(define/public (get-plot-bounds)
145-
(match-define (vector (ivl xmin xmax) (ivl ymin ymax) (ivl zmin zmax))
146-
(send area get-bounds-rect))
147-
(vector (vector xmin xmax) (vector ymin ymax) (vector zmin zmax)))
148-
(define/public (plot->dc coords) (send area plot->dc coords))
146+
(define plot-metrics-ok? #f)
147+
(match-define (list bounds ->dc ->plot plane)
148+
(send area get-plot-metrics-functions))
149+
(define (update-metrics)
150+
(match-define (list new-bounds new-->dc new-->plot new-plane)
151+
(send area get-plot-metrics-functions))
152+
(set! bounds new-bounds)
153+
(set! ->dc new-->dc)
154+
(set! ->plot new-->plot)
155+
(set! plane new-plane)
156+
(set! plot-metrics-ok? #t))
157+
(define/public (get-plot-bounds) (unless plot-metrics-ok? (update-metrics)) (bounds))
158+
(define/public (plot->dc coords) (unless plot-metrics-ok? (update-metrics)) (->dc coords))
159+
(define/public (dc->plot coords) (unless plot-metrics-ok? (update-metrics)) (->plot coords))
160+
(define/public (plane-vector coords) (unless plot-metrics-ok? (update-metrics)) (plane))
161+
(define/public (get-plot-metrics-functions) (unless plot-metrics-ok? (update-metrics)) (list bounds ->dc ->plot plane))
149162
))
150163

151164
(define (make-3d-plot-snip

‎plot-lib/plot/private/common/contract.rkt‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,5 @@
122122
(or/c elem-contract
123123
(listof (recursive-contract (treeof elem-contract) #:flat))))
124124

125-
(define plot-metrics<%>/c
126-
(object/c [get-plot-bounds (->m (-> (vectorof (vector/c real? real?))))]
127-
[plot->dc (->m (vectorof real?) (vectorof real?))]))
128-
125+
(require (submod "plotmetrics.rkt" untyped))
126+
(provide plot-metrics-object/c)

‎plot-lib/plot/private/common/plotmetrics.rkt‎

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
#lang typed/racket/base
2+
3+
;; Untyped interface / contract
4+
(module untyped racket/base
5+
(require racket/class
6+
racket/contract
7+
racket/match
8+
racket/draw)
9+
10+
(provide plot-metrics<%>
11+
plot-metrics-object/c)
12+
13+
(define plot-metrics<%> (interface ()
14+
get-plot-bounds
15+
dc->plot
16+
plot->dc
17+
plane-vector
18+
get-plot-metrics-functions))
19+
20+
(define plot-metrics-object/c
21+
(object/c [get-plot-bounds (->m (-> (vectorof (vector/c real? real?))))]
22+
[plot->dc (->m (vectorof real?) (vectorof real?))]
23+
[dc->plot (->m (vectorof real?) (vectorof real?))]
24+
[plane-vector (->m (vectorof real?))]
25+
[get-plot-metrics-functions (->m (values (-> (vectorof (vector/c real? real?)))
26+
(-> (vectorof real?) (vectorof real?))
27+
(-> (vectorof real?) (vectorof real?))
28+
(-> (vectorof real?))))]))
29+
)
30+
31+
;; Typed Types / mixin / structures
32+
(require typed/pict
33+
typed/racket/class
34+
racket/match)
35+
36+
(provide plot-metrics-mixin Plot-Metrics-Functions Plot-Metrics<%> plot-metrics%
37+
(struct-out plot-pict) Plot-Pict pict->pp)
38+
39+
(define-type Metrics-Object (Object [get-plot-metrics-functions (-> Plot-Metrics-Functions)]))
40+
(define-type Plot-Metrics-Functions (List (-> (Vectorof (Vectorof Real)))
41+
(-> (Vectorof Real) (Vectorof Real))
42+
(-> (Vectorof Real) (Vectorof Real))
43+
(-> (Vectorof Real))))
44+
(define-type Plot-Metrics<%>
45+
(Class
46+
[get-plot-bounds (-> (Vectorof (Vectorof Real)))]
47+
[plot->dc (-> (Vectorof Real) (Vectorof Real))]
48+
[dc->plot (-> (Vectorof Real) (Vectorof Real))]
49+
[plane-vector (-> (Vectorof Real))]
50+
[get-plot-metrics-functions (-> Plot-Metrics-Functions)]))
51+
52+
(: plot-metrics-mixin (All (A #:row) (-> (Class #:row-var A)
53+
(Class [init [->metrics-object (-> Metrics-Object)]]
54+
#:row-var A
55+
#:implements Plot-Metrics<%>))))
56+
(define (plot-metrics-mixin %)
57+
(class %
58+
(init ->metrics-object)
59+
(define (load) : Void
60+
(match-define (list new-bounds new-->dc new-->plot new-plane)
61+
(send (->metrics-object) get-plot-metrics-functions))
62+
(set! bounds new-bounds)
63+
(set! ->dc new-->dc)
64+
(set! ->plot new-->plot)
65+
(set! plane new-plane)
66+
(set! getall (λ () (list bounds ->dc ->plot plane)))
67+
(set! load void))
68+
69+
(define (bounds) : (Vectorof (Vectorof Real)) (load)(bounds))
70+
(define (plane) : (Vectorof Real) (load)(plane))
71+
(define (getall) : Plot-Metrics-Functions (load)(list bounds ->dc ->plot plane))
72+
(define (->dc [v : (Vectorof Real)]) : (Vectorof Real) (load)(->dc v))
73+
(define (->plot [v : (Vectorof Real)]) : (Vectorof Real) (load)(->plot v))
74+
75+
(super-make-object)
76+
(define/public (get-plot-bounds) (bounds))
77+
(define/public (dc->plot coords) (->plot coords))
78+
(define/public (plot->dc coords) (->dc coords))
79+
(define/public (plane-vector) (plane))
80+
(define/public (get-plot-metrics-functions) (getall))))
81+
82+
(define plot-metrics% (plot-metrics-mixin object%))
83+
84+
85+
(struct plot-pict pict ([bounds : (Vectorof (Vectorof Real))]
86+
[plot->dc : (-> (Vectorof Real) (Vectorof Real))]
87+
[dc->plot : (-> (Vectorof Real) (Vectorof Real))]
88+
[plane-vector : (Vectorof Real)]))
89+
(define-type Plot-Pict plot-pict)
90+
(define (pict->pp [P : pict]
91+
[metrics-object : Metrics-Object]) : plot-pict
92+
(match-define (list bounds ->dc ->plot plane)
93+
(send metrics-object get-plot-metrics-functions))
94+
95+
(plot-pict (pict-draw P) (pict-width P) (pict-height P) (pict-ascent P)
96+
(pict-descent P) (pict-children P) (pict-panbox P) (pict-last P)
97+
(bounds) ->dc ->plot (plane)))

‎plot-lib/plot/private/common/types.rkt‎

Lines changed: 2 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -163,17 +163,5 @@
163163
[calculate-legend-rect (-> (Listof legend-entry) Rect Anchor Rect)]
164164
[draw-legend (-> (Listof legend-entry) Rect Void)]))
165165

166-
(define-type Plot-Metrics<%>
167-
(Class
168-
[get-plot-bounds (-> (Vectorof (Vector Real Real)))]
169-
[plot->dc (-> (Vectorof Real) (Vectorof Real))]))
170-
171-
(struct plotpict pict ([bounds : (Vectorof (Vector Real Real))]
172-
[plot->dc : (-> (Vector Real Real) (Vectorof Real))]))
173-
(define-type PlotPict plotpict)
174-
(define (pict->pp [P : pict]
175-
[bounds : (Vectorof (Vector Real Real))]
176-
[->dc : (-> (Vector Real Real) (Vectorof Real))]) : plotpict
177-
(plotpict (pict-draw P) (pict-width P) (pict-height P) (pict-ascent P) (pict-descent P) (pict-children P) (pict-panbox P) (pict-last P)
178-
bounds ->dc))
179-
166+
(require "plotmetrics.rkt")
167+
(provide Plot-Metrics<%> Plot-Pict Plot-Metrics-Functions)

‎plot-lib/plot/private/no-gui/plot-pict.rkt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@
2525
#:legend-anchor Anchor
2626
#:out-file (U Path-String Output-Port #f)
2727
#:out-kind (U 'auto Image-File-Format)]
28-
PlotPict))
28+
Plot-Pict))
2929
(define (plot renderer-tree
3030
#:x-min [x-min #f] #:x-max [x-max #f]
3131
#:y-min [y-min #f] #:y-max [y-max #f]
@@ -65,7 +65,7 @@
6565
#:legend-anchor Anchor
6666
#:out-file (U Path-String Output-Port #f)
6767
#:out-kind (U 'auto Image-File-Format)]
68-
PlotPict))
68+
Plot-Pict))
6969
(define (plot3d renderer-tree
7070
#:x-min [x-min #f] #:x-max [x-max #f]
7171
#:y-min [y-min #f] #:y-max [y-max #f]

‎plot-lib/plot/private/no-gui/plot2d-untyped.rkt‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@
2828
#:y-label (or/c string? pict? #f)
2929
#:aspect-ratio (or/c (and/c rational? positive?) #f)
3030
#:legend-anchor legend-anchor/c]
31-
plot-metrics<%>/c)]
31+
plot-metrics-object/c)]
3232
[untyped-plot-bitmap
3333
(->* [(treeof (or/c renderer2d? nonrenderer?))]
3434
[#:x-min (or/c real? #f)
@@ -42,7 +42,7 @@
4242
#:y-label (or/c string? pict? #f)
4343
#:aspect-ratio (or/c (and/c rational? positive?) #f)
4444
#:legend-anchor legend-anchor/c]
45-
(and/c (is-a?/c bitmap%) plot-metrics<%>/c))]
45+
(and/c (is-a?/c bitmap%) plot-metrics-object/c))]
4646
[untyped-plot-pict
4747
(->* [(treeof (or/c renderer2d? nonrenderer?))]
4848
[#:x-min (or/c real? #f)
@@ -56,7 +56,7 @@
5656
#:y-label (or/c string? pict? #f)
5757
#:aspect-ratio (or/c (and/c rational? positive?) #f)
5858
#:legend-anchor legend-anchor/c]
59-
plotpict?)]))
59+
plot-pict?)]))
6060

6161
(define untyped-plot/dc plot/dc)
6262
(define untyped-plot-pict plot-pict)

‎plot-lib/plot/private/no-gui/plot2d.rkt‎

Lines changed: 6 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -12,10 +12,10 @@
1212
"../common/nonrenderer.rkt"
1313
"../common/file-type.rkt"
1414
"../common/utils.rkt"
15+
"../common/plotmetrics.rkt"
1516
"../plot2d/plot-area.rkt"
1617
"../plot2d/renderer.rkt"
1718
"plot2d-utils.rkt"
18-
"../common/math.rkt"
1919
(except-in "evil.rkt" dc)
2020
typed/racket/unsafe)
2121

@@ -76,14 +76,7 @@
7676
bounds-rect x-ticks x-far-ticks y-ticks y-far-ticks legend dc x y width height aspect-ratio))
7777
(plot-area area renderer-list)
7878

79-
(define bounds (vector (vector (assert (ivl-min (vector-ref bounds-rect 0)) real?)
80-
(assert (ivl-max (vector-ref bounds-rect 0)) real?))
81-
(vector (assert (ivl-min (vector-ref bounds-rect 1)) real?)
82-
(assert (ivl-max (vector-ref bounds-rect 1)) real?))))
83-
(new (class object%
84-
(super-new)
85-
(define/public (get-plot-bounds) bounds)
86-
(define/public (plot->dc [v : (Vectorof Real)]) (send area plot->dc v)))))]))
79+
(new plot-metrics% [->metrics-object (λ () area)]))]))
8780

8881
;; ===================================================================================================
8982
;; Plot to a bitmap
@@ -111,11 +104,8 @@
111104
#:aspect-ratio [aspect-ratio (plot-aspect-ratio)]
112105
#:legend-anchor [legend-anchor (plot-legend-anchor)])
113106
(define bm : (Instance (Class #:implements Bitmap% #:implements Plot-Metrics<%>))
114-
(new (class bitmap%
115-
(super-make-object width height #t 1.0)
116-
(define/public (get-plot-bounds) (send pm get-plot-bounds))
117-
(define/public (plot->dc [v : (Vectorof Real)]) (send pm plot->dc v))))
118-
#;(make-bitmap width height))
107+
(make-object (plot-metrics-mixin bitmap%)
108+
(λ () pm) width height #t 1.0))
119109
(define dc : (Instance DC<%>) (make-object bitmap-dc% bm))
120110
(define pm : (Instance Plot-Metrics<%>)
121111
(plot/dc renderer-tree dc 0 0 width height
@@ -138,7 +128,7 @@
138128
#:y-label (U String pict #f)
139129
#:aspect-ratio (U Nonnegative-Real #f)
140130
#:legend-anchor Legend-Anchor]
141-
PlotPict))
131+
Plot-Pict))
142132
(define (plot-pict renderer-tree
143133
#:x-min [x-min #f] #:x-max [x-max #f]
144134
#:y-min [y-min #f] #:y-max [y-max #f]
@@ -160,11 +150,7 @@
160150
#:title title #:x-label x-label #:y-label y-label #:legend-anchor legend-anchor
161151
#:aspect-ratio aspect-ratio))))
162152
width height))
163-
(pict->pp
164-
P
165-
(send (assert pm) get-plot-bounds)
166-
(λ ([v : (Vector Real Real)])
167-
(send (assert pm) plot->dc v))))
153+
(pict->pp P (assert pm)))
168154

169155
;; ===================================================================================================
170156
;; Plot to a file

‎plot-lib/plot/private/no-gui/plot3d-untyped.rkt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@
3434
#:z-label (or/c string? pict? #f)
3535
#:aspect-ratio (or/c (and/c rational? positive?) #f)
3636
#:legend-anchor legend-anchor/c]
37-
plot-metrics<%>/c)]))
37+
plot-metrics-object/c)]))
3838

3939
(define-syntax untyped-plot3d/dc
4040
(make-rename-transformer (unbox plot3d/dc-box)))

0 commit comments

Comments
 (0)