Squeak-dev September 2013

squeak-dev@lists.squeakfoundation.org

42 participants
315 discussions

Change notification: SqueakSource transition to a new server
by David T. Lewis 30 Sep '13

30 Sep '13

For many years, SqueakSource has been hosted by the Software Composition Group and the University of Bern, providing a valuable resource to the Squeak and Pharo community. The maintainers of SqueakSource at SCG have kindly offered to support a transition of this service to a server maintained by the Squeak community, and the Squeak oversight board has agreed to take responsibility for maintaining that service. Effective October 1, 2013 or thereabouts, the squeaksource.com address will be redirected to a new server. This change may impact you in the following ways: 1) Files that have been committed to SqueakSource since August 22, 2013 may be missing after the switch. We expect to identify and restore any such missing files within a few days following the change, but until this is complete, some recent repository updates will be temporarily missing. 2) If you are the owner of a project on SqueakSource, and have recently (since August 22) made changes to your project such as adding new developer authorizations, those recent changes may be lost. We will attempt to identify problems such as this, but it may be necessary for you to redo the changes. 3) Outbound mail notifications from SqueakSource will be disabled. If your project is configured to send mail to a mailing list or to yourself when commits are made, that mail will not be sent. This feature will be restored in the future, but will not be available immediately after the transition. No changes have been made to existing SqueakSource policies, and at the present time creation of new projects on squeaksource.com remains disabled. Dave

1 0

Daily Commit Log
by commits＠source.squeak.org 30 Sep '13

30 Sep '13

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2013-September/006452.… Name: Multilingual-nice.181 Ancestors: Multilingual-nice.180 Find a better replacement for firstDestX inst. var. usage (my previous fix broke selection of first char in the line, because a MultiCharacterBlockScanner would never have set firstDestX). I wonder if this handling is really necessary though... Remove unused presentationText: ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006453.… Name: Graphics-nice.235 Ancestors: Graphics-nice.234 Correct this glitch: when a text was centered or right flush, clicking at the very left of text morph would incorrectly position the text cursor. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006454.… Name: Graphics-nice.236 Ancestors: Graphics-nice.235 Don't setStopConditions twice in CharacterBlockScanner and DisplayScanner in MVC compatibility methods. SharedPools are inherited in Squeak, so don't declare TextConstants in CompositionScanner. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006455.… Name: Multilingual-nice.182 Ancestors: Multilingual-nice.181 Reduce some differences with the CharacterScanner hierarchies: This will fix a regression - centered Paragraph is not displayed corectly in MVC because inst. var. alignment was used before set in the scanner. This was solved in 2003 in http://ftp.squeak.org/updates/6188CenteredTextFix-BG.cs But the fix was applied on CharacterScanner branch only, while MultiCharacterScanner was already forked. Then the MultiCharacterScanner displayLines:in:clippedBy: was connected in 2005 (from the timeStamp of the method, maybe not the inclusion in official images, you'll have to dig the updateStream). Funnily, the selection did still use a CharacterBlockScanner, so was correctly centered (outside displayed text) ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006456.… Name: Multilingual-nice.183 Ancestors: Multilingual-nice.182 Fix theFirstCharCrossedX is a bit more straight replacement of crooked itsNotTheFirstCharThatCrossedX.. And it should be taken into account in (multi) display scanner, otherwise, the display scanner does not honour the composition... Apply the fix of Graphics branch to avoid displaying the cursor at window left in centerd alignment. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006457.… Name: Graphics-nice.237 Ancestors: Graphics-nice.236 Copy the multi-lingual methods from MultiCharacterScanner hierarchy that were missing in CharacterScanner hierarchy. Note that this does not include the precomposed unicode Combining which deserves a rewrite. Also note that non-space breakable chars are handled a bit differently in CompositionScanner in order to make the minimal change that could work. Start using the CharacterScanner hierarchy instead of the Multi one. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006458.… Name: Morphic-nice.693 Ancestors: Morphic-tpr.692 Start using the CharacterScanner hierarchy instead of the Multi one. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006459.… Name: ST80-nice.151 Ancestors: ST80-nice.150 Start using the CharacterScanner hierarchy instead of the Multi one. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006460.… Name: Multilingual-nice.184 Ancestors: Multilingual-nice.183 Remove now unused MultiCharacterScanner hierarchy Reminder: we will have to rewrite scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006461.… Name: Graphics-nice.238 Ancestors: Graphics-nice.237 Take font baseKern into account when measuring a String (a small diff with defunct Multi*). Create a specially crafted MeasuringStopConditions and use it when measuringString. This way, initializeStringMeasurer is no longer required and deprecated. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006462.… Name: 45Deprecated-nice.10 Ancestors: 45Deprecated-nice.9 Deprecate initializeStringMeasurer which is no longer required. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006463.… Name: Graphics-nice.239 Ancestors: Graphics-nice.238 Remove some dust from CharacterBlockScanner surface (just sanitize before we operate deeper) - don't copy lastSpaceOrTabExtent or lastCharacterExtent Points, we do not mutate them (since 2000) but create anew (see lastSpaceOrTabExtentSetX: and lastCharacterExtentSetX:) - don't (ab)use == to compare numbers (even integer indices) ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-September/006464.… Name: Graphics-nice.240 Ancestors: Graphics-nice.239 Remove the inst. var. lastCharacter of CharacterBlockScanner, because it is not a state. =============================================

1 0

The Trunk: Graphics-nice.240.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.240.mcz ==================== Summary ==================== Name: Graphics-nice.240 Author: nice Time: 29 September 2013, 11:37:28.204 pm UUID: 8723c89d-2584-4aa3-bfb2-a863df2ee81d Ancestors: Graphics-nice.239 Remove the inst. var. lastCharacter of CharacterBlockScanner, because it is not a state. =============== Diff against Graphics-nice.239 =============== Item was changed: CharacterScanner subclass: #CharacterBlockScanner + instanceVariableNames: 'characterPoint characterIndex lastCharacterExtent lastSpaceOrTabExtent nextLeftMargin specialWidth' - instanceVariableNames: 'characterPoint characterIndex lastCharacter lastCharacterExtent lastSpaceOrTabExtent nextLeftMargin specialWidth' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Text'! !CharacterBlockScanner commentStamp: '<historical>' prior: 0! My instances are used to scan text to compute the CharacterBlock for a character specified by its index in the text or its proximity to the cursor location.! Item was changed: ----- Method: CharacterBlockScanner>>cr (in category 'stop conditions') ----- cr "Answer a CharacterBlock that specifies the current location of the mouse relative to a carriage return stop condition that has just been encountered. The ParagraphEditor convention is to denote selections by CharacterBlocks, sometimes including the carriage return (cursor is at the end) and sometimes not (cursor is in the middle of the text)." ((characterIndex ~= nil and: [characterIndex > text size]) or: [(line last = text size) and: [(destY + line lineHeight) < characterPoint y]]) ifTrue: ["When off end of string, give data for next character" destY := destY + line lineHeight. - lastCharacter := nil. characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ destY. (lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]]) ifTrue: [lastIndex := lastIndex + 2] ifFalse: [lastIndex := lastIndex + 1]. self lastCharacterExtentSetX: 0. ^ true]. - lastCharacter := CR. characterPoint := destX @ destY. self lastCharacterExtentSetX: rightMargin - destX. ^true! Item was changed: ----- Method: CharacterBlockScanner>>crossedX (in category 'stop conditions') ----- 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." + | currentX lastCharacter | - | 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: [characterPoint := destX @ destY. - ifTrue: [lastCharacter := (text at: lastIndex). - characterPoint := destX @ destY. ^true]. lastIndex >= line last + ifTrue: [characterPoint := destX @ destY. - 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) font: font))]. ^ true! Item was changed: ----- Method: CharacterBlockScanner>>endOfRun (in category 'stop conditions') ----- 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 lastCharacter | - | runLength lineStop | (((characterIndex ~~ nil and: [runStopIndex < characterIndex and: [runStopIndex < text size]]) or: [characterIndex == nil and: [lastIndex < line last]]) or: [ ((lastIndex < line last) and: [((text at: lastIndex) leadingChar ~= (text at: lastIndex+1) leadingChar) and: [lastIndex ~= characterIndex]])]) 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!

1 0

The Trunk: Graphics-nice.239.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.239.mcz ==================== Summary ==================== Name: Graphics-nice.239 Author: nice Time: 29 September 2013, 10:14:06.441 pm UUID: 2357b4a4-41d5-4083-8d0d-89b83f87ceb4 Ancestors: Graphics-nice.238 Remove some dust from CharacterBlockScanner surface (just sanitize before we operate deeper) - don't copy lastSpaceOrTabExtent or lastCharacterExtent Points, we do not mutate them (since 2000) but create anew (see lastSpaceOrTabExtentSetX: and lastCharacterExtentSetX:) - don't (ab)use == to compare numbers (even integer indices) =============== Diff against Graphics-nice.238 =============== Item was changed: ----- Method: CharacterBlockScanner>>characterBlockAtPoint:index:in: (in category 'scanning') ----- characterBlockAtPoint: aPoint index: index in: textLine "This method is the Morphic characterBlock finder. It combines MVC's characterBlockAtPoint:, -ForIndex:, and buildCharacterBlockIn:" | runLength lineStop stopCondition | line := textLine. rightMargin := line rightMargin. lastIndex := line first. self setStopConditions. "also sets font" characterIndex := index. " == nil means scanning for point" characterPoint := aPoint. (characterPoint isNil or: [characterPoint y > line bottom]) ifTrue: [characterPoint := line bottomRight]. destX := leftMargin := line leftMarginForAlignment: alignment. destY := line top. (text isEmpty or: [(characterPoint y < destY or: [characterPoint x < destX]) or: [characterIndex notNil and: [characterIndex < line first]]]) ifTrue: [^ (CharacterBlock new stringIndex: line first text: text topLeft: destX@destY extent: 0 @ textStyle lineGrid) textLine: line]. runLength := text runLengthFor: line first. lineStop := characterIndex "scanning for index" ifNil: [ line last ]. "scanning for point" runStopIndex := lastIndex + (runLength - 1) min: lineStop. lastCharacterExtent := 0 @ line lineHeight. spaceCount := 0. [ 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 ifNil: [font widthOf: (text at: lastIndex)]). - self lastCharacterExtentSetX: (specialWidth - ifNil: [font widthOf: (text at: lastIndex)] - ifNotNil: [specialWidth]). self perform: stopCondition ] whileFalse. characterIndex ifNil: [ "Result for characterBlockAtPoint: " + (stopCondition ~~ #cr and: [ lastIndex = line last - (stopCondition ~~ #cr and: [ lastIndex == line last and: [ aPoint x > ((characterPoint x) + (lastCharacterExtent x / 2)) ]]) ifTrue: [ "Correct for right half of last character in line" ^ (CharacterBlock new stringIndex: lastIndex + 1 text: text topLeft: characterPoint + (lastCharacterExtent x @ 0) + (font descentKern @ 0) extent: 0 @ lastCharacterExtent y) textLine: line ]. ^ (CharacterBlock new stringIndex: lastIndex text: text topLeft: characterPoint + (font descentKern @ 0) extent: lastCharacterExtent - (font baseKern @ 0)) textLine: line] ifNotNil: ["Result for characterBlockForIndex: " ^ (CharacterBlock new stringIndex: characterIndex text: text topLeft: characterPoint + ((font descentKern) - kern @ 0) extent: lastCharacterExtent) textLine: line]! Item was changed: ----- Method: CharacterBlockScanner>>paddedSpace (in category 'stop conditions') ----- paddedSpace "When the line is justified, the spaces will not be the same as the font's space character. A padding of extra space must be considered in trying to find which character the cursor is pointing at. Answer whether the scanning has crossed the cursor." | pad | pad := 0. spaceCount := spaceCount + 1. pad := line justifiedPadFor: spaceCount font: font. + lastSpaceOrTabExtent := lastCharacterExtent. - lastSpaceOrTabExtent := lastCharacterExtent copy. self lastSpaceOrTabExtentSetX: spaceWidth + pad. (destX + lastSpaceOrTabExtent x) >= characterPoint x + ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent. - ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent copy. ^self crossedX]. lastIndex := lastIndex + 1. destX := destX + lastSpaceOrTabExtent x. ^ false ! Item was changed: ----- Method: CharacterBlockScanner>>space (in category 'stop conditions') ----- space "Account for spaceWidth" spaceCount := spaceCount + 1. + lastSpaceOrTabExtent := lastCharacterExtent. - lastSpaceOrTabExtent := lastCharacterExtent copy. self lastSpaceOrTabExtentSetX: spaceWidth. + (destX + spaceWidth) >= characterPoint x + ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent. - (destX + lastSpaceOrTabExtent x) >= characterPoint x - ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent copy. ^self crossedX]. lastIndex := lastIndex + 1. + destX := destX + spaceWidth. - destX := destX + lastSpaceOrTabExtent x. ^ false ! Item was changed: ----- Method: CharacterBlockScanner>>tab (in category 'stop conditions') ----- 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. - lastSpaceOrTabExtent := lastCharacterExtent copy. self lastSpaceOrTabExtentSetX: (currentX - destX max: 0). currentX >= characterPoint x ifTrue: + [lastCharacterExtent := lastSpaceOrTabExtent. - [lastCharacterExtent := lastSpaceOrTabExtent copy. ^ self crossedX]. destX := currentX. lastIndex := lastIndex + 1. ^false!

1 0

The Trunk: 45Deprecated-nice.10.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of 45Deprecated to project The Trunk: http://source.squeak.org/trunk/45Deprecated-nice.10.mcz ==================== Summary ==================== Name: 45Deprecated-nice.10 Author: nice Time: 29 September 2013, 7:07:40.687 pm UUID: c616ca66-997d-45f3-b5a8-df386dfcc3e8 Ancestors: 45Deprecated-nice.9 Deprecate initializeStringMeasurer which is no longer required. =============== Diff against 45Deprecated-nice.9 =============== Item was added: + ----- Method: CharacterScanner>>initializeStringMeasurer (in category '*45Deprecated') ----- + initializeStringMeasurer + "This method was once required to measure String but is now obsolescent." + + self deprecated: 'initializeStringMeasurer is no longer required' + !

1 0

The Trunk: Graphics-nice.238.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.238.mcz ==================== Summary ==================== Name: Graphics-nice.238 Author: nice Time: 29 September 2013, 7:06:35.509 pm UUID: f7a0533e-2b32-4908-8666-d26204334a6e Ancestors: Graphics-nice.237 Take font baseKern into account when measuring a String (a small diff with defunct Multi*). Create a specially crafted MeasuringStopConditions and use it when measuringString. This way, initializeStringMeasurer is no longer required and deprecated. =============== Diff against Graphics-nice.237 =============== Item was changed: Object subclass: #CharacterScanner instanceVariableNames: 'destX lastIndex destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel wantsColumnBreaks pendingKernX' + classVariableNames: 'ColumnBreakStopConditions DefaultStopConditions MeasuringStopConditions PaddedSpaceCondition' - classVariableNames: 'ColumnBreakStopConditions DefaultStopConditions PaddedSpaceCondition' poolDictionaries: 'TextConstants' category: 'Graphics-Text'! !CharacterScanner commentStamp: '<historical>' prior: 0! My instances hold the state associated with scanning text. My subclasses scan characters for specified purposes, such as computing a CharacterBlock or placing characters into Forms.! Item was changed: ----- Method: CharacterScanner class>>initialize (in category 'class initialization') ----- initialize " CharacterScanner initialize " | a | a := TextStopConditions new. a at: 1 + 1 put: #embeddedObject. a at: Space asciiValue + 1 put: #space. a at: Tab asciiValue + 1 put: #tab. a at: CR asciiValue + 1 put: #cr. a at: Character lf asciiValue + 1 put: #cr. DefaultStopConditions := a copy. ColumnBreakStopConditions := a copy. ColumnBreakStopConditions at: TextComposer characterForColumnBreak asciiValue + 1 put: #columnBreak. PaddedSpaceCondition := a copy. PaddedSpaceCondition at: Space asciiValue + 1 put: #paddedSpace. + + MeasuringStopConditions := TextStopConditions new! - ! Item was removed: - ----- Method: CharacterScanner>>initializeStringMeasurer (in category 'initialize') ----- - initializeStringMeasurer - - stopConditions := TextStopConditions new - ! Item was changed: ----- Method: CharacterScanner>>measureString:inFont:from:to: (in category 'scanning') ----- measureString: aString inFont: aFont from: startIndex to: stopIndex + "Measure aString width in given font aFont. + The string shall not include line breaking, tab or other control character." - "WARNING: In order to use this method the receiver has to be set up using #initializeStringMeasurer" destX := destY := lastIndex := 0. pendingKernX := 0. font := aFont. kern := 0 - font baseKern. spaceWidth := font widthOf: Space. + stopConditions := MeasuringStopConditions. + self scanCharactersFrom: startIndex to: stopIndex in: aString rightX: 999999 stopConditions: stopConditions kern: kern. - self scanCharactersFrom: startIndex to: stopIndex in: aString rightX: 999999 stopConditions: stopConditions kern: 0. ^destX!

1 0

The Trunk: Multilingual-nice.184.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of Multilingual to project The Trunk: http://source.squeak.org/trunk/Multilingual-nice.184.mcz ==================== Summary ==================== Name: Multilingual-nice.184 Author: nice Time: 29 September 2013, 5:00:34.754 pm UUID: 10f1b297-ecee-44ec-9135-f4251c8392bb Ancestors: Multilingual-nice.183 Remove now unused MultiCharacterScanner hierarchy Reminder: we will have to rewrite scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: =============== Diff against Multilingual-nice.183 =============== Item was removed: - MultiCharacterScanner subclass: #MultiCanvasCharacterScanner - instanceVariableNames: 'canvas fillBlt foregroundColor runX lineY' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Scanning'! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>canvas: (in category 'accessing') ----- - canvas: aCanvas - "set the canvas to draw on" - canvas ifNotNil: [ self inform: 'initializing twice!!' ]. - canvas := aCanvas! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>cr (in category 'stop conditions') ----- - cr - "When a carriage return is encountered, simply increment the pointer - into the paragraph." - - pendingKernX := 0. - (lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]]) - ifTrue: [lastIndex := lastIndex + 2] - ifFalse: [lastIndex := lastIndex + 1]. - ^false! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>crossedX (in category 'stop conditions') ----- - crossedX - "This condition will sometimes be reached 'legally' during display, when, - for instance the space that caused the line to wrap actually extends over - the right boundary. This character is allowed to display, even though it - is technically outside or straddling the clipping ectangle since it is in - the normal case not visible and is in any case appropriately clipped by - the scanner." - - "self fillLeading." - ^ true ! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>displayLine:offset:leftInRun: (in category 'scanning') ----- - displayLine: textLine offset: offset leftInRun: leftInRun - | nowLeftInRun 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. - - [ - "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 drawString: text string - from: startIndex to: lastIndex - at: startLoc - font: font - color: foregroundColor. - - "handle the stop condition" - self perform: stopCondition - ] whileFalse. - - ^runStopIndex - lastIndex! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>doesDisplaying (in category 'private') ----- - doesDisplaying - ^false "it doesn't do displaying using copyBits"! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>endOfRun (in category 'stop conditions') ----- - endOfRun - "The end of a run in the display case either means that there is actually - a change in the style (run code) to be associated with the string or the - end of this line has been reached." - | runLength | - - lastIndex = line last ifTrue: [^true]. - runX := destX. - runLength := text runLengthFor: (lastIndex := lastIndex + 1). - runStopIndex := lastIndex + (runLength - 1) min: line last. - self setStopConditions. - ^ false! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>paddedSpace (in category 'stop conditions') ----- - paddedSpace - "Each space is a stop condition when the alignment is right justified. - Padding must be added to the base width of the space according to - which space in the line this space is and according to the amount of - space that remained at the end of the line when it was composed." - - pendingKernX := 0. - destX := destX + spaceWidth + (line justifiedPadFor: spaceCount font: font). - lastIndex := lastIndex + 1. - ^ false! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>setFont (in category 'private') ----- - setFont - | baselineY | - foregroundColor ifNil: [foregroundColor := Color black]. - super setFont. - baselineY := lineY + line baseline. - destY := baselineY - font ascent.! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>space (in category 'stop conditions') ----- - space - "Don't display the space, just skip the spaceWidth." - - pendingKernX := 0. - destX := destX + spaceWidth. - lastIndex := lastIndex + 1. - ^ false! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>tab (in category 'stop conditions') ----- - tab - - pendingKernX := 0. - 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! Item was removed: - ----- Method: MultiCanvasCharacterScanner>>textColor: (in category 'private') ----- - textColor: color - foregroundColor := color! Item was removed: - MultiCharacterScanner subclass: #MultiCharacterBlockScanner - instanceVariableNames: 'characterPoint characterIndex lastCharacter lastCharacterExtent lastSpaceOrTabExtent nextLeftMargin specialWidth' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Scanning'! Item was removed: - ----- Method: MultiCharacterBlockScanner>>buildCharacterBlockIn: (in category 'private') ----- - buildCharacterBlockIn: para - "This method is used by the MVC version only." - - | lineIndex runLength lineStop 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 ifNil:[textStyle 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. - lastIndex := line first. - rightMargin := para rightMarginForDisplay. - self setStopConditions. " also loads the font, alignment and all emphasis attributes " - - (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. - runLength := text runLengthFor: line first. - lineStop := characterIndex "scanning for index" - ifNil: [ line last ]. "scanning for point" - runStopIndex := lastIndex + (runLength - 1) min: lineStop. - lastCharacterExtent := 0 @ line lineHeight. - spaceCount := 0. - self handleIndentation. - - [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] whileFalse. - - ^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]! Item was removed: - ----- Method: MultiCharacterBlockScanner>>characterBlockAtPoint:in: (in category 'scanning') ----- - characterBlockAtPoint: aPoint in: aParagraph - "Answer a CharacterBlock for character in aParagraph at point aPoint. It - is assumed that aPoint has been transformed into coordinates appropriate - to the text's destination form rectangle and the composition rectangle." - - self initializeFromParagraph: aParagraph clippedBy: aParagraph clippingRectangle. - characterPoint := aPoint. - ^self buildCharacterBlockIn: aParagraph! Item was removed: - ----- Method: MultiCharacterBlockScanner>>characterBlockAtPoint:index:in: (in category 'scanning') ----- - characterBlockAtPoint: aPoint index: index in: textLine - "This method is the Morphic characterBlock finder. It combines - MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:" - | runLength lineStop stopCondition | - line := textLine. - rightMargin := line rightMargin. - lastIndex := line first. - self setStopConditions. "also sets font" - characterIndex := index. " == nil means scanning for point" - characterPoint := aPoint. - (characterPoint isNil or: [characterPoint y > line bottom]) - ifTrue: [characterPoint := line bottomRight]. - destX := leftMargin := line leftMarginForAlignment: alignment. - destY := line top. - (text isEmpty or: [(characterPoint y < destY or: [characterPoint x <destX]) - or: [characterIndex notNil and: [characterIndex < line first]]]) - ifTrue: [^ (CharacterBlock new stringIndex: line first text: text - topLeft: destX@destY extent: 0 @ textStyle lineGrid) - textLine: line]. - runLength := text runLengthFor: line first. - lineStop := characterIndex "scanning for index" - ifNil: [ line last ]. "scanning for point" - runStopIndex := lastIndex + (runLength - 1) min: lineStop. - lastCharacterExtent := 0 @ line lineHeight. - spaceCount := 0. - - [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 - ifNil: [font widthOf: (text at: lastIndex)] - ifNotNil: [specialWidth]). - self perform: stopCondition] whileFalse. - - characterIndex - ifNil: [ - "Result for characterBlockAtPoint: " - (stopCondition ~~ #cr and: [ lastIndex == line last - and: [ aPoint x > ((characterPoint x) + (lastCharacterExtent x / 2)) ]]) - ifTrue: [ "Correct for right half of last character in line" - ^ (CharacterBlock new stringIndex: lastIndex + 1 - text: text - topLeft: characterPoint + (lastCharacterExtent x @ 0) + (font descentKern @ 0) - extent: 0 @ lastCharacterExtent y) - textLine: line ]. - ^ (CharacterBlock new stringIndex: lastIndex - text: text topLeft: characterPoint + (font descentKern @ 0) - extent: lastCharacterExtent - (font baseKern @ 0)) - textLine: line] - ifNotNil: ["Result for characterBlockForIndex: " - ^ (CharacterBlock new stringIndex: characterIndex - text: text topLeft: characterPoint + ((font descentKern) - kern @ 0) - extent: lastCharacterExtent) - textLine: line]! Item was removed: - ----- Method: MultiCharacterBlockScanner>>characterBlockForIndex:in: (in category 'scanning') ----- - characterBlockForIndex: targetIndex in: aParagraph - "Answer a CharacterBlock for character in aParagraph at targetIndex. The - coordinates in the CharacterBlock will be appropriate to the intersection - of the destination form rectangle and the composition rectangle." - - self - initializeFromParagraph: aParagraph - clippedBy: aParagraph clippingRectangle. - characterIndex := targetIndex. - characterPoint := - aParagraph rightMarginForDisplay @ - (aParagraph topAtLineIndex: - (aParagraph lineIndexOfCharacterIndex: characterIndex)). - ^self buildCharacterBlockIn: aParagraph! Item was removed: - ----- Method: MultiCharacterBlockScanner>>characterPointSetX: (in category 'private') ----- - characterPointSetX: xVal - characterPoint := xVal @ characterPoint y! Item was removed: - ----- Method: MultiCharacterBlockScanner>>cr (in category 'stop conditions') ----- - cr - "Answer a CharacterBlock that specifies the current location of the mouse - relative to a carriage return stop condition that has just been - encountered. The ParagraphEditor convention is to denote selections by - CharacterBlocks, sometimes including the carriage return (cursor is at - the end) and sometimes not (cursor is in the middle of the text)." - - ((characterIndex ~= nil - and: [characterIndex > text size]) - or: [(line last = text size) - and: [(destY + line lineHeight) < characterPoint y]]) - ifTrue: ["When off end of string, give data for next character" - destY := destY + line lineHeight. - lastCharacter := nil. - characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ destY. - (lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]]) - ifTrue: [lastIndex := lastIndex + 2] - ifFalse: [lastIndex := lastIndex + 1]. - self lastCharacterExtentSetX: 0. - ^ true]. - lastCharacter := CR. - characterPoint := destX @ destY. - self lastCharacterExtentSetX: rightMargin - destX. - ^true! Item was removed: - ----- Method: MultiCharacterBlockScanner>>crossedX (in category 'stop conditions') ----- - 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." - - | 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) font: font))]. - - ^ true! Item was removed: - ----- Method: MultiCharacterBlockScanner>>endOfRun (in category 'stop conditions') ----- - 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]]) or: [ - ((lastIndex < line last) - and: [((text at: lastIndex) leadingChar ~= (text at: lastIndex+1) leadingChar) - and: [lastIndex ~= characterIndex]])]) - 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! Item was removed: - ----- Method: MultiCharacterBlockScanner>>indentationLevel: (in category 'scanning') ----- - indentationLevel: anInteger - super indentationLevel: anInteger. - nextLeftMargin := leftMargin. - indentationLevel timesRepeat: [ - nextLeftMargin := textStyle nextTabXFrom: nextLeftMargin - leftMargin: leftMargin - rightMargin: rightMargin]! Item was removed: - ----- Method: MultiCharacterBlockScanner>>lastCharacterExtentSetX: (in category 'private') ----- - lastCharacterExtentSetX: xVal - lastCharacterExtent := xVal @ lastCharacterExtent y! Item was removed: - ----- Method: MultiCharacterBlockScanner>>lastSpaceOrTabExtentSetX: (in category 'private') ----- - lastSpaceOrTabExtentSetX: xVal - lastSpaceOrTabExtent := xVal @ lastSpaceOrTabExtent y! Item was removed: - ----- Method: MultiCharacterBlockScanner>>paddedSpace (in category 'stop conditions') ----- - paddedSpace - "When the line is justified, the spaces will not be the same as the font's - space character. A padding of extra space must be considered in trying - to find which character the cursor is pointing at. Answer whether the - scanning has crossed the cursor." - - | pad | - pad := 0. - spaceCount := spaceCount + 1. - pad := line justifiedPadFor: spaceCount font: font. - lastSpaceOrTabExtent := lastCharacterExtent copy. - self lastSpaceOrTabExtentSetX: spaceWidth + pad. - (destX + lastSpaceOrTabExtent x) >= characterPoint x - ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent copy. - ^self crossedX]. - lastIndex := lastIndex + 1. - destX := destX + lastSpaceOrTabExtent x. - ^ false - ! Item was removed: - ----- Method: MultiCharacterBlockScanner>>placeEmbeddedObject: (in category 'scanning') ----- - placeEmbeddedObject: anchoredMorph - "Workaround: The following should really use #textAnchorType" - anchoredMorph relativeTextAnchorPosition ifNotNil:[^true]. - (super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false]. - specialWidth := anchoredMorph width. - ^ true! Item was removed: - ----- Method: MultiCharacterBlockScanner>>scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') ----- - scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - - | encoding nextDestX startEncoding char charValue floatDestX widthAndKernedWidth nextChar | - lastIndex := startIndex. - lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun]. - startEncoding := (sourceString at: startIndex) leadingChar. - floatDestX := destX. - widthAndKernedWidth := Array new: 2. - [lastIndex <= stopIndex] whileTrue: [ - encoding := (sourceString at: lastIndex) leadingChar. - encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun]. - char := (sourceString at: lastIndex). - charValue := char charCode. - (encoding = 0 and: [charValue < 256 and: [(stops at: charValue + 1) ~~ nil]]) ifTrue: [ - ^ stops at: charValue + 1 - ]. - nextChar := (lastIndex + 1 <= stopIndex) - ifTrue:[sourceString at: lastIndex + 1] - ifFalse:[nil]. - font - widthAndKernedWidthOfLeft: ((char isMemberOf: CombinedChar) ifTrue:[char base] ifFalse:[char]) - right: nextChar - into: widthAndKernedWidth. - nextDestX := floatDestX + (widthAndKernedWidth at: 1). - nextDestX > rightX ifTrue: [^ stops crossedX]. - floatDestX := floatDestX + kernDelta + (widthAndKernedWidth at: 2). - destX := floatDestX. - lastIndex := lastIndex + 1. - ]. - lastIndex := stopIndex. - ^ stops endOfRun! Item was removed: - ----- Method: MultiCharacterBlockScanner>>setFont (in category 'stop conditions') ----- - setFont - specialWidth := nil. - super setFont! Item was removed: - ----- Method: MultiCharacterBlockScanner>>space (in category 'stop conditions') ----- - space - "Account for spaceWidth" - - spaceCount := spaceCount + 1. - lastSpaceOrTabExtent := lastCharacterExtent copy. - self lastSpaceOrTabExtentSetX: spaceWidth. - (destX + lastSpaceOrTabExtent x) >= characterPoint x - ifTrue: [lastCharacterExtent := lastSpaceOrTabExtent copy. - ^self crossedX]. - lastIndex := lastIndex + 1. - destX := destX + lastSpaceOrTabExtent x. - ^ false - ! Item was removed: - ----- Method: MultiCharacterBlockScanner>>tab (in category 'stop conditions') ----- - 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! Item was removed: - ----- Method: MultiCharacterBlockScanner>>theFirstCharCrossedX (in category 'private') ----- - theFirstCharCrossedX - "Note: it is hard to explain why, but this is required to keep selection of leftmost char possible." - ^false! Item was removed: - Object subclass: #MultiCharacterScanner - instanceVariableNames: 'destX lastIndex destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel wantsColumnBreaks pendingKernX baselineY firstDestX lastWidth' - classVariableNames: 'ColumnBreakStopConditions DefaultStopConditions PaddedSpaceCondition' - poolDictionaries: 'TextConstants' - category: 'Multilingual-Scanning'! Item was removed: - ----- Method: MultiCharacterScanner class>>initialize (in category 'class initialization') ----- - initialize - " - MultiCharacterScanner initialize - " - | a | - a := TextStopConditions new. - a at: 1 + 1 put: #embeddedObject. - a at: Space asciiValue + 1 put: #space. - a at: Tab asciiValue + 1 put: #tab. - a at: CR asciiValue + 1 put: #cr. - a at: Character lf asciiValue + 1 put: #cr. - - DefaultStopConditions := a copy. - - ColumnBreakStopConditions := a copy. - ColumnBreakStopConditions at: TextComposer characterForColumnBreak asciiValue + 1 put: #columnBreak. - - PaddedSpaceCondition := a copy. - PaddedSpaceCondition at: Space asciiValue + 1 put: #paddedSpace. - ! Item was removed: - ----- Method: MultiCharacterScanner>>addCharToPresentation: (in category 'multilingual scanning') ----- - addCharToPresentation: char - "appears to be unused" - lastWidth := font widthOf: char. - destX := destX + lastWidth.! Item was removed: - ----- Method: MultiCharacterScanner>>addEmphasis: (in category 'private') ----- - addEmphasis: code - "Set the bold-ital-under-strike emphasis." - emphasisCode := emphasisCode bitOr: code! Item was removed: - ----- Method: MultiCharacterScanner>>addKern: (in category 'private') ----- - addKern: kernDelta - "Set the current kern amount." - kern := kern + kernDelta! Item was removed: - ----- Method: MultiCharacterScanner>>basicScanCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') ----- - basicScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - "In ancient days this would have called primitive 103 to scan a string with StrikeFont, but time moves on. See historicalScanCharactersFrom:to:in:rightX:stopConditions:kern: if you're curious. This code handles the newer shape of CharacterScanner but does *no* pair kerning. - There is a pretty deep assumption of simple ASCII strings and characters - beware" - | ascii nextDestX char | - lastIndex := startIndex. - [lastIndex <= stopIndex] - whileTrue: [ - "get the character value" - char := sourceString at: lastIndex. - ascii := char asciiValue + 1. - "if there is an entry in 'stops' for this value, return it" - (stops at: ascii) - ifNotNil: [^ stops at: ascii]. - "bump nextDestX by the width of the current character" - nextDestX := destX + (font widthOf: char). - "if the next x is past the right edge, return crossedX" - nextDestX > rightX - ifTrue: [^ stops crossedX]. - "update destX and incorporate thr kernDelta" - destX := nextDestX + kernDelta. - lastIndex := lastIndex + 1]. - lastIndex := stopIndex. - ^ stops endOfRun! Item was removed: - ----- Method: MultiCharacterScanner>>basicScanKernableCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') ----- - basicScanKernableCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - "In ancient days this would have called primitive 103 to scan a string with StrikeFont, but time moves on. See historicalScanCharactersFrom:to:in:rightX:stopConditions:kern: if you're curious. This code handles the newer shape of CharacterScanner and provides some support for fonts that have pair-kerning; this may be removable with some better factoring. - There is a pretty deep assumption of simple ASCII strings and characters - beware" - | ascii nextDestX char floatDestX widthAndKernedWidth nextCharOrNil atEndOfRun | - lastIndex := startIndex. - floatDestX := destX. - widthAndKernedWidth := Array new: 2. - atEndOfRun := false. - [lastIndex <= stopIndex] - whileTrue: [ - "get the character value" - char := sourceString at: lastIndex. - ascii := char asciiValue + 1. - "if there is an entry in 'stops' for this value, return it" - (stops at: ascii) - ifNotNil: [^ stops at: ascii]. - "get the next character..." - nextCharOrNil := lastIndex + 1 <= stopIndex - ifTrue: [sourceString at: lastIndex + 1] - ifFalse: ["if we're at or past the stopIndex, see if there is anything in the full string" - atEndOfRun := true. - lastIndex + 1 <= sourceString size - ifTrue: [sourceString at: lastIndex + 1]]. - "get the font's kerning info for the pair of current character and next character" - "for almost all fonts in common use this is a waste of time since they don't support pair kerning and both values are #widthOf: char" - font - widthAndKernedWidthOfLeft: char - right: nextCharOrNil - into: widthAndKernedWidth. - "bump nextDestX by the width of the current character" - nextDestX := floatDestX - + (widthAndKernedWidth at: 1). - "if the next x is past the right edge, return crossedX" - nextDestX > rightX - ifTrue: [^ stops crossedX]. - "bump floatDestX by the *kerned* width of the current - character, which is where the *next* char will go" - floatDestX := floatDestX + kernDelta - + (widthAndKernedWidth at: 2). - "if we are at the end of this run we keep track of the - character-kern-delta for possible later use and then rather - insanely remove that character-kern-delta from floatDestX, - making it equivalent to (old floatDestX) + kernDelta + - width-of-character - no idea why" - atEndOfRun - ifTrue: [pendingKernX := (widthAndKernedWidth at: 2) - - (widthAndKernedWidth at: 1). - floatDestX := floatDestX - pendingKernX]. - "save the next x for next time around the loop" - destX := floatDestX. - lastIndex := lastIndex + 1]. - lastIndex := stopIndex. - ^ stops endOfRun! Item was removed: - ----- Method: MultiCharacterScanner>>columnBreak (in category 'scanning') ----- - columnBreak - - pendingKernX := 0. - ^true! Item was removed: - ----- Method: MultiCharacterScanner>>combinableChar:for: (in category 'scanner methods') ----- - combinableChar: char for: prevEntity - "appears to be unused" - ! Item was removed: - ----- Method: MultiCharacterScanner>>embeddedObject (in category 'scanning') ----- - 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! Item was removed: - ----- Method: MultiCharacterScanner>>handleIndentation (in category 'scanning') ----- - handleIndentation - self indentationLevel timesRepeat: [ - self plainTab]! Item was removed: - ----- Method: MultiCharacterScanner>>indentationLevel (in category 'scanning') ----- - indentationLevel - "return the number of tabs that are currently being placed at the beginning of each line" - ^indentationLevel ifNil:[0]! Item was removed: - ----- Method: MultiCharacterScanner>>indentationLevel: (in category 'scanning') ----- - indentationLevel: anInteger - "set the number of tabs to put at the beginning of each line" - indentationLevel := anInteger! Item was removed: - ----- Method: MultiCharacterScanner>>initialize (in category 'initialize') ----- - initialize - destX := destY := leftMargin := 0.! Item was removed: - ----- Method: MultiCharacterScanner>>initializeFromParagraph:clippedBy: (in category 'private') ----- - initializeFromParagraph: aParagraph clippedBy: clippingRectangle - - text := aParagraph text. - textStyle := aParagraph textStyle. - ! Item was removed: - ----- Method: MultiCharacterScanner>>initializeStringMeasurer (in category 'initialize') ----- - initializeStringMeasurer - - stopConditions := TextStopConditions new - ! Item was removed: - ----- Method: MultiCharacterScanner>>isBreakableAt:in:in: (in category 'scanner methods') ----- - isBreakableAt: index in: sourceString in: encodingClass - "check with the encoding whether the character at index is a breakable character- only the JISX0208 & JapaneseEnvironment will ever return true, so only the scanJapaneseCharacters... method calls this" - ^ encodingClass isBreakableAt: index in: sourceString. - ! Item was removed: - ----- Method: MultiCharacterScanner>>leadingTab (in category 'scanning') ----- - leadingTab - "return true if only tabs lie to the left" - line first to: lastIndex do: - [:i | (text at: i) == Tab ifFalse: [^ false]]. - ^ true! Item was removed: - ----- Method: MultiCharacterScanner>>measureString:inFont:from:to: (in category 'scanning') ----- - measureString: aString inFont: aFont from: startIndex to: stopIndex - "WARNING: In order to use this method the receiver has to be set up using #initializeStringMeasurer" - destX := destY := lastIndex := 0. - font := aFont. - pendingKernX := 0. - kern := 0 - font baseKern. - spaceWidth := font widthOf: Space. - - self scanCharactersFrom: startIndex to: stopIndex in: aString rightX: 999999 stopConditions: stopConditions kern: kern. - ^destX! Item was removed: - ----- Method: MultiCharacterScanner>>placeEmbeddedObject: (in category 'scanning') ----- - 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! Item was removed: - ----- Method: MultiCharacterScanner>>plainTab (in category 'scanning') ----- - 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]. - pendingKernX := 0.! Item was removed: - ----- Method: MultiCharacterScanner>>registerBreakableIndex (in category 'multilingual scanning') ----- - registerBreakableIndex - - "Record left x and character index of the line-wrappable point. - The default implementation here does nothing." - - ^ false. - ! Item was removed: - ----- Method: MultiCharacterScanner>>removeLastCharFromPresentation (in category 'multilingual scanning') ----- - removeLastCharFromPresentation - "appears to be unused" - destX := destX - lastWidth. - ! Item was removed: - ----- Method: MultiCharacterScanner>>scanCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') ----- - scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - | startEncoding selector | - sourceString isByteString - ifTrue: [font isPairKerningCapable - ifTrue: [^ self - basicScanKernableCharactersFrom: startIndex - to: (stopIndex min: sourceString size) - in: sourceString - rightX: rightX - stopConditions: stops - kern: kernDelta] - ifFalse: [^ self - basicScanCharactersFrom: startIndex - to: (stopIndex min: sourceString size) - in: sourceString - rightX: rightX - stopConditions: stops - kern: kernDelta]]. - sourceString isWideString - ifTrue: [startIndex > stopIndex - ifTrue: [lastIndex := stopIndex. - ^ stops endOfRun]. - startEncoding := (sourceString at: startIndex) leadingChar. - selector := EncodedCharSet scanSelectorAt: startEncoding. - ^ self - perform: selector - withArguments: (Array - with: startIndex - with: stopIndex - with: sourceString - with: rightX - with: stops - with: kernDelta)]. - ^ stops endOfRun! Item was removed: - ----- Method: MultiCharacterScanner>>scanJapaneseCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') ----- - scanJapaneseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - - | ascii encoding nextDestX startEncoding | - lastIndex := startIndex. - lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun]. - startEncoding := (sourceString at: startIndex) leadingChar. - [lastIndex <= stopIndex] whileTrue: [ - encoding := (sourceString at: lastIndex) leadingChar. - encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun]. - ascii := (sourceString at: lastIndex) charCode. - (encoding = 0 and: [ascii < 256 and:[(stops at: ascii + 1) notNil]]) - ifTrue: [^ stops at: ascii + 1]. - (self isBreakableAt: lastIndex in: sourceString in: (EncodedCharSet charsetAt: encoding)) ifTrue: [ - self registerBreakableIndex. - ]. - nextDestX := destX + (font widthOf: (sourceString at: lastIndex)). - nextDestX > rightX ifTrue: [self theFirstCharCrossedX ifFalse: [^ stops crossedX]]. - destX := nextDestX + kernDelta. - lastIndex := lastIndex + 1. - ]. - lastIndex := stopIndex. - ^ stops endOfRun! Item was removed: - ----- Method: MultiCharacterScanner>>scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') ----- - scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - - "appears to be unused" - | charCode encoding startEncoding combining combined combiningIndex c | - lastIndex := startIndex. - lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun]. - startEncoding := (sourceString at: startIndex) leadingChar. - combining := nil. - [lastIndex <= stopIndex] whileTrue: [ - charCode := (sourceString at: lastIndex) charCode. - c := (sourceString at: lastIndex). - combining ifNil: [ - combining := CombinedChar new. - combining add: c. - combiningIndex := lastIndex. - lastIndex := lastIndex + 1. - ] ifNotNil: [ - (combining add: c) ifFalse: [ - self addCharToPresentation: (combined := combining combined). - combining := CombinedChar new. - combining add: c. - charCode := combined charCode. - encoding := combined leadingChar. - encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. - (encoding = 0 and: [charCode < 256 and:[(stops at: charCode + 1) notNil]]) ifTrue: [ - ^ stops at: charCode + 1 - ] ifFalse: [ - ^ stops endOfRun - ]. - ]. - (encoding = 0 and: [charCode < 256 and:[(stops at: charCode + 1) notNil]]) ifTrue: [ - combining ifNotNil: [ - self addCharToPresentation: (combining combined). - ]. - ^ stops at: charCode + 1 - ]. - destX > rightX ifTrue: [ - self theFirstCharCrossedX ifFalse: [ - lastIndex := combiningIndex. - self removeLastCharFromPresentation. - ^ stops crossedX]]. - combiningIndex := lastIndex. - lastIndex := lastIndex + 1. - ] ifTrue: [ - lastIndex := lastIndex + 1. - ]. - ]. - ]. - lastIndex := stopIndex. - combining ifNotNil: [ - combined := combining combined. - self addCharToPresentation: combined. - ]. - ^ stops endOfRun! Item was removed: - ----- Method: MultiCharacterScanner>>scanMultiCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') ----- - scanMultiCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - - | ascii encoding nextDestX startEncoding floatDestX widthAndKernedWidth nextChar atEndOfRun | - lastIndex := startIndex. - lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun]. - startEncoding := (sourceString at: startIndex) leadingChar. - floatDestX := destX. - widthAndKernedWidth := Array new: 2. - atEndOfRun := false. - [lastIndex <= stopIndex] whileTrue: [ - encoding := (sourceString at: lastIndex) leadingChar. - encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun]. - ascii := (sourceString at: lastIndex) charCode. - (ascii < 256 and: [(stops at: ascii + 1) ~~ nil]) ifTrue: [^ stops at: ascii + 1]. - nextChar := (lastIndex + 1 <= stopIndex) - ifTrue:[sourceString at: lastIndex + 1] - ifFalse:[ - atEndOfRun := true. - "if there is a next char in sourceString, then get the kern - and store it in pendingKernX" - lastIndex + 1 <= sourceString size - ifTrue:[sourceString at: lastIndex + 1] - ifFalse:[ nil]]. - font - widthAndKernedWidthOfLeft: (sourceString at: lastIndex) - right: nextChar - into: widthAndKernedWidth. - nextDestX := floatDestX + (widthAndKernedWidth at: 1). - nextDestX > rightX ifTrue: [self theFirstCharCrossedX ifFalse: [^stops crossedX]]. - floatDestX := floatDestX + kernDelta + (widthAndKernedWidth at: 2). - atEndOfRun - ifTrue:[ - pendingKernX := (widthAndKernedWidth at: 2) - (widthAndKernedWidth at: 1). - floatDestX := floatDestX - pendingKernX]. - destX := floatDestX . - lastIndex := lastIndex + 1. - ]. - lastIndex := stopIndex. - ^ stops endOfRun! Item was removed: - ----- Method: MultiCharacterScanner>>setActualFont: (in category 'private') ----- - setActualFont: aFont - "Set the basal font to an isolated font reference." - - font := aFont! Item was removed: - ----- Method: MultiCharacterScanner>>setAlignment: (in category 'private') ----- - setAlignment: style - alignment := style. - ! Item was removed: - ----- Method: MultiCharacterScanner>>setConditionArray: (in category 'private') ----- - setConditionArray: aStopConditionOrNil - "This method is to be removed" - - ^stopConditions := DefaultStopConditions! Item was removed: - ----- Method: MultiCharacterScanner>>setFont (in category 'private') ----- - setFont - | priorFont | - "Set the font and other emphasis." - priorFont := font. - text == nil ifFalse:[ - emphasisCode := 0. - kern := 0. - indentationLevel := 0. - alignment := textStyle alignment. - font := nil. - (text attributesAt: lastIndex forStyle: textStyle) - do: [:att | att emphasizeScanner: self]]. - font == nil ifTrue: - [self setFont: textStyle defaultFontIndex]. - font := font emphasized: emphasisCode. - priorFont - ifNotNil: [ - font = priorFont - ifTrue:[ - "font is the same, perhaps the color has changed? - We still want kerning between chars of the same - font, but of different color. So add any pending kern to destX" - destX := destX + (pendingKernX ifNil:[0])]. - destX := destX + priorFont descentKern]. - pendingKernX := 0. "clear any pending kern so there is no danger of it being added twice" - destX := destX - font descentKern. - "NOTE: next statement should be removed when clipping works" - leftMargin ifNotNil: [destX := destX max: leftMargin]. - kern := kern - font baseKern. - - "Install various parameters from the font." - spaceWidth := font widthOf: Space. - stopConditions := DefaultStopConditions.! Item was removed: - ----- Method: MultiCharacterScanner>>setFont: (in category 'private') ----- - setFont: fontNumber - "Set the font by number from the textStyle." - - self setActualFont: (textStyle fontAt: fontNumber)! Item was removed: - ----- Method: MultiCharacterScanner>>setStopConditions (in category 'private') ----- - setStopConditions - "Set the font and the stop conditions for the current run." - - self setFont. - self setStopConditionsOrNil: (alignment = Justified ifTrue: [PaddedSpaceCondition]).! Item was removed: - ----- Method: MultiCharacterScanner>>setStopConditionsOrNil: (in category 'private') ----- - setStopConditionsOrNil: aStopConditionOrNil - - aStopConditionOrNil ifNotNil: [^stopConditions := aStopConditionOrNil]. - ^stopConditions := DefaultStopConditions! Item was removed: - ----- Method: MultiCharacterScanner>>text:textStyle: (in category 'private') ----- - text: t textStyle: ts - text := t. - textStyle := ts! Item was removed: - ----- Method: MultiCharacterScanner>>textColor: (in category 'private') ----- - textColor: ignored - "Overridden in DisplayScanner"! Item was removed: - ----- Method: MultiCharacterScanner>>theFirstCharCrossedX (in category 'private') ----- - theFirstCharCrossedX - "Tell whether the left most char crossed the right margin boundary" - ^destX = leftMargin! Item was removed: - ----- Method: MultiCharacterScanner>>wantsColumnBreaks: (in category 'initialize') ----- - wantsColumnBreaks: aBoolean - - wantsColumnBreaks := aBoolean! Item was removed: - MultiCharacterScanner subclass: #MultiCompositionScanner - instanceVariableNames: 'spaceX lineHeight baseline breakableIndex lineHeightAtBreak baselineAtBreak breakAtSpace' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Scanning'! Item was removed: - ----- Method: MultiCompositionScanner>>columnBreak (in category 'stop conditions') ----- - columnBreak - - "Answer true. Set up values for the text line interval currently being - composed." - - pendingKernX := 0. - line stop: lastIndex. - spaceX := destX. - line paddingWidth: rightMargin - spaceX. - ^true! Item was removed: - ----- Method: MultiCompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide: (in category 'scanning') ----- - composeFrom: startIndex inRectangle: lineRectangle - firstLine: firstLine leftSide: leftSide rightSide: rightSide - "Answer an instance of TextLineInterval that represents the next line in the paragraph." - | runLength 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. - breakAtSpace := false. - self handleIndentation. - leftMargin := destX. - line leftMargin: leftMargin. - - [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] whileFalse. - - ^ line - lineHeight: lineHeight + textStyle leading - baseline: baseline + textStyle leading! Item was removed: - ----- Method: MultiCompositionScanner>>composeLine:fromCharacterIndex:inParagraph: (in category 'scanning') ----- - composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: aParagraph - "Answer an instance of TextLineInterval that represents the next line in the paragraph." - | runLength stopCondition | - destX := spaceX := leftMargin := aParagraph leftMarginForCompositionForLine: lineIndex. - destY := 0. - rightMargin := aParagraph rightMarginForComposition. - leftMargin >= rightMargin ifTrue: [self error: 'No room between margins to compose']. - lastIndex := startIndex. "scanning sets last index" - lineHeight := textStyle lineGrid. "may be increased by setFont:..." - baseline := textStyle baseline. - self setStopConditions. "also sets font" - self handleIndentation. - runLength := text runLengthFor: startIndex. - runStopIndex := (lastIndex := startIndex) + (runLength - 1). - line := TextLineInterval - start: lastIndex - stop: 0 - internalSpaces: 0 - paddingWidth: 0. - spaceCount := 0. - breakAtSpace := false. - - [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] whileFalse. - - ^line - lineHeight: lineHeight + textStyle leading - baseline: baseline + textStyle leading! Item was removed: - ----- Method: MultiCompositionScanner>>computeDefaultLineHeight (in category 'scanning') ----- - computeDefaultLineHeight - "Compute the default line height for a potentially empty text" - rightMargin notNil - ifTrue: [lastIndex := 1. - self setFont. - ^ lineHeight + textStyle leading] - ifFalse: [^textStyle lineGrid]! Item was removed: - ----- Method: MultiCompositionScanner>>cr (in category 'stop conditions') ----- - cr - "Answer true. Set up values for the text line interval currently being - composed." - - pendingKernX := 0. - (lastIndex < text size and: [(text at: lastIndex) = Character cr and: [(text at: lastIndex+1) = Character lf]]) ifTrue: [lastIndex := lastIndex + 1]. - line stop: lastIndex. - spaceX := destX. - line paddingWidth: rightMargin - spaceX. - ^true! Item was removed: - ----- Method: MultiCompositionScanner>>crossedX (in category 'stop conditions') ----- - crossedX - "There is a word that has fallen across the right edge of the composition - rectangle. This signals the need for wrapping which is done to the last - space that was encountered, as recorded by the space stop condition." - - pendingKernX := 0. - (breakAtSpace) ifTrue: [ - spaceCount >= 1 ifTrue: - ["The common case. First back off to the space at which we wrap." - line stop: breakableIndex. - lineHeight := lineHeightAtBreak. - baseline := baselineAtBreak. - spaceCount := spaceCount - 1. - breakableIndex := breakableIndex - 1. - - "Check to see if any spaces preceding the one at which we wrap. - Double space after punctuation, most likely." - [(spaceCount > 1 and: [(text at: breakableIndex) = Space])] - whileTrue: - [spaceCount := spaceCount - 1. - "Account for backing over a run which might - change width of space." - font := text fontAt: breakableIndex withStyle: textStyle. - breakableIndex := breakableIndex - 1. - spaceX := spaceX - (font widthOf: Space)]. - line paddingWidth: rightMargin - spaceX. - line internalSpaces: spaceCount] - ifFalse: - ["Neither internal nor trailing spaces -- almost never happens." - lastIndex := lastIndex - 1. - [destX <= rightMargin] - whileFalse: - [destX := destX - (font widthOf: (text at: lastIndex)). - lastIndex := lastIndex - 1]. - spaceX := destX. - line paddingWidth: rightMargin - destX. - line stop: (lastIndex max: line first)]. - ^true - ]. - - (breakableIndex isNil or: [breakableIndex < line first]) ifTrue: [ - "Any breakable point in this line. Just wrap last character." - breakableIndex := lastIndex - 1. - lineHeightAtBreak := lineHeight. - baselineAtBreak := baseline. - ]. - - "It wasn't a space, but anyway this is where we break the line." - line stop: breakableIndex. - lineHeight := lineHeightAtBreak. - baseline := baselineAtBreak. - ^ true. - ! Item was removed: - ----- Method: MultiCompositionScanner>>endOfRun (in category 'stop conditions') ----- - endOfRun - "Answer true if scanning has reached the end of the paragraph. - Otherwise step conditions (mostly install potential new font) and answer - false." - - | runLength | - lastIndex = text size - ifTrue: [line stop: lastIndex. - spaceX := destX. - line paddingWidth: rightMargin - destX. - ^true] - ifFalse: [ - runLength := (text runLengthFor: (lastIndex := lastIndex + 1)). - runStopIndex := lastIndex + (runLength - 1). - self setStopConditions. - ^false] - ! Item was removed: - ----- Method: MultiCompositionScanner>>forParagraph: (in category 'intialize-release') ----- - forParagraph: aParagraph - "Initialize the receiver for scanning the given paragraph." - - self - initializeFromParagraph: aParagraph - clippedBy: aParagraph clippingRectangle. - ! Item was removed: - ----- Method: MultiCompositionScanner>>placeEmbeddedObject: (in category 'stop conditions') ----- - 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! Item was removed: - ----- Method: MultiCompositionScanner>>registerBreakableIndex (in category 'multilingual scanning') ----- - registerBreakableIndex - - "Record left x and character index of the line-wrappable point. - Used for wrap-around. Answer whether the character has crossed the - right edge of the composition rectangle of the paragraph." - - (text at: lastIndex) = Character space ifTrue: [ - breakAtSpace := true. - spaceX := destX. - spaceCount := spaceCount + 1. - lineHeightAtBreak := lineHeight. - baselineAtBreak := baseline. - breakableIndex := lastIndex. - destX > rightMargin ifTrue: [^self crossedX]. - ] ifFalse: [ - breakAtSpace := false. - lineHeightAtBreak := lineHeight. - baselineAtBreak := baseline. - breakableIndex := lastIndex - 1. - ]. - ^ false. - ! Item was removed: - ----- Method: MultiCompositionScanner>>rightX (in category 'accessing') ----- - rightX - "Meaningful only when a line has just been composed -- refers to the - line most recently composed. This is a subtrefuge to allow for easy - resizing of a composition rectangle to the width of the maximum line. - Useful only when there is only one line in the form or when each line - is terminated by a carriage return. Handy for sizing menus and lists." - - breakAtSpace ifTrue: [^ spaceX]. - - ^ destX. - ! Item was removed: - ----- Method: MultiCompositionScanner>>setActualFont: (in category 'scanning') ----- - setActualFont: aFont - "Keep track of max height and ascent for auto lineheight" - | descent | - super setActualFont: aFont. - lineHeight == nil - ifTrue: [descent := font descent. - baseline := font ascent. - lineHeight := baseline + descent] - ifFalse: [descent := lineHeight - baseline max: font descent. - baseline := baseline max: font ascent. - lineHeight := lineHeight max: baseline + descent]! Item was removed: - ----- Method: MultiCompositionScanner>>setStopConditions (in category 'stop conditions') ----- - setStopConditions - "Set the font and the stop conditions for the current run." - - self setFont. - self setStopConditionsOrNil: (wantsColumnBreaks == true ifTrue: [ColumnBreakStopConditions])! Item was removed: - ----- Method: MultiCompositionScanner>>space (in category 'stop conditions') ----- - space - "Record left x and character index of the space character just encounted. - Used for wrap-around. Answer whether the character has crossed the - right edge of the composition rectangle of the paragraph." - - pendingKernX := 0. - breakAtSpace := true. - spaceX := destX. - destX := spaceX + spaceWidth. - spaceCount := spaceCount + 1. - lineHeightAtBreak := lineHeight. - baselineAtBreak := baseline. - breakableIndex := lastIndex. - lastIndex := lastIndex + 1. - destX > rightMargin ifTrue: [^self crossedX]. - ^false - - ! Item was removed: - ----- Method: MultiCompositionScanner>>tab (in category 'stop conditions') ----- - tab - "Advance destination x according to tab settings in the paragraph's - textStyle. Answer whether the character has crossed the right edge of - the composition rectangle of the paragraph." - - pendingKernX := 0. - destX := textStyle - nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin. - destX > rightMargin ifTrue: [^self crossedX]. - lastIndex := lastIndex + 1. - ^false - ! Item was removed: - MultiCharacterScanner subclass: #MultiDisplayScanner - instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraphColor morphicOffset ignoreColorChanges' - classVariableNames: '' - poolDictionaries: '' - category: 'Multilingual-Scanning'! Item was removed: - ----- Method: MultiDisplayScanner class>>defaultFont (in category 'queries') ----- - defaultFont - ^ TextStyle defaultFont! Item was removed: - ----- Method: MultiDisplayScanner>>cr (in category 'stop conditions') ----- - cr - "When a carriage return is encountered, simply increment the pointer - into the paragraph." - - pendingKernX := 0. - (lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]]) - ifTrue: [lastIndex := lastIndex + 2] - ifFalse: [lastIndex := lastIndex + 1]. - ^false! Item was removed: - ----- Method: MultiDisplayScanner>>crossedX (in category 'stop conditions') ----- - crossedX - "This condition will sometimes be reached 'legally' during display, when, - for instance the space that caused the line to wrap actually extends over - the right boundary. This character is allowed to display, even though it - is technically outside or straddling the clipping ectangle since it is in - the normal case not visible and is in any case appropriately clipped by - the scanner." - - ^ true ! Item was removed: - ----- Method: MultiDisplayScanner>>displayLine:offset:leftInRun: (in category 'scanning') ----- - 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." - | stopCondition nowLeftInRun startIndex string lastPos baselineY | - 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]. - baselineY := lineY + line baseline. - destY := baselineY - font ascent. - runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last. - spaceCount := 0. - string := text string. - [ - "remember where this portion of the line starts" - startIndex := lastIndex. - lastPos := destX@destY. - - "find the end of this portion of the line" - stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex - in: string rightX: rightMargin stopConditions: stopConditions - kern: kern. - - "display that portion of the line" - lastIndex >= startIndex ifTrue:[ - bitBlt displayString: string - from: startIndex - "XXXX: The following is an interesting bug. All stopConditions exept #endOfRun - have lastIndex past the last character displayed. #endOfRun sets it *on* the character. - If we display up until lastIndex then we will also display invisible characters like - CR and tab. This problem should be fixed in the scanner (i.e., position lastIndex - consistently) but I don't want to deal with the fallout right now so we keep the - fix minimally invasive." - to: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1]) - at: lastPos kern: kern baselineY: baselineY font: font]. - (emphasisCode allMask: 4) ifTrue:[ - font displayUnderlineOn: bitBlt from: lastPos x@baselineY to: destX@baselineY. - ]. - (emphasisCode allMask: 16) ifTrue:[ - font displayStrikeoutOn: bitBlt from: lastPos x@baselineY to: destX@baselineY. - ]. - - "handle the stop condition" - "see setStopConditions for stopping conditions for displaying." - self perform: stopCondition. - ] whileFalse. - ^ runStopIndex - lastIndex "Number of characters remaining in the current run"! Item was removed: - ----- Method: MultiDisplayScanner>>displayLines:in:clippedBy: (in category 'MVC-compatibility') ----- - 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)." - | leftInRun | - "leftInRun is the # of characters left to scan in the current run; - when 0, it is time to call 'self setStopConditions'" - morphicOffset := 0@0. - leftInRun := 0. - self initializeFromParagraph: aParagraph clippedBy: visibleRectangle. - ignoreColorChanges := false. - 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 | - | runLength stopCondition startIndex string lastPos baselineY | - line := aParagraph lines at: lineIndex. - lastIndex := line first. - leftInRun <= 0 - ifTrue: [self setStopConditions. "also sets the font, alignment and emphasisCode" - leftInRun := text runLengthFor: line first]. - leftMargin := aParagraph leftMarginForDisplayForLine: lineIndex alignment: alignment. - destX := (runX := leftMargin). - lineHeight := line lineHeight. - fillBlt == nil ifFalse: - [fillBlt destX: visibleRectangle left destY: lineY - width: visibleRectangle width height: lineHeight; copyBits]. - baselineY := lineY + line baseline. - destY := baselineY - font ascent. "Should have happened in setFont" - runLength := leftInRun. - runStopIndex := lastIndex + (runLength - 1) min: line last. - leftInRun := leftInRun - (runStopIndex - lastIndex + 1). - spaceCount := 0. - string := text string. - self handleIndentation. - [ - 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 baselineY: baselineY]. - "see setStopConditions for stopping conditions for displaying." - self perform: stopCondition - ] whileFalse. - fillBlt == nil ifFalse: - [fillBlt destX: destX destY: lineY width: visibleRectangle right-destX height: lineHeight; copyBits]. - lineY := lineY + lineHeight]]! Item was removed: - ----- Method: MultiDisplayScanner>>endOfRun (in category 'stop conditions') ----- - endOfRun - "The end of a run in the display case either means that there is actually - a change in the style (run code) to be associated with the string or the - end of this line has been reached." - | runLength | - lastIndex = line last ifTrue: [^true]. - runX := destX. - runLength := text runLengthFor: (lastIndex := lastIndex + 1). - runStopIndex := lastIndex + (runLength - 1) min: line last. - self setStopConditions. - ^ false! Item was removed: - ----- Method: MultiDisplayScanner>>initializeFromParagraph:clippedBy: (in category 'MVC-compatibility') ----- - initializeFromParagraph: aParagraph clippedBy: clippingRectangle - - super initializeFromParagraph: aParagraph clippedBy: clippingRectangle. - bitBlt := BitBlt asGrafPort toForm: aParagraph destinationForm. - bitBlt sourceX: 0; width: 0. "Init BitBlt so that the first call to a primitive will not fail" - bitBlt combinationRule: - ((Display depth = 1) - ifTrue: - [aParagraph rule] - ifFalse: - [Form paint]). - bitBlt colorMap: - (Bitmap with: 0 "Assumes 1-bit deep fonts" - with: (bitBlt destForm pixelValueFor: aParagraph foregroundColor)). - bitBlt clipRect: clippingRectangle. - ! Item was removed: - ----- Method: MultiDisplayScanner>>isBreakableAt:in:in: (in category 'multilingual scanning') ----- - isBreakableAt: index in: sourceString in: encodingClass - - ^ false. - ! Item was removed: - ----- Method: MultiDisplayScanner>>paddedSpace (in category 'stop conditions') ----- - paddedSpace - "Each space is a stop condition when the alignment is right justified. - Padding must be added to the base width of the space according to - which space in the line this space is and according to the amount of - space that remained at the end of the line when it was composed." - - spaceCount := spaceCount + 1. - destX := destX + spaceWidth + (line justifiedPadFor: spaceCount font: font). - lastIndex := lastIndex + 1. - pendingKernX := 0. - ^ false! Item was removed: - ----- Method: MultiDisplayScanner>>placeEmbeddedObject: (in category 'scanning') ----- - 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 or: [anchoredMorph isPrimitiveCostume]) ifTrue: [ - anchoredMorph position: ((destX - anchoredMorph width)@lineY) - morphicOffset - ] ifFalse: [| baselineY | - destY := lineY. - baselineY := lineY + anchoredMorph height.. - runX := destX. - anchoredMorph - displayOn: bitBlt destForm - at: destX - anchoredMorph width @ destY - clippingBox: bitBlt clipRect - rule: Form blend - fillColor: Color white - ]. - ^ true! Item was removed: - ----- Method: MultiDisplayScanner>>plainTab (in category 'stop conditions') ----- - plainTab - | oldX | - oldX := destX. - super plainTab. - fillBlt == nil ifFalse: - [fillBlt destX: oldX destY: destY width: destX - oldX height: font height; copyBits]! Item was removed: - ----- Method: MultiDisplayScanner>>scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: (in category 'multilingual scanning') ----- - scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta - - | encoding nextDestX startEncoding char charValue | - lastIndex := startIndex. - lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun]. - startEncoding := (sourceString at: startIndex) leadingChar. - [lastIndex <= stopIndex] whileTrue: [ - encoding := (sourceString at: lastIndex) leadingChar. - encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun]. - char := (sourceString at: lastIndex). - charValue := char charCode. - (encoding = 0 and: [charValue < 256 and:[(stops at: charValue + 1) notNil]]) - ifTrue: [^stops at: charValue + 1]. - nextDestX := destX + (font widthOf: char). - nextDestX > rightX ifTrue: [^ stops crossedX]. - destX := nextDestX + kernDelta. - lastIndex := lastIndex + 1. - ]. - lastIndex := stopIndex. - ^ stops endOfRun! Item was removed: - ----- Method: MultiDisplayScanner>>setDestForm: (in category 'private') ----- - setDestForm: df - bitBlt setDestForm: df.! Item was removed: - ----- Method: MultiDisplayScanner>>setFont (in category 'private') ----- - setFont - foregroundColor := paragraphColor. - super setFont. "Sets font and emphasis bits, and maybe foregroundColor" - font installOn: bitBlt foregroundColor: foregroundColor backgroundColor: Color transparent. - text ifNotNil:[| baselineY | - baselineY := lineY + line baseline. - destY := baselineY - font ascent]. - ! Item was removed: - ----- Method: MultiDisplayScanner>>setPort: (in category 'private') ----- - setPort: aBitBlt - "Install the BitBlt to use" - bitBlt := aBitBlt. - bitBlt sourceX: 0; width: 0. "Init BitBlt so that the first call to a primitive will not fail" - bitBlt sourceForm: nil. "Make sure font installation won't be confused" - ! Item was removed: - ----- Method: MultiDisplayScanner>>space (in category 'stop conditions') ----- - space - "Don't display the space, just skip the spaceWidth" - - spaceCount := spaceCount + 1. - destX := destX + spaceWidth. - lastIndex := lastIndex + 1. - pendingKernX := 0. - ^ false! Item was removed: - ----- Method: MultiDisplayScanner>>tab (in category 'stop conditions') ----- - tab - self plainTab. - lastIndex := lastIndex + 1. - ^ false! Item was removed: - ----- Method: MultiDisplayScanner>>text:textStyle:foreground:background:fillBlt:ignoreColorChanges: (in category 'private') ----- - text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode - text := t. - textStyle := ts. - foregroundColor := paragraphColor := foreColor. - (backgroundColor := backColor) isTransparent ifFalse: - [fillBlt := blt. - fillBlt fillColor: backgroundColor]. - ignoreColorChanges := shadowMode! Item was removed: - ----- Method: MultiDisplayScanner>>textColor: (in category 'private') ----- - textColor: textColor - ignoreColorChanges ifTrue: [^ self]. - foregroundColor := textColor!

1 0

The Trunk: ST80-nice.151.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-nice.151.mcz ==================== Summary ==================== Name: ST80-nice.151 Author: nice Time: 29 September 2013, 4:35:30.085 pm UUID: bdd314c3-0f95-4519-82f0-dfc85b76d4a7 Ancestors: ST80-nice.150 Start using the CharacterScanner hierarchy instead of the Multi one. =============== Diff against ST80-nice.150 =============== Item was changed: ----- Method: Paragraph>>composeAll (in category 'composition') ----- composeAll "Compose a collection of characters into a collection of lines." | startIndex stopIndex lineIndex maximumRightX compositionScanner | lines := Array new: 32. lastLine := 0. maximumRightX := 0. text size = 0 ifTrue: [compositionRectangle := compositionRectangle withHeight: 0. ^maximumRightX]. startIndex := lineIndex := 1. stopIndex := text size. + compositionScanner := CompositionScanner new forParagraph: self. - compositionScanner := MultiCompositionScanner new forParagraph: self. [startIndex > stopIndex] whileFalse: [self lineAt: lineIndex put: (compositionScanner composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: self). maximumRightX := compositionScanner rightX max: maximumRightX. startIndex := (lines at: lineIndex) last + 1. lineIndex := lineIndex + 1]. self updateCompositionHeight. self trimLinesTo: lineIndex - 1. ^ maximumRightX! Item was changed: ----- Method: Paragraph>>displayLines:affectedRectangle: (in category 'private') ----- displayLines: linesInterval affectedRectangle: affectedRectangle "This is the first level workhorse in the display portion of the TextForm routines. It checks to see which lines in the interval are actually visible, has the CharacterScanner display only those, clears out the areas in which display will occur, and clears any space remaining in the visibleRectangle following the space occupied by lastLine." + | topY firstLineIndex lastLineIndex lastLineIndexBottom | - | lineGrid topY firstLineIndex lastLineIndex lastLineIndexBottom | "Save some time by only displaying visible lines" firstLineIndex := self lineIndexOfTop: affectedRectangle top. firstLineIndex < linesInterval first ifTrue: [firstLineIndex := linesInterval first]. lastLineIndex := self lineIndexOfTop: affectedRectangle bottom - 1. lastLineIndex > linesInterval last ifTrue: [linesInterval last > lastLine ifTrue: [lastLineIndex := lastLine] ifFalse: [lastLineIndex := linesInterval last]]. lastLineIndexBottom := (self bottomAtLineIndex: lastLineIndex). ((Rectangle origin: affectedRectangle left @ (topY := self topAtLineIndex: firstLineIndex) corner: affectedRectangle right @ lastLineIndexBottom) intersects: affectedRectangle) ifTrue: [ " . . . (skip to clear-below if no lines displayed)" + DisplayScanner new - MultiDisplayScanner new displayLines: (firstLineIndex to: lastLineIndex) in: self clippedBy: affectedRectangle]. lastLineIndex = lastLine ifTrue: [destinationForm "Clear out white space below last line" fill: (affectedRectangle left @ (lastLineIndexBottom max: affectedRectangle top) corner: affectedRectangle bottomRight) rule: rule fillColor: self backgroundColor]!

1 0

The Trunk: Morphic-nice.693.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-nice.693.mcz ==================== Summary ==================== Name: Morphic-nice.693 Author: nice Time: 29 September 2013, 4:31:07.575 pm UUID: 7c0b3c16-a967-457e-8fcf-0bdcec39d18a Ancestors: Morphic-tpr.692 Start using the CharacterScanner hierarchy instead of the Multi one. =============== Diff against Morphic-tpr.692 =============== Item was changed: ----- Method: GrafPort>>displayScannerFor:foreground:background:ignoreColorChanges: (in category 'accessing') ----- displayScannerFor: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode - - ((para isMemberOf: NewParagraph) or: [para text string isByteString]) ifTrue: [ - ^ (MultiDisplayScanner new text: para text textStyle: para textStyle - foreground: foreColor background: backColor fillBlt: self - ignoreColorChanges: shadowMode) - setPort: self clone - ]. ^ (DisplayScanner new text: para text textStyle: para textStyle foreground: foreColor background: backColor fillBlt: self ignoreColorChanges: shadowMode) setPort: self clone ! Item was changed: ----- Method: NewParagraph>>characterBlockAtPoint: (in category 'selection') ----- 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) - ^ ((text string isWideString) ifTrue: [ - MultiCharacterBlockScanner new text: text textStyle: textStyle - ] ifFalse: [CharacterBlockScanner new text: text textStyle: textStyle]) characterBlockAtPoint: aPoint index: nil in: line! Item was changed: ----- Method: NewParagraph>>characterBlockForIndex: (in category 'selection') ----- characterBlockForIndex: index "Answer a CharacterBlock for the character in text at index." | line | line := lines at: (self lineIndexOfCharacterIndex: index). + ^ (CharacterBlockScanner new text: text textStyle: textStyle) - ^ ((text string isWideString) ifTrue: [ - MultiCharacterBlockScanner new text: text textStyle: textStyle - ] ifFalse: [ - CharacterBlockScanner new text: text textStyle: textStyle - ]) characterBlockAtPoint: nil index: ((index max: line first) min: text size+1) in: line!

1 0

The Trunk: Graphics-nice.237.mcz
by commits＠source.squeak.org 29 Sep '13

29 Sep '13

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.237.mcz ==================== Summary ==================== Name: Graphics-nice.237 Author: nice Time: 29 September 2013, 4:26:28.942 pm UUID: f73a5da8-0cca-42c7-a0b3-08472216f2cf Ancestors: Graphics-nice.236 Copy the multi-lingual methods from MultiCharacterScanner hierarchy that were missing in CharacterScanner hierarchy. Note that this does not include the precomposed unicode Combining which deserves a rewrite. Also note that non-space breakable chars are handled a bit differently in CompositionScanner in order to make the minimal change that could work. Start using the CharacterScanner hierarchy instead of the Multi one. =============== Diff against Graphics-nice.236 =============== Item was added: + ----- Method: CharacterBlockScanner>>theFirstCharCrossedX (in category 'private') ----- + theFirstCharCrossedX + "Note: it is hard to explain why, but this is required to keep selection of leftmost char possible." + ^false! Item was added: + ----- Method: CharacterScanner>>isBreakableAt:in:in: (in category 'scanner methods') ----- + isBreakableAt: index in: sourceString in: encodingClass + "check with the encoding whether the character at index is a breakable character- only the JISX0208 & JapaneseEnvironment will ever return true, so only the scanJapaneseCharacters... method calls this" + ^ encodingClass isBreakableAt: index in: sourceString. + ! Item was removed: - ----- Method: CharacterScanner>>isBreakableAtIndex: (in category 'scanner methods') ----- - isBreakableAtIndex: index - "appears t obe unused - cf MultiCharacterScanner>isBreakableAt:in:in" - ^ (EncodedCharSet at: ((text at: index) leadingChar + 1)) isBreakableAt: index in: text. - ! Item was added: + ----- Method: CharacterScanner>>registerBreakableIndex (in category 'multilingual scanning') ----- + registerBreakableIndex + + "Record left x and character index of the line-wrappable point. + The default implementation here does nothing." + + ^ false. + ! Item was changed: ----- Method: CharacterScanner>>scanJapaneseCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') ----- scanJapaneseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta | ascii encoding nextDestX startEncoding | lastIndex := startIndex. lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun]. startEncoding := (sourceString at: startIndex) leadingChar. [lastIndex <= stopIndex] whileTrue: [ encoding := (sourceString at: lastIndex) leadingChar. encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun]. ascii := (sourceString at: lastIndex) charCode. (encoding = 0 and: [ascii < 256 and:[(stops at: ascii + 1) notNil]]) ifTrue: [^ stops at: ascii + 1]. + (self isBreakableAt: lastIndex in: sourceString in: (EncodedCharSet charsetAt: encoding)) ifTrue: [ + self registerBreakableIndex. + ]. nextDestX := destX + (font widthOf: (sourceString at: lastIndex)). + nextDestX > rightX ifTrue: [self theFirstCharCrossedX ifFalse: [^ stops crossedX]]. - nextDestX > rightX ifTrue: [^ stops crossedX]. destX := nextDestX + kernDelta. - "destX printString displayAt: 0@(lastIndex*20)." lastIndex := lastIndex + 1. ]. lastIndex := stopIndex. ^ stops endOfRun! Item was changed: ----- Method: CharacterScanner>>scanMultiCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') ----- scanMultiCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta + | ascii encoding nextDestX startEncoding floatDestX widthAndKernedWidth nextChar atEndOfRun | - | ascii encoding nextDestX startEncoding | lastIndex := startIndex. lastIndex > stopIndex ifTrue: [lastIndex := stopIndex. ^ stops endOfRun]. startEncoding := (sourceString at: startIndex) leadingChar. + floatDestX := destX. + widthAndKernedWidth := Array new: 2. + atEndOfRun := false. [lastIndex <= stopIndex] whileTrue: [ encoding := (sourceString at: lastIndex) leadingChar. encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun]. ascii := (sourceString at: lastIndex) charCode. + (ascii < 256 and: [(stops at: ascii + 1) ~~ nil]) ifTrue: [^ stops at: ascii + 1]. + nextChar := (lastIndex + 1 <= stopIndex) + ifTrue:[sourceString at: lastIndex + 1] + ifFalse:[ + atEndOfRun := true. + "if there is a next char in sourceString, then get the kern + and store it in pendingKernX" + lastIndex + 1 <= sourceString size + ifTrue:[sourceString at: lastIndex + 1] + ifFalse:[ nil]]. + font + widthAndKernedWidthOfLeft: (sourceString at: lastIndex) + right: nextChar + into: widthAndKernedWidth. + nextDestX := floatDestX + (widthAndKernedWidth at: 1). + nextDestX > rightX ifTrue: [self theFirstCharCrossedX ifFalse: [^stops crossedX]]. + floatDestX := floatDestX + kernDelta + (widthAndKernedWidth at: 2). + atEndOfRun + ifTrue:[ + pendingKernX := (widthAndKernedWidth at: 2) - (widthAndKernedWidth at: 1). + floatDestX := floatDestX - pendingKernX]. + destX := floatDestX . - (encoding = 0 and: [ascii < 256 and:[(stops at: ascii + 1) notNil]]) - ifTrue: [^ stops at: ascii + 1]. - nextDestX := destX + (font widthOf: (sourceString at: lastIndex)). - nextDestX > rightX ifTrue: [^ stops crossedX]. - destX := nextDestX + kernDelta. - "destX printString displayAt: 0@(lastIndex*20)." lastIndex := lastIndex + 1. ]. lastIndex := stopIndex. ^ stops endOfRun! Item was added: + ----- Method: CharacterScanner>>theFirstCharCrossedX (in category 'private') ----- + theFirstCharCrossedX + "Tell whether the left most char crossed the right margin boundary" + ^destX = leftMargin! Item was changed: CharacterScanner subclass: #CompositionScanner + instanceVariableNames: 'spaceX spaceIndex lineHeight baseline lineHeightAtSpace baselineAtSpace lastBreakIsNotASpace' - instanceVariableNames: 'spaceX spaceIndex lineHeight baseline lineHeightAtSpace baselineAtSpace' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Text'! !CompositionScanner commentStamp: '<historical>' prior: 0! CompositionScanners are used to measure text and determine where line breaks and space padding should occur.! Item was changed: ----- Method: CompositionScanner>>columnBreak (in category 'stop conditions') ----- columnBreak "Answer true. Set up values for the text line interval currently being composed." pendingKernX := 0. line stop: lastIndex. spaceX := destX. + lastBreakIsNotASpace := false. line paddingWidth: rightMargin - spaceX. ^true! Item was changed: ----- Method: CompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide: (in category 'scanning') ----- composeFrom: startIndex inRectangle: lineRectangle firstLine: firstLine leftSide: leftSide rightSide: rightSide "Answer an instance of TextLineInterval that represents the next line in the paragraph." | runLength 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" line := (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0) rectangle: lineRectangle. self setStopConditions. "also sets font" runLength := text runLengthFor: startIndex. runStopIndex := (lastIndex := startIndex) + (runLength - 1). spaceCount := 0. + lastBreakIsNotASpace := false. self handleIndentation. leftMargin := destX. line leftMargin: leftMargin. [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] whileFalse. ^ line lineHeight: lineHeight + textStyle leading baseline: baseline + textStyle leading! Item was changed: ----- Method: CompositionScanner>>composeLine:fromCharacterIndex:inParagraph: (in category 'scanning') ----- composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: aParagraph "Answer an instance of TextLineInterval that represents the next line in the paragraph." | runLength stopCondition | destX := spaceX := leftMargin := aParagraph leftMarginForCompositionForLine: lineIndex. destY := 0. rightMargin := aParagraph rightMarginForComposition. leftMargin >= rightMargin ifTrue: [self error: 'No room between margins to compose']. lastIndex := startIndex. "scanning sets last index" lineHeight := textStyle lineGrid. "may be increased by setFont:..." baseline := textStyle baseline. self setStopConditions. "also sets font" self handleIndentation. runLength := text runLengthFor: startIndex. runStopIndex := (lastIndex := startIndex) + (runLength - 1). line := TextLineInterval start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0. spaceCount := 0. + lastBreakIsNotASpace := false. [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] whileFalse. ^line lineHeight: lineHeight + textStyle leading baseline: baseline + textStyle leading! Item was changed: ----- Method: CompositionScanner>>cr (in category 'stop conditions') ----- cr "Answer true. Set up values for the text line interval currently being composed." pendingKernX := 0. (lastIndex < text size and: [(text at: lastIndex) = CR and: [(text at: lastIndex+1) = Character lf]]) ifTrue: [lastIndex := lastIndex + 1]. line stop: lastIndex. spaceX := destX. + lastBreakIsNotASpace := false. line paddingWidth: rightMargin - spaceX. ^true! Item was changed: ----- Method: CompositionScanner>>crossedX (in category 'stop conditions') ----- crossedX "There is a word that has fallen across the right edge of the composition rectangle. This signals the need for wrapping which is done to the last + space that was encountered, as recorded by the space stop condition, + or any other breakable character if the language permits so." - space that was encountered, as recorded by the space stop condition." pendingKernX := 0. + + lastBreakIsNotASpace ifTrue: + ["In some languages break is possible on non space." + line stop: spaceIndex. + lineHeight := lineHeightAtSpace. + baseline := baselineAtSpace. + spaceCount := spaceCount - 1. + spaceIndex := spaceIndex - 1. + line paddingWidth: rightMargin. + line internalSpaces: spaceCount. + ^true]. + spaceCount >= 1 ifTrue: ["The common case. First back off to the space at which we wrap." line stop: spaceIndex. lineHeight := lineHeightAtSpace. baseline := baselineAtSpace. spaceCount := spaceCount - 1. spaceIndex := spaceIndex - 1. "Check to see if any spaces preceding the one at which we wrap. Double space after punctuation, most likely." [(spaceCount > 1 and: [(text at: spaceIndex) = Space])] whileTrue: [spaceCount := spaceCount - 1. "Account for backing over a run which might change width of space." font := text fontAt: spaceIndex withStyle: textStyle. spaceIndex := spaceIndex - 1. spaceX := spaceX - (font widthOf: Space)]. line paddingWidth: rightMargin - spaceX. line internalSpaces: spaceCount] ifFalse: ["Neither internal nor trailing spaces -- almost never happens." lastIndex := lastIndex - 1. [destX <= rightMargin or: [ lastIndex = 0 ]] whileFalse: [destX := destX - (font widthOf: (text at: lastIndex)). lastIndex := lastIndex - 1]. spaceX := destX. line paddingWidth: rightMargin - destX. line stop: (lastIndex max: line first)]. ^true! Item was added: + ----- Method: CompositionScanner>>registerBreakableIndex (in category 'multilingual scanning') ----- + registerBreakableIndex + "Record left x and character index of the line-wrappable point. + Used for wrap-around in eastern Asian languages." + + spaceX := destX. + lineHeightAtSpace := lineHeight. + baselineAtSpace := baseline. + spaceIndex := lastIndex. + lastBreakIsNotASpace := true.! Item was changed: ----- Method: CompositionScanner>>space (in category 'stop conditions') ----- space + "Record left x and character index of the space character just encountered. - "Record left x and character index of the space character just encounted. Used for wrap-around. Answer whether the character has crossed the right edge of the composition rectangle of the paragraph." pendingKernX := 0. spaceX := destX. destX := spaceX + spaceWidth. spaceIndex := lastIndex. lineHeightAtSpace := lineHeight. baselineAtSpace := baseline. lastIndex := lastIndex + 1. spaceCount := spaceCount + 1. + lastBreakIsNotASpace := false. destX > rightMargin ifTrue: [^self crossedX]. ^false ! Item was changed: ----- Method: DisplayScanner>>displayLine:offset:leftInRun: (in category 'scanning') ----- 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." | 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. string := text string. [ "remember where this portion of the line starts" startIndex := lastIndex. lastPos := destX@destY. "find the end of this portion of the line" stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex in: string rightX: rightMargin stopConditions: stopConditions kern: kern. "display that portion of the line" lastIndex >= startIndex ifTrue:[ font displayString: string on: bitBlt from: startIndex "XXXX: The following is an interesting bug. All stopConditions exept #endOfRun have lastIndex past the last character displayed. #endOfRun sets it *on* the character. If we display up until lastIndex then we will also display invisible characters like CR and tab. This problem should be fixed in the scanner (i.e., position lastIndex consistently) but I don't want to deal with the fallout right now so we keep the fix minimally invasive." to: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1]) at: lastPos kern: kern]. "handle the stop condition" "see setStopConditions for stopping conditions for displaying." + self perform: stopCondition - (self perform: stopCondition) - or: [lastIndex > runStopIndex]. ] whileFalse. ^ runStopIndex - lastIndex "Number of characters remaining in the current run"! Item was added: + ----- Method: DisplayScanner>>isBreakableAt:in:in: (in category 'multilingual scanning') ----- + isBreakableAt: index in: sourceString in: encodingClass + + ^ false. + ! Item was changed: ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'as yet unclassified') ----- composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks wantsColumnBreaks := argWantsColumnBreaks. lines := argLinesCollection. theTextStyle := argTextStyle. theText := argText. theContainer := argContainer. deltaCharIndex := argDelta. currCharIndex := startCharIndex := argStart. stopCharIndex := argStop. prevLines := argPriorLines. currentY := argStartY. maxRightX := theContainer left. possibleSlide := stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle]. nowSliding := false. prevIndex := 1. "choose an appropriate scanner - should go away soon, when they can be unified" + scanner := CompositionScanner new. - scanner := (theText string isOctetString - ifTrue:[CompositionScanner new] - ifFalse:[MultiCompositionScanner new]). scanner text: theText textStyle: theTextStyle. scanner wantsColumnBreaks: wantsColumnBreaks. defaultLineHeight := scanner computeDefaultLineHeight. isFirstLine := true. self composeAllLines. isFirstLine ifTrue: ["No space in container or empty text" self addNullLineWithIndex: startCharIndex andRectangle: (theContainer topLeft extent: 0@defaultLineHeight) ] ifFalse: [ self fixupLastLineIfCR ]. ^{lines asArray. maxRightX} ! Item was changed: ----- Method: TextComposer>>multiComposeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'as yet unclassified') ----- multiComposeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks "temporarily add this here to support move to drop MultiTextComposer" "now redundant and ready to remove later" wantsColumnBreaks := argWantsColumnBreaks. lines := argLinesCollection. theTextStyle := argTextStyle. theText := argText. theContainer := argContainer. deltaCharIndex := argDelta. currCharIndex := startCharIndex := argStart. stopCharIndex := argStop. prevLines := argPriorLines. currentY := argStartY. maxRightX := theContainer left. possibleSlide := stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle]. nowSliding := false. prevIndex := 1. + scanner := CompositionScanner new text: theText textStyle: theTextStyle. - scanner := MultiCompositionScanner new text: theText textStyle: theTextStyle. scanner wantsColumnBreaks: wantsColumnBreaks. defaultLineHeight := scanner computeDefaultLineHeight. isFirstLine := true. self composeAllLines. isFirstLine ifTrue: ["No space in container or empty text" + self - self addNullLineWithIndex: startCharIndex andRectangle: (theContainer topLeft extent: 0@defaultLineHeight) ] ifFalse: [ self fixupLastLineIfCR ]. ^{lines asArray. maxRightX} !

1 0

← Newer
1
2
3
4
5
6
7
...
32
Older →

Jump to page: