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

added support for customizing the edge label font to the graph library and propogated that argument to the redex traces and traces/ps functions

Browse Source 
svn: r13155
This commit is contained in:
Robby Findler 2009-01-15 21:29:26 +00:00
parent b75dfb878a
commit a4799be53c
5 changed files with 38 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/mrlib/graph.ss
View File

@ -231,6 +231,8 @@
(mixin ((class->interface pasteboard%)) (graph-pasteboard<%>)
(inherit find-first-snip find-next-selected-snip)
(init-field [edge-label-font #f])
(define draw-arrow-heads? #t)
(inherit refresh get-admin)
(define/public (set-draw-arrow-heads? x)
@ -248,6 +250,8 @@
(unbox wb)
(unbox hb))))))
(define arrowhead-angle-width (* 1/4 pi))
(define arrowhead-short-side 8)
(define arrowhead-long-side 12)
@ -484,7 +488,12 @@
(define/override (on-paint before? dc left top right bottom dx dy draw-caret)
(when before?
(draw-edges dc left top right bottom dx dy))
(let ([old-font (send dc get-font)])
(when edge-label-font
(send dc set-font edge-label-font))
(draw-edges dc left top right bottom dx dy)
(when edge-label-font
(send dc set-font old-font))))
(super on-paint before? dc left top right bottom dx dy draw-caret))
(define/public (draw-edges dc left top right bottom dx dy)

8
collects/mrlib/scribblings/graph/graph-pasteboard-mixin.scrbl
View File

@ -3,5 +3,13 @@
@defmixin/title[graph-pasteboard-mixin (pasteboard%) (graph-pasteboard<%>)]{
@defconstructor/auto-super[([edge-label-font (or/c #f (is-a?/c font%)) #f])]{
If @scheme[edge-label-font] is supplied, it is used when drawing the
labels on the edges. Otherwise, the font is not set before drawing
the labels, defaulting to the @scheme[dc<%>] object's font.
}
This mixin overrides many methods to draw lines between
@scheme[graph-snip<%>] that it contains.}

6
collects/redex/gui.ss
View File

@ -35,7 +35,8 @@
#:pp pp-contract
#:colors (listof (list/c string? string?))
#:scheme-colors? boolean?
#:layout (-> any/c any/c))
#:layout (-> any/c any/c)
#:edge-label-font (or/c #f (is-a?/c font%)))
any)]
[traces/ps (->* (reduction-relation?
any/c
@ -46,7 +47,8 @@
(any/c term-node? . -> . any))
#:pp pp-contract
#:colors (listof any/c)
#:layout (-> any/c any/c))
#:layout (-> any/c any/c)
#:edge-label-font (or/c #f (is-a?/c font%)))
any)]
[term-node? (-> any/c boolean?)]

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

@ -131,7 +131,9 @@
#:pp [pp default-pretty-printer]
#:scheme-colors? [scheme-colors? #t]
#:colors [colors '()]
#:layout [layout void])
#:layout [layout void]
#:edge-label-font [edge-label-font #f]
)
(let-values ([(graph-pb canvas)
(traces reductions pre-exprs
#:no-show-frame? #t
@ -140,7 +142,8 @@
#:pp pp
#:scheme-colors? scheme-colors?
#:colors colors
#:layout layout)])
#:layout layout
#:edge-label-font edge-label-font)])
(print-to-ps graph-pb canvas filename)))
(define (print-to-ps graph-pb canvas filename)
@ -227,11 +230,12 @@
#:colors [colors '()]
#:scheme-colors? [scheme-colors? #t]
#:layout [layout void]
#:edge-label-font [edge-label-font #f]
#:no-show-frame? [no-show-frame? #f])
(define exprs (if multiple? pre-exprs (list pre-exprs)))
(define main-eventspace (current-eventspace))
(define saved-parameterization (current-parameterization))
(define graph-pb (new graph-pasteboard% [layout layout]))
(define graph-pb (new graph-pasteboard% [layout layout] [edge-label-font edge-label-font]))
(define f (instantiate red-sem-frame% ()
(label "PLT Redex Reduction Graph")
(style '(toolbar-button))

16
collects/redex/redex.scrbl
View File

@ -1157,7 +1157,8 @@ exploring reduction sequences.
(lambda (x) (member (length x) '(2 3 4 6))))))]
[#:scheme-colors? scheme-colors? boolean?]
[#:layout layout (-> (listof term-node?) void)])
[#:layout layout (-> (listof term-node?) void)]
[#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f])
void?]{
This function opens a new window and inserts each expression
@ -1169,7 +1170,7 @@ found, or no more reductions can occur. It inserts each new
term into the gui. Clicking the @onscreen{reduce} button reduces
until reduction-steps-cutoff more terms are found.
The pred function indicates if a term has a particular
The @scheme[pred] function indicates if a term has a particular
property. If it returns @scheme[#f], the term is displayed with a
pink background. If it returns a string or a @scheme[color%] object,
the term is displayed with a background of that color (using
@ -1211,8 +1212,6 @@ the color that fills the arrow head. If fewer than six colors are
specified, the colors specified colors are used and then defaults are
filled in for the remaining colors.
The @scheme[scheme-colors?] argument, if @scheme[#t] causes
@scheme[traces] to color the contents of each of the windows according
to DrScheme's Scheme mode color Scheme. If it is @scheme[#f],
@ -1224,8 +1223,10 @@ 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.
The @scheme[edge-label-font] argument is used as the font on the edge
labels. If nothign is suppled, the @scheme[dc<%>] object's default
font is used.
}
@defproc[(traces/ps [reductions reduction-relation?]
@ -1241,7 +1242,8 @@ from the menus.
(any output-port number (is-a?/c text%) -> void))
default-pretty-printer]
[#:colors colors (listof (list string string)) '()]
[#:layout layout (-> (listof term-node?) void)])
[#:layout layout (-> (listof term-node?) void)]
[#:edge-label-font edge-label-font (or/c #f (is-a?/c font%)) #f])
void?]{
The arguments behave just like the function @scheme[traces], but