From a3e487d90a82c4ddad60b974787e8c053a91bb40 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 31 Mar 2009 04:53:23 +0000 Subject: [PATCH] always keep the lables right-side-up svn: r14373 original commit: fb3846cb4367b04ce42794c729162a5aa5c4f337 --- collects/mrlib/graph.ss | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/collects/mrlib/graph.ss b/collects/mrlib/graph.ss index 9a36a277..0382e89a 100644 --- a/collects/mrlib/graph.ss +++ b/collects/mrlib/graph.ss @@ -614,9 +614,12 @@ [arrow-end-y (send point3 get-y)] [arrowhead-end (make-rectangular arrow-end-x arrow-end-y)] [vec (- arrowhead-end from-pt)] + [angle (- (angle vec))] + [flip? (not (< (/ pi -2) angle (/ pi 2)))] + [angle (if flip? (+ angle pi) angle)] [middle (+ from-pt (- (* 1/2 vec) - (make-polar (/ text-len 2) (angle vec))))]) + (make-polar (/ text-len 2) (- angle))))]) (when (> (sqrt (+ (sqr (- arrow-end-x from-x)) (sqr (- arrow-end-y from-y)))) text-len) @@ -625,7 +628,7 @@ (+ dy (imag-part middle)) #f 0 - (- (angle vec)))))))])))))))) + angle)))))])))))))) (define (set-pen/brush from-link dark-lines?) (send dc set-brush