From 01f54a18ee773168adf6c980b363f160478f510e Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 10 Oct 2024 16:06:49 +0200 Subject: [PATCH 1/3] - Adding support for stoping and starting the Bloc thread during image startup / shutdown - Recovering open spaces in the same place - Fixing Tests - Showing an space that has been hide should work --- src/Bloc-Tests/BlSpaceTest.class.st | 89 ------------------- src/Bloc-Tests/BlSpaceVisibilityTest.class.st | 46 ++++++++++ src/Bloc-Tests/BlStartupShutdownTest.class.st | 78 ++++++++++++++++ src/Bloc/BlHost.class.st | 6 ++ src/Bloc/BlParallelUniverse.class.st | 28 +++++- src/Bloc/BlRealTime.class.st | 2 +- src/Bloc/BlSpace.class.st | 23 ++++- src/Bloc/BlSpaceManager.class.st | 12 +++ .../BlMorphicSteppingHost.class.st | 7 ++ .../BlMorphicWindowHostSpace.class.st | 26 ++++++ .../BlOSWindowHostSpace.class.st | 6 ++ 11 files changed, 227 insertions(+), 96 deletions(-) create mode 100644 src/Bloc-Tests/BlSpaceVisibilityTest.class.st create mode 100644 src/Bloc-Tests/BlStartupShutdownTest.class.st diff --git a/src/Bloc-Tests/BlSpaceTest.class.st b/src/Bloc-Tests/BlSpaceTest.class.st index a19c0f7ee..8d577a8b4 100644 --- a/src/Bloc-Tests/BlSpaceTest.class.st +++ b/src/Bloc-Tests/BlSpaceTest.class.st @@ -7,92 +7,3 @@ Class { ], #category : #'Bloc-Tests-Space' } - -{ #category : #initialization } -BlSpaceTest >> dirtyAreas [ - ^ space dirtyAreas asArray collect: #asRectangle -] - -{ #category : #initialization } -BlSpaceTest >> setUp [ - super setUp. - - space := BlSpace new. - host := BlMockedHost new. - - space host: host. - host createHostSpaceFor: space. -] - -{ #category : #initialization } -BlSpaceTest >> tearDown [ - super tearDown. - - host destroyHostSpaceFor: space. - space host: nil. - host := nil. - space := nil -] - -{ #category : #tests } -BlSpaceTest >> testEnqueueEvent [ - - self skip. - space pulse. - self assert: space pulseRequested not. - - space hostSpace enqueueEvent: - (BlMouseMoveEvent new - position: 20 @ 20; - yourself). - self assert: space pulseRequested. - - space pulse. - self assert: space pulseRequested not -] - -{ #category : #tests } -BlSpaceTest >> testInitialization [ - self skip. - "Host space must not be nil" - self assert: space hostSpace isNotNil. - - "Space must request pulse when just created" - self assert: space pulseRequested. - - "Space must have its whole area being dirty" - self assert: self dirtyAreas equals: { 0@0 extent: space extent } -] - -{ #category : #tests } -BlSpaceTest >> testRender [ - self skip. - self assert: self dirtyAreas equals: { 0@0 extent: space extent }. - self assert: space hostSpace renderCount equals: 0. - self assert: space pulseRequested. - - space pulse. - self assert: self dirtyAreas equals: {}. - self assert: space hostSpace renderCount equals: 1. - self assert: space pulseRequested not. - - space pulse. - self assert: self dirtyAreas equals: {}. - self assert: space hostSpace renderCount equals: 1. - self assert: space pulseRequested not. - - space requestNextPulse. - self assert: space pulseRequested. - space pulse. - self assert: self dirtyAreas equals: {}. - self assert: space hostSpace renderCount equals: 1. - self assert: space pulseRequested not. - - space invalidRect: (BlBounds origin: 50.0@70.0 extent: 300.0@200.0) from: space root. - self assert: space pulseRequested. - self assert: self dirtyAreas equals: { 50@70 extent: 300@200 }. - space pulse. - self assert: self dirtyAreas equals: {}. - self assert: space hostSpace renderCount equals: 2. - self assert: space pulseRequested not. -] diff --git a/src/Bloc-Tests/BlSpaceVisibilityTest.class.st b/src/Bloc-Tests/BlSpaceVisibilityTest.class.st new file mode 100644 index 000000000..23b9a8639 --- /dev/null +++ b/src/Bloc-Tests/BlSpaceVisibilityTest.class.st @@ -0,0 +1,46 @@ +Class { + #name : #BlSpaceVisibilityTest, + #superclass : #BlParameterizedHostTest, + #category : #'Bloc-Tests-Space' +} + +{ #category : #tests } +BlSpaceVisibilityTest >> testHidingAnOpenSpaceHidesTheWindow [ + + | aSpace | + + aSpace := self newTestingSpace. + + aSpace show. + self waitTestingOpenedSpaces. + + self assert: aSpace hostSpace isVisible. + + aSpace hide. + + self deny: aSpace hostSpace isVisible. + +] + +{ #category : #tests } +BlSpaceVisibilityTest >> testHidingAndShowingAnOpenSpaceShowsTheWindow [ + + | aSpace | + + aSpace := self newTestingSpace. + + aSpace show. + self waitTestingOpenedSpaces. + + self assert: aSpace hostSpace isVisible. + + aSpace hide. + + self deny: aSpace hostSpace isVisible. + + aSpace show. + self waitTestingOpenedSpaces. + + self assert: aSpace hostSpace isVisible. + +] diff --git a/src/Bloc-Tests/BlStartupShutdownTest.class.st b/src/Bloc-Tests/BlStartupShutdownTest.class.st new file mode 100644 index 000000000..b5692cd52 --- /dev/null +++ b/src/Bloc-Tests/BlStartupShutdownTest.class.st @@ -0,0 +1,78 @@ +Class { + #name : #BlStartupShutdownTest, + #superclass : #BlParameterizedHostTest, + #category : #'Bloc-Tests-Space' +} + +{ #category : #running } +BlStartupShutdownTest >> runCaseManaged [ + + ^ self runCase +] + +{ #category : #tests } +BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesInSamePosition [ + + | aSpace | + + hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. + + aSpace := self newTestingSpace. + + aSpace show. + self waitTestingOpenedSpaces. + aSpace position: 100@100. + aSpace extent: 200@200. + + self assert: aSpace position equals: 100@100. + self assert: aSpace extent equals: 200@200. + + aSpace universe stopUniverse. + aSpace universe startUniverse. + + self assert: aSpace position equals: 100@100. + self assert: aSpace extent equals: 200@200. + +] + +{ #category : #tests } +BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesOpen [ + + | aSpace | + + hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. + + aSpace := self newTestingSpace. + + aSpace show. + self waitTestingOpenedSpaces. + self assert: aSpace isVisible. + + aSpace universe stopUniverse. + aSpace universe startUniverse. + + self assert: aSpace isVisible. + +] + +{ #category : #tests } +BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesOpenWithInvalidation [ + + | aSpace | + + hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. + + aSpace := self newTestingSpace. + + aSpace show. + self waitTestingOpenedSpaces. + self assert: aSpace isVisible. + + aSpace universe stopUniverse. + aSpace hostSpace invalidate. + + aSpace universe startUniverse. + + self assert: aSpace isVisible. + +] diff --git a/src/Bloc/BlHost.class.st b/src/Bloc/BlHost.class.st index 06fc9c6ff..b60edc071 100644 --- a/src/Bloc/BlHost.class.st +++ b/src/Bloc/BlHost.class.st @@ -159,6 +159,12 @@ BlHost >> offscreenMeasureTextParagraph: aBlTextParagraph [ BlHostRenderer preferableClass offscreenMeasureTextParagraph: aBlTextParagraph ] +{ #category : #'host - testing' } +BlHost >> runOneCycle [ + + "The host can do something while waiting for the pulse to happen. Useful for Morphic when the test run in the UI thread" +] + { #category : #'api - lifecycle' } BlHost >> start [ diff --git a/src/Bloc/BlParallelUniverse.class.st b/src/Bloc/BlParallelUniverse.class.st index b3194d783..056008018 100644 --- a/src/Bloc/BlParallelUniverse.class.st +++ b/src/Bloc/BlParallelUniverse.class.st @@ -55,7 +55,21 @@ BlParallelUniverse class >> forHost: aHostClass [ BlParallelUniverse class >> initialize [ Universes := #(). UniversesMutex := Mutex new. - UniqueIdGenerator := BlUniqueIdGenerator new + UniqueIdGenerator := BlUniqueIdGenerator new. + + SessionManager default registerGuiClassNamed: self name +] + +{ #category : #'system startup' } +BlParallelUniverse class >> shutDown [ + + self all do: [ :anUniverse | anUniverse stopUniverse ] +] + +{ #category : #'system startup' } +BlParallelUniverse class >> startUp [ + + self all do: [ :anUniverse | anUniverse startUniverse ] ] { #category : #'api - spaces' } @@ -297,6 +311,7 @@ BlParallelUniverse >> hasUIProcess [ { #category : #accessing } BlParallelUniverse >> hostClass [ + ^ hostClass ] @@ -354,7 +369,10 @@ BlParallelUniverse >> openSpace: aSpace [ { #category : #'private - spaces' } BlParallelUniverse >> openSpaceSynchronously: aSpace [ - aSpace isOpened ifTrue: [ ^ self ]. + aSpace isOpened ifTrue: [ + "If it has been already opened, just unhide it" + aSpace hostSpace show. + ^ self ]. self assert: [ aSpace hasHostSpace not ] @@ -450,7 +468,8 @@ BlParallelUniverse >> startUniverse [ "A universe must not be running here. I am called outside of the UI loop (there is no UI loop yet)" - self hostClass start + hostClass start. + spaceManager start ] { #category : #'private - lifecycle' } @@ -458,7 +477,8 @@ BlParallelUniverse >> stopUniverse [ "A universe must be running here. I am called from the UI loop" - self hostClass stop + hostClass stop. + spaceManager stop ] { #category : #'deferred message' } diff --git a/src/Bloc/BlRealTime.class.st b/src/Bloc/BlRealTime.class.st index e099caef5..2445c6b56 100644 --- a/src/Bloc/BlRealTime.class.st +++ b/src/Bloc/BlRealTime.class.st @@ -32,7 +32,7 @@ BlRealTime >> every: aDuration while: aWhileBlock do: aDoBlock [ aStartTime := self now. aCount := 0. - aWhileBlock whileTrue: [ + [aWhileBlock value] whileTrue: [ | anExpectedTime aCurrentTime aWaitingTime | aDoBlock value. diff --git a/src/Bloc/BlSpace.class.st b/src/Bloc/BlSpace.class.st index a1e457ee3..259e71393 100644 --- a/src/Bloc/BlSpace.class.st +++ b/src/Bloc/BlSpace.class.st @@ -53,7 +53,8 @@ Class { 'reference', 'iconStencil', 'rootElement', - 'userData' + 'userData', + 'previousVisibleStatus' ], #classVars : [ 'UniqueIdGenerator' @@ -139,7 +140,10 @@ BlSpace class >> pulseUntilEmptyTaskQueue: aSpace timeout: aDuration [ aSpace universe hasDeferredActions or: [ (aSpace taskQueue isEmpty or: [ aSpace time now >= deadline ]) not ] ] - do: [ aSpace pulse ]. + do: [ + "We delegate to the host class also to run a cycle, it is needed when using morphic host, as this can run in the same UI thread blocking everything." + aSpace host runOneCycle. + aSpace pulse ]. aSpace pulse. @@ -864,6 +868,15 @@ BlSpace >> ensureSession [ self onSessionChanged: Smalltalk session ] +{ #category : #'private - display' } +BlSpace >> ensureWindowOpen [ + + hostSpace ifNotNil: [ + hostSpace isValid ifFalse: [ + host createHostSpaceFor: self. + previousVisibleStatus ifTrue: [ hostSpace open ] ] ] +] + { #category : #'event management accessing' } BlSpace >> eventDispatcher [ ^ eventDispatcher @@ -1480,6 +1493,12 @@ BlSpace >> pulseRequested [ ^ nextPulseRequested ] +{ #category : #'startup - shutdown' } +BlSpace >> rememberVisibleStatus [ + + previousVisibleStatus := self isVisible +] + { #category : #pulse } BlSpace >> render [ "Render this space in my host window if it is assigned, otherwise do nothing" diff --git a/src/Bloc/BlSpaceManager.class.st b/src/Bloc/BlSpaceManager.class.st index 008d3156c..c63eb2f97 100644 --- a/src/Bloc/BlSpaceManager.class.st +++ b/src/Bloc/BlSpaceManager.class.st @@ -91,3 +91,15 @@ BlSpaceManager >> spaces [ ^ spaces ] + +{ #category : #'startup - shutdown' } +BlSpaceManager >> start [ + + spaces do: [ :aSpace | aSpace ensureWindowOpen ] +] + +{ #category : #'startup - shutdown' } +BlSpaceManager >> stop [ + + spaces do: [ :anSpace | anSpace rememberVisibleStatus ] +] diff --git a/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st b/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st index 6b2a65506..abe93804b 100644 --- a/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st +++ b/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st @@ -51,6 +51,13 @@ BlMorphicSteppingHost class >> uiProcessDo: aBlock [ UIManager default uiProcess ifNotNil: aBlock ] +{ #category : #'host - testing' } +BlMorphicSteppingHost >> runOneCycle [ + + MorphicUIManager uiProcess == Processor activeProcess ifTrue: [ + MorphicRenderLoop new doOneCycle ] +] + { #category : #'host - testing' } BlMorphicSteppingHost >> supportsFormSurface [ diff --git a/src/BlocHost-Morphic/BlMorphicWindowHostSpace.class.st b/src/BlocHost-Morphic/BlMorphicWindowHostSpace.class.st index 9d8f096e5..07b8d2742 100644 --- a/src/BlocHost-Morphic/BlMorphicWindowHostSpace.class.st +++ b/src/BlocHost-Morphic/BlMorphicWindowHostSpace.class.st @@ -66,6 +66,12 @@ BlMorphicWindowHostSpace >> fullsize: aBoolean [ morphicWindow fullsize: aBoolean. ] +{ #category : #'host space - displaying' } +BlMorphicWindowHostSpace >> hide [ + + morphicWindow visible: false. +] + { #category : #initialization } BlMorphicWindowHostSpace >> initialize [ super initialize. @@ -74,6 +80,12 @@ BlMorphicWindowHostSpace >> initialize [ isFullSize := false ] +{ #category : #'dirty areas' } +BlMorphicWindowHostSpace >> invalidate [ + + morphicWindow := nil +] + { #category : #'window - properties' } BlMorphicWindowHostSpace >> isBorderless [ "Return true if underlying window is now borderless, false otherwise" @@ -95,6 +107,18 @@ BlMorphicWindowHostSpace >> isTextInputActive [ ^ morphicWindow isTextInputActive ] +{ #category : #testing } +BlMorphicWindowHostSpace >> isValid [ + + ^ morphicWindow isNotNil +] + +{ #category : #testing } +BlMorphicWindowHostSpace >> isVisible [ + + ^ morphicWindow visible +] + { #category : #'host space - geometry' } BlMorphicWindowHostSpace >> logicalSize [ "Returns the logical size of the host's client area. @@ -162,6 +186,8 @@ BlMorphicWindowHostSpace >> position: aPoint [ BlMorphicWindowHostSpace >> show [ | anExtent | + morphicWindow visible: true. + anExtent := morphicWindow extent. morphicWindow openInWorld. morphicWindow extent: anExtent diff --git a/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st b/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st index 87fb1ce8a..bbae55800 100644 --- a/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st +++ b/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st @@ -109,6 +109,12 @@ BlOSWindowHostSpace >> initializeWithAttributes: initialAttributes [ (BlOSWindowCreatedSignal new window: window) emit ] +{ #category : #'dirty areas' } +BlOSWindowHostSpace >> invalidate [ + + window := nil +] + { #category : #'window - properties' } BlOSWindowHostSpace >> isBorderless [ From 480b0b38f82a48b992057f8e50a3b774b1a67f8e Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 10 Oct 2024 18:48:02 +0200 Subject: [PATCH 2/3] Skipping if we are in Linux --- src/Bloc-Tests/BlSpaceVisibilityTest.class.st | 4 ++++ src/Bloc-Tests/BlStartupShutdownTest.class.st | 3 +++ 2 files changed, 7 insertions(+) diff --git a/src/Bloc-Tests/BlSpaceVisibilityTest.class.st b/src/Bloc-Tests/BlSpaceVisibilityTest.class.st index 23b9a8639..ac5a8ccbf 100644 --- a/src/Bloc-Tests/BlSpaceVisibilityTest.class.st +++ b/src/Bloc-Tests/BlSpaceVisibilityTest.class.st @@ -9,6 +9,8 @@ BlSpaceVisibilityTest >> testHidingAnOpenSpaceHidesTheWindow [ | aSpace | + Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. + aSpace := self newTestingSpace. aSpace show. @@ -27,6 +29,8 @@ BlSpaceVisibilityTest >> testHidingAndShowingAnOpenSpaceShowsTheWindow [ | aSpace | + Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. + aSpace := self newTestingSpace. aSpace show. diff --git a/src/Bloc-Tests/BlStartupShutdownTest.class.st b/src/Bloc-Tests/BlStartupShutdownTest.class.st index b5692cd52..020c0b54b 100644 --- a/src/Bloc-Tests/BlStartupShutdownTest.class.st +++ b/src/Bloc-Tests/BlStartupShutdownTest.class.st @@ -16,6 +16,7 @@ BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesInSamePosition [ | aSpace | hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace. @@ -41,6 +42,7 @@ BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesOpen [ | aSpace | hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace. @@ -61,6 +63,7 @@ BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesOpenWithInvalidation [ | aSpace | hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace. From b87b7ee944a80606fdd1f13982231b36bf180b77 Mon Sep 17 00:00:00 2001 From: Pablo Tesone Date: Thu, 10 Oct 2024 18:55:38 +0200 Subject: [PATCH 3/3] The OS name is unix --- src/Bloc-Tests/BlSpaceVisibilityTest.class.st | 4 ++-- src/Bloc-Tests/BlStartupShutdownTest.class.st | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Bloc-Tests/BlSpaceVisibilityTest.class.st b/src/Bloc-Tests/BlSpaceVisibilityTest.class.st index ac5a8ccbf..abc5e489d 100644 --- a/src/Bloc-Tests/BlSpaceVisibilityTest.class.st +++ b/src/Bloc-Tests/BlSpaceVisibilityTest.class.st @@ -9,7 +9,7 @@ BlSpaceVisibilityTest >> testHidingAnOpenSpaceHidesTheWindow [ | aSpace | - Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'unix' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace. @@ -29,7 +29,7 @@ BlSpaceVisibilityTest >> testHidingAndShowingAnOpenSpaceShowsTheWindow [ | aSpace | - Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'unix' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace. diff --git a/src/Bloc-Tests/BlStartupShutdownTest.class.st b/src/Bloc-Tests/BlStartupShutdownTest.class.st index 020c0b54b..bdc64872e 100644 --- a/src/Bloc-Tests/BlStartupShutdownTest.class.st +++ b/src/Bloc-Tests/BlStartupShutdownTest.class.st @@ -16,7 +16,7 @@ BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesInSamePosition [ | aSpace | hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. - Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'unix' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace. @@ -42,7 +42,7 @@ BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesOpen [ | aSpace | hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. - Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'unix' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace. @@ -63,7 +63,7 @@ BlStartupShutdownTest >> testShutdownAndStartupKeepsSpacesOpenWithInvalidation [ | aSpace | hostClass = BlMorphicWindowHost ifTrue: [ ^ self skip ]. - Smalltalk vm operatingSystemName = 'Linux' ifTrue: [ ^ self skip ]. + Smalltalk vm operatingSystemName = 'unix' ifTrue: [ ^ self skip ]. aSpace := self newTestingSpace.