'From Squeak3.2alpha of 2 October 2001 [latest update: #4613] on 17 December 2001 at 1:41:41 pm'! "Change Set: TextAndFonts-ar Date: 17 December 2001 Author: Andreas Raab Various improvements for text: * Alignment can now be set for each paragraph in a text individually (e.g., the text style does no longer dominate the alignment for the entire document). * Fonts can now be set for each character individually (e.g., the text style does no longer dominate the font for the entire document). * Morphs can be anchored either #inline (behaving like characters) or #paragraph (relative to the enclosing paragraph) or #document (relative to the enclosing document). The anchoring scheme can be set for each morph individually. Needless to say, this CS contains a bunch of major fixes and modifications to the character scanner classes - which means that some old things might be broken."! TextAttribute subclass: #TextAlignment instanceVariableNames: 'alignment ' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! !Canvas methodsFor: 'drawing' stamp: 'ar 12/15/2001 18:08'! text: s at: pt ^ self text: s bounds: (pt extent: 10000@10000) font: nil color: Color black! ! !CharacterScanner methodsFor: 'private' stamp: 'ar 12/15/2001 23:31'! setAlignment: style alignment _ style. ! ! !CharacterScanner methodsFor: 'scanning' stamp: 'ar 12/17/2001 01:50'! embeddedObject | savedIndex | savedIndex _ lastIndex. text attributesAt: lastIndex do:[:attr| attr anchoredMorph ifNotNil:[ "Following may look strange but logic gets reversed. If the morph fits on this line we're not done (return false for true) and if the morph won't fit we're done (return true for false)" (self placeEmbeddedObject: attr anchoredMorph) ifFalse:[^true]]]. lastIndex _ savedIndex + 1. "for multiple(!!) embedded morphs" ^false! ! !CharacterScanner methodsFor: 'scanning' stamp: 'ar 12/16/2001 19:27'! placeEmbeddedObject: anchoredMorph "Place the anchoredMorph or return false if it cannot be placed. In any event, advance destX by its width." | w | "Workaround: The following should really use #textAnchorType" anchoredMorph relativeTextAnchorPosition ifNotNil:[^true]. destX _ destX + (w _ anchoredMorph width). (destX > rightMargin and: [(leftMargin + w) <= rightMargin]) ifTrue: ["Won't fit, but would on next line" ^ false]. lastIndex _ lastIndex + 1. self setFont. "Force recalculation of emphasis for next run" ^ true! ! !CharacterScanner methodsFor: 'scanning' stamp: 'ar 12/15/2001 23:28'! plainTab "This is the basic method of adjusting destX for a tab." destX _ (alignment == Justified and: [self leadingTab not]) ifTrue: "embedded tabs in justified text are weird" [destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX] ifFalse: [textStyle nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin]! ! !CharacterScanner methodsFor: 'scanning' stamp: 'ar 12/17/2001 02:08'! scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta "Primitive. This is the inner loop of text display--but see scanCharactersFrom: to:rightX: which would get the string, stopConditions and displaying from the instance. March through source String from startIndex to stopIndex. If any character is flagged with a non-nil entry in stops, then return the corresponding value. Determine width of each character from xTable, indexed by map. If dextX would exceed rightX, then return stops at: 258. Advance destX by the width of the character. If stopIndex has been reached, then return stops at: 257. Optional. See Object documentation whatIsAPrimitive." | ascii nextDestX char | lastIndex _ startIndex. [lastIndex <= stopIndex] whileTrue: [char _ (sourceString at: lastIndex). ascii _ char asciiValue + 1. (stops at: ascii) == nil ifFalse: [^stops at: ascii]. "Note: The following is querying the font about the width since the primitive may have failed due to a non-trivial mapping of characters to glyphs or a non-existing xTable." nextDestX _ destX + (font widthOf: char). nextDestX > rightX ifTrue: [^stops at: CrossedX]. destX _ nextDestX + kernDelta. lastIndex _ lastIndex + 1]. lastIndex _ stopIndex. ^stops at: EndOfRun! ! !CanvasCharacterScanner methodsFor: 'scanning' stamp: 'ar 12/15/2001 23:27'! displayLine: textLine offset: offset leftInRun: leftInRun | nowLeftInRun done startLoc startIndex stopCondition | "largely copied from DisplayScanner's routine" line _ textLine. foregroundColor ifNil: [ foregroundColor _ Color black ]. leftMargin _ (line leftMarginForAlignment: alignment) + offset x. rightMargin _ line rightMargin + offset x. lineY _ line top + offset y. lastIndex _ textLine first. leftInRun <= 0 ifTrue: [self setStopConditions. "also sets the font" nowLeftInRun _ text runLengthFor: lastIndex] ifFalse: [nowLeftInRun _ leftInRun]. runX _ destX _ leftMargin. runStopIndex _ lastIndex + (nowLeftInRun - 1) min: line last. spaceCount _ 0. done _ false. [done] whileFalse: [ "remember where this portion of the line starts" startLoc _ destX@destY. startIndex _ lastIndex. "find the end of this portion of the line" stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: text string rightX: rightMargin stopConditions: stopConditions kern: kern "displaying: false". "display that portion of the line" canvas text: (text string copyFrom: startIndex to: lastIndex) bounds: (startLoc corner: 99999@99999) font: font color: foregroundColor. "handle the stop condition" done _ self perform: stopCondition ]. ^runStopIndex - lastIndex! ! !CanvasCharacterScanner methodsFor: 'stop conditions' stamp: 'ar 12/15/2001 23:27'! setStopConditions "Set the font and the stop conditions for the current run." self setFont. stopConditions at: Space asciiValue + 1 put: (alignment = Justified ifTrue: [#paddedSpace])! ! !CanvasCharacterScanner methodsFor: 'stop conditions' stamp: 'ar 12/15/2001 23:28'! tab destX _ (alignment == Justified and: [self leadingTab not]) ifTrue: "imbedded tabs in justified text are weird" [destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX] ifFalse: [textStyle nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin]. lastIndex _ lastIndex + 1. ^ false! ! !CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'ar 12/15/2001 23:28'! crossedX "Text display has wrapping. The scanner just found a character past the x location of the cursor. We know that the cursor is pointing at a character or before one." | leadingTab currentX | characterIndex == nil ifFalse: [ "If the last character of the last line is a space, and it crosses the right margin, then locating the character block after it is impossible without this hack." characterIndex > text size ifTrue: [ lastIndex _ characterIndex. characterPoint _ (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight). ^true]]. characterPoint x <= (destX + (lastCharacterExtent x // 2)) ifTrue: [lastCharacter _ (text at: lastIndex). characterPoint _ destX @ destY. ^true]. lastIndex >= line last ifTrue: [lastCharacter _ (text at: line last). characterPoint _ destX @ destY. ^true]. "Pointing past middle of a character, return the next character." lastIndex _ lastIndex + 1. lastCharacter _ text at: lastIndex. currentX _ destX + lastCharacterExtent x + kern. self lastCharacterExtentSetX: (font widthOf: lastCharacter). characterPoint _ currentX @ destY. lastCharacter = Space ifFalse: [^ true]. "Yukky if next character is space or tab." alignment = Justified ifTrue: [self lastCharacterExtentSetX: (lastCharacterExtent x + (line justifiedPadFor: (spaceCount + 1))). ^ true]. true ifTrue: [^ true]. "NOTE: I find no value to the following code, and so have defeated it - DI" "See tabForDisplay for illumination on the following awfulness." leadingTab _ true. line first to: lastIndex - 1 do: [:index | (text at: index) ~= Tab ifTrue: [leadingTab _ false]]. (alignment ~= Justified or: [leadingTab]) ifTrue: [self lastCharacterExtentSetX: (textStyle nextTabXFrom: currentX leftMargin: leftMargin rightMargin: rightMargin) - currentX] ifFalse: [self lastCharacterExtentSetX: (((currentX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount))) - currentX) max: 0)]. ^ true! ! !CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'ar 12/15/2001 23:28'! endOfRun "Before arriving at the cursor location, the selection has encountered an end of run. Answer false if the selection continues, true otherwise. Set up indexes for building the appropriate CharacterBlock." | runLength lineStop | ((characterIndex ~~ nil and: [runStopIndex < characterIndex and: [runStopIndex < text size]]) or: [characterIndex == nil and: [lastIndex < line last]]) ifTrue: ["We're really at the end of a real run." runLength _ (text runLengthFor: (lastIndex _ lastIndex + 1)). characterIndex ~~ nil ifTrue: [lineStop _ characterIndex "scanning for index"] ifFalse: [lineStop _ line last "scanning for point"]. (runStopIndex _ lastIndex + (runLength - 1)) > lineStop ifTrue: [runStopIndex _ lineStop]. self setStopConditions. ^false]. lastCharacter _ text at: lastIndex. characterPoint _ destX @ destY. ((lastCharacter = Space and: [alignment = Justified]) or: [lastCharacter = Tab and: [lastSpaceOrTabExtent notNil]]) ifTrue: [lastCharacterExtent _ lastSpaceOrTabExtent]. characterIndex ~~ nil ifTrue: ["If scanning for an index and we've stopped on that index, then we back destX off by the width of the character stopped on (it will be pointing at the right side of the character) and return" runStopIndex = characterIndex ifTrue: [self characterPointSetX: destX - lastCharacterExtent x. ^true]. "Otherwise the requested index was greater than the length of the string. Return string size + 1 as index, indicate further that off the string by setting character to nil and the extent to 0." lastIndex _ lastIndex + 1. lastCharacter _ nil. self lastCharacterExtentSetX: 0. ^true]. "Scanning for a point and either off the end of the line or off the end of the string." runStopIndex = text size ifTrue: ["off end of string" lastIndex _ lastIndex + 1. lastCharacter _ nil. self lastCharacterExtentSetX: 0. ^true]. "just off end of line without crossing x" lastIndex _ lastIndex + 1. ^true! ! !CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'ar 12/15/2001 23:28'! setStopConditions "Set the font and the stop conditions for the current run." self setFont. alignment = Justified ifTrue:[ "Make a local copy of stop conditions so we don't modify the default" stopConditions == DefaultStopConditions ifTrue:[stopConditions _ stopConditions copy]. stopConditions at: Space asciiValue + 1 put: #paddedSpace]! ! !CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'ar 12/15/2001 23:28'! tab | currentX | currentX _ (alignment == Justified and: [self leadingTab not]) ifTrue: "imbedded tabs in justified text are weird" [destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX] ifFalse: [textStyle nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin]. lastSpaceOrTabExtent _ lastCharacterExtent copy. self lastSpaceOrTabExtentSetX: (currentX - destX max: 0). currentX >= characterPoint x ifTrue: [lastCharacterExtent _ lastSpaceOrTabExtent copy. ^ self crossedX]. destX _ currentX. lastIndex _ lastIndex + 1. ^false! ! !CharacterBlockScanner methodsFor: 'private' stamp: 'ar 12/15/2001 23:30'! buildCharacterBlockIn: para | lineIndex runLength lineStop done stopCondition | "handle nullText" (para numberOfLines = 0 or: [text size = 0]) ifTrue: [^ CharacterBlock new stringIndex: 1 "like being off end of string" text: para text topLeft: (para leftMarginForDisplayForLine: 1 alignment: alignment) @ para compositionRectangle top extent: 0 @ textStyle lineGrid]. "find the line" lineIndex _ para lineIndexOfTop: characterPoint y. destY _ para topAtLineIndex: lineIndex. line _ para lines at: lineIndex. rightMargin _ para rightMarginForDisplay. (lineIndex = para numberOfLines and: [(destY + line lineHeight) < characterPoint y]) ifTrue: ["if beyond lastLine, force search to last character" self characterPointSetX: rightMargin] ifFalse: [characterPoint y < (para compositionRectangle) top ifTrue: ["force search to first line" characterPoint _ (para compositionRectangle) topLeft]. characterPoint x > rightMargin ifTrue: [self characterPointSetX: rightMargin]]. destX _ (leftMargin _ para leftMarginForDisplayForLine: lineIndex alignment: alignment). nextLeftMargin_ para leftMarginForDisplayForLine: lineIndex+1 alignment: alignment. lastIndex _ line first. self setStopConditions. "also sets font" runLength _ (text runLengthFor: line first). characterIndex == nil ifTrue: [lineStop _ line last "characterBlockAtPoint"] ifFalse: [lineStop _ characterIndex "characterBlockForIndex"]. (runStopIndex _ lastIndex + (runLength - 1)) > lineStop ifTrue: [runStopIndex _ lineStop]. lastCharacterExtent _ 0 @ line lineHeight. spaceCount _ 0. done _ false. self handleIndentation. [done] whileFalse: [stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: text string rightX: characterPoint x stopConditions: stopConditions kern: kern. "see setStopConditions for stopping conditions for character block operations." self lastCharacterExtentSetX: (font widthOf: (text at: lastIndex)). (self perform: stopCondition) ifTrue: [characterIndex == nil ifTrue: ["characterBlockAtPoint" ^ CharacterBlock new stringIndex: lastIndex text: text topLeft: characterPoint + (font descentKern @ 0) extent: lastCharacterExtent] ifFalse: ["characterBlockForIndex" ^ CharacterBlock new stringIndex: lastIndex text: text topLeft: characterPoint + ((font descentKern) - kern @ 0) extent: lastCharacterExtent]]]! ! !CharacterBlockScanner methodsFor: 'scanning' stamp: 'ar 12/16/2001 18:14'! characterBlockAtPoint: aPoint index: index in: textLine "This method is the Morphic characterBlock finder. It combines MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:" | runLength lineStop done stopCondition | line _ textLine. rightMargin _ line rightMargin. lastIndex _ line first. self setStopConditions. "also sets font" characterIndex _ index. " == nil means scanning for point" characterPoint _ aPoint. (characterPoint == nil or: [characterPoint y > line bottom]) ifTrue: [characterPoint _ line bottomRight]. (text isEmpty or: [(characterPoint y < line top or: [characterPoint x < line left]) or: [characterIndex ~~ nil and: [characterIndex < line first]]]) ifTrue: [^ (CharacterBlock new stringIndex: line first text: text topLeft: line leftMargin@line top extent: 0 @ textStyle lineGrid) textLine: line]. destX _ leftMargin _ line leftMarginForAlignment: alignment. destY _ line top. runLength _ text runLengthFor: line first. characterIndex ~~ nil ifTrue: [lineStop _ characterIndex "scanning for index"] ifFalse: [lineStop _ line last "scanning for point"]. runStopIndex _ lastIndex + (runLength - 1) min: lineStop. lastCharacterExtent _ 0 @ line lineHeight. spaceCount _ 0. done _ false. [done] whileFalse: [stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: text string rightX: characterPoint x stopConditions: stopConditions kern: kern. "see setStopConditions for stopping conditions for character block operations." self lastCharacterExtentSetX: (specialWidth == nil ifTrue: [font widthOf: (text at: lastIndex)] ifFalse: [specialWidth]). (self perform: stopCondition) ifTrue: [characterIndex == nil ifTrue: ["Result for characterBlockAtPoint: " ^ (CharacterBlock new stringIndex: lastIndex text: text topLeft: characterPoint + (font descentKern @ 0) extent: lastCharacterExtent - (font baseKern @ 0)) textLine: line] ifFalse: ["Result for characterBlockForIndex: " ^ (CharacterBlock new stringIndex: characterIndex text: text topLeft: characterPoint + ((font descentKern) - kern @ 0) extent: lastCharacterExtent) textLine: line]]]! ! !CharacterBlockScanner methodsFor: 'scanning' stamp: 'ar 12/16/2001 19:27'! placeEmbeddedObject: anchoredMorph "Workaround: The following should really use #textAnchorType" anchoredMorph relativeTextAnchorPosition ifNotNil:[^true]. (super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false]. specialWidth _ anchoredMorph width. ^ true! ! !CharacterScanner class methodsFor: 'class initialization' stamp: 'ar 12/17/2001 02:17'! initialize "CharacterScanner initialize" "NewCharacterScanner initialize" | stopConditions | stopConditions _ Array new: 258. stopConditions atAllPut: nil. stopConditions at: 1+1 put: #embeddedObject. stopConditions at: Space asciiValue + 1 put: nil. stopConditions at: Tab asciiValue + 1 put: #tab. stopConditions at: CR asciiValue + 1 put: #cr. stopConditions at: EndOfRun put: #endOfRun. stopConditions at: CrossedX put: #crossedX. DefaultStopConditions _ stopConditions.! ! !CompositionScanner methodsFor: 'scanning' stamp: 'ar 12/17/2001 02:06'! composeFrom: startIndex inRectangle: lineRectangle firstLine: firstLine leftSide: leftSide rightSide: rightSide "Answer an instance of TextLineInterval that represents the next line in the paragraph." | runLength done stopCondition | "Set up margins" leftMargin _ lineRectangle left. leftSide ifTrue: [leftMargin _ leftMargin + (firstLine ifTrue: [textStyle firstIndent] ifFalse: [textStyle restIndent])]. destX _ spaceX _ leftMargin. rightMargin _ lineRectangle right. rightSide ifTrue: [rightMargin _ rightMargin - textStyle rightIndent]. lastIndex _ startIndex. "scanning sets last index" destY _ lineRectangle top. lineHeight _ baseline _ 0. "Will be increased by setFont" self setStopConditions. "also sets font" runLength _ text runLengthFor: startIndex. runStopIndex _ (lastIndex _ startIndex) + (runLength - 1). line _ (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0) rectangle: lineRectangle. spaceCount _ 0. self handleIndentation. leftMargin _ destX. line leftMargin: leftMargin. done _ false. [done] whileFalse: [stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: text string rightX: rightMargin stopConditions: stopConditions kern: kern. "See setStopConditions for stopping conditions for composing." (self perform: stopCondition) ifTrue: [^ line lineHeight: lineHeight + textStyle leading baseline: baseline + textStyle leading]]! ! !CompositionScanner methodsFor: 'stop conditions' stamp: 'ar 12/17/2001 02:13'! placeEmbeddedObject: anchoredMorph | descent | "Workaround: The following should really use #textAnchorType" anchoredMorph relativeTextAnchorPosition ifNotNil:[^true]. (super placeEmbeddedObject: anchoredMorph) ifFalse: ["It doesn't fit" "But if it's the first character then leave it here" lastIndex < line first ifFalse:[ line stop: lastIndex-1. ^ false]]. descent _ lineHeight - baseline. lineHeight _ lineHeight max: anchoredMorph height. baseline _ lineHeight - descent. line stop: lastIndex. ^ true! ! !DisplayScanner methodsFor: 'scanning' stamp: 'ar 12/16/2001 18:13'! displayLine: textLine offset: offset leftInRun: leftInRun "The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated). leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions." | done stopCondition nowLeftInRun startIndex string lastPos | line _ textLine. morphicOffset _ offset. lineY _ line top + offset y. lineHeight _ line lineHeight. rightMargin _ line rightMargin + offset x. lastIndex _ line first. leftInRun <= 0 ifTrue: [self setStopConditions]. leftMargin _ (line leftMarginForAlignment: alignment) + offset x. destX _ runX _ leftMargin. fillBlt == nil ifFalse: ["Not right" fillBlt destX: line left destY: lineY width: line width left height: lineHeight; copyBits]. lastIndex _ line first. leftInRun <= 0 ifTrue: [nowLeftInRun _ text runLengthFor: lastIndex] ifFalse: [nowLeftInRun _ leftInRun]. destY _ lineY + line baseline - font ascent. runStopIndex _ lastIndex + (nowLeftInRun - 1) min: line last. spaceCount _ 0. done _ false. string _ text string. [done] whileFalse:[ startIndex _ lastIndex. lastPos _ destX@destY. stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: string rightX: rightMargin stopConditions: stopConditions kern: kern. lastIndex >= startIndex ifTrue:[ font displayString: string on: bitBlt from: startIndex to: lastIndex at: lastPos kern: kern]. "see setStopConditions for stopping conditions for displaying." done _ self perform: stopCondition]. ^ runStopIndex - lastIndex "Number of characters remaining in the current run"! ! !DisplayScanner methodsFor: 'scanning' stamp: 'ar 12/15/2001 23:30'! displayLines: linesInterval in: aParagraph clippedBy: visibleRectangle "The central display routine. The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated)." | runLength done stopCondition leftInRun startIndex string lastPos | "leftInRun is the # of characters left to scan in the current run; when 0, it is time to call 'self setStopConditions'" leftInRun _ 0. self initializeFromParagraph: aParagraph clippedBy: visibleRectangle. ignoreColorChanges _ false. paragraph _ aParagraph. foregroundColor _ paragraphColor _ aParagraph foregroundColor. backgroundColor _ aParagraph backgroundColor. aParagraph backgroundColor isTransparent ifTrue: [fillBlt _ nil] ifFalse: [fillBlt _ bitBlt copy. "Blt to fill spaces, tabs, margins" fillBlt sourceForm: nil; sourceOrigin: 0@0. fillBlt fillColor: aParagraph backgroundColor]. rightMargin _ aParagraph rightMarginForDisplay. lineY _ aParagraph topAtLineIndex: linesInterval first. bitBlt destForm deferUpdatesIn: visibleRectangle while: [ linesInterval do: [:lineIndex | leftMargin _ aParagraph leftMarginForDisplayForLine: lineIndex alignment: alignment. destX _ (runX _ leftMargin). line _ aParagraph lines at: lineIndex. lineHeight _ line lineHeight. fillBlt == nil ifFalse: [fillBlt destX: visibleRectangle left destY: lineY width: visibleRectangle width height: lineHeight; copyBits]. lastIndex _ line first. leftInRun <= 0 ifTrue: [self setStopConditions. "also sets the font" leftInRun _ text runLengthFor: line first]. destY _ lineY + line baseline - font ascent. "Should have happened in setFont" runLength _ leftInRun. runStopIndex _ lastIndex + (runLength - 1) min: line last. leftInRun _ leftInRun - (runStopIndex - lastIndex + 1). spaceCount _ 0. done _ false. string _ text string. self handleIndentation. [done] whileFalse:[ startIndex _ lastIndex. lastPos _ destX@destY. stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex in: string rightX: rightMargin stopConditions: stopConditions kern: kern. lastIndex >= startIndex ifTrue:[ font displayString: string on: bitBlt from: startIndex to: lastIndex at: lastPos kern: kern]. "see setStopConditions for stopping conditions for displaying." done _ self perform: stopCondition]. fillBlt == nil ifFalse: [fillBlt destX: destX destY: lineY width: visibleRectangle right-destX height: lineHeight; copyBits]. lineY _ lineY + lineHeight]]! ! !DisplayScanner methodsFor: 'scanning' stamp: 'ar 12/17/2001 13:28'! placeEmbeddedObject: anchoredMorph anchoredMorph relativeTextAnchorPosition ifNotNil:[ anchoredMorph position: anchoredMorph relativeTextAnchorPosition + (anchoredMorph owner textBounds origin x @ 0) - (0@morphicOffset y) + (0@lineY). ^true ]. (super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false]. anchoredMorph isMorph ifTrue: [ anchoredMorph position: ((destX - anchoredMorph width)@lineY) - morphicOffset ] ifFalse: [ destY _ lineY. runX _ destX. anchoredMorph displayOn: bitBlt destForm at: destX - anchoredMorph width @ destY clippingBox: bitBlt clipRect ]. ^ true! ! !DisplayScanner methodsFor: 'stop conditions' stamp: 'ar 12/15/2001 23:28'! setStopConditions "Set the font and the stop conditions for the current run." self setFont. alignment = Justified ifTrue:[ "Make a local copy of stop conditions so we don't modify the default" stopConditions == DefaultStopConditions ifTrue:[stopConditions _ stopConditions copy]. stopConditions at: Space asciiValue + 1 put: #paddedSpace]! ! !HtmlFormatter methodsFor: 'formatting commands' stamp: 'ar 12/17/2001 02:18'! addMorph: aMorph "add a morph to the output" | savedAttributes | self addChar: Character space. savedAttributes _ outputStream currentAttributes. outputStream currentAttributes: (savedAttributes copyWith: (TextAnchor new anchoredMorph: aMorph)). self addChar: (Character value: 1). outputStream currentAttributes: savedAttributes. self addChar: Character space. morphsToEmbed add: aMorph.! ! !Morph methodsFor: 'classification' stamp: 'ar 12/16/2001 18:28'! isTextMorph ^false! ! !Morph methodsFor: 'submorphs-add/remove' stamp: 'ar 12/16/2001 21:08'! addMorphFrontFromWorldPosition: aMorph ^self addMorphFront: aMorph fromWorldPosition: aMorph positionInWorld.! ! !Morph methodsFor: 'menus' stamp: 'ar 12/16/2001 21:06'! addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu" | unlockables | self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph]. self mustBeBackmost ifFalse: [aMenu add: 'send to back' action: #goBehind. aMenu add: 'bring to front' action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine]. self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addPlayerItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addStackItemsTo: aMenu. self adMiscExtrasTo: aMenu. Preferences noviceMode ifFalse: [self addDebuggingItemsTo: aMenu hand: aHandMorph]. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables _ self submorphs select: [:m | m isLocked]. unlockables size == 1 ifTrue: [aMenu add: 'unlock "', unlockables first externalName, '"' action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' action: #unlockContents. aMenu add: 'unlock...' action: #unlockOneSubpart]. aMenu defaultTarget: aHandMorph. ! ! !Morph methodsFor: 'private' stamp: 'ar 12/16/2001 21:47'! privateFullMoveBy: delta "Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method." self privateMoveBy: delta. 1 to: submorphs size do: [:i | (submorphs at: i) privateFullMoveBy: delta]. owner ifNotNil:[ owner isTextMorph ifTrue:[owner adjustTextAnchor: self]].! ! !Morph methodsFor: 'meta-actions' stamp: 'ar 12/16/2001 21:07'! addEmbeddingMenuItemsTo: aMenu hand: aHandMorph | menu | menu _ MenuMorph new defaultTarget: self. self potentialEmbeddingTargets reverseDo: [:m | menu add: (m knownName ifNil:[m class name asString]) target: m selector: #addMorphFrontFromWorldPosition: argumentList: {self}]. aMenu ifNotNil:[ menu submorphCount > 0 ifTrue:[aMenu add:'embed into' subMenu: menu]. ]. ^menu! ! !Morph methodsFor: 'meta-actions' stamp: 'ar 12/16/2001 21:06'! buildMetaMenu: evt "Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph." | menu | menu _ MenuMorph new defaultTarget: self. menu addStayUpItem. menu add: 'grab' action: #grabMorph:. menu add: 'copy to paste buffer' action: #copyToPasteBuffer:. self maybeAddCollapseItemTo: menu. menu add: 'delete' action: #dismissMorph:. menu addLine. menu add: 'copy Postscript' action: #clipPostscript. menu add: 'print PS to file...' action: #printPSToFile. menu addLine. menu add: 'go behind' action: #goBehind. menu add: 'add halo' action: #addHalo:. menu add: 'duplicate' action: #maybeDuplicateMorph:. self addEmbeddingMenuItemsTo: menu hand: evt hand. menu add: 'resize' action: #resizeMorph:. "Give the argument control over what should be done about fill styles" self addFillStyleMenuItems: menu hand: evt hand. self addDropShadowMenuItems: menu hand: evt hand. self addLayoutMenuItems: menu hand: evt hand. menu addUpdating: #hasClipSubmorphsString target: self selector: #changeClipSubmorphs argumentList: #(). menu addLine. (self morphsAt: evt position) size > 1 ifTrue: [menu add: 'submorphs...' target: self selector: #invokeMetaMenuAt:event: argument: evt position]. menu addLine. menu add: 'inspect' selector: #inspectAt:event: argument: evt position. menu add: 'explore' action: #explore. menu add: 'browse hierarchy' action: #browseHierarchy. menu add: 'make own subclass' action: #subclassMorph. menu addLine. menu add: 'set variable name...' action: #choosePartName. (self isMorphicModel) ifTrue: [menu add: 'save morph as prototype' action: #saveAsPrototype. (self ~~ self world modelOrNil) ifTrue: [menu add: 'become this world''s model' action: #beThisWorldsModel]]. menu add: 'save morph in file' action: #saveOnFile. (self hasProperty: #resourceFilePath) ifTrue: [((self valueOfProperty: #resourceFilePath) endsWith: '.morph') ifTrue: [menu add: 'save as resource' action: #saveAsResource]. menu add: 'update from resource' action: #updateFromResource] ifFalse: [menu add: 'attach to resource' action: #attachToResource]. menu add: 'show actions' action: #showActions. menu addLine. self addDebuggingItemsTo: menu hand: evt hand. self addCustomMenuItems: menu hand: evt hand. ^ menu ! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/17/2001 12:45'! addTextAnchorMenuItems: topMenu hand: aHand | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addUpdating: #hasInlineAnchorString action: #changeInlineAnchor. aMenu addUpdating: #hasParagraphAnchorString action: #changeParagraphAnchor. aMenu addUpdating: #hasDocumentAnchorString action: #changeDocumentAnchor. topMenu ifNotNil:[topMenu add: 'text anchor' subMenu: aMenu]. ^aMenu! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 19:06'! changeDocumentAnchor "Change the anchor from/to document anchoring" | newType | self textAnchorType == #document ifTrue:[newType _ #paragraph] ifFalse:[newType _ #document]. owner isTextMorph ifTrue:[owner anchorMorph: self at: self position type: newType]. ! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/17/2001 12:45'! changeInlineAnchor "Change the anchor from/to line anchoring" | newType | self textAnchorType == #inline ifTrue:[newType _ #paragraph] ifFalse:[newType _ #inline]. owner isTextMorph ifTrue:[owner anchorMorph: self at: self position type: newType]. ! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 19:28'! changeParagraphAnchor "Change the anchor from/to paragraph anchoring" | newType | self textAnchorType == #paragraph ifTrue:[newType _ #document] ifFalse:[newType _ #paragraph]. owner isTextMorph ifTrue:[owner anchorMorph: self at: self position type: newType]. ! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 18:35'! hasDocumentAnchorString ^(self textAnchorType == #document ifTrue:[''] ifFalse:['']), 'Document'.! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/17/2001 12:45'! hasInlineAnchorString ^(self textAnchorType == #inline ifTrue:[''] ifFalse:['']), 'Inline'.! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 18:35'! hasParagraphAnchorString ^(self textAnchorType == #paragraph ifTrue:[''] ifFalse:['']), 'Paragraph'.! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 19:47'! relativeTextAnchorPosition ^self valueOfProperty: #relativeTextAnchorPosition! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 19:22'! relativeTextAnchorPosition: aPoint ^self setProperty: #relativeTextAnchorPosition toValue: aPoint! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 18:36'! textAnchorType ^self valueOfProperty: #textAnchorType ifAbsent:[#document]! ! !Morph methodsFor: 'text-anchor' stamp: 'ar 12/16/2001 18:37'! textAnchorType: aSymbol aSymbol == #document ifTrue:[^self removeProperty: #textAnchorType] ifFalse:[^self setProperty: #textAnchorType toValue: aSymbol].! ! !EToyChatMorph methodsFor: 'as yet unclassified' stamp: 'ar 12/17/2001 02:18'! chatFrom: ipAddress name: senderName text: text | initialText attrib | recipientForm ifNil: [ initialText _ senderName asText allBold. ] ifNotNil: [ attrib _ TextAnchor new anchoredMorph: recipientForm "asMorph". initialText _ (String value: 1) asText. initialText addAttribute: attrib from: 1 to: 1. ]. self appendMessage: initialText,' - ',text,String cr. EToyCommunicatorMorph playArrivalSound. ! ! !EToyChatMorph methodsFor: 'as yet unclassified' stamp: 'ar 12/17/2001 02:18'! startOfMessageFromMe myForm ifNil: [ myForm _ EToySenderMorph pictureForIPAddress: NetNameResolver localAddressString. myForm ifNotNil: [ myForm _ myForm scaledToSize: 20@20 ]. ]. myForm ifNil: [ ^(Preferences defaultAuthorName asText allBold addAttribute: TextColor blue) ]. ^(String value: 1) asText addAttribute: (TextAnchor new anchoredMorph: myForm); yourself ! ! !MenuMorph methodsFor: 'construction' stamp: 'ar 12/16/2001 16:53'! add: aString subMenu: aMenuMorph target: target selector: aSymbol argumentList: argList "Append the given submenu with the given label." | item | item _ MenuItemMorph new. item contents: aString; target: target; selector: aSymbol; arguments: argList asArray; subMenu: aMenuMorph. self addMorphBack: item. ^item! ! !NewParagraph methodsFor: 'selection' stamp: 'ar 12/17/2001 01:51'! characterBlockAtPoint: aPoint "Answer a CharacterBlock for the character in the text at aPoint." | line | line _ lines at: (self lineIndexForPoint: aPoint). ^ (CharacterBlockScanner new text: text textStyle: textStyle) characterBlockAtPoint: aPoint index: nil in: line! ! !NewParagraph methodsFor: 'display' stamp: 'ar 12/17/2001 01:52'! displayOn: aCanvas using: displayScanner at: somePosition "Send all visible lines to the displayScanner for display" | visibleRectangle offset leftInRun line | visibleRectangle _ aCanvas clipRect. offset _ somePosition - positionWhenComposed. leftInRun _ 0. (self lineIndexForPoint: visibleRectangle topLeft) to: (self lineIndexForPoint: visibleRectangle bottomRight) do: [:i | line _ lines at: i. self displaySelectionInLine: line on: aCanvas. line first <= line last ifTrue: [leftInRun _ displayScanner displayLine: line offset: offset leftInRun: leftInRun]]. ! ! !Paragraph methodsFor: 'private' stamp: 'ar 12/15/2001 23:29'! leftMarginForDisplayForLine: lineIndex alignment: alignment "Build the left margin for display of a line. Depends upon leftMarginForComposition, compositionRectangle left and the alignment." | pad | (alignment = LeftFlush or: [alignment = Justified]) ifTrue: [^compositionRectangle left + (self leftMarginForCompositionForLine: lineIndex)]. "When called from character location code and entire string has been cut, there are no valid lines, hence following nil check." (lineIndex <= lines size and: [(lines at: lineIndex) notNil]) ifTrue: [pad _ (lines at: lineIndex) paddingWidth] ifFalse: [pad _ compositionRectangle width - textStyle firstIndent - textStyle rightIndent]. alignment = Centered ifTrue: [^compositionRectangle left + (self leftMarginForCompositionForLine: lineIndex) + (pad // 2)]. alignment = RightFlush ifTrue: [^compositionRectangle left + (self leftMarginForCompositionForLine: lineIndex) + pad]. self error: ['no such alignment']! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'ar 12/17/2001 12:54'! changeAlignment | aList reply | aList _ #(leftFlush centered justified rightFlush). reply _ (SelectionMenu labelList: aList selections: aList) startUp. reply ifNil:[^self]. self setAlignment: reply. paragraph composeAll. self recomputeSelection. self mvcRedisplay. ^ true! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'ar 12/17/2001 12:55'! setAlignment: aSymbol | attr string left right | attr _ TextAlignment perform: aSymbol. string _ paragraph text string. left _ string lastIndexOf: Character cr startingAt: startBlock stringIndex-1 ifAbsent:[1]. right _ string indexOf: Character cr startingAt: stopBlock stringIndex ifAbsent:[string size]. paragraph replaceFrom: left to: right with: ((paragraph text copyFrom: left to: right) addAttribute: attr) displaying: true. ! ! !PluggableTextMorph methodsFor: 'menu commands' stamp: 'ar 12/17/2001 13:00'! offerFontMenu self handleEdit: [textMorph editor changeTextFont]! ! !Scamper methodsFor: 'document handling' stamp: 'ar 12/17/2001 02:18'! displayFlashPage: newSource "A shockwave flash document -- embed it in a text" | attrib stream player | stream _ (RWBinaryOrTextStream with: newSource content) binary reset. (FlashFileReader canRead: stream) ifFalse:[^false]. "Not a flash file" player _ (FlashMorphReader on: stream) processFileAsync. player sourceUrl: newSource url. player startPlaying. attrib _ TextAnchor new anchoredMorph: player. formattedPage _ (Character value: 1) asText. backgroundColor _ self defaultBackgroundColor. formattedPage addAttribute: attrib from: 2 to: 2. currentUrl _ newSource url. pageSource _ newSource content. "remove it from the history--these thigns are too big!!" "ideally, there would be a smarter history mechanism that can do things like remove items when memory consumption gets too high...." " recentDocuments removeLast." self changeAll: #(currentUrl relabel hasLint lint backgroundColor formattedPage formattedPageSelection). self status: 'sittin'. ^true! ! !Scamper methodsFor: 'document handling' stamp: 'ar 12/17/2001 02:18'! displayImagePage: newSource "an image--embed it in a text" | image imageMorph attrib text handled | handled _ true. backgroundColor _ self defaultBackgroundColor. formattedPage _ [ image _ ImageReadWriter formFromStream: (RWBinaryOrTextStream with: newSource content) binary reset. imageMorph _ ImageMorph new image: image. attrib _ TextAnchor new anchoredMorph: imageMorph. text _ (Character value: 1) asText. text addAttribute: attrib from: 2 to: 2. text] ifError: [ :msg :ctx | handled _ false ]. currentUrl _ newSource url. pageSource _ newSource content. "remove it from the history--these thigns are too big!!" "ideally, there would be a smarter history mechanism that can do things like remove items when memory consumption gets too high...." " recentDocuments removeLast." self changeAll: #(currentUrl relabel hasLint lint backgroundColor formattedPage formattedPageSelection). self status: 'sittin'. ^handled! ! !SequenceableCollection methodsFor: 'accessing' stamp: 'ar 12/16/2001 01:06'! lastIndexOf: anElement "Answer the index of the last occurence of anElement within the receiver. If the receiver does not contain anElement, answer 0." ^ self lastIndexOf: anElement startingAt: self size ifAbsent: [0]! ! !SequenceableCollection methodsFor: 'accessing' stamp: 'ar 12/16/2001 01:06'! lastIndexOf: anElement ifAbsent: exceptionBlock "Answer the index of the last occurence of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." ^self lastIndexOf: anElement startingAt: self size ifAbsent: exceptionBlock! ! !SequenceableCollection methodsFor: 'accessing' stamp: 'ar 12/16/2001 01:05'! lastIndexOf: anElement startingAt: lastIndex ifAbsent: exceptionBlock "Answer the index of the last occurence of anElement within the receiver. If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." lastIndex to: 1 by: -1 do: [:index | (self at: index) = anElement ifTrue: [^ index]]. ^ exceptionBlock value! ! !RunArray methodsFor: 'enumerating' stamp: 'ar 12/17/2001 00:00'! runsFrom: start to: stop do: aBlock "Evaluate aBlock with all existing runs in the range from start to stop" | run value index | start > stop ifTrue:[^self]. self at: start setRunOffsetAndValue:[:firstRun :offset :firstValue| run _ firstRun. value _ firstValue. index _ start + (runs at: run) - offset. [aBlock value: value. index <= stop] whileTrue:[ run _ run + 1. value _ values at: run. index _ index + (runs at: run)]]. ! ! !RunArray class methodsFor: 'instance creation' stamp: 'ar 12/16/2001 01:55'! scanFrom: strm "Read the style section of a fileOut or sources file. nextChunk has already been done. We need to return a RunArray of TextAttributes of various kinds." | rr vv aa this | (strm peekFor: $( ) ifFalse: [^ nil]. rr _ OrderedCollection new. [strm skipSeparators. strm peekFor: $)] whileFalse: [rr add: (Number readFrom: strm)]. vv _ OrderedCollection new. "Value array" aa _ OrderedCollection new. "Attributes list" [(this _ strm next) == nil] whileFalse: [ this == $, ifTrue: [vv add: aa asArray. aa _ OrderedCollection new]. this == $a ifTrue: [aa add: (TextAlignment new alignment: (Number readFrom: strm))]. this == $f ifTrue: [aa add: (TextFontChange new fontNumber: (Number readFrom: strm))]. this == $b ifTrue: [aa add: (TextEmphasis bold)]. this == $i ifTrue: [aa add: (TextEmphasis italic)]. this == $u ifTrue: [aa add: (TextEmphasis underlined)]. this == $= ifTrue: [aa add: (TextEmphasis struckOut)]. this == $n ifTrue: [aa add: (TextEmphasis normal)]. this == $- ifTrue: [aa add: (TextKern kern: -1)]. this == $+ ifTrue: [aa add: (TextKern kern: 1)]. this == $c ifTrue: [aa add: (TextColor scanFrom: strm)]. "color" this == $L ifTrue: [aa add: (TextLink scanFrom: strm)]. "L not look like 1" this == $R ifTrue: [aa add: (TextURL scanFrom: strm)]. "R capitalized so it can follow a number" this == $q ifTrue: [aa add: (TextSqkPageLink scanFrom: strm)]. this == $p ifTrue: [aa add: (TextSqkProjectLink scanFrom: strm)]. this == $P ifTrue: [aa add: (TextPrintIt scanFrom: strm)]. this == $d ifTrue: [aa add: (TextDoIt scanFrom: strm)]. "space, cr do nothing" ]. aa size > 0 ifTrue: [vv add: aa asArray]. ^ self runs: rr asArray values: vv asArray " RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i') "! ! !String class methodsFor: 'instance creation' stamp: 'ar 12/17/2001 01:24'! value: anInteger ^self with: (Character value: anInteger)! ! !Text methodsFor: 'accessing' stamp: 'ar 12/16/2001 23:31'! embeddedMorphs "return the list of morphs embedded in me" | morphs | morphs _ IdentitySet new. runs withStartStopAndValueDo: [ :start :stop :attribs | attribs do: [ :attrib | attrib anchoredMorph ifNotNil:[morphs add: attrib anchoredMorph]]]. ^morphs select: [ :m | m isKindOf: Morph ]! ! !Text methodsFor: 'accessing' stamp: 'ar 12/16/2001 23:33'! embeddedMorphsFrom: start to: stop "return the list of morphs embedded in me" | morphs | morphs _ IdentitySet new. runs runsFrom: start to: stop do:[:attribs| attribs do:[:attr| attr anchoredMorph ifNotNil:[morphs add: attr anchoredMorph]]]. ^morphs select: [ :m | m isKindOf: Morph ]! ! !Text methodsFor: 'converting' stamp: 'ar 12/17/2001 00:38'! removeAttributesThat: removalBlock replaceAttributesThat: replaceBlock by: convertBlock "Enumerate all attributes in the receiver. Remove those passing removalBlock and replace those passing replaceBlock after converting it through convertBlock" | added removed new | "Deliberately optimized for the no-op default." added _ removed _ nil. runs withStartStopAndValueDo: [ :start :stop :attribs | attribs do: [ :attrib | (removalBlock value: attrib) ifTrue:[ removed ifNil:[removed _ WriteStream on: #()]. removed nextPut: {start. stop. attrib}. ] ifFalse:[ (replaceBlock value: attrib) ifTrue:[ removed ifNil:[removed _ WriteStream on: #()]. removed nextPut: {start. stop. attrib}. new _ convertBlock value: attrib. added ifNil:[added _ WriteStream on: #()]. added nextPut: {start. stop. new}. ]. ]. ]. ]. (added == nil and:[removed == nil]) ifTrue:[^self]. "otherwise do the real work" removed ifNotNil:[removed contents do:[:spec| self removeAttribute: spec last from: spec first to: spec second]]. added ifNotNil:[added contents do:[:spec| self addAttribute: spec last from: spec first to: spec second]].! ! !Text methodsFor: 'emphasis' stamp: 'ar 12/17/2001 01:17'! attributesAt: characterIndex do: aBlock "Answer the code for characters in the run beginning at characterIndex." "NB: no senders any more (supplanted by #attributesAt:forStyle: but retained for the moment in order not to break user code that may exist somewhere that still calls this" self size = 0 ifTrue:[^self]. (runs at: characterIndex) do: aBlock! ! !TextAttribute methodsFor: 'as yet unclassified' stamp: 'ar 12/16/2001 23:18'! anchoredMorph "If one hides here, return it" ^nil! ! !TextAlignment methodsFor: 'as yet unclassified' stamp: 'ar 12/15/2001 23:33'! = other ^ (other class == self class) and: [other alignment = alignment]! ! !TextAlignment methodsFor: 'as yet unclassified' stamp: 'ar 12/15/2001 23:33'! alignment ^alignment! ! !TextAlignment methodsFor: 'as yet unclassified' stamp: 'ar 12/15/2001 23:33'! alignment: aNumber alignment _ aNumber.! ! !TextAlignment methodsFor: 'as yet unclassified' stamp: 'ar 12/16/2001 00:20'! dominates: other "There can be only one..." ^self class == other class! ! !TextAlignment methodsFor: 'as yet unclassified' stamp: 'ar 12/15/2001 23:34'! emphasizeScanner: scanner "Set the emphasist for text scanning" scanner setAlignment: alignment.! ! !TextAlignment methodsFor: 'as yet unclassified' stamp: 'ar 12/16/2001 01:55'! writeScanOn: strm strm nextPut: $a. alignment printOn: strm.! ! !TextAlignment class methodsFor: 'instance creation' stamp: 'ar 12/15/2001 23:36'! centered ^self new alignment: 2! ! !TextAlignment class methodsFor: 'instance creation' stamp: 'ar 12/15/2001 23:36'! justified ^self new alignment: 3! ! !TextAlignment class methodsFor: 'instance creation' stamp: 'ar 12/15/2001 23:35'! leftFlush ^self new alignment: 0! ! !TextAlignment class methodsFor: 'instance creation' stamp: 'ar 12/15/2001 23:35'! rightFlush ^self new alignment: 1! ! !TextAnchor methodsFor: 'as yet unclassified' stamp: 'ar 12/17/2001 01:19'! emphasizeScanner: scanner "Do nothing for emphasizing the scanner - if the anchor is valid a #embeddedObject will be encountered by the scanner and do the real thing"! ! !TextComposer methodsFor: 'as yet unclassified' stamp: 'ar 12/17/2001 01:59'! composeEachRectangleIn: rectangles | myLine lastChar | 1 to: rectangles size do: [:i | currCharIndex <= theText size ifFalse: [^false]. myLine _ scanner composeFrom: currCharIndex inRectangle: (rectangles at: i) firstLine: isFirstLine leftSide: i=1 rightSide: i=rectangles size. lines addLast: myLine. actualHeight _ actualHeight max: myLine lineHeight. "includes font changes" currCharIndex _ myLine last + 1. lastChar _ theText at: myLine last. lastChar = Character cr ifTrue: [^#cr]. wantsColumnBreaks ifTrue: [ lastChar = TextComposer characterForColumnBreak ifTrue: [^#columnBreak]. ]. ]. ^false! ! !TextMorph methodsFor: 'accessing' stamp: 'ar 12/17/2001 12:46'! isTextMorph ^true! ! !TextMorph methodsFor: 'editing' stamp: 'ar 12/17/2001 13:09'! chooseFont self editor changeTextFont. self updateFromParagraph.! ! !TextMorph methodsFor: 'editing' stamp: 'ar 12/17/2001 13:09'! chooseStyle self editor changeTextFont. self updateFromParagraph.! ! !TextMorph methodsFor: 'anchors' stamp: 'ar 12/17/2001 13:21'! addMorphFront: aMorph fromWorldPosition: wp "Overridden for more specific re-layout and positioning" aMorph textAnchorType == #document ifFalse:[^self anchorMorph: aMorph at: wp type: aMorph textAnchorType]. self addMorphFront: aMorph. ! ! !TextMorph methodsFor: 'anchors' stamp: 'ar 12/17/2001 13:38'! adjustTextAnchor: aMorph "Later compute the new relative position of aMorph if it is #paragraph anchored."! ! !TextMorph methodsFor: 'anchors' stamp: 'ar 12/17/2001 13:40'! anchorMorph: aMorph at: aPoint type: anchorType | relPt index newText block | aMorph owner == self ifTrue:[self privateRemoveMorph: aMorph]. aMorph textAnchorType: nil. aMorph relativeTextAnchorPosition: nil. self addMorphFront: aMorph. aMorph textAnchorType: anchorType. aMorph relativeTextAnchorPosition: nil. anchorType == #document ifTrue:[^self]. relPt _ self transformFromWorld globalPointToLocal: aPoint. index _ (self paragraph characterBlockAtPoint: relPt) stringIndex. newText _ Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: aMorph). anchorType == #inline ifTrue:[ self paragraph replaceFrom: index to: index-1 with: newText displaying: false. ] ifFalse:[ index _ index min: paragraph text size. index _ paragraph text string lastIndexOf: Character cr startingAt: index ifAbsent:[0]. block _ paragraph characterBlockForIndex: index+1. aMorph relativeTextAnchorPosition: (relPt x - bounds left) @ (relPt y - block top ). self paragraph replaceFrom: index+1 to: index with: newText displaying: false. ]. self fit.! ! !TextMorph methodsFor: 'anchors' stamp: 'ar 12/17/2001 13:35'! privateRemoveMorph: aMorph | range | range _ text find: (TextAnchor new anchoredMorph: aMorph). range ifNotNil: [self paragraph replaceFrom: range first to: range last with: Text new displaying: false. self fit]. aMorph textAnchorType: nil. aMorph relativeTextAnchorPosition: nil. super privateRemoveMorph: aMorph! ! !TextMorphEditor methodsFor: 'mvc compatibility' stamp: 'ar 12/17/2001 12:55'! align "Align text according to the next greater alignment value, cycling among leftFlush, rightFlush, center, and justified." self changeAlignment. self recomputeInterval! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'ar 12/17/2001 13:03'! changeTextFont "Present a menu of available fonts, and if one is chosen, apply it to the current selection." | curFont fontList fontMenu style active ptMenu label | curFont _ (paragraph text fontAt: startBlock stringIndex withStyle: paragraph textStyle). fontList _ StrikeFont familyNames remove: 'DefaultTextStyle' ifAbsent: []; asOrderedCollection. fontMenu _ MenuMorph new defaultTarget: self. fontList do:[:fontName| style _ TextStyle named: fontName. active _ curFont familyName sameAs: fontName. ptMenu _ MenuMorph new defaultTarget: self. style pointSizes do:[:pt| (active and:[pt = curFont pointSize]) ifTrue:[label _ ''] ifFalse:[label _ '']. label _ label, pt printString, ' pt'. ptMenu add: label target: self selector: #fontSelectionNamed:pointSize: argumentList: {fontName. pt}. ]. active ifTrue:[label _ ''] ifFalse:[label _ '']. label _ label, fontName. fontMenu add: label subMenu: ptMenu "later - allow selecting the font only and keep font sizes intact" "target: self selector: #fontSelectionNamed: argumentList: {fontName}". ]. fontMenu popUpInWorld.! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'ar 12/17/2001 13:08'! fontSelectionNamed: fontName pointSize: ptSize "Set the current selection to the given font name in the appropriate point size" | style font attr | style _ TextStyle named: fontName. style ifNil:[^self]. font _ style fonts detect:[:any| any pointSize = ptSize] ifNone:[nil]. font ifNil:[^self]. attr _ TextFontReference toFont: font. paragraph text addAttribute: attr from: startBlock stringIndex to: stopBlock stringIndex. paragraph composeAll. morph changed.! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'ar 12/17/2001 13:00'! offerFontMenu "Present a menu of available fonts, and if one is chosen, apply it to the current selection. Use only names of Fonts of this paragraph " | aList reply curFont menuList | true ifTrue:[^self changeTextFont]. self flag: #arNote. "Move this up once we get rid of MVC" curFont _ (paragraph text fontAt: startBlock stringIndex withStyle: paragraph textStyle) fontNameWithPointSize. aList _ paragraph textStyle fontNamesWithPointSizes. menuList _ aList collect:[:fntName| fntName = curFont ifTrue:['',fntName] ifFalse:['',fntName]]. reply _ (SelectionMenu labelList: menuList selections: aList) startUp. reply ~~ nil ifTrue: [self replaceSelectionWith: (Text string: self selection asString attribute: (TextFontChange fontNumber: (aList indexOf: reply)))] ! ! !TextStyle methodsFor: 'accessing' stamp: 'ar 12/16/2001 16:58'! fonts "Return a collection of fonts contained in this text style" ^fontArray! ! !TextStyle methodsFor: 'accessing' stamp: 'ar 12/16/2001 16:43'! pointSizes ^ fontArray collect: [:x | x pointSize] "TextStyle default fontNamesWithPointSizes"! ! Paragraph removeSelector: #leftMarginForDisplayForLine:! CharacterScanner initialize!