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

fixed an x/y reversal bug and improved the #:layout function so it isn't called as much

Browse Source 
svn: r13116
This commit is contained in:
Robby Findler 2009-01-14 18:05:21 +00:00
parent d1f65ae6c9
commit ae1e6ca263
2 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/redex/private/traces.ss
View File

@ -86,7 +86,7 @@
(λ (ed)
(let ([yb (box 0)]
[snip (term-node-snip term-node)])
(if (send ed get-snip-location snip yb #f #f)
(if (send ed get-snip-location snip #f yb #f)
(unbox yb)
0)))))
@ -145,7 +145,7 @@
(define (print-to-ps graph-pb filename)
(let ([admin (send graph-pb get-admin)]
[printing-admin (new printing-editor-admin%)])
[printing-admin (new printing-editor-admin% [ed graph-pb])])
(send graph-pb set-admin printing-admin)
(dynamic-wind
@ -153,7 +153,7 @@
(λ ()
(let loop ([snip (send graph-pb find-first-snip)])
(when snip
(send snip size-cache-invalid)
(send (send snip get-admin) resized snip #t)
(loop (send snip next))))
(send graph-pb invalidate-bitmap-cache)
@ -179,6 +179,8 @@
(define printing-editor-admin%
(class editor-admin%
(init-field ed)
(define temp-file (make-temporary-file "redex-size-snip-~a"))
(define ps-dc
@ -270,7 +272,7 @@
"Reducing..."
lower-panel
(lambda (x y)
(reduce-button-callback))))
(reduce-button-callback #f))))
(define status-message (instantiate message% ()
(label "")
(parent lower-panel)
@ -411,7 +413,6 @@
(set! col (+ x-spacing (find-rightmost-x graph-pb))))
(begin0
(insert-into col y graph-pb new-snips)
(send graph-pb re-run-layout)
(send graph-pb end-edit-sequence)
(send status-message set-label
(string-append (term-count (count-snips)) "...")))))])
@ -455,9 +456,10 @@
(send reduce-button enable #t)
(send font-size enable #t))
;; reduce-button-callback : -> void
;; reduce-button-callback : boolean -> void
;; =eventspace main thread=
(define (reduce-button-callback)
(define (reduce-button-callback show-all-at-once?)
(when show-all-at-once? (send graph-pb begin-edit-sequence))
(send reduce-button enable #f)
(send reduce-button set-label "Reducing...")
(thread
@ -465,6 +467,10 @@
(do-some-reductions)
(queue-callback
(lambda () ;; =eventspace main thread=
(send graph-pb begin-edit-sequence)
(send graph-pb re-run-layout)
(send graph-pb end-edit-sequence)
(when show-all-at-once? (send graph-pb end-edit-sequence))
(scroll-to-rightmost-snip)
(send reduce-button set-label "Reduce")
(cond
@ -542,7 +548,6 @@
null)))
(out-of-dot-state) ;; make sure the state is initialized right
(insert-into init-rightmost-x 0 graph-pb frontier)
(send graph-pb re-run-layout)
(set-font-size (initial-font-size))
(cond
[no-show-frame?
@ -553,7 +558,7 @@
(yield s))
(values graph-pb f)]
[else
(reduce-button-callback)
(reduce-button-callback #t)
(send f show #t)]))
(define red-sem-frame%

8
collects/redex/redex.scrbl
View File

@ -1218,9 +1218,11 @@ The @scheme[scheme-colors?] argument, if @scheme[#t] causes
to DrScheme's Scheme mode color Scheme. If it is @scheme[#f],
@scheme[traces] just uses black for the color scheme.
The @scheme[layout] argument is called (with all of the terms) each
time a new term is inserted into the window. See also
@scheme[term-node-set-position!].
The @scheme[layout] argument is called (with all of the terms) when
new terms is inserted into the window. In general, it is called when
after new terms are inserted in response to the user clicking on the
reduce button, and after the initial set of terms is inserted.
See also @scheme[term-node-set-position!].
You can save the contents of the window as a postscript file
from the menus.