Squeak-dev September 2009

squeak-dev@lists.squeakfoundation.org

119 participants
370 discussions

The Trunk: MorphicTests-rkrk.11.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

Andreas Raab uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-rkrk.11.mcz ==================== Summary ==================== Name: MorphicTests-rkrk.11 Author: rkrk Time: 24 September 2009, 3:39:36 am UUID: 7168c8d1-f45b-4968-bbd1-677b6783b81b Ancestors: MorphicTests-ar.10 Tests for FormCanvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor:. It raises errors in degenerate cases when fillStyle is more than a Color (e.g. a GradientFillStyle). =============== Diff against MorphicTests-ar.10 =============== Item was added: + ----- Method: FormCanvasTest>>testFrameAndFillDegenerateRoundRect02 (in category 'tests') ----- + testFrameAndFillDegenerateRoundRect02 + + | fill canvas smallRect | + fill := GradientFillStyle sample. + canvas := FormCanvas extent: 100@100. + canvas fillColor: Color black. + smallRect := 0@0 corner: 20@20. + self shouldnt: [ + canvas + frameAndFillRoundRect: smallRect + radius: 0 + fillStyle: fill + borderWidth: 0 + borderColor: Color lightGray] + raise: Error.! Item was changed: SystemOrganization addCategory: #'MorphicTests-Basic'! SystemOrganization addCategory: #'MorphicTests-Kernel'! SystemOrganization addCategory: #'MorphicTests-Text Support'! SystemOrganization addCategory: #'MorphicTests-Widgets'! + SystemOrganization addCategory: #'MorphicTests-Support'! SystemOrganization addCategory: #'MorphicTests-Worlds'! Item was added: + TestCase subclass: #FormCanvasTest + instanceVariableNames: 'morph' + classVariableNames: '' + poolDictionaries: '' + category: 'MorphicTests-Support'! Item was added: + ----- Method: FormCanvasTest>>testFrameAndFillDegenerateRoundRect01 (in category 'tests') ----- + testFrameAndFillDegenerateRoundRect01 + + | fill canvas smallRect | + fill := GradientFillStyle sample. + canvas := FormCanvas extent: 100@100. + canvas fillColor: Color black. + smallRect := 0@0 corner: 20@20. + self shouldnt: [ + canvas + frameAndFillRoundRect: smallRect + radius: smallRect width / 2 + 1 + fillStyle: fill + borderWidth: 0 + borderColor: Color lightGray] + raise: Error.!

1 0

The Trunk: Morphic-ar.190.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

Andreas Raab uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ar.190.mcz ==================== Summary ==================== Name: Morphic-ar.190 Author: ar Time: 23 September 2009, 7:49:23 am UUID: 18965e3f-8d35-ac45-b94a-eefa107dba28 Ancestors: Morphic-dtl.189, Morphic-rkrk.189 Merging Morphic-rkrk.189: Fix for FormCanvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor:. when rect or radius is degenerated. This bug appeared e..g when resizing the switch button pane in the Browser to a very small width. =============== Diff against Morphic-dtl.189 =============== Item was changed: ----- Method: FormCanvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor: (in category 'drawing-rectangles') ----- frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderWidth: bw borderColor: bc "Draw a rounded rectangle" self shadowColor ifNotNil:[ ^self fillRoundRect: aRectangle radius: cornerRadius fillStyle: shadowColor. ]. "see if the round rect is degenerate" cornerRadius asPoint <= (0@0) + ifTrue:[^self frameAndFillRectangle: aRectangle fillColor: fillStyle asColor borderWidth: bw borderColor: bc]. - ifTrue:[^self frameAndFillRectangle: aRectangle fillColor: fillStyle borderWidth: bw borderColor: bc]. cornerRadius * 2 >= aRectangle width + ifTrue:[^self fillOval: aRectangle color: fillStyle asColor borderWidth: bw borderColor: bc]. - ifTrue:[^self fillOval: aRectangle color: fillStyle borderWidth: bw borderColor: bc]. "Okay it's a rounded rectangle" fillStyle isTransparent ifFalse:["fill interior" | innerRect radius | innerRect := aRectangle. radius := cornerRadius. bw isZero ifFalse:[ innerRect := innerRect insetBy: bw. radius := radius - bw. ]. self fillRoundRect: innerRect radius: radius fillStyle: fillStyle. ]. self frameRoundRect: aRectangle radius: cornerRadius width: bw color: bc !

1 0

The Inbox: MorphicTests-rkrk.11.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

Robert Krahn uploaded a new version of MorphicTests to project The Inbox: http://source.squeak.org/inbox/MorphicTests-rkrk.11.mcz ==================== Summary ==================== Name: MorphicTests-rkrk.11 Author: rkrk Time: 24 September 2009, 3:39:36 am UUID: 7168c8d1-f45b-4968-bbd1-677b6783b81b Ancestors: MorphicTests-ar.10 Tests for FormCanvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor:. It raises errors in degenerate cases when fillStyle is more than a Color (e.g. a GradientFillStyle). ==================== Snapshot ==================== SystemOrganization addCategory: #'MorphicTests-Basic'! SystemOrganization addCategory: #'MorphicTests-Kernel'! SystemOrganization addCategory: #'MorphicTests-Text Support'! SystemOrganization addCategory: #'MorphicTests-Widgets'! SystemOrganization addCategory: #'MorphicTests-Support'! SystemOrganization addCategory: #'MorphicTests-Worlds'! HashAndEqualsTestCase subclass: #TextAnchorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Text Support'! ----- Method: TextAnchorTest>>setUp (in category 'initialize-release') ----- setUp super setUp. prototypes add: (TextAnchor new anchoredMorph: RectangleMorph new initialize); add: (TextAnchor new anchoredMorph: EllipseMorph new initialize) ! HashAndEqualsTestCase subclass: #TextLineTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Text Support'! ----- Method: TextLineTest>>setUp (in category 'initialize-release') ----- setUp super setUp. prototypes add: (TextLine start: 1 stop: 50 internalSpaces: 2 paddingWidth: 1) ! Morph subclass: #TestInWorldMorph instanceVariableNames: 'intoWorldCount outOfWorldCount' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Kernel'! !TestInWorldMorph commentStamp: 'sd 6/5/2005 10:25' prior: 0! Helper class for MorphTest! ----- Method: TestInWorldMorph>>initialize (in category 'as yet unclassified') ----- initialize super initialize. outOfWorldCount := intoWorldCount := 0.! ----- Method: TestInWorldMorph>>intoWorld: (in category 'as yet unclassified') ----- intoWorld: aWorld aWorld ifNil:[^self]. super intoWorld: aWorld. intoWorldCount := intoWorldCount + 1. ! ----- Method: TestInWorldMorph>>intoWorldCount (in category 'as yet unclassified') ----- intoWorldCount ^intoWorldCount! ----- Method: TestInWorldMorph>>outOfWorld: (in category 'as yet unclassified') ----- outOfWorld: aWorld aWorld ifNil:[^self]. super outOfWorld: aWorld. outOfWorldCount := outOfWorldCount + 1. ! ----- Method: TestInWorldMorph>>outOfWorldCount (in category 'as yet unclassified') ----- outOfWorldCount ^outOfWorldCount! TestCase subclass: #BalloonFontTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Widgets'! ----- Method: BalloonFontTest>>testDefaultFont (in category 'tests') ----- testDefaultFont "(self selector: #testDefaultFont) debug" self assert: RectangleMorph new balloonFont = BalloonMorph balloonFont. self assert: RectangleMorph new defaultBalloonFont = BalloonMorph balloonFont.! ----- Method: BalloonFontTest>>testSpecificFont (in category 'tests') ----- testSpecificFont "(self selector: #testSpecificFont) debug" | aMorph | aMorph := RectangleMorph new. self assert: RectangleMorph new balloonFont = BalloonMorph balloonFont. self assert: RectangleMorph new defaultBalloonFont = BalloonMorph balloonFont. aMorph balloonFont: (StrikeFont familyName: #ComicPlain size: 19). self assert: aMorph balloonFont = (StrikeFont familyName: #ComicPlain size: 19). "The next test is horrible because I do no know how to access the font with the appropiate interface" self assert: (((BalloonMorph getTextMorph: 'lulu' for: aMorph) text runs at: 1) at: 1) font = (StrikeFont familyName: #ComicPlain size: 19)! TestCase subclass: #FormCanvasTest instanceVariableNames: 'morph' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Support'! ----- Method: FormCanvasTest>>testFrameAndFillDegenerateRoundRect01 (in category 'tests') ----- testFrameAndFillDegenerateRoundRect01 | fill canvas smallRect | fill := GradientFillStyle sample. canvas := FormCanvas extent: 100@100. canvas fillColor: Color black. smallRect := 0@0 corner: 20@20. self shouldnt: [ canvas frameAndFillRoundRect: smallRect radius: smallRect width / 2 + 1 fillStyle: fill borderWidth: 0 borderColor: Color lightGray] raise: Error.! ----- Method: FormCanvasTest>>testFrameAndFillDegenerateRoundRect02 (in category 'tests') ----- testFrameAndFillDegenerateRoundRect02 | fill canvas smallRect | fill := GradientFillStyle sample. canvas := FormCanvas extent: 100@100. canvas fillColor: Color black. smallRect := 0@0 corner: 20@20. self shouldnt: [ canvas frameAndFillRoundRect: smallRect radius: 0 fillStyle: fill borderWidth: 0 borderColor: Color lightGray] raise: Error.! TestCase subclass: #MCPTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Kernel'! ----- Method: MCPTest>>defaultBounds (in category 'constants') ----- defaultBounds "the default bounds for morphs" ^ 0 @ 0 corner: 50 @ 40 ! ----- Method: MCPTest>>defaultTop (in category 'constants') ----- defaultTop "the default top for morphs" ^ self defaultBounds top ! ----- Method: MCPTest>>testIsMorphicModel (in category 'tests') ----- testIsMorphicModel "test isMorphicModel" self deny: Object new isMorphicModel. self deny: Morph new isMorphicModel. self assert: MorphicModel new isMorphicModel. ! ----- Method: MCPTest>>testIsSystemWindow (in category 'tests') ----- testIsSystemWindow "test isSystemWindow" self deny: Object new isSystemWindow. self assert: SystemWindow new isSystemWindow.! ----- Method: MCPTest>>testTop (in category 'tests') ----- testTop "test the #top: messages and its consequences" | morph factor newTop newBounds | morph := Morph new. "" factor := 10. newTop := self defaultTop + factor. newBounds := self defaultBounds translateBy: 0 @ factor. "" morph top: newTop. "" self assert: morph top = newTop; assert: morph bounds = newBounds! TestCase subclass: #MorphTest instanceVariableNames: 'morph world' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Kernel'! !MorphTest commentStamp: '<historical>' prior: 0! This is the unit test for the class Morph. Unit tests are a good way to exercise the functionality of your system in a repeatable and automatic manner. They are therefore recommended if you plan to release anything. For more information, see: - http://www.c2.com/cgi/wiki?UnitTest - http://minnow.cc.gatech.edu/squeak/1547 - the sunit class category! MorphTest subclass: #CircleMorphTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Basic'! !CircleMorphTest commentStamp: 'tlk 5/21/2006 14:16' prior: 0! A CircleMorphTest is a subclass of MorphTest. It was first implemented when removing some unused and broken functionality. My fixtures are morph, a CircleMorph and world. ! ----- Method: CircleMorphTest>>setUp (in category 'initialize-release') ----- setUp morph := CircleMorph new! ----- Method: MorphTest>>getWorld (in category 'initialize-release') ----- getWorld ^ world ifNil: [world := MorphicProject new world]! ----- Method: MorphTest>>setUp (in category 'initialize-release') ----- setUp morph := Morph new! ----- Method: MorphTest>>tearDown (in category 'initialize-release') ----- tearDown morph delete. world ifNotNil: [Project deletingProject: world project]! ----- Method: MorphTest>>testIntoWorldCollapseOutOfWorld (in category 'testing - into/outOf World') ----- testIntoWorldCollapseOutOfWorld | m1 m2 collapsed | "Create the guys" m1 := TestInWorldMorph new. m2 := TestInWorldMorph new. self assert: (m1 intoWorldCount = 0). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 0). self assert: (m2 outOfWorldCount = 0). "add them to basic morph" morph addMorphFront: m1. m1 addMorphFront: m2. self assert: (m1 intoWorldCount = 0). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 0). self assert: (m2 outOfWorldCount = 0). "open the guy" morph openInWorld. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 0). "collapse it" collapsed := CollapsedMorph new beReplacementFor: morph. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 1). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 1). "expand it" collapsed collapseOrExpand. self assert: (m1 intoWorldCount = 2). self assert: (m1 outOfWorldCount = 1). self assert: (m2 intoWorldCount = 2). self assert: (m2 outOfWorldCount = 1). "delete it" morph delete. self assert: (m1 intoWorldCount = 2). self assert: (m1 outOfWorldCount = 2). self assert: (m2 intoWorldCount = 2). self assert: (m2 outOfWorldCount = 2). ! ----- Method: MorphTest>>testIntoWorldDeleteOutOfWorld (in category 'testing - into/outOf World') ----- testIntoWorldDeleteOutOfWorld | m1 m2 | "Create the guys" m1 := TestInWorldMorph new. m2 := TestInWorldMorph new. self assert: (m1 intoWorldCount = 0). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 0). self assert: (m2 outOfWorldCount = 0). morph addMorphFront: m1. m1 addMorphFront: m2. self assert: (m1 intoWorldCount = 0). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 0). self assert: (m2 outOfWorldCount = 0). morph openInWorld. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 0). morph delete. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 1). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 1). ! ----- Method: MorphTest>>testIntoWorldTransferToNewGuy (in category 'testing - into/outOf World') ----- testIntoWorldTransferToNewGuy | m1 m2 | "Create the guys" m1 := TestInWorldMorph new. m2 := TestInWorldMorph new. self assert: (m1 intoWorldCount = 0). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 0). self assert: (m2 outOfWorldCount = 0). morph addMorphFront: m1. m1 addMorphFront: m2. self assert: (m1 intoWorldCount = 0). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 0). self assert: (m2 outOfWorldCount = 0). morph openInWorld. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 0). morph addMorphFront: m2. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 0). morph addMorphFront: m1. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 0). m2 addMorphFront: m1. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 0). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 0). morph delete. self assert: (m1 intoWorldCount = 1). self assert: (m1 outOfWorldCount = 1). self assert: (m2 intoWorldCount = 1). self assert: (m2 outOfWorldCount = 1). ! ----- Method: MorphTest>>testIsMorph (in category 'testing - classification') ----- testIsMorph self assert: (morph isMorph).! ----- Method: MorphTest>>testOpenInWorld (in category 'testing - initialization') ----- testOpenInWorld self shouldnt: [morph openInWorld] raise: Error.! ----- Method: MorphTest>>testOverlapAny (in category 'testing - etoys') ----- testOverlapAny "self debug: #testOverlapAny" | p1 p2 | p1 := Morph new assuredPlayer. p2 := EllipseMorph new assuredPlayer. "Same position" p1 costume position: 0@0. p2 costume position: 0@0. self assert: (p1 overlapsAny: p2). "Different position" p1 costume position: 0@0. p2 costume position: 500@0. self assert: (p1 overlapsAny: p2) not.! ----- Method: MorphTest>>testOverlapAnyDeletedPlayer (in category 'testing - etoys') ----- testOverlapAnyDeletedPlayer "self debug: #testOverlapAnyDeletedPlayer" | me friend sibling | me := Morph new assuredPlayer assureUniClass; yourself. friend := EllipseMorph new assuredPlayer assureUniClass; yourself. sibling := friend getNewClone. sibling costume delete. self getWorld addMorph: me costume. "Same position but deleted" me costume position: 0 @ 0. friend costume position: 0 @ 0. sibling costume position: 0 @ 0. self assert: (me overlapsAny: friend) not. self assert: (me overlapsAny: sibling) not! ----- Method: MorphTest>>testOverlapAnyScriptedPlayer (in category 'testing - etoys') ----- testOverlapAnyScriptedPlayer "self debug: #testOverlapAnyScriptedPlayer" | me friend other sibling | me := Morph new assuredPlayer assureUniClass; yourself. friend := EllipseMorph new assuredPlayer assureUniClass; yourself. sibling := friend getNewClone. other := EllipseMorph new assuredPlayer assureUniClass; yourself. self getWorld addMorph: me costume; addMorph: friend costume; addMorph: other costume; addMorph: sibling costume. "myself" self assert: (me overlapsAny: me) not. "Same position with sibling" me costume position: 0 @ 0. friend costume position: 500 @ 0. other costume position: 500 @ 0. sibling costume position: 0@0. self assert: (me overlapsAny: friend). "Different position with sibling but same class" me costume position: 0 @ 0. friend costume position: 500 @ 0. sibling costume position: 500@ 0. other costume position: 0 @ 0. self assert: (me overlapsAny: friend) not! ----- Method: MorphTest>>testOverlapAnyUnscriptedPlayer (in category 'testing - etoys') ----- testOverlapAnyUnscriptedPlayer "self debug: #testOverlapAnyUnscriptedPlayer" | p1 p2 p3 | p1 := Morph new assuredPlayer. p2 := EllipseMorph new assuredPlayer. p3 := EllipseMorph new assuredPlayer. self getWorld addMorph: p1 costume; addMorph: p2 costume; addMorph: p3 costume. "Same class, same position" p1 costume position: 0 @ 0. p2 costume position: 500 @ 0. p3 costume position: 0 @ 0. self assert: (p1 overlapsAny: p2). "Same class, different position" p1 costume position: 0 @ 0. p2 costume position: 1000 @ 0. p3 costume position: 500 @ 0. self assert: (p1 overlapsAny: p2) not. ! TestCase subclass: #TileMorphTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Basic'! ----- Method: TileMorphTest>>testArrowAction (in category 'testing') ----- testArrowAction "self debug: #testArrowAction" | dummy tile | dummy := Morph new. tile := TileMorph new setOperator: '+'. dummy addMorph: tile. tile arrowAction: 1. self assert: tile codeString = '-'. tile := TileMorph new setOperator: '<'. dummy addMorph: tile. tile arrowAction: 1. "Because receiver is not tile" self assert: tile codeString = '='. tile := true newTileMorphRepresentative. dummy addMorph: tile. tile arrowAction: 1. self assert: tile codeString = '(false)'. ! ----- Method: TileMorphTest>>testAssignmentTile (in category 'testing') ----- testAssignmentTile "self debug: #testAssignmentTile" | player viewer tile phrase | player := Morph new assuredPlayer. viewer := CategoryViewer new invisiblySetPlayer: player. viewer makeSetter: #(#getX #Number) event: nil from: player costume. phrase := ActiveHand firstSubmorph. ActiveHand removeAllMorphs. tile := phrase submorphs second. self assert: tile codeString = 'setX: '. tile arrowAction: 1. self assert: tile codeString = 'setX: self getX + '. ! ----- Method: TileMorphTest>>testSoundTile (in category 'testing') ----- testSoundTile "self debug: #testSoundTile" | tile dummy | dummy := Morph new. tile := SoundTile new literal: 'croak'. dummy addMorph: tile. tile arrowAction: 1. self assert: tile codeString = '(''horn'')'. ! ClassTestCase subclass: #PasteUpMorphTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Worlds'! !PasteUpMorphTest commentStamp: '<historical>' prior: 0! I am a TestCase for PasteUpMorph.! ----- Method: PasteUpMorphTest>>testCursorWrapped (in category 'tests') ----- testCursorWrapped "self debug: #testCursorWrapped" | holder | holder := PasteUpMorph new. self assert: holder cursor = 1. holder cursorWrapped: 2. self assert: holder cursor = 1. holder addMorph: Morph new; addMorph: Morph new; addMorph: Morph new. holder cursorWrapped: 3. self assert: holder cursor = 3. holder cursorWrapped: 5. self assert: holder cursor = 2. holder cursorWrapped: 0. self assert: holder cursor = 3. holder cursorWrapped: -1. self assert: holder cursor = 2.! ----- Method: PasteUpMorphTest>>testCursorWrappedWithFraction (in category 'tests') ----- testCursorWrappedWithFraction "self debug: #testCursorWrappedWithFraction" | holder | holder := PasteUpMorph new. holder addMorph: Morph new; addMorph: Morph new; addMorph: Morph new. holder cursorWrapped: 3.5. self assert: holder cursor = 3.5. holder cursorWrapped: 5.5. self assert: holder cursor = 2.5. holder cursorWrapped: 0.5. self assert: holder cursor = 3.5. holder cursorWrapped: -0.5. self assert: holder cursor = 2.5.! ----- Method: PasteUpMorphTest>>testGridToGradient (in category 'tests') ----- testGridToGradient "A trivial test for checking that you can change from a grid to a gradient background. A recent [FIX] will make this pass." | pum | pum := PasteUpMorph new. pum setStandardTexture. "The following should fail without the fix" self shouldnt: [pum gradientFillColor: Color red] raise: MessageNotUnderstood! ----- Method: PasteUpMorphTest>>testPlayWithMe1Romoval (in category 'tests') ----- testPlayWithMe1Romoval "A trivial test for checking that PlayWithMe classes are all removed" self deny: ( Smalltalk hasClassNamed: 'PlayWithMe1' ) .! ClassTestCase subclass: #SimpleSwitchMorphTest instanceVariableNames: 'testSwitch' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Widgets'! !SimpleSwitchMorphTest commentStamp: '<historical>' prior: 0! I test the behavior of SimpleSwitchMorph! ----- Method: SimpleSwitchMorphTest>>classToBeTested (in category 'as yet unclassified') ----- classToBeTested ^ SimpleSwitchMorph ! ----- Method: SimpleSwitchMorphTest>>setUp (in category 'as yet unclassified') ----- setUp super setUp. testSwitch := SimpleSwitchMorph new! ----- Method: SimpleSwitchMorphTest>>testName (in category 'as yet unclassified') ----- testName self assert: testSwitch externalName = 'SimpleSwitch'! ----- Method: SimpleSwitchMorphTest>>testState (in category 'as yet unclassified') ----- testState self assert: testSwitch isOff. self deny: testSwitch isOn. testSwitch toggleState. self assert: testSwitch isOn. self deny: testSwitch isOff! ----- Method: SimpleSwitchMorphTest>>testSwitching (in category 'as yet unclassified') ----- testSwitching testSwitch setSwitchState: false. self assert: testSwitch isOff. self assert: testSwitch color = testSwitch offColor. testSwitch setSwitchState: true. self assert: testSwitch isOn. self assert: testSwitch color = testSwitch onColor.! ClassTestCase subclass: #TextMorphTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicTests-Basic'! ----- Method: TextMorphTest>>testInitialize (in category 'testing') ----- testInitialize "For now, just make sure initialization doesn't throw exception" self shouldnt: [TextMorph initialize] raise: Error.!

1 0

The Trunk: Tools-dtl.129.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

David T. Lewis uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-dtl.129.mcz ==================== Summary ==================== Name: Tools-dtl.129 Author: dtl Time: 23 September 2009, 9:31:10 am UUID: 2ca49a59-5ced-472d-b3cb-cffd5f985b78 Ancestors: Tools-dtl.128 Reinitialize each instance of ProcessBrowser on image restart if its autoUpdateProcess is running. Fix implemented for both MVC and Morphic. Reference Mantis 1578. =============== Diff against Tools-dtl.128 =============== Item was changed: ----- Method: ProcessBrowser>>openAsMVC (in category 'views') ----- openAsMVC "Create a pluggable version of me, answer a window" | window processListView stackListView methodTextView | + window := StandardSystemView new model: self controller: StandardSystemController new. - window := StandardSystemView new model: self controller: (deferredMessageRecipient := DeferredActionStandardSystemController new). window borderWidth: 1. processListView := PluggableListView on: self list: #processNameList selected: #processListIndex changeSelected: #processListIndex: menu: #processListMenu: keystroke: #processListKey:from:. processListView window: (0 @ 0 extent: 300 @ 200). window addSubView: processListView. stackListView := PluggableListView on: self list: #stackNameList selected: #stackListIndex changeSelected: #stackListIndex: menu: #stackListMenu: keystroke: #stackListKey:from:. stackListView window: (300 @ 0 extent: 300 @ 200). window addSubView: stackListView toRightOf: processListView. methodTextView := PluggableTextView on: self text: #selectedMethod accept: nil readSelection: nil menu: nil. methodTextView askBeforeDiscardingEdits: false. methodTextView window: (0 @ 200 corner: 600 @ 400). window addSubView: methodTextView below: processListView. window setUpdatablePanesFrom: #(#processNameList #stackNameList ). window label: 'Process Browser'. window minimumSize: 300 @ 200. window subViews do: [:each | each controller]. window controller open. startedCPUWatcher ifTrue: [ self setUpdateCallbackAfter: 7 ]. ^ window! Item was changed: ----- Method: ProcessBrowser>>openAsMorph (in category 'views') ----- openAsMorph "Create a pluggable version of me, answer a window" | window aTextMorph | window := (SystemWindow labelled: 'later') model: self. - deferredMessageRecipient := WorldState. window addMorph: ((PluggableListMorph on: self list: #processNameList selected: #processListIndex changeSelected: #processListIndex: menu: #processListMenu: keystroke: #processListKey:from:) enableDragNDrop: false) frame: (0 @ 0 extent: 0.5 @ 0.5). window addMorph: ((PluggableListMorph on: self list: #stackNameList selected: #stackListIndex changeSelected: #stackListIndex: menu: #stackListMenu: keystroke: #stackListKey:from:) enableDragNDrop: false) frame: (0.5 @ 0.0 extent: 0.5 @ 0.5). aTextMorph := PluggableTextMorph on: self text: #selectedMethod accept: nil readSelection: nil menu: nil. aTextMorph askBeforeDiscardingEdits: false. window addMorph: aTextMorph frame: (0 @ 0.5 corner: 1 @ 1). window setUpdatablePanesFrom: #(#processNameList #stackNameList ). (window setLabel: 'Process Browser') openInWorld. startedCPUWatcher ifTrue: [ self setUpdateCallbackAfter: 7 ]. ^ window! Item was changed: + ----- Method: ProcessBrowser class>>shutDown (in category 'system startup') ----- - ----- Method: ProcessBrowser class>>shutDown (in category 'as yet unclassified') ----- shutDown Browsers do: [ :ea | ea isAutoUpdating ifTrue: [ ea pauseAutoUpdate ]]! Item was changed: + ----- Method: ProcessBrowser class>>startUp (in category 'system startup') ----- - ----- Method: ProcessBrowser class>>startUp (in category 'as yet unclassified') ----- startUp + Browsers + do: [:ea | | paused | ea isAutoUpdatingPaused + ifTrue: [ea initialize; startAutoUpdate]]! - Browsers do: [ :ea | ea isAutoUpdatingPaused ifTrue: [ ea startAutoUpdate ]]! Item was changed: ----- Method: ProcessBrowser>>setUpdateCallbackAfter: (in category 'updating') ----- + setUpdateCallbackAfter: seconds - setUpdateCallbackAfter: seconds + | d | + d := Delay forSeconds: seconds. + [d wait. + d := nil. + Project current addDeferredUIMessage: [self updateProcessList]] fork! - deferredMessageRecipient ifNotNil: [ | d | - d := Delay forSeconds: seconds. - [ d wait. - d := nil. - deferredMessageRecipient addDeferredUIMessage: [self updateProcessList] - ] fork - ]! Item was changed: ----- Method: ProcessBrowser>>initialize (in category 'initialize-release') ----- initialize methodText := ''. stackListIndex := 0. searchString := ''. lastUpdate := 0. startedCPUWatcher := Preferences cpuWatcherEnabled and: [ self startCPUWatcher ]. + self updateProcessList; processListIndex: 1. + Browsers add: self! - self updateProcessList; processListIndex: 1! Item was changed: ----- Method: ProcessBrowser class>>tallyCPUUsageFor:every: (in category 'CPU utilization') ----- tallyCPUUsageFor: seconds every: msec "Compute CPU usage using a msec millisecond sample for the given number of seconds, then dump the usage statistics on the Transcript. The UI is free to continue, meanwhile" "ProcessBrowser tallyCPUUsageFor: 10 every: 100" | promise | promise := Processor tallyCPUUsageFor: seconds every: msec. [ | tally | tally := promise value. Smalltalk isMorphic + ifTrue: [ Project current addDeferredUIMessage: [ self dumpTallyOnTranscript: tally ] ] - ifTrue: [ WorldState addDeferredUIMessage: [ self dumpTallyOnTranscript: tally ] ] ifFalse: [ [ Transcript open ] forkAt: Processor userSchedulingPriority. [ (Delay forSeconds: 1) wait. self dumpTallyOnTranscript: tally ] forkAt: Processor userSchedulingPriority.] ] fork.! Item was changed: ----- Method: ProcessBrowser>>startAutoUpdate (in category 'updating') ----- startAutoUpdate + self isAutoUpdatingPaused + ifTrue: [^ autoUpdateProcess resume]. - self isAutoUpdatingPaused ifTrue: [ ^autoUpdateProcess resume ]. self isAutoUpdating + ifFalse: [autoUpdateProcess := [[self hasView] + whileTrue: [(Delay forSeconds: 2) wait. + Project current addDeferredUIMessage: [self updateProcessList]]. - ifFalse: [| delay | - delay := Delay forSeconds: 2. - autoUpdateProcess := [[self hasView] - whileTrue: [delay wait. - deferredMessageRecipient ifNotNil: [ - deferredMessageRecipient addDeferredUIMessage: [self updateProcessList]] - ifNil: [ self updateProcessList ]]. autoUpdateProcess := nil] fork]. + self updateProcessList + ! - self updateProcessList! Item was changed: Model subclass: #ProcessBrowser + instanceVariableNames: 'selectedProcess selectedContext methodText processList processListIndex stackList stackListIndex sourceMap selectedClass selectedSelector searchString autoUpdateProcess lastUpdate startedCPUWatcher' - instanceVariableNames: 'selectedProcess selectedContext methodText processList processListIndex stackList stackListIndex sourceMap selectedClass selectedSelector searchString autoUpdateProcess deferredMessageRecipient lastUpdate startedCPUWatcher' classVariableNames: 'Browsers SuspendedProcesses WellKnownProcesses' poolDictionaries: '' category: 'Tools-Process Browser'! !ProcessBrowser commentStamp: '<historical>' prior: 0! Change Set: ProcessBrowser Date: 14 March 2000 Author: Ned Konz email: ned(a)bike-nomad.com This is distributed under the Squeak License. Added 14 March: CPUWatcher integration automatically start and stop CPUWatcher added CPUWatcher to process list menu Added 29 October: MVC version 2.8, 2.7 compatibility rearranged menus added pointer inspection and chasing added suspend/resume recognized more well-known processes misc. bug fixes Added 26 October: highlight pc in source code Added 27 October: added 'signal semaphore' added 'inspect receiver', 'explore receiver', 'message tally' to stack list menu added 'find context', 'next context' to process list menu added 'change priority' and 'debug' choices to process list menu 27 October mods by Bob Arning: alters process display in Ned's ProcessBrowser to - show process priority - drop 'a Process in' that appears on each line - show in priority order - prettier names for known processes - fix to Utilities to forget update downloading process when it ends (1 less dead process) - correct stack dump for the active process !

1 0

The Trunk: Morphic-dtl.189.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

David T. Lewis uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-dtl.189.mcz ==================== Summary ==================== Name: Morphic-dtl.189 Author: dtl Time: 23 September 2009, 9:05:58 am UUID: a708b322-c0ad-47b1-bb9d-634786943c1b Ancestors: Morphic-ar.188 Implement MorphicProject>>addDeferredUIMessage. Reference Mantis 1578. =============== Diff against Morphic-ar.188 =============== Item was added: + ----- Method: MorphicProject>>addDeferredUIMessage: (in category 'scheduling') ----- + addDeferredUIMessage: valuableObject + "Arrange for valuableObject to be evaluated at a time when the user interface + is in a coherent state." + + WorldState addDeferredUIMessage: valuableObject!

1 0

The Trunk: ST80-dtl.54.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

David T. Lewis uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-dtl.54.mcz ==================== Summary ==================== Name: ST80-dtl.54 Author: dtl Time: 23 September 2009, 9:04:51 am UUID: 93745599-d881-4dca-a682-f47a84c2e983 Ancestors: ST80-ar.53 Implement MVCProject>>addDeferredUIMessage: and move implementation for deferred UI messages from DeferredActionStandardSystemController to Controller. This allows scheduling deferred of deferred UI actions regardless of which controller is currently active. This is important when, for example, deferred actions are scheduled during system startup and a ScreenController is the active controller (ProcessBrowser may do this during startup). Reference Mantis 1578. =============== Diff against ST80-ar.53 =============== Item was added: + ----- Method: Controller>>deferredActionQueue (in category 'basic control sequence') ----- + deferredActionQueue + + ^deferredActionQueue ifNil: [deferredActionQueue := SharedQueue new]! Item was changed: ----- Method: Controller>>controlActivity (in category 'control defaults') ----- controlActivity "Pass control to the next control level (that is, to the Controller of a subView of the receiver's view) if possible. It is sent by Controller|controlLoop each time through the main control loop. It should be redefined in a subclass if some other action is needed." + [self deferredActionQueue isEmpty] + whileFalse: [deferredActionQueue next value]. self controlToNextLevel! Item was added: + ----- Method: Controller>>addDeferredUIMessage: (in category 'basic control sequence') ----- + addDeferredUIMessage: valuableObject + "Arrange for valuableObject to be evaluated the next time the + controlActivity for this controller becomes active." + + self deferredActionQueue nextPut: valuableObject! Item was added: + ----- Method: MVCProject>>addDeferredUIMessage: (in category 'scheduling') ----- + addDeferredUIMessage: valuableObject + "Arrange for valuableObject to be evaluated at a time when the user interface + is in a coherent state." + + ScheduledControllers activeController + ifNotNilDo: [:controller | controller addDeferredUIMessage: valuableObject]! Item was changed: Object subclass: #Controller + instanceVariableNames: 'model view sensor deferredActionQueue lastActivityTime' - instanceVariableNames: 'model view sensor lastActivityTime' classVariableNames: 'MinActivityLapse' poolDictionaries: '' category: 'ST80-Kernel-Remnants'! !Controller commentStamp: '<historical>' prior: 0! A Controller coordinates a View, its model, and user actions. It provides scheduling (control) behavior to determine when the user wants to communicate with the model or view.!

1 0

The Trunk: System-dtl.151.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.151.mcz ==================== Summary ==================== Name: System-dtl.151 Author: dtl Time: 23 September 2009, 9:02:56 am UUID: 1d0dfba8-093d-4014-8873-8586f140eba1 Ancestors: System-ar.150 Implement #addDeferredUIMessage: in abstract Project. Reference Mantis 1578. This supports a fix to ProcessBrowser to correctly reinitialize following image restart in MVC or Morphic. =============== Diff against System-ar.150 =============== Item was added: + ----- Method: Project>>addDeferredUIMessage: (in category 'scheduling') ----- + addDeferredUIMessage: valuableObject + "Arrange for valuableObject to be evaluated at a time when the user interface + is in a coherent state." + + self subclassResponsibility!

1 0

The Trunk: Tools-dtl.128.mcz
by commits＠source.squeak.org 24 Sep '09

24 Sep '09

David T. Lewis uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-dtl.128.mcz ==================== Summary ==================== Name: Tools-dtl.128 Author: dtl Time: 23 September 2009, 8:50:19 am UUID: a9d27ac7-8c93-4ead-a99c-08f2588ddf86 Ancestors: Tools-ar.127 Make DeferredActionStandardSystemController an empty stub, retained for the time being to provide backward compatibility for external packages. Implementation has been moved to Controller. Reference Mantis 1578. =============== Diff against Tools-ar.127 =============== Item was changed: StandardSystemController subclass: #DeferredActionStandardSystemController + instanceVariableNames: '' - instanceVariableNames: 'queue' classVariableNames: '' poolDictionaries: '' category: 'Tools-Process Browser'! + !DeferredActionStandardSystemController commentStamp: 'dtl 9/20/2009 18:39' prior: 0! + Deprecated (Sept 2009) - The DeferredActionStandardSystemController has been merged into Controller. This class remains as a stub to guard ensure that any external packages that depend on it remain functional. + - !DeferredActionStandardSystemController commentStamp: '<historical>' prior: 0! This is a StandardSystemController that can queue up objects to be evaluated before its control loop.! Item was removed: - ----- Method: DeferredActionStandardSystemController>>controlActivity (in category 'as yet unclassified') ----- - controlActivity - [queue isEmpty] - whileFalse: [queue next value]. - ^super controlActivity! Item was removed: - ----- Method: DeferredActionStandardSystemController>>initialize (in category 'as yet unclassified') ----- - initialize - super initialize. - queue := SharedQueue new.! Item was removed: - ----- Method: DeferredActionStandardSystemController>>addDeferredUIMessage: (in category 'as yet unclassified') ----- - addDeferredUIMessage: valuableObject - queue nextPut: valuableObject!

1 0

[ANN] UGP / SecureSqueak version 0.1 released
by Michael van der Gulik 23 Sep '09

23 Sep '09

Hi all. I'm announcing version 0.1 of my Unnamed Grand Project, including naïve versions of SecureSqueak, Subcanvas, SiteBrowser and DPON. Download from here: http://sourceforge.net/projects/securesqueak/ Or watch the video: http://vimeo.com/6698843. This release "barely works". It is for curious onlookers who want to poke the code with a stick to see if it moves. I've only tested this under the Linux VM. I'm not sure if it will run on the Windows or Mac VMs; it requires that the EventSensor's inputSemaphore is signalled from the VM. Also, if you're worried about security, this release opens up a TCP socket and basically runs anything that comes in on it. If you're worried, disconnect yourself from the Internet first. Later releases will be more secure. The Unnamed Grand Project is like a web browser but different. Instead of loading HTML, the user will interact with distributed objects. The downloadable image above does this for three simple "sites", downloading their implementation and running them locally. SecureSqueak is a fork of Squeak which provides a sandboxed environment to run untrusted, remotely loaded code. Later versions will be progressively more secure. Subcanvas is a graphics/event-handling framework. It does a similar job to the EventSensor, Display, Form and BitBlt classes. It provides a secure API with optimisable implementations. SiteBrowser is the user interface built on Subcanvas which lets the user interact with distributed objects. DPON is an object replication framework. It lets objects move between images. It can replicate most objects in the image using a number of replication algorithms, and will also replicate the classes of those objects and any dependencies. Unfortunately, PbWiki seems to be down, but when it works again I'll add more information at http://gulik.pbwiki.com/SecureSqueak and consider finding another wiki hosting site. Gulik. -- http://gulik.pbwiki.com/

3 5

Advice on new projects
by Ross Boylan 23 Sep '09

23 Sep '09

I'm starting some new projects, one on squeak and the other on seaside. Both use magma, and the latter will probably use the pharo-based images, since seaside is using that as a development platform. Is there any namespace or similar mechanism that it would be advisable to use? I'm using Monticello, as distributed in the image, for managing the project. Is that a sensible choice? Should I use MC 2? Despite its age it seems to still be a bit unfinished, certainly with respect to documentation. I'm putting my classes in MC type class categories, and prefixing them with an indentifying code (MI for one, undecided for the other). This seems a weak substitute for namespaces, however. I'm also toying with the idea of using traits. Thanks for any advice or perspective you can offer. Ross Boylan

7 6

← Newer
1
...
6
7
8
9
10
11
12
...
37
Older →

Jump to page: