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

always keep the lables right-side-up

Browse Source 
svn: r14373

original commit: fb3846cb4367b04ce42794c729162a5aa5c4f337
This commit is contained in:
Eli Barzilay 2009-03-31 04:53:23 +00:00
parent d10ddc1348
commit a3e487d90a
1 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/mrlib/graph.ss
View File

@ -614,9 +614,12 @@
[arrow-end-y (send point3 get-y)] [arrow-end-y (send point3 get-y)]
[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))]
[flip? (not (< (/ pi -2) angle (/ pi 2)))]
[angle (if flip? (+ angle pi) angle)]
[middle (+ from-pt [middle (+ from-pt
(- (* 1/2 vec) (- (* 1/2 vec)
(make-polar (/ text-len 2) (angle vec))))]) (make-polar (/ text-len 2) (- angle))))])
(when (> (sqrt (+ (sqr (- arrow-end-x from-x)) (when (> (sqrt (+ (sqr (- arrow-end-x from-x))
(sqr (- arrow-end-y from-y)))) (sqr (- arrow-end-y from-y))))
text-len) text-len)
@ -625,7 +628,7 @@
(+ dy (imag-part middle)) (+ dy (imag-part middle))
#f #f
0 0
(- (angle vec)))))))])))))))) angle)))))]))))))))
(define (set-pen/brush from-link dark-lines?) (define (set-pen/brush from-link dark-lines?)
(send dc set-brush (send dc set-brush