Packages August 2020

packages@lists.squeakfoundation.org

1 participants
22 discussions

The Trunk: Graphics-tonyg.438.mcz
by commits＠source.squeak.org 27 Aug '20

27 Aug '20

Tony Garnock-Jones uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-tonyg.438.mcz ==================== Summary ==================== Name: Graphics-tonyg.438 Author: tonyg Time: 27 August 2020, 7:33:11.682629 pm UUID: c77170e1-f29b-44f5-bb2d-b1dc78f9e60c Ancestors: Graphics-pre.437 As the display may need a repaint after pixelsPerInch changes, call Display restore. =============== Diff against Graphics-pre.437 =============== Item was changed: ----- Method: TextStyle class>>pixelsPerInch: (in category 'utilities') ----- pixelsPerInch: aNumber "Set the nominal number of pixels per inch to aNumber." TextConstants at: #pixelsPerInch put: aNumber asFloat. + AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ]. + Display restore.! - AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ].!

1 0

The Trunk: TrueType-tonyg.54.mcz
by commits＠source.squeak.org 27 Aug '20

27 Aug '20

Tony Garnock-Jones uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-tonyg.54.mcz ==================== Summary ==================== Name: TrueType-tonyg.54 Author: tonyg Time: 27 August 2020, 7:31:31.535357 pm UUID: d4f009fe-48ef-40dc-9455-30140dfcbaf6 Ancestors: TrueType-mt.53 In order for pixelsPerInchChanged to properly rerender things, it seems the (previously-unused) functionality of flushCachedValues is required. So this change puts the functionality of flushCachedValues in flushCache, removes flushCachedValues (no callers in the trunk image), and alters pixelsPerInchChanged for TTCFont to call flushCache instead of recreateCache. =============== Diff against TrueType-mt.53 =============== Item was changed: ----- Method: TTCFont>>flushCache (in category 'initialize') ----- flushCache "Flush the cache of this font" + cache := foregroundColor := colorToCacheMap := nil. + + "Flush all values computed from ttcDescription and cached for speed" + height := ascent := descent := nil.! - cache := foregroundColor := colorToCacheMap := nil.! Item was removed: - ----- Method: TTCFont>>flushCachedValues (in category 'private') ----- - flushCachedValues - "Flush all values computed from ttcDescription and cached for speed" - "TTCFont allInstancesDo:[:font| font flushCachedValues]" - height := ascent := descent := nil.! Item was changed: ----- Method: TTCFont>>pixelsPerInchChanged (in category 'notifications') ----- pixelsPerInchChanged "The definition of TextStyle class>>pixelsPerInch has changed. Do whatever is necessary." + self flushCache! - self recreateCache!

1 0

The Trunk: Morphic-mt.1675.mcz
by commits＠source.squeak.org 26 Aug '20

26 Aug '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1675.mcz ==================== Summary ==================== Name: Morphic-mt.1675 Author: mt Time: 26 August 2020, 3:49:04.632388 pm UUID: ed707aec-b6db-fc49-9e76-56f61780e8a4 Ancestors: Morphic-mt.1674 Refactors #needsClickToFocus to #handlesKeyboardOnlyOnFocus to be useful for all kinds of morphs. For backwards compatibility, preserves the simple override "handlesKeyboard:evt \ ^true" without breaking this mechanism. So, this guard is exactly at the same place, where auto-focus is implemented: Morph >> #handleKeystroke:. Thanks to Christoph (ct)! =============== Diff against Morphic-mt.1674 =============== Item was changed: ----- Method: DialogWindow>>createMessage: (in category 'initialization') ----- createMessage: aString messageMorph := aString asText asMorph. messageMorph name: 'Message'; readOnly: true; setProperty: #indicateKeyboardFocus toValue: #never; + handlesKeyboardOnlyOnFocus: true. "If user presses enter while only hovering the text, we want to process the stroke to close the dialog." - setProperty: #needsClickToFocus toValue: true. self setMessageParameters. ^ messageMorph! Item was changed: ----- Method: Morph>>handleKeyDown: (in category 'events-processing') ----- handleKeyDown: anEvent "System level event handling." + anEvent wasHandled ifTrue: [^ self]. + (self handlesKeyboard: anEvent) ifFalse: [^ self]. + (anEvent hand keyboardFocus ~~ self + and: [self handlesKeyboardOnlyOnFocus]) + ifTrue: [^ self]. + - anEvent wasHandled ifTrue:[^self]. - (self handlesKeyboard: anEvent) ifFalse:[^self]. anEvent wasHandled: true. + ^ self keyDown: anEvent! - ^self keyDown: anEvent! Item was changed: ----- Method: Morph>>handleKeyUp: (in category 'events-processing') ----- handleKeyUp: anEvent "System level event handling." + anEvent wasHandled ifTrue: [^ self]. + (self handlesKeyboard: anEvent) ifFalse: [^ self]. + (anEvent hand keyboardFocus ~~ self + and: [self handlesKeyboardOnlyOnFocus]) + ifTrue: [^ self]. + - anEvent wasHandled ifTrue:[^self]. - (self handlesKeyboard: anEvent) ifFalse:[^self]. anEvent wasHandled: true. + ^ self keyUp: anEvent! - ^self keyUp: anEvent! Item was changed: ----- Method: Morph>>handleKeystroke: (in category 'events-processing') ----- handleKeystroke: anEvent "System level event handling. Has support for automatically grabbing the keyboard focus considering the keyboard focus delegate. See #newKeyboardFocus:" | handler | anEvent wasHandled ifTrue: [^ self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. + (anEvent hand keyboardFocus ~~ self + and: [self handlesKeyboardOnlyOnFocus]) + ifTrue: [^ self]. handler := self wantsKeyboardFocus ifFalse: [self] ifTrue: [(anEvent hand newKeyboardFocus: self) ifNil: [self]]. anEvent handler: handler. anEvent wasHandled: true. ^ handler keyStroke: anEvent! Item was added: + ----- Method: Morph>>handlesKeyboardOnlyOnFocus (in category 'event handling') ----- + handlesKeyboardOnlyOnFocus + "If set, reject every keyboard event until the receiver has received the keyboard focus in another way, i.e. a mouse click (see #mouseDown:) or programmatic focusing (see HandMorph >> #newKeyboardFocus:). This allows sending keyboard events to any owner of the receiver while the receiver is hovered by the hand. See senders. + A particular user is DialogWindow which looks for Enter and Escape presses and should not loose these events to the content morph unless it is explicitly focused. For the full discussion, see http://forum.world.st/The-Inbox-Morphic-cbc-1665-mcz-td5117905.html." + + ^ self valueOfProperty: #handlesKeyboardOnlyOnFocus ifAbsent: [false]! Item was added: + ----- Method: Morph>>handlesKeyboardOnlyOnFocus: (in category 'event handling') ----- + handlesKeyboardOnlyOnFocus: aBoolean + + ^ self setProperty: #handlesKeyboardOnlyOnFocus toValue: aBoolean! Item was changed: ----- Method: PluggableTextMorph>>mouseEnter: (in category 'event handling') ----- mouseEnter: event "Restore the selection in the text morph if there was a selection." super mouseEnter: event. selectionInterval ifNotNil: [:interval | textMorph editor selectInterval: selectionInterval; setEmphasisHere]. Preferences mouseOverForKeyboardFocus + ifTrue: [event hand newKeyboardFocus: self].! - ifTrue:[event hand newKeyboardFocus: self]! Item was changed: ----- Method: TextMorph>>handleKeystroke: (in category 'events-processing') ----- handleKeystroke: anEvent "Overwritten to support tab-among-fields preference." | pasteUp | anEvent wasHandled ifTrue:[^self]. (self handlesKeyboard: anEvent) ifFalse: [^ self]. + (anEvent hand keyboardFocus ~~ self + and: [self handlesKeyboardOnlyOnFocus]) + ifTrue: [^ self]. anEvent keyCharacter = Character tab ifTrue: [ "Allow passing through text morph inside pasteups" (self wouldAcceptKeyboardFocusUponTab and: [(pasteUp := self pasteUpMorphHandlingTabAmongFields) notNil]) ifTrue: [ anEvent wasHandled: true. ^ pasteUp tabHitWithEvent: anEvent]]. ^ super handleKeystroke: anEvent! Item was changed: ----- Method: TextMorph>>handlesKeyboard: (in category 'event handling') ----- + handlesKeyboard: evt + ^true! - handlesKeyboard: anEvent - - ^ ((self valueOfProperty: #needsClickToFocus ifAbsent: [false]) ==> [ - anEvent hand keyboardFocus = self])!

1 0

The Trunk: SUnit-pre.122.mcz
by commits＠source.squeak.org 24 Aug '20

24 Aug '20

Patrick Rein uploaded a new version of SUnit to project The Trunk: http://source.squeak.org/trunk/SUnit-pre.122.mcz ==================== Summary ==================== Name: SUnit-pre.122 Author: pre Time: 24 August 2020, 3:13:32.049786 pm UUID: 6755fd5f-c8d9-b94b-b7ce-61cb56b0de2e Ancestors: SUnit-mt.121 Recateogrizes assertions and timeout infrastructure from the "accessing" category to their own method categories. =============== Diff against SUnit-mt.121 =============== Item was changed: + ----- Method: TestCase>>assert: (in category 'asserting') ----- - ----- Method: TestCase>>assert: (in category 'accessing') ----- assert: aBooleanOrBlock aBooleanOrBlock value ifFalse: [self signalFailure: 'Assertion failed'] ! Item was changed: + ----- Method: TestCase>>assert:description: (in category 'asserting') ----- - ----- Method: TestCase>>assert:description: (in category 'accessing') ----- assert: aBooleanOrBlock description: aStringOrBlock aBooleanOrBlock value ifFalse: [ | description | description := aStringOrBlock value. self logFailure: description. TestResult failure signal: description ] ! Item was changed: + ----- Method: TestCase>>assert:description:resumable: (in category 'asserting') ----- - ----- Method: TestCase>>assert:description:resumable: (in category 'accessing') ----- assert: aBooleanOrBlock description: aString resumable: resumableBoolean | exception | aBooleanOrBlock value ifFalse: [self logFailure: aString. exception := resumableBoolean ifTrue: [TestResult resumableFailure] ifFalse: [TestResult failure]. exception signal: aString] ! Item was changed: + ----- Method: TestCase>>assert:equals: (in category 'asserting') ----- - ----- Method: TestCase>>assert:equals: (in category 'accessing') ----- assert: expected equals: actual ^self assert: expected = actual description: [ self comparingStringBetween: expected and: actual ] ! Item was changed: + ----- Method: TestCase>>assert:equals:description: (in category 'asserting') ----- - ----- Method: TestCase>>assert:equals:description: (in category 'accessing') ----- assert: expected equals: actual description: aString ^self assert: expected = actual description: [ aString , ': ', (self comparingStringBetween: expected and: actual) ]! Item was changed: + ----- Method: TestCase>>assert:identical: (in category 'asserting') ----- - ----- Method: TestCase>>assert:identical: (in category 'accessing') ----- assert: expected identical: actual ^self assert: expected == actual description: [ self comparingStringBetweenIdentical: expected and: actual ] ! Item was changed: + ----- Method: TestCase>>assert:identical:description: (in category 'asserting') ----- - ----- Method: TestCase>>assert:identical:description: (in category 'accessing') ----- assert: expected identical: actual description: aString ^self assert: expected == actual description: [ aString , ': ', (self comparingStringBetweenIdentical: expected and: actual) ]! Item was changed: + ----- Method: TestCase>>defaultTimeout (in category 'running - timeout') ----- - ----- Method: TestCase>>defaultTimeout (in category 'accessing') ----- defaultTimeout "Answer the default timeout to use for tests in this test case. The timeout is a value in seconds." ^Smalltalk isLowerPerformance ifTrue:[ 25] ifFalse: [5] "seconds"! Item was changed: + ----- Method: TestCase>>deny: (in category 'asserting') ----- - ----- Method: TestCase>>deny: (in category 'accessing') ----- deny: aBooleanOrBlock self assert: aBooleanOrBlock value not ! Item was changed: + ----- Method: TestCase>>deny:description: (in category 'asserting') ----- - ----- Method: TestCase>>deny:description: (in category 'accessing') ----- deny: aBooleanOrBlock description: aString self assert: aBooleanOrBlock value not description: aString ! Item was changed: + ----- Method: TestCase>>deny:description:resumable: (in category 'asserting') ----- - ----- Method: TestCase>>deny:description:resumable: (in category 'accessing') ----- deny: aBooleanOrBlock description: aString resumable: resumableBoolean self assert: aBooleanOrBlock value not description: aString resumable: resumableBoolean ! Item was changed: + ----- Method: TestCase>>deny:equals: (in category 'asserting') ----- - ----- Method: TestCase>>deny:equals: (in category 'accessing') ----- deny: unexpected equals: actual ^self deny: unexpected = actual description: 'Actual equals unexpected' ! Item was changed: + ----- Method: TestCase>>ensureInternetConnection (in category 'asserting - extensions') ----- - ----- Method: TestCase>>ensureInternetConnection (in category 'extensions') ----- ensureInternetConnection ^ self ensureInternetConnectionTo: 'http://www.google.com'! Item was changed: + ----- Method: TestCase>>ensureInternetConnectionTo: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>ensureInternetConnectionTo: (in category 'extensions') ----- ensureInternetConnectionTo: url "(Smalltalk classNamed: 'WebClient') httpGet: 'http://www.google.com'" ((Smalltalk classNamed: 'WebClient') httpGet: url) isSuccess ifFalse: [Error signal: 'No internet connection available, but test requires one'] ! Item was changed: + ----- Method: TestCase>>ensureSecureInternetConnection (in category 'asserting - extensions') ----- - ----- Method: TestCase>>ensureSecureInternetConnection (in category 'extensions') ----- ensureSecureInternetConnection ^ self ensureInternetConnectionTo: 'https://www.google.com'! Item was changed: + ----- Method: TestCase>>executeShould:inScopeOf:withExceptionDo: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>executeShould:inScopeOf:withExceptionDo: (in category 'extensions') ----- executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock ^[aBlock value. false] on: anException do: [:exception | anotherBlock value: exception. exception return: true]! Item was changed: + ----- Method: TestCase>>fail (in category 'asserting - extensions') ----- - ----- Method: TestCase>>fail (in category 'extensions') ----- fail ^self assert: false! Item was changed: + ----- Method: TestCase>>fail: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>fail: (in category 'extensions') ----- fail: aString ^self assert: false description: aString.! Item was changed: + ----- Method: TestCase>>should: (in category 'asserting') ----- - ----- Method: TestCase>>should: (in category 'accessing') ----- should: aBlock self assert: aBlock value ! Item was changed: + ----- Method: TestCase>>should:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:description: (in category 'accessing') ----- should: aBlock description: aString self assert: aBlock value description: aString ! Item was changed: + ----- Method: TestCase>>should:notTakeMoreThan: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>should:notTakeMoreThan: (in category 'extensions') ----- should: aBlock notTakeMoreThan: aDuration "Evaluate aBlock in a forked process and if it takes more than anInteger milliseconds to run we terminate the process and report a test failure. It'' important to use the active process for the test failure so that the failure reporting works correctly in the context of the exception handlers." | evaluated evaluationProcess result delay testProcess | evaluated := false. delay := Delay forDuration: aDuration. testProcess := Processor activeProcess. "Create a new process to evaluate aBlock" evaluationProcess := [ result := aBlock value. evaluated := true. delay unschedule. testProcess resume ] forkNamed: 'Process to evaluate should: notTakeMoreThanMilliseconds:'. "Wait the milliseconds they asked me to" delay wait. "After this point either aBlock was evaluated or not..." evaluated ifFalse: [ evaluationProcess terminate. self assert: false description: ('Block evaluation took more than the expected <1p>' expandMacrosWith: aDuration)]. ^result! Item was changed: + ----- Method: TestCase>>should:notTakeMoreThanMilliseconds: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>should:notTakeMoreThanMilliseconds: (in category 'extensions') ----- should: aBlock notTakeMoreThanMilliseconds: anInteger "For compatibility with other Smalltalks" self should: aBlock notTakeMoreThan: (Duration milliSeconds: anInteger).! Item was changed: + ----- Method: TestCase>>should:raise: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) ! Item was changed: + ----- Method: TestCase>>should:raise:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise:description: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) description: aString ! Item was changed: + ----- Method: TestCase>>should:raise:whoseDescriptionDoesNotInclude:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise:whoseDescriptionDoesNotInclude:description: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) description: aString ! Item was changed: + ----- Method: TestCase>>should:raise:whoseDescriptionIncludes:description: (in category 'asserting') ----- - ----- Method: TestCase>>should:raise:whoseDescriptionIncludes:description: (in category 'accessing') ----- should: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) description: aString ! Item was changed: + ----- Method: TestCase>>should:raise:withExceptionDo: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>should:raise:withExceptionDo: (in category 'extensions') ----- should: aBlock raise: anException withExceptionDo: anotherBlock ^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock)! Item was changed: + ----- Method: TestCase>>shouldFix: (in category 'asserting - extensions') ----- - ----- Method: TestCase>>shouldFix: (in category 'extensions') ----- shouldFix: aBlock ^self should: aBlock raise: Exception! Item was changed: + ----- Method: TestCase>>shouldnt: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt: (in category 'accessing') ----- shouldnt: aBlock self deny: aBlock value ! Item was changed: + ----- Method: TestCase>>shouldnt:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:description: (in category 'accessing') ----- shouldnt: aBlock description: aString self deny: aBlock value description: aString ! Item was changed: + ----- Method: TestCase>>shouldnt:raise: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent ^ [ aBlock value ] on: anExceptionalEvent do: [:e | self fail: 'Block raised ', e className, ': ', e messageText].! Item was changed: + ----- Method: TestCase>>shouldnt:raise:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise:description: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not description: aString ! Item was changed: + ----- Method: TestCase>>shouldnt:raise:whoseDescriptionDoesNotInclude:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise:whoseDescriptionDoesNotInclude:description: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionDoesNotInclude: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionNotContaining: subString) not description: aString ! Item was changed: + ----- Method: TestCase>>shouldnt:raise:whoseDescriptionIncludes:description: (in category 'asserting') ----- - ----- Method: TestCase>>shouldnt:raise:whoseDescriptionIncludes:description: (in category 'accessing') ----- shouldnt: aBlock raise: anExceptionalEvent whoseDescriptionIncludes: subString description: aString ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withDescriptionContaining: subString) not description: aString ! Item was changed: + ----- Method: TestCase>>signalFailure: (in category 'private') ----- - ----- Method: TestCase>>signalFailure: (in category 'accessing') ----- signalFailure: aString TestResult failure signal: aString! Item was changed: + ----- Method: TestCase>>timeout: (in category 'running - timeout') ----- - ----- Method: TestCase>>timeout: (in category 'accessing') ----- timeout: seconds "The timeout for a test should normally be set with a method annotation. However, for tests that are expected to run in images that do not support method annotations, the value may be set by setting the value from the #setUp method (i.e. prior to running the test method)." timeout := seconds! Item was changed: + ----- Method: TestCase>>timeout:after: (in category 'private') ----- - ----- Method: TestCase>>timeout:after: (in category 'running') ----- timeout: aBlock after: seconds "Evaluate the argument block. Time out if the evaluation is not complete after the given number of seconds. Handle the situation that a timeout may occur after a failure (during debug)" | theProcess delay watchdog | "the block will be executed in the current process" theProcess := Processor activeProcess. delay := Delay forSeconds: seconds. "make a watchdog process" watchdog := [ delay wait. "wait for timeout or completion" theProcess ifNotNil:[ theProcess signalException: (TestFailure new messageText: 'Test timed out') ] ] newProcess. "Watchdog needs to run at high priority to do its job (but not at timing priority)" watchdog priority: Processor timingPriority-1. "catch the timeout signal" watchdog resume. "start up the watchdog" ^[aBlock on: TestFailure, Error, Halt do:[:ex| theProcess := nil. ex pass. ]] ensure:[ "evaluate the receiver" theProcess := nil. "it has completed, so ..." delay delaySemaphore signal. "arrange for the watchdog to exit" ]! Item was changed: + ----- Method: TestCase>>timeoutForSetUp (in category 'running - timeout') ----- - ----- Method: TestCase>>timeoutForSetUp (in category 'accessing') ----- timeoutForSetUp "Answer the timeout to use for setUp" | method | method := self class lookupSelector: testSelector asSymbol. (method pragmaAt: #timeout:) ifNotNil:[:tag| ^tag arguments first]. ^self defaultTimeout! Item was changed: + ----- Method: TestCase>>timeoutForTest (in category 'running - timeout') ----- - ----- Method: TestCase>>timeoutForTest (in category 'accessing') ----- timeoutForTest "Answer the timeout to use for this test" | method | method := self class lookupSelector: testSelector asSymbol. (method pragmaAt: #timeout:) ifNotNil:[:tag| ^tag arguments first]. ^timeout ifNil: [self defaultTimeout]!

1 0

The Trunk: GraphicsTests-pre.55.mcz
by commits＠source.squeak.org 24 Aug '20

24 Aug '20

Patrick Rein uploaded a new version of GraphicsTests to project The Trunk: http://source.squeak.org/trunk/GraphicsTests-pre.55.mcz ==================== Summary ==================== Name: GraphicsTests-pre.55 Author: pre Time: 24 August 2020, 3:04:18.602786 pm UUID: 8459435a-1c95-9b46-a745-32f6d373c6a5 Ancestors: GraphicsTests-eem.54 Recategorizes methods throughout the package and improves two test cases which did only state the assertion in a comment. =============== Diff against GraphicsTests-eem.54 =============== Item was changed: + ----- Method: BMPReadWriterTest>>testBmp16Bit (in category 'tests') ----- - ----- Method: BMPReadWriterTest>>testBmp16Bit (in category 'reading') ----- testBmp16Bit | reader form | reader := BMPReadWriter new on: (ReadStream on: self bmpData16bit). form := reader nextImage. "special black here to compensate for zero-is-transparent effect" self assert: (form colorAt: 7@1) = Color red. self assert: (form colorAt: 1@7) = Color green. self assert: (form colorAt: 7@7) = Color blue. self assert: (form colorAt: 4@4) = Color white. self assert: (form pixelValueAt: 1@1) = 16r8000. ! Item was changed: + ----- Method: BMPReadWriterTest>>testBmp24Bit (in category 'tests') ----- - ----- Method: BMPReadWriterTest>>testBmp24Bit (in category 'reading') ----- testBmp24Bit | reader form | reader := BMPReadWriter new on: (ReadStream on: self bmpData24bit). form := reader nextImage. self assert: (form colorAt: 7@1) = Color red. self assert: (form colorAt: 1@7) = Color green. self assert: (form colorAt: 7@7) = Color blue. self assert: (form colorAt: 4@4) = Color white. self assert: (form pixelValueAt: 1@1) = 16rFF000001. ! Item was changed: + ----- Method: BMPReadWriterTest>>testBmp32Bit (in category 'tests') ----- - ----- Method: BMPReadWriterTest>>testBmp32Bit (in category 'reading') ----- testBmp32Bit | reader form | reader := BMPReadWriter new on: (ReadStream on: self bmpData32bit). form := reader nextImage. self assert: (form colorAt: 7@1) = Color red. self assert: (form colorAt: 1@7) = Color green. self assert: (form colorAt: 7@7) = Color blue. self assert: (form colorAt: 4@4) = Color white. self assert: (form pixelValueAt: 1@1) = 16rFF000000. ! Item was changed: + ----- Method: BMPReadWriterTest>>testBmp4Bit (in category 'tests') ----- - ----- Method: BMPReadWriterTest>>testBmp4Bit (in category 'reading') ----- testBmp4Bit | reader form | reader := BMPReadWriter new on: (ReadStream on: self bmpData4bit). form := reader nextImage. self assert: (form colorAt: 1@1) = Color black. self assert: (form colorAt: 7@1) = Color red. self assert: (form colorAt: 1@7) = Color green. self assert: (form colorAt: 7@7) = Color blue. self assert: (form colorAt: 4@4) = Color white. ! Item was changed: + ----- Method: BMPReadWriterTest>>testBmp8Bit (in category 'tests') ----- - ----- Method: BMPReadWriterTest>>testBmp8Bit (in category 'reading') ----- testBmp8Bit | reader form | reader := BMPReadWriter new on: (ReadStream on: self bmpData8bit). form := reader nextImage. self assert: (form colorAt: 1@1) = Color black. self assert: (form colorAt: 7@1) = Color red. self assert: (form colorAt: 1@7) = Color green. self assert: (form colorAt: 7@7) = Color blue. self assert: (form colorAt: 4@4) = Color white. ! Item was changed: + ----- Method: BitBltTest>>testAllAlphasRgbAdd (in category 'tests') ----- - ----- Method: BitBltTest>>testAllAlphasRgbAdd (in category 'bugs') ----- testAllAlphasRgbAdd "self run: #testAllAlphasRgbAdd" | sourceForm destForm blt correctAlphas | <timeout: 15> correctAlphas := 0. 0 to: 255 do: [:sourceAlpha | sourceForm := Form extent: 1 @ 1 depth: 32. sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. 0 to: 255 do: [:destAlpha | destForm := Form extent: 1 @ 1 depth: 32. destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. blt := BitBlt new. blt sourceForm: sourceForm. blt sourceOrigin: 0 @ 0. blt setDestForm: destForm. blt destOrigin: 0 @ 0. blt combinationRule: 20. "rgbAdd" blt copyBits. correctAlphas := correctAlphas + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha + sourceAlpha min: 255) ifTrue: [1] ifFalse: [0]) ]]. self assert: 65536 equals: correctAlphas! Item was changed: + ----- Method: BitBltTest>>testAllAlphasRgbMax (in category 'tests') ----- - ----- Method: BitBltTest>>testAllAlphasRgbMax (in category 'bugs') ----- testAllAlphasRgbMax "self run: #testAllAlphasRgbMax" | sourceForm destForm blt correctAlphas | <timeout: 10> correctAlphas := 0. 0 to: 255 do: [:sourceAlpha | sourceForm := Form extent: 1 @ 1 depth: 32. sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. 0 to: 255 do: [:destAlpha | destForm := Form extent: 1 @ 1 depth: 32. destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. blt := BitBlt new. blt sourceForm: sourceForm. blt sourceOrigin: 0 @ 0. blt setDestForm: destForm. blt destOrigin: 0 @ 0. blt combinationRule: 27. "rgbMax" blt copyBits. correctAlphas := correctAlphas + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha max: sourceAlpha) ifTrue: [1] ifFalse: [0]) ]]. self assert: 65536 equals: correctAlphas! Item was changed: + ----- Method: BitBltTest>>testAllAlphasRgbMin (in category 'tests') ----- - ----- Method: BitBltTest>>testAllAlphasRgbMin (in category 'bugs') ----- testAllAlphasRgbMin "self run: #testAllAlphasRgbMin" | sourceForm destForm blt correctAlphas | <timeout: 10> correctAlphas := 0. 0 to: 255 do: [:sourceAlpha | sourceForm := Form extent: 1 @ 1 depth: 32. sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. 0 to: 255 do: [:destAlpha | destForm := Form extent: 1 @ 1 depth: 32. destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. blt := BitBlt new. blt sourceForm: sourceForm. blt sourceOrigin: 0 @ 0. blt setDestForm: destForm. blt destOrigin: 0 @ 0. blt combinationRule: 28. "rgbMin" blt copyBits. correctAlphas := correctAlphas + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: sourceAlpha) ifTrue: [1] ifFalse: [0]) ]]. self assert: 65536 equals: correctAlphas! Item was changed: + ----- Method: BitBltTest>>testAllAlphasRgbMinInvert (in category 'tests') ----- - ----- Method: BitBltTest>>testAllAlphasRgbMinInvert (in category 'bugs') ----- testAllAlphasRgbMinInvert "self run: #testAllAlphasRgbMinInvert" | sourceForm destForm blt correctAlphas | <timeout: 10> correctAlphas := 0. 0 to: 255 do: [:sourceAlpha | sourceForm := Form extent: 1 @ 1 depth: 32. sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. 0 to: 255 do: [:destAlpha | destForm := Form extent: 1 @ 1 depth: 32. destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. blt := BitBlt new. blt sourceForm: sourceForm. blt sourceOrigin: 0 @ 0. blt setDestForm: destForm. blt destOrigin: 0 @ 0. blt combinationRule: 29. "rgbMinInvert" blt copyBits. correctAlphas := correctAlphas + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: 255-sourceAlpha) ifTrue: [1] ifFalse: [0]) ]]. self assert: 65536 equals: correctAlphas! Item was changed: + ----- Method: BitBltTest>>testAllAlphasRgbMul (in category 'tests') ----- - ----- Method: BitBltTest>>testAllAlphasRgbMul (in category 'bugs') ----- testAllAlphasRgbMul "self run: #testAllAlphasRgbMul" | sourceForm destForm blt correctAlphas | <timeout: 10> correctAlphas := 0. 0 to: 255 do: [:sourceAlpha | sourceForm := Form extent: 1 @ 1 depth: 32. sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. 0 to: 255 do: [:destAlpha | destForm := Form extent: 1 @ 1 depth: 32. destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. blt := BitBlt new. blt sourceForm: sourceForm. blt sourceOrigin: 0 @ 0. blt setDestForm: destForm. blt destOrigin: 0 @ 0. blt combinationRule: 37. "rgbMul" blt copyBits. correctAlphas := correctAlphas + (((blt destForm bits at: 1) digitAt: 4) = ((destAlpha+1) * (sourceAlpha+1)- 1 // 256) ifTrue: [1] ifFalse: [0]) ]]. self assert: 65536 equals: correctAlphas! Item was changed: + ----- Method: BitBltTest>>testAllAlphasRgbSub (in category 'tests') ----- - ----- Method: BitBltTest>>testAllAlphasRgbSub (in category 'bugs') ----- testAllAlphasRgbSub "self run: #testAllAlphasRgbSub" | sourceForm destForm blt correctAlphas | <timeout: 10> correctAlphas := 0. 0 to: 255 do: [:sourceAlpha | sourceForm := Form extent: 1 @ 1 depth: 32. sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. 0 to: 255 do: [:destAlpha | destForm := Form extent: 1 @ 1 depth: 32. destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. blt := BitBlt new. blt sourceForm: sourceForm. blt sourceOrigin: 0 @ 0. blt setDestForm: destForm. blt destOrigin: 0 @ 0. blt combinationRule: 21. "rgbSub" blt copyBits. correctAlphas := correctAlphas + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha - sourceAlpha) abs ifTrue: [1] ifFalse: [0]) ]]. self assert: 65536 equals: correctAlphas! Item was changed: + ----- Method: BitBltTest>>testAlphaCompositing (in category 'tests') ----- - ----- Method: BitBltTest>>testAlphaCompositing (in category 'bugs') ----- testAlphaCompositing "self run: #testAlphaCompositing" | bb f1 f2 mixColor result eps | f1 := Form extent: 1@1 depth: 32. f2 := Form extent: 1@1 depth: 32. eps := 0.5 / 255. 0 to: 255 do:[:i| f1 colorAt: 0@0 put: Color blue. mixColor := Color red alpha: i / 255.0. f2 colorAt: 0@0 put: mixColor. mixColor := f2 colorAt: 0@0. bb := BitBlt toForm: f1. bb sourceForm: f2. bb combinationRule: Form blend. bb copyBits. result := f1 colorAt: 0@0. self assert: (result red - mixColor alpha) abs < eps. self assert: (result blue - (1.0 - mixColor alpha)) abs < eps. self assert: result alpha = 1.0. ].! Item was changed: + ----- Method: BitBltTest>>testAlphaCompositing2 (in category 'tests') ----- - ----- Method: BitBltTest>>testAlphaCompositing2 (in category 'bugs') ----- testAlphaCompositing2 "self run: #testAlphaCompositing2" | bb f1 f2 mixColor result eps | f1 := Form extent: 1@1 depth: 32. f2 := Form extent: 1@1 depth: 32. eps := 0.5 / 255. 0 to: 255 do:[:i| f1 colorAt: 0@0 put: Color transparent. mixColor := Color red alpha: i / 255.0. f2 colorAt: 0@0 put: mixColor. mixColor := f2 colorAt: 0@0. bb := BitBlt toForm: f1. bb sourceForm: f2. bb combinationRule: Form blend. bb copyBits. result := f1 colorAt: 0@0. self assert: (result red - mixColor alpha) abs < eps. self assert: result alpha = mixColor alpha. ].! Item was changed: + ----- Method: BitBltTest>>testPeekerUnhibernateBug (in category 'tests - bugs') ----- - ----- Method: BitBltTest>>testPeekerUnhibernateBug (in category 'bugs') ----- testPeekerUnhibernateBug "self run: #testPeekerUnhibernateBug" | bitBlt | bitBlt := BitBlt bitPeekerFromForm: Display. bitBlt destForm hibernate. "This should not throw an exception." + self + shouldnt: [bitBlt pixelAt: 1@1] + raise: Error! - bitBlt pixelAt: 1@1.! Item was changed: + ----- Method: BitBltTest>>testPivelValueAt (in category 'tests') ----- - ----- Method: BitBltTest>>testPivelValueAt (in category 'bugs') ----- testPivelValueAt "tests for the pixel peeking extension to bitBlt" " self run: #testPixelValueAt" |formList pixels | "make a Form of each depth" formList := #[1 2 4 8 16 32] collect:[:d| Form extent: 17@7 depth: d] as: Array. pixels := Dictionary new. pixels at: 1 put: 1; at: 2 put: 3; at:4 put: 7; at: 8 put: 16rFF; at: 16 put: 16rFFFF ; at: 32 put: 16rFFFFFFFF. "poke pixels to topleft (to test handling 0) bottomright (to test limits) middle (just because) peek at each location (to make sure it matches expectations)" formList do:[:f| |d pixval| d := f depth. pixval := pixels at: d. f pixelValueAt: 0@0 put: pixval. f pixelValueAt: 16@6 put: pixval. f pixelValueAt: 7@3 put: pixval. self assert: (f pixelValueAt: 0@0) = pixval. self assert: (f pixelValueAt: 1@0) = 0. self assert: (f pixelValueAt: 16@6) = pixval. self assert:(f pixelValueAt: 15@6) = 0. self assert: (f pixelValueAt: 7@3) = pixval. self assert: (f pixelValueAt: 6@3) = 0. ]! Item was changed: + ----- Method: BitBltTest>>testPokerUnhibernateBug (in category 'tests - bugs') ----- - ----- Method: BitBltTest>>testPokerUnhibernateBug (in category 'bugs') ----- testPokerUnhibernateBug "self run: #testPokerUnhibernateBug" | bitBlt | bitBlt := BitBlt bitPokerToForm: Display. bitBlt sourceForm hibernate. + self + shouldnt: [bitBlt pixelAt: 1@1 put: 0] + raise: Error.! - "This should not throw an exception." - bitBlt pixelAt: 1@1 put: 0.! Item was changed: + ----- Method: CharacterScannerTest>>testBreakAnywhere (in category 'tests') ----- - ----- Method: CharacterScannerTest>>testBreakAnywhere (in category 'testing') ----- testBreakAnywhere | p text cbs indicesOfM | text := ((String new: 2 withAll: $m) , (String space) , (String new: 2 withAll: $m)) asText. p := NewParagraph new. p compose: text style: style from: 1 in: (0 @ 0 corner: mWidth+1 @ (style lineGrid * 6)). indicesOfM := (1 to: text size) select: [:i | (text at: i) = $m]. self assert: p lines size equals: indicesOfM size description: 'Each m is on a new line'. self assert: (p lines collect: #first) equals: indicesOfM description: 'Each line begins with m'. cbs := indicesOfM collect: [:i | p characterBlockForIndex: i]. self assert: (cbs collect: #left as: Set) size = 1 description: 'Selecting before each m align on same column' ! Item was changed: + ----- Method: CharacterScannerTest>>testBreakAnywhereWhenFirstCharDoesNotFit (in category 'tests') ----- - ----- Method: CharacterScannerTest>>testBreakAnywhereWhenFirstCharDoesNotFit (in category 'testing') ----- testBreakAnywhereWhenFirstCharDoesNotFit | p text cbs | text := ((String new: 2 withAll: $m) , (String space) , (String new: 2 withAll: $m)) asText. p := NewParagraph new. p compose: text style: style from: 1 in: (0 @ 0 corner: mWidth-1 @ (style lineGrid * 7)). self assert: p lines size equals: text size + 1 description: 'Each character is on a new line, past end also'. self assert: (p lines collect: #first) equals: (1 to: text size + 1) asArray description: 'Each character is on a new line'. cbs := (1 to: text size + 1) collect: [:i | p characterBlockForIndex: i]. self assert: (cbs collect: #left as: Set) size = 1 description: 'Selecting before each character align on left' ! Item was changed: + ----- Method: CharacterScannerTest>>testBreakAtLastCr (in category 'tests') ----- - ----- Method: CharacterScannerTest>>testBreakAtLastCr (in category 'testing') ----- testBreakAtLastCr | p text cbfirst cblast cbend cbend2 | text := ((String new: 4 withAll: $m) , (String new: 2 withAll: Character space) , String cr) asText. p := NewParagraph new. p compose: text style: style from: 1 in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)). self assert: p lines size = 2 description: 'An empty last line after CR must be materialized'. self assert: p lines first last = 7 description: 'The CR is included in the line preceding it'. cbfirst := p characterBlockForIndex: 1. cblast := p characterBlockForIndex: text size. self assert: cblast origin y = cbfirst origin y description: 'The CR coordinate is still on the first line'. cbend := p characterBlockForIndex: text size + 1. self assert: cbend origin y >= cblast corner y description: 'Past end is located on the next line'. cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid). self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'. self assert: cbend origin = cbend2 origin. self assert: cbend corner = cbend2 corner. ! Item was changed: + ----- Method: CharacterScannerTest>>testBreakAtLastSpace (in category 'tests') ----- - ----- Method: CharacterScannerTest>>testBreakAtLastSpace (in category 'testing') ----- testBreakAtLastSpace | p text cbfirst cblast cbend cbend2 | text := ((String new: 4 withAll: $m) , (String new: 3 withAll: Character space)) asText. p := NewParagraph new. p compose: text style: style from: 1 in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)). self assert: p lines size = 2 description: 'In leftFlush alignment, spaces at end of line overflowing the right margin should flow on next line'. self assert: p lines first last = 7 description: 'The space which is crossing the right margin is included in the first line as if it were a CR'. cbfirst := p characterBlockForIndex: 1. cblast := p characterBlockForIndex: text size. self assert: cblast origin y = cbfirst origin y description: 'The last space coordinate is still on the first line'. cbend := p characterBlockForIndex: text size + 1. self assert: cbend origin y >= cblast corner y description: 'Past end is located on the next line'. cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid). self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'. self assert: cbend origin = cbend2 origin. self assert: cbend corner = cbend2 corner. ! Item was changed: + ----- Method: CharacterScannerTest>>testBreakAtSpace (in category 'tests') ----- - ----- Method: CharacterScannerTest>>testBreakAtSpace (in category 'testing') ----- testBreakAtSpace | p text cbfirst cblast cbend cbend2 | text := ((String new: 4 withAll: $m) , (String new: 4 withAll: Character space)) asText. p := NewParagraph new. p compose: text style: style from: 1 in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)). self assert: p lines size = 2 description: 'In leftFlush alignment, spaces at end of line overflowing the right margin should flow on next line'. self assert: p lines first last = 7 description: 'The space which is crossing the right margin is included in the first line as if it were a CR'. cbfirst := p characterBlockForIndex: 1. cblast := p characterBlockForIndex: text size. self assert: cblast origin y >= cbfirst corner y description: 'The last space coordinate is under the first line'. cbend := p characterBlockForIndex: text size + 1. self assert: cbend origin x >= cblast corner x description: 'Past end is located right of last space'. cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid). self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'. self assert: cbend origin = cbend2 origin. self assert: cbend corner = cbend2 corner. ! Item was changed: + ----- Method: CharacterScannerTest>>testBreakBeforeLongWord (in category 'tests') ----- - ----- Method: CharacterScannerTest>>testBreakBeforeLongWord (in category 'testing') ----- testBreakBeforeLongWord | p text cbfirst cblast cbend cbend2 cbend1 cbspace | text := ((String with: $m) , (String with: Character space) , (String new: 4 withAll: $m)) asText. p := NewParagraph new. p compose: text style: style from: 1 in: (0 @ 0 corner: mWidth*4+(spaceWidth*2)+1 @ (style lineGrid * 4)). self assert: p lines size = 2 description: 'In leftFlush alignment, a long word overflowing the right margin should flow on next line'. self assert: p lines first last = 2 description: 'The space before the long word is on the first line'. cbfirst := p characterBlockForIndex: 1. cblast := p characterBlockForIndex: text size. self assert: cblast origin y >= cbfirst corner y description: 'The long word coordinate is under the first line'. cbend := p characterBlockForIndex: text size + 1. self assert: cbend origin x >= cblast corner x description: 'Past end is located right of long word'. cbend2 := p characterBlockAtPoint: 0 @ (cbend corner y + style lineGrid). self assert: cbend = cbend2 description: 'Clicking below the second line gives the past end location'. self assert: cbend origin = cbend2 origin. self assert: cbend corner = cbend2 corner. cbspace := p characterBlockForIndex: 2. self assert: cbspace origin y = cbfirst origin y description: 'The space is on the first line'. cbend1 := p characterBlockAtPoint: cbspace corner x + 1 @ cbspace center y. self assert: cbend1 origin x >= cbspace corner x description: 'Clicking after the space starts right after the space'. self assert: cbend1 origin y = cbspace origin y description: 'Clicking after the space starts on same line as the space'. self assert: cbend1 stringIndex = 3 description: 'Clicking after the space starts on the long word'. ! Item was changed: + ----- Method: CharacterScannerTest>>testClickLeftOfCenteredText (in category 'tests') ----- - ----- Method: CharacterScannerTest>>testClickLeftOfCenteredText (in category 'testing') ----- testClickLeftOfCenteredText | p text cbfirst cbfirst2 | style := TextStyle default. mWidth := style defaultFont widthOf: $m. spaceWidth := style defaultFont widthOf: Character space. text := (String new: 4 withAll: $m) asText. text addAttribute: TextAlignment centered from: 1 to: text size. p := NewParagraph new. p compose: text style: style from: 1 in: (2 @ 2 extent: mWidth*8 @ (style lineGrid * 2)). cbfirst := p characterBlockForIndex: 1. cbfirst2 := p characterBlockAtPoint: 1 @ cbfirst center y. self assert: cbfirst = cbfirst2. self assert: cbfirst origin = cbfirst2 origin description: 'Clicking left of the margin shall position the cursor correctly'.! Item was changed: + ----- Method: RectangleTest>>testArea (in category 'tests') ----- - ----- Method: RectangleTest>>testArea (in category 'testing') ----- testArea | r1 empty | r1 := 0@0 extent: 10@20. self assert: r1 area = (10*20). self assert: (r1 translateBy: -20@10) area = (10*20) description: 'translation preserves area'. empty := 10@20 corner: 0@0. self assert: empty area = 0 description: 'the area of an empty rectangle is null'. empty := 10@0 corner: 0@20. self assert: empty area = 0 description: 'the area of an empty rectangle is null'. empty := 0@20 corner: 10@0. self assert: empty area = 0 description: 'the area of an empty rectangle is null'.! Item was changed: + ----- Method: RectangleTest>>testAreasOutside1 (in category 'tests') ----- - ----- Method: RectangleTest>>testAreasOutside1 (in category 'testing') ----- testAreasOutside1 "RectangleTest new testAreasOutside1" | frame rects visibleArea | frame := 0@0 extent: 300@300. rects := OrderedCollection new: 80. 0 to: 3 do: [:i | 0 to: 2 do: [:j | rects add: (i@j * 20 extent: 10@10) ] ]. visibleArea := Array with: frame. rects do: [:rect | | remnants | remnants := OrderedCollection new. visibleArea do: [:a | remnants addAll: (a areasOutside: rect)]. visibleArea := remnants. ]. visibleArea := visibleArea asArray. self assert: (visibleArea allSatisfy: [:r | r area ~= 0]). 1 to: visibleArea size do: [:idx | idx + 1 to: visibleArea size do: [:idx2 | self deny: ((visibleArea at: idx) intersects: (visibleArea at: idx2)). ] ]. 1 to: rects size do: [:idx | 1 to: visibleArea size do: [:idx2 | self deny: ((rects at: idx) intersects: (visibleArea at: idx2)). ] ]. ! Item was changed: + ----- Method: RectangleTest>>testAreasOutside2 (in category 'tests') ----- - ----- Method: RectangleTest>>testAreasOutside2 (in category 'testing') ----- testAreasOutside2 "RectangleTest new testAreasOutside2" | frame rects visibleArea | frame := 0@0 extent: 300@300. rects := OrderedCollection new: 80. rects add: (50@50 corner: 200 @ 200); add: (100@100 corner: 250@250). visibleArea := Array with: frame. rects do: [:rect | | remnants | remnants := OrderedCollection new. visibleArea do: [:a | remnants addAll: (a areasOutside: rect)]. visibleArea := remnants. ]. visibleArea := visibleArea asArray. self assert: (visibleArea allSatisfy: [:r | r area ~= 0]). 1 to: visibleArea size do: [:idx | idx + 1 to: visibleArea size do: [:idx2 | self deny: ((visibleArea at: idx) intersects: (visibleArea at: idx2)). ] ]. 1 to: rects size do: [:idx | 1 to: visibleArea size do: [:idx2 | self deny: ((rects at: idx) intersects: (visibleArea at: idx2)). ] ]. ! Item was changed: + ----- Method: RectangleTest>>testBottomHalf (in category 'tests') ----- - ----- Method: RectangleTest>>testBottomHalf (in category 'testing') ----- testBottomHalf | r | r := 10@20 corner: 30@50. self assert: (10@35 corner: 30@50) equals: r bottomHalf. self assert: (10@42 corner: 30@50) equals: r bottomHalf bottomHalf! Item was changed: + ----- Method: RectangleTest>>testBottomLeftQuadrant (in category 'tests') ----- - ----- Method: RectangleTest>>testBottomLeftQuadrant (in category 'testing') ----- testBottomLeftQuadrant | r | r := 10@20 corner: 30@50. self assert: (10@35 corner: 20@50) equals: r bottomLeftQuadrant. self assert: (10@42 corner: 15@50) equals: r bottomLeftQuadrant bottomLeftQuadrant! Item was changed: + ----- Method: RectangleTest>>testBottomRightQuadrant (in category 'tests') ----- - ----- Method: RectangleTest>>testBottomRightQuadrant (in category 'testing') ----- testBottomRightQuadrant | r | r := 10@20 corner: 30@50. self assert: (20@35 corner: 30@50) equals: r bottomRightQuadrant. self assert: (25@42 corner: 30@50) equals: r bottomRightQuadrant bottomRightQuadrant! Item was changed: + ----- Method: RectangleTest>>testCenter (in category 'tests') ----- - ----- Method: RectangleTest>>testCenter (in category 'testing') ----- testCenter | r1 c | r1 := 0@0 extent: 10@20. c := r1 center. self assert: (r1 containsPoint: c) description: 'the center is inside the rectangle'. self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c). self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c). self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c). self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'.! Item was changed: + ----- Method: RectangleTest>>testCenterEmpty (in category 'tests') ----- - ----- Method: RectangleTest>>testCenterEmpty (in category 'testing') ----- testCenterEmpty | r1 c | r1 := 30@10 corner: 10@20. c := r1 center. self deny: (r1 containsPoint: c) description: 'An empty rectangle does not contain any point.'. self assert: (r1 topLeft dist: c) = (r1 bottomRight dist: c). self assert: (r1 bottomLeft dist: c) = (r1 topRight dist: c). self assert: (r1 topLeft dist: c) = (r1 bottomLeft dist: c). self assert: (r1 translateBy: -20@10) center = (c translateBy: -20@10) description: 'the center is translated with the rectangle'.! Item was changed: + ----- Method: RectangleTest>>testCorner1 (in category 'tests') ----- - ----- Method: RectangleTest>>testCorner1 (in category 'testing') ----- testCorner1 "RectangleTest new testCorner1" | rect | rect := 10@10 extent: 20@30. self deny: (rect containsPoint: rect corner).! Item was changed: + ----- Method: RectangleTest>>testDegeneratedIntersectionTest (in category 'tests') ----- - ----- Method: RectangleTest>>testDegeneratedIntersectionTest (in category 'testing') ----- testDegeneratedIntersectionTest | horizontalLine verticalLine outsideRectangle | horizontalLine := 10@10 extent: 20@0. verticalLine := 20@0 extent: 0@20. self assert: (horizontalLine intersects: verticalLine). outsideRectangle := 100@10 extent: 20@20. self deny: (horizontalLine intersects: outsideRectangle).! Item was changed: + ----- Method: RectangleTest>>testFlip (in category 'tests') ----- - ----- Method: RectangleTest>>testFlip (in category 'testing') ----- testFlip | r1 c r1Horiz r1Vert | r1 := 30@10 extent: 10@20. c := 5@5. r1Horiz := r1 flipBy: #horizontal centerAt: c. r1Vert := r1 flipBy: #vertical centerAt: c. self assert: r1 area = r1Horiz area description: 'flip preserves area'. self assert: r1 area = r1Vert area description: 'flip preserves area'. self assert: r1 extent = r1Horiz extent description: 'flip preserves extent'. self assert: r1 extent = r1Vert extent description: 'flip preserves extent'. self assert: (r1 flipBy: #horizontal centerAt: r1 center) = r1. self assert: (r1 flipBy: #vertical centerAt: r1 center) = r1! Item was changed: + ----- Method: RectangleTest>>testFlipEmpty (in category 'tests') ----- - ----- Method: RectangleTest>>testFlipEmpty (in category 'testing') ----- testFlipEmpty | r1 c r1Horiz r1Vert | r1 := 30@10 corner: 10@20. c := 5@5. r1Horiz := r1 flipBy: #horizontal centerAt: c. r1Vert := r1 flipBy: #vertical centerAt: c. self assert: r1 area = r1Horiz area description: 'flip preserves area'. self assert: r1 area = r1Vert area description: 'flip preserves area'. self assert: r1 extent = r1Horiz extent description: 'flip preserves extent'. self assert: r1 extent = r1Vert extent description: 'flip preserves extent'. self assert: (r1 flipBy: #horizontal centerAt: r1 center) = r1. self assert: (r1 flipBy: #vertical centerAt: r1 center) = r1! Item was changed: + ----- Method: RectangleTest>>testIntersection1 (in category 'tests') ----- - ----- Method: RectangleTest>>testIntersection1 (in category 'testing') ----- testIntersection1 "RectangleTest new testIntersection1" | rect1 rect2 | rect1 := 10@10 corner: 20@30. rect2 := rect1 corner extent: 20@40. self deny: (rect1 intersects: rect2).! Item was changed: + ----- Method: RectangleTest>>testIntersection2 (in category 'tests') ----- - ----- Method: RectangleTest>>testIntersection2 (in category 'testing') ----- testIntersection2 "RectangleTest new testIntersection2" | rect1 rect2 | rect1 := 0@0 corner: 40@40. rect2 := 40@40 corner: 50@50. self deny: (rect1 intersects: rect2); deny: (rect2 intersects: rect1).! Item was changed: + ----- Method: RectangleTest>>testIntersectionEmpty (in category 'tests') ----- - ----- Method: RectangleTest>>testIntersectionEmpty (in category 'testing') ----- testIntersectionEmpty | rect1 empty1 empty2 | rect1 := 10@10 corner: 40@40. empty1 := 50@50 corner: 0@0. empty2 := 30@30 corner: 20@20. self deny: (rect1 intersects: empty1); deny: (rect1 intersects: empty2); deny: (empty1 intersects: rect1); deny: (empty2 intersects: rect1); deny: (empty1 intersects: empty2); deny: (empty2 intersects: empty1).! Item was changed: + ----- Method: RectangleTest>>testLeftHalf (in category 'tests') ----- - ----- Method: RectangleTest>>testLeftHalf (in category 'testing') ----- testLeftHalf | r | r := 10@20 corner: 30@50. self assert: (10@20 corner: 20@50) equals: r leftHalf. self assert: (10@20 corner: 15@50) equals: r leftHalf leftHalf! Item was changed: + ----- Method: RectangleTest>>testRightHalf (in category 'tests') ----- - ----- Method: RectangleTest>>testRightHalf (in category 'testing') ----- testRightHalf | r | r := 10@20 corner: 30@50. self assert: (20@20 corner: 30@50) equals: r rightHalf. self assert: (25@20 corner: 30@50) equals: r rightHalf rightHalf! Item was changed: + ----- Method: RectangleTest>>testRotate (in category 'tests') ----- - ----- Method: RectangleTest>>testRotate (in category 'testing') ----- testRotate | r1 c r1Left r1Right r1Pi | r1 := 30@10 extent: 10@20. c := 5@5. r1Left := r1 rotateBy: #left centerAt: c. r1Right := r1 rotateBy: #right centerAt: c. r1Pi := r1 rotateBy: #pi centerAt: c. self assert: r1 area = r1Left area description: 'rotation preserves area'. self assert: r1 area = r1Right area description: 'rotation preserves area'. self assert: r1 area = r1Pi area description: 'rotation preserves area'. self assert: r1 extent transposed = r1Left extent. self assert: r1 extent transposed = r1Right extent. self assert: r1 extent = r1Pi extent. self assert: (r1 rotateBy: #pi centerAt: r1 center) = r1! Item was changed: + ----- Method: RectangleTest>>testRotateEmpty (in category 'tests') ----- - ----- Method: RectangleTest>>testRotateEmpty (in category 'testing') ----- testRotateEmpty | r1 c r1Left r1Right r1Pi | r1 := 30@10 corner: 10@20. c := 5@5. r1Left := r1 rotateBy: #left centerAt: c. r1Right := r1 rotateBy: #right centerAt: c. r1Pi := r1 rotateBy: #pi centerAt: c. self assert: r1 area = r1Left area description: 'rotation preserves area'. self assert: r1 area = r1Right area description: 'rotation preserves area'. self assert: r1 area = r1Pi area description: 'rotation preserves area'. self assert: r1 extent transposed = r1Left extent. self assert: r1 extent transposed = r1Right extent. self assert: r1 extent = r1Pi extent. self assert: (r1 rotateBy: #pi centerAt: r1 center) = r1! Item was changed: + ----- Method: RectangleTest>>testTopHalf (in category 'tests') ----- - ----- Method: RectangleTest>>testTopHalf (in category 'testing') ----- testTopHalf | r | r := 10@20 corner: 30@50. self assert: (10@20 corner: 30@35) equals: r topHalf. self assert: (10@20 corner: 30@27) equals: r topHalf topHalf! Item was changed: + ----- Method: RectangleTest>>testTopLeftQuadrant (in category 'tests') ----- - ----- Method: RectangleTest>>testTopLeftQuadrant (in category 'testing') ----- testTopLeftQuadrant | r | r := 10@20 corner: 30@50. self assert: (10@20 corner: 20@35) equals: r topLeftQuadrant. self assert: (10@20 corner: 15@27) equals: r topLeftQuadrant topLeftQuadrant! Item was changed: + ----- Method: RectangleTest>>testTopRightQuadrant (in category 'tests') ----- - ----- Method: RectangleTest>>testTopRightQuadrant (in category 'testing') ----- testTopRightQuadrant | r | r := 10@20 corner: 30@50. self assert: (20@20 corner: 30@35) equals: r topRightQuadrant. self assert: (25@20 corner: 30@27) equals: r topRightQuadrant topRightQuadrant!

1 0

The Trunk: Graphics-pre.437.mcz
by commits＠source.squeak.org 24 Aug '20

24 Aug '20

Patrick Rein uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-pre.437.mcz ==================== Summary ==================== Name: Graphics-pre.437 Author: pre Time: 24 August 2020, 2:59:59.323786 pm UUID: 62f7d108-a88e-1e49-b109-11a9cc14b292 Ancestors: Graphics-kfr.436 Recategorizes a number of methods throughout the package to make categories more consistent. =============== Diff against Graphics-kfr.436 =============== Item was changed: + ----- Method: AbstractFont>>isRegular (in category 'testing') ----- - ----- Method: AbstractFont>>isRegular (in category 'accessing') ----- isRegular ^false! Item was changed: + ----- Method: Color>>= (in category 'comparing') ----- - ----- Method: Color>>= (in category 'equality') ----- = aColor "Return true if the receiver equals the given color. This method handles TranslucentColors, too." aColor isColor ifFalse: [^ false]. ^ aColor privateRGB = rgb and: [aColor privateAlpha = self privateAlpha] ! Item was changed: + ----- Method: Color>>diff: (in category 'comparing') ----- - ----- Method: Color>>diff: (in category 'equality') ----- diff: theOther "Returns a number between 0.0 and 1.0" ^ ((self privateRed - theOther privateRed) abs + (self privateGreen - theOther privateGreen) abs + (self privateBlue - theOther privateBlue) abs) / 3.0 / ComponentMax! Item was changed: + ----- Method: Color>>hash (in category 'comparing') ----- - ----- Method: Color>>hash (in category 'equality') ----- hash ^ rgb! Item was changed: + ----- Method: Color>>isBitmapFill (in category 'testing') ----- - ----- Method: Color>>isBitmapFill (in category 'queries') ----- isBitmapFill ^false! Item was changed: + ----- Method: Color>>isBlack (in category 'testing') ----- - ----- Method: Color>>isBlack (in category 'queries') ----- isBlack "Return true if the receiver represents black" ^rgb = 0! Item was changed: + ----- Method: Color>>isColor (in category 'testing') ----- - ----- Method: Color>>isColor (in category 'queries') ----- isColor ^ true ! Item was changed: + ----- Method: Color>>isGradientFill (in category 'testing') ----- - ----- Method: Color>>isGradientFill (in category 'queries') ----- isGradientFill ^false! Item was changed: + ----- Method: Color>>isGray (in category 'testing') ----- - ----- Method: Color>>isGray (in category 'queries') ----- isGray "Return true if the receiver represents a shade of gray" ^(self privateRed = self privateGreen) and:[self privateRed = self privateBlue]! Item was changed: + ----- Method: Color>>isOpaque (in category 'testing') ----- - ----- Method: Color>>isOpaque (in category 'queries') ----- isOpaque ^true! Item was changed: + ----- Method: Color>>isOrientedFill (in category 'testing') ----- - ----- Method: Color>>isOrientedFill (in category 'queries') ----- isOrientedFill "Return true if the receiver keeps an orientation (e.g., origin, direction, and normal)" ^false! Item was changed: + ----- Method: Color>>isSolidFill (in category 'testing') ----- - ----- Method: Color>>isSolidFill (in category 'queries') ----- isSolidFill ^true! Item was changed: + ----- Method: Color>>isTranslucent (in category 'testing') ----- - ----- Method: Color>>isTranslucent (in category 'queries') ----- isTranslucent ^ false ! Item was changed: + ----- Method: Color>>isTranslucentColor (in category 'testing') ----- - ----- Method: Color>>isTranslucentColor (in category 'queries') ----- isTranslucentColor "This means: self isTranslucent, but isTransparent not" ^ false! Item was changed: + ----- Method: Color>>isTransparent (in category 'testing') ----- - ----- Method: Color>>isTransparent (in category 'queries') ----- isTransparent ^ false ! Item was changed: + ----- Method: DisplayObject>>isTransparent (in category 'testing') ----- - ----- Method: DisplayObject>>isTransparent (in category 'displaying-Display') ----- isTransparent ^ false! Item was changed: + ----- Method: FormSetFont>>makeTintable (in category 'tinting') ----- - ----- Method: FormSetFont>>makeTintable (in category 'as yet unclassified') ----- makeTintable "Default." self tintable: true. self combinationRule: Form over.! Item was changed: + ----- Method: FormSetFont>>preserveColors (in category 'tinting') ----- - ----- Method: FormSetFont>>preserveColors (in category 'as yet unclassified') ----- preserveColors self tintable: false. self combinationRule: Form paint.! Item was changed: + ----- Method: FormSetFont>>preserveColorsWithAlpha (in category 'tinting') ----- - ----- Method: FormSetFont>>preserveColorsWithAlpha (in category 'as yet unclassified') ----- preserveColorsWithAlpha "Useful for rendering Emojis." self tintable: false. self combinationRule: Form blend.! Item was changed: + ----- Method: InfiniteForm>>asColor (in category 'converting') ----- - ----- Method: InfiniteForm>>asColor (in category 'accessing') ----- asColor ^ patternForm dominantColor! Item was changed: + ----- Method: InfiniteForm>>asForm (in category 'converting') ----- - ----- Method: InfiniteForm>>asForm (in category 'accessing') ----- asForm ^ patternForm! Item was changed: + ----- Method: Point>>isIntegerPoint (in category 'testing') ----- - ----- Method: Point>>isIntegerPoint (in category 'truncation and round off') ----- isIntegerPoint ^ x isInteger and: [ y isInteger ] ! Item was changed: + ----- Method: Point>>isPoint (in category 'testing') ----- - ----- Method: Point>>isPoint (in category 'converting') ----- isPoint ^ true! Item was changed: + ----- Method: Rectangle>>rightHalf (in category 'transforming') ----- - ----- Method: Rectangle>>rightHalf (in category 'truncation and round off') ----- rightHalf ^self withLeft: self center x! Item was changed: + ----- Method: TextStyle>>asStringOrText (in category 'converting') ----- - ----- Method: TextStyle>>asStringOrText (in category 'accessing') ----- asStringOrText "be fancy" ^ self defaultFont familyName asText addAttribute: (TextFontReference toFont: self defaultFont); yourself! Item was changed: + ----- Method: TextStyle>>printOn: (in category 'printing') ----- - ----- Method: TextStyle>>printOn: (in category 'accessing') ----- printOn: aStream super printOn: aStream. self defaultFont printShortDescriptionOn: aStream ! Item was changed: + ----- Method: TextStyle>>storeDataOn: (in category 'object from disk') ----- - ----- Method: TextStyle>>storeDataOn: (in category 'Disk I/O') ----- storeDataOn: aDataStream "The shared arrays in tabsArray and marginTabsArray are the globals DefaultTabsArray and DefaultMarginTabsArray. DiskProxies will be substituted for these in (Array objectForDataStream:)." ^ super storeDataOn: aDataStream! Item was changed: + ----- Method: TextStyle>>veryDeepCopyWith: (in category 'copying') ----- - ----- Method: TextStyle>>veryDeepCopyWith: (in category 'Disk I/O') ----- veryDeepCopyWith: deepCopier "All inst vars are meant to be shared" self == #veryDeepCopyWith:. "to satisfy checkVariables" ^ deepCopier references at: self ifAbsentPut: [self shallowCopy]. "remember"! Item was changed: + ----- Method: TranslucentColor>>hash (in category 'comparing') ----- - ----- Method: TranslucentColor>>hash (in category 'equality') ----- hash ^ rgb bitXor: alpha !

1 0

The Trunk: SUnitGUI-ct.81.mcz
by commits＠source.squeak.org 23 Aug '20

23 Aug '20

Eliot Miranda uploaded a new version of SUnitGUI to project The Trunk: http://source.squeak.org/trunk/SUnitGUI-ct.81.mcz ==================== Summary ==================== Name: SUnitGUI-ct.81 Author: ct Time: 22 August 2020, 8:03:59.041378 pm UUID: 73e8b227-7520-354a-986c-5e8a5991afc6 Ancestors: SUnitGUI-mt.79 Fix selection updates in TestRunner by sending missing observer updates. Same reason as ToolBuilder-Morphic-ct.253. =============== Diff against SUnitGUI-mt.79 =============== Item was changed: ----- Method: TestRunner>>categoryAt:put: (in category 'accessing-categories') ----- categoryAt: anInteger put: aBoolean categoriesSelected := categoriesSelected perform: (aBoolean ifTrue: [ #copyWith: ] ifFalse: [ #copyWithout: ]) with: (categories at: anInteger ifAbsent: [ ^ self ]). + self + changed: #categoryAt:; + changed: #categorySelected; + updateClasses.! - self changed: #categorySelected; updateClasses.! Item was changed: ----- Method: TestRunner>>classAt:put: (in category 'accessing-classes') ----- classAt: anInteger put: aBoolean classesSelected := classesSelected perform: (aBoolean ifTrue: [ #copyWith: ] ifFalse: [ #copyWithout: ]) with: (classes at: anInteger ifAbsent: [ ^ self ]). + self + changed: #classAt:; + changed: #classSelected; + changed: #hasRunnable.! - self changed: #classSelected; changed: #hasRunnable.!

1 0

The Trunk: Tools-ct.985.mcz
by commits＠source.squeak.org 23 Aug '20

23 Aug '20

Eliot Miranda uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.985.mcz ==================== Summary ==================== Name: Tools-ct.985 Author: ct Time: 22 August 2020, 8:05:25.644378 pm UUID: fcb716be-e917-2646-ade9-4c4550088392 Ancestors: Tools-eem.984 Fix selection updates in ChangeList by sending missing observer updates. Same reason as ToolBuilder-Morphic-ct.253. I also re-checked all other senders of #setSelectionList: in the Trunk image and did not found any further invalidation problems. =============== Diff against Tools-eem.984 =============== Item was changed: ----- Method: ChangeList>>listSelectionAt:put: (in category 'viewing access') ----- listSelectionAt: index put: value listSelections at: index put: value. + self + changed: #listSelectionAt:; + changed: #listIndex. - self changed: #listIndex. ^ value!

1 0

The Trunk: Kernel-ct.1338.mcz
by commits＠source.squeak.org 23 Aug '20

23 Aug '20

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1338.mcz ==================== Summary ==================== Name: Kernel-ct.1338 Author: ct Time: 22 August 2020, 8:18:22.970378 pm UUID: 2ab1921f-016a-7044-9b35-75f940130863 Ancestors: Kernel-dtl.1336 Break dependents when copying a model For the full discussion, see this thread: http://forum.world.st/Bug-in-copy-td5120761.html =============== Diff against Kernel-dtl.1336 =============== Item was added: + ----- Method: Model>>postCopy (in category 'copying') ----- + postCopy + + super postCopy. + self breakDependents.!

1 0

The Trunk: KernelTests-ct.385.mcz
by commits＠source.squeak.org 23 Aug '20

23 Aug '20

Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.385.mcz ==================== Summary ==================== Name: KernelTests-ct.385 Author: ct Time: 22 August 2020, 8:20:01.189378 pm UUID: 7b38e1cc-215c-8446-999e-0b702ed39766 Ancestors: KernelTests-eem.384 Test copying of the dependents array Complements Kernel-ct.1338. For more details, see http://forum.world.st/Bug-in-copy-td5120761.html. =============== Diff against KernelTests-eem.384 =============== Item was changed: SystemOrganization addCategory: #'KernelTests-Classes'! SystemOrganization addCategory: #'KernelTests-Methods'! SystemOrganization addCategory: #'KernelTests-Numbers'! SystemOrganization addCategory: #'KernelTests-Objects'! SystemOrganization addCategory: #'KernelTests-Processes'! SystemOrganization addCategory: #'KernelTests-WriteBarrier'! + SystemOrganization addCategory: #'KernelTests-Models'! Item was added: + TestCase subclass: #ModelTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Models'! Item was added: + ----- Method: ModelTest>>testCopyDependents (in category 'tests') ----- + testCopyDependents + + | bar foo | + foo := Model new. + foo addDependent: 42. + self assert: {42} equals: foo dependents asArray. + + bar := foo copy. + self assert: bar dependents isEmpty.! Item was added: + ----- Method: ObjectTest>>testCopyDependents (in category 'tests') ----- + testCopyDependents + + | bar foo | + foo := Object new. + foo addDependent: 42. + self assert: {42} equals: foo dependents asArray. + + bar := foo copy. + self assert: bar dependents isEmpty.!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages August 2020