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

make font size changes also change the font of the edge

Browse Source 
labels and the size of the arrow heads in traces

closees PR 14719
This commit is contained in:
Robby Findler 2014-09-01 10:46:37 -05:00
parent b212f21977
commit 4ba0451caf
1 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/redex-pkgs/redex-gui-lib/redex/private/traces.rkt
View File

@ -11,6 +11,7 @@
racket/gui/base
racket/class
racket/file
racket/math
framework)
(preferences:set-default 'plt-reducer:show-bottom #t boolean?)
@ -247,7 +248,7 @@
#:racket-colors? [racket-colors? #t]
#:scheme-colors? [scheme-colors? racket-colors?]
#:layout [layout void]
#:edge-label-font [edge-label-font #f]
#:edge-label-font [given-edge-label-font #f]
#:edge-labels? [edge-labels? #t]
#:filter [term-filter (lambda (x y) #t)]
#:graph-pasteboard-mixin [extra-graph-pasteboard-mixin values]
@ -260,7 +261,7 @@
(define saved-parameterization (current-parameterization))
(define graph-pb
(let ([pb (new (extra-graph-pasteboard-mixin graph-pasteboard%)
[layout layout] [edge-label-font edge-label-font]
[layout layout] [edge-label-font given-edge-label-font]
[edge-labels? edge-labels?])])
(send pb set-flip-labels? #f)
pb))
@ -386,7 +387,12 @@
(send standard get-delta delta)
(send delta set-size-mult 0)
(send delta set-size-add size)
(send standard set-delta delta)))
(send standard set-delta delta)
(send graph-pb set-arrowhead-params (* pi 1/4) size (* size 2/3))
(unless given-edge-label-font
(send graph-pb set-edge-label-font
(send the-font-list find-or-create-font
size 'default 'normal 'normal)))))
;; fill-out : (listof X) (listof X) -> (listof X)
;; produces a list whose length matches defaults but