new:
authorStefan Vogel <sv@exept.de>
Mon, 16 Mar 2009 16:18:00 +0100
changeset 2128 f659bd2d462a
parent 2127 dc0da410f2d7
child 2129 d28f31f63e99
new: #actionForAll: - to add actionBlocks (see LinkButton) #emphasisAtPoint:on:
Text.st
--- a/Text.st	Mon Mar 16 16:15:05 2009 +0100
+++ b/Text.st	Mon Mar 16 16:18:00 2009 +0100
@@ -866,6 +866,17 @@
 
 !Text methodsFor:'emphasis'!
 
+actionForAll:aBlock
+    "change the color of all characters"
+
+    self emphasisAllAdd:(#actionBlock -> aBlock).
+
+    "
+     Transcript showCR:
+        ((Text string:'hello') actionForAll:[Transcript flash]) 
+    "
+!
+
 allBold
     "make all characters bold"
 
@@ -1278,6 +1289,30 @@
 
 !Text methodsFor:'printing & storing'!
 
+displayOn:aGCOrStream
+    "append a printed representation from which the receiver can be reconstructed
+     to aStream."
+
+    "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+    "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+    (aGCOrStream isStream or:[aGCOrStream == Transcript]) ifTrue:[
+        aGCOrStream nextPutAll:'(Text string:'.
+        string storeOn:aGCOrStream.
+        aGCOrStream nextPutAll:' runs:'.
+        runs displayOn:aGCOrStream.
+        aGCOrStream nextPutAll:')'.
+        ^ self.
+    ].
+    ^ self displayOn:aGCOrStream x:0 y:0.
+
+    "Created: 11.5.1996 / 14:27:09 / cg"
+    "Modified: 16.5.1996 / 11:23:32 / cg"
+!
+
+displayString
+    ^ String streamContents:[:s| self displayOn:s]
+!
+
 printOn:aStream
     "print the receivers characters (including emphasis) on
      aStream. 
@@ -1365,6 +1400,68 @@
 
 !Text methodsFor:'queries'!
 
+emphasisAtPoint:aPoint on:aGC
+    "return the emphasis at a given point, or nil if there is none"
+
+    |pointX savedFont boldFont italicFont bold italic wasItalic pos f l device posX|
+
+    pointX := aPoint x.
+    device := aGC graphicsDevice.
+
+    savedFont := aGC basicFont onDevice:device.
+
+    pos := 1.
+    posX := 0.
+    l := 0.
+    italic := false.
+    runs runsDo:[:len :emphasis |
+        wasItalic := italic.
+        emphasis isSymbol ifTrue:[
+            bold := (emphasis == #bold).
+            italic := (emphasis == #italic).
+        ] ifFalse:[
+            (emphasis isNil 
+            or:[emphasis isMemberOf:Association]) ifTrue:[
+                bold := italic := false
+            ] ifFalse:[
+                bold := emphasis includesIdentical:#bold.
+                italic := emphasis includesIdentical:#italic.
+            ]
+        ].
+
+        bold ifTrue:[
+            boldFont isNil ifTrue:[
+                boldFont := savedFont asBold onDevice:device
+            ].
+            f := boldFont.
+        ] ifFalse:[
+            italic ifTrue:[
+                italicFont isNil ifTrue:[
+                    italicFont := savedFont asItalic onDevice:device
+                ].
+                f := italicFont
+            ] ifFalse:[
+                f := savedFont
+            ]
+        ].
+        f := f onDevice:device.
+        wasItalic ~~ italic ifTrue:[
+            italic ifFalse:[
+                "/ going from italic to non-italic; leave some space for the shear
+                l := l + (f width " // 2" )
+            ].
+        ].
+        l := (f widthOf:string from:pos to:(pos + len - 1)).
+        (pointX between:posX and:posX + l) ifTrue:[
+            ^ emphasis
+        ].
+        pos := pos + len.
+        posX := posX + l.
+    ].
+
+    ^ nil
+!
+
 encoding
     ^ string encoding
 !
@@ -1537,7 +1634,7 @@
 !Text class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic2/Text.st,v 1.96 2009-02-11 15:25:11 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic2/Text.st,v 1.97 2009-03-16 15:18:00 stefan Exp $'
 ! !
 
 Text initialize!