GraphicsContext.st
changeset 4911 aa37e3fa329e
parent 4903 9bed66cb8c21
child 4930 d464ba6aea9b
--- a/GraphicsContext.st	Thu Feb 14 14:58:43 2008 +0100
+++ b/GraphicsContext.st	Thu Feb 14 16:05:29 2008 +0100
@@ -1713,39 +1713,53 @@
 displayRoundRectangleX:left y:top width:width height:height wCorner:wCorn hCorner:hCorn
     |right bottom wC hC wHalf hHalf|
 
+    "/ BIG KLUDGE WARNING HERE: the code below looks "good" on windows displays;
+    "/ (if you change anything under Unix, make it X-platform specific.
+    "/ (there seem to be drawing incompatibilities between Win- and XWorkstation)
+
     right := left + width-1.
     bottom := top + height-1.
 
     wC := wCorn.
     hC := hCorn.
 
-    wHalf := wC / 2.
-    hHalf := hC / 2.
-
-    "top line"
-    self displayLineFromX:(left + wHalf - 1) y:top toX:(right - wHalf) y:top.
+    self scale = 1 ifTrue:[
+        wHalf := wC // 2.
+        hHalf := hC // 2.
+    ] ifFalse:[
+        wHalf := wC / 2.
+        hHalf := hC / 2.
+    ].
 
     "top left arc"
     self displayArcX:left y:top width:wC height:hC from:90 angle:90.
 
-    "left line"
-    self displayLineFromX:left y:(top + hHalf - 1) toX:left y:(bottom - hHalf).
-
     "top right arc"
     self displayArcX:(right - wC) y:top width:wC height:hC from:0 angle:90.
 
+    "bottom right arc"
+    self scale = 1 ifTrue:[
+        self displayArcX:(right - wC+1) y:(bottom - hC+1) width:wC height:hC from:270 angle:90.
+    ] ifFalse:[
+        self displayArcX:(right - wC) y:(bottom - hC) width:wC height:hC from:270 angle:90.
+    ].
+
+    "bottom left arc"
+    self displayArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90.
+
+    "top line"
+    self displayLineFromX:(left + wHalf) y:top toX:(right - wHalf+1) y:top.
+
+    "left line"
+    self displayLineFromX:left y:(top + hHalf - 1) toX:left y:(bottom - hHalf).
+
     "bottom line"
-    self displayLineFromX:(left + wHalf -1) y:bottom
+    self displayLineFromX:(left + wHalf-1) y:bottom
                       toX:(right - wHalf ) y:bottom.
 
-    "bottom right arc"
-    self displayArcX:(right - wC) y:(bottom - hC) width:wC height:hC from:270 angle:90.
-
     "right line"
     self displayLineFromX:right y:(top + hHalf) toX:right y:(bottom - hHalf).
 
-    "bottom left arc"
-    self displayArcX:left y:(bottom - hC) width:wC height:hC from:180 angle:90
 
     "
      |v|
@@ -2420,7 +2434,7 @@
 !GraphicsContext class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.116 2008-02-05 20:02:33 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.117 2008-02-14 15:05:29 cg Exp $'
 ! !
 
 GraphicsContext initialize!