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

added set-flip-labels?

Browse Source 
svn: r14386
This commit is contained in:
Eli Barzilay 2009-03-31 14:54:40 +00:00
parent 03ef481766
commit c5d2342999
2 changed files with 24 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/mrlib/graph.ss
View File

@ -252,6 +252,7 @@
set-arrowhead-params set-arrowhead-params
get-arrowhead-params get-arrowhead-params
set-draw-arrow-heads? set-draw-arrow-heads?
set-flip-labels?
draw-edges)) draw-edges))
(define-struct rect (left top right bottom)) (define-struct rect (left top right bottom))
@ -264,23 +265,21 @@
[edge-labels? #t]) [edge-labels? #t])
(define draw-arrow-heads? #t) (define draw-arrow-heads? #t)
(define flip-labels? #t)
(inherit refresh get-admin) (inherit refresh get-admin)
(define/public (set-draw-arrow-heads? x) (define (refresh*)
(set! draw-arrow-heads? x)
(let ([admin (get-admin)]) (let ([admin (get-admin)])
(when admin (when admin
(let ([xb (box 0)] (let ([xb (box 0)] [yb (box 0)] [wb (box 0)] [hb (box 0)])
[yb (box 0)]
[wb (box 0)]
[hb (box 0)])
(send admin get-view xb yb wb hb) (send admin get-view xb yb wb hb)
(send admin needs-update (send admin needs-update
(unbox xb) (unbox xb) (unbox yb) (unbox wb) (unbox hb))))))
(unbox yb) (define/public (set-draw-arrow-heads? x)
(unbox wb) (set! draw-arrow-heads? x)
(unbox hb)))))) (refresh*))
(define/public (set-flip-labels? x)
(set! flip-labels? x)
(refresh*))
(define arrowhead-angle-width (* 1/4 pi)) (define arrowhead-angle-width (* 1/4 pi))
(define arrowhead-short-side 8) (define arrowhead-short-side 8)
@ -644,7 +643,8 @@
[arrowhead-end (make-rectangular arrow-end-x arrow-end-y)] [arrowhead-end (make-rectangular arrow-end-x arrow-end-y)]
[vec (- arrowhead-end from-pt)] [vec (- arrowhead-end from-pt)]
[angle (- (angle vec))] [angle (- (angle vec))]
[flip? (not (< (/ pi -2) angle (/ pi 2)))] [flip? (and flip-labels?
(not (< (/ pi -2) angle (/ pi 2))))]
[angle (if flip? (+ angle pi) angle)] [angle (if flip? (+ angle pi) angle)]
[middle (+ from-pt [middle (+ from-pt
(- (* 1/2 vec) (- (* 1/2 vec)

11
collects/mrlib/scribblings/graph/graph-pasteboard-intf.scrbl
View File

@ -45,6 +45,17 @@ different nodes.
} }
@defmethod[(set-draw-arrow-heads? [flip-labels? any/c])
void?]{
Sets a boolean controlling whether or not arrow labels are flipped so
the are always right-side-up.
This setting does not affect self-links---only links between two
different nodes.
}
@defmethod[(draw-edges [dc (is-a?/c dc<%>)] @defmethod[(draw-edges [dc (is-a?/c dc<%>)]
[left real?] [left real?]
[top real?] [top real?]