Levente Uzonyi uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-ul.298.mcz
==================== Summary ====================
Name: EToys-ul.298
Author: ul
Time: 27 April 2017, 1:02:38.02162 pm
UUID: d4ecbed2-60da-4651-b11b-b6ecd27bee67
Ancestors: EToys-nice.297
- removed some of the extension methods, mostly those which have already been removed from the Trunk
- removed #fixTemps sends
- use the generic quicksort implementation in ChessMoveList
=============== Diff against EToys-nice.297 ===============
Item was removed:
- ----- Method: Behavior>>indexIfCompact (in category '*Etoys-Squeakland-private') -----
- indexIfCompact
- "If these 5 bits are non-zero, then instances of this class
- will be compact. It is crucial that there be an entry in
- Smalltalk compactClassesArray for any class so optimized.
- See the msgs becomeCompact and becomeUncompact."
- ^ (format bitShift: -11) bitAnd: 16r1F
- "
- Smalltalk compactClassesArray doWithIndex:
- [:c :i | c == nil ifFalse:
- [c indexIfCompact = i ifFalse: [self halt]]]
- "!
Item was changed:
----- Method: BroomMorph>>filter: (in category 'accessing') -----
filter: aBlock
"Set my acceptance filter. aBlock should return true for all Morphs to be moved"
+ filter := aBlock!
- filter := aBlock fixTemps!
Item was removed:
- ----- Method: ByteString>>primitiveFindSubstring:in:startingAt:matchTable: (in category '*Etoys-Squeakland-comparing') -----
- primitiveFindSubstring: key in: body startingAt: start matchTable: matchTable
- "Answer the index in the string body at which the substring key first occurs, at or beyond start. The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches. If no match is found, zero will be returned.
-
- The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter."
- | index |
- <primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
- <var: #key declareC: 'unsigned char *key'>
- <var: #body declareC: 'unsigned char *body'>
- <var: #matchTable declareC: 'unsigned char *matchTable'>
-
- key size = 0 ifTrue: [^ 0].
- start to: body size - key size + 1 do:
- [:startIndex |
- index := 1.
- [(matchTable at: (body at: startIndex+index-1) asciiValue + 1)
- = (matchTable at: (key at: index) asciiValue + 1)]
- whileTrue:
- [index = key size ifTrue: [^ startIndex].
- index := index+1]].
- ^ 0
- "
- ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1
- ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7
- ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0
- ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0
- ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7
- "!
Item was removed:
- ----- Method: Character>>asUnicodeChar (in category '*Etoys-Squeakland-converting') -----
- asUnicodeChar
- "@@@ FIXME: Make this use asUnicode and move it to its lonely sender @@@"
- | table charset v |
- self leadingChar = 0 ifTrue: [^ self asInteger].
- charset := EncodedCharSet charsetAt: self leadingChar.
- charset isCharset ifFalse: [^ self].
- table := charset ucsTable.
- table isNil ifTrue: [^ Character value: 16rFFFD].
-
- v := table at: self charCode + 1.
- v = -1 ifTrue: [^ Character value: 16rFFFD].
-
- ^ Character leadingChar: charset unicodeLeadingChar code: v.!
Item was removed:
- ----- Method: ChessMoveList>>sort:to:using: (in category 'sorting') -----
- sort: i to: j using: sorter
- "Sort elements i through j of self to be nondescending according to sorter."
-
- | di dij dj tt ij k l n |
- "The prefix d means the data at that index."
- (n := j + 1 - i) <= 1 ifTrue: [^self]. "Nothing to sort."
- "Sort di,dj."
- di := collection at: i.
- dj := collection at: j.
- (sorter sorts: di before: dj) ifFalse:["i.e., should di precede dj?"
- collection swap: i with: j.
- tt := di. di := dj. dj := tt].
- n > 2 ifTrue:["More than two elements."
- ij := (i + j) // 2. "ij is the midpoint of i and j."
- dij := collection at: ij. "Sort di,dij,dj. Make dij be their median."
- (sorter sorts: di before: dij) ifTrue:["i.e. should di precede dij?"
- (sorter sorts: dij before: dj) "i.e., should dij precede dj?"
- ifFalse:[collection swap: j with: ij.
- dij := dj].
- ] ifFalse:[ "i.e. di should come after dij"
- collection swap: i with: ij.
- dij := di
- ].
- n > 3 ifTrue:["More than three elements."
- "Find k>i and l<j such that dk,dij,dl are in reverse order.
- Swap k and l. Repeat this procedure until k and l pass each other."
- k := i. l := j.
- [
- [l := l - 1. k <= l and: [sorter sorts: dij before: (collection at: l)]]
- whileTrue. "i.e. while dl succeeds dij"
- [k := k + 1. k <= l and: [sorter sorts: (collection at: k) before: dij]]
- whileTrue. "i.e. while dij succeeds dk"
- k <= l
- ] whileTrue:[collection swap: k with: l].
- "Now l<k (either 1 or 2 less), and di through dl are all less than
- or equal to dk through dj. Sort those two segments."
- self sort: i to: l using: sorter.
- self sort: k to: j using: sorter]].
- !
Item was changed:
----- Method: ChessMoveList>>sortUsing: (in category 'sorting') -----
sortUsing: historyTable
+
+ ^collection
+ quickSortFrom: startIndex
+ to: readLimit
+ by: [ :a :b | historyTable sorts: a before: b ]!
- ^self sort: startIndex to: readLimit using: historyTable!
Item was removed:
- ----- Method: Delay>>scheduleEvent (in category '*Etoys-Squeakland-private') -----
- scheduleEvent
- "Schedule this delay"
- resumptionTime := Time millisecondClockValue + delayDuration.
- AccessProtect critical:[
- ScheduledDelay := self.
- TimingSemaphore signal.
- ].!
Item was removed:
- ----- Method: Dictionary>>errorKeyNotFound (in category '*Etoys-Squeakland-private') -----
- errorKeyNotFound
-
- self error: 'key not found'!
Item was removed:
- ----- Method: Dictionary>>keyAt: (in category '*Etoys-Squeakland-private') -----
- keyAt: index
- "May be overridden by subclasses so that fixCollisions will work"
- | assn |
- assn := array at: index.
- assn == nil ifTrue: [^ nil]
- ifFalse: [^ assn key]!
Item was removed:
- ----- Method: Dictionary>>noCheckAdd: (in category '*Etoys-Squeakland-private') -----
- noCheckAdd: anObject
- "Must be defined separately for Dictionary because (self findElementOrNil:) expects a key, not an association. 9/7/96 tk"
-
- array at: (self findElementOrNil: anObject key) put: anObject.
- tally := tally + 1!
Item was changed:
----- Method: FileList2 class>>buildFileTypeButtons:actionRow:fileList: (in category '*Etoys-Squeakland-blue ui') -----
buildFileTypeButtons: window actionRow: actionRow fileList: aFileList
| fileTypeInfo fileTypeButtons fileTypeRow aButton |
fileTypeInfo := self endingSpecs.
fileTypeRow := window addARowCentered: #().
fileTypeRow color: ScriptingSystem paneColor.
fileTypeRow layoutInset: 3 @ 3.
fileTypeRow cellInset: 2 @ 0.
fileTypeRow hResizing: #spaceFill.
fileTypeButtons := fileTypeInfo
collect: [:each |
aButton := self
buildButtonText: each first
balloonText: nil
receiver: aFileList
selector: #update:fileTypeRow:morphUp:.
aButton arguments: {actionRow. fileTypeRow. aButton}.
aButton setProperty: #enabled toValue: true.
aButton setProperty: #buttonText toValue: each first.
aButton].
fileTypeRow addAllMorphs: fileTypeButtons.
aFileList directoryChangeBlock: [:newDir | self
enableTypeButtons: fileTypeButtons
info: fileTypeInfo
+ forDir: newDir].
- forDir: newDir] fixTemps.
!
Item was removed:
- ----- Method: OrderedCollection>>errorConditionNotSatisfied (in category '*Etoys-Squeakland-private') -----
- errorConditionNotSatisfied
-
- self error: 'no element satisfies condition'!
Item was removed:
- ----- Method: OrderedCollection>>grow (in category '*Etoys-Squeakland-adding') -----
- grow
- "Become larger. Typically, a subclass has to override this if the subclass
- adds instance variables."
- | newArray |
- newArray := Array new: self size + self growSize.
- newArray replaceFrom: 1 to: array size with: array startingAt: 1.
- array := newArray!
Item was removed:
- ----- Method: OrderedCollection>>growSize (in category '*Etoys-Squeakland-adding') -----
- growSize
- ^ array size max: 2!
Item was removed:
- ----- Method: Random class>>theItsCompletelyBrokenTest (in category '*Etoys-Squeakland-testing') -----
- theItsCompletelyBrokenTest
- "Random theItsCompletelyBrokenTest"
- "The above should print as...
- (0.149243269650845 0.331633021743797 0.75619644800024 0.393701540023881 0.941783181364547 0.549929193942775 0.659962596213428 0.991354559078512 0.696074432551896 0.922987899707159 )
- If they are not these values (accounting for precision of printing) then something is horribly wrong: DO NOT USE THIS CODE FOR ANYTHING. "
- | rng |
- rng := Random new.
- rng seed: 2345678901.
- ^ (1 to: 10) collect: [:i | rng next]!
Item was removed:
- ----- Method: Set>>init: (in category '*Etoys-Squeakland-private') -----
- init: n
- "Initialize array to an array size of n"
- array := Array new: n.
- tally := 0!
Item was removed:
- ----- Method: Set>>keyAt: (in category '*Etoys-Squeakland-private') -----
- keyAt: index
- "May be overridden by subclasses so that fixCollisions will work"
- ^ array at: index!
Item was removed:
- ----- Method: Set>>noCheckAdd: (in category '*Etoys-Squeakland-private') -----
- noCheckAdd: anObject
- array at: (self findElementOrNil: anObject) put: anObject.
- tally := tally + 1!
Item was removed:
- ----- Method: Set>>swap:with: (in category '*Etoys-Squeakland-private') -----
- swap: oneIndex with: otherIndex
- "May be overridden by subclasses so that fixCollisions will work"
-
- array swap: oneIndex with: otherIndex
- !
Item was removed:
- ----- Method: Set>>withArray: (in category '*Etoys-Squeakland-private') -----
- withArray: anArray
- "private -- for use only in copy"
- array := anArray!
Item was removed:
- ----- Method: SharedQueue>>init: (in category '*Etoys-Squeakland-private') -----
- init: size
-
- contentsArray := Array new: size.
- readPosition := 1.
- writePosition := 1.
- accessProtect := Semaphore forMutualExclusion.
- readSynch := Semaphore new!
Item was removed:
- ----- Method: String>>findLastOccuranceOfString:startingAt: (in category '*Etoys-Squeakland-deprecated-3.10') -----
- findLastOccuranceOfString: subString startingAt: start
- "Answer the index of the last occurance of subString within the receiver, starting at start. If
- the receiver does not contain subString, answer 0."
-
- ^ self findLastOccurrenceOfString: subString startingAt: start
- !
Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.1101.mcz
==================== Summary ====================
Name: Kernel-nice.1101
Author: nice
Time: 26 April 2017, 11:32:58.822457 pm
UUID: e7668d92-95a7-4ece-967a-35a6bf61c946
Ancestors: Kernel-eem.1100
Fix the dividend of ZeroDivide exception in case of reciprocal.
Classify a few 'as yet unclassified' methods.
=============== Diff against Kernel-eem.1100 ===============
Item was changed:
+ ----- Method: ClassCommentReader>>scanFrom: (in category 'filein/Out') -----
- ----- Method: ClassCommentReader>>scanFrom: (in category 'as yet unclassified') -----
scanFrom: aStream
"File in the class comment from aStream. Not string-i-fied, just a text, exactly as it is in the browser. Move to changes file."
class theNonMetaClass classComment: (aStream nextChunkText) stamp: changeStamp
"Writes it on the disk and saves a RemoteString ref"!
Item was changed:
+ ----- Method: ClassCommentReader>>scanFrom:environment: (in category 'filein/Out') -----
- ----- Method: ClassCommentReader>>scanFrom:environment: (in category 'as yet unclassified') -----
scanFrom: aStream environment: anEnvironment
^ self scanFrom: aStream!
Item was changed:
+ ----- Method: ClassCommentReader>>scanFromNoCompile: (in category 'filein/Out') -----
- ----- Method: ClassCommentReader>>scanFromNoCompile: (in category 'as yet unclassified') -----
scanFromNoCompile: aStream
"File in the class comment from aStream. Not string-i-fied, just a text, exactly as it is in the browser. Move to changes file."
self scanFrom: aStream. "for comments, the same as usual"!
Item was changed:
----- Method: Complex>>reciprocal (in category 'arithmetic') -----
reciprocal
"Answer 1 divided by the receiver. Create an error notification if the
receiver is 0."
self = 0
+ ifTrue: [^ (ZeroDivide dividend: 1) signal]
- ifTrue: [^ (ZeroDivide dividend: self) signal]
ifFalse: [^1 / self]
!
Item was changed:
+ ----- Method: Error>>defaultAction (in category 'handling') -----
- ----- Method: Error>>defaultAction (in category 'exceptionDescription') -----
defaultAction
"No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)"
UnhandledError signalForException: self!
Item was changed:
----- Method: Number>>raisedTo: (in category 'mathematical functions') -----
raisedTo: aNumber
"Answer the receiver raised to aNumber."
aNumber isInteger ifTrue: [
"Do the special case of integer power"
^ self raisedToInteger: aNumber].
aNumber isFraction ifTrue: [
"Special case for fraction power"
^ (self nthRoot: aNumber denominator) raisedToInteger: aNumber numerator ].
self negative ifTrue: [
^ ArithmeticError signal: 'Negative numbers can''t be raised to float powers.' ].
aNumber isZero ifTrue: [^ self class one]. "Special case of exponent=0"
1 = aNumber ifTrue: [^ self]. "Special case of exponent=1"
self isZero ifTrue: [ "Special case of self = 0"
aNumber negative
+ ifTrue: [^ (ZeroDivide dividend: 1) signal]
- ifTrue: [^ (ZeroDivide dividend: self) signal]
ifFalse: [^ self]].
^ (aNumber * self ln) exp "Otherwise use logarithms"!
Nicolas Cellier uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-nice.374.mcz
==================== Summary ====================
Name: Graphics-nice.374
Author: nice
Time: 26 April 2017, 11:03:04.6544 pm
UUID: 7b1aeafa-4b31-4143-9add-cba95d9617f1
Ancestors: Graphics-ul.373
Classify a few 'as yet unclassified' methods
=============== Diff against Graphics-ul.373 ===============
Item was changed:
+ ----- Method: Color>>alpha (in category 'accessing') -----
- ----- Method: Color>>alpha (in category 'access') -----
alpha
"Return the opacity ('alpha') value of opaque so that normal colors can be compared to TransparentColors."
^ 1.0
!
Item was changed:
+ ----- Method: Color>>blue (in category 'accessing') -----
- ----- Method: Color>>blue (in category 'access') -----
blue
"Return the blue component of this color, a float in the range [0.0..1.0]."
^ self privateBlue asFloat / ComponentMax!
Item was changed:
+ ----- Method: Color>>brightness (in category 'accessing') -----
- ----- Method: Color>>brightness (in category 'access') -----
brightness
"Return the brightness of this color, a float in the range [0.0..1.0]."
^ ((self privateRed max:
self privateGreen) max:
self privateBlue) asFloat / ComponentMax!
Item was changed:
+ ----- Method: Color>>green (in category 'accessing') -----
- ----- Method: Color>>green (in category 'access') -----
green
"Return the green component of this color, a float in the range [0.0..1.0]."
^ self privateGreen asFloat / ComponentMax!
Item was changed:
+ ----- Method: Color>>hue (in category 'accessing') -----
- ----- Method: Color>>hue (in category 'access') -----
hue
"Return the hue of this color, an angle in the range [0.0..360.0]."
| r g b max min span h |
r := self privateRed.
g := self privateGreen.
b := self privateBlue.
max := ((r max: g) max: b).
min := ((r min: g) min: b).
span := (max - min) asFloat.
span = 0.0 ifTrue: [ ^ 0.0 ].
r = max ifTrue: [
h := ((g - b) asFloat / span) * 60.0.
] ifFalse: [
g = max
ifTrue: [ h := 120.0 + (((b - r) asFloat / span) * 60.0). ]
ifFalse: [ h := 240.0 + (((r - g) asFloat / span) * 60.0). ].
].
h < 0.0 ifTrue: [ h := 360.0 + h ].
^ h!
Item was changed:
+ ----- Method: Color>>luminance (in category 'accessing') -----
- ----- Method: Color>>luminance (in category 'access') -----
luminance
"Return the luminance of this color, a brightness value weighted by the human eye's color sensitivity."
^ ((299 * self privateRed) +
(587 * self privateGreen) +
(114 * self privateBlue)) / (1000 * ComponentMax)
!
Item was changed:
+ ----- Method: Color>>red (in category 'accessing') -----
- ----- Method: Color>>red (in category 'access') -----
red
"Return the red component of this color, a float in the range [0.0..1.0]."
^ self privateRed asFloat / ComponentMax!
Item was changed:
+ ----- Method: Color>>saturation (in category 'accessing') -----
- ----- Method: Color>>saturation (in category 'access') -----
saturation
"Return the saturation of this color, a value between 0.0 and 1.0."
| r g b max min |
r := self privateRed.
g := self privateGreen.
b := self privateBlue.
max := min := r.
g > max ifTrue: [max := g].
b > max ifTrue: [max := b].
g < min ifTrue: [min := g].
b < min ifTrue: [min := b].
max = 0
ifTrue: [ ^ 0.0 ]
ifFalse: [ ^ (max - min) asFloat / max asFloat ].
!
Item was changed:
+ ----- Method: FormSetFont>>displayString:on:from:to:at:kern: (in category 'displaying') -----
- ----- Method: FormSetFont>>displayString:on:from:to:at:kern: (in category 'as yet unclassified') -----
displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta
"Draw the given string from startIndex to stopIndex "
combinationRule ifNotNil: [:r | aBitBlt combinationRule: r].
tintable == false ifTrue: [aBitBlt colorMap: nil].
^ super displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta!
Item was changed:
+ ----- Method: FormSetFont>>fromFormArray:asciiStart:ascent: (in category 'initialize-release') -----
- ----- Method: FormSetFont>>fromFormArray:asciiStart:ascent: (in category 'as yet unclassified') -----
fromFormArray: formArray asciiStart: asciiStart ascent: ascentVal
| height width x badChar |
type := 2.
name := 'aFormFont'.
minAscii := asciiStart.
maxAscii := minAscii + formArray size - 1.
ascent := ascentVal.
subscript := superscript := emphasis := 0.
height := width := 0.
maxWidth := 0.
formArray do:
[:f | width := width + f width.
maxWidth := maxWidth max: f width.
height := height max: f height + f offset y].
badChar := (Form extent: 7@height) borderWidth: 1.
width := width + badChar width.
descent := height - ascent.
pointSize := height.
glyphs := Form extent: width @ height depth: formArray first depth.
xTable := Array new: maxAscii + 3 withAll: 0.
x := 0.
formArray doWithIndex:
[:f :i | f displayOn: glyphs at: x@0.
xTable at: minAscii + i+1 put: (x := x + f width)].
badChar displayOn: glyphs at: x@0.
xTable at: maxAscii + 3 put: x + badChar width.
characterToGlyphMap := nil.!
Item was changed:
+ ----- Method: FormSetFont>>initialize (in category 'initialize-release') -----
- ----- Method: FormSetFont>>initialize (in category 'as yet unclassified') -----
initialize
super initialize.
self preserveColors.!
Item was changed:
+ ----- Method: FormSetFont>>reset (in category 'emphasis') -----
- ----- Method: FormSetFont>>reset (in category 'as yet unclassified') -----
reset "Ignored by FormSetFonts"!
Item was changed:
+ ----- Method: IdentityGlyphMap>>at: (in category 'accessing') -----
- ----- Method: IdentityGlyphMap>>at: (in category 'as yet unclassified') -----
at: index
^ index - 1.
!
Item was changed:
+ ----- Method: InfiniteForm>>addFillStyleMenuItems:hand:from: (in category 'Morphic menu') -----
- ----- Method: InfiniteForm>>addFillStyleMenuItems:hand:from: (in category 'as yet unclassified') -----
addFillStyleMenuItems: aMenu hand: aHand from: aMorph
"Add the items for changing the current fill style of the receiver"
"prevents a walkback when control menu is built for morph with me as color"!
Item was changed:
+ ----- Method: StaticForm>>isStatic (in category 'testing') -----
- ----- Method: StaticForm>>isStatic (in category 'as yet unclassified') -----
isStatic
^true!
Item was changed:
+ ----- Method: TextComposer>>addNullLineForIndex: (in category 'private') -----
- ----- Method: TextComposer>>addNullLineForIndex: (in category 'as yet unclassified') -----
addNullLineForIndex: index
"This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic."
| oldLastLine r |
oldLastLine := lines last.
oldLastLine last - oldLastLine first >= 0 ifFalse: [^self].
oldLastLine last = (index - 1) ifFalse: [^self].
r := oldLastLine left @ oldLastLine bottom
extent: 0@(oldLastLine bottom - oldLastLine top).
"Even though we may be below the bottom of the container,
it is still necessary to compose the last line for consistency..."
self addNullLineWithIndex: index andRectangle: r.
!
Item was changed:
+ ----- Method: TextComposer>>addNullLineWithIndex:andRectangle: (in category 'private') -----
- ----- Method: TextComposer>>addNullLineWithIndex:andRectangle: (in category 'as yet unclassified') -----
addNullLineWithIndex: index andRectangle: r
lines addLast: (
(
TextLine
start: index
stop: index - 1
internalSpaces: 0
paddingWidth: 0
)
rectangle: r;
lineHeight: defaultLineHeight baseline: theTextStyle baseline
)
!
Item was changed:
+ ----- Method: TextComposer>>checkIfReadyToSlide (in category 'private') -----
- ----- Method: TextComposer>>checkIfReadyToSlide (in category 'as yet unclassified') -----
checkIfReadyToSlide
"Check whether we are now in sync with previously composed lines"
(possibleSlide and: [currCharIndex > stopCharIndex]) ifFalse: [^self].
[prevIndex < prevLines size
and: [(prevLines at: prevIndex) first < (currCharIndex - deltaCharIndex)]]
whileTrue: [prevIndex := prevIndex + 1].
(prevLines at: prevIndex) first = (currCharIndex - deltaCharIndex) ifTrue: [
"Yes -- next line will have same start as prior line."
prevIndex := prevIndex - 1.
possibleSlide := false.
nowSliding := true
] ifFalse: [
prevIndex = prevLines size ifTrue: [
"Weve reached the end of prevLines, so no use to keep looking for lines to slide."
possibleSlide := false
]
]!
Item was changed:
+ ----- Method: TextComposer>>composeAllLines (in category 'private') -----
- ----- Method: TextComposer>>composeAllLines (in category 'as yet unclassified') -----
composeAllLines
[currCharIndex <= theText size and:
[(currentY + defaultLineHeight) <= theContainer bottom]] whileTrue: [
nowSliding ifTrue: [
self slideOneLineDown ifNil: [^nil].
] ifFalse: [
self composeOneLine ifNil: [^nil].
]
].
!
Item was changed:
+ ----- Method: TextComposer>>composeAllRectangles: (in category 'private') -----
- ----- Method: TextComposer>>composeAllRectangles: (in category 'as yet unclassified') -----
composeAllRectangles: rectangles
| charIndexBeforeLine numberOfLinesBefore reasonForStopping |
actualHeight := defaultLineHeight.
charIndexBeforeLine := currCharIndex.
numberOfLinesBefore := lines size.
reasonForStopping := self composeEachRectangleIn: rectangles.
currentY := currentY + actualHeight.
currentY > theContainer bottom ifTrue: [
"Oops -- the line is really too high to fit -- back out"
currCharIndex := charIndexBeforeLine.
lines size - numberOfLinesBefore timesRepeat: [lines removeLast].
^self
].
"It's OK -- the line still fits."
maxRightX := maxRightX max: scanner rightX.
1 to: rectangles size - 1 do: [ :i | |lineIndex|
"Adjust heights across rectangles if necessary"
lineIndex:=lines size - rectangles size + i.
(lines size between: 1 and: lineIndex) ifTrue:
[(lines at: lineIndex)
lineHeight: lines last lineHeight
baseline: lines last baseline]
].
isFirstLine := false.
reasonForStopping == #columnBreak ifTrue: [^nil].
currCharIndex > theText size ifTrue: [
^nil "we are finished composing"
].
!
Item was changed:
+ ----- Method: TextComposer>>composeEachRectangleIn: (in category 'private') -----
- ----- Method: TextComposer>>composeEachRectangleIn: (in category 'as yet unclassified') -----
composeEachRectangleIn: rectangles
| myLine lastChar |
1 to: rectangles size do: [:i |
currCharIndex <= theText size ifFalse: [^false].
myLine := scanner
composeFrom: currCharIndex
inRectangle: (rectangles at: i)
firstLine: isFirstLine
leftSide: i=1
rightSide: i=rectangles size.
lines addLast: myLine.
actualHeight := actualHeight max: myLine lineHeight. "includes font changes"
currCharIndex := myLine last + 1.
lastChar := theText at: myLine last.
(CharacterSet crlf includes: lastChar) ifTrue: [^#cr].
wantsColumnBreaks ifTrue: [
lastChar = Character characterForColumnBreak ifTrue: [^#columnBreak].
].
].
^false!
Item was changed:
+ ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'composing') -----
- ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'as yet unclassified') -----
composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks
wantsColumnBreaks := argWantsColumnBreaks.
lines := argLinesCollection.
theTextStyle := argTextStyle.
theText := argText.
theContainer := argContainer.
deltaCharIndex := argDelta.
currCharIndex := startCharIndex := argStart.
stopCharIndex := argStop.
prevLines := argPriorLines.
currentY := argStartY.
maxRightX := theContainer left.
possibleSlide := stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle].
nowSliding := false.
prevIndex := 1.
"choose an appropriate scanner - should go away soon, when they can be unified"
scanner := CompositionScanner new.
scanner text: theText textStyle: theTextStyle.
scanner wantsColumnBreaks: wantsColumnBreaks.
defaultLineHeight := scanner computeDefaultLineHeight.
isFirstLine := true.
self composeAllLines.
isFirstLine ifTrue: ["No space in container or empty text"
self
addNullLineWithIndex: startCharIndex
andRectangle: (theContainer left @ theContainer top extent: 0@defaultLineHeight)
] ifFalse: [
(lines last last = theText size and: [scanner doesTheLineBreaksAfterLastChar])
ifTrue: [self addNullLineForIndex: theText size + 1]
].
^{lines asArray. maxRightX}
!
Item was changed:
+ ----- Method: TextComposer>>composeOneLine (in category 'private') -----
- ----- Method: TextComposer>>composeOneLine (in category 'as yet unclassified') -----
composeOneLine
| rectangles |
rectangles := theContainer rectanglesAt: currentY height: defaultLineHeight.
rectangles notEmpty
ifTrue: [(self composeAllRectangles: rectangles) ifNil: [^nil]]
ifFalse: [currentY := currentY + defaultLineHeight].
self checkIfReadyToSlide!
Item was changed:
+ ----- Method: TextComposer>>slideOneLineDown (in category 'private') -----
- ----- Method: TextComposer>>slideOneLineDown (in category 'as yet unclassified') -----
slideOneLineDown
| priorLine |
"Having detected the end of rippling recoposition, we are only sliding old lines"
prevIndex < prevLines size ifFalse: [
"There are no more prevLines to slide."
^nowSliding := possibleSlide := false
].
"Adjust and re-use previously composed line"
prevIndex := prevIndex + 1.
priorLine := (prevLines at: prevIndex)
slideIndexBy: deltaCharIndex andMoveTopTo: currentY.
lines addLast: priorLine.
currentY := priorLine bottom.
currCharIndex := priorLine last + 1.
wantsColumnBreaks ifTrue: [
priorLine first to: priorLine last do: [ :i |
(theText at: i) = Character characterForColumnBreak ifTrue: [
nowSliding := possibleSlide := false.
^nil
].
].
].
!