#BUGFIX by stefan
authorStefan Vogel <sv@exept.de>
Tue, 13 Sep 2016 12:09:19 +0200
changeset 4082 bf789bbea096
parent 4080 8b66d15c3473
child 4083 0371ef82506b
child 4084 14a4edd54856
#BUGFIX by stefan class: Text changed: #displayOn:x:y:opaque: #emphasisAtPoint:on: #widthOn: compute correct width for BoldOverline and others
Text.st
--- a/Text.st	Fri Sep 09 13:23:00 2016 +0200
+++ b/Text.st	Tue Sep 13 12:09:19 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1996 by Claus Gittinger
               All Rights Reserved
@@ -761,7 +763,7 @@
 
 !Text methodsFor:'displaying'!
 
-displayOn:aGC x:x0 y:yBase opaque:opaqueWanted
+displayOn:aGCOrView x:x0 y:yBase opaque:opaqueWanted
     "display the receiver on a GC.
      This is one of the ugliest pieces of code..."
 
@@ -772,29 +774,29 @@
      pos    "{ Class: SmallInteger }"
      endPos "{ Class: SmallInteger }"
      x y    
-     l      "{ Class: SmallInteger }"
+     len    "{ Class: SmallInteger }"
      yL k value device opaque|
 
-    savedFont := aGC basicFont.
-    savedPaint := aGC paint.
-    savedBgPaint := aGC backgroundPaint.
+    savedFont := aGCOrView basicFont.
+    savedPaint := aGCOrView paint.
+    savedBgPaint := aGCOrView backgroundPaint.
 
     opaque := opaqueWanted.
-    device := aGC graphicsDevice.
+    device := aGCOrView graphicsDevice.
 
     pos := 1.
     x := x0.
-    bold := italic := underline := underwave := strikeout := reverse := false.
+    bold := italic := underline := underwave := strikeout := reverse := overline := false.
 
     runs size > string size ifTrue:[
         Transcript showCR:'inconsistent text: runs size > string size'.
         runs := runs copyTo:(string size)
     ].
 
-    runs runsDo:[:len :emphasis |
+    runs runsDo:[:runLen :emphasis |
         wasItalic := italic.
         color := savedPaint.
-        bold := italic := underline := underwave := strikeout := reverse := false.
+        bold := italic := underline := underwave := strikeout := reverse := overline := false.
         altFont := subOrSuperscript := nil.
         bgPaint := savedBgPaint.
         y := yBase.
@@ -816,7 +818,7 @@
             ifFalse:[emphasis == Superscript ifTrue:[subOrSuperscript := Superscript]
             ]]]]]]]]]]]]]
         ] ifFalse:[
-            (emphasis isMemberOf:Association) ifTrue:[
+            emphasis isAssociation ifTrue:[
                 value := emphasis value.
                 value notNil ifTrue:[
                     k := emphasis key.
@@ -858,7 +860,7 @@
                         ifFalse:[emphasis == Subscript ifTrue:[subOrSuperscript := Subscript]
                         ifFalse:[emphasis == Superscript ifTrue:[subOrSuperscript := Superscript]
                         ifFalse:[
-                            (entry isMemberOf:Association) ifTrue:[
+                            entry isAssociation ifTrue:[
                                 value := entry value.
                                 value notNil ifTrue:[
                                     k := entry key.
@@ -923,15 +925,15 @@
                 y := y + (font height // 3).
             ].    
         ].    
-        aGC basicFont:font.
+        aGCOrView basicFont:font.
         reverse ifTrue:[
-            aGC paint:bgPaint on:color.
+            aGCOrView paint:bgPaint on:color.
             opaque := true.
         ] ifFalse:[
-            aGC paint:color on:bgPaint.
+            aGCOrView paint:color on:bgPaint.
         ].
 
-        endPos := pos + len - 1.
+        endPos := pos + runLen - 1.
 
 "/ disabled - it is too ugly (and not handled correctly, anyway).
 "/        wasItalic ~~ italic ifTrue:[
@@ -942,54 +944,54 @@
 "/        ].
 
         (opaque and:[etchColor isNil]) ifTrue:[
-            aGC displayOpaqueString:string from:pos to:endPos x:x y:y.
+            aGCOrView displayOpaqueString:string from:pos to:endPos x:x y:y.
         ] ifFalse:[
             etchColor notNil ifTrue:[
                 opaque ifTrue:[
                     "/ sigh - must draw the background rectangle;
                     "/ its easier (and faster) to draw the string twice here ...
-                    aGC displayOpaqueString:string from:pos to:endPos x:x y:y.
+                    aGCOrView displayOpaqueString:string from:pos to:endPos x:x y:y.
                 ].
-                savedFgPaint := aGC paint.
-                aGC paint:etchColor.
-                aGC displayString:string from:pos to:endPos x:x+1 y:y+1.
-                aGC paint:savedFgPaint.
+                savedFgPaint := aGCOrView paint.
+                aGCOrView paint:etchColor.
+                aGCOrView displayString:string from:pos to:endPos x:x+1 y:y+1.
+                aGCOrView paint:savedFgPaint.
             ].
-            aGC displayString:string from:pos to:endPos x:x y:y.
+            aGCOrView displayString:string from:pos to:endPos x:x y:y.
         ].
-        l := font widthOf:string from:pos to:endPos.
+        len := font widthOf:string from:pos to:endPos.
 
         underline ifTrue:[
-            ulPaint notNil ifTrue:[aGC paint:ulPaint].
+            ulPaint notNil ifTrue:[aGCOrView paint:ulPaint].
             yL := y+1.
-            aGC displayLineFromX:x y:yL toX:x+l-1 y:yL
+            aGCOrView displayLineFromX:x y:yL toX:x+len-1 y:yL
         ].
-        (overline ? false) ifTrue:[                      "MB:added v"
-            ulPaint notNil ifTrue:[aGC paint:ulPaint].
+        overline ifTrue:[                               "MB:added v"
+            ulPaint notNil ifTrue:[aGCOrView paint:ulPaint].
             yL := y-(font heightOf: string) + 2.
-            aGC displayLineFromX:x y:yL toX:x+l-1 y:yL
+            aGCOrView displayLineFromX:x y:yL toX:x+len-1 y:yL
         ].                                               "MB:added ^"
         underwave ifTrue:[
-            ulPaint notNil ifTrue:[aGC paint:ulPaint].
+            ulPaint notNil ifTrue:[aGCOrView paint:ulPaint].
             yL := y+1.
-            aGC displayHorizontalWavelineFromX:x y:yL toX:x+l-1
+            aGCOrView displayHorizontalWavelineFromX:x y:yL toX:x+len-1
         ].
         strikeout ifTrue:[
-            strikePaint notNil ifTrue:[aGC paint:strikePaint].
+            strikePaint notNil ifTrue:[aGCOrView paint:strikePaint].
             yL := y-(font ascent//2).
-            aGC displayLineFromX:x y:yL toX:x+l-1 y:yL
+            aGCOrView displayLineFromX:x y:yL toX:x+len-1 y:yL
         ].
 
-        x := x + l.
+        x := x + len.
         pos := endPos + 1
     ].
 
-    aGC basicFont:savedFont.
-    aGC paint:savedPaint on:savedBgPaint.
+    aGCOrView basicFont:savedFont.
+    aGCOrView paint:savedPaint on:savedBgPaint.
 
     pos < string size ifTrue:[
        "/ draw rest
-       aGC displayString:string from:pos to:string size x:x y:y.
+       aGCOrView displayString:string from:pos to:string size x:x y:y.
     ].
 
     "Created: / 12.5.1996 / 11:14:30 / cg"
@@ -1627,51 +1629,65 @@
 
 !Text methodsFor:'queries'!
 
-emphasisAtPoint:aPoint on:aGC
+emphasisAtPoint:aPoint on:aGCOrView
     "return the emphasis at a given point, or nil if there is none"
 
-    |pointX savedFont boldFont italicFont bold italic wasItalic pos f l gcDevice posX|
+    |pointX savedFont boldFont italicFont bold italic wasItalic pos font len gcDevice posX boldItalicFont|
 
-    pointX := aPoint x.
-    gcDevice := aGC graphicsDevice.
-
-    savedFont := aGC basicFont onDevice:gcDevice.
+    gcDevice := aGCOrView graphicsDevice.
+    savedFont := aGCOrView basicFont onDevice:gcDevice.
 
     pos := 1.
     posX := 0.
-    l := 0.
+    pointX := aPoint x.
+    len := 0.
     italic := false.
-    runs runsDo:[:len :emphasis |
+    runs runsDo:[:runLen :emphasis |
         wasItalic := italic.
         emphasis isSymbol ifTrue:[
-            bold := (emphasis == #bold).
-            italic := (emphasis == #italic).
+            bold := emphasis == BoldEmphasis 
+                        or:[emphasis == BoldUnderlineEmphasis
+                        or:[emphasis == BoldOverlineEmphasis
+                        or:[emphasis == BoldUnderwaveEmphasis]]].
+            italic := emphasis == ItalicEmphasis
+                        or:[emphasis == ItalicUnderlineEmphasis
+                        or:[emphasis == ItalicUnderwaveEmphasis]].
         ] ifFalse:[
-            (emphasis isNil 
-            or:[emphasis isMemberOf:Association]) ifTrue:[
-                bold := italic := false
-            ] ifFalse:[
-                bold := emphasis includesIdentical:#bold.
-                italic := emphasis includesIdentical:#italic.
+            bold := italic := false.
+            (emphasis isNil or:[emphasis isAssociation]) ifFalse:[
+                emphasis do:[:eachEmphasisSymbol|
+                    eachEmphasisSymbol == BoldEmphasis ifTrue:[bold := true]
+                    ifFalse:[eachEmphasisSymbol == ItalicEmphasis ifTrue:[italic := true]
+                    ifFalse:[eachEmphasisSymbol == BoldUnderlineEmphasis ifTrue:[bold := true]
+                    ifFalse:[eachEmphasisSymbol == BoldUnderwaveEmphasis ifTrue:[bold := true]
+                    ifFalse:[eachEmphasisSymbol == ItalicUnderlineEmphasis ifTrue:[italic := true]
+                    ifFalse:[eachEmphasisSymbol == ItalicUnderwaveEmphasis ifTrue:[italic := true]]]]]].
+                ].
             ]
         ].
 
         bold ifTrue:[
-            boldFont isNil ifTrue:[
-                boldFont := savedFont asBold onDevice:gcDevice
-            ].
-            f := boldFont.
+            italic ifTrue:[
+                boldItalicFont isNil ifTrue:[
+                    boldItalicFont := savedFont asBold asItalic onDevice:gcDevice
+                ].
+                font := boldItalicFont.
+            ] ifFalse:[
+                boldFont isNil ifTrue:[
+                    boldFont := savedFont asBold onDevice:gcDevice
+                ].
+                font := boldFont.
+            ]
         ] ifFalse:[
             italic ifTrue:[
                 italicFont isNil ifTrue:[
                     italicFont := savedFont asItalic onDevice:gcDevice
                 ].
-                f := italicFont
+                font := italicFont
             ] ifFalse:[
-                f := savedFont
+                font := savedFont
             ]
         ].
-        f := f onDevice:gcDevice.
 "/ disabled - it is too ugly (and not handled correctly, anyway).
 "/        wasItalic ~~ italic ifTrue:[
 "/            italic ifFalse:[
@@ -1679,12 +1695,12 @@
 "/                l := l + (f width " // 2" )
 "/            ].
 "/        ].
-        l := (f widthOf:string from:pos to:(pos + len - 1)).
-        (pointX between:posX and:posX + l) ifTrue:[
+        len := font widthOf:string from:pos to:(pos + runLen - 1).
+        (pointX between:posX and:posX + len) ifTrue:[
             ^ emphasis
         ].
-        pos := pos + len.
-        posX := posX + l.
+        pos := pos + runLen.
+        posX := posX + len.
     ].
 
     ^ nil
@@ -1814,46 +1830,60 @@
 widthOn:aGC
     "return the number of device units, required on aGC's device"
 
-    |savedFont boldFont italicFont bold italic wasItalic pos f l gcDevice|
+    |savedFont boldFont italicFont bold italic wasItalic pos font len gcDevice boldItalicFont|
 
     gcDevice := aGC graphicsDevice.
-
     savedFont := aGC basicFont onDevice:gcDevice.
 
     pos := 1.
-    l := 0.
+    len := 0.
     italic := false.
-    runs runsDo:[:len :emphasis |
+    runs runsDo:[:runLen :emphasis |
         wasItalic := italic.
         emphasis isSymbol ifTrue:[
-            bold := (emphasis == #bold).
-            italic := (emphasis == #italic).
+            bold := emphasis == BoldEmphasis 
+                        or:[emphasis == BoldUnderlineEmphasis
+                        or:[emphasis == BoldOverlineEmphasis
+                        or:[emphasis == BoldUnderwaveEmphasis]]].
+            italic := emphasis == ItalicEmphasis
+                        or:[emphasis == ItalicUnderlineEmphasis
+                        or:[emphasis == ItalicUnderwaveEmphasis]].
         ] ifFalse:[
-            (emphasis isNil 
-            or:[emphasis isMemberOf:Association]) ifTrue:[
-                bold := italic := false
-            ] ifFalse:[
-                bold := emphasis includesIdentical:#bold.
-                italic := emphasis includesIdentical:#italic.
+            bold := italic := false.
+            (emphasis isNil or:[emphasis isAssociation]) ifFalse:[
+                emphasis do:[:eachEmphasisSymbol|
+                    eachEmphasisSymbol == BoldEmphasis ifTrue:[bold := true]
+                    ifFalse:[eachEmphasisSymbol == ItalicEmphasis ifTrue:[italic := true]
+                    ifFalse:[eachEmphasisSymbol == BoldUnderlineEmphasis ifTrue:[bold := true]
+                    ifFalse:[eachEmphasisSymbol == BoldUnderwaveEmphasis ifTrue:[bold := true]
+                    ifFalse:[eachEmphasisSymbol == ItalicUnderlineEmphasis ifTrue:[italic := true]
+                    ifFalse:[eachEmphasisSymbol == ItalicUnderwaveEmphasis ifTrue:[italic := true]]]]]].
+                ].
             ]
         ].
 
         bold ifTrue:[
-            boldFont isNil ifTrue:[
-                boldFont := savedFont asBold onDevice:gcDevice
-            ].
-            f := boldFont.
+            italic ifTrue:[
+                boldItalicFont isNil ifTrue:[
+                    boldItalicFont := savedFont asBold asItalic onDevice:gcDevice
+                ].
+                font := boldItalicFont.
+            ] ifFalse:[
+                boldFont isNil ifTrue:[
+                    boldFont := savedFont asBold onDevice:gcDevice
+                ].
+                font := boldFont.
+            ]
         ] ifFalse:[
             italic ifTrue:[
                 italicFont isNil ifTrue:[
                     italicFont := savedFont asItalic onDevice:gcDevice
                 ].
-                f := italicFont
+                font := italicFont
             ] ifFalse:[
-                f := savedFont
+                font := savedFont
             ]
         ].
-        f := f onDevice:gcDevice.
 "/ disabled - it is too ugly (and not handled correctly, anyway).
 "/        wasItalic ~~ italic ifTrue:[
 "/            italic ifFalse:[
@@ -1861,11 +1891,11 @@
 "/                l := l + (f width " // 2" )
 "/            ].
 "/        ].
-        l := l + (f widthOf:string from:pos to:(pos + len - 1)).
-        pos := pos + len
+        len := len + (font widthOf:string from:pos to:(pos + runLen - 1)).
+        pos := pos + runLen
     ].
 
-    ^ l
+    ^ len
 
     "Modified: 5.7.1996 / 17:54:58 / cg"
 ! !