From 5bff95c6faf8058253253c024a2a0b31b9d96f29 Mon Sep 17 00:00:00 2001 From: SantiagoBragagnolo Date: Thu, 9 Apr 2020 13:01:20 +0000 Subject: [PATCH] More experiments --- .../GrafoscopioAbstractText.class.st | 18 +- src/Grafoscopio/GrafoscopioComposer.class.st | 194 -------- .../GrafoscopioDisplayScanner.class.st | 423 ------------------ .../GrafoscopioDisplayScanner2.class.st | 74 --- .../GrafoscopioEditingArea.class.st | 43 -- .../GrafoscopioFlatAttributeVisitor.class.st | 108 +++++ .../GrafoscopioFmtAnchorAsBody.class.st | 20 + .../GrafoscopioFmtAnchorOnTheLeft.class.st | 22 + .../GrafoscopioFmtBeginningLinebreak.class.st | 22 + .../GrafoscopioFmtDoubleLinebreak.class.st | 27 ++ .../GrafoscopioFmtEndingLinebreak.class.st | 27 ++ .../GrafoscopioFmtEndingSpace.class.st | 22 + .../GrafoscopioFmtUrlAsBody.class.st | 28 ++ src/Grafoscopio/GrafoscopioFormat.class.st | 47 ++ src/Grafoscopio/GrafoscopioLine.class.st | 327 -------------- .../GrafoscopioLineConfiguration.class.st | 59 --- src/Grafoscopio/GrafoscopioParagraph.class.st | 50 --- .../GrafoscopioPillarASText.class.st | 206 ++++++--- ...scopioPillarASTextStringDecorator.class.st | 5 + .../GrafoscopioPillarRuns.class.st | 70 +++ .../GrafoscopioPillarTextAnnotator.class.st | 58 +-- .../GrafoscopioPillarUIBuilder.class.st | 97 ---- .../GrafoscopioScrolledTextMorph.class.st | 18 - .../GrafoscopioTextFormatter.class.st | 110 +++++ src/Grafoscopio/PRDocumentItem.extension.st | 29 +- src/Grafoscopio/PRLineBreak.extension.st | 48 ++ src/Grafoscopio/PRLink.extension.st | 6 + src/Grafoscopio/PRText.extension.st | 45 ++ .../SpGrafoscopioTextPresenter.class.st | 11 - .../SpMorphicGrafoscopioTextAdapter.class.st | 39 -- 30 files changed, 788 insertions(+), 1465 deletions(-) delete mode 100644 src/Grafoscopio/GrafoscopioComposer.class.st delete mode 100644 src/Grafoscopio/GrafoscopioDisplayScanner.class.st delete mode 100644 src/Grafoscopio/GrafoscopioDisplayScanner2.class.st delete mode 100644 src/Grafoscopio/GrafoscopioEditingArea.class.st create mode 100644 src/Grafoscopio/GrafoscopioFlatAttributeVisitor.class.st create mode 100644 src/Grafoscopio/GrafoscopioFmtAnchorAsBody.class.st create mode 100644 src/Grafoscopio/GrafoscopioFmtAnchorOnTheLeft.class.st create mode 100644 src/Grafoscopio/GrafoscopioFmtBeginningLinebreak.class.st create mode 100644 src/Grafoscopio/GrafoscopioFmtDoubleLinebreak.class.st create mode 100644 src/Grafoscopio/GrafoscopioFmtEndingLinebreak.class.st create mode 100644 src/Grafoscopio/GrafoscopioFmtEndingSpace.class.st create mode 100644 src/Grafoscopio/GrafoscopioFmtUrlAsBody.class.st create mode 100644 src/Grafoscopio/GrafoscopioFormat.class.st delete mode 100644 src/Grafoscopio/GrafoscopioLine.class.st delete mode 100644 src/Grafoscopio/GrafoscopioLineConfiguration.class.st delete mode 100644 src/Grafoscopio/GrafoscopioParagraph.class.st create mode 100644 src/Grafoscopio/GrafoscopioPillarRuns.class.st delete mode 100644 src/Grafoscopio/GrafoscopioPillarUIBuilder.class.st delete mode 100644 src/Grafoscopio/GrafoscopioScrolledTextMorph.class.st create mode 100644 src/Grafoscopio/GrafoscopioTextFormatter.class.st create mode 100644 src/Grafoscopio/PRLink.extension.st delete mode 100644 src/Grafoscopio/SpGrafoscopioTextPresenter.class.st delete mode 100644 src/Grafoscopio/SpMorphicGrafoscopioTextAdapter.class.st diff --git a/src/Grafoscopio/GrafoscopioAbstractText.class.st b/src/Grafoscopio/GrafoscopioAbstractText.class.st index 74c601b..5158b86 100644 --- a/src/Grafoscopio/GrafoscopioAbstractText.class.st +++ b/src/Grafoscopio/GrafoscopioAbstractText.class.st @@ -7,6 +7,11 @@ Class { #category : #'Grafoscopio-Pillar' } +{ #category : #'as yet unclassified' } +GrafoscopioAbstractText >> allRangesOfSubstring: aString [ + ^ { } +] + { #category : #converting } GrafoscopioAbstractText >> asText [ ^ self @@ -30,11 +35,12 @@ GrafoscopioAbstractText >> attributesAt: characterIndex [ ] { #category : #accessing } -GrafoscopioAbstractText >> attributesAt: anInteger forStyle: aTextStyle [ - - | attributes | - self size = 0 - ifTrue: [^ Array with: (TextFontChange new fontNumber: aTextStyle defaultFontIndex)]. "null text tolerates access" +GrafoscopioAbstractText >> attributesAt: anInteger forStyle: aTextStyle [ + | attributes size | + size := self size. + (size = 0 or: [ size < anInteger ]) + ifTrue: [ ^ Array + with: (TextFontChange new fontNumber: aTextStyle defaultFontIndex) ]. "null text tolerates access" attributes := self runs at: anInteger. ^ attributes ] @@ -93,7 +99,7 @@ GrafoscopioAbstractText >> replaceFrom: anInteger to: anInteger2 with: aCollecti { #category : #emphasis } GrafoscopioAbstractText >> runLengthFor: characterIndex [ - ^ self runs runLengthAt: characterIndex + ^ self runs runLengthFor: characterIndex ] { #category : #accessing } diff --git a/src/Grafoscopio/GrafoscopioComposer.class.st b/src/Grafoscopio/GrafoscopioComposer.class.st deleted file mode 100644 index 5197a03..0000000 --- a/src/Grafoscopio/GrafoscopioComposer.class.st +++ /dev/null @@ -1,194 +0,0 @@ -Class { - #name : #GrafoscopioComposer, - #superclass : #Object, - #instVars : [ - 'text', - 'styler', - 'container', - 'lines' - ], - #category : #'Grafoscopio-Rub' -} - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> actualWidth [ - ^ (lines collect: [ :l | l approximateWidth ]) max -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> calculateMaximumAmountOfCharactersToComposeStartingAt: startingY contemplating: delta [ - - | deltaX deltaY | - - " This method is mean to restrict the amount of text to be processed. For knowing how much of the text is going to be processed, we calculate the size of a minimal character with the default font. - This strategy is not really the best, since we should check with the smallest font used in the text instead of using the default. - But by the time being this code should beenough, knowning that for a text drawn in a scrolled area we have almost infinite space. We should mind this bug first then come back . - - " - - deltaX := delta + (((styler fontAt: styler defaultFontIndex) linearWidthOf: $.) roundDownTo: 1). - deltaY := (styler fontAt: styler defaultFontIndex) height. - - - ^ (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 stackedY bounding | - " we set the lines collection " - lines := lineColl. - " we do calculate the size of an average " - maxChars := self - calculateMaximumAmountOfCharactersToComposeStartingAt: startingY - contemplating: delta. - " we should care about really fragmenting the composittion once we have this assert failling - should be enough to stop the inspection of the tree nodes once the from > maxChars. - something like: - - 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 - ifEmpty: [ lines - add: - (GrafoscopioLine new - from: 1 to: 1; - bounds: (0 @ 0 corner: 0 @ 0); - yourself) ] -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> container: aRectangle [ - container := aRectangle -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> cursorWidth: anInteger [ - -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> emphasisHere: anObject [ - self assert: (anObject isNil or: [ anObject isArray ]) -] - -{ #category : #'as yet unclassified' } -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 >> 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' } -GrafoscopioComposer >> lines [ - ^ lines ifNil: [ lines := { GrafoscopioLine new }] -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> replaceFrom: anInteger to: anInteger2 with: aCollection [ - -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> text [ - ^ text -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> text: aCollection [ - text := aCollection -] - -{ #category : #'as yet unclassified' } -GrafoscopioComposer >> textStyle: aTextStyle [ - styler := aTextStyle -] diff --git a/src/Grafoscopio/GrafoscopioDisplayScanner.class.st b/src/Grafoscopio/GrafoscopioDisplayScanner.class.st deleted file mode 100644 index 5d8ff43..0000000 --- a/src/Grafoscopio/GrafoscopioDisplayScanner.class.st +++ /dev/null @@ -1,423 +0,0 @@ -Class { - #name : #GrafoscopioDisplayScanner, - #superclass : #Object, - #instVars : [ - 'destX', - 'lastIndex', - 'stopConditions', - 'text', - 'textStyle', - 'alignment', - 'leftMargin', - 'rightMargin', - 'font', - 'line', - 'runStopIndex', - 'spaceCount', - 'spaceWidth', - 'emphasisCode', - 'kern', - 'pendingKernX', - 'bitBlt', - 'lineY', - 'runX', - 'foregroundColor', - 'fillBlt', - 'morphicOffset', - 'ignoreColorChanges', - 'destY' - ], - #classVars : [ - 'DefaultStopConditions', - 'PaddedSpaceCondition' - ], - #category : #'Grafoscopio-Rub' -} - -{ #category : #queries } -GrafoscopioDisplayScanner class >> defaultFont [ - ^ TextStyle defaultFont -] - -{ #category : #'class initialization' } -GrafoscopioDisplayScanner class >> initialize [ -" - RubCharacterScanner initialize -" - | a | - a := RubTextStopConditions new. - a at: 1 + 1 put: #embeddedObject. - a at: Character tab asciiValue + 1 put: #tab. - a at: Character cr asciiValue + 1 put: #cr. - a at: Character lf asciiValue + 1 put: #cr. - - DefaultStopConditions := a . - - PaddedSpaceCondition := a copy. - PaddedSpaceCondition at: Character space asciiValue + 1 put: #paddedSpace. - -] - -{ #category : #private } -GrafoscopioDisplayScanner >> addEmphasis: code [ - "Set the bold-ital-under-strike emphasis." - emphasisCode := emphasisCode bitOr: code -] - -{ #category : #private } -GrafoscopioDisplayScanner >> addKern: kernDelta [ - "Set the current kern amount." - kern := kern + kernDelta -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> cr [ -"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]]) - ifTrue: [lastIndex := lastIndex + 2] - ifFalse: [lastIndex := lastIndex + 1]. - ^false -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> 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 -] - -{ #category : #displaying } -GrafoscopioDisplayScanner >> displayEmbeddedForm: aForm [ - - aForm - displayOn: bitBlt destForm - at: destX @ (lineY + line baseline - aForm height) - clippingBox: bitBlt clipRect - rule: Form blend - fillColor: Color white -] - -{ #category : #scanning } -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 baselineY lastPos bundle | - offset traceCr. - line := textLine. - morphicOffset := offset. - lineY := textLine top + offset y. - rightMargin := (textLine rightMargin + offset x). - lastIndex := textLine first. - self setStopConditions. - leftMargin := (textLine leftMarginForAlignment: alignment) + offset x. - destX := runX := leftMargin. - self fillTextBackgroundAt: lineY . - lastIndex := textLine first. - - baselineY := lineY + textLine baseline. - destY := baselineY - font ascent. - - runStopIndex := textLine last. - spaceCount := 0. - - [ - - 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. - lastIndex := bundle first. - 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. - - ^ {stopCondition . runStopIndex - lastIndex} "Number of characters remaining in the current run" -] - -{ #category : #scanning } -GrafoscopioDisplayScanner >> 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 -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> 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 - 1) ifTrue: [^true]. - runX := destX. - runLength := text runLengthFor: (lastIndex := lastIndex + 1). - runStopIndex := lastIndex + (runLength - 1) min: line last. - self setStopConditions. - ^ false -] - -{ #category : #displaying } -GrafoscopioDisplayScanner >> fillTextBackgroundAt: aPosition [ - fillBlt == nil ifFalse: - ["Not right" - fillBlt destX: line left destY: aPosition - width: line width left height: line lineHeight; copyBits]. -] - -{ #category : #'multilingual scanning' } -GrafoscopioDisplayScanner >> initialize [ - super initialize. - destX := destY := leftMargin := 0 -] - -{ #category : #'multilingual scanning' } -GrafoscopioDisplayScanner >> isBreakableAt: index in: sourceString in: encodingClass [ - - ^ encodingClass isBreakableAt: index in: sourceString. - -] - -{ #category : #'text constants' } -GrafoscopioDisplayScanner >> justified [ - ^ 3 -] - -{ #category : #scanning } -GrafoscopioDisplayScanner >> leadingTab [ - "return true if only tabs lie to the left" - line first to: lastIndex do: - [:i | (text at: i) == Character tab ifFalse: [^ false]]. - ^ true -] - -{ #category : #scanning } -GrafoscopioDisplayScanner >> nextTabXFrom: anX [ - "Tab stops are distances from the left margin. Set the distance into the - argument, anX, normalized for the paragraph's left margin." - - | normalizedX tabX mx | - mx := 9999. - normalizedX := anX - leftMargin. - tabX := self tabWidth. - [ tabX <= normalizedX and: [ tabX < mx ] ] whileTrue: [ tabX := tabX + self tabWidth ]. - ^ tabX < mx - ifTrue: [ leftMargin + tabX min: rightMargin ] - ifFalse: [ rightMargin ] -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> 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 -] - -{ #category : #scanning } -GrafoscopioDisplayScanner >> placeEmbeddedObject: anchoredMorph [ - - anchoredMorph relativeTextAnchorPosition ifNotNil:[ - anchoredMorph position: - anchoredMorph relativeTextAnchorPosition + - (anchoredMorph owner bounds origin x @ 0) - - (0@morphicOffset y) + (0@lineY). - ^true - ]. - (self superPlaceEmbeddedObject: anchoredMorph) ifFalse: [^ false]. - anchoredMorph isMorph ifTrue: [ - anchoredMorph position: ((destX - anchoredMorph width)@lineY) - morphicOffset - ] ifFalse: [ - destY := lineY. - runX := destX. - anchoredMorph - displayOn: bitBlt destForm - at: destX - anchoredMorph width @ destY - clippingBox: bitBlt clipRect - rule: Form blend - fillColor: Color white - ]. - ^ true -] - -{ #category : #'multilingual scanning' } -GrafoscopioDisplayScanner >> registerBreakableIndex [ - - "Record left x and character index of the line-wrappable point. - The default implementation here does nothing." - - ^ false. - -] - -{ #category : #private } -GrafoscopioDisplayScanner >> setActualFont: aFont [ - "Set the basal font to an isolated font reference." - - font := aFont -] - -{ #category : #private } -GrafoscopioDisplayScanner >> setAlignment: style [ - alignment := style. - -] - -{ #category : #private } -GrafoscopioDisplayScanner >> setConditionArray: aSymbol [ - - aSymbol == #paddedSpace ifTrue: [^stopConditions := PaddedSpaceCondition "copy"]. - aSymbol == nil ifTrue: [^stopConditions := DefaultStopConditions "copy"]. - self error: 'undefined stopcondition for space character'. - -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> setFont [ - | priorFont baselineY | - foregroundColor := Smalltalk ui theme textColor. - text ifNil:[ ^ self setActualFont: textStyle defaultFont ]. - - - "Set the font and other emphasis." - priorFont := font. - text == nil - ifFalse: [ - emphasisCode := 0. - kern := 0. - alignment := textStyle alignment. - font := nil. - (text attributesAt: lastIndex forStyle: textStyle) do: [ :att | att emphasizeScanner: self ] ]. - font == nil - ifTrue: [ self setActualFont: textStyle defaultFont ]. - 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: Character space. " map := font characterToGlyphMap." - stopConditions := DefaultStopConditions. - font installOn: bitBlt foregroundColor: foregroundColor backgroundColor: Color transparent. - text ifNotNil:[ - destY := lineY + line baseline - font ascent]. - -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> setFont: aNumber [ - - self setActualFont: (textStyle fontAt: aNumber) -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> 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" - -] - -{ #category : #'stop conditions' } -GrafoscopioDisplayScanner >> setStopConditions [ - "Set the font and the stop conditions for the current run." - self setFont. - self setConditionArray: (alignment = self justified ifTrue: [#paddedSpace]). - -" - alignment = self justified ifTrue: [ - stopConditions == DefaultStopConditions - ifTrue:[stopConditions := stopConditions copy]. - stopConditions at: Character space asciiValue + 1 put: #paddedSpace] -" -] - -{ #category : #scanning } -GrafoscopioDisplayScanner >> superPlaceEmbeddedObject: 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. - - ^ true -] - -{ #category : #private } -GrafoscopioDisplayScanner >> text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode [ - text := t. - textStyle := ts. - foregroundColor := foreColor. - backColor isTransparent - ifFalse: [ fillBlt := blt. - fillBlt fillColor: backColor ]. - ignoreColorChanges := shadowMode -] - -{ #category : #private } -GrafoscopioDisplayScanner >> textColor: textColor [ - ignoreColorChanges ifTrue: [^ self]. - foregroundColor := textColor -] - -{ #category : #'as yet unclassified' } -GrafoscopioDisplayScanner >> textStyle [ - ^ textStyle -] - -{ #category : #'multilingual scanning' } -GrafoscopioDisplayScanner >> widthOf: char inFont: aFont [ - - (char isMemberOf: CombinedChar) ifTrue: [ - ^ aFont widthOf: char base. - ] ifFalse: [ - ^ aFont widthOf: char. - ]. - - - -] diff --git a/src/Grafoscopio/GrafoscopioDisplayScanner2.class.st b/src/Grafoscopio/GrafoscopioDisplayScanner2.class.st deleted file mode 100644 index 5ec16ad..0000000 --- a/src/Grafoscopio/GrafoscopioDisplayScanner2.class.st +++ /dev/null @@ -1,74 +0,0 @@ -Class { - #name : #GrafoscopioDisplayScanner2, - #superclass : #Object, - #instVars : [ - 'text', - 'textStyle', - 'foregroundColor', - 'backgroundColor', - 'fillBlt', - 'ignoreColorChanges', - 'bitBlt' - ], - #category : #'Grafoscopio-Rub' -} - -{ #category : #private } -GrafoscopioDisplayScanner2 >> displayLine: line offset: offset leftInRun2: leftInRun [ - fillBlt == nil - ifFalse: [ "Not right" - fillBlt - destX: line left - destY: 100 - width: 300 - height: 30; - copyBits ]. - ^ line - display: text - on: bitBlt - with: offset - using: textStyle -] - -{ #category : #private } -GrafoscopioDisplayScanner2 >> displayLine: line offset: offset leftInRun: leftInRun [ - fillBlt == nil - ifFalse: [ "Not right" - fillBlt - destX: line left - destY: 100 - width: 300 - height: 30; - copyBits ]. - ^ line - display: text - on: bitBlt - with: offset - using: textStyle -] - -{ #category : #'reflective operations' } -GrafoscopioDisplayScanner2 >> doesNotUnderstand: something [ - - self halt. -] - -{ #category : #'as yet unclassified' } -GrafoscopioDisplayScanner2 >> 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" - -] - -{ #category : #private } -GrafoscopioDisplayScanner2 >> text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode [ - text := t. - textStyle := ts. - foregroundColor := foreColor. - fillBlt := blt. - (backgroundColor := backColor) isTransparent - ifFalse: [ fillBlt fillColor: backgroundColor ]. - ignoreColorChanges := shadowMode -] diff --git a/src/Grafoscopio/GrafoscopioEditingArea.class.st b/src/Grafoscopio/GrafoscopioEditingArea.class.st deleted file mode 100644 index 6f35d75..0000000 --- a/src/Grafoscopio/GrafoscopioEditingArea.class.st +++ /dev/null @@ -1,43 +0,0 @@ -Class { - #name : #GrafoscopioEditingArea, - #superclass : #RubEditingArea, - #category : #'Grafoscopio-Rub' -} - -{ #category : #private } -GrafoscopioEditingArea >> drawSubmorphsOn: aCanvas [ - -"Display submorphs back to front" - - | drawBlock | - 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] - ifFalse: [drawBlock value: aCanvas]. - "Draw the focus here since we are using inset bounds - for the focus rectangle." - aCanvas gfcParagraph: self paragraph bounds: self drawingBounds color: self textColor. - (scrollPane isNil and: [ self readOnly not and: [ self hasKeyboardFocus or: [ self hasFindReplaceFocus ] ] ]) - ifTrue: [self drawKeyboardFocusOn: aCanvas ] -] - -{ #category : #private } -GrafoscopioEditingArea >> newParagraph [ - | newParagraph | - newParagraph := self privateInstantiateParagraphObject. - newParagraph textArea: self. - newParagraph container: self compositionRectangle. - ^ newParagraph -] - -{ #category : #private } -GrafoscopioEditingArea >> privateInstantiateParagraphObject [ - ^ RubOpeningClosingDelimiterDecorator next: GrafoscopioParagraph new. - -] - -{ #category : #private } -GrafoscopioEditingArea >> wrapped [ - ^ true. -] diff --git a/src/Grafoscopio/GrafoscopioFlatAttributeVisitor.class.st b/src/Grafoscopio/GrafoscopioFlatAttributeVisitor.class.st new file mode 100644 index 0000000..3b0743b --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFlatAttributeVisitor.class.st @@ -0,0 +1,108 @@ +Class { + #name : #GrafoscopioFlatAttributeVisitor, + #superclass : #Object, + #instVars : [ + 'attributes', + 'level', + 'listLevel', + 'index' + ], + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> attributes [ + ^ attributes +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> index: anIndex [ + index := anIndex +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> initialize [ + super initialize. + level := 0 +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitCommentedLine: aPRCommentedLine [ + +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitDocument: aPRDocument [ + attributes := OrderedCollection new. + listLevel := 0 +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitExternalLink: aPRExternalLink [ + attributes + add: (TextColor new color: (Color fromHexString: '03A9F4')); + add: TextEmphasis underlined; + add: + (TextAction new + actOnClickBlock: [ self inform: 'Should be going to ' , aPRExternalLink reference ]) + +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitFigure: aPRFigure [ + +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitHeader: aPRHeader [ + level := level + 1. + attributes + add: + (TextFontReference + toFont: + (LogicalFont + familyName: 'Source Code Pro' + pointSize: ((20 - (level * 5)) max: 10))) +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitInternalLink: aPRInternalLink [ + self visitExternalLink: aPRInternalLink +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitLineBreak: aPRLineBreak [ +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitListItem: aPRListItem [ + aPRListItem textStart = index + ifTrue: [ + attributes + add: (TextIndent tabs: 2); + add: + (TextAnchor new + anchoredMorph: (self iconNamed: #menuPin); + yourself) ] +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitParagraph: aPRParagraph [ + "attributes + add: + (TextFontReference + toFont: + (LogicalFont + familyName: 'Source Code Pro' + pointSize: 10))" +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitText: aPRText [ + +] + +{ #category : #'as yet unclassified' } +GrafoscopioFlatAttributeVisitor >> visitUnorderedList: aPRUnorderedList [ + listLevel := listLevel + 1 . +] diff --git a/src/Grafoscopio/GrafoscopioFmtAnchorAsBody.class.st b/src/Grafoscopio/GrafoscopioFmtAnchorAsBody.class.st new file mode 100644 index 0000000..fdfdd33 --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFmtAnchorAsBody.class.st @@ -0,0 +1,20 @@ +Class { + #name : #GrafoscopioFmtAnchorAsBody, + #superclass : #GrafoscopioFmtUrlAsBody, + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'target resize' } +GrafoscopioFmtAnchorAsBody >> applyOn: aString from: textStart to: textStop [ + ^ model anchor +] + +{ #category : #'target resize' } +GrafoscopioFmtAnchorAsBody >> leftSize [ + ^ model anchor size - 1 +] + +{ #category : #'target resize' } +GrafoscopioFmtAnchorAsBody >> rightSize [ + ^ 0 +] diff --git a/src/Grafoscopio/GrafoscopioFmtAnchorOnTheLeft.class.st b/src/Grafoscopio/GrafoscopioFmtAnchorOnTheLeft.class.st new file mode 100644 index 0000000..7df1843 --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFmtAnchorOnTheLeft.class.st @@ -0,0 +1,22 @@ +Class { + #name : #GrafoscopioFmtAnchorOnTheLeft, + #superclass : #GrafoscopioFormat, + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'target resize' } +GrafoscopioFmtAnchorOnTheLeft >> applyOn: aString from: textStart to: textStop [ + ^ textStart = model textStart + ifTrue: [ (Character value: 1) asString , aString ] + ifFalse: [ aString ] +] + +{ #category : #'target resize' } +GrafoscopioFmtAnchorOnTheLeft >> leftSize [ + ^ 1 +] + +{ #category : #'target resize' } +GrafoscopioFmtAnchorOnTheLeft >> rightSize [ + ^ 0 +] diff --git a/src/Grafoscopio/GrafoscopioFmtBeginningLinebreak.class.st b/src/Grafoscopio/GrafoscopioFmtBeginningLinebreak.class.st new file mode 100644 index 0000000..e956010 --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFmtBeginningLinebreak.class.st @@ -0,0 +1,22 @@ +Class { + #name : #GrafoscopioFmtBeginningLinebreak, + #superclass : #GrafoscopioFormat, + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'target resize' } +GrafoscopioFmtBeginningLinebreak >> applyOn: aString from: textStart to: textStop [ + ^ textStart = model textStart + ifTrue: [ OSPlatform current lineEnding , aString ] + ifFalse: [ aString ] +] + +{ #category : #'target resize' } +GrafoscopioFmtBeginningLinebreak >> leftSize [ + ^ OSPlatform current lineEnding size +] + +{ #category : #'target resize' } +GrafoscopioFmtBeginningLinebreak >> rightSize [ + ^ 0 +] diff --git a/src/Grafoscopio/GrafoscopioFmtDoubleLinebreak.class.st b/src/Grafoscopio/GrafoscopioFmtDoubleLinebreak.class.st new file mode 100644 index 0000000..27952c0 --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFmtDoubleLinebreak.class.st @@ -0,0 +1,27 @@ +Class { + #name : #GrafoscopioFmtDoubleLinebreak, + #superclass : #GrafoscopioFormat, + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'target resize' } +GrafoscopioFmtDoubleLinebreak >> applyOn: aString from: textStart to: textStop [ + | return | + return := textStart = (model textStart) + ifTrue: [ OSPlatform current lineEnding , aString ] + ifFalse: [ aString ]. + return := textStop = model textStop + ifTrue: [ return , OSPlatform current lineEnding ] + ifFalse: [ aString ]. + ^ return +] + +{ #category : #'target resize' } +GrafoscopioFmtDoubleLinebreak >> leftSize [ + ^ OSPlatform current lineEnding size +] + +{ #category : #'target resize' } +GrafoscopioFmtDoubleLinebreak >> rightSize [ + ^ OSPlatform current lineEnding size +] diff --git a/src/Grafoscopio/GrafoscopioFmtEndingLinebreak.class.st b/src/Grafoscopio/GrafoscopioFmtEndingLinebreak.class.st new file mode 100644 index 0000000..378c1e7 --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFmtEndingLinebreak.class.st @@ -0,0 +1,27 @@ +Class { + #name : #GrafoscopioFmtEndingLinebreak, + #superclass : #GrafoscopioFormat, + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'target resize' } +GrafoscopioFmtEndingLinebreak >> applyOn: aString from: textStart to: textStop [ + ^ textStop = model textStop + ifTrue: [ aString , OSPlatform current lineEnding ] + ifFalse: [ aString ] +] + +{ #category : #'target resize' } +GrafoscopioFmtEndingLinebreak >> leftSize [ + ^ 0 +] + +{ #category : #'target resize' } +GrafoscopioFmtEndingLinebreak >> rightSize [ + ^ OSPlatform current lineEnding size +] + +{ #category : #'target resize' } +GrafoscopioFmtEndingLinebreak >> value: aString [ + ^aString , OSPlatform current lineEnding +] diff --git a/src/Grafoscopio/GrafoscopioFmtEndingSpace.class.st b/src/Grafoscopio/GrafoscopioFmtEndingSpace.class.st new file mode 100644 index 0000000..6d7e7fd --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFmtEndingSpace.class.st @@ -0,0 +1,22 @@ +Class { + #name : #GrafoscopioFmtEndingSpace, + #superclass : #GrafoscopioFormat, + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'target resize' } +GrafoscopioFmtEndingSpace >> applyOn: aString from: textStart to: textStop [ + ^ textStop = model textStop + ifTrue: [ aString , ' ' ] + ifFalse: [ aString ] +] + +{ #category : #'target resize' } +GrafoscopioFmtEndingSpace >> leftSize [ + ^ 0 +] + +{ #category : #'target resize' } +GrafoscopioFmtEndingSpace >> rightSize [ + ^ 1 +] diff --git a/src/Grafoscopio/GrafoscopioFmtUrlAsBody.class.st b/src/Grafoscopio/GrafoscopioFmtUrlAsBody.class.st new file mode 100644 index 0000000..8a99f15 --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFmtUrlAsBody.class.st @@ -0,0 +1,28 @@ +Class { + #name : #GrafoscopioFmtUrlAsBody, + #superclass : #GrafoscopioFormat, + #category : #'Grafoscopio-Pillar' +} + +{ #category : #'target resize' } +GrafoscopioFmtUrlAsBody >> applyOn: aString from: textStart to: textStop [ + ^ model reference +] + +{ #category : #'target resize' } +GrafoscopioFmtUrlAsBody >> beInstalledIn: anExternalLink [ + anExternalLink children isEmpty ifFalse: [ ^ self ]. + anExternalLink children: {(PRText new text: ' '; yourself)}. + super beInstalledIn: anExternalLink. + +] + +{ #category : #'target resize' } +GrafoscopioFmtUrlAsBody >> leftSize [ + ^ model reference size - 1 +] + +{ #category : #'target resize' } +GrafoscopioFmtUrlAsBody >> rightSize [ + ^ 0 +] diff --git a/src/Grafoscopio/GrafoscopioFormat.class.st b/src/Grafoscopio/GrafoscopioFormat.class.st new file mode 100644 index 0000000..da6215e --- /dev/null +++ b/src/Grafoscopio/GrafoscopioFormat.class.st @@ -0,0 +1,47 @@ +Class { + #name : #GrafoscopioFormat, + #superclass : #Object, + #instVars : [ + 'model' + ], + #classInstVars : [ + 'instance' + ], + #category : #'Grafoscopio-Pillar' +} + +{ #category : #accessing } +GrafoscopioFormat class >> instance [ + ^ instance ifNil: [ instance := self new ] +] + +{ #category : #'target resize' } +GrafoscopioFormat >> applyOn: aString from: textStart to: textStop [ + self subclassResponsibility +] + +{ #category : #'target resize' } +GrafoscopioFormat >> beInstalledIn: aNode [ + + aNode installFormat: (self copy model: aNode; yourself ) +] + +{ #category : #'target resize' } +GrafoscopioFormat >> leftSize [ + ^ self subclassResponsibility +] + +{ #category : #'as yet unclassified' } +GrafoscopioFormat >> model: aPRHeader [ + model := aPRHeader +] + +{ #category : #'target resize' } +GrafoscopioFormat >> rightSize [ + ^ self subclassResponsibility +] + +{ #category : #'target resize' } +GrafoscopioFormat >> size [ + ^ self leftSize + self rightSize +] diff --git a/src/Grafoscopio/GrafoscopioLine.class.st b/src/Grafoscopio/GrafoscopioLine.class.st deleted file mode 100644 index a740d25..0000000 --- a/src/Grafoscopio/GrafoscopioLine.class.st +++ /dev/null @@ -1,327 +0,0 @@ -Class { - #name : #GrafoscopioLine, - #superclass : #Object, - #instVars : [ - 'from', - 'to', - 'bounds', - 'text', - 'styler', - 'fontCode', - 'lastUsedConfiguration' - ], - #category : #'Grafoscopio-Rub' -} - -{ #category : #'as yet unclassified' } -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 [ - ^ bounds bottom -] - -{ #category : #accessing } -GrafoscopioLine >> bottomRight [ - ^ bounds bottomRight -] - -{ #category : #'as yet unclassified' } -GrafoscopioLine >> bounds: aRectangle [ - bounds := aRectangle -] - -{ #category : #'as yet unclassified' } -GrafoscopioLine >> configurationFor: aText with: style at: lastIndex [ - | attributes | - attributes := aText attributesAt: lastIndex forStyle: style. - (lastUsedConfiguration isNotNil and: [lastUsedConfiguration attributes = attributes ]) ifFalse: [ - lastUsedConfiguration := GrafoscopioLineConfiguration new. - lastUsedConfiguration loadDefaultsFromStyle: style and: attributes. - ]. - ^ lastUsedConfiguration . - - -] - -{ #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: aText - with: style - at: lastIndex. - kern := configuration kern. - font := configuration font. - emphasisCode := configuration emphasisCode. - lastIndex >= startIndex - ifTrue: [ [ bitBlt - displayString: (aText extractStringFrom: startIndex to: lastIndex) - from: 1 - to: lastIndex - startIndex + 1 - at: lastPos - kern: kern - baselineY: baselineY - font: font ] - on: Error - do: [ :e | self halt ] ]. - (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 ] -] - -{ #category : #accessing } -GrafoscopioLine >> first [ - ^ from -] - -{ #category : #'as yet unclassified' } -GrafoscopioLine >> fontCodeFor: aGrafoscopioPillarASText [ - fontCode - ifNil: [ (aGrafoscopioPillarASText runs at: self first) - do: [ :d | d emphasizeScanner: self ] ]. - ^ fontCode -] - -{ #category : #'instance creation' } -GrafoscopioLine >> from: anInteger to: anInteger2 [ - from := anInteger. - 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 [ - | 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 : #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 : #accessing } -GrafoscopioLine >> left [ - ^ 1 -] - -{ #category : #accessing } -GrafoscopioLine >> leftMargin [ - ^ self left -] - -{ #category : #accessing } -GrafoscopioLine >> leftMarginForAlignment: anInteger [ - ^ self left -] - -{ #category : #accessing } -GrafoscopioLine >> lineHeight [ - ^ self height -] - -{ #category : #accessing } -GrafoscopioLine >> right [ - ^ self width -] - -{ #category : #accessing } -GrafoscopioLine >> rightMargin [ - ^ self right -] - -{ #category : #'as yet unclassified' } -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: 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 - ifTrue: [ lastIndex := stopIndex. - ^ {lastIndex . stops endOfRun . 0 . d } ]. - lastIndex := startIndex. - startEncoding := (source at: startIndex) leadingChar. -" font := self fontFor: text at: startIndex." - destX := d . - font ifNil: [font := TextStyle defaultFont fontArray at: 1]. - font isFontSet ifTrue: [ - f := [font fontArray at: startEncoding + 1] - on: Exception do: [:ex | nil]. - f ifNil: [ f := font fontArray at: 1]. - maxAscii := f maxAscii. - ] ifFalse: [ - maxAscii := font maxAscii. - ]. - floatDestX := destX. - widthAndKernedWidth := Array new: 2. - atEndOfRun := false. - [lastIndex <= stopIndex] whileTrue: [ - encoding := (source at: lastIndex) leadingChar. - encoding ~= startEncoding ifTrue: [lastIndex := lastIndex - 1. ^ stops endOfRun]. - ascii := (source at: lastIndex) charCode. - ascii > maxAscii ifTrue: [ascii := maxAscii]. - (encoding = 0 and: [ascii < stops size and: [(stops at: ascii + 1) ~~ nil]]) ifTrue: [ - ^ {lastIndex .(stops at: ascii + 1) . pendingKernX . destX }]. - - nextChar := (lastIndex + 1 <= stopIndex) - ifTrue:[source 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 <= source size - ifTrue:[source at: lastIndex + 1] - ifFalse:[ nil]]. - font - widthAndKernedWidthOfLeft: (source at: lastIndex) - right: nextChar - into: widthAndKernedWidth. - nextDestX := floatDestX + (widthAndKernedWidth at: 1). - nextDestX > rightX ifTrue: [^ {lastIndex . stops crossedX . pendingKernX . destX }]. - 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. - ^ {lastIndex . stops endOfRun . pendingKernX . destX } -] - -{ #category : #initialization } -GrafoscopioLine >> setFont: anInteger [ - fontCode := anInteger -] - -{ #category : #accessing } -GrafoscopioLine >> size [ - ^ (self last - self first ) + 1 -] - -{ #category : #'as yet unclassified' } -GrafoscopioLine >> string [ - ^ text extractStringFrom: from to: to -] - -{ #category : #accessing } -GrafoscopioLine >> top [ - ^ bounds top -] - -{ #category : #accessing } -GrafoscopioLine >> topLeft [ - ^ bounds topLeft -] - -{ #category : #'as yet unclassified' } -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/GrafoscopioLineConfiguration.class.st b/src/Grafoscopio/GrafoscopioLineConfiguration.class.st deleted file mode 100644 index b93d1db..0000000 --- a/src/Grafoscopio/GrafoscopioLineConfiguration.class.st +++ /dev/null @@ -1,59 +0,0 @@ -Class { - #name : #GrafoscopioLineConfiguration, - #superclass : #Object, - #instVars : [ - 'emphasisCode', - 'kern', - 'alignment', - 'font', - 'attributes', - 'style' - ], - #category : #'Grafoscopio-Rub' -} - -{ #category : #'as yet unclassified' } -GrafoscopioLineConfiguration >> attributes [ - ^ attributes -] - -{ #category : #'as yet unclassified' } -GrafoscopioLineConfiguration >> emphasisCode [ - ^ emphasisCode -] - -{ #category : #'as yet unclassified' } -GrafoscopioLineConfiguration >> font [ - ^ font -] - -{ #category : #initialization } -GrafoscopioLineConfiguration >> initialize [ - super initialize. - emphasisCode := 0. - kern := 0. - -] - -{ #category : #'as yet unclassified' } -GrafoscopioLineConfiguration >> kern [ - ^ kern -] - -{ #category : #initialization } -GrafoscopioLineConfiguration >> loadDefaultsFromStyle: aStyle [ - alignment := aStyle alignment. -] - -{ #category : #'as yet unclassified' } -GrafoscopioLineConfiguration >> loadDefaultsFromStyle: aTextStyle and: aCollection [ - attributes := aCollection. - style := aTextStyle. - self loadDefaultsFromStyle: aTextStyle. - attributes do: [ : att | att emphasizeScanner: self ]. -] - -{ #category : #'as yet unclassified' } -GrafoscopioLineConfiguration >> setFont: aNumber [ - font := style fontAt: aNumber -] diff --git a/src/Grafoscopio/GrafoscopioParagraph.class.st b/src/Grafoscopio/GrafoscopioParagraph.class.st deleted file mode 100644 index df2a084..0000000 --- a/src/Grafoscopio/GrafoscopioParagraph.class.st +++ /dev/null @@ -1,50 +0,0 @@ -Class { - #name : #GrafoscopioParagraph, - #superclass : #RubParagraph, - #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 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. - charactersLeft := 0. - (self lineIndexForPoint: visibleRectangle topLeft) to: (self lineIndexForPoint: visibleRectangle bottomRight) do: [ :i | - line := self lines at: i. - 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 844fd64..6990c6d 100644 --- a/src/Grafoscopio/GrafoscopioPillarASText.class.st +++ b/src/Grafoscopio/GrafoscopioPillarASText.class.st @@ -7,7 +7,8 @@ Class { #instVars : [ 'ast', 'stringDecorator', - 'lastNode' + 'lastNode', + 'runs' ], #category : #'Grafoscopio-Pillar' } @@ -23,9 +24,8 @@ GrafoscopioPillarASText class >> openExample [ GrafoscopioPillarASText class >> pillarExample [ ^ PRPillarParser parse: - '!!我是三條 - About Pillar -!! + '!!About Pillar + Pillar is a system to manage documents (books, presentations, and web sites). From a common format, it is able to generate documents in multiple formats (html, markdown, latex, AsciiDoc). It is composed of several modules such as importers, transformers, document model and outputers. @@ -35,8 +35,9 @@ The original author of Pillar was Damien Cassou. Many people have also contribut This book adapts, extends, and clarifies the chapter explaining Pillar in the ''Enterprise Pharo: a Web Perspective'' book. Pillar was sponsored by *ESUG>http://www.esug.org*. - + !!!Introduction + Pillar (hosted at *http://github.com/pillar-markup*) is a markup language and associated tools to write and generate documentation, books (such as this one), web sites, and slide-based presentations. The Pillar screenshot in Figure *@voyageDocExample* shows the HTML version of chapter Voyage. +An example Pillar output>file://figures/voyageDocExample-small.png|label=voyageDocExample|width=60+ @@ -51,6 +52,7 @@ Pillar has many features, helpful tools, and documentation: !!!Pillar users + @pillarUSERS This book was written in Pillar itself. If you want to see how Pillar is used, have a look at its source code (*http://github.com/SquareBracketAssociates/Booklet-PublishingAPillarBooklet*), or check the following other real-world projects: @@ -60,9 +62,9 @@ This book was written in Pillar itself. If you want to see how Pillar is used, h - Any of the Pharo booklets (*https://github.com/SquareBracketAssociates/Booklet-XXXX*, - the PillarHub open-access shared blog (*http://pillarhub.pharocloud.com*). - + !!! Pillar future features - + Pillar 70 saw some major refactorings and cleaning: it does not rely on Grease and Magritte anymore. Its architecture is a lot cleaner. @@ -72,61 +74,16 @@ Still some issues are missing. Here is a little list of features that we are wor - Markdown syntax. - Release of Ecstatic. Pillar supports the deployment of web sites named Ecstatic and we are working on a second version of Ecstatic. - Better table support. - + !!! Conclusion + + Pillar is still in active development: maintainers keep improving its implementation. The current version of Pillar is Pillar 70. This booklet only documents Pillar 70. This booklet will be synchronised with future enhancements.' ] { #category : #'as yet unclassified' } -GrafoscopioPillarASText >> allRangesOfSubstring: aString [ - ^ { } -] - -{ #category : #removing } -GrafoscopioPillarASText >> allSegmentsOfLinesCollect: aBlock [ - | 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 | - 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 [ - | 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' } -GrafoscopioPillarASText >> allTextNodesDo: aBlock [ - ^ self allTextNodesFrom: ast do: aBlock -] - -{ #category : #'as yet unclassified' } -GrafoscopioPillarASText >> allTextNodesFrom: aNode do: aBlock [ - ^ aNode hasChildren - ifFalse: [ aNode isTextOrLineBreak - ifTrue: [ aBlock value: aNode ] ] - ifTrue: [ aNode children do: [ :n | self allTextNodesFrom: n do: aBlock ] ] +GrafoscopioPillarASText >> ast [ + ^ ast ] { #category : #'as yet unclassified' } @@ -144,11 +101,18 @@ GrafoscopioPillarASText >> ast: aPRDocument [ GrafoscopioPillarASText >> at: anInteger [ | node | + (anInteger > (self size +1 ) or: [ anInteger < 1 ]) ifTrue: [ ^ self errorSubscriptBounds: anInteger ]. node := self detectAstNodeFor: anInteger in: ast. - ^ node text at: anInteger - node textStart +1 + ^ node formattedText at: anInteger - node textStart +1 +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarASText >> attributesAt: characterIndex do: aBlockClosure [ + self size = 0 ifTrue:[^self]. + (self runs at: characterIndex) do: aBlockClosure ] { #category : #copying } @@ -163,24 +127,41 @@ GrafoscopioPillarASText >> copyFrom: from to: to [ yourself ] ] +{ #category : #'as yet unclassified' } +GrafoscopioPillarASText >> detectAstNodeFor: anInteger [ + ^ self detectAstNodeFor: anInteger in: ast +] + { #category : #'as yet unclassified' } GrafoscopioPillarASText >> detectAstNodeFor: anInteger in: aNode [ (lastNode isNotNil - and: [ anInteger between: lastNode textStart and: lastNode textStop ]) + and: [ anInteger between: lastNode textStart and: lastNode textStop -1 ]) ifTrue: [ ^ lastNode ]. (anInteger between: aNode textStart and: aNode textStop) ifFalse: [ self error: 'Cannot find a node for ' , anInteger asString ]. ^ aNode hasChildren ifTrue: [ aNode children - detect: [ :c | anInteger between: c textStart and: c textStop ] + detect: [ :c | anInteger between: c textStart and: c textStop -1 ] ifFound: [ :n | self detectAstNodeFor: anInteger in: n ] ifNone: [ self error: 'whut?' ] ] ifFalse: [ lastNode := aNode ] ] { #category : #'as yet unclassified' } -GrafoscopioPillarASText >> detectAstNodesBetween: from and: to in: aNode [ - | children childrenStream currentNode | +GrafoscopioPillarASText >> detectAstNodesBetween: from and: to in: aNode [ + | current nodes | + nodes := OrderedCollection new. + current := self detectAstNodeFor: from. + from > to + ifTrue: [ nodes add: current ] + ifFalse: [ [ current isNotNil and: [ current textStart <= to ] ] + whileTrue: [ nodes add: current. + current := current next ] ]. + ^ nodes + + + + "| children childrenStream currentNode | aNode hasChildren ifFalse: [ ^ {aNode} ]. childrenStream := aNode children readStream. children := OrderedCollection new. @@ -190,7 +171,24 @@ GrafoscopioPillarASText >> detectAstNodesBetween: from and: to in: aNode [ children addAll: (self detectAstNodesBetween: from and: to in: currentNode ) . ]. ]. - ^ children. + ^ children." +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarASText >> detectFullBranchFor: anId [ + ^ self detectFullBranchFor: anId in: ast. +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarASText >> detectFullBranchFor: anInteger in: aNode [ + (anInteger between: aNode textStart and: aNode textStop -1 ) + ifFalse: [ self error: 'Cannot find a node for ' , anInteger asString ]. + ^ aNode hasChildren + ifTrue: [ | sub | + sub := aNode children + detect: [ :c | anInteger between: c textStart and: c textStop -1 ]. + {aNode} , (self detectFullBranchFor: anInteger in: sub) ] + ifFalse: [ {aNode} ] ] { #category : #'as yet unclassified' } @@ -201,10 +199,10 @@ GrafoscopioPillarASText >> extractStringFrom: aPosition to: anOtherPosition [ nodes size = 1 ifTrue: [ ^ nodes first text copyFrom: from to: from + anOtherPosition - aPosition . ]. - to := nodes last textStop - anOtherPosition + 1. + to := nodes last textStop - anOtherPosition. - preffix := nodes first text copyFrom: from to: nodes first textSize. - suffix := nodes last text copyFrom: 1 to: to. + preffix := nodes first formattedText copyFrom: from to: nodes first textSize. + suffix := nodes last formattedText copyFrom: 1 to: to. ^ String streamContents: [ :str | str nextPutAll: preffix. @@ -216,6 +214,47 @@ GrafoscopioPillarASText >> extractStringFrom: aPosition to: anOtherPosition [ str nextPutAll: suffix ] ] +{ #category : #'as yet unclassified' } +GrafoscopioPillarASText >> fontAt: characterIndex withStyle: aTextStyle [ + "Answer the fontfor characters in the run beginning at characterIndex." + | attributes font | + self size = 0 ifTrue: [^ aTextStyle defaultFont]. "null text tolerates access" + attributes := runs at: characterIndex. + font := aTextStyle defaultFont. "default" + attributes do: + [:att | att forFontInStyle: aTextStyle do: [:f | font := f]]. + ^ font +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarASText >> rangeOf: aTextURL startingAt: anInteger [ + ^ self runs rangeOf: aTextURL startingAt: anInteger +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarASText >> reannotate: aPRText [ + | current previous size parents | + + aPRText textStop: aPRText textStart + aPRText formattedText size. + parents := Set new. + parents add: aPRText parent. + current := aPRText next. + + previous := aPRText. + + [ current isNotNil ] + whileTrue: [ + size := current textSize. + current textStart: previous textStop. + current textStop: current textStart + size. + previous := current. + current := current next. + self ]. + + + self resetRuns. +] + { #category : #'as yet unclassified' } GrafoscopioPillarASText >> removeAttribute: att from: start to: stop [ @@ -223,16 +262,41 @@ GrafoscopioPillarASText >> removeAttribute: att from: start to: stop [ { #category : #editing } GrafoscopioPillarASText >> replaceFrom: start to: stop with: aCollection [ - " Here we should be managing insertion and adding of text. " - self assert: aCollection isEmpty. + | nodes realStart realStop newText node | + aCollection ifEmpty: [ ^ self ]. + nodes := self detectAstNodesBetween: start and: stop in: ast. + self assert: nodes size = 1. + node := nodes first. + realStart := (start - (node textStart + node leftFormatSize) )+ 1 . + realStop := stop - (node textStart + node rightFormatSize) + 1 . + newText := (node text copyReplaceFrom: realStart to: realStop with: aCollection). + node isText ifTrue: [ + node text: newText + ] ifFalse: [ + (newText beginsWith: node text) ifTrue: [ + nodes := self detectAstNodesBetween: start - 1 and: start -1 in: ast. + nodes first text: nodes first text , (newText copyFrom: node text size to: newText size ). + ] ifFalse: [ + nodes first next text: (newText copyFrom: 1 to: newText size - node textSize) , nodes first text. + ] + ]. + self reannotate: nodes first. + +] +{ #category : #accessing } +GrafoscopioPillarASText >> resetRuns [ + ^ runs := GrafoscopioPillarRuns new + ast: self; + yourself ] { #category : #accessing } GrafoscopioPillarASText >> runs [ - ^ RunArray - new: self size - withAll: (Array with: (TextFontChange fontNumber: 1)) + ^ runs + ifNil: [ runs := GrafoscopioPillarRuns new + ast: self; + yourself ] ] { #category : #accessing } diff --git a/src/Grafoscopio/GrafoscopioPillarASTextStringDecorator.class.st b/src/Grafoscopio/GrafoscopioPillarASTextStringDecorator.class.st index 2e0feda..ff105fd 100644 --- a/src/Grafoscopio/GrafoscopioPillarASTextStringDecorator.class.st +++ b/src/Grafoscopio/GrafoscopioPillarASTextStringDecorator.class.st @@ -47,6 +47,11 @@ GrafoscopioPillarASTextStringDecorator >> size [ ^ text size ] +{ #category : #'as yet unclassified' } +GrafoscopioPillarASTextStringDecorator >> string [ + self shouldBeImplemented. +] + { #category : #accessing } GrafoscopioPillarASTextStringDecorator >> text: aGFPText [ text := aGFPText diff --git a/src/Grafoscopio/GrafoscopioPillarRuns.class.st b/src/Grafoscopio/GrafoscopioPillarRuns.class.st new file mode 100644 index 0000000..e403ca5 --- /dev/null +++ b/src/Grafoscopio/GrafoscopioPillarRuns.class.st @@ -0,0 +1,70 @@ +Class { + #name : #GrafoscopioPillarRuns, + #superclass : #Object, + #instVars : [ + 'ast', + 'lastBranch', + 'lastAttributes' + ], + #category : #'Grafoscopio-Pillar' +} + +{ #category : #accessing } +GrafoscopioPillarRuns >> ast: anAst [ + ast := anAst +] + +{ #category : #'basic api' } +GrafoscopioPillarRuns >> at: anIndex [ + | newBranch | + newBranch := ast detectFullBranchFor: anIndex. + newBranch = lastBranch + ifTrue: [ .^ lastAttributes ]. + lastBranch := newBranch. + ^ lastAttributes := self calculateAttributesForBranch: lastBranch at: anIndex +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarRuns >> calculateAttributesForBranch: aCollection at: anIndex [ + | visitor | + visitor := GrafoscopioFlatAttributeVisitor new. + visitor index: anIndex. + aCollection do: [ :n | n accept: visitor ]. + ^ visitor attributes +] + +{ #category : #'basic api' } +GrafoscopioPillarRuns >> isEmpty [ + ^ ast isNil or: [ ast isEmpty ] +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarRuns >> rangeOf: aTextURL startingAt: anInteger [ + self assert: (aTextURL isKindOf: TextAction). + + ((self at: anInteger) contains: [ : a | (a isKindOf: TextAction)]) ifTrue: [ + (ast extractStringFrom: anInteger to: (ast detectAstNodeFor: anInteger ) textStop) traceCr. + ^ anInteger to: (ast detectAstNodeFor: anInteger ) textStop + ]. + ^ 0 to: 0 +] + +{ #category : #'basic api' } +GrafoscopioPillarRuns >> reset [ + lastAttributes := nil. + lastBranch := nil. +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarRuns >> runLengthFor: anInteger [ + | node | + anInteger > ast size ifTrue: [ ^0 ]. + node := (ast detectAstNodeFor: anInteger). + ^ node textStop - anInteger. +] + +{ #category : #'as yet unclassified' } +GrafoscopioPillarRuns >> withStartStopAndValueDo: aBlockClosure [ +thisContext sender asString traceCr. + 'Should implement' traceCr. +] diff --git a/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st b/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st index c526f34..cf767da 100644 --- a/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st +++ b/src/Grafoscopio/GrafoscopioPillarTextAnnotator.class.st @@ -3,31 +3,22 @@ Class { #superclass : #PRVisitor, #instVars : [ 'texts', - 'lastStop', - 'stack' + 'formatter', + 'lastStop' ], #category : #'Grafoscopio-Pillar' } { #category : #'visiting-document' } -GrafoscopioPillarTextAnnotator >> initialize [ - super initialize. - texts := OrderedCollection new +GrafoscopioPillarTextAnnotator >> formatter: aFormatter [ + formatter := aFormatter ] { #category : #'visiting-document' } -GrafoscopioPillarTextAnnotator >> populateParentsOf: aSetOfParents [ - - | parents | - parents := Set new. - aSetOfParents do: [ : n | - parents add: n parent. - n parent propertyAt: #textStart ifAbsent: [ - n parent propertyAt: #textStart put: (n parent children first propertyAt: #textStart). - n parent propertyAt: #textStop put: (n parent children last propertyAt: #textStop). - ] - ]. - +GrafoscopioPillarTextAnnotator >> initialize [ + super initialize. + texts := OrderedCollection new. + formatter := GrafoscopioTextFormatter default. ] { #category : #'visiting-document' } @@ -43,27 +34,9 @@ GrafoscopioPillarTextAnnotator >> visitCommentedLine: aTextObject [ { #category : #'visiting-document' } GrafoscopioPillarTextAnnotator >> visitDocument: aDoc [ lastStop := 1 . + aDoc accept: formatter. super visitDocument: aDoc. -] - -{ #category : #'visiting-document' } -GrafoscopioPillarTextAnnotator >> visitDocumentGroup: aGroup [ - super visitDocumentGroup: aGroup. - "aGroup - propertyAt: #textStart - ifAbsent: [ - aGroup hasChildren - ifTrue: [ aGroup - propertyAt: #textStart - put: (aGroup children first propertyAt: #textStart). - aGroup - propertyAt: #textStop - put: (aGroup children last propertyAt: #textStop) ] - ifFalse: [ - aGroup propertyAt: #textStart put: 0 . - aGroup propertyAt: #textStop put: 0 - ] - ]" + ] { #category : #'visiting-document' } @@ -71,11 +44,6 @@ GrafoscopioPillarTextAnnotator >> visitLineBreak: anObject [ ^ self visitText: anObject ] -{ #category : #'visiting-document' } -GrafoscopioPillarTextAnnotator >> visitLink: aLink [ - super visitLink: aLink -] - { #category : #'visiting-document' } GrafoscopioPillarTextAnnotator >> visitRaw: aTextObject [ self visitText: aTextObject @@ -83,9 +51,9 @@ GrafoscopioPillarTextAnnotator >> visitRaw: aTextObject [ { #category : #'visiting-document' } GrafoscopioPillarTextAnnotator >> visitText: aTextObject [ + texts ifNotEmpty: [ texts last next: aTextObject ]. texts add: aTextObject. aTextObject propertyAt: #textStart put: lastStop. - aTextObject propertyAt: #textStop put: lastStop + aTextObject text size - 1. - lastStop := lastStop + aTextObject text size. - + lastStop := lastStop + aTextObject formattedText size. + aTextObject propertyAt: #textStop put: lastStop . ] diff --git a/src/Grafoscopio/GrafoscopioPillarUIBuilder.class.st b/src/Grafoscopio/GrafoscopioPillarUIBuilder.class.st deleted file mode 100644 index d1ab183..0000000 --- a/src/Grafoscopio/GrafoscopioPillarUIBuilder.class.st +++ /dev/null @@ -1,97 +0,0 @@ -Class { - #name : #GrafoscopioPillarUIBuilder, - #superclass : #PRVisitor, - #instVars : [ - 'stack', - 'document' - ], - #category : #'Grafoscopio-Pillar' -} - -{ #category : #'as yet unclassified' } -GrafoscopioPillarUIBuilder class >> openExample [ - ^ self new - build: self pillarExample; - openWithSpec -] - -{ #category : #'as yet unclassified' } -GrafoscopioPillarUIBuilder class >> pillarExample [ - ^ PRPillarParser - parse: - '!! About Pillar -!! -Pillar is a system to manage documents (books, presentations, and web sites). From a common format, it is able to generate documents in multiple formats (html, markdown, latex, AsciiDoc). -It is composed of several modules such as importers, transformers, document model and outputers. - -This book describes Pillar in its current version 7.0. Pillar is currently developed and masintained by Stéphane Ducasse and Guillermo Polito. -The original author of Pillar was Damien Cassou. Many people have also contributed to Pillar: Ben Coman, Guillermo Polito, Lukas Renggli (original author of the PierCMS from which a first version of Pillar has been extracted), Benjamin van Ryseghem, Cyril Ferlicot-Delbecque, Thibault Arloing, Yann Dubois, Quentin Ducasse and Asbathou Sama Biyalou. Special thanks to Asbathou Sama Biyalou! - -This book adapts, extends, and clarifies the chapter explaining Pillar in the ''Enterprise Pharo: a Web Perspective'' book. - -Pillar was sponsored by *ESUG>http://www.esug.org*. - -!!!Introduction -Pillar (hosted at *http://github.com/pillar-markup*) is a markup language and associated tools to write and generate documentation, books (such as this one), web sites, and slide-based presentations. The Pillar screenshot in Figure *@voyageDocExample* shows the HTML version of chapter Voyage. - -+An example Pillar output>file://figures/voyageDocExample-small.png|label=voyageDocExample|width=60+ - -Pillar has many features, helpful tools, and documentation: -- simple markup syntax with references, tables, pictures, captions, syntax-highlighted code blocks; -- export documents to HTML, LaTeX, Markdown, AsciiDoc, ePuB and Pillar itself, and presentations to Beamer and Deck.js; -%- customization of the export through a dedicated STON configuration file (see chapter Missing Chapter *@cha:ston*) and Mustache templates (see chapter *@templating*). -- many tests with good coverage (94% with more than a 2100 executed tests), which are regularly run by a *continuous integration job>https://ci.inria.fr/pharo-contribution/job/Pillar* -- a command-line interface and dedicated plugins for several text editors: *Emacs>https://github.com/pillar-markup/pillar-mode*, *Vim>https://github.com/cdlm/vim-pillar*, *TextMate>https://github.com/Uko/Pillar.tmbundle*, and *Atom>https://github.com/Uko/language-pillar* -- a cheat sheet (see Chapter *@chacheat*). - - -!!!Pillar users -@pillarUSERS - -This book was written in Pillar itself. If you want to see how Pillar is used, have a look at its source code (*http://github.com/SquareBracketAssociates/Booklet-PublishingAPillarBooklet*), or check the following other real-world projects: - -- the Updated Pharo by Example book (*https://github.com/SquareBracketAssociates/UpdatedPharoByExample*), -- the Pharo MOOC - Massive open online course (*https://github.com/SquareBracketAssociates/PharoMooc*, -- Any of the Pharo booklets (*https://github.com/SquareBracketAssociates/Booklet-XXXX*, -- the PillarHub open-access shared blog (*http://pillarhub.pharocloud.com*). - - -!!! Pillar future features - -Pillar 70 saw some major refactorings and cleaning: it does not rely on Grease and Magritte anymore. -Its architecture is a lot cleaner. - -Still some issues are missing. Here is a little list of features that we are working on or will soon: - -- Incremental recompilation. Since we remove the use of make (so that Windows users can use Pillar) we should introduce a way to avoid to recompile complete book when just one chapter changed. -- Markdown syntax. -- Release of Ecstatic. Pillar supports the deployment of web sites named Ecstatic and we are working on a second version of Ecstatic. -- Better table support. - -!!! Conclusion -Pillar is still in active development: maintainers keep improving its implementation. The current version of Pillar is Pillar 70. This booklet only documents Pillar 70. This booklet will be synchronised with future enhancements.' -] - -{ #category : #'as yet unclassified' } -GrafoscopioPillarUIBuilder >> build: aPRDocument [ - stack := Stack new. - aPRDocument accept: self. - -] - -{ #category : #'as yet unclassified' } -GrafoscopioPillarUIBuilder >> openWithSpec [ - document openWithSpec. -] - -{ #category : #'as yet unclassified' } -GrafoscopioPillarUIBuilder >> visitDocument: aDocument [ - document ifNotNil: [ self error: 'whut?' ]. - document := SpTextPresenter new. - super visitDocument: aDocument -] - -{ #category : #'as yet unclassified' } -GrafoscopioPillarUIBuilder >> visitHeader: aHeader [ - aHeader level -] diff --git a/src/Grafoscopio/GrafoscopioScrolledTextMorph.class.st b/src/Grafoscopio/GrafoscopioScrolledTextMorph.class.st deleted file mode 100644 index dbee073..0000000 --- a/src/Grafoscopio/GrafoscopioScrolledTextMorph.class.st +++ /dev/null @@ -1,18 +0,0 @@ -Class { - #name : #GrafoscopioScrolledTextMorph, - #superclass : #RubScrolledTextMorph, - #instVars : [ - 'textAreaClass' - ], - #category : #'Grafoscopio-Rub' -} - -{ #category : #initialization } -GrafoscopioScrolledTextMorph >> textAreaClass [ - ^ textAreaClass ifNil: [ GrafoscopioEditingArea ] -] - -{ #category : #initialization } -GrafoscopioScrolledTextMorph >> textAreaClass: aClass [ - textAreaClass := aClass. -] diff --git a/src/Grafoscopio/GrafoscopioTextFormatter.class.st b/src/Grafoscopio/GrafoscopioTextFormatter.class.st new file mode 100644 index 0000000..5a2103b --- /dev/null +++ b/src/Grafoscopio/GrafoscopioTextFormatter.class.st @@ -0,0 +1,110 @@ +" +I am in charge of formatting a document in terms of text. +Our text model does not support break lines or tabbings as text attribute, but as text content. (By example, our header needs to have a line break before and after by default. This kind of things can be done in rubbric by adding the character cr. Still, our pillar AST does not have this breakline for the header, and we do not wan to add it, since it would affect the parsing. No, what we want is to be able to format and modify the text before returning it when being displayed, composed, scanned, etc. So for doing so we add the text formatter. +This text formatter contains a dictionary that allows the user to add as many as needed for each class. +This class provides as extention point: + + #formatsFor: anObject > Returning a collection of formats for the given object (the default behaviour stores it by class). + #Redefine the specific visit methods for specific class behaviour. + + +) +" +Class { + #name : #GrafoscopioTextFormatter, + #superclass : #PRVisitor, + #instVars : [ + 'formats', + 'stack' + ], + #classInstVars : [ + 'default' + ], + #category : #'Grafoscopio-Pillar' +} + +{ #category : #accessing } +GrafoscopioTextFormatter class >> buildDefault [ + | new | + new := self new. + new registerFormat: GrafoscopioFmtDoubleLinebreak instance forClass: PRHeader. + new registerFormat: GrafoscopioFmtAnchorOnTheLeft instance forClass: PRListItem. + new registerFormat: GrafoscopioFmtBeginningLinebreak instance forClass: PRListItem. +" new registerFormat: GrafoscopioFmtEndingLinebreak instance forClass: PRParagraph ." + new registerFormat: GrafoscopioFmtBeginningLinebreak instance forClass: PRList. + new registerFormat: GrafoscopioFmtUrlAsBody instance forClass: PRExternalLink . + new registerFormat: GrafoscopioFmtEndingSpace instance forClass: PRExternalLink. + new registerFormat: GrafoscopioFmtUrlAsBody instance forClass: PRMailLink. + new registerFormat: GrafoscopioFmtEndingSpace instance forClass: PRMailLink. + new registerFormat: GrafoscopioFmtAnchorAsBody instance forClass: PRInternalLink. + new registerFormat: GrafoscopioFmtEndingSpace instance forClass: PRInternalLink. + ^ new +] + +{ #category : #accessing } +GrafoscopioTextFormatter class >> buildEmpty [ + | new | + new := self new. + + ^ new +] + +{ #category : #accessing } +GrafoscopioTextFormatter class >> default [ + ^ self buildDefault +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> format: aNode [ + (self formatsFor: aNode) do: [ :f | f beInstalledIn: aNode ]. +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> formatsFor: aNode [ + ^ formats at: aNode ifAbsent: [ self formatsForClass: aNode class ] +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> formatsForClass: aNodeClass [ + ^ formats at: aNodeClass ifAbsent: [ Array empty ] +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> initialize [ + super initialize . + formats := Dictionary new. + stack := Stack new. +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> registerFormat: aFormat for: aNode [ + ^ (formats at: aNode ifAbsentPut: [ OrderedCollection new ]) + add: aFormat +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> registerFormat: aFormat forClass: aNodeClass [ + ^ self registerFormat: aFormat for: aNodeClass +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> visitDocument: aDocument [ + self assert: stack isEmpty. + super visitDocument: aDocument. + self assert: stack isEmpty +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> visitDocumentGroup: aNode [ + aNode parent: (stack ifNotEmpty: [stack first] ifEmpty:[ nil ]). + self format: aNode. + stack push: aNode. + super visitDocumentGroup: aNode. + stack pop +] + +{ #category : #initialization } +GrafoscopioTextFormatter >> visitDocumentItem: anItem [ + self format: anItem. + anItem parent: stack first. +] diff --git a/src/Grafoscopio/PRDocumentItem.extension.st b/src/Grafoscopio/PRDocumentItem.extension.st index 0185e34..f05cd6f 100644 --- a/src/Grafoscopio/PRDocumentItem.extension.st +++ b/src/Grafoscopio/PRDocumentItem.extension.st @@ -1,5 +1,17 @@ Extension { #name : #PRDocumentItem } +{ #category : #'*Grafoscopio' } +PRDocumentItem >> formats [ + | ancestors | + ancestors := (self parent ifNil: [ {} ] ifNotNil: [ self parent formats ]). + ^ ancestors , (self propertyAt: #gfpFormat ifAbsent: [ Array empty ]) +] + +{ #category : #'*Grafoscopio' } +PRDocumentItem >> installFormat: aFormat [ + (self propertyAt: #gfpFormat ifAbsentPut: [ OrderedCollection new ]) add: aFormat. +] + { #category : #'*Grafoscopio' } PRDocumentItem >> isLineBreak [ ^ false @@ -11,17 +23,18 @@ PRDocumentItem >> isTextOrLineBreak [ ] { #category : #'*Grafoscopio' } -PRDocumentItem >> textSize [ - ^ self textStop - self textStart +PRDocumentItem >> parent [ + ^ self propertyAt: #parent ifAbsent: [ nil ] ] { #category : #'*Grafoscopio' } -PRDocumentItem >> textStart [ - ^ self - propertyAt: #textStart - ifAbsent: [ self hasChildren - ifTrue: [ self children first textStart ] - ifFalse: [ 0 ] ] +PRDocumentItem >> parent: aParent [ + self propertyAt: #parent put: aParent +] + +{ #category : #'*Grafoscopio' } +PRDocumentItem >> textSize [ + ^ self textStop - self textStart ] { #category : #'*Grafoscopio' } diff --git a/src/Grafoscopio/PRLineBreak.extension.st b/src/Grafoscopio/PRLineBreak.extension.st index 9f52381..f55808a 100644 --- a/src/Grafoscopio/PRLineBreak.extension.st +++ b/src/Grafoscopio/PRLineBreak.extension.st @@ -1,5 +1,10 @@ Extension { #name : #PRLineBreak } +{ #category : #'*Grafoscopio' } +PRLineBreak >> formattedText [ + ^ OSPlatform current lineEnding +] + { #category : #'*Grafoscopio' } PRLineBreak >> isLineBreak [ ^ true @@ -10,12 +15,55 @@ PRLineBreak >> isTextOrLineBreak [ ^ true ] +{ #category : #'*Grafoscopio' } +PRLineBreak >> leftFormatSize [ + ^ self formats + inject: 0 + into: [ :acc :f | acc + f leftSize ] +] + +{ #category : #'*Grafoscopio' } +PRLineBreak >> next [ + ^ self propertyAt: #next ifAbsent: [ nil ] +] + +{ #category : #'*Grafoscopio' } +PRLineBreak >> next: aText [ + self propertyAt: #next put: aText +] + +{ #category : #'*Grafoscopio' } +PRLineBreak >> rightFormatSize [ + ^ self formats + inject: 0 + into: [ :acc :f | acc + f rightSize ] +] + { #category : #'*Grafoscopio' } PRLineBreak >> text [ ^ OSPlatform current lineEnding ] +{ #category : #'*Grafoscopio' } +PRLineBreak >> text: aString [ + self shouldBeImplemented. +] + { #category : #'*Grafoscopio' } PRLineBreak >> textSize [ ^ self text size ] + +{ #category : #'*Grafoscopio' } +PRLineBreak >> textStart: aValue [ + ^ self + propertyAt: #textStart + put: aValue +] + +{ #category : #'*Grafoscopio' } +PRLineBreak >> textStop: aValue [ + ^ self + propertyAt: #textStop + put: aValue +] diff --git a/src/Grafoscopio/PRLink.extension.st b/src/Grafoscopio/PRLink.extension.st new file mode 100644 index 0000000..12d4fc5 --- /dev/null +++ b/src/Grafoscopio/PRLink.extension.st @@ -0,0 +1,6 @@ +Extension { #name : #PRLink } + +{ #category : #'*Grafoscopio' } +PRLink >> children: aCollection [ + children := aCollection +] diff --git a/src/Grafoscopio/PRText.extension.st b/src/Grafoscopio/PRText.extension.st index 595c79b..d2fcd80 100644 --- a/src/Grafoscopio/PRText.extension.st +++ b/src/Grafoscopio/PRText.extension.st @@ -1,6 +1,51 @@ Extension { #name : #PRText } +{ #category : #'*Grafoscopio' } +PRText >> formattedText [ + ^ self formats + inject: self text + into: [ :acc :f | f applyOn: acc from: self textStart to: self textStop ] +] + { #category : #'*Grafoscopio' } PRText >> isTextOrLineBreak [ ^ true ] + +{ #category : #'*Grafoscopio' } +PRText >> leftFormatSize [ + ^ self formats + inject: 0 + into: [ :acc :f | acc + f leftSize ] +] + +{ #category : #'*Grafoscopio' } +PRText >> next [ + ^ self propertyAt: #next ifAbsent: [ nil ] +] + +{ #category : #'*Grafoscopio' } +PRText >> next: aText [ + self propertyAt: #next put: aText. +] + +{ #category : #'*Grafoscopio' } +PRText >> rightFormatSize [ + ^ self formats + inject: 0 + into: [ :acc :f | acc + f rightSize ] +] + +{ #category : #'*Grafoscopio' } +PRText >> textStart: aValue [ + ^ self + propertyAt: #textStart + put: aValue +] + +{ #category : #'*Grafoscopio' } +PRText >> textStop: aValue [ + ^ self + propertyAt: #textStop + put: aValue +] diff --git a/src/Grafoscopio/SpGrafoscopioTextPresenter.class.st b/src/Grafoscopio/SpGrafoscopioTextPresenter.class.st deleted file mode 100644 index 51c7ecf..0000000 --- a/src/Grafoscopio/SpGrafoscopioTextPresenter.class.st +++ /dev/null @@ -1,11 +0,0 @@ -Class { - #name : #SpGrafoscopioTextPresenter, - #superclass : #SpTextPresenter, - #category : #'Grafoscopio-Rub' -} - -{ #category : #specs } -SpGrafoscopioTextPresenter class >> adapterName [ - - ^ #SpMorphicGrafoscopioTextAdapter -] diff --git a/src/Grafoscopio/SpMorphicGrafoscopioTextAdapter.class.st b/src/Grafoscopio/SpMorphicGrafoscopioTextAdapter.class.st deleted file mode 100644 index e71a2dd..0000000 --- a/src/Grafoscopio/SpMorphicGrafoscopioTextAdapter.class.st +++ /dev/null @@ -1,39 +0,0 @@ -Class { - #name : #SpMorphicGrafoscopioTextAdapter, - #superclass : #SpMorphicTextAdapter, - #category : #'Grafoscopio-Rub' -} - -{ #category : #factory } -SpMorphicGrafoscopioTextAdapter >> buildWidget [ - | newWidget | - newWidget := (self widgetClass on: self) - getTextSelector: #getText; - setTextSelector: #accept:notifying:; - getSelectionSelector: #readSelection; - menuProvider: self selector: #codePaneMenu:shifted:; - setSelectionSelector: #setSelection:; - ghostText: self placeholder; - beWrapped; - enabled: self enabled; - askBeforeDiscardingEdits: self askBeforeDiscardingEdits; - autoAccept: self autoAccept; - vResizing: #spaceFill; - hResizing: #spaceFill; - setBalloonText: self help; - dragEnabled: self dragEnabled; - dropEnabled: self dropEnabled; - registerScrollChanges: #scrollValueChanged:; - yourself. - self setEditingModeFor: newWidget. - self presenter - whenTextChangedDo: [ :text | self setText: text to: newWidget ]. - self presenter - whenPlaceholderChangedDo: [ :text | self setGhostText: text to: newWidget ]. - ^ newWidget -] - -{ #category : #factory } -SpMorphicGrafoscopioTextAdapter >> widgetClass [ - ^ GrafoscopioScrolledTextMorph -]