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

added x-spacing and y-spacing parameters to traces and traces/ps

Browse Source 
svn: r15356
This commit is contained in:
Robby Findler 2009-07-01 18:24:47 +00:00
parent 62bc659ec8
commit 890882a6fd
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -124,8 +124,8 @@
get-point-size)))
;; the initial spacing between row and columns of the reduction terms
(define x-spacing 15)
(define y-spacing 15)
(define default-x-spacing 15)
(define default-y-spacing 15)
(define (traces/ps reductions pre-exprs filename
#:multiple? [multiple? #f]
@ -138,7 +138,9 @@
#:edge-labels? [edge-labels? #t]
#:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values]
#:filter [term-filter (lambda (x y) #t)]
#:post-process [post-process void])
#:post-process [post-process void]
#:x-spacing [x-spacing default-x-spacing]
#:y-spacing [y-spacing default-x-spacing])
(let-values ([(graph-pb canvas)
(traces reductions pre-exprs
#:no-show-frame? #t
@ -151,7 +153,9 @@
#:edge-label-font edge-label-font
#:edge-labels? edge-labels?
#:graph-pasteboard-mixin extra-graph-pasteboard-mixin
#:filter term-filter)])
#:filter term-filter
#:x-spacing x-spacing
#:y-spacing y-spacing)])
(post-process graph-pb)
(print-to-ps graph-pb canvas filename)))
@ -243,7 +247,9 @@
#:edge-labels? [edge-labels? #t]
#:filter [term-filter (lambda (x y) #t)]
#:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values]
#:no-show-frame? [no-show-frame? #f])
#:no-show-frame? [no-show-frame? #f]
#:x-spacing [x-spacing default-x-spacing]
#:y-spacing [y-spacing default-y-spacing])
(define exprs (if multiple? pre-exprs (list pre-exprs)))
(define main-eventspace (current-eventspace))
(define saved-parameterization (current-parameterization))
@ -438,7 +444,7 @@
(unless col ;; only compute col here, incase user moves snips
(set! col (+ x-spacing (find-rightmost-x graph-pb))))
(begin0
(insert-into col y graph-pb new-snips)
(insert-into col y graph-pb new-snips y-spacing)
(send graph-pb end-edit-sequence)
(send status-message set-label
(string-append (term-count (count-snips)) "...")))))])
@ -610,7 +616,7 @@
null)))
(out-of-dot-state) ;; make sure the state is initialized right
(set-font-size (initial-font-size)) ;; have to call this before 'insert-into' or else it triggers resizing
(insert-into init-rightmost-x 0 graph-pb frontier)
(insert-into init-rightmost-x 0 graph-pb frontier y-spacing)
(cond
[no-show-frame?
(let ([s (make-semaphore)])
@ -759,7 +765,7 @@
;; inserts the snips into the pasteboard vertically
;; aligned, starting at (x,y). Returns
;; the y coordinate where another snip might be inserted.
(define (insert-into x y pb exprs)
(define (insert-into x y pb exprs y-spacing)
(let loop ([exprs exprs]
[y y])
(cond

7
collects/redex/redex.scrbl
View File

@ -1272,6 +1272,8 @@ exploring reduction sequences.
[#:scheme-colors? scheme-colors? boolean? #t]
[#:filter term-filter (-> any/c (or/c #f string?) any/c) (lambda (x y) #t)]
[#:x-spacing number? 15]
[#:y-spacing number? 15]
[#:layout layout (-> (listof term-node?) void) void]
[#:edge-labels? edge-label-font boolean? #t]
[#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f]
@ -1338,6 +1340,9 @@ The @scheme[term-filter] function is called each time a new node is
about to be inserted into the graph. If the filter returns false, the
node is not inserted into the graph.
The @scheme[x-spacing] and @scheme[y-spacing] control the amount of
space put between the snips in the default layout.
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
@ -1378,6 +1383,8 @@ inserted into the editor by this library have a
[#:colors colors (listof (list string string)) '()]
[#:filter term-filter (-> any/c (or/c #f string?) any/c) (lambda (x y) #t)]
[#:layout layout (-> (listof term-node?) void) void]
[#:x-spacing number? 15]
[#:y-spacing number? 15]
[#:edge-labels? edge-label-font boolean? #t]
[#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f]
[#:graph-pasteboard-mixin graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>) values]