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

added set-links-label! to change a link label

Browse Source 
svn: r14374
This commit is contained in:
Eli Barzilay 2009-03-31 05:57:44 +00:00
parent fb3846cb43
commit 202134e45c
1 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/mrlib/graph.ss
View File

@ -83,7 +83,13 @@
number? number?
(or/c false/c string?) (or/c false/c string?)
. -> . . -> .
void?))) void?))
(set-links-label!
((is-a?/c graph-snip<%>)
(is-a?/c graph-snip<%>)
(or/c false/c string?)
. -> .
void?)))
(define self-offset 10) (define self-offset 10)
@ -140,6 +146,8 @@
label) label)
(send parent add-child child) (send parent add-child child)
(send child add-parent parent dark-pen light-pen dark-brush light-brush dark-text light-text dx dy label)) (send child add-parent parent dark-pen light-pen dark-brush light-brush dark-text light-text dx dy label))
(define (set-links-label! parent child label)
(send child set-parent-link-label parent label))
(define graph-snip-mixin (define graph-snip-mixin
(mixin ((class->interface snip%)) (graph-snip<%>) (mixin ((class->interface snip%)) (graph-snip<%>)
@ -155,6 +163,15 @@
(field (parent-links null)) (field (parent-links null))
(define/public (get-parent-links) parent-links) (define/public (get-parent-links) parent-links)
(define/public (get-parents) (map link-snip parent-links)) (define/public (get-parents) (map link-snip parent-links))
(define/public (set-parent-link-label parent label)
(let ([parent-link
(cond [(memf (lambda (parent-link)
(eq? (link-snip parent-link) parent))
parent-links)
=> car]
[else #f])])
(when parent-link
(set-link-label! parent-link label))))
(define/public add-parent (define/public add-parent
(case-lambda (case-lambda
[(parent) (add-parent parent #f #f #f #f)] [(parent) (add-parent parent #f #f #f #f)]