Nicolas Cellier uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-nice.187.mcz
==================== Summary ====================
Name: Graphics-nice.187
Author: nice
Time: 27 June 2011, 8:38:52.631 pm
UUID: 3d0c74fa-7438-4139-8e2a-74979eee4a86
Ancestors: Graphics-ul.186
Apply Display/Character Scanner clean-ups from Cuis:
- remove unused paragraph ivar from DisplayScanner
- remove historical dead code from #crossedX
- ifNil: simplifies code a bit
=============== Diff against Graphics-ul.186 ===============
Item was changed:
----- Method: CharacterBlockScanner>>characterBlockAtPoint:index:in: (in category 'scanning') -----
characterBlockAtPoint: aPoint index: index in: textLine
"This method is the Morphic characterBlock finder. It combines
MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:"
| runLength lineStop stopCondition |
line := textLine.
rightMargin := line rightMargin.
lastIndex := line first.
self setStopConditions. "also sets font"
characterIndex := index. " == nil means scanning for point"
characterPoint := aPoint.
(characterPoint isNil or: [characterPoint y > line bottom])
ifTrue: [characterPoint := line bottomRight].
(text isEmpty or: [(characterPoint y < line top or: [characterPoint x < line left])
or: [characterIndex notNil and: [characterIndex < line first]]])
ifTrue: [^ (CharacterBlock new stringIndex: line first text: text
topLeft: line leftMargin@line top extent: 0 @ textStyle lineGrid)
textLine: line].
destX := leftMargin := line leftMarginForAlignment: alignment.
destY := line top.
runLength := text runLengthFor: line first.
+ lineStop := characterIndex "scanning for index"
+ ifNil: [ line last ]. "scanning for point"
- characterIndex
- ifNotNil: [lineStop := characterIndex "scanning for index"]
- ifNil: [lineStop := line last "scanning for point"].
runStopIndex := lastIndex + (runLength - 1) min: lineStop.
lastCharacterExtent := 0 @ line lineHeight.
spaceCount := 0.
[
stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
in: text string rightX: characterPoint x
stopConditions: stopConditions kern: kern.
"see setStopConditions for stopping conditions for character block operations."
self lastCharacterExtentSetX: (specialWidth
ifNil: [font widthOf: (text at: lastIndex)]
ifNotNil: [specialWidth]).
self perform: stopCondition
] whileFalse.
characterIndex
ifNil: [
"Result for characterBlockAtPoint: "
(stopCondition ~~ #cr and: [ lastIndex == line last
and: [ aPoint x > ((characterPoint x) + (lastCharacterExtent x / 2)) ]])
ifTrue: [ "Correct for right half of last character in line"
^ (CharacterBlock new stringIndex: lastIndex + 1
text: text
topLeft: characterPoint + (lastCharacterExtent x @ 0) + (font descentKern @ 0)
extent: 0 @ lastCharacterExtent y)
textLine: line ].
^ (CharacterBlock new
stringIndex: lastIndex
text: text topLeft: characterPoint + (font descentKern @ 0)
extent: lastCharacterExtent - (font baseKern @ 0))
textLine: line]
ifNotNil: ["Result for characterBlockForIndex: "
^ (CharacterBlock new
stringIndex: characterIndex
text: text topLeft: characterPoint + ((font descentKern) - kern @ 0)
extent: lastCharacterExtent)
textLine: line]!
Item was changed:
----- Method: CharacterBlockScanner>>crossedX (in category 'stop conditions') -----
crossedX
"Text display has wrapping. The scanner just found a character past the x
location of the cursor. We know that the cursor is pointing at a character
or before one."
+ | currentX |
- | leadingTab currentX |
characterIndex == nil ifFalse: [
"If the last character of the last line is a space,
and it crosses the right margin, then locating
the character block after it is impossible without this hack."
characterIndex > text size ifTrue: [
lastIndex := characterIndex.
characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight).
^true]].
characterPoint x <= (destX + (lastCharacterExtent x // 2))
ifTrue: [lastCharacter := (text at: lastIndex).
characterPoint := destX @ destY.
^true].
lastIndex >= line last
ifTrue: [lastCharacter := (text at: line last).
characterPoint := destX @ destY.
^true].
"Pointing past middle of a character, return the next character."
lastIndex := lastIndex + 1.
lastCharacter := text at: lastIndex.
currentX := destX + lastCharacterExtent x + kern.
self lastCharacterExtentSetX: (font widthOf: lastCharacter).
characterPoint := currentX @ destY.
lastCharacter = Space ifFalse: [^ true].
"Yukky if next character is space or tab."
alignment = Justified ifTrue:
[self lastCharacterExtentSetX:
+ (lastCharacterExtent x + (line justifiedPadFor: (spaceCount + 1) font: font))].
- (lastCharacterExtent x + (line justifiedPadFor: (spaceCount + 1) font: font)).
- ^ true].
- true ifTrue: [^ true].
- "NOTE: I find no value to the following code, and so have defeated it - DI"
-
- "See tabForDisplay for illumination on the following awfulness."
- leadingTab := true.
- line first to: lastIndex - 1 do:
- [:index | (text at: index) ~= Tab ifTrue: [leadingTab := false]].
- (alignment ~= Justified or: [leadingTab])
- ifTrue: [self lastCharacterExtentSetX: (textStyle nextTabXFrom: currentX
- leftMargin: leftMargin rightMargin: rightMargin) -
- currentX]
- ifFalse: [self lastCharacterExtentSetX: (((currentX + (textStyle tabWidth -
- (line justifiedTabDeltaFor: spaceCount))) -
- currentX) max: 0)].
^ true!
Item was changed:
CharacterScanner subclass: #DisplayScanner
+ instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraphColor morphicOffset ignoreColorChanges'
- instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraph paragraphColor morphicOffset ignoreColorChanges'
classVariableNames: ''
poolDictionaries: ''
category: 'Graphics-Text'!
!DisplayScanner commentStamp: '<historical>' prior: 0!
My instances are used to scan text and display it on the screen or in a hidden form.!
Item was changed:
----- Method: DisplayScanner>>displayLines:in:clippedBy: (in category 'MVC-compatibility') -----
displayLines: linesInterval in: aParagraph clippedBy: visibleRectangle
"The central display routine. The call on the primitive
(scanCharactersFrom:to:in:rightX:) will be interrupted according to an
array of stop conditions passed to the scanner at which time the code to
handle the stop condition is run and the call on the primitive continued
until a stop condition returns true (which means the line has
terminated)."
| leftInRun |
"leftInRun is the # of characters left to scan in the current run;
when 0, it is time to call 'self setStopConditions'"
morphicOffset := 0@0.
leftInRun := 0.
self initializeFromParagraph: aParagraph clippedBy: visibleRectangle.
ignoreColorChanges := false.
- paragraph := aParagraph.
foregroundColor := paragraphColor := aParagraph foregroundColor.
backgroundColor := aParagraph backgroundColor.
aParagraph backgroundColor isTransparent
ifTrue: [fillBlt := nil]
ifFalse: [fillBlt := bitBlt copy. "Blt to fill spaces, tabs, margins"
fillBlt sourceForm: nil; sourceOrigin: 0@0.
fillBlt fillColor: aParagraph backgroundColor].
rightMargin := aParagraph rightMarginForDisplay.
lineY := aParagraph topAtLineIndex: linesInterval first.
bitBlt destForm deferUpdatesIn: visibleRectangle while: [
linesInterval do:
[:lineIndex |
| string startIndex lastPos runLength stopCondition |
line := aParagraph lines at: lineIndex.
lastIndex := line first.
self setStopConditions. " causes an assignment to inst var. alignment "
leftMargin := aParagraph leftMarginForDisplayForLine: lineIndex alignment: (alignment ifNil:[textStyle alignment]).
destX := (runX := leftMargin).
line := aParagraph lines at: lineIndex.
lineHeight := line lineHeight.
fillBlt == nil ifFalse:
[fillBlt destX: visibleRectangle left destY: lineY
width: visibleRectangle width height: lineHeight; copyBits].
lastIndex := line first.
leftInRun <= 0
ifTrue: [self setStopConditions. "also sets the font"
leftInRun := text runLengthFor: line first].
destY := lineY + line baseline - font ascent. "Should have happened in setFont"
runLength := leftInRun.
runStopIndex := lastIndex + (runLength - 1) min: line last.
leftInRun := leftInRun - (runStopIndex - lastIndex + 1).
spaceCount := 0.
string := text string.
self handleIndentation.
[
startIndex := lastIndex.
lastPos := destX@destY.
stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
in: string rightX: rightMargin stopConditions: stopConditions
kern: kern.
lastIndex >= startIndex ifTrue:[
font displayString: string on: bitBlt
from: startIndex to: lastIndex at: lastPos kern: kern].
"see setStopConditions for stopping conditions for displaying."
self perform: stopCondition
] whileFalse.
fillBlt == nil ifFalse:
[fillBlt destX: destX destY: lineY width: visibleRectangle right-destX height: lineHeight; copyBits].
lineY := lineY + lineHeight]]!
Nicolas Cellier uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-nice.187.mcz
==================== Summary ====================
Name: Graphics-nice.187
Author: nice
Time: 27 June 2011, 8:38:52.631 pm
UUID: 3d0c74fa-7438-4139-8e2a-74979eee4a86
Ancestors: Graphics-ul.186
Apply Display/Character Scanner clean-ups from Cuis:
- remove unused paragraph ivar from DisplayScanner
- remove historical dead code from #crossedX
- ifNil: simplifies code a bit
=============== Diff against Graphics-ul.186 ===============
Item was changed:
----- Method: CharacterBlockScanner>>characterBlockAtPoint:index:in: (in category 'scanning') -----
characterBlockAtPoint: aPoint index: index in: textLine
"This method is the Morphic characterBlock finder. It combines
MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:"
| runLength lineStop stopCondition |
line := textLine.
rightMargin := line rightMargin.
lastIndex := line first.
self setStopConditions. "also sets font"
characterIndex := index. " == nil means scanning for point"
characterPoint := aPoint.
(characterPoint isNil or: [characterPoint y > line bottom])
ifTrue: [characterPoint := line bottomRight].
(text isEmpty or: [(characterPoint y < line top or: [characterPoint x < line left])
or: [characterIndex notNil and: [characterIndex < line first]]])
ifTrue: [^ (CharacterBlock new stringIndex: line first text: text
topLeft: line leftMargin@line top extent: 0 @ textStyle lineGrid)
textLine: line].
destX := leftMargin := line leftMarginForAlignment: alignment.
destY := line top.
runLength := text runLengthFor: line first.
+ lineStop := characterIndex "scanning for index"
+ ifNil: [ line last ]. "scanning for point"
- characterIndex
- ifNotNil: [lineStop := characterIndex "scanning for index"]
- ifNil: [lineStop := line last "scanning for point"].
runStopIndex := lastIndex + (runLength - 1) min: lineStop.
lastCharacterExtent := 0 @ line lineHeight.
spaceCount := 0.
[
stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
in: text string rightX: characterPoint x
stopConditions: stopConditions kern: kern.
"see setStopConditions for stopping conditions for character block operations."
self lastCharacterExtentSetX: (specialWidth
ifNil: [font widthOf: (text at: lastIndex)]
ifNotNil: [specialWidth]).
self perform: stopCondition
] whileFalse.
characterIndex
ifNil: [
"Result for characterBlockAtPoint: "
(stopCondition ~~ #cr and: [ lastIndex == line last
and: [ aPoint x > ((characterPoint x) + (lastCharacterExtent x / 2)) ]])
ifTrue: [ "Correct for right half of last character in line"
^ (CharacterBlock new stringIndex: lastIndex + 1
text: text
topLeft: characterPoint + (lastCharacterExtent x @ 0) + (font descentKern @ 0)
extent: 0 @ lastCharacterExtent y)
textLine: line ].
^ (CharacterBlock new
stringIndex: lastIndex
text: text topLeft: characterPoint + (font descentKern @ 0)
extent: lastCharacterExtent - (font baseKern @ 0))
textLine: line]
ifNotNil: ["Result for characterBlockForIndex: "
^ (CharacterBlock new
stringIndex: characterIndex
text: text topLeft: characterPoint + ((font descentKern) - kern @ 0)
extent: lastCharacterExtent)
textLine: line]!
Item was changed:
----- Method: CharacterBlockScanner>>crossedX (in category 'stop conditions') -----
crossedX
"Text display has wrapping. The scanner just found a character past the x
location of the cursor. We know that the cursor is pointing at a character
or before one."
+ | currentX |
- | leadingTab currentX |
characterIndex == nil ifFalse: [
"If the last character of the last line is a space,
and it crosses the right margin, then locating
the character block after it is impossible without this hack."
characterIndex > text size ifTrue: [
lastIndex := characterIndex.
characterPoint := (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight).
^true]].
characterPoint x <= (destX + (lastCharacterExtent x // 2))
ifTrue: [lastCharacter := (text at: lastIndex).
characterPoint := destX @ destY.
^true].
lastIndex >= line last
ifTrue: [lastCharacter := (text at: line last).
characterPoint := destX @ destY.
^true].
"Pointing past middle of a character, return the next character."
lastIndex := lastIndex + 1.
lastCharacter := text at: lastIndex.
currentX := destX + lastCharacterExtent x + kern.
self lastCharacterExtentSetX: (font widthOf: lastCharacter).
characterPoint := currentX @ destY.
lastCharacter = Space ifFalse: [^ true].
"Yukky if next character is space or tab."
alignment = Justified ifTrue:
[self lastCharacterExtentSetX:
+ (lastCharacterExtent x + (line justifiedPadFor: (spaceCount + 1) font: font))].
- (lastCharacterExtent x + (line justifiedPadFor: (spaceCount + 1) font: font)).
- ^ true].
- true ifTrue: [^ true].
- "NOTE: I find no value to the following code, and so have defeated it - DI"
-
- "See tabForDisplay for illumination on the following awfulness."
- leadingTab := true.
- line first to: lastIndex - 1 do:
- [:index | (text at: index) ~= Tab ifTrue: [leadingTab := false]].
- (alignment ~= Justified or: [leadingTab])
- ifTrue: [self lastCharacterExtentSetX: (textStyle nextTabXFrom: currentX
- leftMargin: leftMargin rightMargin: rightMargin) -
- currentX]
- ifFalse: [self lastCharacterExtentSetX: (((currentX + (textStyle tabWidth -
- (line justifiedTabDeltaFor: spaceCount))) -
- currentX) max: 0)].
^ true!
Item was changed:
CharacterScanner subclass: #DisplayScanner
+ instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraphColor morphicOffset ignoreColorChanges'
- instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraph paragraphColor morphicOffset ignoreColorChanges'
classVariableNames: ''
poolDictionaries: ''
category: 'Graphics-Text'!
!DisplayScanner commentStamp: '<historical>' prior: 0!
My instances are used to scan text and display it on the screen or in a hidden form.!
Item was changed:
----- Method: DisplayScanner>>displayLines:in:clippedBy: (in category 'MVC-compatibility') -----
displayLines: linesInterval in: aParagraph clippedBy: visibleRectangle
"The central display routine. The call on the primitive
(scanCharactersFrom:to:in:rightX:) will be interrupted according to an
array of stop conditions passed to the scanner at which time the code to
handle the stop condition is run and the call on the primitive continued
until a stop condition returns true (which means the line has
terminated)."
| leftInRun |
"leftInRun is the # of characters left to scan in the current run;
when 0, it is time to call 'self setStopConditions'"
morphicOffset := 0@0.
leftInRun := 0.
self initializeFromParagraph: aParagraph clippedBy: visibleRectangle.
ignoreColorChanges := false.
- paragraph := aParagraph.
foregroundColor := paragraphColor := aParagraph foregroundColor.
backgroundColor := aParagraph backgroundColor.
aParagraph backgroundColor isTransparent
ifTrue: [fillBlt := nil]
ifFalse: [fillBlt := bitBlt copy. "Blt to fill spaces, tabs, margins"
fillBlt sourceForm: nil; sourceOrigin: 0@0.
fillBlt fillColor: aParagraph backgroundColor].
rightMargin := aParagraph rightMarginForDisplay.
lineY := aParagraph topAtLineIndex: linesInterval first.
bitBlt destForm deferUpdatesIn: visibleRectangle while: [
linesInterval do:
[:lineIndex |
| string startIndex lastPos runLength stopCondition |
line := aParagraph lines at: lineIndex.
lastIndex := line first.
self setStopConditions. " causes an assignment to inst var. alignment "
leftMargin := aParagraph leftMarginForDisplayForLine: lineIndex alignment: (alignment ifNil:[textStyle alignment]).
destX := (runX := leftMargin).
line := aParagraph lines at: lineIndex.
lineHeight := line lineHeight.
fillBlt == nil ifFalse:
[fillBlt destX: visibleRectangle left destY: lineY
width: visibleRectangle width height: lineHeight; copyBits].
lastIndex := line first.
leftInRun <= 0
ifTrue: [self setStopConditions. "also sets the font"
leftInRun := text runLengthFor: line first].
destY := lineY + line baseline - font ascent. "Should have happened in setFont"
runLength := leftInRun.
runStopIndex := lastIndex + (runLength - 1) min: line last.
leftInRun := leftInRun - (runStopIndex - lastIndex + 1).
spaceCount := 0.
string := text string.
self handleIndentation.
[
startIndex := lastIndex.
lastPos := destX@destY.
stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
in: string rightX: rightMargin stopConditions: stopConditions
kern: kern.
lastIndex >= startIndex ifTrue:[
font displayString: string on: bitBlt
from: startIndex to: lastIndex at: lastPos kern: kern].
"see setStopConditions for stopping conditions for displaying."
self perform: stopCondition
] whileFalse.
fillBlt == nil ifFalse:
[fillBlt destX: destX destY: lineY width: visibleRectangle right-destX height: lineHeight; copyBits].
lineY := lineY + lineHeight]]!
Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.602.mcz
==================== Summary ====================
Name: Kernel-nice.602
Author: nice
Time: 27 June 2011, 8:27:00.479 pm
UUID: 5466a1ae-e947-4881-b71f-e83278dc1e33
Ancestors: Kernel-bf.601
Minor tweaks:
Use a better approximation for counting digits in base 10
Use raisedToInteger: since we now the argument 'base' is Integer
Change arTanh error message because (between -1 and 1) is more inline with Smalltalk message #between:and: than (between 1 and -1).
Simplify ulp since #abs matches #ulp return value for any non finite number.
=============== Diff against Kernel-bf.601 ===============
Item was changed:
----- Method: Float>>arTanh (in category 'mathematical functions') -----
arTanh
"Answer receiver's area hyperbolic tangent.
That is the inverse function of tanh."
self = 0.0 ifTrue: [^self]. "Handle negativeZero"
self abs = 1 ifTrue: [^self copySignTo: Float infinity].
self abs > 1
ifTrue:
+ [^DomainError signal: 'Receiver must be between -1.0 and 1.0'].
- [^DomainError signal: 'Receiver must be between 1.0 and -1.0'].
^((1 + self) / (1 - self)) ln / 2!
Item was changed:
----- Method: Float>>ulp (in category 'truncation and round off') -----
ulp
"Answer the unit of least precision of self (the power of two corresponding to last bit of mantissa)"
| exponent |
+ self isFinite ifFalse: [^self abs].
- self isFinite ifFalse: [
- self isNaN ifTrue: [^self].
- ^Float infinity].
self = 0.0 ifTrue: [^Float fmin].
exponent := self exponent.
^exponent < self class emin
ifTrue: [Float fminDenormalized]
ifFalse: [Float epsilon timesTwoPower: exponent]!
Item was changed:
----- Method: Integer>>numberOfDigitsInBase: (in category 'printing') -----
numberOfDigitsInBase: b
"Return how many digits are necessary to print this number in base b.
This does not count any place for minus sign, radix prefix or whatever.
Note that this algorithm may cost a few operations on LargeInteger."
| nDigits q total |
self negative ifTrue: [^self negated numberOfDigitsInBase: b].
self < b ifTrue: [^1].
b isPowerOfTwo ifTrue: [^self highBit + b highBit - 2 quo: b highBit - 1].
"A conversion from base 2 to base b has to be performed.
This algorithm avoids Float computations like (self log: b) floor + 1,
1) because they are inexact
2) because LargeInteger might overflow
3) because this algorithm might be cheaper than conversion"
q := self.
total := 0.
["Make an initial nDigits guess that is lower than or equal to required number of digits"
nDigits := b = 10
ifTrue: [((q highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
ifFalse: [q highBit quo: b highBit].
total := total + nDigits.
"See how many digits remains above these first nDigits guess"
+ (q := q quo: (b raisedToInteger: nDigits)) < b] whileFalse.
- (q := q quo: (b raisedTo: nDigits)) < b] whileFalse.
^q = 0
ifTrue: [total]
ifFalse: [total + 1]!
Item was changed:
----- Method: LargePositiveInteger>>printOn:base: (in category 'printing') -----
printOn: aStream base: b
"Append a representation of this number in base b on aStream.
In order to reduce cost of LargePositiveInteger ops, split the number in approximately two equal parts in number of digits."
| halfDigits halfPower head tail nDigitsUnderestimate |
"Don't engage any arithmetic if not normalized"
(self digitLength = 0 or: [(self digitAt: self digitLength) = 0]) ifTrue: [^self normalize printOn: aStream base: b].
nDigitsUnderestimate := b = 10
+ ifTrue: [((self highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
- ifTrue: [((self highBit - 1) * 3 quo: 10) + 1 "because 1024 is almost a kilo"]
ifFalse: [self highBit quo: b highBit].
"splitting digits with a whole power of two is more efficient"
halfDigits := 1 bitShift: nDigitsUnderestimate highBit - 2.
halfDigits <= 1
ifTrue: ["Hmmm, this could happen only in case of a huge base b... Let lower level fail"
^self printOn: aStream base: b nDigits: (self numberOfDigitsInBase: b)].
"Separate in two halves, head and tail"
halfPower := b raisedToInteger: halfDigits.
head := self quo: halfPower.
tail := self - (head * halfPower).
"print head"
head printOn: aStream base: b.
"print tail without the overhead to count the digits"
tail printOn: aStream base: b nDigits: halfDigits!
Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.602.mcz
==================== Summary ====================
Name: Kernel-nice.602
Author: nice
Time: 27 June 2011, 8:27:00.479 pm
UUID: 5466a1ae-e947-4881-b71f-e83278dc1e33
Ancestors: Kernel-bf.601
Minor tweaks:
Use a better approximation for counting digits in base 10
Use raisedToInteger: since we now the argument 'base' is Integer
Change arTanh error message because (between -1 and 1) is more inline with Smalltalk message #between:and: than (between 1 and -1).
Simplify ulp since #abs matches #ulp return value for any non finite number.
=============== Diff against Kernel-bf.601 ===============
Item was changed:
----- Method: Float>>arTanh (in category 'mathematical functions') -----
arTanh
"Answer receiver's area hyperbolic tangent.
That is the inverse function of tanh."
self = 0.0 ifTrue: [^self]. "Handle negativeZero"
self abs = 1 ifTrue: [^self copySignTo: Float infinity].
self abs > 1
ifTrue:
+ [^DomainError signal: 'Receiver must be between -1.0 and 1.0'].
- [^DomainError signal: 'Receiver must be between 1.0 and -1.0'].
^((1 + self) / (1 - self)) ln / 2!
Item was changed:
----- Method: Float>>ulp (in category 'truncation and round off') -----
ulp
"Answer the unit of least precision of self (the power of two corresponding to last bit of mantissa)"
| exponent |
+ self isFinite ifFalse: [^self abs].
- self isFinite ifFalse: [
- self isNaN ifTrue: [^self].
- ^Float infinity].
self = 0.0 ifTrue: [^Float fmin].
exponent := self exponent.
^exponent < self class emin
ifTrue: [Float fminDenormalized]
ifFalse: [Float epsilon timesTwoPower: exponent]!
Item was changed:
----- Method: Integer>>numberOfDigitsInBase: (in category 'printing') -----
numberOfDigitsInBase: b
"Return how many digits are necessary to print this number in base b.
This does not count any place for minus sign, radix prefix or whatever.
Note that this algorithm may cost a few operations on LargeInteger."
| nDigits q total |
self negative ifTrue: [^self negated numberOfDigitsInBase: b].
self < b ifTrue: [^1].
b isPowerOfTwo ifTrue: [^self highBit + b highBit - 2 quo: b highBit - 1].
"A conversion from base 2 to base b has to be performed.
This algorithm avoids Float computations like (self log: b) floor + 1,
1) because they are inexact
2) because LargeInteger might overflow
3) because this algorithm might be cheaper than conversion"
q := self.
total := 0.
["Make an initial nDigits guess that is lower than or equal to required number of digits"
nDigits := b = 10
ifTrue: [((q highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
ifFalse: [q highBit quo: b highBit].
total := total + nDigits.
"See how many digits remains above these first nDigits guess"
+ (q := q quo: (b raisedToInteger: nDigits)) < b] whileFalse.
- (q := q quo: (b raisedTo: nDigits)) < b] whileFalse.
^q = 0
ifTrue: [total]
ifFalse: [total + 1]!
Item was changed:
----- Method: LargePositiveInteger>>printOn:base: (in category 'printing') -----
printOn: aStream base: b
"Append a representation of this number in base b on aStream.
In order to reduce cost of LargePositiveInteger ops, split the number in approximately two equal parts in number of digits."
| halfDigits halfPower head tail nDigitsUnderestimate |
"Don't engage any arithmetic if not normalized"
(self digitLength = 0 or: [(self digitAt: self digitLength) = 0]) ifTrue: [^self normalize printOn: aStream base: b].
nDigitsUnderestimate := b = 10
+ ifTrue: [((self highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
- ifTrue: [((self highBit - 1) * 3 quo: 10) + 1 "because 1024 is almost a kilo"]
ifFalse: [self highBit quo: b highBit].
"splitting digits with a whole power of two is more efficient"
halfDigits := 1 bitShift: nDigitsUnderestimate highBit - 2.
halfDigits <= 1
ifTrue: ["Hmmm, this could happen only in case of a huge base b... Let lower level fail"
^self printOn: aStream base: b nDigits: (self numberOfDigitsInBase: b)].
"Separate in two halves, head and tail"
halfPower := b raisedToInteger: halfDigits.
head := self quo: halfPower.
tail := self - (head * halfPower).
"print head"
head printOn: aStream base: b.
"print tail without the overhead to count the digits"
tail printOn: aStream base: b nDigits: halfDigits!
Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.602.mcz
==================== Summary ====================
Name: Kernel-nice.602
Author: nice
Time: 27 June 2011, 8:27:00.479 pm
UUID: 5466a1ae-e947-4881-b71f-e83278dc1e33
Ancestors: Kernel-bf.601
Minor tweaks:
Use a better approximation for counting digits in base 10
Use raisedToInteger: since we now the argument 'base' is Integer
Change arTanh error message because (between -1 and 1) is more inline with Smalltalk message #between:and: than (between 1 and -1).
Simplify ulp since #abs matches #ulp return value for any non finite number.
=============== Diff against Kernel-bf.601 ===============
Item was changed:
----- Method: Float>>arTanh (in category 'mathematical functions') -----
arTanh
"Answer receiver's area hyperbolic tangent.
That is the inverse function of tanh."
self = 0.0 ifTrue: [^self]. "Handle negativeZero"
self abs = 1 ifTrue: [^self copySignTo: Float infinity].
self abs > 1
ifTrue:
+ [^DomainError signal: 'Receiver must be between -1.0 and 1.0'].
- [^DomainError signal: 'Receiver must be between 1.0 and -1.0'].
^((1 + self) / (1 - self)) ln / 2!
Item was changed:
----- Method: Float>>ulp (in category 'truncation and round off') -----
ulp
"Answer the unit of least precision of self (the power of two corresponding to last bit of mantissa)"
| exponent |
+ self isFinite ifFalse: [^self abs].
- self isFinite ifFalse: [
- self isNaN ifTrue: [^self].
- ^Float infinity].
self = 0.0 ifTrue: [^Float fmin].
exponent := self exponent.
^exponent < self class emin
ifTrue: [Float fminDenormalized]
ifFalse: [Float epsilon timesTwoPower: exponent]!
Item was changed:
----- Method: Integer>>numberOfDigitsInBase: (in category 'printing') -----
numberOfDigitsInBase: b
"Return how many digits are necessary to print this number in base b.
This does not count any place for minus sign, radix prefix or whatever.
Note that this algorithm may cost a few operations on LargeInteger."
| nDigits q total |
self negative ifTrue: [^self negated numberOfDigitsInBase: b].
self < b ifTrue: [^1].
b isPowerOfTwo ifTrue: [^self highBit + b highBit - 2 quo: b highBit - 1].
"A conversion from base 2 to base b has to be performed.
This algorithm avoids Float computations like (self log: b) floor + 1,
1) because they are inexact
2) because LargeInteger might overflow
3) because this algorithm might be cheaper than conversion"
q := self.
total := 0.
["Make an initial nDigits guess that is lower than or equal to required number of digits"
nDigits := b = 10
ifTrue: [((q highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
ifFalse: [q highBit quo: b highBit].
total := total + nDigits.
"See how many digits remains above these first nDigits guess"
+ (q := q quo: (b raisedToInteger: nDigits)) < b] whileFalse.
- (q := q quo: (b raisedTo: nDigits)) < b] whileFalse.
^q = 0
ifTrue: [total]
ifFalse: [total + 1]!
Item was changed:
----- Method: LargePositiveInteger>>printOn:base: (in category 'printing') -----
printOn: aStream base: b
"Append a representation of this number in base b on aStream.
In order to reduce cost of LargePositiveInteger ops, split the number in approximately two equal parts in number of digits."
| halfDigits halfPower head tail nDigitsUnderestimate |
"Don't engage any arithmetic if not normalized"
(self digitLength = 0 or: [(self digitAt: self digitLength) = 0]) ifTrue: [^self normalize printOn: aStream base: b].
nDigitsUnderestimate := b = 10
+ ifTrue: [((self highBit - 1) * 1233 >> 12) + 1. "This is because (2 log)/(10 log)*4096 is slightly greater than 1233"]
- ifTrue: [((self highBit - 1) * 3 quo: 10) + 1 "because 1024 is almost a kilo"]
ifFalse: [self highBit quo: b highBit].
"splitting digits with a whole power of two is more efficient"
halfDigits := 1 bitShift: nDigitsUnderestimate highBit - 2.
halfDigits <= 1
ifTrue: ["Hmmm, this could happen only in case of a huge base b... Let lower level fail"
^self printOn: aStream base: b nDigits: (self numberOfDigitsInBase: b)].
"Separate in two halves, head and tail"
halfPower := b raisedToInteger: halfDigits.
head := self quo: halfPower.
tail := self - (head * halfPower).
"print head"
head printOn: aStream base: b.
"print tail without the overhead to count the digits"
tail printOn: aStream base: b nDigits: halfDigits!
Bert Freudenberg uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-bf.552.mcz
==================== Summary ====================
Name: Morphic-bf.552
Author: bf
Time: 25 June 2011, 1:42:08.074 pm
UUID: 813fe1f0-64a5-467f-81b0-19260375959d
Ancestors: Morphic-cmm.551
fix userString for lists
=============== Diff against Morphic-cmm.551 ===============
Item was changed:
----- Method: LazyListMorph>>userString (in category 'accessing') -----
userString
"Do I have a text string to be searched on?"
^ String streamContents: [:strm |
1 to: self getListSize do: [:i |
+ "must use asStringOrText because that's what the drawing uses, too"
+ strm nextPutAll: (self getListItem: i) asStringOrText; cr]]!
- strm nextPutAll: (self getListItem: i); cr]]!
Item was changed:
----- Method: PluggableListMorph>>userString (in category 'debug and other') -----
userString
"Do I have a text string to be searched on?"
^ String streamContents: [:strm |
1 to: self getListSize do: [:i |
+ "must use asStringOrText because that's what the drawing uses, too"
+ strm nextPutAll: (self getListItem: i) asStringOrText; cr]]!
- strm nextPutAll: (self getListItem: i); cr]]!
Bert Freudenberg uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-bf.552.mcz
==================== Summary ====================
Name: Morphic-bf.552
Author: bf
Time: 25 June 2011, 1:42:08.074 pm
UUID: 813fe1f0-64a5-467f-81b0-19260375959d
Ancestors: Morphic-cmm.551
fix userString for lists
=============== Diff against Morphic-cmm.551 ===============
Item was changed:
----- Method: LazyListMorph>>userString (in category 'accessing') -----
userString
"Do I have a text string to be searched on?"
^ String streamContents: [:strm |
1 to: self getListSize do: [:i |
+ "must use asStringOrText because that's what the drawing uses, too"
+ strm nextPutAll: (self getListItem: i) asStringOrText; cr]]!
- strm nextPutAll: (self getListItem: i); cr]]!
Item was changed:
----- Method: PluggableListMorph>>userString (in category 'debug and other') -----
userString
"Do I have a text string to be searched on?"
^ String streamContents: [:strm |
1 to: self getListSize do: [:i |
+ "must use asStringOrText because that's what the drawing uses, too"
+ strm nextPutAll: (self getListItem: i) asStringOrText; cr]]!
- strm nextPutAll: (self getListItem: i); cr]]!
Bert Freudenberg uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-bf.552.mcz
==================== Summary ====================
Name: Morphic-bf.552
Author: bf
Time: 25 June 2011, 1:42:08.074 pm
UUID: 813fe1f0-64a5-467f-81b0-19260375959d
Ancestors: Morphic-cmm.551
fix userString for lists
=============== Diff against Morphic-cmm.551 ===============
Item was changed:
----- Method: LazyListMorph>>userString (in category 'accessing') -----
userString
"Do I have a text string to be searched on?"
^ String streamContents: [:strm |
1 to: self getListSize do: [:i |
+ "must use asStringOrText because that's what the drawing uses, too"
+ strm nextPutAll: (self getListItem: i) asStringOrText; cr]]!
- strm nextPutAll: (self getListItem: i); cr]]!
Item was changed:
----- Method: PluggableListMorph>>userString (in category 'debug and other') -----
userString
"Do I have a text string to be searched on?"
^ String streamContents: [:strm |
1 to: self getListSize do: [:i |
+ "must use asStringOrText because that's what the drawing uses, too"
+ strm nextPutAll: (self getListItem: i) asStringOrText; cr]]!
- strm nextPutAll: (self getListItem: i); cr]]!
Bert Freudenberg uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-bf.601.mcz
==================== Summary ====================
Name: Kernel-bf.601
Author: bf
Time: 23 June 2011, 3:37:18.629 pm
UUID: f3acd77d-7721-4775-90d7-a4aa00a90670
Ancestors: Kernel-cmm.600
revert Float>>/ to restore proper ZeroDivide handling (see
testZeroDivideHandler)
=============== Diff against Kernel-cmm.600 ===============
Item was changed:
----- Method: Float>>/ (in category 'arithmetic') -----
/ aNumber
"Primitive. Answer the result of dividing receiver by aNumber.
Fail if the argument is not a Float. Essential. See Object documentation
whatIsAPrimitive."
<primitive: 50>
+ aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal].
+ ^ aNumber adaptToFloat: self andSend: #/!
- aNumber = 0.0 ifTrue: [ ZeroDivide signalWithDividend: self].
- ^aNumber adaptToFloat: self andSend: #/!
Bert Freudenberg uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-bf.601.mcz
==================== Summary ====================
Name: Kernel-bf.601
Author: bf
Time: 23 June 2011, 3:37:18.629 pm
UUID: f3acd77d-7721-4775-90d7-a4aa00a90670
Ancestors: Kernel-cmm.600
revert Float>>/ to restore proper ZeroDivide handling (see
testZeroDivideHandler)
=============== Diff against Kernel-cmm.600 ===============
Item was changed:
----- Method: Float>>/ (in category 'arithmetic') -----
/ aNumber
"Primitive. Answer the result of dividing receiver by aNumber.
Fail if the argument is not a Float. Essential. See Object documentation
whatIsAPrimitive."
<primitive: 50>
+ aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal].
+ ^ aNumber adaptToFloat: self andSend: #/!
- aNumber = 0.0 ifTrue: [ ZeroDivide signalWithDividend: self].
- ^aNumber adaptToFloat: self andSend: #/!