Merge pull request #619 from pharo-graphics/618-Bloc-Main-Thread-shou…

…ld-be-stopped-and-restarted-in-shutdownstartup

618-Bloc-Main-Thread-should-be-stopped-and-restarted-in-shutdownstartup

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.
-]

src/Bloc-Tests/BlSpaceVisibilityTest.class.st

@@ -0,0 +1,50 @@
+Class {
+	#name : #BlSpaceVisibilityTest,
+	#superclass : #BlParameterizedHostTest,
+	#category : #'Bloc-Tests-Space'
+}
+
+{ #category : #tests }
+BlSpaceVisibilityTest >> testHidingAnOpenSpaceHidesTheWindow [
+
+	| aSpace |
+
+	Smalltalk vm operatingSystemName = 'unix' ifTrue: [ ^ self skip ].
+
+	aSpace := self newTestingSpace.
+
+	aSpace show.
+	self waitTestingOpenedSpaces.
+
+	self assert: aSpace hostSpace isVisible.
+
+	aSpace hide.	
+
+	self deny: aSpace hostSpace isVisible.
+
+]
+
+{ #category : #tests }
+BlSpaceVisibilityTest >> testHidingAndShowingAnOpenSpaceShowsTheWindow [
+
+	| aSpace |
+
+	Smalltalk vm operatingSystemName = 'unix' ifTrue: [ ^ self skip ].
+
+	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.
+
+]

src/Bloc-Tests/BlStartupShutdownTest.class.st

@@ -0,0 +1,81 @@
+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 ].
+	Smalltalk vm operatingSystemName = 'unix' 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 ].
+	Smalltalk vm operatingSystemName = 'unix' 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 ].
+	Smalltalk vm operatingSystemName = 'unix' 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.
+
+]

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 [
 

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,15 +468,17 @@ 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' }
 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' }

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.
 

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"

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 ]
+]

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 [