From c5d2342999d2e1c4ab0de7df04b90a8678a25e67 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 31 Mar 2009 14:54:40 +0000
Subject: [PATCH] added set-flip-labels?

svn: r14386
---
 collects/mrlib/graph.ss                       | 26 +++++++++----------
 .../graph/graph-pasteboard-intf.scrbl         | 11 ++++++++
 2 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/collects/mrlib/graph.ss b/collects/mrlib/graph.ss
index 0da089863c..0bf6e09151 100644
--- a/collects/mrlib/graph.ss
+++ b/collects/mrlib/graph.ss
@@ -252,6 +252,7 @@
       set-arrowhead-params
       get-arrowhead-params
       set-draw-arrow-heads?
+      set-flip-labels?
       draw-edges))
   
   (define-struct rect (left top right bottom))
@@ -264,23 +265,21 @@
                   [edge-labels? #t])
       
       (define draw-arrow-heads? #t)
+      (define flip-labels?      #t)
       (inherit refresh get-admin)
-      (define/public (set-draw-arrow-heads? x)
-        (set! draw-arrow-heads? x)
+      (define (refresh*)
         (let ([admin (get-admin)])
           (when admin
-            (let ([xb (box 0)]
-                  [yb (box 0)]
-                  [wb (box 0)]
-                  [hb (box 0)])
+            (let ([xb (box 0)] [yb (box 0)] [wb (box 0)] [hb (box 0)])
               (send admin get-view xb yb wb hb)
               (send admin needs-update
-                    (unbox xb)
-                    (unbox yb)
-                    (unbox wb)
-                    (unbox hb))))))
-      
-      
+                    (unbox xb) (unbox yb) (unbox wb) (unbox hb))))))
+      (define/public (set-draw-arrow-heads? x)
+        (set! draw-arrow-heads? x)
+        (refresh*))
+      (define/public (set-flip-labels? x)
+        (set! flip-labels? x)
+        (refresh*))
       
       (define arrowhead-angle-width (* 1/4 pi))
       (define arrowhead-short-side 8)
@@ -644,7 +643,8 @@
                                       [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)))]
+                                      [flip? (and flip-labels?
+                                                  (not (< (/ pi -2) angle (/ pi 2))))]
                                       [angle (if flip? (+ angle pi) angle)]
                                       [middle (+ from-pt
                                                  (- (* 1/2 vec)
diff --git a/collects/mrlib/scribblings/graph/graph-pasteboard-intf.scrbl b/collects/mrlib/scribblings/graph/graph-pasteboard-intf.scrbl
index c1ef562951..a55866f0b9 100644
--- a/collects/mrlib/scribblings/graph/graph-pasteboard-intf.scrbl
+++ b/collects/mrlib/scribblings/graph/graph-pasteboard-intf.scrbl
@@ -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<%>)]
 [left real?]
 [top real?]