Text.st
author Claus Gittinger <cg@exept.de>
Sun, 12 May 1996 17:17:22 +0200
changeset 310 2c2ce53ef527
parent 309 6458ec5cc033
child 313 46cf6fb8ed5d
permissions -rw-r--r--
strikeout

"
 COPYRIGHT (c) 1996 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"


CharacterArray subclass:#Text
	instanceVariableNames:'string runs'
	classVariableNames:''
	poolDictionaries:''
	category:'Collections-Text'
!

!Text class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1996 by Claus Gittinger
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

!

documentation
"
    Texts add emphasis information to a string.

    This class is not yet fully implemented - being constructed.

    [author:]
        Claus Gittinger

    [see also:]
        CharacterArray String RunArray
"
! !

!Text class methodsFor:'instance creation'!

fromString:aString 
    "create a Text instance, for the characters in aString,
     without emphasis."

    ^ self new string:aString emphasis:nil

    "
     Text fromString:'hello'
    "

    "Modified: 12.5.1996 / 17:05:34 / cg"
!

new:size
    "create a new empty Text instance.
     Redefined for string-protocol compatibility"

    ^ self string:(String new:size)

    "Created: 12.5.1996 / 11:57:27 / cg"
    "Modified: 12.5.1996 / 17:05:17 / cg"
!

string:aString 
    "create a Text instance, for the characters in aString,
     without emphasis."

    ^ self new string:aString emphasis:nil

    "
     Text string:'hello'
    "

    "Modified: 12.5.1996 / 17:05:00 / cg"
!

string:aString color:aColor
    "create a Text instance, for the characters in aString,
     which are colored as aColor.
     This is a shortCut for creating an emphasis of #color->aColor)"

    ^ self new string:aString emphasis:(#color->aColor)

    "
     Dialog
        information:(Text string:'hello' color:(Color red))
    "

    "Modified: 11.5.1996 / 14:21:01 / cg"
    "Created: 12.5.1996 / 17:03:20 / cg"
!

string:aString emphasis:attribute
    "create a Text instance, for the characters in aString,
     which are emphasized as described by attribute."

    ^ self new string:aString emphasis:attribute

    "
     Text string:'hello' emphasis:#bold

     Dialog
        information:(Text string:'hello' emphasis:#bold)

     Dialog
        information:(Text string:'hello' emphasis:#italic)

     Dialog
        information:(Text string:'hello' emphasis:#underline)

     Dialog
        information:(Text string:'hello' emphasis:#strikeout)
    "

    "Modified: 12.5.1996 / 17:16:03 / cg"
! !

!Text methodsFor:'comparing'!

= aStringOrText
    "compare the receiver and the argument, ignoring emphasis"

    ^ string = aStringOrText string


    "
     'hello' asText = 'hello'        
     'hello' asText = 'hello' asText 
     'hello' asText allBold = 'hello' 
    "

    "Modified: 11.5.1996 / 14:33:00 / cg"
! !

!Text methodsFor:'converting'!

asText
    ^ self

    "Created: 11.5.1996 / 14:08:36 / cg"
!

at:characterIndex
    ^ string at:characterIndex

    "Created: 11.5.1996 / 14:25:41 / cg"
!

at:characterIndex put:aCharacter
    ^ string at:characterIndex put:aCharacter

    "Created: 11.5.1996 / 14:25:49 / cg"
! !

!Text methodsFor:'copying'!

, aStringOrText
    "for now, return a string ..."

    ^ self species new
        string:(string , aStringOrText)
        runs:(runs , aStringOrText runs)

    "Created: 11.5.1996 / 13:59:54 / cg"
! !

!Text methodsFor:'displaying'!

displayOn:aGC x:x y:y
    "display the receiver on a GC"

    self displayOn:aGC x:x y:y opaque:false

    "Modified: 12.5.1996 / 11:14:57 / cg"
!

displayOn:aGC x:x y:y from:start to:stop
    "display the receiver on a GC"

    "q&d hack"

    (self copyFrom:start to:stop) displayOn:aGC x:x y:y opaque:false

    "Modified: 12.5.1996 / 12:49:33 / cg"
!

displayOn:aGC x:x0 y:y opaque:opaque
    "display the receiver on a GC"

    |savedFont font color boldFont italicFont savedPaint 
     bold italic underline strikeout 
     pos    "{ Class: SmallInteger }"
     endPos "{ Class: SmallInteger }"
     x      "{ Class: SmallInteger }"
     l      "{ Class: SmallInteger }"
     yL|

    savedFont := aGC basicFont.
    savedPaint := aGC paint.

    pos := 1.
    x := x0.
    runs runsDo:[:len :emphasis |
        color := nil.
        bold := italic := underline := strikeout := false.

        emphasis isSymbol ifTrue:[
            emphasis == #bold ifTrue:[bold := true]
            ifFalse:[emphasis == #italic ifTrue:[italic := true]
            ifFalse:[emphasis == #underline ifTrue:[underline := true]
            ifFalse:[emphasis == #strikeout ifTrue:[strikeout := true]
            ]]]
        ] ifFalse:[
            (emphasis isMemberOf:Association) ifTrue:[
                emphasis key == #color ifTrue:[
                    color := emphasis value
                ]
            ] ifFalse:[
                emphasis notNil ifTrue:[
                    emphasis do:[:entry |
                        entry == #bold ifTrue:[bold := true]
                        ifFalse:[entry == #italic ifTrue:[italic := true]
                        ifFalse:[entry == #underline ifTrue:[underline := true]
                        ifFalse:[entry == #strikeout ifTrue:[strikeout := true]
                        ifFalse:[
                            (entry isMemberOf:Association) ifTrue:[
                                entry key == #color ifTrue:[
                                    color := entry value
                            ]
                        ]]]]]
                    ]
                ]
            ]
        ].

        color isNil ifTrue:[
            color := savedPaint.
        ] ifFalse:[
            color := color on:aGC device.
        ].

        bold ifTrue:[
            boldFont isNil ifTrue:[
                boldFont := savedFont asBold on:aGC device
            ].
            font := boldFont.
        ] ifFalse:[
            italic ifTrue:[
                italicFont isNil ifTrue:[
                    italicFont := savedFont asItalic on:aGC device
                ].
                font := italicFont.
            ] ifFalse:[
                font := savedFont
            ]
        ].
        aGC basicFont:font.
        aGC paint:color.

        endPos := pos + len - 1.
        opaque ifTrue:[
            aGC displayOpaqueString:string from:pos to:endPos x:x y:y.
        ] ifFalse:[
            aGC displayString:string from:pos to:endPos x:x y:y.
        ].
        l := aGC font widthOf:string from:pos to:endPos.

        underline ifTrue:[
            yL := y+1.
            aGC displayLineFromX:x y:yL toX:x+l-1 y:yL
        ].
        strikeout ifTrue:[
            yL := y-(font ascent//2).
            aGC displayLineFromX:x y:yL toX:x+l-1 y:yL
        ].

        x := x + l.
        pos := endPos + 1
    ].

    aGC basicFont:savedFont.
    aGC paint:savedPaint.

    "Created: 12.5.1996 / 11:14:30 / cg"
    "Modified: 12.5.1996 / 17:15:23 / cg"
!

displayOpaqueOn:aGC x:x y:y
    "display the receiver on a GC"

    self displayOn:aGC x:x y:y opaque:true

    "Modified: 12.5.1996 / 11:14:52 / cg"
!

displayOpaqueOn:aGC x:x y:y from:start to:stop
    "display the receiver on a GC"

    "q&d hack"

    (self copyFrom:start to:stop) displayOn:aGC x:x y:y opaque:true

    "Created: 12.5.1996 / 12:29:37 / cg"
    "Modified: 12.5.1996 / 12:49:19 / cg"
! !

!Text methodsFor:'emphasis'!

allBold
    "make all characters bold"

    runs := RunArray new:(string size) withAll:#bold

    "
     (Text string:'hello') allBold
    "

    "Modified: 11.5.1996 / 14:22:12 / cg"
!

emphasisAt:characterIndex
    "return the emphasis at some index"

    ^ runs at:characterIndex

    "
     (Text string:'hello') allBold emphasisAt:2 
    "

    "Modified: 11.5.1996 / 14:22:31 / cg"
!

emphasisAt:characterIndex put:emphasis
    "change the emphasis at some index. return the receiver"

    runs at:characterIndex put:emphasis

    "
     (Text string:'hello') allBold emphasisAt:2 put:#italic
    "

    "Modified: 12.5.1996 / 12:40:31 / cg"
!

emphasizeAllWith:emphasis
    "change the emphasis of all characters"

    runs := RunArray new:(string size) withAll:emphasis

    "
     (Text string:'hello') allBold emphasizeAllWith:#italic 
    "

    "Modified: 11.5.1996 / 14:22:52 / cg"
!

emphasizeFrom:start to:stop with:emphasis
    "change the emphasis of a range of characters"

    |newRuns|

    newRuns := RunArray new.

    "/ for now - a q&d hack
    1 to:start-1 do:[:i |
        newRuns add:(runs at:i).
    ].
    newRuns add:emphasis withOccurrences:(stop - start + 1).
    stop+1 to:string size do:[:i |
        newRuns add:(runs at:i)
    ].
    runs := newRuns

    "
     (Text string:'hello world') 
        emphasizeFrom:1 to:5 with:#bold;
        emphasizeFrom:7 to:11 with:#italic
    "

    "Modified: 11.5.1996 / 14:30:02 / cg"
! !

!Text methodsFor:'printing & storing'!

displayString
    ^ self storeString

    "Created: 11.5.1996 / 14:24:48 / cg"
!

printOn:aStream
    string printOn:aStream

    "Created: 11.5.1996 / 14:27:25 / cg"
!

storeOn:aStream
    aStream nextPutAll:'(Text string:'.
    string storeOn:aStream.
    aStream nextPutAll:' runs:'.
    runs storeOn:aStream.
    aStream nextPutAll:')'.

    "Created: 11.5.1996 / 14:27:09 / cg"
    "Modified: 12.5.1996 / 12:45:16 / cg"
! !

!Text methodsFor:'private accessing'!

string:aString emphasis:emphasis
    string := aString.
    runs := RunArray new:string size withAll:emphasis

    "
     |t|

     t := Text new string:'hello' emphasis:#bold.
     t emphasisAt:2.
    "

    "Modified: 11.5.1996 / 14:19:38 / cg"
! !

!Text methodsFor:'queries'!

bitsPerCharacter
    ^ string bitsPerCharacter

    "Created: 12.5.1996 / 15:44:04 / cg"
!

hasChangeOfEmphasis
    ^ runs notNil

    "Created: 11.5.1996 / 14:03:19 / cg"
!

heightOn:aGC
    "return the number of device units, required on aGC's device"

    ^ aGC font heightOf:string

    "Created: 12.5.1996 / 11:02:03 / cg"
!

indexOf:aCharacter startingAt:index
    ^ string indexOf:aCharacter startingAt:index

    "Created: 11.5.1996 / 13:58:56 / cg"
!

isText
    ^ true

    "Created: 12.5.1996 / 10:56:24 / cg"
!

occurrencesOf:aCharacter
    ^ string occurrencesOf:aCharacter

    "Created: 11.5.1996 / 13:58:46 / cg"
!

size
    ^ string size

    "Created: 11.5.1996 / 14:25:15 / cg"
!

string
    ^ string

    "Created: 11.5.1996 / 13:58:38 / cg"
!

widthOn:aGC
    "return the number of device units, required on aGC's device"

    |savedFont savedPaint boldFont italicFont bold italic pos f l|

    savedFont := aGC basicFont on:aGC device.

    pos := 1.
    l := 0.
    runs runsDo:[:len :emphasis |
        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 on:aGC device
            ].
            f := boldFont.
        ] ifFalse:[
            italic ifTrue:[
                italicFont isNil ifTrue:[
                    italicFont := savedFont asItalic on:aGC device
                ].
                f := italicFont
            ] ifFalse:[
                f := savedFont
            ]
        ].
        l := l + (f widthOf:string from:pos to:(pos + len - 1)).
        pos := pos + len
    ].

    ^ l

    "Modified: 12.5.1996 / 16:07:52 / cg"
! !

!Text methodsFor:'replacing'!

replaceFrom:start to:stop with:aCollection startingAt:startIndex
    |idx|

    aCollection isString ifTrue:[
        aCollection hasChangeOfEmphasis ifTrue:[
            string replaceFrom:start to:stop with:aCollection startingAt:startIndex.
            idx := startIndex.
            start to:stop do:[:col |
                self emphasisAt:col put:(aCollection emphasisAt:idx).
                idx := idx + 1.
            ].
            ^ self.
        ]
    ].

    string replaceFrom:start to:stop with:aCollection startingAt:startIndex.
    self emphasizeFrom:start to:stop with:nil

    "
     ((Text string:'hello') allBold emphasisAt:2 put:#italic)
        copyFrom:1 to:3
    "

    "Modified: 12.5.1996 / 12:44:53 / cg"
! !

!Text class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic2/Text.st,v 1.5 1996-05-12 15:17:22 cg Exp $'
! !