[squeak-dev] The Trunk: Graphics-nice.260.mcz

Nicolas Cellier nicolas.cellier.aka.nice at gmail.com
Wed Oct 9 00:45:40 UTC 2013


I forgot to tell that I removed this code, because
* it was acting against the solving of first char that does not fit
* I did not know what it could be useful to

-       [destX <= rightMargin or: [ lastIndex = 0 ]]
-               whileFalse:
-                       [destX := destX - (font widthOf: (text at:
lastIndex)).
-                       lastIndex := lastIndex - 1].
-       nextIndexAfterLineBreak := lastIndex + 1.

My feeling is that is dates back from the times when there weren't a proper
clipping...
Just a guess


2013/10/9 <commits at source.squeak.org>

> Nicolas Cellier uploaded a new version of Graphics to project The Trunk:
> http://source.squeak.org/trunk/Graphics-nice.260.mcz
>
> ==================== Summary ====================
>
> Name: Graphics-nice.260
> Author: nice
> Time: 9 October 2013, 2:39:39.19 am
> UUID: 338e05c0-4e8f-433f-8f04-f65ae8721491
> Ancestors: Graphics-nice.259
>
> Introduce uniform handling for the case when the first char does not fit
> in the composition rectangle: if we crossedX and have no breakable, then
> advanceIfFirstCharOfLine.
> Move some pendingkernX reset (way too many of those...).
> In DisplayScanner, this is more complex because we display BEFORE
> processing the stop conditions. Fix it with a temporary workaround that
> advanceIfFirstCharOfLine in the scan loop, but prepare a new instance
> variable lastDisplayableIndex to fix it properly (in a next stage,
> displaying is vital).
>
> =============== Diff against Graphics-nice.259 ===============
>
> 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 |
>         spaceCount := spaceCount + 1.
>         pad := line justifiedPadFor: spaceCount font: font.
>         lastCharacterWidth := spaceWidth + pad.
>         (destX + lastCharacterWidth)  >= characterPoint x
>                 ifTrue:
>                         [^self crossedX].
>         lastIndex := lastIndex + 1.
>         destX := destX + lastCharacterWidth + kern.
> +       pendingKernX := 0.
>         ^ false
>   !
>
> Item was added:
> + ----- Method: CharacterScanner>>advanceIfFirstCharOfLine (in category
> 'private') -----
> + advanceIfFirstCharOfLine
> +       lastIndex = line first
> +               ifTrue:
> +                       [destX := destX + pendingKernX + (font widthOf:
> (text at: line first)).
> +                       lastIndex := lastIndex + 1.
> +                       pendingKernX := 0].!
>
> 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."
>
>         pendingKernX := 0.
>
>         lastBreakIsNotASpace ifTrue:
>                 ["In some languages line break is possible before a non
> space."
>                 ^self wrapAtLastBreakable].
>
>         spaceCount >= 1 ifTrue:
>                 ["The common case. there is a space on the line."
>                 ^self wrapAtLastSpace].
>
>         "Neither internal nor trailing spaces -- almost never happens."
> +       self advanceIfFirstCharOfLine.
>         ^self wrapHere!
>
> Item was changed:
>   ----- Method: CompositionScanner>>wrapAtLastBreakable (in category 'stop
> conditions') -----
>   wrapAtLastBreakable
>         "Wrap the line before last encountered breakable character."
> +       pendingKernX := 0.
>         nextIndexAfterLineBreak := spaceIndex.
>         line stop: spaceIndex - 1.
>         lineHeight := lineHeightAtSpace.
>         baseline := baselineAtSpace.
>         line paddingWidth: rightMargin - spaceX.
>         line internalSpaces: spaceCount.
>         ^true!
>
> Item was changed:
>   ----- Method: CompositionScanner>>wrapAtLastSpace (in category 'stop
> conditions') -----
>   wrapAtLastSpace
>         "Wrap the line before last encountered space"
>
> +       pendingKernX := 0.
>         nextIndexAfterLineBreak := spaceIndex + 1.
>         alignment = Justified ifTrue: [
>                 "gobble all subsequent spaces"
>                 [nextIndexAfterLineBreak <= text size and: [(text at:
> nextIndexAfterLineBreak) == Space]]
>                         whileTrue: [nextIndexAfterLineBreak :=
> nextIndexAfterLineBreak + 1]].
>
>         line stop: nextIndexAfterLineBreak - 1.
>         lineHeight := lineHeightAtSpace.
>         baseline := baselineAtSpace.
>
>         ["remove the space at which we break..."
>         spaceCount := spaceCount - 1.
>         spaceIndex := spaceIndex - 1.
>
>         "...and every other spaces preceding the one at which we wrap.
>                 Double space after punctuation, most likely."
>         spaceCount >= 1 and: [(text at: spaceIndex) = Space]]
>                 whileTrue:
>                         ["Account for backing over a run which might
>                                 change width of space."
>                         font := text fontAt: spaceIndex withStyle:
> textStyle.
>                         spaceX := spaceX - (font widthOf: Space)].
>         line paddingWidth: rightMargin - spaceX.
>         line internalSpaces: spaceCount.
>         ^true!
>
> Item was changed:
>   ----- Method: CompositionScanner>>wrapHere (in category 'stop
> conditions') -----
>   wrapHere
>         "Wrap the line before current character."
> +       pendingKernX := 0.
> +       nextIndexAfterLineBreak := lastIndex.
>         lastIndex := lastIndex - 1.
> -       [destX <= rightMargin or: [ lastIndex = 0 ]]
> -               whileFalse:
> -                       [destX := destX - (font widthOf: (text at:
> lastIndex)).
> -                       lastIndex := lastIndex - 1].
> -       nextIndexAfterLineBreak := lastIndex + 1.
>         spaceX := destX.
>         line paddingWidth: rightMargin - destX.
>         line stop: (lastIndex max: line first).
>         ^true!
>
> Item was changed:
>   CharacterScanner subclass: #DisplayScanner
> +       instanceVariableNames: 'bitBlt lineY foregroundColor
> backgroundColor fillBlt paragraphColor morphicOffset ignoreColorChanges
> lastDisplayableIndex'
> -       instanceVariableNames: 'bitBlt lineY foregroundColor
> backgroundColor fillBlt paragraphColor morphicOffset ignoreColorChanges'
>         classVariableNames: ''
>         poolDictionaries: ''
>         category: 'Graphics-Text'!
>
> + !DisplayScanner commentStamp: 'nice 10/9/2013 02:33' prior: 0!
> - !DisplayScanner commentStamp: 'nice 10/9/2013 02:22' prior: 0!
>   A DisplayScanner displays characters on Screen or other Form with help
> of a BitBlt.
>
>   Instance Variables
>         backgroundColor:                <Color>
>         bitBlt:         <BitBlt>
>         fillBlt:                <BitBlt>
>         foregroundColor:                <Color>
>         ignoreColorChanges:             <Boolean>
> +       lastDisplayableIndex:           <Integer>
>         lineY:          <Number>
>         morphicOffset:          <Point>
>         paragraphColor:         <Color>
>
>   backgroundColor
>         - the background color for displaying text.
>         Note that this can be set to Color transparent, in which case no
> background is displayed.
>
>   bitBlt
>         - the object which knows how to copy bits from one Form (the font
> glyph data) to another (the destination Form)
>
>   fillBlt
>         - another object for copying form bits, initialized for displaying
> the background.
>
>   foregroundColor
>         - the foreground color for displaying text
>
>   ignoreColorChanges
>         - indicates that any change of color specified in text attributes
> shall be ignored.
>         This is used for displaying text in a shadow mode, when dragging
> text for example.
>
> + lastDisplayableIndex
> +       - the index of last character to be displayed.
> +       A different index than lastIndex is required in order to avoid
> display of control characters.
> +       This variable must be updated by the stop condition at each inner
> scan loop.
> +
>   lineY
>         - the distance between destination form top and current line top
>
>   morphicOffset
>         - an offset for positionning the embedded morphs.
>         THE EXACT SPECIFICATION YET REMAINS TO BE WRITTEN
>
>   paragraphColor
>         - the default foreground color for displaying text in absence of
> other text attributes specification
>   !
>
> Item was changed:
>   ----- Method: DisplayScanner>>cr (in category 'stop conditions') -----
>   cr
>         "When a carriage return is encountered, simply increment the
> pointer
>         into the paragraph."
>
>         pendingKernX := 0.
> +       lastDisplayableIndex := lastIndex - 1.
>         (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 changed:
>   ----- Method: DisplayScanner>>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 rectangle since
> it is in
> -       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 advanceIfFirstCharOfLine.
> +       lastDisplayableIndex := lastIndex - 1.
>         ^ true !
>
> 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 lineHeight |
>         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 := leftMargin.
>         fillBlt == nil ifFalse:
>                 ["Not right"
>                 fillBlt destX: line left destY: lineY
>                         width: line width left height: lineHeight;
> copyBits].
> +       lastDisplayableIndex := lastIndex := line first.
> -       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 at destY.
>
>                 "find the end of this portion of the line"
>                 stopCondition := self scanCharactersFrom: lastIndex to:
> runStopIndex
>                                                 in: string rightX:
> rightMargin stopConditions: stopConditions
>                                                 kern: kern.
> +
> +               "Dsiplay a character that crosses the right margin if
> first char of the line"
> +               stopCondition == #crossedX ifTrue: [self
> advanceIfFirstCharOfLine].
> +
> -
>                 "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
>         ] whileFalse.
>         ^ runStopIndex - lastIndex   "Number of characters remaining in
> the current run"!
>
> Item was changed:
>   ----- Method: DisplayScanner>>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 |
> +       lastDisplayableIndex := lastIndex.
>         lastIndex = line last ifTrue: [^true].
>         runLength := text runLengthFor: (lastIndex := lastIndex + 1).
>         runStopIndex := lastIndex + (runLength - 1) min: line last.
>         self setStopConditions.
>         ^ false!
>
> Item was changed:
>   ----- Method: DisplayScanner>>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."
>
> +       lastDisplayableIndex := lastIndex - 1.
>         spaceCount := spaceCount + 1.
>         destX := destX + spaceWidth + kern + (line justifiedPadFor:
> spaceCount font: font).
>         lastIndex := lastIndex + 1.
>         pendingKernX := 0.
>         ^ false!
>
> Item was changed:
>   ----- Method: DisplayScanner>>tab (in category 'stop conditions') -----
>   tab
> +       lastDisplayableIndex := lastIndex - 1.
>         self plainTab.
>         lastIndex := lastIndex + 1.
>         ^ false!
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20131009/fb5d39bd/attachment.htm


More information about the Squeak-dev mailing list