From 447665261cc4a9ace4edc49858cb62769c1ba7ec Mon Sep 17 00:00:00 2001 From: SantiagoBragagnolo Date: Tue, 7 Apr 2020 12:38:44 +0000 Subject: [PATCH] Commit before going to previous experiment. fed up of the scanner by the time being --- src/Grafoscopio/GrafoscopioComposer.class.st | 112 +++++++-- .../GrafoscopioDisplayScanner.class.st | 36 +-- .../GrafoscopioEditingArea.class.st | 7 +- src/Grafoscopio/GrafoscopioLine.class.st | 216 +++++++++++++----- src/Grafoscopio/GrafoscopioParagraph.class.st | 32 ++- .../GrafoscopioPillarASText.class.st | 69 +++--- ...arASTextStringProjectionDecorator.class.st | 13 +- .../GrafoscopioPillarTextAnnotator.class.st | 5 + src/Grafoscopio/PRLineBreak.extension.st | 10 + src/Grafoscopio/Text.extension.st | 6 + 10 files changed, 382 insertions(+), 124 deletions(-) create mode 100644 src/Grafoscopio/Text.extension.st diff --git a/src/Grafoscopio/GrafoscopioComposer.class.st b/src/Grafoscopio/GrafoscopioComposer.class.st index c3e96c9..5197a03 100644 --- a/src/Grafoscopio/GrafoscopioComposer.class.st +++ b/src/Grafoscopio/GrafoscopioComposer.class.st @@ -12,12 +12,7 @@ Class { { #category : #'as yet unclassified' } GrafoscopioComposer >> actualWidth [ - ^ 50 -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> calculateMaximumAmountOfCharactersToComposeStartingAt: anInteger [ - self shouldBeImplemented. + ^ (lines collect: [ :l | l approximateWidth ]) max ] { #category : #'as yet unclassified' } @@ -38,11 +33,47 @@ GrafoscopioComposer >> calculateMaximumAmountOfCharactersToComposeStartingAt: st ^ (container width / deltaX) * ((container height - startingY ) / deltaY ). ] +{ #category : #'as yet unclassified' } +GrafoscopioComposer >> charWidthForCharIndex: idx [ + | font | + text ifNil: [ ^ 1 ]. + font := styler + fontAt: + ((text runs at: idx) detect: [ :a | a isKindOf: TextFontChange ]) + fontNumber. + ^ font widthOf: (text at: idx) +] + +{ #category : #'as yet unclassified' } +GrafoscopioComposer >> composeLinesFrom: from to: to [ + | genLines width charWidth lastAdded maxWidth | + genLines := OrderedCollection new. + width := 0. + lastAdded := from. + maxWidth := container width. + + from to: to do: [ :i | + charWidth := self charWidthForCharIndex: i. + width + charWidth > maxWidth + ifTrue: [ genLines + add: + (GrafoscopioLine new + from: lastAdded + to: i - 1 + text: text + styler: styler; + yourself). + lastAdded := i. + width := 0 + ]. + width := width + charWidth + ]. + ^ genLines +] + { #category : #'as yet unclassified' } GrafoscopioComposer >> composeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines atY: startingY [ - | maxChars | - stop > 0 - ifTrue: [ self haltOnce ]. + | maxChars stackedY bounding | " we set the lines collection " lines := lineColl. " we do calculate the size of an average " @@ -56,11 +87,28 @@ GrafoscopioComposer >> composeLinesFrom: start to: stop delta: delta into: lineC text allSegmentsOfLinesUpTo: [: from : to | from > maxChars] collect: [ :from :to | GrafoscopioLine new from: from to: to]. for this we should implement #allSegmentsOfLinesUpTo:collect: " + stackedY := startingY. self assert: stop - start < maxChars. + bounding := container. + text + allSegmentsOfLinesDo: [ :from :to | + | h | + (self composeLinesFrom: from to: to) + do: [ :line | + lines add: line. + h := line height. + line + bounds: + (bounding origin x @ stackedY + corner: bounding corner x @ (stackedY + h)). + stackedY := stackedY + h ] ]. lines - addAll: - (text - allSegmentsOfLinesCollect: [ :from :to | GrafoscopioLine new from: from to: to ]) + ifEmpty: [ lines + add: + (GrafoscopioLine new + from: 1 to: 1; + bounds: (0 @ 0 corner: 0 @ 0); + yourself) ] ] { #category : #'as yet unclassified' } @@ -79,13 +127,45 @@ GrafoscopioComposer >> emphasisHere: anObject [ ] { #category : #'as yet unclassified' } -GrafoscopioComposer >> lineIndexForPoint: aPoint [ - ^ 1 +GrafoscopioComposer >> fastFindFirstLineIndexSuchThat: lineBlock [ + "Perform a binary search of the lines array and return the index + of the first element for which lineBlock evaluates as true. + This assumes the condition is one that goes from false to true for + increasing line numbers (as, eg, yval > somey or start char > somex). + If lineBlock is not true for any element, return size+1." + | index low high | + low := 1. + high := lines size. + [index := high + low // 2. + low > high] + whileFalse: + [(lineBlock value: (lines at: index)) + ifTrue: [high := index - 1] + ifFalse: [low := index + 1]]. + ^ low ] { #category : #'as yet unclassified' } -GrafoscopioComposer >> lineIndexOfCharacterIndex: anInteger [ - ^ 1 +GrafoscopioComposer >> lineIndexForPoint: aPoint [ + "Answer the index of the line in which to select the character nearest to aPoint." + | i py | + py := aPoint y truncated. + "Find the first line at this y-value" + i := (self fastFindFirstLineIndexSuchThat: [:line | line bottom > py]) min: self lines size. + + "Now find the first line at this x-value" + [i < self lines size and: [(self lines at: i+1) top = (self lines at: i) top + and: [aPoint x >= (self lines at: i+1) left]]] + whileTrue: [i := i + 1]. + ^ i +] + +{ #category : #'as yet unclassified' } +GrafoscopioComposer >> lineIndexOfCharacterIndex: characterIndex [ + ^ (self + fastFindFirstLineIndexSuchThat: + [ :line | line first >= characterIndex and: [ line last <= characterIndex ] ]) + - 1 max: 1 ] { #category : #'as yet unclassified' } diff --git a/src/Grafoscopio/GrafoscopioDisplayScanner.class.st b/src/Grafoscopio/GrafoscopioDisplayScanner.class.st index db4256b..5d8ff43 100644 --- a/src/Grafoscopio/GrafoscopioDisplayScanner.class.st +++ b/src/Grafoscopio/GrafoscopioDisplayScanner.class.st @@ -72,7 +72,7 @@ GrafoscopioDisplayScanner >> addKern: kernDelta [ { #category : #'stop conditions' } GrafoscopioDisplayScanner >> cr [ - "When a carriage return is encountered, simply increment the pointer +"When a carriage return is encountered, simply increment the pointer into the paragraph." pendingKernX := 0. (lastIndex < text size and: [(text at: lastIndex) = Character cr and: [(text at: lastIndex+1) = Character lf]]) @@ -105,33 +105,32 @@ GrafoscopioDisplayScanner >> displayEmbeddedForm: aForm [ ] { #category : #scanning } -GrafoscopioDisplayScanner >> displayLine: textLine offset: offset leftInRun: leftInRun [ +GrafoscopioDisplayScanner >> displayLine: textLine offset: offset [ "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 baselineY lastPos bundle | + | stopCondition baselineY lastPos bundle | + offset traceCr. line := textLine. morphicOffset := offset. lineY := textLine top + offset y. - rightMargin := textLine rightMargin + offset x. + rightMargin := (textLine rightMargin + offset x). lastIndex := textLine first. - leftInRun <= 0 ifTrue: [self setStopConditions]. + self setStopConditions. leftMargin := (textLine leftMarginForAlignment: alignment) + offset x. destX := runX := leftMargin. self fillTextBackgroundAt: lineY . - lastIndex := textLine first. - leftInRun <= 0 - ifTrue: [nowLeftInRun := text runLengthFor: lastIndex] - ifFalse: [nowLeftInRun := leftInRun]. - baselineY := lineY + textLine baseline. + baselineY := lineY + textLine baseline. destY := baselineY - font ascent. - runStopIndex := lastIndex + (nowLeftInRun - 1) min: textLine last. + runStopIndex := textLine last. spaceCount := 0. [ - startIndex := lastIndex. + lastPos := destX@destY. + destY = 388 ifTrue: [ self haltOnce ]. + lastPos traceCr. bundle := textLine scanAndDrawCharactersFrom: lastIndex to: runStopIndex in: text rightX: rightMargin stopConditions: stopConditions kern: kern firstDestX:destX style: textStyle on: bitBlt at: lastPos withBaseline: baselineY. @@ -139,13 +138,15 @@ GrafoscopioDisplayScanner >> displayLine: textLine offset: offset leftInRun: lef stopCondition := bundle second. pendingKernX := bundle third. destX := bundle fourth. + "textLine display: text textStyle: textStyle on: bitBlt at: lastPos startDrawingAt: destX withBaseline: baselineY from: startIndex upTo: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1]) ." " textLine display: text with: font with: kern on: bitBlt at: lastPos destX: destX baseline: baselineY startIndex: startIndex lastIndex:(stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1]) emphasisCode: emphasisCode." self perform: stopCondition. ] whileFalse. - ^ runStopIndex - lastIndex "Number of characters remaining in the current run" + + ^ {stopCondition . runStopIndex - lastIndex} "Number of characters remaining in the current run" ] { #category : #scanning } @@ -172,7 +173,7 @@ GrafoscopioDisplayScanner >> endOfRun [ 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]. + lastIndex >=( line last - 1) ifTrue: [^true]. runX := destX. runLength := text runLengthFor: (lastIndex := lastIndex + 1). runStopIndex := lastIndex + (runLength - 1) min: line last. @@ -197,7 +198,7 @@ GrafoscopioDisplayScanner >> initialize [ { #category : #'multilingual scanning' } GrafoscopioDisplayScanner >> isBreakableAt: index in: sourceString in: encodingClass [ - ^ false. + ^ encodingClass isBreakableAt: index in: sourceString. ] @@ -403,6 +404,11 @@ GrafoscopioDisplayScanner >> textColor: textColor [ foregroundColor := textColor ] +{ #category : #'as yet unclassified' } +GrafoscopioDisplayScanner >> textStyle [ + ^ textStyle +] + { #category : #'multilingual scanning' } GrafoscopioDisplayScanner >> widthOf: char inFont: aFont [ diff --git a/src/Grafoscopio/GrafoscopioEditingArea.class.st b/src/Grafoscopio/GrafoscopioEditingArea.class.st index afa5c92..6f35d75 100644 --- a/src/Grafoscopio/GrafoscopioEditingArea.class.st +++ b/src/Grafoscopio/GrafoscopioEditingArea.class.st @@ -13,7 +13,7 @@ GrafoscopioEditingArea >> drawSubmorphsOn: aCanvas [ submorphs isEmpty ifTrue: [^self]. drawBlock := [:canvas | submorphs reverseDo: [:m | canvas fullDrawMorph: m]]. self clipSubmorphs - ifTrue: [aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock] + ifTrue: [aCanvas clipBy: (aCanvas clipRect intersect: self clippingBounds ifNone: [ ^ self ]) during: drawBlock] ifFalse: [drawBlock value: aCanvas]. "Draw the focus here since we are using inset bounds for the focus rectangle." @@ -36,3 +36,8 @@ GrafoscopioEditingArea >> privateInstantiateParagraphObject [ ^ RubOpeningClosingDelimiterDecorator next: GrafoscopioParagraph new. ] + +{ #category : #private } +GrafoscopioEditingArea >> wrapped [ + ^ true. +] diff --git a/src/Grafoscopio/GrafoscopioLine.class.st b/src/Grafoscopio/GrafoscopioLine.class.st index ca43990..a740d25 100644 --- a/src/Grafoscopio/GrafoscopioLine.class.st +++ b/src/Grafoscopio/GrafoscopioLine.class.st @@ -4,6 +4,9 @@ Class { #instVars : [ 'from', 'to', + 'bounds', + 'text', + 'styler', 'fontCode', 'lastUsedConfiguration' ], @@ -11,54 +14,78 @@ Class { } { #category : #'as yet unclassified' } -GrafoscopioLine >> baseline [ - ^ 10 +GrafoscopioLine >> approximateWidth [ + | runs | + text ifNil: [ ^ 1 ]. + runs := text runs. + ^ ((self first to: self last) + collect: [ :r | + (styler + fontAt: ((runs at: r) detect: [ :a | a isKindOf: TextFontChange ]) fontNumber) + widthOf: $A ]) max * self size * 1.2 ] { #category : #'as yet unclassified' } +GrafoscopioLine >> baseline [ + | runs | + text ifNil:[^0] . + runs := text runs. + ^ ((self first to: self last) + collect: [ :r | + (styler + fontAt: ((runs at: r) detect: [ :a | a isKindOf: TextFontChange ]) fontNumber) + ascent ]) max +] + +{ #category : #accessing } GrafoscopioLine >> bottom [ - ^ 10 + ^ bounds bottom +] + +{ #category : #accessing } +GrafoscopioLine >> bottomRight [ + ^ bounds bottomRight ] { #category : #'as yet unclassified' } -GrafoscopioLine >> bottomRight [ - ^ self right@ self bottom +GrafoscopioLine >> bounds: aRectangle [ + bounds := aRectangle ] { #category : #'as yet unclassified' } -GrafoscopioLine >> configurationFor: text with: style at: lastIndex [ +GrafoscopioLine >> configurationFor: aText with: style at: lastIndex [ | attributes | - attributes := text attributesAt: lastIndex forStyle: style. + attributes := aText attributesAt: lastIndex forStyle: style. (lastUsedConfiguration isNotNil and: [lastUsedConfiguration attributes = attributes ]) ifFalse: [ lastUsedConfiguration := GrafoscopioLineConfiguration new. - lastUsedConfiguration loadDefaultsFromStyle: style and: attributes. - . + lastUsedConfiguration loadDefaultsFromStyle: style and: attributes. ]. ^ lastUsedConfiguration . ] -{ #category : #'as yet unclassified' } -GrafoscopioLine >> display: text textStyle: style on: bitBlt at: lastPos startDrawingAt: destX withBaseline: baselineY from: startIndex upTo: lastIndex [ +{ #category : #accessing } +GrafoscopioLine >> display: aText textStyle: style on: bitBlt at: lastPos startDrawingAt: destX withBaseline: baselineY from: startIndex upTo: lastIndex [ | configuration kern font emphasisCode | - - configuration := self configurationFor: text with: style at: lastIndex . - - kern := configuration kern. + configuration := self + configurationFor: aText + with: style + at: lastIndex. + kern := configuration kern. font := configuration font. - emphasisCode := configuration emphasisCode. - - + emphasisCode := configuration emphasisCode. lastIndex >= startIndex - ifTrue: [ bitBlt - displayString: text string - from: startIndex - to: lastIndex + ifTrue: [ [ bitBlt + displayString: (aText extractStringFrom: startIndex to: lastIndex) + from: 1 + to: lastIndex - startIndex + 1 at: lastPos kern: kern baselineY: baselineY - font: font ]. + font: font ] + on: Error + do: [ :e | self halt ] ]. (emphasisCode allMask: 4) ifTrue: [ font displayUnderlineOn: bitBlt @@ -71,7 +98,7 @@ GrafoscopioLine >> display: text textStyle: style on: bitBlt at: lastPos startDr to: destX @ baselineY ] ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> first [ ^ from ] @@ -84,70 +111,112 @@ GrafoscopioLine >> fontCodeFor: aGrafoscopioPillarASText [ ^ fontCode ] -{ #category : #'as yet unclassified' } +{ #category : #'instance creation' } GrafoscopioLine >> from: anInteger to: anInteger2 [ from := anInteger. - to := anInteger2 + to := anInteger2. + bounds := 0@0 corner: 0@0 +] + +{ #category : #'instance creation' } +GrafoscopioLine >> from: anInteger to: anInteger2 text: aText styler: aStyler [ + aText ifNil: [ self halt ]. + self from: anInteger to: anInteger2. + text := aText. + styler := aStyler ] { #category : #'as yet unclassified' } GrafoscopioLine >> height [ - ^ 30 + | runs | + text ifNil:[^0] . + runs := text runs. + ^ ((self first to: self last) + collect: [ :r | + (styler + fontAt: ((runs at: r) detect: [ :a | a isKindOf: TextFontChange ]) fontNumber) + height ]) max ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } +GrafoscopioLine >> heightForWidth: aWidth [ + | onelineWidth onlineHeight| + onelineWidth := self width. + onlineHeight := self height. + aWidth > onelineWidth ifTrue: [ ^ onlineHeight ]. + + ^((onelineWidth /aWidth )roundUpTo: 1)* onlineHeight +] + +{ #category : #accessing } GrafoscopioLine >> last [ ^ to ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> left [ ^ 1 ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> leftMargin [ ^ self left ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> leftMarginForAlignment: anInteger [ - ^ 1 + ^ self left ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> lineHeight [ - ^ 30 + ^ self height ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> right [ - ^ 10000 + ^ self width ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> rightMargin [ ^ self right ] { #category : #'as yet unclassified' } -GrafoscopioLine >> scanAndDrawCharactersFrom: startIndex to: stopIndex in: text rightX: rightX stopConditions: stopConditions kern: kernDelta firstDestX:d style: textStyle on: bitBlt at: lastPos withBaseline: baselineY [ -|bundle lastIndex stopCondition destX | - - bundle := self scanCharactersFrom: startIndex to: stopIndex - in: text rightX: rightX stopConditions: stopConditions - kern: kernDelta firstDestX:d. - - lastIndex := bundle first. - stopCondition := bundle second. - destX := bundle fourth. - self display: text textStyle: textStyle on: bitBlt at: lastPos startDrawingAt: destX withBaseline: baselineY from: startIndex upTo: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1]) . - ^ bundle +GrafoscopioLine >> scanAndDrawCharactersFrom: startIndex to: stopIndex in: aText rightX: rightX stopConditions: stopConditions kern: kernDelta firstDestX: d style: textStyle on: bitBlt at: lastPos withBaseline: baselineY [ + | bundle lastIndex stopCondition destX | + [ bundle := self + scanCharactersFrom: startIndex + to: stopIndex + in: aText + rightX: rightX + stopConditions: stopConditions + kern: kernDelta + firstDestX: d. + lastIndex := bundle first. + stopCondition := bundle second. + destX := bundle fourth. + self + display: aText + textStyle: textStyle + on: bitBlt + at: lastPos + startDrawingAt: destX + withBaseline: baselineY + from: startIndex + upTo: + (stopCondition == #endOfRun + ifTrue: [ lastIndex ] + ifFalse: [ lastIndex - 1 ]). + ^ bundle ] + on: SubscriptOutOfBounds + do: [ :e | self halt ] ] { #category : #scanning } -GrafoscopioLine >> scanCharactersFrom: startIndex to: stopIndex in: text rightX: rightX stopConditions: stops kern: kernDelta firstDestX:d [ - | ascii encoding f nextDestX maxAscii startEncoding floatDestX widthAndKernedWidth nextChar atEndOfRun font lastIndex pendingKernX destX spaceWidth source | +GrafoscopioLine >> scanCharactersFrom: startIndex to: stopIndex in: aText rightX: rightX stopConditions: stops kern: kernDelta firstDestX:d [ + | ascii encoding f nextDestX maxAscii startEncoding floatDestX widthAndKernedWidth nextChar atEndOfRun font lastIndex pendingKernX destX source | source := text string. startIndex > stopIndex @@ -163,7 +232,6 @@ GrafoscopioLine >> scanCharactersFrom: startIndex to: stopIndex in: text rightX: on: Exception do: [:ex | nil]. f ifNil: [ f := font fontArray at: 1]. maxAscii := f maxAscii. - spaceWidth := f widthOf: Character space. ] ifFalse: [ maxAscii := font maxAscii. ]. @@ -176,7 +244,6 @@ GrafoscopioLine >> scanCharactersFrom: startIndex to: stopIndex in: text rightX: ascii := (source at: lastIndex) charCode. ascii > maxAscii ifTrue: [ascii := maxAscii]. (encoding = 0 and: [ascii < stops size and: [(stops at: ascii + 1) ~~ nil]]) ifTrue: [ - self haltOnce. ^ {lastIndex .(stops at: ascii + 1) . pendingKernX . destX }]. nextChar := (lastIndex + 1 <= stopIndex) @@ -206,22 +273,55 @@ GrafoscopioLine >> scanCharactersFrom: startIndex to: stopIndex in: text rightX: ^ {lastIndex . stops endOfRun . pendingKernX . destX } ] -{ #category : #'as yet unclassified' } +{ #category : #initialization } GrafoscopioLine >> setFont: anInteger [ fontCode := anInteger ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } GrafoscopioLine >> size [ ^ (self last - self first ) + 1 ] { #category : #'as yet unclassified' } +GrafoscopioLine >> string [ + ^ text extractStringFrom: from to: to +] + +{ #category : #accessing } GrafoscopioLine >> top [ - ^ 1 + ^ bounds top +] + +{ #category : #accessing } +GrafoscopioLine >> topLeft [ + ^ bounds topLeft ] { #category : #'as yet unclassified' } -GrafoscopioLine >> topLeft [ - ^ self left @ self top +GrafoscopioLine >> width [ + | string runs font | + text ifNil: [ ^1 ]. + string := self string. + runs := text runs. + ^ (1 to: self size) + inject: 0 + into: [ :acc :idx | + font := styler + fontAt: + ((runs at: idx) detect: [ :a | a isKindOf: TextFontChange ]) + fontNumber. + acc + (font widthOf: (string at: idx)) ] +] + +{ #category : #accessing } +GrafoscopioLine >> withThePrevious: anAmountOfCharacters [ + ^ anAmountOfCharacters = 0 + ifTrue: [ self ] + ifFalse: [ self class new + from: from - anAmountOfCharacters - 1 + to: to + text: text + styler: styler; + yourself ] ] diff --git a/src/Grafoscopio/GrafoscopioParagraph.class.st b/src/Grafoscopio/GrafoscopioParagraph.class.st index bc5bb81..df2a084 100644 --- a/src/Grafoscopio/GrafoscopioParagraph.class.st +++ b/src/Grafoscopio/GrafoscopioParagraph.class.st @@ -4,23 +4,47 @@ Class { #category : #'Grafoscopio-Rub' } +{ #category : #'accessing composer' } +GrafoscopioParagraph >> defaultEmptyText [ + ^ super defaultEmptyText +] + { #category : #'accessing composer' } GrafoscopioParagraph >> drawOn: aCanvas using: aDisplayScanner at: aPosition [ "Send all visible lines to the displayScanner for display" - | offset leftInRun line visibleRectangle | + | offset charactersLeft line visibleRectangle return | self drawingEnabled ifFalse: [ ^ self ]. visibleRectangle := aCanvas clipRect. + visibleRectangle setPoint: visibleRectangle origin point: visibleRectangle corner x @ 350. offset := (aPosition - self position) truncated. - leftInRun := 0. + charactersLeft := 0. (self lineIndexForPoint: visibleRectangle topLeft) to: (self lineIndexForPoint: visibleRectangle bottomRight) do: [ :i | line := self lines at: i. - line first <= line last - ifTrue: [ leftInRun := aDisplayScanner displayLine: line offset: offset leftInRun: leftInRun ] ] + return := aDisplayScanner displayLine: line offset: offset. + charactersLeft := return second. + ] +] + +{ #category : #'accessing composer' } +GrafoscopioParagraph >> move: anEvent for: model controller: editor [ + self traceCr: 'handle event' + "super move: anEvent for: model controller: editor." ] { #category : #'accessing composer' } GrafoscopioParagraph >> newComposer [ ^ GrafoscopioComposer new ] + +{ #category : #'accessing composer' } +GrafoscopioParagraph >> uptodateComposer [ + ^ self composer + text: self text; + textStyle: self textStyle; + container: self compositionRectangle; + emphasisHere: textArea emphasisHere; + cursorWidth: textArea cursorWidth; + yourself +] diff --git a/src/Grafoscopio/GrafoscopioPillarASText.class.st b/src/Grafoscopio/GrafoscopioPillarASText.class.st index 8fd5daf..844fd64 100644 --- a/src/Grafoscopio/GrafoscopioPillarASText.class.st +++ b/src/Grafoscopio/GrafoscopioPillarASText.class.st @@ -84,23 +84,36 @@ GrafoscopioPillarASText >> allRangesOfSubstring: aString [ { #category : #removing } GrafoscopioPillarASText >> allSegmentsOfLinesCollect: aBlock [ - | return | + | return chunk | return := OrderedCollection new. + chunk := OrderedCollection new. + " This method puts together many different nodes togehter into one line. Each line finishes with a breakline. The last one maybe not ." self - allTextNodesDo: - [ :node | return add: (aBlock value: node textStart value: node textStop) ]. + allTextNodesDo: [ :node | + chunk add: node. + node isLineBreak + ifTrue: [ return + add: (aBlock value: chunk first textStart value: chunk last textStop). + chunk removeAll ] ]. + chunk + ifNotEmpty: [ return + add: (aBlock value: chunk first textStart value: chunk last textStop) ]. ^ return ] { #category : #removing } GrafoscopioPillarASText >> allSegmentsOfLinesDo: aBlock [ - ^ self - allTextNodesDo: [ :node | aBlock value: node textStart value: node textStop ] -] - -{ #category : #'as yet unclassified' } -GrafoscopioPillarASText >> allTextNodes [ - ^ self allTextNodesFrom: ast + | chunk | + chunk := OrderedCollection new. + " This method puts together many different nodes togehter into one line. Each line finishes with a breakline. The last one maybe not ." + self + allTextNodesDo: [ :node | + chunk add: node. + node isLineBreak + ifTrue: [ aBlock value: chunk first textStart value: chunk last textStop. + chunk removeAll ] ]. + chunk + ifNotEmpty: [ aBlock value: chunk first textStart value: chunk last textStop ] ] { #category : #'as yet unclassified' } @@ -108,16 +121,6 @@ GrafoscopioPillarASText >> allTextNodesDo: aBlock [ ^ self allTextNodesFrom: ast do: aBlock ] -{ #category : #'as yet unclassified' } -GrafoscopioPillarASText >> allTextNodesFrom: aNode [ - ^ aNode hasChildren - ifFalse: [ aNode isTextOrLineBreak - ifTrue: [ {aNode} ] - ifFalse: [ {} ] ] - ifTrue: - [ aNode children flatCollect: [ :n | self allTextNodesFrom: n ] ] -] - { #category : #'as yet unclassified' } GrafoscopioPillarASText >> allTextNodesFrom: aNode do: aBlock [ ^ aNode hasChildren @@ -141,7 +144,7 @@ GrafoscopioPillarASText >> ast: aPRDocument [ GrafoscopioPillarASText >> at: anInteger [ | node | - (anInteger > self size or: [ anInteger < 1 ]) + (anInteger > (self size +1 ) or: [ anInteger < 1 ]) ifTrue: [ ^ self errorSubscriptBounds: anInteger ]. node := self detectAstNodeFor: anInteger in: ast. @@ -182,8 +185,8 @@ GrafoscopioPillarASText >> detectAstNodesBetween: from and: to in: aNode [ childrenStream := aNode children readStream. children := OrderedCollection new. - [ childrenStream atEnd not and: [ (currentNode :=childrenStream next) textStart < to ] ] whileTrue:[ - currentNode textStart >= from ifTrue: [ + [ childrenStream atEnd not and: [ (currentNode :=childrenStream next) textStart <= to ] ] whileTrue:[ + ((currentNode textStart >= from) or: [ currentNode textStop >= from ]) ifTrue: [ children addAll: (self detectAstNodesBetween: from and: to in: currentNode ) . ]. ]. @@ -191,12 +194,26 @@ GrafoscopioPillarASText >> detectAstNodesBetween: from and: to in: aNode [ ] { #category : #'as yet unclassified' } -GrafoscopioPillarASText >> extractStringFrom: aPoisition to: anOtherPosition [ +GrafoscopioPillarASText >> extractStringFrom: aPosition to: anOtherPosition [ + | from to nodes preffix suffix | + nodes := self detectAstNodesBetween: aPosition and: anOtherPosition in: ast. + from := (aPosition - nodes first textStart +1 ) . + nodes size = 1 ifTrue: [ + ^ nodes first text copyFrom: from to: from + anOtherPosition - aPosition . + ]. + to := nodes last textStop - anOtherPosition + 1. + + preffix := nodes first text copyFrom: from to: nodes first textSize. + suffix := nodes last text copyFrom: 1 to: to. ^ String streamContents: [ :str | - (self detectAstNodesBetween: aPoisition and: anOtherPosition in: ast) + str nextPutAll: preffix. + (nodes copyFrom: 2 to: nodes size) inject: str - into: [ :stream :each | stream nextPutAll: each text . stream ] ] + into: [ :stream :each | + stream nextPutAll: each text. + stream ]. + str nextPutAll: suffix ] ] { #category : #'as yet unclassified' } diff --git a/src/Grafoscopio/GrafoscopioPillarASTextStringProjectionDecorator.class.st b/src/Grafoscopio/GrafoscopioPillarASTextStringProjectionDecorator.class.st index 55d5e92..f532efa 100644 --- a/src/Grafoscopio/GrafoscopioPillarASTextStringProjectionDecorator.class.st +++ b/src/Grafoscopio/GrafoscopioPillarASTextStringProjectionDecorator.class.st @@ -3,7 +3,8 @@ Class { #superclass : #GrafoscopioPillarASTextStringDecorator, #instVars : [ 'from', - 'to' + 'to', + 'cached' ], #category : #'Grafoscopio-Pillar' } @@ -14,9 +15,13 @@ GrafoscopioPillarASTextStringProjectionDecorator >> allRangesOfSubstring: aStrin ] { #category : #accessing } -GrafoscopioPillarASTextStringProjectionDecorator >> at: anInteger [ - from + anInteger > to ifTrue: [ ^ self error: ' out of bounds ' ]. - ^ super at: from + anInteger +GrafoscopioPillarASTextStringProjectionDecorator >> at: anInteger [ + ^ self cached at: anInteger +] + +{ #category : #accessing } +GrafoscopioPillarASTextStringProjectionDecorator >> cached [ + ^ cached ifNil: [ cached := text extractStringFrom: from to: to ] ] { #category : #'as yet unclassified' } diff --git a/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st b/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st index 49a1dcb..c526f34 100644 --- a/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st +++ b/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st @@ -71,6 +71,11 @@ GrafoscopioPillarTextAnnotator >> visitLineBreak: anObject [ ^ self visitText: anObject ] +{ #category : #'visiting-document' } +GrafoscopioPillarTextAnnotator >> visitLink: aLink [ + super visitLink: aLink +] + { #category : #'visiting-document' } GrafoscopioPillarTextAnnotator >> visitRaw: aTextObject [ self visitText: aTextObject diff --git a/src/Grafoscopio/PRLineBreak.extension.st b/src/Grafoscopio/PRLineBreak.extension.st index e8d22f8..9f52381 100644 --- a/src/Grafoscopio/PRLineBreak.extension.st +++ b/src/Grafoscopio/PRLineBreak.extension.st @@ -9,3 +9,13 @@ PRLineBreak >> isLineBreak [ PRLineBreak >> isTextOrLineBreak [ ^ true ] + +{ #category : #'*Grafoscopio' } +PRLineBreak >> text [ + ^ OSPlatform current lineEnding +] + +{ #category : #'*Grafoscopio' } +PRLineBreak >> textSize [ + ^ self text size +] diff --git a/src/Grafoscopio/Text.extension.st b/src/Grafoscopio/Text.extension.st new file mode 100644 index 0000000..a4c6da8 --- /dev/null +++ b/src/Grafoscopio/Text.extension.st @@ -0,0 +1,6 @@ +Extension { #name : #Text } + +{ #category : #'*Grafoscopio' } +Text >> allSegmentsOfLinesDo: aBlockClosure [ + +]