| BagTest>>testEqual: (no stamp -> EP 3/8/2006 08:39) |
no previous history |
testEqual "(self run: #testEqual)" "(self debug: #testEqual)" | bag1 bag2 | bag1 := Bag new. bag2 := Bag new. self assert: bag1 = bag2. bag1 add: #a; add: #b. bag2 add: #a; add: #a. self deny: bag1 = bag2. self assert: bag1 = bag1. bag1 add: #a. bag2 add: #b. self assert: bag1 = bag2. bag1 add: #c. self deny: bag1 = bag2. bag2 add: #c. self assert: bag1 = bag2 |
| BagTest>>testCreation: (no stamp -> EP 2/28/2006 09:56) |
no previous history |
testCreation "self run: #testCreation" "self debug: #testCreation" | bag | bag := Bag new. self assert: (bag size) = 0. self assert: (bag isEmpty). |
| BagTest>>testSortedCounts: (no stamp -> EP 2/28/2006 09:48) |
no previous history |
testSortedCounts "self run: #testSortedCounts" "self debug: #testSortedCounts" | bag sortedCounts| bag := Bag new. bag add: '1' withOccurrences: 10. bag add: '2' withOccurrences: 1. bag add: '3' withOccurrences: 5. sortedCounts := bag sortedCounts. self assert: sortedCounts size = 3. self assert: sortedCounts first = (10->'1'). self assert: sortedCounts second = (5->'3'). self assert: sortedCounts third = (1->'2'). |
| BagTest>>testCumulativeCounts: (no stamp -> EP 2/28/2006 10:05) |
no previous history |
testCumulativeCounts "self run: #testCumulativeCounts" "self debug: #testCumulativeCounts" | bag cumulativeCounts | bag := Bag new. bag add: '1' withOccurrences: 50. bag add: '2' withOccurrences: 40. bag add: '3' withOccurrences: 10. cumulativeCounts := bag cumulativeCounts. self assert: cumulativeCounts size = 3. self assert: cumulativeCounts first = (50 -> '1'). self assert: cumulativeCounts second = (90 -> '2'). self assert: cumulativeCounts third = (100 -> '3'). |
| BagTest>>testSortedElements: (no stamp -> EP 2/28/2006 09:48) |
no previous history |
testSortedElements
"self run: #testSortedElements"
"self debug: #testSortedElements"
| bag sortedElements|
bag := Bag new.
bag add: '2' withOccurrences: 1.
bag add: '1' withOccurrences: 10.
bag add: '3' withOccurrences: 5.
sortedElements := bag sortedElements.
self assert: sortedElements size = 3.
self assert: sortedElements first = ('1'->10).
self assert: sortedElements second = ('2'->1).
self assert: sortedElements third = ('3'->5).
|
| BagTest>>testRemove: (no stamp -> EP 2/28/2006 09:57) |
no previous history |
testRemove "self run: #testRemove" "self debug: #testRemove" | bag item | item := 'test item'. bag := Bag new. bag add: item. self assert: (bag size) = 1. bag remove: item. self assert: bag isEmpty. bag add: item withOccurrences: 2. bag remove: item. bag remove: item. self assert: (bag size) = 0. self should: [bag remove: item.] raise: Error. |
| IdentityBagTest>>testIdentity: (no stamp -> EP 3/8/2006 09:50) |
no previous history |
testIdentity "self run:#testIdentity" "self debug:#testIdentity" | bag identityBag aString anOtherString | aString := 'hello'. anOtherString := aString copy. self assert: (aString = anOtherString). self assert: (aString == anOtherString) not. bag := Bag new. bag add: aString. bag add: aString. bag add: anOtherString. self assert: (bag occurrencesOf: aString) = 3. self assert: (bag occurrencesOf: anOtherString) = 3. identityBag := IdentityBag new. identityBag add: aString. identityBag add: aString. identityBag add: anOtherString. self assert: (identityBag occurrencesOf: aString) = 2. self assert: (identityBag occurrencesOf: anOtherString) = 1. |
| HttpUrl>>retrieveContentsArgs:: (mir 7/26/2000 12:56 -> EW 4/30/2006 12:00) |
retrieveContentsArgs: args ^self retrieveContentsArgs: args accept: 'application/octet-stream' |
retrieveContentsArgs: args ^self retrieveContentsArgs: args accept: '*/*; q=1' |
retrieveContentsArgs: args ^self retrieveContentsArgs: args accept: '*/*; q=1' ^self retrieveContentsArgs: args accept: 'application/octet-stream' |
| SetTest>>testUnion: (no stamp -> GL 3/8/2006 00:50) |
no previous history |
testUnion | newFull col newCol | full add: 3. full add: 2. col := full union: full. self assert: (full = col). newFull := Set with: 8 with: 9 with: #z. col := newFull union: full. self assert: (col size = (full size + newFull size)). self assert: ((col select: [:each | (full includes: each) not]) = newFull). self assert: ((col select: [:each | (newFull includes: each) not]) = full). full add: 9. col := newFull union: full. newCol := newFull copy. newCol remove: 9. self assert: (col size = (full size + newFull size - 1)). self assert: ((col select: [:each | (full includes: each) not]) = newCol). newCol := full copy. newCol remove: 9. self assert: ((col select: [:each | (newFull includes: each) not]) = newCol). |
| SetTest>>testCopy: (no stamp -> GL 2/28/2006 09:46) |
no previous history |
testCopy | newFull | full add: 3. full add: 2. newFull := full copy. self assert: (full size = newFull size). self assert: ((full select: [:each | (newFull includes: each) not]) isEmpty). self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty). |
| SetTest>>testIllegal: (no stamp -> GL 2/28/2006 08:23) |
no previous history |
testIllegal self should: [empty at: 5] raise: TestResult error. self should: [empty at: 5 put: #abc] raise: TestResult error. |
| SetTest>>testAtRandom: (no stamp -> GL 2/28/2006 09:25) |
no previous history |
testAtRandom | rand | rand := Random new. full add: 3. full add: 2. full add: 4. full add: 1. self assert: (full includes: (full atRandom: rand)). |
| SetTest>>testAdd: (no stamp -> GL 2/28/2006 08:26) |
no previous history |
testAdd empty add: 5. self assert: (empty includes: 5). |
| SetTest>>testGrow: (no stamp -> GL 2/28/2006 08:27) |
no previous history |
testGrow empty addAll: (1 to: 100). self assert: (empty size = 100). |
| SetTest>>testCopyWithout: (no stamp -> GL 3/8/2006 00:06) |
no previous history |
testCopyWithout | newFull | full add: 3. full add: 2. newFull := full copyWithout: 3. self assert: (newFull size = (full size - 1)). self deny: (newFull includes: 3). self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty). self assert: ((full select: [:each | (newFull includes: each) not]) = (Set with: 3)). |
| SetTest>>testAddWithOccurences: (no stamp -> GL 3/16/2006 10:36) |
no previous history |
testAddWithOccurences empty add: 2 withOccurrences: 3. self assert: (empty includes: 2). self assert: ((empty occurrencesOf: 2) = 1). |
| SetTest>>testIntersection: (no stamp -> GL 3/8/2006 09:55) |
no previous history |
testIntersection | newFull col | full add: 3; add: 2. col := full intersection: full. self assert: (full = col). newFull := Set with: 8 with: 9 with: #z. col := newFull intersection: full. self assert: (col isEmpty). newFull add: 5; add: #abc; add: 7. col := newFull intersection: full. self assert: ((full select: [:each | (newFull includes: each)]) = col). |
| StandardFileMenu class>>oldFileFrom:withPattern:: (no stamp -> MM 4/6/2004 22:56) |
no previous history |
oldFileFrom: aDirectory withPattern: aPattern " Select an existing file from a selection conforming to aPattern. " ^(self oldFileMenu: aDirectory withPattern: aPattern) startUpWithCaption: 'Select a File:' translated |
| DictionaryTest>>testOccurrencesOf: (no stamp -> NDCC 3/8/2006 09:41) |
no previous history |
testOccurrencesOf "self run:#testOccurrencesOf" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. dict at: #c put: 1. dict at: #d put: 3. dict at: nil put: nil. dict at: #z put: nil. self assert: (dict occurrencesOf: 1 ) = 2. self assert: (dict occurrencesOf: nil ) = 2. |
| Boolean>>==>: (hg 1/2/2002 13:57 -> PH 10/3/2003 08:10) |
==> aBlock "this is logical implicature, a ==> b, also known as b iff a (if and only if)" ^self not or: [aBlock value] |
==> aBlock "this is material implication, a ==> b, also known as: b if a a implies b if a then b b is a consequence of a a therefore b (but note: 'it is raining therefore it is cloudy' is implication; 'it is autumn therefore the leaves are falling' is equivalence). Here is the truth table for material implication (view in a monospaced font): p | q | p ==> q -------|-------|------------- T | T | T T | F | F F | T | T F | F | T " ^self not or: [aBlock value] |
==> aBlock "this is material implication, a ==> b, also known as: b if a a implies b if a then b b is a consequence of a a therefore b (but note: 'it is raining therefore it is cloudy' is implication; 'it is autumn therefore the leaves are falling' is equivalence). Here is the truth table for material implication (view in a monospaced font): p | q | p ==> q -------|-------|------------- T | T | T T | F | F F | T | T F | F | T " "this is logical implicature, a ==> b, also known as b iff a (if and only if)" ^self not or: [aBlock value] |
| Number>>asFloatD: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloatD "Answer a d precision floating-point number approximating the receiver." #Numeric. "add 200/01/19 For ANSI <number> protocol." ^ self asFloat |
| Number>>asScaledDecimal:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asScaledDecimal: scale "Answer a scaled decimal number, with a fractional precision of scale, approximating the receiver." #Numeric. "add 200/01/19 For number protocol." ^ ScaledDecimal newFromNumber: self scale: scale |
| Number>>integerPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
integerPart "Answer the integer part of the receiver." #Numeric. "2000/03/04 Harmon R. Added ANSI <number> protocol" ^ self truncated |
| Number>>asFloatE: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloatE "Answer a floating-point number approximating the receiver." #Numeric. "add 200/01/19 For ANSI <number> protocol." ^ self asFloat |
| Number>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Do any required conversion and then the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ self subclassResponsibility |
| Number>>asFloatQ: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloatQ "Answer a floating-point number approximating the receiver." #Numeric. "add 200/01/19 For ANSI <number> protocol." ^ self asFloat |
| Number>>fractionPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
fractionPart "Answer the fractional part of the receiver." #Numeric. "2000/03/04 Harmon R. Added ANSI <number> protocol" ^ self - self truncated |
| Number>>raisedToInteger:: (RJ 3/15/1999 19:32 -> RAH 4/25/2000 19:49) |
raisedToInteger: anInteger "Answer the receiver raised to the power anInteger where the argument must be a kind of Integer. This is a special case of raisedTo:." anInteger isInteger ifFalse: [^self error: 'raisedToInteger: only works for integral arguments']. anInteger = 0 ifTrue: [^ 1]. (self = 0) | (anInteger = 1) ifTrue: [^ self]. anInteger > 1 ifTrue: [^ (self * self raisedToInteger: anInteger // 2) * (self raisedToInteger: anInteger \\ 2)]. ^ (self raisedToInteger: anInteger negated) reciprocal |
raisedToInteger: operand "Answer the receiver raised to the power operand, an Integer." | count result | #Numeric. "Changed 200/01/19 For ANSI <number> support." operand isInteger ifFalse: [^ ArithmeticError signal: 'parameter is not an Integer'"<- Chg"]. operand = 0 ifTrue: [^ self class one]. operand = 1 ifTrue: [^ self]. operand < 0 ifTrue: [^ (self raisedToInteger: operand negated) reciprocal]. count := 1. [(count := count + count) < operand] whileTrue. result := self class one. [count > 0] whileTrue: [result := result * result. (operand bitAnd: count) = 0 ifFalse: [result := result * self]. count := count bitShift: -1]. ^ result |
raisedToInteger: operand "Answer the receiver raised to the power operand, an Integer." | count result | #Numeric. "Changed 200/01/19 For ANSI <number> support." operand isInteger ifFalse: [^ ArithmeticError signal: 'parameter is not an Integer'"<- Chg"]. operand = 0 ifTrue: [^ self class one]. operand = 1 ifTrue: [^ self]. operand < 0 ifTrue: [^ (self raisedToInteger: operand negated) reciprocal]. count := 1. [(count := count + count) < operand] whileTrue. result := self class one. [count > 0] whileTrue: [result := result * result. (operand bitAnd: count) = 0 ifFalse: [result := result * self]. count := count bitShift: -1]. ^ result raisedToInteger: anInteger "Answer the receiver raised to the power anInteger where the argument must be a kind of Integer. This is a special case of raisedTo:." anInteger isInteger ifFalse: [^self error: 'raisedToInteger: only works for integral arguments']. anInteger = 0 ifTrue: [^ 1]. (self = 0) | (anInteger = 1) ifTrue: [^ self]. anInteger > 1 ifTrue: [^ (self * self raisedToInteger: anInteger // 2) * (self raisedToInteger: anInteger \\ 2)]. ^ (self raisedToInteger: anInteger negated) reciprocal |
| Number>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
reciprocal "Answer 1 divided by the receiver. Create an error notification if the receiver is 0." self = 0 ifTrue: [^self error: 'zero has no reciprocal'] ifFalse: [^1 / self] |
reciprocal "Answer 1 divided by the receiver. Create an error notification if the receiver is 0." #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. ^ 1 / self |
reciprocal "Answer 1 divided by the receiver. Create an error notification if the receiver is 0." #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. ^ 1 / self self = 0 ifTrue: [^self error: 'zero has no reciprocal'] ifFalse: [^1 / self] |
| Fraction class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one #Numeric. "add 200/01/19 For <number> protocol support." ^ self numerator: 1 denominator: 1 |
| Fraction>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Convert receiverScaledDecimal to a Fraction and do the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ receiverScaledDecimal asFraction perform: arithmeticOpSelector with: self |
| Fraction>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
reciprocal "Refer to the comment in Number|reciprocal." numerator = 0 ifTrue: [self error: '0 has no reciprocal']. numerator = 1 ifTrue: [^denominator]. numerator = -1 ifTrue: [^denominator negated]. ^Fraction numerator: denominator denominator: numerator |
reciprocal "Refer to the comment in Number|reciprocal." #Numeric. "Changed 200/01/19 For ANSI <number> support." numerator = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. numerator = 1 ifTrue: [^ denominator]. numerator = -1 ifTrue: [^ denominator negated]. ^ Fraction numerator: denominator denominator: numerator |
reciprocal reciprocal "Refer to the comment in Number|reciprocal." #Numeric. "Changed 200/01/19 For ANSI <number> support." numerator = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. numerator = 1 ifTrue: [^ denominator]. numerator = -1 ifTrue: [^ denominator negated]. ^ Fraction numerator: denominator denominator: numerator numerator = 0 ifTrue: [self error: '0 has no reciprocal']. numerator = 1 ifTrue: [^denominator]. numerator = -1 ifTrue: [^denominator negated]. ^Fraction numerator: denominator denominator: numerator |
| Float class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one #Numeric. "add 200/01/19 For <number> protocol support." ^ 1.0 |
| Float>>sqrt: (no stamp -> RAH 4/25/2000 19:49) |
sqrt "Answer the square root of the receiver. Optional. See Object documentation whatIsAPrimitive." | exp guess eps delta | <primitive: 55> "Newton-Raphson" self <= 0.0 ifTrue: [ self = 0.0 ifTrue: [^ 0.0] ifFalse: [^ self error: 'sqrt is invalid for x < 0']]. "first guess is half the exponent" exp _ self exponent // 2. guess _ self timesTwoPower: (0 - exp). "get eps value" eps _ guess * Epsilon. eps _ eps * eps. delta _ (self - (guess * guess)) / (guess * 2.0). [(delta * delta) > eps] whileTrue: [ guess _ guess + delta. delta _ (self - (guess * guess)) / (guess * 2.0)]. ^ guess |
sqrt "Answer the square root of the receiver. Optional. See Object documentation whatIsAPrimitive." | exp guess eps delta | <primitive: 55> #Numeric. "Changed 200/01/19 For ANSI <number> support." "Newton-Raphson" self <= 0.0 ifTrue: [self = 0.0 ifTrue: [^ 0.0] ifFalse: ["v Chg" ^ FloatingPointException signal: 'undefined if less than zero.']]. "first guess is half the exponent" exp := self exponent // 2. guess := self timesTwoPower: 0 - exp. "get eps value" eps := guess * Epsilon. eps := eps * eps. delta := self - (guess * guess) / (guess * 2.0). [delta * delta > eps] whileTrue: [guess := guess + delta. delta := self - (guess * guess) / (guess * 2.0)]. ^ guess |
sqrt "Answer the square root of the receiver. "Answer the square root of the receiver. Optional. See Object documentation whatIsAPrimitive." | exp guess eps delta | <primitive: 55> #Numeric. "Changed 200/01/19 For ANSI <number> support." "Newton-Raphson" self <= 0.0 ifTrue: [self = 0.0 ifTrue: [^ 0.0] ifFalse: ["v Chg" ^ FloatingPointException signal: 'undefined if less than zero.']]. self <= 0.0 ifTrue: [ self = 0.0 ifTrue: [^ 0.0] ifFalse: [^ self error: 'sqrt is invalid for x < 0']]. "first guess is half the exponent" exp := self exponent // 2. guess := self timesTwoPower: 0 - exp. exp _ self exponent // 2. guess _ self timesTwoPower: (0 - exp). "get eps value" eps := guess * Epsilon. eps := eps * eps. delta := self - (guess * guess) / (guess * 2.0). [delta * delta > eps] whileTrue: [guess := guess + delta. delta := self - (guess * guess) / (guess * 2.0)]. eps _ guess * Epsilon. eps _ eps * eps. delta _ (self - (guess * guess)) / (guess * 2.0). [(delta * delta) > eps] whileTrue: [ guess _ guess + delta. delta _ (self - (guess * guess)) / (guess * 2.0)]. ^ guess |
| Float>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Convert receiverScaledDecimal to a Float and do the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ receiverScaledDecimal asFloat perform: arithmeticOpSelector with: self |
| Float>>printPaddedWith:to:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printPaddedWith: aCharacter to: aNumber "Answer the string containing the ASCII representation of the receiver padded on the left with aCharacter to be at least on aNumber integerPart characters and padded the right with aCharacter to be at least anInteger fractionPart characters." | aStream digits fPadding fLen iPadding iLen curLen periodIndex | #Numeric. "2000/03/04 Harmon R. Added Date and Time support" aStream := WriteStream on: (String new: 10). self printOn: aStream. digits := aStream contents. periodIndex := digits indexOf: $.. curLen := periodIndex - 1. iLen := aNumber integerPart. curLen < iLen ifTrue: [iPadding := (String new: (iLen - curLen) asInteger) atAllPut: aCharacter; yourself] ifFalse: [iPadding := '']. curLen := digits size - periodIndex. fLen := (aNumber fractionPart * (aNumber asFloat exponent * 10)) asInteger. curLen < fLen ifTrue: [fPadding := (String new: fLen - curLen) atAllPut: aCharacter; yourself] ifFalse: [fPadding := '']. ^ iPadding , digits , fPadding |
| Float>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
reciprocal ^ 1.0 / self |
reciprocal #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: ["<- Chg" ^ (ZeroDivide dividend: self) signal"<- Chg"]. "<- Chg" ^ 1.0 / self |
reciprocal #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: ["<- Chg" ^ (ZeroDivide dividend: self) signal"<- Chg"]. "<- Chg" ^ 1.0 / self |
| Integer class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one #Numeric. "add 200/01/19 For <number> protocol support." ^ 1 |
| Integer>>asScaledDecimal:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asScaledDecimal: scaleNotUsed "The number of significant digits of the answer is the same as the number of decimal digits in the receiver. The scale of the answer is 0." #Numeric. "add 200/01/19 For <integer> protocol." ^ ScaledDecimal newFromNumber: self scale: 0 |
| Integer>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Convert me to a ScaledDecimal and do the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ receiverScaledDecimal perform: arithmeticOpSelector with: (self asScaledDecimal: 0) |
| Integer>>printPaddedWith:to:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printPaddedWith: aCharacter to: anInteger "Answer the string containing the ASCII representation of the receiver padded on the left with aCharacter to be at least anInteger characters." #Numeric. "2000/03/04 Harmon R. Added Date and Time support" ^ self printPaddedWith: aCharacter to: anInteger base: 10 |
| Integer>>//: (no stamp -> RAH 4/25/2000 19:49) |
// aNumber | q | aNumber = 0 ifTrue: [^self error: 'division by 0']. self = 0 ifTrue: [^0]. q _ self quo: aNumber "Refer to the comment in Number|//.". (q negative ifTrue: [q * aNumber ~= self] ifFalse: [q = 0 and: [self negative ~= aNumber negative]]) ifTrue: [^q - 1"Truncate towards minus infinity"] ifFalse: [^q] |
// aNumber | q | #Numeric. "Changed 200/01/19 For ANSI support." aNumber = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. self = 0 ifTrue: [^ 0]. q := self quo: aNumber. "Refer to the comment in Number|//." (q negative ifTrue: [q * aNumber ~= self] ifFalse: [q = 0 and: [self negative ~= aNumber negative]]) ifTrue: [^ q - 1"Truncate towards minus infinity."] ifFalse: [^ q] |
// aNumber // aNumber | q | #Numeric. "Changed 200/01/19 For ANSI support." aNumber = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. self = 0 ifTrue: [^ 0]. q := self quo: aNumber. "Refer to the comment in Number|//." aNumber = 0 ifTrue: [^self error: 'division by 0']. self = 0 ifTrue: [^0]. q _ self quo: aNumber "Refer to the comment in Number|//.". (q negative ifTrue: [q * aNumber ~= self] ifFalse: [q = 0 and: [self negative ~= aNumber negative]]) ifTrue: [^ q - 1"Truncate towards minus infinity."] ifFalse: [^ q] ifTrue: [^q - 1"Truncate towards minus infinity"] ifFalse: [^q] |
| ScaledDecimal class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one "Answer the receiver's representation of one." ^ self newFromNumber: 1 scale: 0 |
| ScaledDecimal class>>zero: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
zero "Answer the receiver's representation of zero." ^ self newFromNumber: 0 scale: 0 |
| ScaledDecimal class>>newFromNumber:scale:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
newFromNumber: aNumber scale: scaleIn "Answer a new instance of me." | temp | temp := self basicNew. temp setFraction: aNumber asFraction scale: scaleIn. ^ temp |
| ScaledDecimal>>setFraction:scale:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
setFraction: fractionIn scale: scaleIn "Private - Set the fraction to fractionIn and the total number of digits used to represent the fraction part of the receiver, including trailing zeroes, to the Integer scaleIn." fraction := fractionIn. scale := scaleIn |
| ScaledDecimal>>printString: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printString "Reimplementation - Number 'printing' method." | tempStream | tempStream := WriteStream on: (String new: 10). self printOn: tempStream. ^ tempStream contents |
| ScaledDecimal>>//: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
// operand "Answer the integer quotient after dividing the receiver by operand with truncation towards negative infinity." ^ fraction // operand |
| ScaledDecimal>>adaptToInteger:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToInteger: receiver andSend: arithmeticOpSelector "Convert receiver to a ScaledDecimal and do the arithmetic. receiver arithmeticOpSelector self." ^ (receiver asScaledDecimal: 0) perform: arithmeticOpSelector with: self |
| ScaledDecimal>>adaptToFraction:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToFraction: receiver andSend: arithmeticOpSelector "Convert me to a Fraction and do the arithmetic. receiver arithmeticOpSelector self." ^ receiver perform: arithmeticOpSelector with: fraction |
| ScaledDecimal>>scale: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
scale "Private - Answer a integer which represents the total number of digits used to represent the fraction part of the receiver, including trailing zeroes. " ^ scale |
| ScaledDecimal>>hash: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
hash "Reimplementation of Object 'comparing' method." ^ fraction hash |
| ScaledDecimal>>negated: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
negated "Reimplementation of Number 'arithmetic' method." ^ ScaledDecimal newFromNumber: fraction negated scale: scale |
| ScaledDecimal>>isZero: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
isZero "Answer whether the receiver is equal to its class' zero" ^ fraction numerator = 0 |
| ScaledDecimal>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
reciprocal "Reimplementation of Number 'arithmetic' method." self = 0 ifTrue: [^ (ZeroDivide dividend: 1) signal]. ^ ScaledDecimal newFromNumber: fraction reciprocal scale: scale |
| ScaledDecimal>>squared: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
squared "Reimplementation - Number 'mathematical functions' method." "not used ->" ^ ScaledDecimal newFromNumber: fraction squared scale: scale |
| ScaledDecimal>>integerPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
integerPart "Answer the fractional part of the receiver." ^ ScaledDecimal newFromNumber: fraction integerPart scale: scale |
| ScaledDecimal>>asFloat: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloat "Reimplementation - Number 'converting' method." ^ fraction asFloat |
| ScaledDecimal>>isScaledDecimal: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
isScaledDecimal "Reimplementation - Number 'testing' method." ^ true |
| ScaledDecimal>>asSpecies:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asSpecies: number "Convert number to a ScaledDecimal." #Numeric. "add 200/01/19 For ANSI <number>support." ^ ScaledDecimal newFromNumber: number scale: scale |
| ScaledDecimal>>numerator: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
numerator "Private - Answer an Integer, the numerator part of the receiver." ^ fraction numerator |
| ScaledDecimal>>fractionPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
fractionPart "Answer the fractional part of the receiver." ^ ScaledDecimal newFromNumber: fraction fractionPart scale: scale |
| ScaledDecimal>>printOn:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printOn: aStream "Reimplementation - Object 'printing' method." | aFraction tmpFractionPart | self < 0 ifTrue: [aStream nextPut: $-]. aFraction := fraction abs. aStream nextPutAll: aFraction truncated printString. scale = 0 ifTrue: [^ aStream nextPutAll: 's0']. aStream nextPut: $.. tmpFractionPart := aFraction fractionPart. 1 to: scale do: [:dummy | tmpFractionPart := tmpFractionPart * 10. aStream nextPut: (Character digitValue: tmpFractionPart truncated). tmpFractionPart := tmpFractionPart fractionPart]. aStream nextPut: $s. scale printOn: aStream |
| ScaledDecimal>>denominator: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
denominator "Private - Answer an Integer, the denominator part of the receiver." ^ fraction denominator |
| ScaledDecimal>>asFraction: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFraction "Implementation - Number 'converting' method." ^ fraction |
| ScaledDecimal>>asScaledDecimal:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asScaledDecimal: scaleIn "Reimplementation - Number 'converting' method." ^ ScaledDecimal newFromNumber: fraction scale: scaleIn |
| ScaledDecimal>>truncated: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
truncated "Reimplementation of Number 'truncation and round off' method." ^ fraction truncated |
| Character class>>codePoint:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
codePoint: integer "Return a character whose encoding value is integer." #Fundmntl. (0 > integer or: [255 < integer]) ifTrue: [self error: 'parameter out of range 0..255']. ^ CharacterTable at: integer + 1 |
| Character>>codePoint: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
codePoint "Return the encoding value of the receiver." #Fundmntl. ^ self asciiValue |
| BlockContext>>argumentCount: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
argumentCount "Answers the number of arguments needed to evaluate the receiver." #Valuable. ^ self numArgs |
| ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:caption:tickPrintBlock:: (di 2/17/98 12:11 -> RCS 3/16/2000 14:54) |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk start _ strt. stop _ stp. minorTick _ mnt. minorTickLength _ mntLen. majorTick _ mjt. majorTickLength _ mjtLen. caption _ cap. tickPrintBlock_ blk fixTemps. self buildLabels |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: true captionAbove: true. |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: true captionAbove: true. start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk start _ strt. stop _ stp. minorTick _ mnt. minorTickLength _ mntLen. majorTick _ mjt. majorTickLength _ mjtLen. caption _ cap. tickPrintBlock_ blk fixTemps. self buildLabels |
| ScaleMorph>>labelsAbove:: (no stamp -> RCS 3/16/2000 00:38) |
no previous history |
labelsAbove: aBoolean labelsAbove _ aBoolean. |
| ScaleMorph>>extent:: (di 2/19/98 21:41 -> RCS 3/16/2000 13:59) |
extent: newExtent | pixPerTick newWidth | pixPerTick _ (newExtent x - (self borderWidth*2) - 1) / ((stop-start) asFloat / minorTick). pixPerTick _ pixPerTick detentBy: 0.1 atMultiplesOf: 1.0 snap: false. newWidth _ pixPerTick * ((stop-start) asFloat / minorTick) + (self borderWidth*2) + 1. super extent: newWidth @ newExtent y. self buildLabels |
extent: newExtent | modExtent | modExtent _ self checkExtent: newExtent. super extent: modExtent. self buildLabels |
extent: newExtent | modExtent | modExtent _ self checkExtent: newExtent. super extent: modExtent. extent: newExtent | pixPerTick newWidth | pixPerTick _ (newExtent x - (self borderWidth*2) - 1) / ((stop-start) asFloat / minorTick). pixPerTick _ pixPerTick detentBy: 0.1 atMultiplesOf: 1.0 snap: false. newWidth _ pixPerTick * ((stop-start) asFloat / minorTick) + (self borderWidth*2) + 1. super extent: newWidth @ newExtent y. self buildLabels |
| ScaleMorph>>tickPrintBlock:: (no stamp -> RCS 3/15/2000 21:47) |
no previous history |
tickPrintBlock: aBlock tickPrintBlock _ aBlock. |
| ScaleMorph>>start: (no stamp -> RCS 3/15/2000 21:43) |
no previous history |
start ^ start |
| ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:caption:tickPrintBlock:labelsAbove:captionAbove:: (no stamp -> RCS 3/16/2000 15:09) |
no previous history |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: aBoolean captionAbove: notherBoolean start _ strt. stop _ stp. minorTick _ mnt. minorTickLength _ mntLen. majorTick _ mjt. majorTickLength _ mjtLen. caption _ cap. tickPrintBlock _ blk. labelsAbove _ aBoolean. captionAbove _ notherBoolean. self buildLabels |
| ScaleMorph>>minorTickLength:: (no stamp -> RCS 3/15/2000 21:46) |
no previous history |
minorTickLength: anInteger minorTickLength _ anInteger. |
| ScaleMorph>>caption: (no stamp -> RCS 3/15/2000 21:41) |
no previous history |
caption ^ caption. |
| ScaleMorph>>stop:: (no stamp -> RCS 3/15/2000 21:44) |
no previous history |
stop: aNumber stop _ aNumber. |
| ScaleMorph>>start:: (no stamp -> RCS 3/15/2000 21:43) |
no previous history |
start: aNumber start _ aNumber. |
| ScaleMorph>>stop: (no stamp -> RCS 3/15/2000 21:43) |
no previous history |
stop ^ stop |
| ScaleMorph>>drawTicksOn:: (no stamp -> RCS 3/16/2000 14:19) |
no previous history |
drawTicksOn: aCanvas self drawMajorTicksOn: aCanvas. self drawMinorTicksOn: aCanvas |
| ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:: (no stamp -> RCS 3/16/2000 14:55) |
no previous history |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: nil tickPrintBlock: nil |
| ScaleMorph>>caption:: (no stamp -> RCS 3/15/2000 21:42) |
no previous history |
caption: aString caption _ aString. |
| ScaleMorph>>captionAbove:: (no stamp -> RCS 3/16/2000 00:38) |
no previous history |
captionAbove: aBoolean captionAbove _ aBoolean |
| ScaleMorph>>drawOn:: (RCS 10/25/1999 18:42 -> RCS 3/15/2000 21:36) |
drawOn: aCanvas
| scale x1 y1 y2 x y3 even yy loopStart checkStart |
super drawOn: aCanvas.
scale _ (self innerBounds width-1) / (stop-start) asFloat.
x1 _ self innerBounds left.
y1 _ self innerBounds bottom - 1.
y2 _ y1 - minorTickLength.
loopStart _ ((start / minorTick ) ceiling) * minorTick.
loopStart to: stop by: minorTick do:
[:v | x _ x1 + (scale*(v - start)).
aCanvas line: x@y1 to: x@y2 width: 1 color: Color black].
x1 _ self innerBounds left.
y2 _ y1 - majorTickLength.
y3 _ y1 - (minorTickLength+majorTickLength//2).
even _ true.
"Make sure mjor ticks start drawing on a multiple of majorTick"
loopStart _ ((start / majorTick ) ceiling) * majorTick.
checkStart _ ((start / (majorTick/2.0) ) ceiling) * majorTick.
"Check to see if semimajor tick should be drawn before majorTick"
( checkStart = (loopStart * 2) ) ifFalse:
[ loopStart _ checkStart/2.0.
even _ false. ].
loopStart to: stop by: majorTick/2.0 do:
[:v | x _ x1 + (scale*(v - start)).
yy _ even ifTrue: [y2] ifFalse: [y3].
aCanvas line: x@y1 to: x@yy width: 1 color: Color black.
even _ even not].
|
drawOn: aCanvas | | super drawOn: aCanvas. self drawTicksOn: aCanvas. |
drawOn: aCanvas | | super drawOn: aCanvas. self drawTicksOn: aCanvas. drawOn: aCanvas | scale x1 y1 y2 x y3 even yy loopStart checkStart | super drawOn: aCanvas. scale _ (self innerBounds width-1) / (stop-start) asFloat. x1 _ self innerBounds left. y1 _ self innerBounds bottom - 1. y2 _ y1 - minorTickLength. loopStart _ ((start / minorTick ) ceiling) * minorTick. loopStart to: stop by: minorTick do: [:v | x _ x1 + (scale*(v - start)). aCanvas line: x@y1 to: x@y2 width: 1 color: Color black]. x1 _ self innerBounds left. y2 _ y1 - majorTickLength. y3 _ y1 - (minorTickLength+majorTickLength//2). even _ true. "Make sure mjor ticks start drawing on a multiple of majorTick" loopStart _ ((start / majorTick ) ceiling) * majorTick. checkStart _ ((start / (majorTick/2.0) ) ceiling) * majorTick. "Check to see if semimajor tick should be drawn before majorTick" ( checkStart = (loopStart * 2) ) ifFalse: [ loopStart _ checkStart/2.0. even _ false. ]. loopStart to: stop by: majorTick/2.0 do: [:v | x _ x1 + (scale*(v - start)). yy _ even ifTrue: [y2] ifFalse: [y3]. aCanvas line: x@y1 to: x@yy width: 1 color: Color black. even _ even not]. |
| ScaleMorph>>majorTickLength:: (no stamp -> RCS 3/15/2000 21:46) |
no previous history |
majorTickLength: anInteger majorTickLength _ anInteger |
| ScaleMorph>>checkExtent:: (no stamp -> RCS 3/16/2000 13:58) |
no previous history |
checkExtent: newExtent | pixPerTick newWidth | pixPerTick _ newExtent x - (self borderWidth * 2) - 1 / ((stop - start) asFloat / minorTick). pixPerTick _ pixPerTick detentBy: 0.1 atMultiplesOf: 1.0 snap: false. newWidth _ pixPerTick * ((stop - start) asFloat / minorTick) + (self borderWidth * 2) + 1. ^ (newWidth @ newExtent y). |
| SkipListTest>>testAtPutAlreadyPresent: (no stamp -> YE 3/8/2006 10:00) |
no previous history |
testAtPutAlreadyPresent "self run: #testAtPutAlreadyPresent" "self debug: #testAtPutAlreadyPresent" | sk | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk at: 3 put: '666'. self assert: (sk at: 7) = '77777'. self assert: (sk includes: 7). self assert: (sk at: 3) = '3333'. self assert: (sk includes: 3). self assert: (sk size) = 3 |
| SkipListTest>>testIfPresent: (no stamp -> YE 3/16/2006 10:49) |
no previous history |
testIfPresent "self run: #testIfPresent" "self debug: #testIfPresent" | sk | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk add: 7 ifPresent: [sk at: 8 put: '88']. self assert: (sk at: 7) = '77777'. self assert: (sk at: 8) = '88'. |
| SkipListTest>>testRandomLevel: (no stamp -> YE 2/28/2006 09:45) |
no previous history |
testRandomLevel "a randomLevel should not be greater than maxLevel" "self run: #testRandomLevel" | s | s := SkipList new. s maxLevel: 5. self assert: s randomLevel <= 5 |
| SkipListTest>>testIfAbsent: (no stamp -> YE 3/16/2006 10:50) |
no previous history |
testIfAbsent "self run: #testIfAbsent" "self debug: #testIfAbsent" | sk temp | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk add: 7 ifPresent: [sk at: 8 put: '88']. temp := sk at: 9 ifAbsent: [sk at: 8]. self assert: (temp = '88') |
| SkipListTest>>testCreation: (no stamp -> YE 3/8/2006 09:56) |
no previous history |
testCreation "self run: #testCreation" "self debug: #testCreation" | sk | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. self assert: (sk at: 7) = '77777'. self assert: (sk includes: 7). |
| SkipListTest>>testIsEqualTo: (no stamp -> YE 3/16/2006 11:47) |
no previous history |
testIsEqualTo "self run: #testIsEqualTo" "self debug: #testIsEqualTo" | sk sk2 | sk := SkipList new. sk2 := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk at: 9 put: '3333'. sk2 at: 3 put: '3333'. sk2 at: 5 put: '3333'. self assert: (sk is: (sk at: 3) equalTo: (sk at: 9)). self assert: (sk is: (sk at: 3) equalTo: (sk2 at: 3)). self assert: (sk is: (sk at: 3) equalTo: (sk2 at: 5)) |
| MCTestCase>>compileClass:source:category:: (cwp 7/21/2003 22:51 -> abc 2/16/2006 09:24) |
compileClass: aClass source: source category: category aClass compileInobtrusively: source classified: category |
compileClass: aClass source: source category: category aClass compileSilently: source classified: category |
compileClass: aClass source: source category: category aClass compileSilently: source classified: category aClass compileInobtrusively: source classified: category |
| MCMergeRecord class>>version:: (no stamp -> abc 2/13/2004 15:52) |
no previous history |
version: aVersion ^ self basicNew initializeWithVersion: aVersion |
| MCMergeRecord>>isAncestorMerge: (no stamp -> abc 2/13/2004 17:14) |
no previous history |
isAncestorMerge ^ version workingCopy ancestry hasAncestor: version info |
| MCMergeRecord>>version: (no stamp -> abc 2/13/2004 15:52) |
no previous history |
version ^ version |
| MCMergeRecord>>updateWorkingCopy: (no stamp -> abc 2/13/2004 17:14) |
no previous history |
updateWorkingCopy self isAncestorMerge ifFalse: [self imageIsClean ifTrue: [version workingCopy loaded: version] ifFalse: [version workingCopy merged: version]] |
| MCWorkingCopy>>merged:: (no stamp -> abc 2/13/2004 15:57) |
no previous history |
merged: aVersion ancestry addAncestor: aVersion info. self changed |
| MCVersion>>merge: (no stamp -> abc 2/13/2004 15:58) |
no previous history |
merge MCVersionMerger mergeVersion: self |
| MCVersionMerger>>merge: (no stamp -> abc 2/13/2004 17:15) |
no previous history |
merge records do: [:ea | merger addBaseSnapshot: ea packageSnapshot]. records do: [:ea | merger applyPatch: ea mergePatch]. self resolveConflicts ifTrue: [merger load. records do: [:ea | ea updateWorkingCopy]]. |
| MCRepositoryGroup>>useCache: (no stamp -> no stamp) |
no previous history |
not found |
| MCRepositoryGroup>>includesVersionNamed:: (no stamp -> abc 11/6/2004 20:32) |
no previous history |
includesVersionNamed: aString self repositoriesDo: [:ea | (ea includesVersionNamed: aString) ifTrue: [^ true]]. ^ false |
| Browser>>classMessagesIndicated: (no stamp -> ak 11/24/2000 21:46) |
classMessagesIndicated "Answer whether the messages to be presented should come from the metaclass." ^ self metaClassIndicated |
classMessagesIndicated "Answer whether the messages to be presented should come from the metaclass." ^ self metaClassIndicated and: [self classCommentIndicated not] |
classMessagesIndicated "Answer whether the messages to be presented should come from the metaclass." ^ self metaClassIndicated and: [self classCommentIndicated not] ^ self metaClassIndicated |
| SystemWindow>>mouseMove:: (di 11/30/2001 11:44 -> bmk 3/19/2002 02:11) |
mouseMove: evt | cp | cp _ evt cursorPoint. self valueOfProperty: #clickPoint ifPresentDo: [:firstClick | ((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: ["If this is a drag that started in the title bar, then pick me up" ^ self isSticky ifFalse: [self fastFramingOn ifTrue: [self doFastFrameDrag] ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]]. model windowActiveOnFirstClick ifTrue: ["Normally window takes control on first click. Need explicit transmission for first-click activity." submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]] |
mouseMove: evt "Handle a mouse-move event" | cp | cp _ evt cursorPoint. self valueOfProperty: #clickPoint ifPresentDo: [:firstClick | ((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: ["If this is a drag that started in the title bar, then pick me up" ^ self isSticky ifFalse: [self fastFramingOn ifTrue: [self doFastFrameDrag: firstClick] ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]]. model windowActiveOnFirstClick ifTrue: ["Normally window takes control on first click. Need explicit transmission for first-click activity." submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]] |
mouseMove: evt "Handle a mouse-move event" | cp | cp _ evt cursorPoint. self valueOfProperty: #clickPoint ifPresentDo: [:firstClick | ((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: ["If this is a drag that started in the title bar, then pick me up" ^ self isSticky ifFalse: [self fastFramingOn ifTrue: [self doFastFrameDrag: firstClick] ifTrue: [self doFastFrameDrag] ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]]. model windowActiveOnFirstClick ifTrue: ["Normally window takes control on first click. Need explicit transmission for first-click activity." submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]] |
| OrderedCollectionTest>>testCollectFromTo: (no stamp -> cm 3/8/2006 09:09) |
no previous history |
testCollectFromTo "Allows one to collect some element of a collection into another collection between a first index and an end index for the collect" "self run: #testCollectFromTo" | c1 res | c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection. res := c1 collect: [:each | each abs] from: 1 to: 3. self assert: (res = #(1 2 3) asOrderedCollection). self should: [c1 collect: [:each | each abs] from: 10 to: 13] raise: Error. self should: [c1 collect: [:each | each abs] from: 5 to: 2] raise: Error. |
| OrderedCollectionTest>>testWithCollect: (no stamp -> cm 3/8/2006 10:02) |
no previous history |
testWithCollect "Allows one to collect some element of two collections into another collection with element corresponding to the condition in the blocks" "self run: #testWithCollect" | c1 c2 res | c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection. c2 := #(-9 10 -11 12 -13 14 -15 16) asOrderedCollection. res := c1 with: c2 collect: [:each1 :each2 | each1 < each2 ifTrue: [each1] ifFalse: [each2]]. self assert: (res = #(-9 2 -11 4 -13 6 -15 8) asOrderedCollection). |
| ArchiveViewer>>initializeToStandAlone: (no stamp -> dls 10/22/2001 07:40) |
no previous history |
initializeToStandAlone self initialize createWindow. |
| SerialPort>>openPort:: (jm 5/18/1998 15:37 -> dns 6/27/2000 19:49) |
openPort: portNumber "Open the given serial port, using the settings specified by my instance variables." self close. self primClosePort: portNumber. self primOpenPort: portNumber baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inputFlowControlType outFlowControlType: outputFlowControlType xOnByte: xOnByte xOffByte: xOffByte. port _ portNumber. |
openPort: portNumber "Open the given serial port, using the settings specified by my instance variables. If the port cannot be opened, such as when it is alreay in use, answer nil." "(DNS)" self close. (self primClosePort: portNumber) isNil ifTrue: [ ^ nil ]. (self primOpenPort: portNumber baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inputFlowControlType outFlowControlType: outputFlowControlType xOnByte: xOnByte xOffByte: xOffByte) isNil ifTrue: [ ^ nil ]. port _ portNumber |
openPort: portNumber "Open the given serial port, using the settings specified by my instance variables. If the port cannot be opened, such as when it is alreay in use, answer nil." "(DNS)" "Open the given serial port, using the settings specified by my instance variables." self close. (self primClosePort: portNumber) isNil ifTrue: [ ^ nil ]. (self primOpenPort: portNumber self primClosePort: portNumber. self primOpenPort: portNumber baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inputFlowControlType outFlowControlType: outputFlowControlType xOnByte: xOnByte xOffByte: xOffByte) isNil ifTrue: [ ^ nil ]. port _ portNumber xOffByte: xOffByte. port _ portNumber. |
| SystemWindow>>allowReframeHandles:: (no stamp -> dns 2/2/2000 14:20) |
no previous history |
allowReframeHandles: aBoolean allowReframeHandles := aBoolean |
| SystemWindow>>allowReframeHandles: (no stamp -> dns 2/2/2000 14:20) |
no previous history |
allowReframeHandles ^ allowReframeHandles |
| BlobMorph class>>new: (no stamp -> dns 1/16/2000 15:11) |
no previous history |
new ^ self remember: super new |
| BlobMorph>>mergeSelfWithBlob:atPoint:: (no stamp -> dns 1/17/2000 13:34) |
no previous history |
mergeSelfWithBlob: aBlob atPoint: aPoint " It has already been determined that we merge with aBlob; we do all the work here. " | v v2 c | c := self bounds center. " Merge the vertices by throwing them all together in one pot " v := vertices, aBlob vertices. " Sort the vertices by degrees to keep them in order " v := (v asSortedCollection: [ :a :b | (a-c) degrees < (b-c) degrees ]) asArray. " Now, pick half of the vertices so the count stays the same " v2 := Array new: v size // 2. 1 to: v2 size do: [ :n | v2 at: n put: (v at: n+n) ]. v := v2. " Average each contiguous pair to help minimize jaggies " 2 to: v size do: [ :n | v at: n put: ((v at: n) + (v at: n-1)) / 2.0 ]. " Remember the new vertices, set a new velocity, then delete the merged blob " vertices := v. self setVelocity. aBlob delete |
| BlobMorph>>limitRange:: (no stamp -> dns 1/16/2000 16:29) |
no previous history |
limitRange: verts " limit radius to range 20-120; limit interpoint angle to surrounding angles with max of twice of average separation. " | cent new prevn nextn prevDeg nextDeg thisDeg dincr | cent := self bounds center. new := Array new: verts size. dincr := 360 // verts size. verts doWithIndex: [ :pt :n | "Find prev/next points, allowing for wrapping around " prevn := n-1 < 1 ifTrue: [new size] ifFalse: [n-1]. nextn := n+1 > new size ifTrue: [1] ifFalse: [n+1]. "Get prev/this/next point's angles " prevDeg := ((verts at: prevn)-cent) degrees. thisDeg := ((verts at: n)-cent) degrees. nextDeg := ((verts at: nextn)-cent) degrees. "Adjust if this is where angles wrap from 0 to 360" (thisDeg - prevDeg) abs > 180 ifTrue: [ prevDeg := prevDeg - 360 ]. (thisDeg - nextDeg) abs > 180 ifTrue: [ nextDeg := nextDeg + 360 ]. "Put adjusted point into new collection" new at: n put: cent + (self selfPolarPointRadius: ((((pt - cent) r) min: 80) max: 20) degrees: (((thisDeg min: nextDeg-5) max: prevDeg+5) min: dincr*2+prevDeg)) ]. ^ new |
| BlobMorph>>oozeAFewPointsOf:: (no stamp -> dns 1/17/2000 13:36) |
no previous history |
oozeAFewPointsOf: verts " change some points at random to cause oozing across screen " | n v | (verts size sqrt max: 2) floor timesRepeat: [ n := (verts size * random next) floor + 1. v := verts at: n. v := (v x + (random next * 2.0 - 1.0)) @ (v y + (random next * 2.0 - 1.0)). verts at: n put: v + velocity ]. |
| BlobMorph>>selfPolarPointRadius:degrees:: (no stamp -> dns 1/14/2000 17:47) |
no previous history |
selfPolarPointRadius: rho degrees: theta " Same as Point>>#r:degrees: in Point class except that x and y are not truncated to integers " | radians x y | radians _ theta asFloat degreesToRadians. x _ rho asFloat * radians cos. y _ rho asFloat * radians sin. ^ Point x: x y: y |
| Browser>>contentsSelection: (dew 7/28/2000 00:44 -> drs 1/6/2003 16:11) |
contentsSelection "Return the interval of text in the code pane to select when I set the pane's contents" messageCategoryListIndex > 1 & (messageListIndex = 0) ifTrue: [^ 1 to: 500] "entire empty method template" ifFalse: [^ 1 to: 0] "null selection" |
contentsSelection "Return the interval of text in the code pane to select when I set the pane's contents" messageCategoryListIndex > 0 & (messageListIndex = 0) ifTrue: [^ 1 to: 500] "entire empty method template" ifFalse: [^ 1 to: 0] "null selection" |
contentsSelection "Return the interval of text in the code pane to select when I set the pane's contents" messageCategoryListIndex > 0 & (messageListIndex = 0) messageCategoryListIndex > 1 & (messageListIndex = 0) ifTrue: [^ 1 to: 500] "entire empty method template" ifFalse: [^ 1 to: 0] "null selection" |
| Integer>>>>: (no stamp -> dwh 8/18/1999 21:57) |
>> shiftAmount "left shift" shiftAmount < 0 ifTrue: [self error: 'negative arg']. ^ self bitShift: 0 - shiftAmount |
>> shiftAmount "right shift" shiftAmount < 0 ifTrue: [self error: 'negative arg']. ^ self bitShift: 0 - shiftAmount |
>> shiftAmount "right shift" >> shiftAmount "left shift" shiftAmount < 0 ifTrue: [self error: 'negative arg']. ^ self bitShift: 0 - shiftAmount |
| Integer>>tinyBenchmarks: (ar 9/10/1999 16:11 -> dwh 11/21/1999 16:40) |
tinyBenchmarks "Report the results of running the two tiny Squeak benchmarks. ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results" "0 tinyBenchmarks" "On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec" "On a 400 MHz PII/Win98: 18028169 bytecodes/sec; 1081272 sends/sec" | t1 t2 r n1 n2 | n1 _ 1. [t1 _ Time millisecondsToRun: [n1 benchmark]. t1 < 1000] whileTrue:[n1 _ n1 * 2]. "Note: #benchmark's runtime is about O(n)" n2 _ 28. [t2 _ Time millisecondsToRun: [r _ n2 benchFib]. t2 < 1000] whileTrue:[n2 _ n2 + 1]. "Note: #benchFib's runtime is about O(n^2)." ^ ((n1 * 500000 * 1000) // t1) printString, ' bytecodes/sec; ', ((r * 1000) // t2) printString, ' sends/sec' |
tinyBenchmarks "Report the results of running the two tiny Squeak benchmarks. ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results" "0 tinyBenchmarks" "On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec" "On a 400 MHz PII/Win98: 18028169 bytecodes/sec; 1081272 sends/sec" | t1 t2 r n1 n2 | n1 _ 1. [t1 _ Time millisecondsToRun: [n1 benchmark]. t1 < 1000] whileTrue:[n1 _ n1 * 2]. "Note: #benchmark's runtime is about O(n)" n2 _ 28. [t2 _ Time millisecondsToRun: [r _ n2 benchFib]. t2 < 1000] whileTrue:[n2 _ n2 + 1]. "Note: #benchFib's runtime is about O(k^n), where k is the golden number = (1 + 5 sqrt) / 2 = 1.618...." ^ ((n1 * 500000 * 1000) // t1) printString, ' bytecodes/sec; ', ((r * 1000) // t2) printString, ' sends/sec' |
tinyBenchmarks "Report the results of running the two tiny Squeak benchmarks. ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results" "0 tinyBenchmarks" "On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec" "On a 400 MHz PII/Win98: 18028169 bytecodes/sec; 1081272 sends/sec" | t1 t2 r n1 n2 | n1 _ 1. [t1 _ Time millisecondsToRun: [n1 benchmark]. t1 < 1000] whileTrue:[n1 _ n1 * 2]. "Note: #benchmark's runtime is about O(n)" n2 _ 28. [t2 _ Time millisecondsToRun: [r _ n2 benchFib]. t2 < 1000] whileTrue:[n2 _ n2 + 1]. "Note: #benchFib's runtime is about O(k^n), where k is the golden number = (1 + 5 sqrt) / 2 = 1.618...." t2 < 1000] whileTrue:[n2 _ n2 + 1]. "Note: #benchFib's runtime is about O(n^2)." ^ ((n1 * 500000 * 1000) // t1) printString, ' bytecodes/sec; ', ((r * 1000) // t2) printString, ' sends/sec' |
| Color class>>paleTan: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleTan ^PaleTan |
| Color class>>paleYellow: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleYellow ^PaleYellow |
| Color class>>paleMagenta: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleMagenta ^PaleMagenta |
| Color class>>paleGreen: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleGreen ^PaleGreen |
| Color class>>paleOrange: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleOrange ^PaleOrange |
| Color class>>paleBlue: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleBlue ^PaleBlue |
| Color class>>palePeach: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
palePeach ^PalePeach |
| Color class>>paleRed: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleRed ^PaleRed |
| Color class>>initializeNames: (di 1/6/1999 17:44 -> dwh 7/7/1999 23:57) |
initializeNames "Name some colors." "Color initializeNames" ColorNames _ OrderedCollection new. self named: #black put: (Color r: 0 g: 0 b: 0). self named: #veryVeryDarkGray put: (Color r: 0.125 g: 0.125 b: 0.125). self named: #veryDarkGray put: (Color r: 0.25 g: 0.25 b: 0.25). self named: #darkGray put: (Color r: 0.375 g: 0.375 b: 0.375). self named: #gray put: (Color r: 0.5 g: 0.5 b: 0.5). self named: #lightGray put: (Color r: 0.625 g: 0.625 b: 0.625). self named: #veryLightGray put: (Color r: 0.75 g: 0.75 b: 0.75). self named: #veryVeryLightGray put: (Color r: 0.875 g: 0.875 b: 0.875). self named: #white put: (Color r: 1.0 g: 1.0 b: 1.0). self named: #red put: (Color r: 1.0 g: 0 b: 0). self named: #yellow put: (Color r: 1.0 g: 1.0 b: 0). self named: #green put: (Color r: 0 g: 1.0 b: 0). self named: #cyan put: (Color r: 0 g: 1.0 b: 1.0). self named: #blue put: (Color r: 0 g: 0 b: 1.0). self named: #magenta put: (Color r: 1.0 g: 0 b: 1.0). self named: #brown put: (Color r: 0.6 g: 0.2 b: 0). self named: #orange put: (Color r: 1.0 g: 0.6 b: 0). self named: #lightRed put: (Color r: 1.0 g: 0.8 b: 0.8). self named: #lightYellow put: (Color r: 1.0 g: 1.0 b: 0.8). self named: #lightGreen put: (Color r: 0.8 g: 1.0 b: 0.6). self named: #lightCyan put: (Color r: 0.4 g: 1.0 b: 1.0). self named: #lightBlue put: (Color r: 0.8 g: 1.0 b: 1.0). self named: #lightMagenta put: (Color r: 1.0 g: 0.8 b: 1.0). self named: #lightBrown put: (Color r: 1.0 g: 0.6 b: 0.2). self named: #lightOrange put: (Color r: 1.0 g: 0.8 b: 0.4). self named: #transparent put: (TranslucentColor new alpha: 0.0). |
initializeNames "Name some colors." "Color initializeNames" ColorNames _ OrderedCollection new. self named: #black put: (Color r: 0 g: 0 b: 0). self named: #veryVeryDarkGray put: (Color r: 0.125 g: 0.125 b: 0.125). self named: #veryDarkGray put: (Color r: 0.25 g: 0.25 b: 0.25). self named: #darkGray put: (Color r: 0.375 g: 0.375 b: 0.375). self named: #gray put: (Color r: 0.5 g: 0.5 b: 0.5). self named: #lightGray put: (Color r: 0.625 g: 0.625 b: 0.625). self named: #veryLightGray put: (Color r: 0.75 g: 0.75 b: 0.75). self named: #veryVeryLightGray put: (Color r: 0.875 g: 0.875 b: 0.875). self named: #white put: (Color r: 1.0 g: 1.0 b: 1.0). self named: #red put: (Color r: 1.0 g: 0 b: 0). self named: #yellow put: (Color r: 1.0 g: 1.0 b: 0). self named: #green put: (Color r: 0 g: 1.0 b: 0). self named: #cyan put: (Color r: 0 g: 1.0 b: 1.0). self named: #blue put: (Color r: 0 g: 0 b: 1.0). self named: #magenta put: (Color r: 1.0 g: 0 b: 1.0). self named: #brown put: (Color r: 0.6 g: 0.2 b: 0). self named: #orange put: (Color r: 1.0 g: 0.6 b: 0). self named: #lightRed put: (Color r: 1.0 g: 0.8 b: 0.8). self named: #lightYellow put: (Color r: 1.0 g: 1.0 b: 0.8). self named: #lightGreen put: (Color r: 0.8 g: 1.0 b: 0.6). self named: #lightCyan put: (Color r: 0.4 g: 1.0 b: 1.0). self named: #lightBlue put: (Color r: 0.8 g: 1.0 b: 1.0). self named: #lightMagenta put: (Color r: 1.0 g: 0.8 b: 1.0). self named: #lightBrown put: (Color r: 1.0 g: 0.6 b: 0.2). self named: #lightOrange put: (Color r: 1.0 g: 0.8 b: 0.4). self named: #transparent put: (TranslucentColor new alpha: 0.0). self named: #paleBuff put: (Color r: 254 g: 250 b: 235 range: 255). self named: #paleBlue put: (Color r: 222 g: 249 b: 254 range: 255). self named: #paleYellow put: (Color r: 255 g: 255 b: 217 range: 255). self named: #paleGreen put: (Color r: 223 g: 255 b: 213 range: 255). self named: #paleRed put: (Color r: 255 g: 230 b: 230 range: 255). self named: #veryPaleRed put: (Color r: 255 g: 242 b: 242 range: 255). self named: #paleTan put: (Color r: 235 g: 224 b: 199 range: 255). self named: #paleMagenta put: (Color r: 255 g: 230 b: 255 range: 255). self named: #paleOrange put: (Color r: 253 g: 237 b: 215 range: 255). self named: #palePeach put: (Color r: 255 g: 237 b: 213 range: 255). |
initializeNames "Name some colors." "Color initializeNames" ColorNames _ OrderedCollection new. self named: #black put: (Color r: 0 g: 0 b: 0). self named: #veryVeryDarkGray put: (Color r: 0.125 g: 0.125 b: 0.125). self named: #veryDarkGray put: (Color r: 0.25 g: 0.25 b: 0.25). self named: #darkGray put: (Color r: 0.375 g: 0.375 b: 0.375). self named: #gray put: (Color r: 0.5 g: 0.5 b: 0.5). self named: #lightGray put: (Color r: 0.625 g: 0.625 b: 0.625). self named: #veryLightGray put: (Color r: 0.75 g: 0.75 b: 0.75). self named: #veryVeryLightGray put: (Color r: 0.875 g: 0.875 b: 0.875). self named: #white put: (Color r: 1.0 g: 1.0 b: 1.0). self named: #red put: (Color r: 1.0 g: 0 b: 0). self named: #yellow put: (Color r: 1.0 g: 1.0 b: 0). self named: #green put: (Color r: 0 g: 1.0 b: 0). self named: #cyan put: (Color r: 0 g: 1.0 b: 1.0). self named: #blue put: (Color r: 0 g: 0 b: 1.0). self named: #magenta put: (Color r: 1.0 g: 0 b: 1.0). self named: #brown put: (Color r: 0.6 g: 0.2 b: 0). self named: #orange put: (Color r: 1.0 g: 0.6 b: 0). self named: #lightRed put: (Color r: 1.0 g: 0.8 b: 0.8). self named: #lightYellow put: (Color r: 1.0 g: 1.0 b: 0.8). self named: #lightGreen put: (Color r: 0.8 g: 1.0 b: 0.6). self named: #lightCyan put: (Color r: 0.4 g: 1.0 b: 1.0). self named: #lightBlue put: (Color r: 0.8 g: 1.0 b: 1.0). self named: #lightMagenta put: (Color r: 1.0 g: 0.8 b: 1.0). self named: #lightBrown put: (Color r: 1.0 g: 0.6 b: 0.2). self named: #lightOrange put: (Color r: 1.0 g: 0.8 b: 0.4). self named: #transparent put: (TranslucentColor new alpha: 0.0). self named: #paleBuff put: (Color r: 254 g: 250 b: 235 range: 255). self named: #paleBlue put: (Color r: 222 g: 249 b: 254 range: 255). self named: #paleYellow put: (Color r: 255 g: 255 b: 217 range: 255). self named: #paleGreen put: (Color r: 223 g: 255 b: 213 range: 255). self named: #paleRed put: (Color r: 255 g: 230 b: 230 range: 255). self named: #veryPaleRed put: (Color r: 255 g: 242 b: 242 range: 255). self named: #paleTan put: (Color r: 235 g: 224 b: 199 range: 255). self named: #paleMagenta put: (Color r: 255 g: 230 b: 255 range: 255). self named: #paleOrange put: (Color r: 253 g: 237 b: 215 range: 255). self named: #palePeach put: (Color r: 255 g: 237 b: 213 range: 255). |
| Color class>>paleBuff: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleBuff ^PaleBuff |
| Color class>>veryPaleRed: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
veryPaleRed ^VeryPaleRed |
| Class>>weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:: (ar 7/15/1999 18:56 -> dwh 11/20/1999 23:44) |
weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables." ^(ClassBuilder new) superclass: self weakSubclass: t instanceVariableNames: d classVariableNames: s poolDictionaries: s category: cat |
weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables." ^(ClassBuilder new) superclass: self weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat |
weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables." ^(ClassBuilder new) superclass: self weakSubclass: t instanceVariableNames: f classVariableNames: d instanceVariableNames: d classVariableNames: s poolDictionaries: s category: cat |
| ObjectExplorerWrapper>>asString: (hg 9/7/2001 19:58 -> edt 5/26/2003 12:36) |
asString | explorerString string | explorerString _ [item asExplorerString] on: Error do: ['<error in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>']. string _ (itemName ifNotNil: [itemName , ': '] ifNil: ['']) , explorerString. (string includes: Character cr) ifTrue: [^ string withSeparatorsCompacted]. ^ string |
asString | explorerString string | explorerString _ [item asExplorerString] on: Error do: ['<error: ', item class name, ' in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>']. string _ (itemName ifNotNil: [itemName , ': '] ifNil: ['']) , explorerString. (string includes: Character cr) ifTrue: [^ string withSeparatorsCompacted]. ^ string |
asString | explorerString string | explorerString _ [item asExplorerString] on: Error do: ['<error: ', item class name, ' in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>']. do: ['<error in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>']. string _ (itemName ifNotNil: [itemName , ': '] ifNil: ['']) , explorerString. (string includes: Character cr) ifTrue: [^ string withSeparatorsCompacted]. ^ string |
| TransformMorph>>numberOfItemsPotentiallyInViewWith:: (no stamp -> ge 9/6/2006 17:51) |
no previous history |
numberOfItemsPotentiallyInViewWith: submorphCount "Answer the number of items that could potentially be viewed in full, computed as my visible height divided by the average height of my submorphs. Ignore visibility of submorphs." ^self innerBounds height // (self localSubmorphBounds height / submorphCount) |
| PluggableListMorph>>numSelectionsInView: (di 5/22/1998 00:32 -> ge 9/6/2006 19:02) |
numSelectionsInView ^ self height // self listItemHeight |
numSelectionsInView "Answer the scroller's height based on the average number of submorphs." (scroller submorphCount > 0) ifFalse:[ ^0 ]. "ugly hack, due to code smell. PluggableListMorph added another level of indirection, There is always only one submorph - a LazyListMorph which holds the actual list, but TransformMorph doesn't know that and we are left with a breach of interface. see vUnadjustedScrollRange for another bad example." ^scroller numberOfItemsPotentiallyInViewWith: (scroller submorphs last getListSize). |
numSelectionsInView "Answer the scroller's height based on the average number of submorphs." (scroller submorphCount > 0) ifFalse:[ ^0 ]. "ugly hack, due to code smell. PluggableListMorph added another level of indirection, There is always only one submorph - a LazyListMorph which holds the actual list, but TransformMorph doesn't know that and we are left with a breach of interface. see vUnadjustedScrollRange for another bad example." ^scroller numberOfItemsPotentiallyInViewWith: (scroller submorphs last getListSize). ^ self height // self listItemHeight |
| Object>>notify:: (tk 4/16/1998 15:54 -> hg 10/2/2001 20:49) |
notify: aString "Create and schedule a Notifier with the argument as the message in order to request confirmation before a process can proceed." Debugger openContext: thisContext label: 'Notifier' contents: aString "nil notify: 'confirmation message'" |
notify: aString "Create and schedule a Notifier with the argument as the message in order to request confirmation before a process can proceed." Warning signal: aString "nil notify: 'confirmation message'" |
notify: aString "Create and schedule a Notifier with the argument as the message in order to request confirmation before a process can proceed." Warning signal: aString Debugger openContext: thisContext label: 'Notifier' contents: aString "nil notify: 'confirmation message'" |
| Object>>initialDeepCopierSize: (no stamp -> hg 11/23/1999 13:43) |
no previous history |
initialDeepCopierSize "default value is 4096; other classes may override this, esp. for smaller (=faster) sizes" ^4096 |
| BitBlt>>cachedFontColormapFrom:to:: (no stamp -> hg 6/27/2000 12:27) |
no previous history |
cachedFontColormapFrom: sourceDepth to: destDepth | srcIndex map | CachedFontColorMaps class == Array ifFalse: [CachedFontColorMaps _ (1 to: 9) collect: [:i | Array new: 32]]. srcIndex _ sourceDepth. sourceDepth > 8 ifTrue: [srcIndex _ 9]. (map _ (CachedFontColorMaps at: srcIndex) at: destDepth) ~~ nil ifTrue: [^ map]. map _ (Color cachedColormapFrom: sourceDepth to: destDepth) copy. (CachedFontColorMaps at: srcIndex) at: destDepth put: map. ^ map |
| PseudoClass>>fileOutDefinitionOn:: (no stamp -> hg 9/6/2000 12:45) |
fileOutDefinitionOn: aStream self hasDefinition ifFalse:[^self]. aStream nextChunkPut: self definition; cr. self hasComment ifTrue:[ aStream cr; nextPut: $!; nextChunkPut: self name,' comment: '; cr. aStream nextChunkPut: self commentString printString. ]. |
fileOutDefinitionOn: aStream self hasDefinition ifFalse:[^self]. aStream nextChunkPut: self definition; cr. self hasComment ifTrue: [aStream cr. self organization commentRemoteStr fileOutOn: aStream] |
fileOutDefinitionOn: aStream self hasDefinition ifFalse:[^self]. aStream nextChunkPut: self definition; cr. self hasComment ifTrue: [aStream cr. self organization commentRemoteStr fileOutOn: aStream] self hasComment ifTrue:[ aStream cr; nextPut: $!; nextChunkPut: self name,' comment: '; cr. aStream nextChunkPut: self commentString printString. ]. |
| FileContentsBrowser class>>initialize: (no stamp -> hg 8/3/2000 18:17) |
no previous history |
initialize FileList registerFileReader: self |
| ChangeList class>>initialize: (no stamp -> hg 8/3/2000 18:14) |
no previous history |
initialize FileList registerFileReader: self |
| ExternalStructureInspector>>fieldList: (no stamp -> hg 2/28/2000 14:20) |
no previous history |
fieldList ^ (Array with: 'self: ', object defaultLabelForInspector with: 'all inst vars'), self recordFieldList |
| ExternalStructureInspector>>replaceSelectionValue:: (no stamp -> hg 2/28/2000 14:12) |
no previous history |
replaceSelectionValue: anObject "Add colon to fieldname to get setter selector, and send it to object with the argument. Refer to the comment in Inspector|replaceSelectionValue:." selectionIndex = 1 ifTrue: [^object] ifFalse: [^object perform: ((self fieldList at: selectionIndex), ':') asSymbol with: anObject] |
| ExternalStructureInspector>>selection: (no stamp -> hg 2/28/2000 14:22) |
no previous history |
selection "Refer to the comment in Inspector|selection." selectionIndex = 0 ifTrue:[^object printString]. selectionIndex = 1 ifTrue: [^object]. selectionIndex = 2 ifTrue:[^object longPrintString]. selectionIndex > 2 ifTrue: [^object perform: (self fieldList at: selectionIndex)] |
| SimpleServiceEntry class>>provider:label:selector:: (no stamp -> hg 8/1/2000 18:57) |
no previous history |
provider: anObject label: aString selector: aSymbol ^self new provider: anObject label: aString selector: aSymbol |
| SimpleServiceEntry>>requestSelector: (no stamp -> hg 8/1/2000 19:49) |
no previous history |
requestSelector "send me this message to ask me to perform my service" ^#performServiceFor: |
| SimpleServiceEntry>>useLineAfter: (no stamp -> hg 8/1/2000 19:53) |
no previous history |
useLineAfter ^useLineAfter == true |
| SimpleServiceEntry>>useLineAfter:: (no stamp -> hg 8/1/2000 19:54) |
no previous history |
useLineAfter: aBoolean useLineAfter _ aBoolean |
| SimpleServiceEntry>>label: (no stamp -> hg 8/3/2000 13:06) |
no previous history |
label ^label |
| Collection>>topologicallySortedUsing:: (hg 12/26/2001 23:53 -> hg 12/26/2001 23:53) |
topologicallySortedUsing: aSortBlock "Answer a SortedCollection whose elements are the elements of the receiver, but topologically sorted. The topological order is defined by the argument, aSortBlock." | aSortedCollection | aSortedCollection _ SortedCollection new: self size. aSortedCollection sortBlock: aSortBlock. self do: [:each | aSortedCollection addLast: each]. "avoids sorting" ^ aSortedCollection sortTopologically |
topologicallySortedUsing: aSortBlock "Answer a SortedCollection whose elements are the elements of the receiver, but topologically sorted. The topological order is defined by the argument, aSortBlock." | aSortedCollection | aSortedCollection := SortedCollection new: self size. aSortedCollection sortBlock: aSortBlock. self do: [:each | aSortedCollection addLast: each]. "avoids sorting" ^ aSortedCollection sortTopologically |
topologicallySortedUsing: aSortBlock "Answer a SortedCollection whose elements are the elements of the receiver, but topologically sorted. The topological order is defined by the argument, aSortBlock." | aSortedCollection | aSortedCollection := SortedCollection new: self size. aSortedCollection _ SortedCollection new: self size. aSortedCollection sortBlock: aSortBlock. self do: [:each | aSortedCollection addLast: each]. "avoids sorting" ^ aSortedCollection sortTopologically |
| SequenceableCollection>>explorerContents: (no stamp -> hg 9/7/2001 12:01) |
no previous history |
explorerContents ^self asOrderedCollection withIndexCollect: [:value :index | ObjectExplorerWrapper with: value name: index printString model: self] |
| SortedCollection>>sortTopologically: (hg 1/2/2002 13:34 -> hg 1/2/2002 13:34) |
sortTopologically "Plenty of room for increased efficiency in this one." | remaining result pick | remaining _ self asOrderedCollection. result _ OrderedCollection new. [remaining isEmpty] whileFalse: [ pick _ remaining select: [:item | remaining allSatisfy: [:anotherItem | item == anotherItem or: [self should: item precede: anotherItem]]]. pick isEmpty ifTrue: [self error: 'bad topological ordering']. result addAll: pick. remaining removeAll: pick]. ^self copySameFrom: result |
sortTopologically "Plenty of room for increased efficiency in this one." | remaining result pick | remaining := self asOrderedCollection. result := OrderedCollection new. [remaining isEmpty] whileFalse: [ pick := remaining select: [:item | remaining allSatisfy: [:anotherItem | item == anotherItem or: [self should: item precede: anotherItem]]]. pick isEmpty ifTrue: [self error: 'bad topological ordering']. result addAll: pick. remaining removeAll: pick]. ^self copySameFrom: result |
sortTopologically "Plenty of room for increased efficiency in this one." | remaining result pick | remaining := self asOrderedCollection. result := OrderedCollection new. remaining _ self asOrderedCollection. result _ OrderedCollection new. [remaining isEmpty] whileFalse: [ pick := remaining select: [:item | pick _ remaining select: [:item | remaining allSatisfy: [:anotherItem | item == anotherItem or: [self should: item precede: anotherItem]]]. pick isEmpty ifTrue: [self error: 'bad topological ordering']. result addAll: pick. remaining removeAll: pick]. ^self copySameFrom: result |
| SortedCollection>>sort:to:: (hg 12/17/2001 20:22 -> hg 12/17/2001 20:22) |
sort: i to: j "Sort elements i through j of self to be nondescending according to sortBlock." | 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 _ array at: i. dj _ array at: j. (self should: di precede: dj) ifFalse: [array 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 _ array at: ij. "Sort di,dij,dj. Make dij be their median." (self should: di precede: dij) ifTrue: [(self should: dij precede: dj) ifFalse: [array swap: j with: ij. dij _ dj]] ifFalse: [array 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: [self should: dij precede: (array at: l)]] whileTrue. "i.e. while dl succeeds dij" [k _ k + 1. k <= l and: [self should: (array at: k) precede: dij]] whileTrue. "i.e. while dij succeeds dk" k <= l] whileTrue: [array 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. self sort: k to: j]] |
sort: i to: j "Sort elements i through j of self to be nondescending according to sortBlock." | 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 := array at: i. dj := array at: j. (self should: di precede: dj) ifFalse: [array 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 := array at: ij. "Sort di,dij,dj. Make dij be their median." (self should: di precede: dij) ifTrue: [(self should: dij precede: dj) ifFalse: [array swap: j with: ij. dij := dj]] ifFalse: [array 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: [self should: dij precede: (array at: l)]] whileTrue. "i.e. while dl succeeds dij" [k := k + 1. k <= l and: [self should: (array at: k) precede: dij]] whileTrue. "i.e. while dij succeeds dk" k <= l] whileTrue: [array 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. self sort: k to: j]] |
sort: i to: j "Sort elements i through j of self to be nondescending according to sortBlock." | 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." (n _ j + 1 - i) <= 1 ifTrue: [^self]. "Nothing to sort." "Sort di,dj." di := array at: i. dj := array at: j. di _ array at: i. dj _ array at: j. (self should: di precede: dj) ifFalse: [array swap: i with: j. tt := di. di := dj. dj := tt]. 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 := array at: ij. "Sort di,dij,dj. Make dij be their median." [ij _ (i + j) // 2. "ij is the midpoint of i and j." dij _ array at: ij. "Sort di,dij,dj. Make dij be their median." (self should: di precede: dij) ifTrue: [(self should: dij precede: dj) ifFalse: [array swap: j with: ij. dij := dj]] dij _ dj]] ifFalse: [array swap: i with: ij. dij := di]. 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: [self should: dij precede: (array at: l)]] k _ i. l _ j. [[l _ l - 1. k <= l and: [self should: dij precede: (array at: l)]] whileTrue. "i.e. while dl succeeds dij" [k := k + 1. k <= l and: [self should: (array at: k) precede: dij]] [k _ k + 1. k <= l and: [self should: (array at: k) precede: dij]] whileTrue. "i.e. while dij succeeds dk" k <= l] whileTrue: [array 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. self sort: k to: j]] |
| SortedCollection>>should:precede:: (no stamp -> hg 12/17/2001 19:30) |
no previous history |
should: a precede: b ^sortBlock ifNil: [a <= b] ifNotNil: [sortBlock value: a value: b] |
| Set>>explorerContents: (no stamp -> hg 9/7/2001 11:51) |
no previous history |
explorerContents ^self asOrderedCollection withIndexCollect: [:each :index | ObjectExplorerWrapper with: each name: index printString model: self] |
| Dictionary>>explorerContents: (hg 10/3/2001 20:47 -> hg 10/3/2001 20:47) |
explorerContents | contents | contents _ OrderedCollection new. self keysSortedSafely do: [:key | contents add: (ObjectExplorerWrapper with: (self at: key) name: (key printString contractTo: 32) model: self)]. ^contents |
explorerContents | contents | contents := OrderedCollection new. self keysSortedSafely do: [:key | contents add: (ObjectExplorerWrapper with: (self at: key) name: (key printString contractTo: 32) model: self)]. ^contents |
explorerContents | contents | contents := OrderedCollection new. contents _ OrderedCollection new. self keysSortedSafely do: [:key | contents add: (ObjectExplorerWrapper with: (self at: key) name: (key printString contractTo: 32) model: self)]. ^contents |
| FileStream class>>initialize: (no stamp -> hg 8/3/2000 18:00) |
no previous history |
initialize FileList registerFileReader: self |
| FileDirectory>>assureExistence: (hg 9/29/2001 14:34 -> hg 2/2/2002 16:37) |
assureExistence "Make sure the current directory exists. If necessary, create all parts inbetween" ^self containingDirectory assurePathExists: self localName |
assureExistence "Make sure the current directory exists. If necessary, create all parts in between" self containingDirectory assureExistenceOfPath: self localName |
assureExistence "Make sure the current directory exists. If necessary, create all parts in between" self containingDirectory assureExistenceOfPath: self localName "Make sure the current directory exists. If necessary, create all parts inbetween" ^self containingDirectory assurePathExists: self localName |
| Form class>>openAsBackground:: (no stamp -> hg 8/3/2000 16:26) |
no previous history |
openAsBackground: fullName "Set an image as a background image. Support Squeak's common file format (GIF, JPG, PNG, 'Form stoteOn: (run coded)' and BMP)" (self fromFileNamed: fullName) setAsBackground |
| Form class>>rgbMul: (no stamp -> hg 1/29/2001 17:28) |
no previous history |
rgbMul "Answer the integer denoting 'Multiply each color component, their values regarded as fractions of 1' rule." ^ 37 |
| Form class>>initialize: (no stamp -> hg 8/3/2000 16:25) |
no previous history |
initialize FileList registerFileReader: self |
| Morph class>>initialize: (no stamp -> hg 8/3/2000 16:43) |
initialize "Morph initialize" "this empty array object is shared by all morphs with no submorphs:" EmptyArray _ Array new. |
initialize "Morph initialize" "this empty array object is shared by all morphs with no submorphs:" EmptyArray _ Array new. FileList registerFileReader: self |
initialize
"Morph initialize"
"this empty array object is shared by all morphs with no submorphs:"
EmptyArray _ Array new.
FileList registerFileReader: self
|
| ProjectViewMorph class>>initialize: (no stamp -> hg 8/3/2000 16:54) |
no previous history |
initialize FileList registerFileReader: self |
| MenuItemMorph>>isEnabled:: (jm 11/4/97 07:46 -> hg 12/8/2001 13:22) |
isEnabled: aBoolean isEnabled = aBoolean ifTrue: [^ self]. isEnabled _ aBoolean. self color: (aBoolean ifTrue: [Color black] ifFalse: [Color gray]). |
isEnabled: aBoolean isEnabled = aBoolean ifTrue: [^ self]. isEnabled _ aBoolean. self color: (aBoolean ifTrue: [Color black] ifFalse: [Color lightGray]). |
isEnabled: aBoolean isEnabled = aBoolean ifTrue: [^ self]. isEnabled _ aBoolean. self color: (aBoolean ifTrue: [Color black] ifFalse: [Color lightGray]). self color: (aBoolean ifTrue: [Color black] ifFalse: [Color gray]). |
| MenuItemMorph>>deselectItem: (di 2/23/98 16:24 -> hg 8/3/2000 15:21) |
deselectItem | item | self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. (owner isKindOf: MenuMorph) ifTrue: [item _ owner popUpOwner. (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]]. |
deselectItem | item | self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. (owner isKindOf: MenuMorph) ifTrue: [item _ owner popUpOwner. (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]]. |
deselectItem | item | self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. (owner isKindOf: MenuMorph) ifTrue: [item _ owner popUpOwner. (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]]. |
| ScorePlayerMorph class>>initialize: (no stamp -> hg 8/3/2000 17:27) |
no previous history |
initialize FileList registerFileReader: self |
| EventRecorderMorph class>>initialize: (no stamp -> hg 8/3/2000 17:25) |
no previous history |
initialize FileList registerFileReader: self |
| MenuMorph>>items: (jm 11/4/97 07:46 -> hg 8/3/2000 15:29) |
items ^ submorphs select: [:m | m isKindOf: MenuItemMorph] |
items ^ submorphs select: [:m | m isKindOf: MenuItemMorph] |
items ^ submorphs select: [:m | m isKindOf: MenuItemMorph] |
| MenuMorph>>deleteIfPopUp: (di 10/28/1999 09:50 -> hg 8/3/2000 15:28) |
deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. |
deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. |
deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. |
| SecurityManager>>storeSecurityKeys: (sw 1/25/2002 12:41 -> hg 9/29/2001 14:35) |
storeSecurityKeys
"Store the keys file for the current user"
"SecurityManager default storeSecurityKeys"
| fd loc file |
self isInRestrictedMode ifTrue:[^self]. "no point in even trying"
loc _ self secureUserDirectory. "where to put it"
loc last = FileDirectory pathNameDelimiter ifFalse:
[loc _ loc copyWith: FileDirectory pathNameDelimiter].
fd _ FileDirectory on: loc.
fd assureExistence.
fd deleteFileNamed: self keysFileName ifAbsent:[].
file _ fd newFileNamed: self keysFileName.
{privateKeyPair. trustedKeys} storeOn: file.
file close
|
storeSecurityKeys
"SecurityManager default storeSecurityKeys"
"Store the keys file for the current user"
| fd loc file |
self isInRestrictedMode ifTrue:[^self]. "no point in even trying"
loc _ self secureUserDirectory. "where to put it"
loc last = FileDirectory pathNameDelimiter ifFalse:[
loc _ loc copyWith: FileDirectory pathNameDelimiter.
].
fd _ FileDirectory on: loc.
fd assureExistence.
fd deleteFileNamed: self keysFileName ifAbsent:[].
file _ fd newFileNamed: self keysFileName.
{privateKeyPair. trustedKeys} storeOn: file.
file close.
|
storeSecurityKeys "Store the keys file for the current user" "SecurityManager default storeSecurityKeys" "Store the keys file for the current user" | fd loc file | self isInRestrictedMode ifTrue:[^self]. "no point in even trying" loc _ self secureUserDirectory. "where to put it" loc last = FileDirectory pathNameDelimiter ifFalse:[ loc _ loc copyWith: FileDirectory pathNameDelimiter. ]. loc last = FileDirectory pathNameDelimiter ifFalse: [loc _ loc copyWith: FileDirectory pathNameDelimiter]. fd _ FileDirectory on: loc. fd assureExistence. fd deleteFileNamed: self keysFileName ifAbsent:[]. file _ fd newFileNamed: self keysFileName. {privateKeyPair. trustedKeys} storeOn: file. file close. file close |
| FileDirectoryTest>>myDirectory: (no stamp -> hg 2/2/2002 16:42) |
no previous history |
myDirectory ^FileDirectory default directoryNamed: self myLocalDirectoryName |
| FileDirectoryTest>>myLocalDirectoryName: (no stamp -> hg 2/2/2002 16:42) |
no previous history |
myLocalDirectoryName ^'zTestDir' |
| FileDirectoryTest>>myAssuredDirectory: (no stamp -> hg 2/2/2002 16:44) |
no previous history |
myAssuredDirectory ^self myDirectory assureExistence |
| FileDirectoryTest>>testDirectoryNamed: (no stamp -> hg 2/2/2002 16:44) |
no previous history |
testDirectoryNamed self should: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) pathName = self myDirectory pathName] |
| DeepCopier>>initialize: (tk 8/22/1998 11:25 -> hg 11/23/1999 13:36) |
initialize references _ IdentityDictionary new: 4096. uniClasses _ IdentityDictionary new. "UniClass -> new UniClass" (self identityHash // 16 bitAnd: 7) = 1 ifTrue: [self checkVariables]. "Just check once in a while" |
initialize self initialize: 4096. |
initialize self initialize: 4096. references _ IdentityDictionary new: 4096. uniClasses _ IdentityDictionary new. "UniClass -> new UniClass" (self identityHash // 16 bitAnd: 7) = 1 ifTrue: [self checkVariables]. "Just check once in a while" |
| HTTPSocket class>>httpGet:args:accept:: (hg 2/12/2002 11:39 -> md 9/6/2005 15:59) |
httpGet: url args: args accept: mimeType ^self httpGet: url args: args accept: mimeType request: '' |
httpGet: url args: args accept: mimeType ^self httpGet: url args: args accept: mimeType request: '' |
httpGet: url args: args accept: mimeType ^self httpGet: url args: args accept: mimeType request: '' |
| HTTPSocket class>>userAgentString: (no stamp -> hg 2/11/2002 11:31) |
no previous history |
userAgentString "self userAgentString" ^'User-Agent: ', SystemVersion current version, '-', SystemVersion current highestUpdate printString |
| HTTPSocket>>logToTranscript: (no stamp -> hg 2/11/2002 19:47) |
no previous history |
logToTranscript ^LogToTranscript == true |
| ServerDirectory class>>on:: (no stamp -> hg 9/21/2001 16:40) |
no previous history |
on: pathString ^self new on: pathString |
| ServerDirectory class>>transferServerDefinitionsToExternal: (sw 1/25/2002 12:42 -> hg 9/29/2001 14:35) |
transferServerDefinitionsToExternal "Transfer server definitions to external" "ServerDirectory transferServerDefinitionsToExternal" | serverDir | serverDir _ ExternalSettings assuredPreferenceDirectory directoryNamed: self serverConfDirectoryName. serverDir assureExistence. ServerDirectory storeCurrentServersIn: serverDir |
transferServerDefinitionsToExternal "ServerDirectory transferServerDefinitionsToExternal" | serverDir | serverDir _ ExternalSettings preferenceDirectory directoryNamed: self serverConfDirectoryName. serverDir assureExistence. ServerDirectory storeCurrentServersIn: serverDir |
transferServerDefinitionsToExternal "Transfer server definitions to external" "ServerDirectory transferServerDefinitionsToExternal" | serverDir | serverDir _ ExternalSettings preferenceDirectory directoryNamed: self serverConfDirectoryName. serverDir _ ExternalSettings assuredPreferenceDirectory directoryNamed: self serverConfDirectoryName. serverDir assureExistence. ServerDirectory storeCurrentServersIn: serverDir |
| ServerDirectory>>localPathExists:: (no stamp -> hg 9/29/2001 14:57) |
no previous history |
localPathExists: localPath ^self directoryNames includes: localPath |
| ServerDirectory>>localName: (no stamp -> hg 9/29/2001 15:35) |
no previous history |
localName directory isEmpty ifTrue: [self error: 'no directory']. ^self localNameFor: directory |
| ServerDirectory>>fileNames: (RAA 6/23/2000 09:46 -> hg 2/8/2002 00:04) |
fileNames "Return a collection of names for the files (but not directories) in this directory." "(ServerDirectory serverNamed: 'UIUCArchive') fileNames" self isTypeFTP | self isTypeFile ifFalse: [ ^ self error: 'To see a directory, use file:// or ftp://' ]. ^ (self entries select: [:entry | (entry at: 4) not]) collect: [:entry | entry first] |
fileNames "Return a collection of names for the files (but not directories) in this directory." "(ServerDirectory serverNamed: 'UIUCArchive') fileNames" ^ self entries select: [:entry | (entry at: 4) not] thenCollect: [:entry | entry first] |
fileNames "Return a collection of names for the files (but not directories) in this directory." "(ServerDirectory serverNamed: 'UIUCArchive') fileNames" ^ self entries select: [:entry | (entry at: 4) not] thenCollect: [:entry | entry first] self isTypeFTP | self isTypeFile ifFalse: [ ^ self error: 'To see a directory, use file:// or ftp://' ]. ^ (self entries select: [:entry | (entry at: 4) not]) collect: [:entry | entry first] |
| ServerDirectory>>fileExists:: (hg 9/29/2001 16:25 -> hg 2/5/2002 16:50) |
fileExists: fileName "Does the file exist on this server directory? fileName must be simple with no / or references to other directories." self isTypeFile ifTrue: [^ self fileNames includes: fileName]. self isTypeHTTP ifTrue: [^ (self readOnlyFileNamed: fileName) class ~~ String]. "ftp" ^ self entries anySatisfy: [:entry | entry name = fileName] |
fileExists: fileName "Does the file exist on this server directory? fileName must be simple with no / or references to other directories." | stream | self isTypeFile ifTrue: [^ self fileNames includes: fileName]. self isTypeHTTP ifTrue: [ stream _ self readOnlyFileNamed: fileName. ^stream contents notEmpty]. "ftp" ^ self entries anySatisfy: [:entry | entry name = fileName] |
fileExists: fileName "Does the file exist on this server directory? fileName must be simple with no / or references to other directories." | stream | self isTypeFile ifTrue: [^ self fileNames includes: fileName]. self isTypeHTTP ifTrue: [ stream _ self readOnlyFileNamed: fileName. ^stream contents notEmpty]. self isTypeHTTP ifTrue: [^ (self readOnlyFileNamed: fileName) class ~~ String]. "ftp" ^ self entries anySatisfy: [:entry | entry name = fileName] |
| ServerDirectory>>containingDirectory: (no stamp -> hg 9/29/2001 15:23) |
no previous history |
containingDirectory self splitName: directory to: [:parentPath :localName | ^self copy directory: parentPath] |
| ServerDirectory>>isRoot: (no stamp -> hg 9/29/2001 15:58) |
no previous history |
isRoot ^directory = (String with: self pathNameDelimiter) |
| ServerDirectory>>fullNameFor:: (tk 9/19/1998 19:29 -> hg 2/8/2002 17:39) |
fullNameFor: aFileName "Convention: If it is an absolute path, directory stored with a leading slash, and url has no user@. If relative path, directory stored with no leading slash, and url begins user@. Should we include ftp:// on the front?" urlObject ifNotNil: [^ urlObject pathString, aFileName]. (aFileName includes: self pathNameDelimiter) ifTrue: [^ aFileName]. directory isEmpty ifTrue: [^ server, self pathNameDelimiter asString, aFileName]. ^ (directory first == $/ ifTrue: [''] ifFalse: [user,'@']), server, self slashDirectory, self pathNameDelimiter asString, aFileName |
fullNameFor: aFileName "Convention: If it is an absolute path, directory stored with a leading slash, and url has no user@. If relative path, directory stored with no leading slash, and url begins user@. Should we include ftp:// on the front?" urlObject ifNotNil: [^ urlObject pathString, aFileName]. (aFileName includes: self pathNameDelimiter) ifTrue: [^ aFileName]. self isTypeHTTP ifTrue: [ ^ self downloadUrl, aFileName]. directory isEmpty ifTrue: [^ server, self pathNameDelimiter asString, aFileName]. ^ (directory first == $/ ifTrue: [''] ifFalse: [user,'@']), server, self slashDirectory, self pathNameDelimiter asString, aFileName |
fullNameFor: aFileName "Convention: If it is an absolute path, directory stored with a leading slash, and url has no user@. If relative path, directory stored with no leading slash, and url begins user@. Should we include ftp:// on the front?" urlObject ifNotNil: [^ urlObject pathString, aFileName]. (aFileName includes: self pathNameDelimiter) ifTrue: [^ aFileName]. self isTypeHTTP ifTrue: [ ^ self downloadUrl, aFileName]. directory isEmpty ifTrue: [^ server, self pathNameDelimiter asString, aFileName]. ^ (directory first == $/ ifTrue: [''] ifFalse: [user,'@']), server, self slashDirectory, self pathNameDelimiter asString, aFileName |
| ServerDirectory>>getFileNamed:into:: (RAA 6/23/2000 09:47 -> hg 2/12/2002 11:44) |
getFileNamed: fileNameOnServer into: dataStream "Just FTP a file from a server. Return a stream. (Later -- Use a proxy server if one has been registered.)" | so dd resp rr | self isTypeFile ifTrue: [ dataStream nextPutAll: (resp _ FileStream oldFileNamed: server,(self serverDelimiter asString), self bareDirectory, (self serverDelimiter asString), fileNameOnServer) contentsOfEntireFile. dataStream dataIsValid. ^ resp]. self isTypeHTTP ifTrue: [ resp _ HTTPSocket httpGet: (self fullNameFor: fileNameOnServer) accept: 'application/octet-stream'. resp class == String ifTrue: [^ dataStream]. "error, no data" dataStream copyFrom: resp. dataStream dataIsValid. ^ dataStream]. so _ self openFTP. "Open passive. Do everything up to RETR or STOR" so class == String ifTrue: ["error, was reported" ^ so]. so sendCommand: 'RETR ', fileNameOnServer. dd _ so dataSocket. dd connectTo: so remoteAddress port: dd portNum. dd waitForConnectionUntil: FTPSocket standardDeadline. Transcript show: 'retrieving file ', fileNameOnServer; cr. "Transcript show: 'retrieve from port ', dd portNum printString; cr." resp _ dd getDataTo: dataStream whileWatching: so. "Later use the length to pre-allocate the buffer" (resp == #error:) ifTrue: [socket _ nil. ^ resp]. dd close. (rr _ so responseOK) == true ifFalse: [ socket _ nil. ^ rr]. "150 Opening binary conn on foo (3113 bytes)" (rr _ so responseOK) == true ifFalse: [ socket _ nil. ^ rr]. "226 Transfer complete." socket ifNil: ["normally leave connection open. Don't quit" so sendCommand: 'QUIT'. (rr _ so responseOK) == true ifFalse: [^ rr]. "221" so destroy]. "Always OK to destroy" dd destroy. dataStream dataIsValid. ^ resp "String with just the data" |
getFileNamed: fileNameOnServer into: dataStream ^self getFileNamed: fileNameOnServer into: dataStream httpRequest: 'Pragma: no-cache', String crlf |
getFileNamed: fileNameOnServer into: dataStream ^self getFileNamed: fileNameOnServer into: dataStream httpRequest: 'Pragma: no-cache', String crlf "Just FTP a file from a server. Return a stream. (Later -- Use a proxy server if one has been registered.)" | so dd resp rr | self isTypeFile ifTrue: [ dataStream nextPutAll: (resp _ FileStream oldFileNamed: server,(self serverDelimiter asString), self bareDirectory, (self serverDelimiter asString), fileNameOnServer) contentsOfEntireFile. dataStream dataIsValid. ^ resp]. self isTypeHTTP ifTrue: [ resp _ HTTPSocket httpGet: (self fullNameFor: fileNameOnServer) accept: 'application/octet-stream'. resp class == String ifTrue: [^ dataStream]. "error, no data" dataStream copyFrom: resp. dataStream dataIsValid. ^ dataStream]. so _ self openFTP. "Open passive. Do everything up to RETR or STOR" so class == String ifTrue: ["error, was reported" ^ so]. so sendCommand: 'RETR ', fileNameOnServer. dd _ so dataSocket. dd connectTo: so remoteAddress port: dd portNum. dd waitForConnectionUntil: FTPSocket standardDeadline. Transcript show: 'retrieving file ', fileNameOnServer; cr. "Transcript show: 'retrieve from port ', dd portNum printString; cr." resp _ dd getDataTo: dataStream whileWatching: so. "Later use the length to pre-allocate the buffer" (resp == #error:) ifTrue: [socket _ nil. ^ resp]. dd close. (rr _ so responseOK) == true ifFalse: [ socket _ nil. ^ rr]. "150 Opening binary conn on foo (3113 bytes)" (rr _ so responseOK) == true ifFalse: [ socket _ nil. ^ rr]. "226 Transfer complete." socket ifNil: ["normally leave connection open. Don't quit" so sendCommand: 'QUIT'. (rr _ so responseOK) == true ifFalse: [^ rr]. "221" so destroy]. "Always OK to destroy" dd destroy. dataStream dataIsValid. ^ resp "String with just the data" |
| ServerDirectory>>directoryNamed:: (sbw 8/21/2001 09:36 -> hg 2/8/2002 17:44) |
directoryNamed: localFileName "Return a copy of me pointing at this directory below me" | new newPath | new _ self copy. urlObject ifNotNil: [new urlObject path: new urlObject path copy. new urlObject path removeLast; addLast: localFileName; addLast: ''. ^ new]. "sbw. When working from an FTP server, the first time we access a subdirectory the <directory> variable is empty. In that case we cannot begin with a leading path delimiter since that leads us to the wrong place." newPath _ directory isEmpty ifTrue: [localFileName] ifFalse: [directory , self pathNameDelimiter asString , localFileName]. new directory: newPath. ^ new |
directoryNamed: localFileName "Return a copy of me pointing at this directory below me" | new newPath newAltUrl | new _ self copy. urlObject ifNotNil: [new urlObject path: new urlObject path copy. new urlObject path removeLast; addLast: localFileName; addLast: ''. ^ new]. "sbw. When working from an FTP server, the first time we access a subdirectory the <directory> variable is empty. In that case we cannot begin with a leading path delimiter since that leads us to the wrong place." newPath _ directory isEmpty ifTrue: [localFileName] ifFalse: [directory , self pathNameDelimiter asString , localFileName]. self altUrl ifNotNil: [ newAltUrl _ self altUrl, self pathNameDelimiter asString , localFileName]. new directory: newPath; altUrl: newAltUrl. ^ new |
directoryNamed: localFileName "Return a copy of me pointing at this directory below me" | new newPath newAltUrl | | new newPath | new _ self copy. urlObject ifNotNil: [new urlObject path: new urlObject path copy. new urlObject path removeLast; addLast: localFileName; addLast: ''. ^ new]. "sbw. When working from an FTP server, the first time we access a subdirectory the <directory> variable is empty. In that case we cannot begin with a leading path delimiter since that leads us to the wrong place." newPath _ directory isEmpty ifTrue: [localFileName] ifFalse: [directory , self pathNameDelimiter asString , localFileName]. self altUrl ifNotNil: [ newAltUrl _ self altUrl, self pathNameDelimiter asString , localFileName]. new directory: newPath; altUrl: newAltUrl. new directory: newPath. ^ new |
| ObjectExplorer>>label: (no stamp -> hg 9/7/2001 12:12) |
no previous history |
label ^ rootObject printStringLimitedTo: 32 |
| FileList>>openProjectFromFile: (RAA 7/13/2000 14:11 -> RAA 10/15/2000 18:02) |
openProjectFromFile "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." fileName ifNil: [^self]. Project canWeLoadAProjectNow ifFalse: [^ self]. ProjectViewMorph openFromDirectory: directory andFileName: fileName |
openProjectFromFile "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." fileName ifNil: [^self]. Project canWeLoadAProjectNow ifFalse: [^ self]. ProjectLoading openFromDirectory: directory andFileName: fileName |
openProjectFromFile "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." fileName ifNil: [^self]. Project canWeLoadAProjectNow ifFalse: [^ self]. ProjectLoading ProjectViewMorph openFromDirectory: directory andFileName: fileName |
| Float>>/: (tfei 4/12/1999 12:45 -> hh 10/3/2000 11:46) |
/ 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 = 0 ifTrue: [^(ZeroDivide dividend: self) signal]. ^ aNumber adaptToFloat: self andSend: #/ |
/ 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 "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 = 0 ifTrue: [^(ZeroDivide dividend: self) signal]. ^ aNumber adaptToFloat: self andSend: #/ |
| Integer>>\\\: (no stamp -> hh 8/4/2000 00:39) |
no previous history |
\\\ anInteger "a modulo method for use in DSA. Be careful if you try to use this elsewhere" ^self \\ anInteger |
| Integer>>raisedTo:modulo:: (no stamp -> hh 8/4/2000 01:09) |
no previous history |
raisedTo: y modulo: n "Answer the modular exponential. Code by Jesse Welton." | s t u | s _ 1. t _ self. u _ y. [u = 0] whileFalse: [ u odd ifTrue: [ s _ s * t. s >= n ifTrue: [s _ s \\\ n]]. t _ t * t. t >= n ifTrue: [t _ t \\\ n]. u _ u bitShift: -1]. ^ s |
| SmallInteger>>/: (tfei 4/12/1999 12:45 -> hh 10/3/2000 11:47) |
/ aNumber "Primitive. This primitive (for /) divides the receiver by the argument and returns the result if the division is exact. Fail if the result is not a whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional. No Lookup. See Object documentation whatIsAPrimitive." <primitive: 10> aNumber = 0 ifTrue: [^(ZeroDivide dividend: self) signal]. (aNumber isMemberOf: SmallInteger) ifTrue: [^(Fraction numerator: self denominator: aNumber) reduced] ifFalse: [^super / aNumber] |
/ aNumber "Primitive. This primitive (for /) divides the receiver by the argument and returns the result if the division is exact. Fail if the result is not a whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional. No Lookup. See Object documentation whatIsAPrimitive." <primitive: 10> aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. (aNumber isMemberOf: SmallInteger) ifTrue: [^(Fraction numerator: self denominator: aNumber) reduced] ifFalse: [^super / aNumber] |
/ aNumber "Primitive. This primitive (for /) divides the receiver by the argument and returns the result if the division is exact. Fail if the result is not a whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional. No Lookup. See Object documentation whatIsAPrimitive." <primitive: 10> aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. aNumber = 0 ifTrue: [^(ZeroDivide dividend: self) signal]. (aNumber isMemberOf: SmallInteger) ifTrue: [^(Fraction numerator: self denominator: aNumber) reduced] ifFalse: [^super / aNumber] |
| DigitalSignatureAlgorithm>>verifySignature:ofMessageHash:publicKey:: (raa 5/30/2000 15:49 -> hh 8/3/2000 18:18) |
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey "Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)." | p q g y r s w u1 u2 v0 v | p _ publicKey first. q _ publicKey second. g _ publicKey third. y _ publicKey fourth. r _ aSignature first. s _ aSignature last. ((r > 0) and: [r < q]) ifFalse: [^ false]. "reject" ((s > 0) and: [s < q]) ifFalse: [^ false]. "reject" w _ self inverseOf: s mod: q. u1 _ (hash * w) \\ q. u2 _ (r * w) \\ q. v0 _ (self raise: g to: u1 mod: p) * (self raise: y to: u2 mod: p). v _ ( v0 \\ p) \\ q. ^ v = r |
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey "Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)." | p q g y r s w u1 u2 v0 v | p _ publicKey first. q _ publicKey second. g _ publicKey third. y _ publicKey fourth. r _ aSignature first. s _ aSignature last. ((r > 0) and: [r < q]) ifFalse: [^ false]. "reject" ((s > 0) and: [s < q]) ifFalse: [^ false]. "reject" w _ self inverseOf: s mod: q. u1 _ (hash * w) \\ q. u2 _ (r * w) \\ q. v0 _ (g raisedTo: u1 modulo: p) * (y raisedTo: u2 modulo: p). v _ ( v0 \\ p) \\ q. ^ v = r |
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey "Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)." | p q g y r s w u1 u2 v0 v | p _ publicKey first. q _ publicKey second. g _ publicKey third. y _ publicKey fourth. r _ aSignature first. s _ aSignature last. ((r > 0) and: [r < q]) ifFalse: [^ false]. "reject" ((s > 0) and: [s < q]) ifFalse: [^ false]. "reject" w _ self inverseOf: s mod: q. u1 _ (hash * w) \\ q. u2 _ (r * w) \\ q. v0 _ (g raisedTo: u1 modulo: p) * (y raisedTo: u2 modulo: p). v0 _ (self raise: g to: u1 mod: p) * (self raise: y to: u2 mod: p). v _ ( v0 \\ p) \\ q. ^ v = r |
| DigitalSignatureAlgorithm>>computeSignatureForMessageHash:privateKey:: (raa 5/30/2000 15:47 -> hh 8/3/2000 18:17) |
computeSignatureForMessageHash: hash privateKey: privateKey "Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)." | p q g x r s k tmp | p _ privateKey first. q _ privateKey second. g _ privateKey third. x _ privateKey fourth. r _ s _ 0. [r = 0 or: [s = 0]] whileTrue: [ k _ self nextRandom160 \\ q. r _ (self raise: g to: k mod: p) \\ q. tmp _ (hash + (x * r)) \\ q. s _ ((self inverseOf: k mod: q) * tmp) \\ q]. ^ Array with: r with: s |
computeSignatureForMessageHash: hash privateKey: privateKey "Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)." | p q g x r s k tmp | p _ privateKey first. q _ privateKey second. g _ privateKey third. x _ privateKey fourth. r _ s _ 0. [r = 0 or: [s = 0]] whileTrue: [ k _ self nextRandom160 \\ q. r _ (g raisedTo: k modulo: p) \\ q. tmp _ (hash + (x * r)) \\ q. s _ ((self inverseOf: k mod: q) * tmp) \\ q]. ^ Array with: r with: s |
computeSignatureForMessageHash: hash privateKey: privateKey "Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)." | p q g x r s k tmp | p _ privateKey first. q _ privateKey second. g _ privateKey third. x _ privateKey fourth. r _ s _ 0. [r = 0 or: [s = 0]] whileTrue: [ k _ self nextRandom160 \\ q. r _ (g raisedTo: k modulo: p) \\ q. r _ (self raise: g to: k mod: p) \\ q. tmp _ (hash + (x * r)) \\ q. s _ ((self inverseOf: k mod: q) * tmp) \\ q]. ^ Array with: r with: s |
| DigitalSignatureAlgorithm>>generateKeySet: (jm 12/21/1999 19:05 -> hh 8/3/2000 18:19) |
generateKeySet "Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature." "Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!" | qAndPandS q p exp g h x y | qAndPandS _ self generateQandP. Transcript show: 'Computing g...'. q _ qAndPandS first. p _ qAndPandS second. exp _ (p - 1) / q. h _ 2. [g _ self raise: h to: exp mod: p. g = 1] whileTrue: [h _ h + 1]. Transcript show: 'done.'; cr. Transcript show: 'Computing x and y...'. x _ self nextRandom160. y _ self raise: g to: x mod: p. Transcript show: 'done.'; cr. Transcript show: 'Key generation complete!'; cr. ^ Array with: (Array with: p with: q with: g with: x) with: (Array with: p with: q with: g with: y) |
generateKeySet "Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature." "Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!" | qAndPandS q p exp g h x y | qAndPandS _ self generateQandP. Transcript show: 'Computing g...'. q _ qAndPandS first. p _ qAndPandS second. exp _ (p - 1) / q. h _ 2. [g _ h raisedTo: exp modulo: p. g = 1] whileTrue: [h _ h + 1]. Transcript show: 'done.'; cr. Transcript show: 'Computing x and y...'. x _ self nextRandom160. y _ g raisedTo: x modulo: p. Transcript show: 'done.'; cr. Transcript show: 'Key generation complete!'; cr. ^ Array with: (Array with: p with: q with: g with: x) with: (Array with: p with: q with: g with: y) |
generateKeySet "Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature." "Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!" | qAndPandS q p exp g h x y | qAndPandS _ self generateQandP. Transcript show: 'Computing g...'. q _ qAndPandS first. p _ qAndPandS second. exp _ (p - 1) / q. h _ 2. [g _ h raisedTo: exp modulo: p. g = 1] whileTrue: [h _ h + 1]. [g _ self raise: h to: exp mod: p. g = 1] whileTrue: [h _ h + 1]. Transcript show: 'done.'; cr. Transcript show: 'Computing x and y...'. x _ self nextRandom160. y _ g raisedTo: x modulo: p. y _ self raise: g to: x mod: p. Transcript show: 'done.'; cr. Transcript show: 'Key generation complete!'; cr. ^ Array with: (Array with: p with: q with: g with: x) with: (Array with: p with: q with: g with: y) |
| DigitalSignatureAlgorithm>>isProbablyPrime:: (raa 5/30/2000 15:47 -> hh 8/3/2000 18:18) |
isProbablyPrime: p "Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)." | iterations factor pMinusOne b m r a j z couldBePrime | iterations _ 50. "Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)" "quick elimination: check for p divisible by a small prime" SmallPrimes ifNil: [ "generate list of small primes > 2" SmallPrimes _ Integer primesUpTo: 2000. SmallPrimes _ SmallPrimes copyFrom: 2 to: SmallPrimes size]. factor _ SmallPrimes detect: [:f | (p \\ f) = 0] ifNone: [nil]. factor ifNotNil: [^ p = factor]. pMinusOne _ p - 1. b _ self logOfLargestPowerOfTwoDividing: pMinusOne. m _ pMinusOne // (2 raisedTo: b). "Assert: pMinusOne = m * (2 raisedTo: b) and m is odd" Transcript show: ' Prime test pass '. r _ Random new. 1 to: iterations do: [:i | Transcript show: i printString; space. a _ (r next * 16rFFFFFF) truncated. j _ 0. z _ (self raise: a to: m mod: p) normalize. couldBePrime _ z = 1. [couldBePrime] whileFalse: [ z = 1 ifTrue: [Transcript show: 'failed!'; cr. ^ false]. "not prime" z = pMinusOne ifTrue: [couldBePrime _ true] ifFalse: [ (j _ j + 1) < b ifTrue: [z _ (z * z) \\ p] ifFalse: [Transcript show: 'failed!'; cr. ^ false]]]]. "not prime" Transcript show: 'passed!'; cr. ^ true "passed all tests; probably prime" |
isProbablyPrime: p "Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)." | iterations factor pMinusOne b m r a j z couldBePrime | iterations _ 50. "Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)" "quick elimination: check for p divisible by a small prime" SmallPrimes ifNil: [ "generate list of small primes > 2" SmallPrimes _ Integer primesUpTo: 2000. SmallPrimes _ SmallPrimes copyFrom: 2 to: SmallPrimes size]. factor _ SmallPrimes detect: [:f | (p \\ f) = 0] ifNone: [nil]. factor ifNotNil: [^ p = factor]. pMinusOne _ p - 1. b _ self logOfLargestPowerOfTwoDividing: pMinusOne. m _ pMinusOne // (2 raisedTo: b). "Assert: pMinusOne = m * (2 raisedTo: b) and m is odd" Transcript show: ' Prime test pass '. r _ Random new. 1 to: iterations do: [:i | Transcript show: i printString; space. a _ (r next * 16rFFFFFF) truncated. j _ 0. z _ (a raisedTo: m modulo: p) normalize. couldBePrime _ z = 1. [couldBePrime] whileFalse: [ z = 1 ifTrue: [Transcript show: 'failed!'; cr. ^ false]. "not prime" z = pMinusOne ifTrue: [couldBePrime _ true] ifFalse: [ (j _ j + 1) < b ifTrue: [z _ (z * z) \\ p] ifFalse: [Transcript show: 'failed!'; cr. ^ false]]]]. "not prime" Transcript show: 'passed!'; cr. ^ true "passed all tests; probably prime" |
isProbablyPrime: p "Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)." | iterations factor pMinusOne b m r a j z couldBePrime | iterations _ 50. "Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)" "quick elimination: check for p divisible by a small prime" SmallPrimes ifNil: [ "generate list of small primes > 2" SmallPrimes _ Integer primesUpTo: 2000. SmallPrimes _ SmallPrimes copyFrom: 2 to: SmallPrimes size]. factor _ SmallPrimes detect: [:f | (p \\ f) = 0] ifNone: [nil]. factor ifNotNil: [^ p = factor]. pMinusOne _ p - 1. b _ self logOfLargestPowerOfTwoDividing: pMinusOne. m _ pMinusOne // (2 raisedTo: b). "Assert: pMinusOne = m * (2 raisedTo: b) and m is odd" Transcript show: ' Prime test pass '. r _ Random new. 1 to: iterations do: [:i | Transcript show: i printString; space. a _ (r next * 16rFFFFFF) truncated. j _ 0. z _ (a raisedTo: m modulo: p) normalize. z _ (self raise: a to: m mod: p) normalize. couldBePrime _ z = 1. [couldBePrime] whileFalse: [ z = 1 ifTrue: [Transcript show: 'failed!'; cr. ^ false]. "not prime" z = pMinusOne ifTrue: [couldBePrime _ true] ifFalse: [ (j _ j + 1) < b ifTrue: [z _ (z * z) \\ p] ifFalse: [Transcript show: 'failed!'; cr. ^ false]]]]. "not prime" Transcript show: 'passed!'; cr. ^ true "passed all tests; probably prime" |
| EndOfStream>>isResumable: (no stamp -> hh 5/17/2000 00:30) |
no previous history |
isResumable "EndOfStream is resumable, so ReadStream>>next can answer" ^ true |
| SelectorBrowser>>selectorMenu:: (tk 5/6/1999 13:57 -> hh 1/20/2000 00:15) |
selectorMenu: aMenu ^ aMenu labels: 'senders implementors copy selector to clipboard' lines: #() selections: #(senders implementors copyName) |
selectorMenu: aMenu ^ aMenu labels: 'senders (n) implementors (m) copy selector to clipboard' lines: #() selections: #(senders implementors copyName) |
selectorMenu: aMenu ^ aMenu labels: 'senders (n) implementors (m) ^ aMenu labels: 'senders implementors copy selector to clipboard' lines: #() selections: #(senders implementors copyName) |
| Point>>theta: (no stamp -> hk 11/10/2005 10:07) |
theta "Answer the angle the receiver makes with origin in radians. right is 0; down is 90." | tan theta | x = 0 ifTrue: [y >= 0 ifTrue: [^1.5708"90.0 degreesToRadians"] ifFalse: [^4.71239"270.0 degreesToRadians"]] ifFalse: [tan _ y asFloat / x asFloat. theta _ tan arcTan. x >= 0 ifTrue: [y >= 0 ifTrue: [^theta] ifFalse: [^360.0 degreesToRadians + theta]] ifFalse: [^180.0 degreesToRadians + theta]] |
theta "Answer the angle the receiver makes with origin in radians. right is 0; down is 90. Corrected the constants from single precision to 64 Bit precision and changed the sends in case of overflow to constants HK 2005-07-23" | tan theta | x = 0 ifTrue: [y >= 0 ifTrue: [^ 1.570796326794897 "90.0 degreesToRadians"] ifFalse: [^ 4.71238898038469 "270.0 degreesToRadians"]] ifFalse: [tan := y asFloat / x asFloat. theta := tan arcTan. x >= 0 ifTrue: [y >= 0 ifTrue: [^theta] ifFalse: [^"360.0 degreesToRadians" 6.283185307179586 + theta]] ifFalse: [^"180.0 degreesToRadians" 3.141592653589793 + theta]] |
theta "Answer the angle the receiver makes with origin in radians. right is 0; down is 90. Corrected the constants from single precision to 64 Bit precision and changed the sends in case of overflow to constants HK 2005-07-23" down is 90." | tan theta | x = 0 ifTrue: [y >= 0 ifTrue: [^ 1.570796326794897 "90.0 degreesToRadians"] ifFalse: [^ 4.71238898038469 "270.0 degreesToRadians"]] ifTrue: [^1.5708"90.0 degreesToRadians"] ifFalse: [^4.71239"270.0 degreesToRadians"]] ifFalse: [tan := y asFloat / x asFloat. theta := tan arcTan. [tan _ y asFloat / x asFloat. theta _ tan arcTan. x >= 0 ifTrue: [y >= 0 ifTrue: [^theta] ifFalse: [^"360.0 degreesToRadians" 6.283185307179586 + theta]] ifFalse: [^"180.0 degreesToRadians" 3.141592653589793 + theta]] ifFalse: [^360.0 degreesToRadians + theta]] ifFalse: [^180.0 degreesToRadians + theta]] |
| PointTest>>testTheta: (no stamp -> hk 11/10/2005 10:09) |
no previous history |
testTheta
| result dir tan x y |
self assert: ((0@1) theta - 90.0 degreesToRadians) abs < 1e-15.
self assert: ((0@-1) theta - 270.0 degreesToRadians) abs < 1e-15.
" See code of old and new theta"
x := 1.0 . y := -1.0.
tan := y / x .
dir := tan arcTan.
result := 360.0 degreesToRadians + dir.
self assert: ((x@y) theta - result) abs < 1e-15.
x := -1.0. "Don't reuse old results whenyou want numeric precision!"
tan := y / x .
dir := tan arcTan.
result := 180.0 degreesToRadians + dir.
self assert: ((x@y) theta - result) abs < 1e-15.
|
| Sonogram>>plotColumn:: (jhm 9/16/1999 14:41 -> jdl 3/28/2003 09:30) |
plotColumn: dataArray | chm1 i normVal r | columnForm unhibernate. chm1 _ columnForm height - 1. 0 to: chm1 do: [:y | i _ y*(dataArray size-1)//chm1 + 1. normVal _ ((dataArray at: i) - minVal) / (maxVal - minVal). normVal < 0.0 ifTrue: [normVal _ 0.0]. normVal > 1.0 ifTrue: [normVal _ 1.0]. columnForm bits at: chm1-y+1 put: (pixValMap at: (normVal * 255.0) truncated + 1)]. (lastX _ lastX + 1) > (image width - 1) ifTrue: [self scroll]. image copy: (r _ (lastX@0 extent: 1@image height)) from: (32//image depth-1)@0 in: columnForm rule: Form over. "self changed." self invalidRect: (r translateBy: self position) |
plotColumn: dataArray | chm1 i normVal r | columnForm unhibernate. chm1 := columnForm height - 1. 0 to: chm1 do: [:y | i := y * (dataArray size - 1) // chm1 + 1. normVal := ((dataArray at: i) - minVal) / (maxVal - minVal). normVal := normVal max: 0.0. normVal := normVal min: 1.0. columnForm bits at: chm1 - y + 1 put: (pixValMap at: (normVal * 255.0) truncated + 1)]. (lastX := lastX + 1) > (image width - 1) ifTrue: [self scroll]. image copy: (r := lastX @ 0 extent: 1 @ image height) from: (32 // image depth - 1) @ 0 in: columnForm rule: Form over. "self changed." self invalidRect: (r translateBy: self position) |
plotColumn: dataArray plotColumn: dataArray | chm1 i normVal r | columnForm unhibernate. chm1 := columnForm height - 1. 0 to: chm1 do: [:y | i := y * (dataArray size - 1) // chm1 + 1. normVal := ((dataArray at: i) - minVal) / (maxVal - minVal). normVal := normVal max: 0.0. normVal := normVal min: 1.0. columnForm bits at: chm1 - y + 1 put: (pixValMap at: (normVal * 255.0) truncated + 1)]. (lastX := lastX + 1) > (image width - 1) ifTrue: [self scroll]. image copy: (r := lastX @ 0 extent: 1 @ image height) from: (32 // image depth - 1) @ 0 in: columnForm rule: Form over. chm1 _ columnForm height - 1. 0 to: chm1 do: [:y | i _ y*(dataArray size-1)//chm1 + 1. normVal _ ((dataArray at: i) - minVal) / (maxVal - minVal). normVal < 0.0 ifTrue: [normVal _ 0.0]. normVal > 1.0 ifTrue: [normVal _ 1.0]. columnForm bits at: chm1-y+1 put: (pixValMap at: (normVal * 255.0) truncated + 1)]. (lastX _ lastX + 1) > (image width - 1) ifTrue: [self scroll]. image copy: (r _ (lastX@0 extent: 1@image height)) from: (32//image depth-1)@0 in: columnForm rule: Form over. "self changed." self invalidRect: (r translateBy: self position) |
| SpeakerMorph>>appendSample:: (jm 4/22/1999 16:45 -> jdl 3/28/2003 09:38) |
appendSample: aFloat "Append the given sample, a number between -100.0 and 100.0, to my buffer. Flush the buffer if it is full." lastConePosition _ aFloat. lastConePosition > 100.0 ifTrue: [lastConePosition _ 100.0]. lastConePosition < -100.0 ifTrue: [lastConePosition _ -100.0]. buffer nextPut: (327.67 * lastConePosition) truncated. buffer position >= bufferSize ifTrue: [self flushBuffer]. |
appendSample: aFloat "Append the given sample, a number between -100.0 and 100.0, to my buffer. Flush the buffer if it is full." lastConePosition := aFloat. lastConePosition := lastConePosition min: 100.0. lastConePosition := lastConePosition max: -100.0. buffer nextPut: (327.67 * lastConePosition) truncated. buffer position >= bufferSize ifTrue: [self flushBuffer] |
appendSample: aFloat appendSample: aFloat "Append the given sample, a number between -100.0 and 100.0, to my buffer. Flush the buffer if it is full." lastConePosition := aFloat. lastConePosition := lastConePosition min: 100.0. lastConePosition := lastConePosition max: -100.0. lastConePosition _ aFloat. lastConePosition > 100.0 ifTrue: [lastConePosition _ 100.0]. lastConePosition < -100.0 ifTrue: [lastConePosition _ -100.0]. buffer nextPut: (327.67 * lastConePosition) truncated. buffer position >= bufferSize ifTrue: [self flushBuffer] buffer position >= bufferSize ifTrue: [self flushBuffer]. |
| MovieMorph>>currentFrame: (no stamp -> jdl 3/28/2003 08:03) |
currentFrame frameList isEmpty ifTrue: [^ nil]. currentFrameIndex > frameList size ifTrue: [currentFrameIndex _ frameList size]. currentFrameIndex < 1 ifTrue: [currentFrameIndex _ 1]. ^ frameList at: currentFrameIndex |
currentFrame
frameList isEmpty ifTrue: [^nil].
currentFrameIndex := currentFrameIndex min: (frameList size).
currentFrameIndex := currentFrameIndex max: 1.
^frameList at: currentFrameIndex
|
currentFrame frameList isEmpty ifTrue: [^nil]. currentFrameIndex := currentFrameIndex min: (frameList size). currentFrameIndex := currentFrameIndex max: 1. ^frameList at: currentFrameIndex frameList isEmpty ifTrue: [^ nil]. currentFrameIndex > frameList size ifTrue: [currentFrameIndex _ frameList size]. currentFrameIndex < 1 ifTrue: [currentFrameIndex _ 1]. ^ frameList at: currentFrameIndex |
| MovieMorph>>setFrame:: (ar 9/23/2000 12:44 -> jdl 3/28/2003 08:08) |
setFrame: newFrameIndex | oldFrame p newFrame | oldFrame _ self currentFrame. oldFrame ifNil: [^ self]. self changed. p _ oldFrame referencePosition. currentFrameIndex _ newFrameIndex. currentFrameIndex > frameList size ifTrue: [currentFrameIndex _ frameList size]. currentFrameIndex < 1 ifTrue: [currentFrameIndex _ 1]. newFrame _ frameList at: currentFrameIndex. newFrame referencePosition: p. oldFrame delete. self addMorph: newFrame. dwellCount _ newFrame framesToDwell. self layoutChanged. self changed. |
setFrame: newFrameIndex
| oldFrame p newFrame |
oldFrame := self currentFrame.
oldFrame ifNil: [^self].
self changed.
p := oldFrame referencePosition.
currentFrameIndex := newFrameIndex.
currentFrameIndex := currentFrameIndex min: (frameList size).
currentFrameIndex := currentFrameIndex max: 1.
newFrame := frameList at: currentFrameIndex.
newFrame referencePosition: p.
oldFrame delete.
self addMorph: newFrame.
dwellCount := newFrame framesToDwell.
self layoutChanged.
self changed
|
setFrame: newFrameIndex setFrame: newFrameIndex | oldFrame p newFrame | oldFrame := self currentFrame. oldFrame ifNil: [^self]. oldFrame _ self currentFrame. oldFrame ifNil: [^ self]. self changed. p _ oldFrame referencePosition. currentFrameIndex _ newFrameIndex. currentFrameIndex > frameList size ifTrue: [currentFrameIndex _ frameList size]. currentFrameIndex < 1 ifTrue: [currentFrameIndex _ 1]. newFrame _ frameList at: currentFrameIndex. newFrame referencePosition: p. oldFrame delete. self addMorph: newFrame. dwellCount _ newFrame framesToDwell. self layoutChanged. self changed. p := oldFrame referencePosition. currentFrameIndex := newFrameIndex. currentFrameIndex := currentFrameIndex min: (frameList size). currentFrameIndex := currentFrameIndex max: 1. newFrame := frameList at: currentFrameIndex. newFrame referencePosition: p. oldFrame delete. self addMorph: newFrame. dwellCount := newFrame framesToDwell. self layoutChanged. self changed |
| TransformationMorph>>scaleToMatch:: (ar 9/23/2000 13:40 -> jdl 3/28/2003 08:13) |
scaleToMatch: aPoint | scaleFactor tfm originalScale | tfm _ transform withScale: 1.0. originalScale _ ((tfm localBoundsToGlobal: self renderedMorph fullBounds) corner - (tfm localPointToGlobal: self renderedMorph referencePosition)) r. "Catch cases where the reference point is on fullBounds corner" originalScale < 1.0 ifTrue:[originalScale _ 1.0]. scaleFactor _ (aPoint - self referencePosition) r / originalScale. scaleFactor _ scaleFactor < 1.0 ifTrue: [scaleFactor detentBy: 0.05 atMultiplesOf: 0.25 snap: false] ifFalse: [scaleFactor detentBy: 0.1 atMultiplesOf: 0.5 snap: false]. self adjustAfter:[self scale: ((scaleFactor min: 8.0) max: 0.1)]. |
scaleToMatch: aPoint | scaleFactor tfm originalScale | tfm := transform withScale: 1.0. originalScale := ((tfm localBoundsToGlobal: self renderedMorph fullBounds) corner - (tfm localPointToGlobal: self renderedMorph referencePosition)) r. "Catch cases where the reference point is on fullBounds corner" originalScale := originalScale max: 1.0. scaleFactor := (aPoint - self referencePosition) r / originalScale. scaleFactor := scaleFactor < 1.0 ifTrue: [scaleFactor detentBy: 0.05 atMultiplesOf: 0.25 snap: false] ifFalse: [scaleFactor detentBy: 0.1 atMultiplesOf: 0.5 snap: false]. self adjustAfter: [self scale: ((scaleFactor min: 8.0) max: 0.1)] |
scaleToMatch: aPoint scaleToMatch: aPoint | scaleFactor tfm originalScale | tfm := transform withScale: 1.0. originalScale := ((tfm localBoundsToGlobal: self renderedMorph fullBounds) corner - (tfm localPointToGlobal: self renderedMorph referencePosition)) r. tfm _ transform withScale: 1.0. originalScale _ ((tfm localBoundsToGlobal: self renderedMorph fullBounds) corner - (tfm localPointToGlobal: self renderedMorph referencePosition)) r. "Catch cases where the reference point is on fullBounds corner" originalScale := originalScale max: 1.0. scaleFactor := (aPoint - self referencePosition) r / originalScale. scaleFactor := scaleFactor < 1.0 ifTrue: [scaleFactor detentBy: 0.05 atMultiplesOf: 0.25 snap: false] ifFalse: [scaleFactor detentBy: 0.1 atMultiplesOf: 0.5 snap: false]. self adjustAfter: [self scale: ((scaleFactor min: 8.0) max: 0.1)] originalScale < 1.0 ifTrue:[originalScale _ 1.0]. scaleFactor _ (aPoint - self referencePosition) r / originalScale. scaleFactor _ scaleFactor < 1.0 ifTrue: [scaleFactor detentBy: 0.05 atMultiplesOf: 0.25 snap: false] ifFalse: [scaleFactor detentBy: 0.1 atMultiplesOf: 0.5 snap: false]. self adjustAfter:[self scale: ((scaleFactor min: 8.0) max: 0.1)]. |
| TableLayout>>layoutLeftToRight:in:: (ar 11/14/2000 17:10 -> jdl 3/28/2003 08:48) |
layoutLeftToRight: aMorph in: newBounds "An optimized left-to-right list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint x. extent _ newBounds extent. n _ 0. vFill _ false. sum _ 0. width _ height _ 0. first _ last _ nil. block _ [:m| props _ m layoutProperties ifNil:[m]. props disableTableLayout ifFalse:[ n _ n + 1. cell _ LayoutCell new target: m. (props hResizing == #spaceFill) ifTrue:[ cell hSpaceFill: true. extra _ m spaceFillWeight. cell extraSpace: extra. sum _ sum + extra. ] ifFalse:[cell hSpaceFill: false]. (props vResizing == #spaceFill) ifTrue:[vFill _ true]. size _ m minExtent. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. cell cellSize: sizeX. last ifNil:[first _ cell] ifNotNil:[last nextCell: cell]. last _ cell. width _ width + sizeX. sizeY > height ifTrue:[height _ sizeY]. ]. ]. properties reverseTableCells ifTrue:[aMorph submorphsReverseDo: block] ifFalse:[aMorph submorphsDo: block]. n > 1 ifTrue:[width _ width + (n-1 * inset)]. (properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]]) ifTrue:[extent _ width @ (extent y max: height)]. (properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]]) ifTrue:[extent _ (extent x max: width) @ height]. posX _ newBounds left. posY _ newBounds top. "Compute extra vertical space" extra _ extent y - height. extra < 0 ifTrue:[extra _ 0]. extra > 0 ifTrue:[ vFill ifTrue:[ height _ extent y. ] ifFalse:[ centering _ properties wrapCentering. centering == #bottomRight ifTrue:[posY _ posY + extra]. centering == #center ifTrue:[posY _ posY + (extra // 2)] ]. ]. "Compute extra horizontal space" extra _ extent x - width. extra < 0 ifTrue:[extra _ 0]. extraPerCell _ 0. extra > 0 ifTrue:[ sum isZero ifTrue:["extra space but no #spaceFillers" centering _ properties listCentering. centering == #bottomRight ifTrue:[posX _ posX + extra]. centering == #center ifTrue:[posX _ posX + (extra // 2)]. ] ifFalse:[extraPerCell _ extra asFloat / sum asFloat]. ]. n _ 0. extra _ last _ 0. cell _ first. [cell == nil] whileFalse:[ n _ n + 1. width _ cell cellSize. (extraPerCell > 0 and:[cell hSpaceFill]) ifTrue:[ extra _ (last _ extra) + (extraPerCell * cell extraSpace). amount _ extra truncated - last truncated. width _ width + amount. ]. cell target layoutInBounds: (posX @ posY extent: width @ height). posX _ posX + width + inset. cell _ cell nextCell. ]. |
layoutLeftToRight: aMorph in: newBounds "An optimized left-to-right list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint x. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props hResizing == #spaceFill ifTrue: [cell hSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell hSpaceFill: false]. props vResizing == #spaceFill ifTrue: [vFill := true]. size := m minExtent. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeX. last ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. n > 1 ifTrue: [width := width + ((n - 1) * inset)]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := width @ (extent y max: height)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := (extent x max: width) @ height]. posX := newBounds left. posY := newBounds top. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [height := extent y] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]]]. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" centering := properties listCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. width := cell cellSize. (extraPerCell > 0 and: [cell hSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. width := width + amount]. cell target layoutInBounds: (posX @ posY extent: width @ height). posX := posX + width + inset. cell := cell nextCell] |
layoutLeftToRight: aMorph in: newBounds layoutLeftToRight: aMorph in: newBounds "An optimized left-to-right list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint x. extent _ newBounds extent. n _ 0. vFill _ false. sum _ 0. width _ height _ 0. first _ last _ nil. block _ [:m| props _ m layoutProperties ifNil:[m]. props disableTableLayout ifFalse:[ n _ n + 1. cell _ LayoutCell new target: m. (props hResizing == #spaceFill) ifTrue:[ cell hSpaceFill: true. extra _ m spaceFillWeight. cell extraSpace: extra. sum _ sum + extra. ] ifFalse:[cell hSpaceFill: false]. (props vResizing == #spaceFill) ifTrue:[vFill _ true]. size _ m minExtent. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. cell cellSize: sizeX. last ifNil:[first _ cell] ifNotNil:[last nextCell: cell]. last _ cell. width _ width + sizeX. sizeY > height ifTrue:[height _ sizeY]. ]. ]. properties reverseTableCells ifTrue:[aMorph submorphsReverseDo: block] ifFalse:[aMorph submorphsDo: block]. | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint x. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props hResizing == #spaceFill ifTrue: [cell hSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell hSpaceFill: false]. props vResizing == #spaceFill ifTrue: [vFill := true]. size := m minExtent. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeX. last ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. n > 1 ifTrue: [width := width + ((n - 1) * inset)]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := width @ (extent y max: height)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := (extent x max: width) @ height]. posX := newBounds left. posY := newBounds top. n > 1 ifTrue:[width _ width + (n-1 * inset)]. (properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]]) ifTrue:[extent _ width @ (extent y max: height)]. (properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]]) ifTrue:[extent _ (extent x max: width) @ height]. posX _ newBounds left. posY _ newBounds top. "Compute extra vertical space" extra _ extent y - height. extra < 0 ifTrue:[extra _ 0]. extra > 0 ifTrue:[ vFill ifTrue:[ height _ extent y. ] ifFalse:[ centering _ properties wrapCentering. centering == #bottomRight ifTrue:[posY _ posY + extra]. centering == #center ifTrue:[posY _ posY + (extra // 2)] ]. ]. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [height := extent y] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]]]. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" extra _ extent x - width. extra < 0 ifTrue:[extra _ 0]. extraPerCell _ 0. extra > 0 ifTrue:[ sum isZero ifTrue:["extra space but no #spaceFillers" centering _ properties listCentering. centering == #bottomRight ifTrue:[posX _ posX + extra]. centering == #center ifTrue:[posX _ posX + (extra // 2)]. ] ifFalse:[extraPerCell _ extra asFloat / sum asFloat]. ]. centering := properties listCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. width := cell cellSize. (extraPerCell > 0 and: [cell hSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. width := width + amount]. cell target layoutInBounds: (posX @ posY extent: width @ height). posX := posX + width + inset. cell := cell nextCell] n _ 0. extra _ last _ 0. cell _ first. [cell == nil] whileFalse:[ n _ n + 1. width _ cell cellSize. (extraPerCell > 0 and:[cell hSpaceFill]) ifTrue:[ extra _ (last _ extra) + (extraPerCell * cell extraSpace). amount _ extra truncated - last truncated. width _ width + amount. ]. cell target layoutInBounds: (posX @ posY extent: width @ height). posX _ posX + width + inset. cell _ cell nextCell. ]. |
| TableLayout>>minExtentHorizontal:: (ar 1/27/2001 14:42 -> jdl 3/28/2003 08:37) |
minExtentHorizontal: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint. n _ 0. width _ height _ 0. aMorph submorphsDo:[:m| m disableTableLayout ifFalse:[ n _ n + 1. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. width _ width + sizeX. sizeY > height ifTrue:[height _ sizeY]. ]. ]. n > 1 ifTrue:[width _ width + (n-1 * inset x)]. ^minExtentCache _ width @ height |
minExtentHorizontal: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | m disableTableLayout ifFalse: [n := n + 1. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. n > 1 ifTrue: [width := width + ((n - 1) * inset x)]. ^minExtentCache := width @ height |
minExtentHorizontal: aMorph minExtentHorizontal: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | m disableTableLayout ifFalse: [n := n + 1. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. n > 1 ifTrue: [width := width + ((n - 1) * inset x)]. ^minExtentCache := width @ height size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint. n _ 0. width _ height _ 0. aMorph submorphsDo:[:m| m disableTableLayout ifFalse:[ n _ n + 1. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. width _ width + sizeX. sizeY > height ifTrue:[height _ sizeY]. ]. ]. n > 1 ifTrue:[width _ width + (n-1 * inset x)]. ^minExtentCache _ width @ height |
| TableLayout>>minExtentVertical:: (ar 1/27/2001 14:42 -> jdl 3/28/2003 08:39) |
minExtentVertical: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint. n _ 0. width _ height _ 0. aMorph submorphsDo:[:m| m disableTableLayout ifFalse:[ n _ n + 1. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. height _ height + sizeY. sizeX > width ifTrue:[width _ sizeX]. ]. ]. n > 1 ifTrue:[height _ height + (n-1 * inset y)]. ^minExtentCache _ width @ height |
minExtentVertical: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | m disableTableLayout ifFalse: [n := n + 1. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. n > 1 ifTrue: [height := height + ((n - 1) * inset y)]. ^minExtentCache := width @ height |
minExtentVertical: aMorph minExtentVertical: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | m disableTableLayout ifFalse: [n := n + 1. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. n > 1 ifTrue: [height := height + ((n - 1) * inset y)]. ^minExtentCache := width @ height size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint. n _ 0. width _ height _ 0. aMorph submorphsDo:[:m| m disableTableLayout ifFalse:[ n _ n + 1. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. height _ height + sizeY. sizeX > width ifTrue:[width _ sizeX]. ]. ]. n > 1 ifTrue:[height _ height + (n-1 * inset y)]. ^minExtentCache _ width @ height |
| TableLayout>>layoutTopToBottom:in:: (ar 11/14/2000 17:12 -> jdl 3/28/2003 08:50) |
layoutTopToBottom: aMorph in: newBounds "An optimized top-to-bottom list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint y. extent _ newBounds extent. n _ 0. vFill _ false. sum _ 0. width _ height _ 0. first _ last _ nil. block _ [:m| props _ m layoutProperties ifNil:[m]. props disableTableLayout ifFalse:[ n _ n + 1. cell _ LayoutCell new target: m. (props vResizing == #spaceFill) ifTrue:[ cell vSpaceFill: true. extra _ m spaceFillWeight. cell extraSpace: extra. sum _ sum + extra. ] ifFalse:[cell vSpaceFill: false]. (props hResizing == #spaceFill) ifTrue:[vFill _ true]. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. cell cellSize: sizeY. first ifNil:[first _ cell] ifNotNil:[last nextCell: cell]. last _ cell. height _ height + sizeY. sizeX > width ifTrue:[width _ sizeX]. ]. ]. properties reverseTableCells ifTrue:[aMorph submorphsReverseDo: block] ifFalse:[aMorph submorphsDo: block]. n > 1 ifTrue:[height _ height + (n-1 * inset)]. (properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]]) ifTrue:[extent _ (extent x max: width) @ height]. (properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]]) ifTrue:[extent _ width @ (extent y max: height)]. posX _ newBounds left. posY _ newBounds top. "Compute extra horizontal space" extra _ extent x - width. extra < 0 ifTrue:[extra _ 0]. extra > 0 ifTrue:[ vFill ifTrue:[ width _ extent x. ] ifFalse:[ centering _ properties wrapCentering. centering == #bottomRight ifTrue:[posX _ posX + extra]. centering == #center ifTrue:[posX _ posX + (extra // 2)] ]. ]. "Compute extra vertical space" extra _ extent y - height. extra < 0 ifTrue:[extra _ 0]. extraPerCell _ 0. extra > 0 ifTrue:[ sum isZero ifTrue:["extra space but no #spaceFillers" centering _ properties listCentering. centering == #bottomRight ifTrue:[posY _ posY + extra]. centering == #center ifTrue:[posY _ posY + (extra // 2)]. ] ifFalse:[extraPerCell _ extra asFloat / sum asFloat]. ]. n _ 0. extra _ last _ 0. cell _ first. [cell == nil] whileFalse:[ n _ n + 1. height _ cell cellSize. (extraPerCell > 0 and:[cell vSpaceFill]) ifTrue:[ extra _ (last _ extra) + (extraPerCell * cell extraSpace). amount _ extra truncated - last truncated. height _ height + amount. ]. cell target layoutInBounds: (posX @ posY extent: width @ height). posY _ posY + height + inset. cell _ cell nextCell. ]. |
layoutTopToBottom: aMorph in: newBounds "An optimized top-to-bottom list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint y. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props vResizing == #spaceFill ifTrue: [cell vSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell vSpaceFill: false]. props hResizing == #spaceFill ifTrue: [vFill := true]. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeY. first ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. n > 1 ifTrue: [height := height + ((n - 1) * inset)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := (extent x max: width) @ height]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := width @ (extent y max: height)]. posX := newBounds left. posY := newBounds top. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [width := extent x] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]]]. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" centering := properties listCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. height := cell cellSize. (extraPerCell > 0 and: [cell vSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. height := height + amount]. cell target layoutInBounds: (posX @ posY extent: width @ height). posY := posY + height + inset. cell := cell nextCell] |
layoutTopToBottom: aMorph in: newBounds layoutTopToBottom: aMorph in: newBounds "An optimized top-to-bottom list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint y. extent _ newBounds extent. n _ 0. vFill _ false. sum _ 0. width _ height _ 0. first _ last _ nil. block _ [:m| props _ m layoutProperties ifNil:[m]. props disableTableLayout ifFalse:[ n _ n + 1. cell _ LayoutCell new target: m. (props vResizing == #spaceFill) ifTrue:[ cell vSpaceFill: true. extra _ m spaceFillWeight. cell extraSpace: extra. sum _ sum + extra. ] ifFalse:[cell vSpaceFill: false]. (props hResizing == #spaceFill) ifTrue:[vFill _ true]. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. cell cellSize: sizeY. first ifNil:[first _ cell] ifNotNil:[last nextCell: cell]. last _ cell. height _ height + sizeY. sizeX > width ifTrue:[width _ sizeX]. ]. ]. properties reverseTableCells ifTrue:[aMorph submorphsReverseDo: block] ifFalse:[aMorph submorphsDo: block]. n > 1 ifTrue:[height _ height + (n-1 * inset)]. (properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]]) ifTrue:[extent _ (extent x max: width) @ height]. (properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]]) ifTrue:[extent _ width @ (extent y max: height)]. posX _ newBounds left. posY _ newBounds top. "Compute extra horizontal space" extra _ extent x - width. extra < 0 ifTrue:[extra _ 0]. extra > 0 ifTrue:[ vFill ifTrue:[ width _ extent x. ] ifFalse:[ centering _ properties wrapCentering. centering == #bottomRight ifTrue:[posX _ posX + extra]. centering == #center ifTrue:[posX _ posX + (extra // 2)] ]. ]. "Compute extra vertical space" extra _ extent y - height. extra < 0 ifTrue:[extra _ 0]. extraPerCell _ 0. extra > 0 ifTrue:[ sum isZero ifTrue:["extra space but no #spaceFillers" centering _ properties listCentering. centering == #bottomRight ifTrue:[posY _ posY + extra]. centering == #center ifTrue:[posY _ posY + (extra // 2)]. ] ifFalse:[extraPerCell _ extra asFloat / sum asFloat]. ]. | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint y. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props vResizing == #spaceFill ifTrue: [cell vSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell vSpaceFill: false]. props hResizing == #spaceFill ifTrue: [vFill := true]. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeY. first ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. n > 1 ifTrue: [height := height + ((n - 1) * inset)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := (extent x max: width) @ height]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := width @ (extent y max: height)]. posX := newBounds left. posY := newBounds top. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [width := extent x] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]]]. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" centering := properties listCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. height := cell cellSize. (extraPerCell > 0 and: [cell vSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. height := height + amount]. cell target layoutInBounds: (posX @ posY extent: width @ height). posY := posY + height + inset. cell := cell nextCell] n _ 0. extra _ last _ 0. cell _ first. [cell == nil] whileFalse:[ n _ n + 1. height _ cell cellSize. (extraPerCell > 0 and:[cell vSpaceFill]) ifTrue:[ extra _ (last _ extra) + (extraPerCell * cell extraSpace). amount _ extra truncated - last truncated. height _ height + amount. ]. cell target layoutInBounds: (posX @ posY extent: width @ height). posY _ posY + height + inset. cell _ cell nextCell. ]. |
| TableLayout>>computeCellArrangement:in:horizontal:target:: (ar 11/13/2000 18:24 -> jdl 3/28/2003 08:18) |
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level. Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row." | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset | maxCell _ cellHolder key. cells _ cellHolder value. properties wrapDirection == #none ifTrue:[wrap _ SmallInteger maxVal] ifFalse:[wrap _ aBool ifTrue:[newBounds width] ifFalse:[newBounds height]. wrap < maxCell x ifTrue:[wrap _ maxCell x]]. spacing _ properties cellSpacing. (spacing == #globalRect or:[spacing = #globalSquare]) ifTrue:[ "Globally equal spacing is a very special case here, so get out fast and easy" ^self computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing]. output _ (WriteStream on: Array new). inset _ properties cellInset asPoint. aBool ifFalse:[inset _ inset transposed]. first _ last _ nil. maxExtent _ 0@0. sum _ 0. index _ 1. n _ 0. hFill _ vFill _ false. [index <= cells size] whileTrue:[ w _ sum. cell _ cells at: index. cellMax _ maxExtent max: cell cellSize. "e.g., minSize" (spacing == #localRect or:[spacing == #localSquare]) ifTrue:[ "Recompute entire size of current row" spacing == #localSquare ifTrue:[max _ cellMax x max: cellMax y] ifFalse:[max _ cellMax x]. sum _ (n + 1) * max. ] ifFalse:[ sum _ sum + (cell cellSize x). ]. ((sum + (n * inset x)) > wrap and:[first notNil]) ifTrue:[ "It doesn't fit and we're not starting a new line" (spacing == #localSquare or:[spacing == #localRect]) ifTrue:[ spacing == #localSquare ifTrue:[maxExtent _ (maxExtent x max: maxExtent y) asPoint]. first do:[:c| c cellSize: maxExtent]]. w _ w + ((n - 1) * inset x). "redistribute extra space" first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]]. last _ LayoutCell new. last cellSize: w @ (maxExtent y). last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse:[last addExtraSpace: 0@inset y]. output nextPut: last. first _ nil. maxExtent _ 0@0. sum _ 0. n _ 0. hFill _ vFill _ false. ] ifFalse:[ "It did fit; use next item from input" first ifNil:[first _ last _ cell] ifNotNil:[last nextCell: cell. last _ cell]. index _ index+1. n _ n + 1. maxExtent _ cellMax. hFill _ hFill or:[cell hSpaceFill]. vFill _ vFill or:[cell vSpaceFill]. ]. ]. first ifNotNil:[ last _ LayoutCell new. sum _ sum + ((n - 1) * inset x). first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]]. last cellSize: sum @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse:[last addExtraSpace: 0@inset y]. output nextPut: last]. output _ output contents. properties listSpacing == #equal ifTrue:[ "Make all the heights equal" max _ output inject: 0 into:[:size :c| size max: c cellSize y]. output do:[:c| c cellSize: c cellSize x @ max]. ]. ^output |
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level. Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row." | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset | maxCell := cellHolder key. cells := cellHolder value. properties wrapDirection == #none ifTrue: [wrap := SmallInteger maxVal] ifFalse: [wrap := aBool ifTrue: [newBounds width] ifFalse: [newBounds height]. wrap := wrap max: (maxCell x)]. spacing := properties cellSpacing. (spacing == #globalRect or: [spacing = #globalSquare]) ifTrue: ["Globally equal spacing is a very special case here, so get out fast and easy" ^self computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing]. output := WriteStream on: Array new. inset := properties cellInset asPoint. aBool ifFalse: [inset := inset transposed]. first := last := nil. maxExtent := 0 @ 0. sum := 0. index := 1. n := 0. hFill := vFill := false. [index <= cells size] whileTrue: [w := sum. cell := cells at: index. cellMax := maxExtent max: cell cellSize. "e.g., minSize" sum := (spacing == #localRect or: [spacing == #localSquare]) ifTrue: ["Recompute entire size of current row" max := spacing == #localSquare ifTrue: [cellMax x max: cellMax y] ifFalse: [cellMax x]. (n + 1) * max] ifFalse: [sum + cell cellSize x]. (sum + (n * inset x) > wrap and: [first notNil]) ifTrue: ["It doesn't fit and we're not starting a new line" (spacing == #localSquare or: [spacing == #localRect]) ifTrue: [spacing == #localSquare ifTrue: [maxExtent := (maxExtent x max: maxExtent y) asPoint]. first do: [:c | c cellSize: maxExtent]]. w := w + ((n - 1) * inset x). "redistribute extra space" first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last := LayoutCell new. last cellSize: w @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last. first := nil. maxExtent := 0 @ 0. sum := 0. n := 0. hFill := vFill := false] ifFalse: ["It did fit; use next item from input" first ifNil: [first := last := cell] ifNotNil: [last nextCell: cell. last := cell]. index := index + 1. n := n + 1. maxExtent := cellMax. hFill := hFill or: [cell hSpaceFill]. vFill := vFill or: [cell vSpaceFill]]]. first ifNotNil: [last := LayoutCell new. sum := sum + ((n - 1) * inset x). first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last cellSize: sum @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last]. output := output contents. properties listSpacing == #equal ifTrue: ["Make all the heights equal" max := output inject: 0 into: [:size :c | size max: c cellSize y]. output do: [:c | c cellSize: c cellSize x @ max]]. ^output |
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level. Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row." | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset | maxCell := cellHolder key. cells := cellHolder value. maxCell _ cellHolder key. cells _ cellHolder value. properties wrapDirection == #none ifTrue: [wrap := SmallInteger maxVal] ifFalse: [wrap := aBool ifTrue: [newBounds width] ifFalse: [newBounds height]. wrap := wrap max: (maxCell x)]. spacing := properties cellSpacing. (spacing == #globalRect or: [spacing = #globalSquare]) ifTrue: ["Globally equal spacing is a very special case here, so get out fast and easy" ^self computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing]. output := WriteStream on: Array new. inset := properties cellInset asPoint. aBool ifFalse: [inset := inset transposed]. first := last := nil. maxExtent := 0 @ 0. sum := 0. index := 1. n := 0. hFill := vFill := false. [index <= cells size] whileTrue: [w := sum. cell := cells at: index. cellMax := maxExtent max: cell cellSize. "e.g., minSize" sum := (spacing == #localRect or: [spacing == #localSquare]) ifTrue: ["Recompute entire size of current row" ifTrue:[wrap _ SmallInteger maxVal] ifFalse:[wrap _ aBool ifTrue:[newBounds width] ifFalse:[newBounds height]. wrap < maxCell x ifTrue:[wrap _ maxCell x]]. spacing _ properties cellSpacing. (spacing == #globalRect or:[spacing = #globalSquare]) ifTrue:[ "Globally equal spacing is a very special case here, so get out fast and easy" ^self computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing]. max := spacing == #localSquare ifTrue: [cellMax x max: cellMax y] ifFalse: [cellMax x]. (n + 1) * max] ifFalse: [sum + cell cellSize x]. (sum + (n * inset x) > wrap and: [first notNil]) ifTrue: ["It doesn't fit and we're not starting a new line" (spacing == #localSquare or: [spacing == #localRect]) ifTrue: [spacing == #localSquare ifTrue: [maxExtent := (maxExtent x max: maxExtent y) asPoint]. first do: [:c | c cellSize: maxExtent]]. w := w + ((n - 1) * inset x). "redistribute extra space" first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last := LayoutCell new. last cellSize: w @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last. first := nil. maxExtent := 0 @ 0. sum := 0. n := 0. hFill := vFill := false] ifFalse: ["It did fit; use next item from input" first ifNil: [first := last := cell] ifNotNil: [last nextCell: cell. last := cell]. index := index + 1. n := n + 1. maxExtent := cellMax. hFill := hFill or: [cell hSpaceFill]. vFill := vFill or: [cell vSpaceFill]]]. first ifNotNil: [last := LayoutCell new. sum := sum + ((n - 1) * inset x). first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last cellSize: sum @ maxExtent y. output _ (WriteStream on: Array new). inset _ properties cellInset asPoint. aBool ifFalse:[inset _ inset transposed]. first _ last _ nil. maxExtent _ 0@0. sum _ 0. index _ 1. n _ 0. hFill _ vFill _ false. [index <= cells size] whileTrue:[ w _ sum. cell _ cells at: index. cellMax _ maxExtent max: cell cellSize. "e.g., minSize" (spacing == #localRect or:[spacing == #localSquare]) ifTrue:[ "Recompute entire size of current row" spacing == #localSquare ifTrue:[max _ cellMax x max: cellMax y] ifFalse:[max _ cellMax x]. sum _ (n + 1) * max. ] ifFalse:[ sum _ sum + (cell cellSize x). ]. ((sum + (n * inset x)) > wrap and:[first notNil]) ifTrue:[ "It doesn't fit and we're not starting a new line" (spacing == #localSquare or:[spacing == #localRect]) ifTrue:[ spacing == #localSquare ifTrue:[maxExtent _ (maxExtent x max: maxExtent y) asPoint]. first do:[:c| c cellSize: maxExtent]]. w _ w + ((n - 1) * inset x). "redistribute extra space" first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]]. last _ LayoutCell new. last cellSize: w @ (maxExtent y). last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last]. output := output contents. properties listSpacing == #equal ifTrue: ["Make all the heights equal" max := output inject: 0 into: [:size :c | size max: c cellSize y]. output do: [:c | c cellSize: c cellSize x @ max]]. output position = 0 ifFalse:[last addExtraSpace: 0@inset y]. output nextPut: last. first _ nil. maxExtent _ 0@0. sum _ 0. n _ 0. hFill _ vFill _ false. ] ifFalse:[ "It did fit; use next item from input" first ifNil:[first _ last _ cell] ifNotNil:[last nextCell: cell. last _ cell]. index _ index+1. n _ n + 1. maxExtent _ cellMax. hFill _ hFill or:[cell hSpaceFill]. vFill _ vFill or:[cell vSpaceFill]. ]. ]. first ifNotNil:[ last _ LayoutCell new. sum _ sum + ((n - 1) * inset x). first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]]. last cellSize: sum @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse:[last addExtraSpace: 0@inset y]. output nextPut: last]. output _ output contents. properties listSpacing == #equal ifTrue:[ "Make all the heights equal" max _ output inject: 0 into:[:size :c| size max: c cellSize y]. output do:[:c| c cellSize: c cellSize x @ max]. ]. ^output |
| PasteUpMorph>>selectedRect: (no stamp -> jdl 3/28/2003 08:17) |
selectedRect "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph." | p | p _ cursor asInteger. p > submorphs size ifTrue: [p _ submorphs size]. p < 1 ifTrue: [p _ 1]. ^ (submorphs at: p) fullBounds expandBy: 2. |
selectedRect "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph." | p | p := cursor asInteger. p := p min: submorphs size. p := p max: 1. ^(submorphs at: p) fullBounds expandBy: 2 |
selectedRect "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph." | p | p := cursor asInteger. p := p min: submorphs size. p := p max: 1. ^(submorphs at: p) fullBounds expandBy: 2 p _ cursor asInteger. p > submorphs size ifTrue: [p _ submorphs size]. p < 1 ifTrue: [p _ 1]. ^ (submorphs at: p) fullBounds expandBy: 2. |
| SoundRecorder>>isActive: (no stamp -> jj 10/20/97 15:30) |
no previous history |
isActive "Return true if I have a recordProcess running." ^ recordProcess ~~ nil |
| HandMorph>>cursorBounds: (di 3/14/1999 10:03 -> jwh 6/5/2000 07:38) |
cursorBounds temporaryCursor == nil ifTrue: [^ self position extent: NormalCursor extent] ifFalse: [^ self position + temporaryCursorOffset extent: temporaryCursor extent] |
cursorBounds ^temporaryCursor ifNil: [self position extent: NormalCursor extent] ifNotNil: [self position + temporaryCursorOffset extent: temporaryCursor extent] |
cursorBounds ^temporaryCursor ifNil: [self position extent: NormalCursor extent] ifNotNil: [self position + temporaryCursorOffset extent: temporaryCursor extent] temporaryCursor == nil ifTrue: [^ self position extent: NormalCursor extent] ifFalse: [^ self position + temporaryCursorOffset extent: temporaryCursor extent] |
| Magnitude>>putOn:: (no stamp -> no stamp) |
no previous history |
not found |
| SequenceableCollection>>putOn:: (no stamp -> no stamp) |
no previous history |
not found |
| Stream>><<: (no stamp -> no stamp) |
no previous history |
not found |
| WriteStream>><<: (no stamp -> no stamp) |
no previous history |
not found |
| BlockContext>>=: (no stamp -> no stamp) |
no previous history |
not found |
| BlockContext>>hash: (no stamp -> no stamp) |
no previous history |
not found |
| MenuItemMorph>>deselectTimeOut:: (ar 10/10/2000 01:50 -> dgd 9/9/2004 21:09) |
deselectTimeOut: evt "Deselect timout. Now really deselect" owner selectedItem == self ifTrue:[owner selectItem: nil event: evt]. |
deselectTimeOut: evt "Deselect timout. Now really deselect" owner selectedItem == self ifTrue:[ evt hand newMouseFocus: nil. owner selectItem: nil event: evt]. |
deselectTimeOut: evt "Deselect timout. Now really deselect" owner selectedItem == self ifTrue:[ evt hand newMouseFocus: nil. owner selectItem: nil event: evt]. owner selectedItem == self ifTrue:[owner selectItem: nil event: evt]. |
| SmalltalkImage>>saveAs:: (no stamp -> no stamp) |
no previous history |
not found |
| SmalltalkImage>>saveAs: (sd 11/16/2003 14:10 -> tpr 12/15/2003 12:21) |
saveAs "Put up the 'saveAs' prompt, obtain a name, and save the image under that new name." | newName | newName _ self getFileNameFromUser. newName isNil ifTrue: [^ self]. (SourceFiles at: 2) ifNotNil: [self saveChangesInFileNamed: (self fullNameForChangesNamed: newName)]. self saveImageInFileNamed: (self fullNameForImageNamed: newName) |
saveAs "Put up the 'saveAs' prompt, obtain a name, and save the image under that new name." | newName | newName _ self getFileNameFromUser. newName isNil ifTrue: [^ self]. (SourceFiles at: 2) ifNotNil: [self closeSourceFiles; "so copying the changes file will always work" saveChangesInFileNamed: (self fullNameForChangesNamed: newName)]. self saveImageInFileNamed: (self fullNameForImageNamed: newName) |
saveAs "Put up the 'saveAs' prompt, obtain a name, and save the image under that new name." | newName | newName _ self getFileNameFromUser. newName isNil ifTrue: [^ self]. (SourceFiles at: 2) ifNotNil: [self closeSourceFiles; "so copying the changes file will always work" saveChangesInFileNamed: (self fullNameForChangesNamed: newName)]. [self saveChangesInFileNamed: (self fullNameForChangesNamed: newName)]. self saveImageInFileNamed: (self fullNameForImageNamed: newName) |
| SocketStream>><<: (no stamp -> no stamp) |
no previous history |
not found |
| Behavior>>allSelectors: (no stamp -> NS 12/12/2003 15:57) |
allSelectors "Answer a Set of all the message selectors that instances of the receiver can understand." "Point allSelectors" | temp | ^ superclass == nil ifTrue: [self selectors] ifFalse: [temp _ superclass allSelectors. temp addAll: self selectors. temp] |
allSelectors "Answer all selectors understood by instances of the receiver" | coll | coll _ OrderedCollection new. self withAllSuperclasses do: [:aClass | coll addAll: aClass selectors]. ^ coll asIdentitySet |
allSelectors "Answer all selectors understood by instances of the receiver" | coll | coll _ OrderedCollection new. self withAllSuperclasses do: [:aClass | coll addAll: aClass selectors]. ^ coll asIdentitySet "Answer a Set of all the message selectors that instances of the receiver can understand." "Point allSelectors" | temp | ^ superclass == nil ifTrue: [self selectors] ifFalse: [temp _ superclass allSelectors. temp addAll: self selectors. temp] |
| EventRecorderMorph class>>openTapeFromFile:: (hg 8/3/2000 17:24 -> los 2/26/2004 11:46) |
openTapeFromFile: fullName "Open an eventRecorder tape for playback." (EventRecorderMorph new readTape: fullName) rewind openInWorld |
openTapeFromFile: fullName "Open an eventRecorder tape for playback." (self new) readTape: fullName; openInWorld |
openTapeFromFile: fullName "Open an eventRecorder tape for playback." (self new) readTape: fullName; openInWorld (EventRecorderMorph new readTape: fullName) rewind openInWorld |
| SyntaxError>>contents:notifying:: (di 8/17/1998 10:28 -> di 10/9/1998 16:36) |
contents: aString notifying: aController "Compile the code in aString and notify aController of any errors. If there are no errors, then automatically proceed." (class compile: aString classified: category notifying: aController) ifNil: [^ false] ifNotNil: [aController hasUnacceptedEdits: false. self proceed]. |
contents: aString notifying: aController "Compile the code in aString and notify aController of any errors. If there are no errors, then automatically proceed." doitFlag ifTrue: [Compiler new evaluate: aString in: nil to: nil notifying: aController ifFail: [^ false]] ifFalse: [(class compile: aString classified: category notifying: aController) ifNil: [^ false]]. aController hasUnacceptedEdits: false. self proceed |
contents: aString notifying: aController "Compile the code in aString and notify aController of any errors. If there are no errors, then automatically proceed." doitFlag ifTrue: [Compiler new evaluate: aString in: nil to: nil notifying: aController ifFail: [^ false]] ifFalse: [(class compile: aString classified: category notifying: aController) ifNil: [^ false]]. aController hasUnacceptedEdits: false. self proceed (class compile: aString classified: category notifying: aController) ifNil: [^ false] ifNotNil: [aController hasUnacceptedEdits: false. self proceed]. |
| Inspector>>explorePointers: (no stamp -> avi 2/18/2004 01:31) |
no previous history |
explorePointers PointerExplorer new openExplorerFor: self selection |
| MenuMorph>>mouseDownInTitle:: (no stamp -> no stamp) |
no previous history |
not found |
| MenuMorph>>mouseDown:: (ar 10/10/2000 01:53 -> RAA 12/16/2000 11:20) |
mouseDown: evt "Handle a mouse down event." (stayUp or:[self fullContainsPoint: evt position]) ifFalse:[^self deleteIfPopUp: evt]. "click outside" "Grab the menu and drag it to some other place" evt hand grabMorph: self. |
mouseDown: evt "Handle a mouse down event." (stayUp or:[self fullContainsPoint: evt position]) ifFalse:[^self deleteIfPopUp: evt]. "click outside" self isSticky ifTrue: [^self]. "Grab the menu and drag it to some other place" evt hand grabMorph: self. |
mouseDown: evt
"Handle a mouse down event."
(stayUp or:[self fullContainsPoint: evt position])
ifFalse:[^self deleteIfPopUp: evt]. "click outside"
self isSticky ifTrue: [^self].
"Grab the menu and drag it to some other place"
evt hand grabMorph: self.
|
| SmalltalkImage>>saveImageInFileNamed:: (sd 11/16/2003 14:17 -> tpr 12/15/2003 15:58) |
saveImageInFileNamed: aString self changeImageNameTo: (FileDirectory default fullNameFor: aString). self closeSourceFiles. self openSourceFiles. "so SNAPSHOT appears in new changes file" self saveImageSegments. self snapshot: true andQuit: false. |
saveImageInFileNamed: aString | fullImageName | fullImageName _ (FileDirectory default fullNameFor: aString). (FileDirectory default directoryNamed:(FileDirectory dirPathFor: fullImageName )) assureExistence. self changeImageNameTo: fullImageName; closeSourceFiles; openSourceFiles; "so SNAPSHOT appears in new changes file" saveImageSegments; snapshot: true andQuit: false |
saveImageInFileNamed: aString | fullImageName | fullImageName _ (FileDirectory default fullNameFor: aString). (FileDirectory default directoryNamed:(FileDirectory dirPathFor: fullImageName )) assureExistence. self changeImageNameTo: fullImageName; closeSourceFiles; openSourceFiles; "so SNAPSHOT appears in new changes file" saveImageSegments; snapshot: true andQuit: false changeImageNameTo: (FileDirectory default fullNameFor: aString). self closeSourceFiles. self openSourceFiles. "so SNAPSHOT appears in new changes file" self saveImageSegments. self snapshot: true andQuit: false. |
| Categorizer>>categories:: (no stamp -> NS 4/5/2004 17:44) |
no previous history |
categories: anArray "Reorder my categories to be in order of the argument, anArray. If the resulting organization does not include all elements, then give an error." | newCategories newStops newElements catName list runningTotal | newCategories _ Array new: anArray size. newStops _ Array new: anArray size. newElements _ Array new: 0. runningTotal _ 0. 1 to: anArray size do: [:i | catName _ (anArray at: i) asSymbol. list _ self listAtCategoryNamed: catName. newElements _ newElements, list. newCategories at: i put: catName. newStops at: i put: (runningTotal _ runningTotal + list size)]. elementArray do: [:element | "check to be sure all elements are included" (newElements includes: element) ifFalse: [^self error: 'New categories must match old ones']]. "Everything is good, now update my three arrays." categoryArray _ newCategories. categoryStops _ newStops. elementArray _ newElements |
| ObjectExplorer>>explorePointers: (no stamp -> no stamp) |
no previous history |
not found |
| ObjectExplorer>>genericMenu:: (nk 7/24/2003 10:24 -> sd 11/20/2005 21:27) |
genericMenu: aMenu "Borrow a menu from my inspector" | insideObject menu parentObject | currentSelection ifNil: [menu _ aMenu. menu add: '*nothing selected*' target: self selector: #yourself] ifNotNil: [insideObject _ self object. parentObject _ self parentObject. inspector ifNil: [inspector _ Inspector new]. inspector inspect: parentObject; object: insideObject. aMenu defaultTarget: inspector. inspector fieldListMenu: aMenu. aMenu items do: [:i | (#(#inspectSelection #exploreSelection #referencesToSelection #defsOfSelection #objectReferencesToSelection #chasePointers ) includes: i selector) ifTrue: [i target: self]]. aMenu addLine; add: 'monitor changes' target: self selector: #monitor: argument: currentSelection]. monitorList isEmptyOrNil ifFalse: [aMenu addLine; add: 'stop monitoring all' target: self selector: #stopMonitoring]. ^ aMenu |
genericMenu: aMenu "Borrow a menu from my inspector" | insideObject menu parentObject | currentSelection ifNil: [menu := aMenu. menu add: '*nothing selected*' target: self selector: #yourself] ifNotNil: [insideObject := self object. parentObject := self parentObject. inspector ifNil: [inspector := Inspector new]. inspector inspect: parentObject; object: insideObject. aMenu defaultTarget: inspector. inspector fieldListMenu: aMenu. aMenu items do: [:i | (#(#inspectSelection #exploreSelection #referencesToSelection #defsOfSelection #objectReferencesToSelection #chasePointers ) includes: i selector) ifTrue: [i target: self]]. aMenu addLine; add: 'monitor changes' target: self selector: #monitor: argument: currentSelection]. monitorList isEmptyOrNil ifFalse: [aMenu addLine; add: 'stop monitoring all' target: self selector: #stopMonitoring]. ^ aMenu |
genericMenu: aMenu "Borrow a menu from my inspector" | insideObject menu parentObject | currentSelection ifNil: [menu := aMenu. ifNil: [menu _ aMenu. menu add: '*nothing selected*' target: self selector: #yourself] ifNotNil: [insideObject := self object. parentObject := self parentObject. ifNotNil: [insideObject _ self object. parentObject _ self parentObject. inspector ifNil: [inspector := Inspector new]. ifNil: [inspector _ Inspector new]. inspector inspect: parentObject; object: insideObject. aMenu defaultTarget: inspector. inspector fieldListMenu: aMenu. aMenu items do: [:i | (#(#inspectSelection #exploreSelection #referencesToSelection #defsOfSelection #objectReferencesToSelection #chasePointers ) includes: i selector) ifTrue: [i target: self]]. aMenu addLine; add: 'monitor changes' target: self selector: #monitor: argument: currentSelection]. monitorList isEmptyOrNil ifFalse: [aMenu addLine; add: 'stop monitoring all' target: self selector: #stopMonitoring]. ^ aMenu |
| MethodContext>>printString: (emm 5/30/2002 14:07 -> mvl 3/13/2007 11:40) |
printString "Answer an emphasized string in case of a breakpoint method" ^self method hasBreakpoint ifTrue:[(super printString , ' [break]') asText allBold] ifFalse:[super printString] |
printString "Answer an emphasized string in case of a breakpoint method" ^(self method notNil and: [self method hasBreakpoint]) ifTrue:[(super printString , ' [break]') asText allBold] ifFalse:[super printString] |
printString "Answer an emphasized string in case of a breakpoint method" ^(self method notNil and: [self method hasBreakpoint]) ^self method hasBreakpoint ifTrue:[(super printString , ' [break]') asText allBold] ifFalse:[super printString] |
| Process>>environmentAt:: (no stamp -> no stamp) |
no previous history |
not found |
| Process>>environmentAt:ifAbsent:: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificVariable class>>value: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificVariable class>>initialize: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificVariable class>>hash: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificVariable class>>default: (no stamp -> no stamp) |
no previous history |
not found |
| DynamicVariable class>>value:during:: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessLocalVariable class>>value:: (no stamp -> no stamp) |
no previous history |
not found |
| TestLocalVariable class>>default: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificTest>>checkDynamic:: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificTest>>testDynamicVariable: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificTest>>testLocalVariable: (no stamp -> no stamp) |
no previous history |
not found |
| ProcessSpecificTest>>checkLocal:: (no stamp -> no stamp) |
no previous history |
not found |
| TestCase>>executeShould:inScopeOf:withExceptionDo:: (DF 3/17/2006 01:26 -> mx 3/20/2006 23:32) |
executeShould: aBlock inScopeOf: anExceptionalEvent withExceptionDo: aOneArgBlock ^[aBlock value. false] on: anExceptionalEvent do: [:ex | aOneArgBlock value: ex. ex return: true] |
executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock ^[aBlock value. false] on: anException do: [:exception | anotherBlock value: exception. exception return: true] |
executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock executeShould: aBlock inScopeOf: anExceptionalEvent withExceptionDo: aOneArgBlock ^[aBlock value. false] on: anException do: [:exception | anotherBlock value: exception. exception return: true] false] on: anExceptionalEvent do: [:ex | aOneArgBlock value: ex. ex return: true] |
| TestCase>>fail: (no stamp -> mx 3/13/2006 23:21) |
no previous history |
fail ^self assert: false |
| TestCase>>shouldFix:: (no stamp -> mx 3/20/2006 21:29) |
no previous history |
shouldFix: aBlock ^self should: aBlock raise: Exception |
| TestCase>>should:raise:withExceptionDo:: (DF 3/17/2006 01:27 -> mx 3/20/2006 23:52) |
should: aBlock raise: anExceptionalEvent withExceptionDo: aOneArgBlock ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withExceptionDo: aOneArgBlock) |
should: aBlock raise: anException withExceptionDo: anotherBlock ^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock) |
should: aBlock raise: anException withExceptionDo: anotherBlock should: aBlock raise: anExceptionalEvent withExceptionDo: aOneArgBlock ^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock) ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withExceptionDo: aOneArgBlock) |
| SUnitExtensionsTest>>differentExceptionInShouldRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
differentExceptionInShouldRaiseWithExceptionDoTest [ self should: [ Error signal ] raise: Halt withExceptionDo: [ :anException | self assert: false description: 'should:raise:withExceptionDo: handled an exception that should not handle'] ] on: Error do: [ :anException | anException return: nil ] |
| SUnitExtensionsTest>>testAutoDenyFalse: (no stamp -> mx 3/20/2006 21:16) |
no previous history |
testAutoDenyFalse
| booleanCondition |
self assert: self isLogging.
self should: [ self deny: 1 = 1 description: 'self deny: 1 = 1'.] raise: TestResult failure.
booleanCondition := (self stream contents subStrings: {Character cr}) last = 'self deny: 1 = 1'.
self assert: booleanCondition
|
| SUnitExtensionsTest>>assertionFailedInRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
assertionFailedInRaiseWithExceptionDoTest self should: [ Error signal ] raise: Error withExceptionDo: [ :anException | self assert: false ] |
| SUnitExtensionsTest>>errorInRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
errorInRaiseWithExceptionDoTest self should: [ Error signal ] raise: Error withExceptionDo: [ :anException | Error signal: 'A forced error' ] |
| SUnitExtensionsTest>>testNoExceptionInShouldRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testNoExceptionInShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #noExceptionInShouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult failures includes: testCase). self assert: testResult failures size=1. self assert: testResult passed isEmpty. self assert: testResult errors isEmpty. |
| SUnitExtensionsTest>>testErrorInRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testErrorInRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #errorInRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult errors includes: testCase). self assert: testResult errors size=1. self assert: testResult failures isEmpty. self assert: testResult passed isEmpty. |
| SUnitExtensionsTest>>testAssertionFailedInRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:39) |
no previous history |
testAssertionFailedInRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #assertionFailedInRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult failures includes: testCase). self assert: testResult failures size=1. self assert: testResult passed isEmpty. self assert: testResult errors isEmpty. |
| SUnitExtensionsTest>>testAutoAssertFalse: (no stamp -> mx 3/20/2006 21:15) |
no previous history |
testAutoAssertFalse
| booleanCondition |
self assert: self isLogging.
self should: [ self assert: 1 = 2 description: 'self assert: 1 = 2' ] raise: TestResult failure.
booleanCondition := (self stream contents subStrings: {Character cr}) last = 'self assert: 1 = 2'.
self assert: booleanCondition
|
| SUnitExtensionsTest>>noExceptionInShouldRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
noExceptionInShouldRaiseWithExceptionDoTest self should: [ ] raise: Error withExceptionDo: [ :anException | Error signal: 'Should not get here' ] |
| SUnitExtensionsTest>>shouldRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
shouldRaiseWithExceptionDoTest self should: [ Error signal: '1' ] raise: Error withExceptionDo: [ :anException | self assert: anException messageText = '1' ] |
| SUnitExtensionsTest>>shouldRaiseWithSignalDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
shouldRaiseWithSignalDoTest self should: [ Error signal: '1' ] raise: Error withExceptionDo: [ :anException | self assert: anException messageText = '1' ] |
| SUnitExtensionsTest>>testDifferentExceptionInShouldRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testDifferentExceptionInShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #differentExceptionInShouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult errors isEmpty. self assert: testResult failures isEmpty. self assert: testResult passed size=1 |
| SUnitExtensionsTest>>testShouldRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #shouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult passed size=1. self assert: testResult failures isEmpty. self assert: testResult errors isEmpty. |
| DictionaryTest>>testIncludesAssociationNoValue: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:25) |
no previous history |
testIncludesAssociationNoValue "self run:#testIncludesAssociationNoValue" "self debug:#testIncludesAssociationNoValue" | dict a1 a3 | a1 := Association key: #Italie. a3 := Association key: #France value: 'Paris'. self assert: (a1 key = #Italie). self assert: (a1 value isNil). dict := Dictionary new. dict add: a1. dict add: a3. self assert: (dict includesKey: #France). self assert: (dict includesKey: #Italie). self assert: (dict at: #Italie) isNil. self assert: (dict at: #France) = 'Paris' |
| HeapTest>>testAdd: (no stamp -> nm 2/28/2006 09:37) |
no previous history |
testAdd "self run: #testAdd" | heap | heap := Heap new. self assert: heap size = 0. heap add: 3. self assert: heap size = 1. self assert: heap isEmpty not. self assert: heap first = 3. self assert: (heap at: 1) = 3. heap add: 2. self assert: heap size = 2. self assert: heap first = 2. self assert: (heap at: 2) = 3. |
| HeapTest>>testFirst: (no stamp -> nm 2/28/2006 09:36) |
no previous history |
testFirst "self run: #testFirst" | heap | heap := Heap new. heap add: 5. heap add: 12. heap add: 1. self assert: heap first = 1. heap removeFirst. self assert: heap first = 5. |
| HeapTest>>testSortBlock: (no stamp -> nm 4/3/2006 11:17) |
no previous history |
testSortBlock "self run: #testSortBlock" | heap | heap := Heap withAll: #(1 3 5). self assert: heap = #(1 3 5). heap sortBlock: [ :e1 :e2 | e1 >= e2 ]. self assert: heap = #(5 3 1) |
| HeapTest>>testHeap: (no stamp -> nm 4/3/2006 11:27) |
no previous history |
testHeap "self run: #testHeap" | heap | heap := Heap new. self assert: heap isHeap. self assert: heap isEmpty. heap add: 1. self assert: heap isEmpty not |
| HeapTest>>testDo: (no stamp -> nm 4/3/2006 11:22) |
no previous history |
testDo "self run: #testDo" | heap coll | heap := Heap withAll: #(1 3 5). coll := OrderedCollection new. heap do: [:each | coll add: each]. self assert: coll = #(1 3 5) asOrderedCollection. |
| HeapTest>>testRemove: (no stamp -> nm 2/15/2006 09:55) |
no previous history |
testRemove "self run: #testRemove" | heap | heap := Heap new. self should: [heap removeFirst] raise: Error. heap add: 5. self shouldnt: [heap removeFirst] raise: Error. self assert: heap size = 0. heap add: 5. self should: [heap removeAt: 2] raise: Error. |
| Object>>isTrait: (no stamp -> pmm 7/6/2006 20:46) |
no previous history |
isTrait "Return true if the receiver is a trait. Note: Do not override in any class except TraitBehavior." ^false |
| Set class>>rehashAllSets: (SqR 8/3/2000 13:18 -> pmm 7/9/2006 11:48) |
rehashAllSets "Set rehashAllSets" | insts | self withAllSubclassesDo: [:c | insts _ c allInstances. insts isEmpty ifFalse: ['Rehashing instances of ' , c name displayProgressAt: Sensor cursorPoint from: 1 to: insts size during: [:bar | 1 to: insts size do: [:x | bar value: x. (insts at: x) rehash]] ] ] |
rehashAllSets "Set rehashAllSets" self withAllSubclassesDo: [ :setClass | | instances | instances := setClass allInstances. instances isEmpty ifFalse: [ 1 to: instances size do: [ :index | (instances at: index) rehash ] ] ] |
rehashAllSets "Set rehashAllSets" self withAllSubclassesDo: [ :setClass | | instances | instances := setClass allInstances. instances isEmpty ifFalse: [ 1 to: instances size do: [ :index | (instances at: index) rehash ] ] ] rehashAllSets "Set rehashAllSets" | insts | self withAllSubclassesDo: [:c | insts _ c allInstances. insts isEmpty ifFalse: ['Rehashing instances of ' , c name displayProgressAt: Sensor cursorPoint from: 1 to: insts size during: [:bar | 1 to: insts size do: [:x | bar value: x. (insts at: x) rehash]] ] ] |
| Set class>>new: (md 2/11/2006 20:48 -> pmm 7/9/2006 11:46) |
new ^ self new: 5 |
new ^ self basicNew initialize: 5 |
new ^ self basicNew initialize: 5 ^ self new: 5 |
| CodeLoader class>>exportCodeSegment:classes:keepSource:: (mir 1/27/2000 17:24 -> mir 10/11/2000 19:12) |
exportCodeSegment: exportName classes: aClassList keepSource: keepSources "Code for writing out a specific category of classes as an external image segment. Perhaps this should be a method." | is oldMethods newMethods m oldCodeString argsAndTemps classList symbolHolder | keepSources ifTrue: [ self confirm: 'We are going to abandon sources. Quit without saving after this has run.' orCancel: [^self]]. classList _ aClassList asArray. "Strong pointers to symbols" symbolHolder := Symbol allInstances. oldMethods _ OrderedCollection new: classList size * 150. newMethods _ OrderedCollection new: classList size * 150. keepSources ifTrue: [ classList do: [:cl | cl selectors do: [:selector | m _ cl compiledMethodAt: selector. m fileIndex > 0 ifTrue: [oldCodeString _ cl sourceCodeAt: selector. argsAndTemps _ (cl compilerClass new parse: oldCodeString in: cl notifying: nil) tempNames. oldMethods addLast: m. newMethods addLast: (m copyWithTempNames: argsAndTemps)]]]]. oldMethods asArray elementsExchangeIdentityWith: newMethods asArray. oldMethods _ newMethods _ m _ oldCodeString _ argsAndTemps _ nil. Smalltalk garbageCollect. is _ ImageSegment new copyFromRootsForExport: classList. "Classes and MetaClasses" is writeForExport: exportName. "is inspect." |
exportCodeSegment: exportName classes: aClassList keepSource: keepSources "Code for writing out a specific category of classes as an external image segment. Perhaps this should be a method." | is oldMethods newMethods m oldCodeString argsAndTemps classList symbolHolder fileName | keepSources ifTrue: [ self confirm: 'We are going to abandon sources. Quit without saving after this has run.' orCancel: [^self]]. classList _ aClassList asArray. "Strong pointers to symbols" symbolHolder := Symbol allInstances. oldMethods _ OrderedCollection new: classList size * 150. newMethods _ OrderedCollection new: classList size * 150. keepSources ifTrue: [ classList do: [:cl | cl selectors do: [:selector | m _ cl compiledMethodAt: selector. m fileIndex > 0 ifTrue: [oldCodeString _ cl sourceCodeAt: selector. argsAndTemps _ (cl compilerClass new parse: oldCodeString in: cl notifying: nil) tempNames. oldMethods addLast: m. newMethods addLast: (m copyWithTempNames: argsAndTemps)]]]]. oldMethods asArray elementsExchangeIdentityWith: newMethods asArray. oldMethods _ newMethods _ m _ oldCodeString _ argsAndTemps _ nil. Smalltalk garbageCollect. is _ ImageSegment new copyFromRootsForExport: classList. "Classes and MetaClasses" fileName _ FileDirectory fileName: exportName extension: ImageSegment fileExtension. is writeForExport: fileName. self compressFileNamed: fileName |
exportCodeSegment: exportName classes: aClassList keepSource: keepSources "Code for writing out a specific category of classes as an external image segment. Perhaps this should be a method." | is oldMethods newMethods m oldCodeString argsAndTemps classList symbolHolder fileName | | is oldMethods newMethods m oldCodeString argsAndTemps classList symbolHolder | keepSources ifTrue: [ self confirm: 'We are going to abandon sources. Quit without saving after this has run.' orCancel: [^self]]. classList _ aClassList asArray. "Strong pointers to symbols" symbolHolder := Symbol allInstances. oldMethods _ OrderedCollection new: classList size * 150. newMethods _ OrderedCollection new: classList size * 150. keepSources ifTrue: [ classList do: [:cl | cl selectors do: [:selector | m _ cl compiledMethodAt: selector. m fileIndex > 0 ifTrue: [oldCodeString _ cl sourceCodeAt: selector. argsAndTemps _ (cl compilerClass new parse: oldCodeString in: cl notifying: nil) tempNames. oldMethods addLast: m. newMethods addLast: (m copyWithTempNames: argsAndTemps)]]]]. oldMethods asArray elementsExchangeIdentityWith: newMethods asArray. oldMethods _ newMethods _ m _ oldCodeString _ argsAndTemps _ nil. Smalltalk garbageCollect. is _ ImageSegment new copyFromRootsForExport: classList. "Classes and MetaClasses" is writeForExport: exportName. "is inspect." fileName _ FileDirectory fileName: exportName extension: ImageSegment fileExtension. is writeForExport: fileName. self compressFileNamed: fileName |
| FloatTest>>testZero2: (no stamp -> pmm 2/27/2006 10:49) |
no previous history |
testZero2 self assert: (Float negativeZero asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '10000000000000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '10000000000000000000000000000000' readStream base: 2)) = Float negativeZero |
| FloatTest>>testInfinity3: (no stamp -> pmm 2/27/2006 10:49) |
no previous history |
testInfinity3 self assert: (Float infinity negated asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '11111111100000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '11111111100000000000000000000000' readStream base: 2)) = Float infinity negated |
| LedDigitMorph class>>initialize: (no stamp -> rjf 5/25/2000 00:16) |
no previous history |
initialize
HSegmentOrigins _ {0.2@0.1. 0.2@0.45. 0.2@0.8}.
VSegmentOrigins _ {0.1@0.2. 0.1@0.55. 0.8@0.2. 0.8@0.55}.
HSegments _ {
{true. false. true}.
{false. false. false}.
{true. true. true}.
{true. true. true}.
{false. true. false}.
{true. true. true}.
{true. true. true}.
{true. false. false}.
{true. true. true}.
{true. true. true}.
{false. true. false}}.
VSegments _ {
{true. true. true. true}.
{false. false. true. true}.
{false. true. true. false}.
{false. false. true. true}.
{true. false. true. true}.
{true. false. false. true}.
{true. true. false. true}.
{false. false. true. true}.
{true. true. true. true}.
{true. false. true. true}.
{false. false. false. false}}.
|
| WatchMorph>>handsColor:: (no stamp -> rjf 5/11/2000 00:03) |
no previous history |
handsColor: aColor handsColor _ aColor |
| WatchMorph>>step: (no stamp -> rlf 3/17/2000 12:59) |
no previous history |
step self changed. |
| FileDirectory>>oldFileOrNoneNamed:: (tpr 10/13/2003 12:34 -> rop 3/14/2004 13:52) |
oldFileOrNoneNamed: fileName "If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil." ^ FileStream oldFileOrNoneNamed: fileName |
oldFileOrNoneNamed: localFileName "If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil." ^ FileStream concreteStream oldFileOrNoneNamed: (self fullNameFor: localFileName) |
oldFileOrNoneNamed: localFileName oldFileOrNoneNamed: fileName "If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil." ^ FileStream concreteStream oldFileOrNoneNamed: (self fullNameFor: localFileName) ^ FileStream oldFileOrNoneNamed: fileName |
| SkipListNode class>>on:level:: (LC 6/18/2001 10:20 -> sac 1/22/2002 17:57) |
on: element level: maxLevel ^ (self new: maxLevel) object: element |
on: element level: maxLevel
^ self key: element value: element level: maxLevel
|
on: element level: maxLevel ^ self key: element value: element level: maxLevel ^ (self new: maxLevel) object: element |
| SkipListNode class>>key:value:level:: (no stamp -> sac 1/22/2002 17:53) |
no previous history |
key: key value: value level: maxLevel
^ (super key: key value: value) initialize: maxLevel
|
| SkipListNode>>printOn:: (sac 1/22/2002 17:22 -> sac 1/22/2002 17:22) |
printOn: aStream
| first |
aStream
nextPut: $[.
super printOn: aStream.
aStream
nextPutAll: ']-->('.
first _ true.
pointers do: [:node |
first ifTrue: [first _ false] ifFalse: [aStream space].
node ifNil: [aStream nextPutAll: '*']
ifNotNil: [node printOn: aStream]].
aStream nextPut: $)
|
printOn: aStream
| first |
aStream
nextPut: $[.
super printOn: aStream.
aStream
nextPutAll: ']-->('.
first := true.
pointers do: [:node |
first ifTrue: [first := false] ifFalse: [aStream space].
node ifNil: [aStream nextPutAll: '*']
ifNotNil: [node printOn: aStream]].
aStream nextPut: $)
|
printOn: aStream
| first |
aStream
nextPut: $[.
super printOn: aStream.
aStream
nextPutAll: ']-->('.
first := true.
first _ true.
pointers do: [:node |
first ifTrue: [first := false] ifFalse: [aStream space].
first ifTrue: [first _ false] ifFalse: [aStream space].
node ifNil: [aStream nextPutAll: '*']
ifNotNil: [node printOn: aStream]].
aStream nextPut: $)
|
| SkipList>>keysAndValuesDo:: (no stamp -> sac 1/25/2002 00:18) |
no previous history |
keysAndValuesDo: aBlock
^self associationsDo:[:assoc|
aBlock value: assoc key value: assoc value].
|
| SkipList>>search:updating:: (sac 1/22/2002 18:01 -> sac 1/22/2002 18:01) |
search: element updating: array
| node forward |
node _ self.
level to: 1 by: -1 do: [:i |
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward].
"At this point: node < element <= forward"
array ifNotNil: [array at: i put: node]].
node _ node next.
^ (self is: node theNodeFor: element) ifTrue: [node]
|
search: element updating: array
| node forward |
node := self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward].
"At this point: node < element <= forward"
array ifNotNil: [array at: i put: node]].
node := node next.
^ (self is: node theNodeFor: element) ifTrue: [node]
|
search: element updating: array
| node forward |
node := self.
node _ self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward].
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward].
"At this point: node < element <= forward"
array ifNotNil: [array at: i put: node]].
node := node next.
node _ node next.
^ (self is: node theNodeFor: element) ifTrue: [node]
|
| SkipList>>at:put:ifPresent:: (sac 1/22/2002 18:23 -> sac 1/22/2002 18:23) |
at: key put: value ifPresent: aBlock
| node lvl s |
node _ self search: key updating: splice.
node ifNotNil: [^ aBlock value].
lvl _ self randomLevel.
node _ SkipListNode key: key value: value level: lvl.
level + 1 to: lvl do: [:i | splice at: i put: self].
1 to: lvl do: [:i |
s _ splice at: i.
node atForward: i put: (s forward: i).
s atForward: i put: node].
numElements _ numElements + 1.
splice atAllPut: nil.
^ node
|
at: key put: value ifPresent: aBlock
| node lvl s |
node := self search: key updating: splice.
node ifNotNil: [^ aBlock value].
lvl := self randomLevel.
node := SkipListNode key: key value: value level: lvl.
level + 1 to: lvl do: [:i | splice at: i put: self].
1 to: lvl do: [:i |
s := splice at: i.
node atForward: i put: (s forward: i).
s atForward: i put: node].
numElements := numElements + 1.
splice atAllPut: nil.
^ node
|
at: key put: value ifPresent: aBlock
| node lvl s |
node := self search: key updating: splice.
node _ self search: key updating: splice.
node ifNotNil: [^ aBlock value].
lvl := self randomLevel.
node := SkipListNode key: key value: value level: lvl.
lvl _ self randomLevel.
node _ SkipListNode key: key value: value level: lvl.
level + 1 to: lvl do: [:i | splice at: i put: self].
1 to: lvl do: [:i |
s := splice at: i.
s _ splice at: i.
node atForward: i put: (s forward: i).
s atForward: i put: node].
numElements := numElements + 1.
numElements _ numElements + 1.
splice atAllPut: nil.
^ node
|
| SkipList>>do:: (LC 6/18/2001 15:39 -> sac 1/23/2002 20:21) |
do: aBlock self nodesDo: [:node | aBlock value: node object] |
do: aBlock
self nodesDo: [:node | aBlock value: node value]
|
do: aBlock self nodesDo: [:node | aBlock value: node value] self nodesDo: [:node | aBlock value: node object] |
| SkipList>>associationsDo:: (no stamp -> sac 1/23/2002 20:24) |
no previous history |
associationsDo: aBlock
self nodesDo: [:node | aBlock value: node]
|
| SkipList>>remove:ifAbsent:: (sac 1/22/2002 16:58 -> sac 1/22/2002 16:58) |
remove: key ifAbsent: aBlock
| node i s |
"Remove and return th association containing key."
node _ self search: key updating: splice.
node ifNil: [^ aBlock value].
i _ 1.
[s _ splice at: i.
i <= level and: [(s forward: i) == node]]
whileTrue:
[s atForward: i put: (node forward: i).
i _ i + 1].
numElements _ numElements - 1.
splice atAllPut: nil.
^ node.
|
remove: key ifAbsent: aBlock
| node i s |
"Remove and return th association containing key."
node := self search: key updating: splice.
node ifNil: [^ aBlock value].
i := 1.
[s := splice at: i.
i <= level and: [(s forward: i) == node]]
whileTrue:
[s atForward: i put: (node forward: i).
i := i + 1].
numElements := numElements - 1.
splice atAllPut: nil.
^ node.
|
remove: key ifAbsent: aBlock
| node i s |
"Remove and return th association containing key."
node := self search: key updating: splice.
node _ self search: key updating: splice.
node ifNil: [^ aBlock value].
i := 1.
[s := splice at: i.
i _ 1.
[s _ splice at: i.
i <= level and: [(s forward: i) == node]]
whileTrue:
[s atForward: i put: (node forward: i).
i := i + 1].
numElements := numElements - 1.
i _ i + 1].
numElements _ numElements - 1.
splice atAllPut: nil.
^ node.
|
| SkipList>>add:ifPresent:: (LC 6/18/2001 20:42 -> sac 1/25/2002 12:26) |
add: element ifPresent: aBlock | node lvl s | node _ self search: element updating: splice. node ifNotNil: [aBlock ifNotNil: [^ aBlock value: node]]. lvl _ self randomLevel. node _ SkipListNode on: element level: lvl. level + 1 to: lvl do: [:i | splice at: i put: self]. 1 to: lvl do: [:i | s _ splice at: i. node atForward: i put: (s forward: i). s atForward: i put: node]. numElements _ numElements + 1. splice atAllPut: nil. ^ element |
add: element ifPresent: aBlock
^self at: element put: element ifPresent: aBlock.
|
add: element ifPresent: aBlock ^self at: element put: element ifPresent: aBlock. | node lvl s | node _ self search: element updating: splice. node ifNotNil: [aBlock ifNotNil: [^ aBlock value: node]]. lvl _ self randomLevel. node _ SkipListNode on: element level: lvl. level + 1 to: lvl do: [:i | splice at: i put: self]. 1 to: lvl do: [:i | s _ splice at: i. node atForward: i put: (s forward: i). s atForward: i put: node]. numElements _ numElements + 1. splice atAllPut: nil. ^ element |
| SkipList>>at:ifAbsent:: (sac 1/22/2002 18:18 -> sac 1/22/2002 18:18) |
at: element ifAbsent: aBlock
"Get the key if it exists, or if it doesn't exist, get the key just after it."
| node forward |
node _ self.
level to: 1 by: -1 do: [:i |
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward]].
node _ node next.
(self is: node theNodeFor: element) ifFalse: [^aBlock value].
^node value
|
at: element ifAbsent: aBlock
"Get the key if it exists, or if it doesn't exist, get the key just after it."
| node forward |
node := self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward]].
node := node next.
(self is: node theNodeFor: element) ifFalse: [^aBlock value].
^node value
|
at: element ifAbsent: aBlock
"Get the key if it exists, or if it doesn't exist, get the key just after it."
| node forward |
node := self.
node _ self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward]].
node := node next.
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward]].
node _ node next.
(self is: node theNodeFor: element) ifFalse: [^aBlock value].
^node value
|
| SkipList>>keysDo:: (no stamp -> sac 1/23/2002 20:22) |
no previous history |
keysDo: aBlock
self nodesDo: [:node | aBlock value: node key]
|
| SkipList>>at:: (no stamp -> sac 1/22/2002 19:11) |
no previous history |
at: element
^self at: element ifAbsent: []
|
| SkipList>>is:before:: (sac 1/22/2002 17:50 -> sac 1/22/2002 17:50) |
is: node before: element
| key |
node ifNil: [^ false].
key _ node key.
^ sortBlock
ifNil: [key < element]
ifNotNil: [(self is: key equalTo: element) ifTrue: [^ false].
sortBlock value: key value: element]
|
is: node before: element
| key |
node ifNil: [^ false].
key := node key.
^ sortBlock
ifNil: [key < element]
ifNotNil: [(self is: key equalTo: element) ifTrue: [^ false].
sortBlock value: key value: element]
|
is: node before: element
| key |
node ifNil: [^ false].
key := node key.
key _ node key.
^ sortBlock
ifNil: [key < element]
ifNotNil: [(self is: key equalTo: element) ifTrue: [^ false].
sortBlock value: key value: element]
|
| SkipList>>add:: (LC 6/18/2001 18:30 -> sac 1/22/2002 18:22) |
add: element self add: element ifPresent: nil. ^ element |
add: element
"Add an association or key on to the skiplist"
^self add: element ifPresent: [].
|
add: element "Add an association or key on to the skiplist" ^self add: element ifPresent: []. self add: element ifPresent: nil. ^ element |
| SkipList>>at:put:: (no stamp -> sac 1/22/2002 18:22) |
no previous history |
at: key put: value
"Add an association or key on to the skiplist"
^self at: key put: value ifPresent: [].
|
| SkipList>>is:theNodeFor:: (LC 6/18/2001 13:19 -> sac 1/22/2002 18:04) |
is: node theNodeFor: element node ifNil: [^ false]. node == self ifTrue: [^ false]. ^ self is: node object equalTo: element |
is: node theNodeFor: key
node ifNil: [^ false].
node == self ifTrue: [^ false].
^ self is: node key equalTo: key
|
is: node theNodeFor: key node ifNil: [^ false]. node == self ifTrue: [^ false]. ^ self is: node key equalTo: key is: node theNodeFor: element node ifNil: [^ false]. node == self ifTrue: [^ false]. ^ self is: node object equalTo: element |
| SkipList>>search:: (sac 1/22/2002 18:33 -> sac 1/22/2002 18:33) |
search: element
"Get the key if it exists, or if it doesn't exist, get the key just after it. If no key after it, return nil."
| node forward |
node _ self.
level to: 1 by: -1 do: [:i |
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward]].
node _ node next.
^node
|
search: element
"Get the key if it exists, or if it doesn't exist, get the key just after it. If no key after it, return nil."
| node forward |
node := self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward]].
node := node next.
^node
|
search: element
"Get the key if it exists, or if it doesn't exist, get the key just after it. If no key after it, return nil."
| node forward |
node := self.
node _ self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward]].
node := node next.
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward]].
node _ node next.
^node
|
| SkipList>>includes:: (LC 6/18/2001 16:59 -> sac 1/22/2002 17:49) |
includes: element ^ (self search: element updating: nil) notNil |
includes: key
^ (self search: key updating: nil) notNil
|
includes: key ^ (self search: key updating: nil) notNil includes: element ^ (self search: element updating: nil) notNil |
| SkipList>>first: (no stamp -> sac 1/22/2002 17:19) |
no previous history |
first
^pointers first.
|
| WorldState class>>deferredExecutionTimeLimit: (no stamp -> sk 1/26/2003 18:29) |
no previous history |
deferredExecutionTimeLimit "Answer the maximum time in milliseconds that should be spent dispatching deferred UI messages in WorldState>>runStepMethodsIn:." ^ 200 |
| WorldState>>runStepMethodsIn:: (ar 10/22/2000 16:07 -> sk 1/26/2003 18:31) |
runStepMethodsIn: aWorld "Perform periodic activity inbetween event cycles" | queue | queue _ self class deferredUIMessages. [queue isEmpty] whileFalse: [ queue next value ]. self runLocalStepMethodsIn: aWorld. "we are using a normal #step for these now" "aWorld allLowerWorldsDo: [ :each | each runLocalStepMethods ]." |
runStepMethodsIn: aWorld "Perform periodic activity inbetween event cycles" | queue numItems i limit stamp | queue _ self class deferredUIMessages. numItems _ queue size. i _ 0. limit _ self class deferredExecutionTimeLimit. stamp _ Time millisecondClockValue. "Dispatch deferred messages while maintaing rudimentary UI responsiveness." [i < numItems and: [(Time millisecondsSince: stamp) < limit]] whileTrue: [queue next value. i _ i + 1]. self runLocalStepMethodsIn: aWorld. "we are using a normal #step for these now" "aWorld allLowerWorldsDo: [ :each | each runLocalStepMethods ]." |
runStepMethodsIn: aWorld "Perform periodic activity inbetween event cycles" | queue numItems i limit stamp | | queue | queue _ self class deferredUIMessages. numItems _ queue size. i _ 0. limit _ self class deferredExecutionTimeLimit. stamp _ Time millisecondClockValue. "Dispatch deferred messages while maintaing rudimentary UI responsiveness." [i < numItems and: [(Time millisecondsSince: stamp) < limit]] whileTrue: [queue next value. i _ i + 1]. [queue isEmpty] whileFalse: [ queue next value ]. self runLocalStepMethodsIn: aWorld. "we are using a normal #step for these now" "aWorld allLowerWorldsDo: [ :each | each runLocalStepMethods ]." |
| MethodDictionary>>do:: (no stamp -> to 1/14/98 10:13) |
no previous history |
do: aBlock tally = 0 ifTrue: [^ self]. 1 to: self basicSize do: [:i | (self basicAt: i) == nil ifFalse: [aBlock value: (array at: i)]] |
| DependentsArray>>size: (nk 3/11/2004 09:34 -> tp 7/6/2006 11:11) |
size ^self inject: 0 into: [ :count :dep | dep ifNotNil: [ count _ count + 1 ]] |
size ^self inject: 0 into: [ :count :dep | dep ifNil: [ count ] ifNotNil: [ count + 1 ]] |
size ^self inject: 0 into: [ :count :dep | dep ifNil: [ count ] ifNotNil: [ count + 1 ]] ^self inject: 0 into: [ :count :dep | dep ifNotNil: [ count _ count + 1 ]] |
| Integer>>bitInvert: (no stamp -> wb 4/28/1998 12:17) |
no previous history |
bitInvert "Answer an Integer whose bits are the logical negation of the receiver's bits. Numbers are interpreted as having 2's-complement representation." ^ -1 - self |
| SmallInteger>>bitShift:: (no stamp -> wb 4/28/1998 12:17) |
bitShift: arg "Primitive. Answer an Integer whose value is the receiver's value shifted left by the number of bits indicated by the argument. Negative arguments shift right. Essential. See Object documentation whatIsAPrimitive." <primitive: 17> self < 0 ifTrue: [^ -1 - (-1-self bitShift: arg)]. ^ super bitShift: arg |
bitShift: arg "Primitive. Answer an Integer whose value is the receiver's value shifted left by the number of bits indicated by the argument. Negative arguments shift right. The receiver is interpreted as having 2's-complement representation. Essential. See Object documentation whatIsAPrimitive." <primitive: 17> self >= 0 ifTrue: [^ super bitShift: arg]. ^ arg >= 0 ifTrue: [(self negated bitShift: arg) negated] ifFalse: [(self bitInvert bitShift: arg) bitInvert] |
bitShift: arg "Primitive. Answer an Integer whose value is the receiver's value shifted left by the number of bits indicated by the argument. Negative arguments shift right. The receiver is interpreted as having 2's-complement representation. shift right. Essential. See Object documentation whatIsAPrimitive." <primitive: 17> self >= 0 ifTrue: [^ super bitShift: arg]. ^ arg >= 0 ifTrue: [(self negated bitShift: arg) negated] ifFalse: [(self bitInvert bitShift: arg) bitInvert] self < 0 ifTrue: [^ -1 - (-1-self bitShift: arg)]. ^ super bitShift: arg |
| SmallInteger>>bitAnd:: (no stamp -> wb 4/28/1998 12:17) |
bitAnd: arg "Primitive. Answer an Integer whose bits are the logical AND of the receiver's bits and those of the argument, arg. Negative numbers are interpreted as a 32-bit 2's-complement. Essential. See Object documentation whatIsAPrimitive." <primitive: 14> self < 0 ifTrue: [^ 16rFFFFFFFF + (self+1) bitAnd: arg]. ^arg bitAnd: self |
bitAnd: arg "Primitive. Answer an Integer whose bits are the logical OR of the receiver's bits and those of the argument, arg. Numbers are interpreted as having 2's-complement representation. Essential. See Object documentation whatIsAPrimitive." <primitive: 14> self >= 0 ifTrue: [^ arg bitAnd: self]. ^ (self bitInvert bitOr: arg bitInvert) bitInvert |
bitAnd: arg "Primitive. Answer an Integer whose bits are the logical OR of the "Primitive. Answer an Integer whose bits are the logical AND of the receiver's bits and those of the argument, arg. Numbers are interpreted as having 2's-complement representation. Negative numbers are interpreted as a 32-bit 2's-complement. Essential. See Object documentation whatIsAPrimitive." <primitive: 14> self >= 0 ifTrue: [^ arg bitAnd: self]. ^ (self bitInvert bitOr: arg bitInvert) bitInvert self < 0 ifTrue: [^ 16rFFFFFFFF + (self+1) bitAnd: arg]. ^arg bitAnd: self |
| SmallInteger>>bitXor:: (no stamp -> wb 4/28/1998 12:17) |
bitXor: arg "Primitive. Answer an Integer whose bits are the logical XOR of the receiver's bits and those of the argument, arg. Negative numbers are interpreted as a 32-bit 2's-complement. Essential. See Object documentation whatIsAPrimitive." <primitive: 16> self < 0 ifTrue: [^ 16rFFFFFFFF + (self+1) bitXor: arg]. ^arg bitXor: self |
bitXor: arg "Primitive. Answer an Integer whose bits are the logical XOR of the receiver's bits and those of the argument, arg. Numbers are interpreted as having 2's-complement representation. Essential. See Object documentation whatIsAPrimitive." <primitive: 16> self >= 0 ifTrue: [^ arg bitXor: self]. ^ arg < 0 ifTrue: [self bitInvert bitXor: arg bitInvert] ifFalse: [(self bitInvert bitXor: arg) bitInvert] |
bitXor: arg "Primitive. Answer an Integer whose bits are the logical XOR of the receiver's bits and those of the argument, arg. Numbers are interpreted as having 2's-complement representation. Negative numbers are interpreted as a 32-bit 2's-complement. Essential. See Object documentation whatIsAPrimitive." <primitive: 16> self >= 0 ifTrue: [^ arg bitXor: self]. ^ arg < 0 ifTrue: [self bitInvert bitXor: arg bitInvert] ifFalse: [(self bitInvert bitXor: arg) bitInvert] self < 0 ifTrue: [^ 16rFFFFFFFF + (self+1) bitXor: arg]. ^arg bitXor: self |
| Metaclass>>isSelfEvaluating: (no stamp -> wbk 7/26/2007 12:41) |
no previous history |
isSelfEvaluating ^ true |
| XBMReadWriter class>>initialize: (no stamp -> wdc 2/2/1999 15:28) |
no previous history |
initialize
"XBMReadWriter initialize"
| flippedByte |
Flipbits _ (0 to: 255) collect:
[:n | "Compute the bit-reversal of the 8-bit value, n"
flippedByte _ 0.
0 to: 7 do:
[:i |
flippedByte _ flippedByte bitOr: ((n >> i bitAnd: 1) << (7-i))].
flippedByte]
|
| XBMReadWriter>>parseByteValue: (no stamp -> wdc 2/2/1999 15:20) |
no previous history |
parseByteValue "skip over separators and return next bytevalue parsed as a C language number: 0ddd is an octal digit. 0xddd is a hex digit. ddd is decimal." | source mybase | stream skipSeparators. source _ ReadWriteStream on: String new. [stream atEnd or: [ stream peek isSeparator ]] whileFalse: [source nextPut: self next asUppercase]. mybase _ 10. "Base 10 default" source reset. (source peek = $0) ifTrue: [ mybase _ 8. "Octal or Hex, say its Octal unless overridden." source next. (source peek = $X) ifTrue: [ mybase _ 16. "Ah. It's Hex." source next. ] ]. ^ Integer readFrom: source base: mybase |
| XBMReadWriter>>nextImage: (no stamp -> wdc 2/1/1999 07:15) |
no previous history |
nextImage "Read in the next xbm image from the stream." | form long incount chunks byteWidth pad fourway outcount total | stream reset. stream ascii. self readHeader. form _ ColorForm extent: width@height depth: 1. incount _ 0. outcount _1. chunks _ Array new: 4. byteWidth _ width + 7 // 8. total _ byteWidth * height. byteWidth > 4 ifTrue: [ pad _ byteWidth \\ 4] ifFalse: [ pad _ 4 - byteWidth ]. fourway _ 0. [(incount = total)] whileFalse: [ incount _ incount + 1. fourway _ fourway + 1. chunks at: fourway put: (Flipbits at: ((self parseByteValue) +1)). (pad > 0 and: [(incount \\ byteWidth) = 0]) ifTrue: [ 1 to: pad do: [:q | fourway _ fourway + 1. chunks at: fourway put: 0] ]. fourway = 4 ifTrue: [ long _ Integer byte1: (chunks at: 4) byte2: (chunks at: 3) byte3: (chunks at: 2) byte4: (chunks at: 1). (form bits) at: outcount put: long. fourway _ 0. outcount _ outcount + 1]. ]. ^ form |