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

7
collects/redex/redex.scrbl
View File

@ -1272,6 +1272,8 @@ exploring reduction sequences.
[#:scheme-colors? scheme-colors? boolean? #t] [#:scheme-colors? scheme-colors? boolean? #t]
[#:filter term-filter (-> any/c (or/c #f string?) any/c) (lambda (x y) #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] [#:layout layout (-> (listof term-node?) void) void]
[#:edge-labels? edge-label-font boolean? #t] [#:edge-labels? edge-label-font boolean? #t]
[#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f] [#: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 about to be inserted into the graph. If the filter returns false, the
node is not inserted into the graph. 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 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 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 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)) '()] [#:colors colors (listof (list string string)) '()]
[#:filter term-filter (-> any/c (or/c #f string?) any/c) (lambda (x y) #t)] [#:filter term-filter (-> any/c (or/c #f string?) any/c) (lambda (x y) #t)]
[#:layout layout (-> (listof term-node?) void) void] [#:layout layout (-> (listof term-node?) void) void]
[#:x-spacing number? 15]
[#:y-spacing number? 15]
[#:edge-labels? edge-label-font boolean? #t] [#:edge-labels? edge-label-font boolean? #t]
[#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f] [#: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] [#:graph-pasteboard-mixin graph-pasteboard-mixin (make-mixin-contract graph-pasteboard<%>) values]