suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

When plot-new-window?' is #t, plot' and `plot3d' now create a frame in a new eventspace. This allows plot frames to be displayed programmatically. (Without this change, the frames are unresponsive until the REPL regains control.)

Browse Source
This commit is contained in:
Neil Toronto 2012-05-25 13:11:46 +09:00
parent ee95182386
commit 50ad8dac1f
4 changed files with 29 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/plot/common/gui.rkt
View File

@ -8,20 +8,20 @@
(define snip-frame%
(class frame%
(super-new)
(define/override (on-traverse-char event)
(define key-code (send event get-key-code))
(case key-code
[(escape) (send this show #f)]
[else (super on-traverse-char event)]))
))
(super-new)))
(define (make-snip-frame snip width height label)
(define (make-snip w h) snip)
(define frame
(new snip-frame% [label label] [width (+ 20 width)] [height (+ 20 height)]))
(parameterize ([current-eventspace (make-eventspace)])
(new snip-frame% [label label] [width (+ 20 width)] [height (+ 20 height)])))
(new snip-canvas%
[parent frame]
@ -30,3 +30,7 @@
[horizontal-inset 5] [vertical-inset 5])
frame)
(define (with-new-eventspace thnk)
(parameterize ([current-eventspace (make-eventspace)])
(thnk)))

4
collects/plot/plot2d/plot.rkt
View File

@ -21,7 +21,7 @@
;; Require lazily: without this, Racket complains while generating documentation:
;; cannot instantiate `racket/gui/base' a second time in the same process
(lazy-require ["snip.rkt" (make-2d-plot-snip)]
["../common/gui.rkt" (make-snip-frame)])
["../common/gui.rkt" (make-snip-frame with-new-eventspace)])
(provide (except-out (all-defined-out) get-renderer-list get-bounds-rect get-ticks plot-dc))
@ -301,7 +301,7 @@
(when out-file
(call plot-file out-file out-kind))
(cond [(plot-new-window?) (define frame (call plot-frame))
(cond [(plot-new-window?) (define frame (with-new-eventspace (λ () (call plot-frame))))
(send frame show #t)
(void)]
[else (call plot-snip)])))

4
collects/plot/plot3d/plot.rkt
View File

@ -21,7 +21,7 @@
;; Require lazily: without this, Racket complains while generating documentation:
;; cannot instantiate `racket/gui/base' a second time in the same process
(lazy-require ["snip.rkt" (make-3d-plot-snip)]
["../common/gui.rkt" (make-snip-frame)])
["../common/gui.rkt" (make-snip-frame with-new-eventspace)])
(provide (except-out (all-defined-out) get-renderer-list get-bounds-rect get-ticks plot3d-dc))
@ -346,7 +346,7 @@
(when out-file
(call plot3d-file out-file out-kind))
(cond [(plot-new-window?) (define frame (call plot3d-frame))
(cond [(plot-new-window?) (define frame (with-new-eventspace (λ () (call plot3d-frame))))
(send frame show #t)
(void)]
[else (call plot3d-snip)])))

37
collects/unstable/gui/snip.rkt
View File

@ -24,20 +24,6 @@
(define text (new read-only-text%))
(send text set-writable #f)
(super-new [parent parent]
[editor text]
[horizontal-inset horizontal-inset]
[vertical-inset vertical-inset]
[label label]
[enabled enabled]
[style (list* 'no-hscroll 'no-vscroll style)]
[vert-margin vert-margin]
[horiz-margin horiz-margin]
[min-width min-width]
[min-height min-height]
[stretchable-width stretchable-width]
[stretchable-height stretchable-height])
(define/public (get-snip) snip)
(define/override (on-size w h)
@ -58,14 +44,23 @@
(send text erase)
(send text insert snip)
(send text set-writable #f))
))
(super-new [parent parent]
[editor text]
[horizontal-inset horizontal-inset]
[vertical-inset vertical-inset]
[label label]
[enabled enabled]
[style (list* 'no-hscroll 'no-vscroll style)]
[vert-margin vert-margin]
[horiz-margin horiz-margin]
[min-width min-width]
[min-height min-height]
[stretchable-width stretchable-width]
[stretchable-height stretchable-height])))
(define read-only-text%
(class text%
(super-new)
(send this hide-caret #t)
(define writable? #t)
(define/public (set-writable w?) (set! writable? w?))
@ -78,4 +73,6 @@
(case op
[(copy select-all) #t]
[else writable?]))
))
(super-new)
(send this hide-caret #t)))