Packages September 2020

packages@lists.squeakfoundation.org

1 participants
56 discussions

The Trunk: CollectionsTests-eem.342.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-eem.342.mcz ==================== Summary ==================== Name: CollectionsTests-eem.342 Author: eem Time: 19 September 2020, 1:11:15.902536 pm UUID: ba823c3b-42f7-4276-8a25-8c59d26a3346 Ancestors: CollectionsTests-ul.341 Refator SHaredQueue2Test so that now we also test SharedQueue. Add a test for peek and peekLast =============== Diff against CollectionsTests-ul.341 =============== Item was added: + TestCase subclass: #AbstractSharedQueueTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Sequenceable'! Item was added: + ----- Method: AbstractSharedQueueTest class>>isAbstract (in category 'testing') ----- + isAbstract + ^self class == thisContext methodClass! Item was added: + ----- Method: AbstractSharedQueueTest>>queueClass (in category 'private') ----- + queueClass + ^self subclassResponsibility! Item was added: + ----- Method: AbstractSharedQueueTest>>testBasics (in category 'tests') ----- + testBasics + | q | + q := self queueClass new. + + self assert: nil equals: q nextOrNil. + + q nextPut: 5. + self assert: 5 equals: q nextOrNil. + self assert: nil equals: q nextOrNil! Item was added: + ----- Method: AbstractSharedQueueTest>>testContention1 (in category 'tests') ----- + testContention1 + "here is a test case that breaks the standard SharedQueue from Squeak 3.8" + + | q r1 r2 | + q := self queueClass new. + q nextPut: 5. + q nextPut: 10. + + self assert: 5 equals: q nextOrNil. + + [ r1 := q next ] fork. + [ r2 := q next ] fork. + Processor yield. "let the above two threads block" + + q nextPut: 10. + Processor yield. + + self assert: 10 equals: r1. + self assert: 10 equals: r2. + self assert: nil equals: q nextOrNil! Item was added: + ----- Method: AbstractSharedQueueTest>>testNextOrNilSuchThat (in category 'tests') ----- + testNextOrNilSuchThat + | q item | + q := self queueClass new. + q nextPut: 5. + q nextPut: 6. + + item := q nextOrNilSuchThat: [ :x | x even ]. + self assert: 6 equals: item. + + self assert: 5 equals: q nextOrNil. + self assert: nil equals: q nextOrNil! Item was added: + ----- Method: AbstractSharedQueueTest>>testPeeks (in category 'tests') ----- + testPeeks + | q | + q := self queueClass new. + + self assert: nil equals: q peek. + self assert: nil equals: q peekLast. + + q nextPut: #first; nextPut: #last. + + self assert: #first equals: q peek. + self assert: #last equals: q peekLast. + + self assert: #first equals: q next. + + self assert: #last equals: q peek. + self assert: #last equals: q peekLast! Item was changed: + AbstractSharedQueueTest subclass: #SharedQueue2Test - TestCase subclass: #SharedQueue2Test instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CollectionsTests-Sequenceable'! Item was added: + ----- Method: SharedQueue2Test>>queueClass (in category 'private') ----- + queueClass + ^SharedQueue2! Item was removed: - ----- Method: SharedQueue2Test>>testBasics (in category 'tests') ----- - testBasics - | q | - q := SharedQueue2 new. - - self should: [ q nextOrNil = nil ]. - - q nextPut: 5. - self should: [ q nextOrNil = 5 ]. - self should: [ q nextOrNil = nil ]. - - ! Item was removed: - ----- Method: SharedQueue2Test>>testContention1 (in category 'tests') ----- - testContention1 - "here is a test case that breaks the standard SharedQueue from Squeak 3.8" - - | q r1 r2 | - q := SharedQueue2 new. - q nextPut: 5. - q nextPut: 10. - - self should: [ q nextOrNil = 5 ]. - - [ r1 := q next ] fork. - [ r2 := q next ] fork. - Processor yield. "let the above two threads block" - - q nextPut: 10. - Processor yield. - - self should: [ r1 = 10 ]. - self should: [ r2 = 10 ]. - self should: [ q nextOrNil = nil ]. - ! Item was removed: - ----- Method: SharedQueue2Test>>testNextOrNilSuchThat (in category 'tests') ----- - testNextOrNilSuchThat - | q item | - q := SharedQueue2 new. - q nextPut: 5. - q nextPut: 6. - - item := q nextOrNilSuchThat: [ :x | x even ]. - self should: [ item = 6 ]. - - self should: [ q nextOrNil = 5 ]. - self should: [ q nextOrNil = nil ]. - ! Item was added: + AbstractSharedQueueTest subclass: #SharedQueueTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Sequenceable'! Item was added: + ----- Method: SharedQueueTest>>queueClass (in category 'private') ----- + queueClass + ^SharedQueue!

1 0

The Trunk: Collections-eem.912.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-eem.912.mcz ==================== Summary ==================== Name: Collections-eem.912 Author: eem Time: 19 September 2020, 1:10:19.845777 pm UUID: 04ad0d49-19ab-4e40-8570-e63c00cc49ca Ancestors: Collections-eem.911 Add peekLast to the SharedQueues to complement peek =============== Diff against Collections-eem.911 =============== Item was added: + ----- Method: SharedQueue>>peekLast (in category 'accessing') ----- + peekLast + "Answer the object that was sent through the receiver last and has not + yet been received by anyone. If no object has been sent, answer nil" + + "SharedQueue new nextPut: 1; nextPut: 2; peekLast" + + ^readSynch + critical: + [accessProtect critical: + [writePosition > 1 ifTrue: + [contentsArray at: writePosition - 1]]] + ifLocked: [nil]! Item was added: + ----- Method: SharedQueue2>>peekLast (in category 'accessing') ----- + peekLast + "Answer the object that was sent through the receiver last and has not + yet been received by anyone. If no object has been sent, answer nil" + + "SharedQueue2 new nextPut: 1; nextPut: 2; peekLast" + ^monitor critical: + [items isEmpty ifFalse: + [items last]]!

1 0

The Trunk: Sound-eem.74.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-eem.74.mcz ==================== Summary ==================== Name: Sound-eem.74 Author: eem Time: 19 September 2020, 9:11:40.666386 am UUID: 42a3c2d9-0bed-4310-bcf1-cbe0f3d0653b Ancestors: Sound-eem.73 Oops! stopPlayerProcess *must* stop the sound system when sent from startPlayerProcessBufferSize:rate:stereo:sound:. Spo refactor a bit, renaming stopPlayerProcess to stopPlayerProcess: to take a hardStop boolean. When quitting the argument is false. Add a 64-bit specific, integer-overflow agnostic version of mixSampleCount:into:startingAt:leftVol:rightVol:, for creating a simpler inline primitive in the 64-bit VM. =============== Diff against Sound-eem.73 =============== Item was changed: ----- Method: AbstractSound class>>translatedPrimitives (in category 'primitive generation') ----- translatedPrimitives ^#( (FMSound mixSampleCount:into:startingAt:leftVol:rightVol:) (PluckedSound mixSampleCount:into:startingAt:leftVol:rightVol:) (LoopedSampledSound mixSampleCount:into:startingAt:leftVol:rightVol:) (SampledSound mixSampleCount:into:startingAt:leftVol:rightVol:) + (SampledSound _64bitMixSampleCount:into:startingAt:leftVol:rightVol:) (ReverbSound applyReverbTo:startingAt:count:) ). ! Item was added: + ----- Method: SampledSound>>_64bitMixSampleCount:into:startingAt:leftVol:rightVol: (in category 'playing') ----- + _64bitMixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol + "Mix the given number of samples with the samples already in the given buffer starting at the given index. + Assume that the buffer size is at least (index + count) - 1." + + | lastIndex outIndex sampleIndex sample i s | + <inline: #always> + <var: #aSoundBuffer type: #'short int *'> + <var: #samples type: #'short int *'> + + lastIndex := (startIndex + n) - 1. + outIndex := startIndex. "index of next stereo output sample pair" + sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). + [(sampleIndex <= samplesSize) and: [outIndex <= lastIndex]] whileTrue: + [sample := ((samples at: sampleIndex) * scaledVol) // ScaleFactor. + leftVol > 0 ifTrue: + [i := (2 * outIndex) - 1. + s := (aSoundBuffer at: i) + ((sample * leftVol) // ScaleFactor). + s > 32767 ifTrue: [s := 32767]. "clipping!!" + s < -32767 ifTrue: [s := -32767]. "clipping!!" + aSoundBuffer at: i put: s]. + rightVol > 0 ifTrue: + [i := 2 * outIndex. + s := (aSoundBuffer at: i) + ((sample * rightVol) // ScaleFactor). + s > 32767 ifTrue: [s := 32767]. "clipping!!" + s < -32767 ifTrue: [s := -32767]. "clipping!!" + aSoundBuffer at: i put: s]. + + scaledVolIncr ~= 0 ifTrue: + [scaledVol := scaledVol + scaledVolIncr. + ((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or: + [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]]) + ifTrue: "reached the limit; stop incrementing" + [scaledVol := scaledVolLimit. + scaledVolIncr := 0]]. + + scaledIndex := scaledIndex + scaledIncrement. + + sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). + outIndex := outIndex + 1]. + count := count - n + ! Item was changed: ----- Method: SampledSound>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'playing') ----- mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol + "Mix the given number of samples with the samples already in the given buffer starting at the given index. + Assume that the buffer size is at least (index + count) - 1." - "Mix the given number of samples with the samples already in the given buffer starting at the given index. Assume that the buffer size is at least (index + count) - 1." | lastIndex outIndex sampleIndex sample i s overflow | + <primitive:'primitiveMixSampledSound' module: 'SoundGenerationPlugin'> + <var: #aSoundBuffer type: #'short int *'> + <var: #samples type: #'short int *'> - <primitive:'primitiveMixSampledSound' module:'SoundGenerationPlugin'> - <var: #aSoundBuffer declareC: 'short int *aSoundBuffer'> - <var: #samples declareC: 'short int *samples'> + SmallInteger maxVal > 16r3FFFFFFF ifTrue: "In 64-bits we don't have to worry about 2^15 * 2^15 overflow" + [^self _64bitMixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol]. lastIndex := (startIndex + n) - 1. outIndex := startIndex. "index of next stereo output sample pair" sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). [(sampleIndex <= samplesSize) and: [outIndex <= lastIndex]] whileTrue: [ sample := ((samples at: sampleIndex) * scaledVol) // ScaleFactor. leftVol > 0 ifTrue: [ i := (2 * outIndex) - 1. s := (aSoundBuffer at: i) + ((sample * leftVol) // ScaleFactor). s > 32767 ifTrue: [s := 32767]. "clipping!!" s < -32767 ifTrue: [s := -32767]. "clipping!!" aSoundBuffer at: i put: s]. rightVol > 0 ifTrue: [ i := 2 * outIndex. s := (aSoundBuffer at: i) + ((sample * rightVol) // ScaleFactor). s > 32767 ifTrue: [s := 32767]. "clipping!!" s < -32767 ifTrue: [s := -32767]. "clipping!!" aSoundBuffer at: i put: s]. scaledVolIncr ~= 0 ifTrue: [ scaledVol := scaledVol + scaledVolIncr. ((scaledVolIncr > 0 and: [scaledVol >= scaledVolLimit]) or: [scaledVolIncr < 0 and: [scaledVol <= scaledVolLimit]]) ifTrue: [ "reached the limit; stop incrementing" scaledVol := scaledVolLimit. scaledVolIncr := 0]]. scaledIndex := scaledIndex + scaledIncrement. scaledIndex >= ScaledIndexOverflow ifTrue: [ overflow := scaledIndex >> IncrementFractionBits. indexHighBits := indexHighBits + overflow. scaledIndex := scaledIndex - (overflow << IncrementFractionBits)]. sampleIndex := indexHighBits + (scaledIndex >> IncrementFractionBits). outIndex := outIndex + 1]. + count := count - n! - count := count - n. - ! Item was changed: ----- Method: SoundPlayer class>>shutDown: (in category 'snapshotting') ----- shutDown: quitting "Stop player process, for example before snapshotting." + quitting ifTrue: + [self stopPlayerProcess: false. + ReverbState := nil]! - quitting ifTrue: [ - self stopPlayerProcess. - ReverbState := nil].! Item was changed: ----- Method: SoundPlayer class>>startPlayerProcessBufferSize:rate:stereo:sound: (in category 'player process') ----- startPlayerProcessBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag sound: aSound "Start the sound player process. Terminate the old process, if any." "SoundPlayer startPlayerProcessBufferSize: 1000 rate: 11025 stereo: false" + self stopPlayerProcess: true. + aSound ifNotNil: "stopPlayerProcess: ensures ActiveSounds are empty..." + [ActiveSounds add: aSound]. - self stopPlayerProcess. - aSound - ifNil:[ActiveSounds := OrderedCollection new] - ifNotNil:[ActiveSounds := OrderedCollection with: aSound]. Buffer := SoundBuffer newStereoSampleCount: (bufferSize // 4) * 4. + LastBuffer ifNotNil: + [LastBuffer := SoundBuffer basicNew: Buffer basicSize]. - LastBuffer ifNotNil:[LastBuffer := SoundBuffer basicNew: Buffer basicSize]. PlayerSemaphore := Semaphore forMutualExclusion. SamplingRate := samplesPerSecond. Stereo := stereoFlag. SoundSupported := true. "Assume so" UseReadySemaphore := true. "set to false if ready semaphore not supported by VM" Smalltalk newExternalSemaphoreDo: [ :semaphore :index | ReadyForBuffer := semaphore. self primSoundStartBufferSize: Buffer stereoSampleCount rate: samplesPerSecond stereo: Stereo semaIndex: index ]. "Check if sound start prim was successful" SoundSupported ifFalse:[ Smalltalk unregisterExternalObject: ReadyForBuffer. ReadyForBuffer := nil. ^self ]. UseReadySemaphore ifTrue: [PlayerProcess := [SoundPlayer playLoop] newProcess] ifFalse: [PlayerProcess := [SoundPlayer oldStylePlayLoop] newProcess]. UseReverb ifTrue: [self startReverb]. PlayerProcess name: 'Sound Player (', ActiveSounds size asString, ')'; priority: Processor userInterruptPriority; resume! Item was removed: - ----- Method: SoundPlayer class>>stopPlayerProcess (in category 'player process') ----- - stopPlayerProcess - "Stop the sound player process." - "SoundPlayer stopPlayerProcess" - - PlayerProcess ifNotNil: - [PlayerProcess ~~ Processor activeProcess ifTrue: - [PlayerProcess terminate]. - PlayerProcess := nil]. - "Don't load the SoundPlugin if it is not in use..." - self soundPluginActive ifTrue: [self primSoundStop]. - ActiveSounds isEmpty ifFalse: - [ActiveSounds := OrderedCollection new]. - Buffer := nil. - PlayerSemaphore isEmpty ifFalse: - [PlayerSemaphore := Semaphore forMutualExclusion]. - ReadyForBuffer ifNotNil: - [Smalltalk unregisterExternalObject: ReadyForBuffer. - ReadyForBuffer := nil]! Item was added: + ----- Method: SoundPlayer class>>stopPlayerProcess: (in category 'player process') ----- + stopPlayerProcess: hardStop + "Stop the sound player process." + "SoundPlayer stopPlayerProcess" + + PlayerProcess ifNotNil: + [PlayerProcess ~~ Processor activeProcess ifTrue: + [PlayerProcess terminate]. + PlayerProcess := nil]. + (hardStop or: [self soundPluginActive]) ifTrue: [self primSoundStop]. + ActiveSounds isEmpty ifFalse: + [ActiveSounds := OrderedCollection new]. + Buffer := nil. + PlayerSemaphore isEmpty ifFalse: + [PlayerSemaphore := Semaphore forMutualExclusion]. + ReadyForBuffer ifNotNil: + [Smalltalk unregisterExternalObject: ReadyForBuffer. + ReadyForBuffer := nil]!

1 0

The Trunk: EToys-eem.401.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-eem.401.mcz ==================== Summary ==================== Name: EToys-eem.401 Author: eem Time: 19 September 2020, 7:23:47.860928 am UUID: 1288d313-8a58-4c91-bddc-ce3def738399 Ancestors: EToys-eem.400 Add error codes to relevant SoundPlugin primitives. =============== Diff against EToys-eem.400 =============== Item was changed: ----- Method: SoundRecorder>>primGetSwitch:captureFlag:channel: (in category '*Etoys-Squeakland-primitives') ----- primGetSwitch: id captureFlag: capture channel: channel + <primitive: 'primitiveSoundGetSwitch' module: 'SoundPlugin' error: ec> - <primitive: 'primitiveSoundGetSwitch' module: 'SoundPlugin'> ^ -1! Item was changed: ----- Method: SoundRecorder>>primSetDevice:name: (in category '*Etoys-Squeakland-primitives') ----- primSetDevice: anInteger name: aString + <primitive: 'primitiveSoundSetDevice' module: 'SoundPlugin' error: ec> + ^ -1! - <primitive: 'primitiveSoundSetDevice' module: 'SoundPlugin'> - ^ -1. - ! Item was changed: ----- Method: SoundRecorder>>primSetSwitch:captureFlag:parameter: (in category '*Etoys-Squeakland-primitives') ----- primSetSwitch: id captureFlag: capture parameter: parameter + <primitive: 'primitiveSoundSetSwitch' module: 'SoundPlugin' error: ec> - <primitive: 'primitiveSoundSetSwitch' module: 'SoundPlugin'> ^ -1!

1 0

The Trunk: Sound-eem.73.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-eem.73.mcz ==================== Summary ==================== Name: Sound-eem.73 Author: eem Time: 19 September 2020, 7:20:30.790279 am UUID: 4e7631d7-a5fd-4c91-8efa-c9f792aaee06 Ancestors: Sound-eem.72 Add error codes to the relevant SoundPlugin primitives. Avoid disturbing the sound system when shutting down and the sound system is inactive (requires Kernel-eem.1341!!). =============== Diff against Sound-eem.72 =============== Item was changed: ----- Method: SoundPlayer class>>primGetDefaultSoundPlayer (in category 'private') ----- primGetDefaultSoundPlayer "Answer the name of the default output device." + <primitive: 'primitiveGetDefaultSoundPlayer' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveGetDefaultSoundPlayer' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primGetDefaultSoundRecorder (in category 'private') ----- primGetDefaultSoundRecorder "Answer the name of the default input device." + <primitive: 'primitiveGetDefaultSoundRecorder' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveGetDefaultSoundRecorder' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primGetNumberOfSoundPlayerDevices (in category 'private') ----- primGetNumberOfSoundPlayerDevices "Answer the number of output devices." + <primitive: 'primitiveGetNumberOfSoundPlayerDevices' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveGetNumberOfSoundPlayerDevices' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primGetNumberOfSoundRecorderDevices (in category 'private') ----- primGetNumberOfSoundRecorderDevices "Answer the number of input devices." + <primitive: 'primitiveGetNumberOfSoundRecorderDevices' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveGetNumberOfSoundRecorderDevices' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primGetSoundPlayerDeviceName: (in category 'private') ----- primGetSoundPlayerDeviceName: n "Answer the name of the n'th output device." + <primitive: 'primitiveGetSoundPlayerDeviceName' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveGetSoundPlayerDeviceName' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primGetSoundRecorderDeviceName: (in category 'private') ----- primGetSoundRecorderDeviceName: n "Answer the name of the n'th input device." + <primitive: 'primitiveGetSoundRecorderDeviceName' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveGetSoundRecorderDeviceName' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primSetDefaultSoundPlayer: (in category 'private') ----- primSetDefaultSoundPlayer: deviceName "Set the default output device by supplying its name." + <primitive: 'primitiveSetDefaultSoundPlayer' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveSetDefaultSoundPlayer' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primSetDefaultSoundRecorder: (in category 'private') ----- primSetDefaultSoundRecorder: deviceName "Set the default input device by supplying its name." + <primitive: 'primitiveSetDefaultSoundRecorder' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveSetDefaultSoundRecorder' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primSoundAvailableBytes (in category 'private') ----- primSoundAvailableBytes + "Answer the number of bytes of available space in the sound output buffer." - "Return the number of bytes of available space in the sound output buffer." "Note: Squeak always uses buffers containing 4-bytes per sample (2 channels at 2 bytes per channel) regardless of the state of the Stereo flag." + <primitive: 'primitiveSoundAvailableSpace' module: 'SoundPlugin' error: ec> + ^ self primitiveFailed! - <primitive: 'primitiveSoundAvailableSpace' module: 'SoundPlugin'> - ^ self primitiveFailed - ! Item was changed: ----- Method: SoundPlayer class>>primSoundEnableAEC: (in category 'private') ----- primSoundEnableAEC: aBooleanInteger "Enable or disable acoustic echo-cancellation (AEC). aBooleanInteger should be 0 for false, and 1 for true." + <primitive: 'primitiveSoundEnableAEC' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveSoundEnableAEC' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primSoundGetRecordLevel (in category 'private') ----- primSoundGetRecordLevel + "Answer sound as array of doubles left then right channel, range is 0.0 to 1.0 but may be overdriven" + <primitive: 'primitiveSoundGetRecordLevel' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - "Return sound as array of doubles left then right channel, range is 0.0 to 1.0 but may be overdriven" - <primitive: 'primitiveSoundGetRecordLevel' module: 'SoundPlugin'> - self primitiveFailed! Item was changed: ----- Method: SoundPlayer class>>primSoundGetVolume (in category 'private') ----- primSoundGetVolume + "Answer sound as an array of doubles left then right channel, range is 0.0 to 1.0 but may be overdriven" + <primitive: 'primitiveSoundGetVolume' module: 'SoundPlugin' error: ec> - "Return sound as array of doubles left then right channel, range is 0.0 to 1.0 but may be overdriven" - <primitive: 'primitiveSoundGetVolume' module: 'SoundPlugin'> ^Array with: 1.0 with: 1.0! Item was changed: ----- Method: SoundPlayer class>>primSoundInsertSamples:from:samplesOfLeadTime: (in category 'private') ----- primSoundInsertSamples: count from: aSoundBuffer samplesOfLeadTime: anInteger + "Mix the given number of sample frames from the given sound buffer into the queue of samples that has already been submitted to the sound driver. This primitive is used to start a sound playing with minimum latency, even if large sound output buffers are being used to ensure smooth sound output. Answers the number of samples consumed, or zero if the primitive is not implemented or fails." - "Mix the given number of sample frames from the given sound buffer into the queue of samples that has already been submitted to the sound driver. This primitive is used to start a sound playing with minimum latency, even if large sound output buffers are being used to ensure smooth sound output. Returns the number of samples consumed, or zero if the primitive is not implemented or fails." + <primitive: 'primitiveSoundInsertSamples' module: 'SoundPlugin' error: ec> + ^ 0! - <primitive: 'primitiveSoundInsertSamples' module: 'SoundPlugin'> - ^ 0 - ! Item was changed: ----- Method: SoundPlayer class>>primSoundPlaySamples:from:startingAt: (in category 'private') ----- primSoundPlaySamples: count from: aSampleBuffer startingAt: index + "Copy count frames (pairs) of stereo sound samples into the current sound + output buffer from the given sample buffer starting at the given index." - "Copy count bytes into the current sound output buffer from the given sample buffer starting at the given index." + <primitive: 'primitiveSoundPlaySamples' module: 'SoundPlugin' error: ec> + ^self primitiveFailed - <primitive: 'primitiveSoundPlaySamples' module: 'SoundPlugin'> - ^ self primitiveFailed ! Item was changed: ----- Method: SoundPlayer class>>primSoundSetVolumeLeft:volumeRight: (in category 'private') ----- primSoundSetVolumeLeft: aLeftVolume volumeRight: aRightVolume "Set sound pass in float 0.0-1.0 for left and right channel, with possible 2.0 or higher to overdrive sound channel " + <primitive: 'primitiveSoundSetLeftVolume' module: 'SoundPlugin' error: ec> + ^self! - <primitive: 'primitiveSoundSetLeftVolume' module: 'SoundPlugin'> - ! Item was changed: ----- Method: SoundPlayer class>>primSoundStartBufferSize:rate:stereo: (in category 'private') ----- primSoundStartBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag "Start double-buffered sound output with the given buffer size and sampling rate. This version has been superceded by primitive 171 (primSoundStartBufferSize:rate:stereo:semaIndex:)." "ar 12/5/1998 Turn off the sound if not supported" + <primitive: 'primitiveSoundStart' module: 'SoundPlugin' error: ec> + SoundSupported := false! - <primitive: 'primitiveSoundStart' module: 'SoundPlugin'> - SoundSupported := false.! Item was changed: ----- Method: SoundPlayer class>>primSoundStartBufferSize:rate:stereo:semaIndex: (in category 'private') ----- primSoundStartBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag semaIndex: anInteger "Start double-buffered sound output with the given buffer size and sampling rate. If the given semaphore index is > 0, it is taken to be the index of a Semaphore in the external objects array to be signalled when the sound driver is ready to accept another buffer of samples." "Details: If this primitive fails, this method tries to use the older version instead." + <primitive: 'primitiveSoundStartWithSemaphore' module: 'SoundPlugin' error: ec> - <primitive: 'primitiveSoundStartWithSemaphore' module: 'SoundPlugin'> UseReadySemaphore := false. + self primSoundStartBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag! - self primSoundStartBufferSize: bufferSize rate: samplesPerSecond stereo: stereoFlag. - ! Item was changed: ----- Method: SoundPlayer class>>primSoundStop (in category 'private') ----- primSoundStop "Stop double-buffered sound output. Must not raise an error because it is used inside error handling and at system shutdown" + <primitive: 'primitiveSoundStop' module: 'SoundPlugin' error: ec> + ^self! - <primitive: 'primitiveSoundStop' module: 'SoundPlugin'>! Item was changed: ----- Method: SoundPlayer class>>primSoundSupportsAEC (in category 'private') ----- primSoundSupportsAEC "Answer if the plugin supports echo-cancellation on this OS/hardware." + <primitive: 'primitiveSoundSupportsAEC' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveSoundSupportsAEC' module: 'SoundPlugin'> - self primitiveFailed! Item was added: + ----- Method: SoundPlayer class>>soundPluginActive (in category 'private') ----- + soundPluginActive + "Answer quickly if the SoundPlugin is actually active." + "self soundPluginActive" + ^SoundSupported + and: [(self class compiledMethodAt: (UseReadySemaphore + ifTrue: [#primSoundStartBufferSize:rate:stereo:semaIndex:] + ifFalse: [#primSoundStartBufferSize:rate:stereo:])) isLinkedNamedPrimitive]! Item was changed: ----- Method: SoundPlayer class>>stopPlayerProcess (in category 'player process') ----- stopPlayerProcess "Stop the sound player process." "SoundPlayer stopPlayerProcess" + PlayerProcess ifNotNil: + [PlayerProcess ~~ Processor activeProcess ifTrue: + [PlayerProcess terminate]. + PlayerProcess := nil]. + "Don't load the SoundPlugin if it is not in use..." + self soundPluginActive ifTrue: [self primSoundStop]. + ActiveSounds isEmpty ifFalse: + [ActiveSounds := OrderedCollection new]. - (PlayerProcess == nil or:[PlayerProcess == Processor activeProcess]) - ifFalse:[PlayerProcess terminate]. - PlayerProcess := nil. - self primSoundStop. - ActiveSounds := OrderedCollection new. Buffer := nil. + PlayerSemaphore isEmpty ifFalse: + [PlayerSemaphore := Semaphore forMutualExclusion]. - PlayerSemaphore := Semaphore forMutualExclusion. ReadyForBuffer ifNotNil: + [Smalltalk unregisterExternalObject: ReadyForBuffer. + ReadyForBuffer := nil]! - [Smalltalk unregisterExternalObject: ReadyForBuffer]. - ReadyForBuffer := nil. - ! Item was changed: ----- Method: SoundRecorder>>primGetActualRecordingSampleRate (in category 'primitives') ----- primGetActualRecordingSampleRate + "Answer the actual sample rate being used for recording. This primitive fails unless sound recording is currently in progress." - "Return the actual sample rate being used for recording. This primitive fails unless sound recording is currently in progress." + <primitive: 'primitiveSoundGetRecordingSampleRate' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveSoundGetRecordingSampleRate' module: 'SoundPlugin'> - self primitiveFailed - ! Item was changed: ----- Method: SoundRecorder>>primRecordSamplesInto:startingAt: (in category 'primitives') ----- primRecordSamplesInto: aWordArray startingAt: index + "Record a sequence of 16-bit sound samples into the given array starting at the given sample index. Answer the number of samples recorded, which may be zero if no samples are currently available." - "Record a sequence of 16-bit sound samples into the given array starting at the given sample index. Return the number of samples recorded, which may be zero if no samples are currently available." + <primitive: 'primitiveSoundRecordSamples' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveSoundRecordSamples' module: 'SoundPlugin'> - self primitiveFailed - ! Item was changed: ----- Method: SoundRecorder>>primSetRecordLevel: (in category 'primitives') ----- primSetRecordLevel: anInteger "Set the desired recording level to the given value in the range 0-1000, where 0 is the lowest recording level and 1000 is the maximum. Do nothing if the sound input hardware does not support changing the recording level." + <primitive: 'primitiveSoundSetRecordLevel' module: 'SoundPlugin' error: ec> + ^self primitiveFailed! - <primitive: 'primitiveSoundSetRecordLevel' module: 'SoundPlugin'> - self primitiveFailed - !

1 0

The Trunk: Kernel-eem.1341.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1341.mcz ==================== Summary ==================== Name: Kernel-eem.1341 Author: eem Time: 19 September 2020, 7:16:49.354509 am UUID: facfc991-969e-4997-acb1-42478416023b Ancestors: Kernel-dtl.1340 Add two useful CompiledMethod testing methods... that sounds clumsy :-) =============== Diff against Kernel-dtl.1340 =============== Item was added: + ----- Method: CompiledMethod>>isLinkedNamedPrimitive (in category 'testing') ----- + isLinkedNamedPrimitive + "Answer if the receiver invokes a named primitive, and the method is linked to an actual primitive. + For example if the method hasn;t yet been used in the current session, it won't be linked" + ^self isNamedPrimitive and: [(self literalAt: 1) fourth ~= 0] + + "self systemNavigation browseAllSelect: [:m| m isLinkedNamedPrimitive]"! Item was added: + ----- Method: CompiledMethod>>isNamedPrimitive (in category 'testing') ----- + isNamedPrimitive + "Answer if the receiver invokes a named primitive." + ^self primitive == 117 + + "self systemNavigation browseAllSelect: [:m| m isNamedPrimitive]"!

1 0

The Trunk: Sound-eem.72.mcz
by commits＠source.squeak.org 19 Sep '20

19 Sep '20

Eliot Miranda uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-eem.72.mcz ==================== Summary ==================== Name: Sound-eem.72 Author: eem Time: 19 September 2020, 6:41:04.690078 am UUID: 993decea-486a-4d07-badb-dda290a3194e Ancestors: Sound-ct.71 Fix an annopying behaviour in MixedSound. If the same SampledSound is added more than once to a MixedSound then mix-down will produce weird results. Fix by checking for duplicates in MixedSound>>add:pan:volume: and silently taking a copy. Levente, if this is the wrong approach LMK and I can commit a version that raises an error instead. =============== Diff against Sound-ct.71 =============== Item was changed: ----- Method: MixedSound>>add:pan:volume: (in category 'composition') ----- add: aSound pan: leftRightPan volume: volume "Add the given sound with the given left-right pan, where 0.0 is full left, 1.0 is full right, and 0.5 is centered. The loudness of the sound will be scaled by volume, which ranges from 0 to 1.0." | pan vol | pan := ((leftRightPan * ScaleFactor) asInteger max: 0) min: ScaleFactor. vol := ((volume * ScaleFactor) asInteger max: 0) min: ScaleFactor. + "Sounds have state. If a sound occurs more than once in sounds then mixing can produce some very strange results" + sounds := sounds copyWith: ((sounds includes: aSound) ifTrue: [aSound copy] ifFalse: [aSound]). - sounds := sounds copyWith: aSound. leftVols := leftVols copyWith: ((ScaleFactor - pan) * vol) // ScaleFactor. + rightVols := rightVols copyWith: (pan * vol) // ScaleFactor! - rightVols := rightVols copyWith: (pan * vol) // ScaleFactor. - !

1 0

The Trunk: Monticello-eem.727.mcz
by commits＠source.squeak.org 17 Sep '20

17 Sep '20

Eliot Miranda uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-eem.727.mcz ==================== Summary ==================== Name: Monticello-eem.727 Author: eem Time: 17 September 2020, 1:33:24.024802 pm UUID: 5415d5d8-f2cd-49ac-974d-54d74f352585 Ancestors: Monticello-cmm.726 Have the snapshot browser file-out the selected method definition(s), not the installed definition(s). =============== Diff against Monticello-cmm.726 =============== Item was added: + ----- Method: MCSnapshotBrowser>>fileOutMessage (in category 'menus') ----- + fileOutMessage + "Put a description of the selected message on a file" + + | definitions wildcard | + wildcard := protocolSelection = '-- all --'. + definitions := methodSelection + ifNotNil: [{methodSelection}] + ifNil: [items select: + [:item| + item isMethodDefinition + and: [item className = classSelection + and: [wildcard or: [item protocol = protocolSelection]]]]]. + definitions isEmpty ifTrue: + [^self]. + FileStream + writeSourceCodeFrom: ((MCStWriter on: (WriteStream on: (String new: 100))) + writeDefinitions: (definitions); + stream) + baseName: (methodSelection + ifNil: [categorySelection, '-', classSelection, (wildcard ifTrue: [''] ifFalse: ['-', protocolSelection])] + ifNotNil: [methodSelection actualClass name, '-', (methodSelection selector copyReplaceAll: ':' with: '')]) + isSt: true + useHtml: false!

1 0

The Trunk: MorphicTests-ct.61.mcz
by commits＠source.squeak.org 17 Sep '20

17 Sep '20

Marcel Taeumel uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-ct.61.mcz ==================== Summary ==================== Name: MorphicTests-ct.61 Author: ct Time: 20 March 2020, 8:07:43.181237 pm UUID: e1d09ce3-9d2a-6440-ad10-b469b1163316 Ancestors: MorphicTests-mt.60 Renames misspelled test selector. =============== Diff against MorphicTests-mt.60 =============== Item was added: + ----- Method: MorphicEventTests>>test02MouseOver (in category 'tests') ----- + test02MouseOver + + | m1 m2 | + m1 := MorphForEventTests new. + m2 := MorphForEventTests new. + + m1 extent: 20@20; topLeft: 0@0. + m2 extent: 20@20; topLeft: 40@0. + + m1 openInWorld: world. + m2 openInWorld: world. + + hand handleEvent: (self redMouseDownAt: m1 center). + hand handleEvent: (self redMouseUpAt: m1 center). + hand handleEvent: (self redMouseDownAt: m2 center). + hand handleEvent: (self redMouseUpAt: m2 center). + + self + checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp mouseLeave) + forEvents: m1 eventsDuringBubble + ignoreMouseOver: true. + + self + checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp) + forEvents: m2 eventsDuringBubble + ignoreMouseOver: true. + ! Item was removed: - ----- Method: MorphicEventTests>>test02MouserOver (in category 'tests') ----- - test02MouserOver - - | m1 m2 | - m1 := MorphForEventTests new. - m2 := MorphForEventTests new. - - m1 extent: 20@20; topLeft: 0@0. - m2 extent: 20@20; topLeft: 40@0. - - m1 openInWorld: world. - m2 openInWorld: world. - - hand handleEvent: (self redMouseDownAt: m1 center). - hand handleEvent: (self redMouseUpAt: m1 center). - hand handleEvent: (self redMouseDownAt: m2 center). - hand handleEvent: (self redMouseUpAt: m2 center). - - self - checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp mouseLeave) - forEvents: m1 eventsDuringBubble - ignoreMouseOver: true. - - self - checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp) - forEvents: m2 eventsDuringBubble - ignoreMouseOver: true. - !

1 0

The Trunk: MorphicTests-mt.65.mcz
by commits＠source.squeak.org 17 Sep '20

17 Sep '20

Marcel Taeumel uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-mt.65.mcz ==================== Summary ==================== Name: MorphicTests-mt.65 Author: mt Time: 17 September 2020, 3:41:47.157573 pm UUID: 50b2cc27-06d5-5d40-936d-7b029ddc01b1 Ancestors: MorphicTests-mt.64, MorphicTests-ct.61 Updates layout tests following MorphicTests-nice.61 (inbox->treated). Complements Morphic-mt.1683. Merges MorphicTests-ct.61 (inbox->trunk). =============== Diff against MorphicTests-mt.64 =============== Item was changed: TestCase subclass: #MorphLayoutTest + instanceVariableNames: 'reset' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Layouts'! Item was removed: - ----- Method: MorphLayoutTest>>testScrollPaneBarUpdate (in category 'tests') ----- - testScrollPaneBarUpdate - - | oldPreferences | - oldPreferences := ScrollPane useRetractableScrollBars. - [| child container | - ScrollPane useRetractableScrollBars: false. - container := ScrollPane new color: Color green; extent: 300 @ 300; showVScrollBarOnlyWhenNeeded; showHScrollBarOnlyWhenNeeded. - container scroller addMorphBack: (child := Morph new color: Color red; extent: 100 @ 100). - - self ensureLayout: container. - self assert: container hScrollBar owner isNil. - self assert: container vScrollBar owner isNil. - - child extent: 400 @ 100. - self ensureLayout: container. - self assert: container hScrollBar owner notNil. - self assert: container vScrollBar owner isNil. - - child extent: 400 @ 400. - self ensureLayout: container. - self assert: container hScrollBar owner notNil. - self assert: container hScrollBar owner notNil] - ensure: [ScrollPane useRetractableScrollBars: oldPreferences]! Item was added: + ----- Method: MorphicEventTests>>test02MouseOver (in category 'tests') ----- + test02MouseOver + + | m1 m2 | + m1 := MorphForEventTests new. + m2 := MorphForEventTests new. + + m1 extent: 20@20; topLeft: 0@0. + m2 extent: 20@20; topLeft: 40@0. + + m1 openInWorld: world. + m2 openInWorld: world. + + hand handleEvent: (self redMouseDownAt: m1 center). + hand handleEvent: (self redMouseUpAt: m1 center). + hand handleEvent: (self redMouseDownAt: m2 center). + hand handleEvent: (self redMouseUpAt: m2 center). + + self + checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp mouseLeave) + forEvents: m1 eventsDuringBubble + ignoreMouseOver: true. + + self + checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp) + forEvents: m2 eventsDuringBubble + ignoreMouseOver: true. + ! Item was removed: - ----- Method: MorphicEventTests>>test02MouserOver (in category 'tests') ----- - test02MouserOver - - | m1 m2 | - m1 := MorphForEventTests new. - m2 := MorphForEventTests new. - - m1 extent: 20@20; topLeft: 0@0. - m2 extent: 20@20; topLeft: 40@0. - - m1 openInWorld: world. - m2 openInWorld: world. - - hand handleEvent: (self redMouseDownAt: m1 center). - hand handleEvent: (self redMouseUpAt: m1 center). - hand handleEvent: (self redMouseDownAt: m2 center). - hand handleEvent: (self redMouseUpAt: m2 center). - - self - checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp mouseLeave) - forEvents: m1 eventsDuringBubble - ignoreMouseOver: true. - - self - checkEventOrder: #(mouseMove mouseEnter mouseDown mouseUp) - forEvents: m2 eventsDuringBubble - ignoreMouseOver: true. - ! Item was changed: TestCase subclass: #TableLayoutTest + instanceVariableNames: 'container reset' - instanceVariableNames: 'container' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Layouts'! Item was added: + ----- Method: TableLayoutTest>>setUp (in category 'running') ----- + setUp + + super setUp. + + reset := { + ([:enable | [self useRetractableScrollBars: enable]] + value: self useRetractableScrollBars) + in: [:block | self useRetractableScrollBars: false]. + }.! Item was added: + ----- Method: TableLayoutTest>>tearDown (in category 'running') ----- + tearDown + + reset do: #value. + super tearDown.! Item was changed: ----- Method: TableLayoutTest>>testPluggableTextMorph (in category 'tests') ----- testPluggableTextMorph + | ptm | - | oldPreferences | - oldPreferences := ScrollPane useRetractableScrollBars. - [| ptm | - ScrollPane useRetractableScrollBars: false. ptm := PluggableTextMorph new extent: 100@50; setText: 'Hello World!! Hello World!! Hello World!! Hello World!!'; wrapFlag: true. + - container := self newContainer addMorphBack: ptm. self ensureLayout: container. self assert: 100@50 equals: container extent. self assert: ptm vIsScrollbarShowing. self deny: ptm hIsScrollbarShowing. "Make it a one-liner." ptm wrapFlag: false. self ensureLayout: container. self deny: ptm vIsScrollbarShowing. self assert: ptm hIsScrollbarShowing. "Make it a one-liner without the horizontal scrollbar." ptm hideScrollBarsIndefinitely. self ensureLayout: container. self deny: ptm vIsScrollbarShowing. + self deny: ptm hIsScrollbarShowing. - self deny: ptm hIsScrollbarShowing] - ensure: [ScrollPane useRetractableScrollBars: oldPreferences]. ! Item was changed: ----- Method: TableLayoutTest>>testPluggableTextMorphScrollBarNotNeeded (in category 'tests') ----- testPluggableTextMorphScrollBarNotNeeded "The entire test might fit if the scroll bar would only disappear..." + | ptm | - | oldPreferences | - oldPreferences := ScrollPane useRetractableScrollBars. - [| ptm | - ScrollPane useRetractableScrollBars: false. ptm := PluggableTextMorph new extent: 100@50; setText: 'Hello World!! Hello World!! \\\ Hello World!! Hello World!!' withCRs. container := self newContainer addMorphBack: ptm. "Make it fit exactly first." ptm hResizing: #shrinkWrap; vResizing: #shrinkWrap. self ensureLayout: container. ptm hResizing: #rigid; vResizing: #rigid. ptm wrapFlag: true. "No scrollbars required." self ensureLayout: container. self deny: ptm vIsScrollbarShowing. "It wraps immediately." ptm width: ptm width - 5. self ensureLayout: container. self assert: ptm vIsScrollbarShowing. "No scrollbars required." ptm width: ptm width + 5. self ensureLayout: container. + self deny: ptm vIsScrollbarShowing.! - self deny: ptm vIsScrollbarShowing] - ensure: [ScrollPane useRetractableScrollBars: oldPreferences]! Item was added: + ----- Method: TableLayoutTest>>testScrollPaneBarUpdate (in category 'tests - scroll panes') ----- + testScrollPaneBarUpdate + + | child container | + container := ScrollPane new color: Color green; extent: 300 @ 300; showVScrollBarOnlyWhenNeeded; showHScrollBarOnlyWhenNeeded. + container scroller addMorphBack: (child := Morph new color: Color red; extent: 100 @ 100). + + self ensureLayout: container. + self assert: container hScrollBar owner isNil. + self assert: container vScrollBar owner isNil. + + child extent: 400 @ 100. + self ensureLayout: container. + self assert: container hScrollBar owner notNil. + self assert: container vScrollBar owner isNil. + + child extent: 400 @ 400. + self ensureLayout: container. + self assert: container hScrollBar owner notNil. + self assert: container hScrollBar owner notNil! Item was changed: ----- Method: TableLayoutTest>>testScrollPaneShrinkWrap (in category 'tests') ----- testScrollPaneShrinkWrap + | scroll scrollContent | - | oldPreferences | - oldPreferences := ScrollPane useRetractableScrollBars. - [| scroll scrollContent | - ScrollPane useRetractableScrollBars: false. container := self newContainer vResizing: #rigid; addMorphBack: (self newMorph extent: 50 @ 50); addMorphBack: (scroll := ScrollPane new hResizing: #shrinkWrap; vResizing: #spaceFill; showVScrollBarOnlyWhenNeeded; hideHScrollBarIndefinitely). " shrinkWrap the horizontal axis but scroll vertically " scroll scroller layoutPolicy: TableLayout new; addMorphBack: (scrollContent := self newMorph extent: 200 @ 500). container extent: 1 @ 300. self ensureLayout: container. self assert: container left = (container layoutChanged; fullBounds; left). "Do not be jumpy." self assert: (200 + scroll scrollBarThickness + scroll borderWidth) @ 300 equals: scroll extent. scrollContent extent: 300 @ 500. self ensureLayout: container. + self assert: (300 + scroll scrollBarThickness + scroll borderWidth) @ 300 equals: scroll extent! - self assert: (300 + scroll scrollBarThickness + scroll borderWidth) @ 300 equals: scroll extent] - ensure: [ScrollPane useRetractableScrollBars: oldPreferences]. - ! Item was added: + ----- Method: TableLayoutTest>>testScrollerFill (in category 'tests - scroll panes') ----- + testScrollerFill + "A scroll pane's scroller (i.e., the transform morph) has always #spaceFill behavior within the scroll pane's layout. Thus, submorphs (here: title and content) can themselves be #spaceFill. Embed a text morph to check height-for-width compatibility." + + | content title | + container := ScrollPane new. + + container scroller + layoutPolicy: TableLayout new; + color: Color random; + addMorphBack: (title := TextMorph new hResizing: #spaceFill; contents: 'Here comes an interesting title'); + addMorphBack: (content := self newMorph extent: 400 @ 400; hResizing: #spaceFill). + container extent: 50 @ 50. "Pick an extent so that the title must wrap!!" + self ensureLayout: container. + + "container openInHand." + + container extent: 500 @ 500. + self ensureLayout: container. + self assert: 500 @ 500 equals: container extent. + self assert: 500 - (container borderWidth * 2) @ 400 equals: content extent. + + container extent: 300 @ 300. + self ensureLayout: container. + self assert: 300 @ 300 equals: container extent. + self assert: 300 - container borderWidth - container scrollBarThickness @ 400 equals: content extent! Item was added: + ----- Method: TableLayoutTest>>testScrollerFillWithContainer (in category 'tests - scroll panes') ----- + testScrollerFillWithContainer + "A scroll pane's scroller (i.e., the transform morph) has always #spaceFill behavior within the scroll pane's layout. Thus, submorphs (here: title and content) can themselves be #spaceFill. Embed a text morph to check height-for-width compatibility. Add an extra container between scroller and title/content." + + | content title | + container := ScrollPane new. + + container scroller + layoutPolicy: TableLayout new; + addMorphBack: (self newContainer + hResizing: #spaceFill; + vResizing: #spaceFill; + listDirection: #topToBottom; + addMorphBack: (title := TextMorph new hResizing: #spaceFill; contents: 'Here comes an interesting title'); + addMorphBack: (content := self newMorph extent: 400 @ 400; hResizing: #spaceFill)). + container extent: 50 @ 50. "Pick an extent so that the title must wrap!!" + self ensureLayout: container. + + "container openInHand." + + container extent: 500 @ 500. + self ensureLayout: container. + self assert: 500 @ 500 equals: container extent. + self assert: 500 - (container borderWidth * 2) @ 400 equals: content extent. + + container extent: 300 @ 300. + self ensureLayout: container. + self assert: 300 @ 300 equals: container extent. + self assert: 300 - container borderWidth - container scrollBarThickness @ 400 equals: content extent! Item was changed: ----- Method: TableLayoutTest>>testShrinkWrapScrollPaneAlwaysShowBars (in category 'tests') ----- testShrinkWrapScrollPaneAlwaysShowBars + | scroll scrollContent | - | oldPreferences | - oldPreferences := ScrollPane useRetractableScrollBars. - [| scroll scrollContent | - ScrollPane useRetractableScrollBars: false. container := self newContainer vResizing: #shrinkWrap; hResizing: #shrinkWrap; addMorphBack: (scroll := ScrollPane new hResizing: #shrinkWrap; vResizing: #shrinkWrap; alwaysShowHScrollBar; alwaysShowVScrollBar). scroll scroller layoutPolicy: TableLayout new; addMorphBack: (scrollContent := self newMorph extent: 300 @ 300). self ensureLayout: container. + self assert: (300 @ 300) + scroll scrollBarThickness + scroll borderWidth equals: container extent! - self assert: (300 @ 300) + scroll scrollBarThickness + scroll borderWidth equals: container extent] - ensure: [ScrollPane useRetractableScrollBars: oldPreferences]. - ! Item was changed: ----- Method: TableLayoutTest>>testSidebarAndScrollingView (in category 'tests - example layouts') ----- testSidebarAndScrollingView " construct a container that has a fixed size sidebar on the left and a scrolling window that adapts flexibly to the container's size " + | scrolling sidebar content title | - | oldPreferences | - oldPreferences := ScrollPane useRetractableScrollBars. - [| scrolling sidebar content title | - ScrollPane useRetractableScrollBars: false. container := self newContainer addMorphBack: (sidebar := self newMorph width: 200; hResizing: #rigid; vResizing: #spaceFill); addMorphBack: (scrolling := ScrollPane new hResizing: #spaceFill; vResizing: #spaceFill). scrolling scroller layoutPolicy: TableLayout new; addMorphBack: (self newContainer hResizing: #spaceFill; vResizing: #spaceFill; listDirection: #topToBottom; addMorphBack: (title := TextMorph new hResizing: #spaceFill; contents: 'Here comes a title'); addMorphBack: (content := self newMorph extent: 400 @ 400; hResizing: #spaceFill)). + self ensureLayout: container. + "container openInHand." container extent: 500 @ 500. self ensureLayout: container. self assert: 200 @ 500 equals: sidebar extent. self assert: 300 @ 500 equals: scrolling extent. self assert: 300 - (scrolling borderWidth * 2) @ 400 equals: content extent. container extent: 300 @ 300. self ensureLayout: container. self assert: 200 @ 300 equals: sidebar extent. self assert: 100 @ 300 equals: scrolling extent. + self assert: 100 - scrolling borderWidth - scrolling scrollBarThickness @ 400 equals: content extent! - self assert: 100 - scrolling borderWidth - scrolling scrollBarThickness @ 400 equals: content extent] - ensure: [ScrollPane useRetractableScrollBars: oldPreferences]! Item was added: + ----- Method: TableLayoutTest>>useRetractableScrollBars (in category 'running') ----- + useRetractableScrollBars + + ^ ScrollPane classPool at: #UseRetractableScrollBars! Item was added: + ----- Method: TableLayoutTest>>useRetractableScrollBars: (in category 'running') ----- + useRetractableScrollBars: aBoolean + "Re-implemented to avoid triggering #allSubInstancesDo:." + + ScrollPane classPool at: #UseRetractableScrollBars put: aBoolean.!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages September 2020