diff --git a/src/Bloc-DevTool/BlBenchmarkConsole.class.st b/src/Bloc-DevTool/BlBenchmarkConsole.class.st index 0205ab13f..42a85604d 100644 --- a/src/Bloc-DevTool/BlBenchmarkConsole.class.st +++ b/src/Bloc-DevTool/BlBenchmarkConsole.class.st @@ -77,7 +77,7 @@ BlBenchmarkConsole >> listenSpace: aSpace [ lastTime := aSpace time now. frames := 0. framesLimit := 120. - aSpace eventDispatcher addEventHandler: + aSpace addEventHandler: (BlEventHandler on: BlSpaceRenderEndEvent do: [ :evt | frames := frames + 1. frames % framesLimit = 0 @@ -86,11 +86,11 @@ BlBenchmarkConsole >> listenSpace: aSpace [ lastTime := evt end. frames := 0 ]. self renderTime: (evt end - evt start) ]). - aSpace eventDispatcher addEventHandler: + aSpace addEventHandler: (BlEventHandler on: BlSpaceEventsProcessedEvent do: [ :evt | self eventProcessingTime: (evt end - evt start). ]). - aSpace eventDispatcher addEventHandler: + aSpace addEventHandler: (BlEventHandler on: BlSpaceLayoutEndEvent do: [ :evt | self layoutTime: (evt end - evt start). ]) diff --git a/src/Bloc-Tests/BlHostPulseLoopTest.class.st b/src/Bloc-Tests/BlHostPulseLoopTest.class.st index 786459fc8..6a5208fdb 100644 --- a/src/Bloc-Tests/BlHostPulseLoopTest.class.st +++ b/src/Bloc-Tests/BlHostPulseLoopTest.class.st @@ -27,7 +27,7 @@ BlHostPulseLoopTest >> testOpeningAnSpaceDeferingAnErrorKeepsLoopRunning [ aSpace show. logger := MemoryLogger new. - logger runFor: BlParallelUniverseErrorDuringPulse during: [ + logger runFor: BlParallelUniverseErrorDuringPulseSignal during: [ aSpace universe defer: [ 1 error: 'I am the debugger to kill' ]. [aSpace universe hasDeferredActions] whileTrue: [ 100 milliSeconds wait diff --git a/src/Bloc-Tests/BlSpaceEventTest.class.st b/src/Bloc-Tests/BlSpaceEventTest.class.st index 0125dcdf9..9f874e4b5 100644 --- a/src/Bloc-Tests/BlSpaceEventTest.class.st +++ b/src/Bloc-Tests/BlSpaceEventTest.class.st @@ -40,29 +40,6 @@ BlSpaceEventTest >> testSpaceClosed [ self assert: count equals: 1 ] -{ #category : #tests } -BlSpaceEventTest >> testSpaceDestroyed [ - - | events | - events := OrderedCollection new. - - space - addEventHandlerOn: BlSpaceClosedEvent - do: [ events add: #closed ]. - space - addEventHandlerOn: BlSpaceDestroyedEvent - do: [ events add: #destroyed ]. - - space show. - self waitPulses. - self assert: events size equals: 0. - - space close. - self waitPulses. - self assert: events size equals: 2. - self assert: events asArray equals: #( closed destroyed ) -] - { #category : #tests } BlSpaceEventTest >> testSpaceShown [ diff --git a/src/Bloc/BlElement.class.st b/src/Bloc/BlElement.class.st index 80fd2ca90..f0160ac67 100644 --- a/src/Bloc/BlElement.class.st +++ b/src/Bloc/BlElement.class.st @@ -3933,16 +3933,15 @@ BlElement >> whenLayoutedDo: aBlock [ { #category : #'geometry hooks' } BlElement >> whenLayoutedDoOnce: aBlock [ - "As an example of use, imagine you need to get the actual size of an element. + "Evaluate block passed as argument after the layout applied. + + As an example of use, imagine you need to get the actual size of an element. The size is computed by the layout. - Thus, if one need to get the size of an element one have to be sure that its layout applied. - This is the purpose of #whenLayoutedDoOne: (when layout applied do once) which intention is to run - the block passed as argument only one time just after the layout applied. - - ** notice ** that my use is not encouraged except for debugging or for particular purposes - ouside usual Bloc coding - " - self when: BlElementLayoutComputedEvent doOnce: [ :event | aBlock cull: event ]. + Thus, if one need to get the size of an element one have to be sure that its layout applied." + + ^ self + addEventHandlerOn: BlElementLayoutComputedEvent + doOnce: aBlock ] { #category : #'api - bounds' } diff --git a/src/Bloc/BlHeadlessHostSpace.class.st b/src/Bloc/BlHeadlessHostSpace.class.st index 08fc48cf6..9a917a92e 100644 --- a/src/Bloc/BlHeadlessHostSpace.class.st +++ b/src/Bloc/BlHeadlessHostSpace.class.st @@ -102,6 +102,12 @@ BlHeadlessHostSpace >> isResizable [ ^ true ] +{ #category : #testing } +BlHeadlessHostSpace >> isValid [ + + ^ true +] + { #category : #'host space - testing' } BlHeadlessHostSpace >> isVisible [ "Return true if underlying window is shown, false otherwise. diff --git a/src/Bloc/BlHost.class.st b/src/Bloc/BlHost.class.st index 6988660e0..c332e093e 100644 --- a/src/Bloc/BlHost.class.st +++ b/src/Bloc/BlHost.class.st @@ -13,6 +13,12 @@ Class { #category : #'Bloc-Universe - Host' } +{ #category : #testing } +BlHost class >> hasUniverse [ + + ^ BlParallelUniverse existsForHost: self +] + { #category : #'api - lifecycle' } BlHost class >> isRunning [ ^ self subclassResponsibility diff --git a/src/Bloc/BlHostPulseLoop.class.st b/src/Bloc/BlHostPulseLoop.class.st index 111fe6014..0b3f84f73 100644 --- a/src/Bloc/BlHostPulseLoop.class.st +++ b/src/Bloc/BlHostPulseLoop.class.st @@ -116,13 +116,13 @@ BlHostPulseLoop >> loopIteration [ [ pulseStartMS := Time millisecondClockValue. - universe := BlParallelUniverse forHost: hostClass. + universe := hostClass universe. universe pulse. pulseDurationMS := Time millisecondClockValue - pulseStartMS. self waitUntilNextPulse. ] on: Exception do: [ :e | - self forceStartNewUIProcess. + self forceStartNewUIProcess. e pass ]. "Returns true to continue looping" diff --git a/src/Bloc/BlParallelUniverse.class.st b/src/Bloc/BlParallelUniverse.class.st index 5cffea24f..bec1078f8 100644 --- a/src/Bloc/BlParallelUniverse.class.st +++ b/src/Bloc/BlParallelUniverse.class.st @@ -5,16 +5,13 @@ I am a parallel Universe. There can exist multiple parallel universes Class { #name : #BlParallelUniverse, #superclass : #Object, - #classTraits : 'TBlEventTarget classTrait', #instVars : [ - 'id', 'deferredActions', 'postponedActions', 'hostClass', - 'spaceManager' + 'spaces' ], #classVars : [ - 'UniqueIdGenerator', 'Universes', 'UniversesMutex' ], @@ -53,9 +50,9 @@ BlParallelUniverse class >> forHost: aHostClass [ { #category : #'class initialization' } BlParallelUniverse class >> initialize [ + Universes := #(). UniversesMutex := Mutex new. - UniqueIdGenerator := BlUniqueIdGenerator new. SessionManager default registerGuiClassNamed: self name ] @@ -79,136 +76,51 @@ BlParallelUniverse >> attachSpace: aSpace [ self defer: [ self attachSpaceSynchronously: aSpace ]. - aSpace host isRunning - ifFalse: [ - (BlParallelUniverseHostStartRequestSignal new - universeId: self id; - spaceId: aSpace id; - host: aSpace host class) emit. - - self startUniverse. - - (BlParallelUniverseHostStartedSignal new - universeId: self id; - spaceId: aSpace id; - host: aSpace host class; - isRunning: aSpace host isRunning) emit ] + aSpace host isRunning ifFalse: [ self startUniverse ] ] { #category : #'private - spaces' } BlParallelUniverse >> attachSpaceSynchronously: aSpace [ - "Synchronously attach a given space to the Universe assuming that the message is sent from within the UI process - of this universe and the space was previously detached from another universe." aSpace isOpened ifTrue: [ ^ self ]. - self - assert: [ aSpace hasHostSpace not ] - description: [ 'Space must not have a host space!' ]. - "First of all we need to add space to the space manager" - spaceManager addSpace: aSpace. - - (BlParallelUniverseSpaceAddedSignal new - universeId: self id; - spaceId: aSpace id) emit. + spaces add: aSpace. "then create and show it in a host space" aSpace host createHostSpaceFor: aSpace. - - (BlParallelUniverseHostSpaceCreatedSignal new - universeId: self id; - spaceId: aSpace id) emit. - - aSpace hostSpace show. - - (BlParallelUniverseHostSpaceShownSignal new - universeId: self id; - spaceId: aSpace id) emit. - - self - assert: [ aSpace hasHostSpace ] - description: [ 'Space must have a host space!' ]. - (BlParallelUniverseSpaceRootAssignedSignal new - universeId: self id; - spaceId: aSpace id) emit. - - (BlParallelUniverseSpaceDispatchAddedToSceneSignal new - universeId: self id; - spaceId: aSpace id) emit + aSpace hostSpace show ] { #category : #'api - spaces' } BlParallelUniverse >> closeSpace: aSpace [ - aSpace isOpened - ifFalse: [ ^ self ]. + + aSpace isOpened ifFalse: [ ^ self ]. self defer: [ self closeSpaceSynchronously: aSpace ] ] { #category : #'private - spaces' } BlParallelUniverse >> closeSpaceSynchronously: aSpace [ - | aHost | - "If space is not even opened we should do nothing" - aSpace isOpened - ifFalse: [ ^ self ]. - - "we have to defer the check to the next frame, otherwise the UI loop may be terminated - before frame finishes" - - "we have to store a reference to the original host because it may potentially change. - for example assume the following: - [[[ - aSpace close. - aSpace host: BlHost pickHost. - aSpace show - ]]] - - the actual termination of the host may happen after a host of the space is changed" - aHost := aSpace host. - - "first remove space itself from space manager, to break any recursions" - spaceManager removeSpace: aSpace. + aSpace isOpened ifFalse: [ ^ self ]. - "then destroy host space" - aSpace hasHostSpace - ifTrue: [ aSpace host destroyHostSpaceFor: aSpace ]. + self detachSpaceSynchronously: aSpace. "Notify root element that it is no longer in scene graph" aSpace dispatchRemovedFromSceneGraph. - - "Raise an event indicating that the space is no longer attached to a universe" - aSpace dispatchEventWithTimestamp: BlSpaceDetachedEvent new. "Send space closed event. - Note: a new space may be spawned as a reaction to the event, that is why - we send it before stopping host and universe" + Note: a new space may be opened as a reaction to the event. That is the reason to defer stopping of host and universe." aSpace dispatchEventWithTimestamp: BlSpaceClosedEvent new. - self - assert: [ aSpace hasHostSpace not ] - description: [ 'Host space must not have a host!' ]. - - (spaceManager hasSpaces not and: [ aHost isRunning ]) - ifTrue: [ - "we must defer host shutdown to let spaces perform actions as a result - of a space closed event" - self defer: [ - "as the last step we may want to stop the host. It may terminate - the current process, so we should do it at last" - (spaceManager hasSpaces not and: [ aHost isRunning ]) - ifTrue: [ self stopUniverse ] ] ]. - - "Raise an event indicating that all normal event for closing a space have been completed. - This event is used by the debugger to stop the UI process. Users should not normally rely - on this event, as there is no guarantee that the process will not be terminated." - aSpace dispatchEventWithTimestamp: BlSpaceDestroyedEvent new + ] { #category : #'api - spaces' } BlParallelUniverse >> closeSpaces [ + self spaces copy do: [ :aSpace | self closeSpace: aSpace ] ] @@ -217,68 +129,47 @@ BlParallelUniverse >> defer: aValuable [ "Enqueue a valuable from any process to be executed in the UI process at the beginning of the next pulse. It is useful to update the UI states." - (BlParallelUniverseDeferredActionAddedSignal new universeId: self id) emit. - deferredActions nextPut: aValuable ] { #category : #'api - spaces' } BlParallelUniverse >> detachSpace: aSpace [ - "Detach a given space from this universe without actually closing the space. Space detaching is useful - for switching hosts and transferring spaces between universes." + "Detach an opened space from this universe without actually closing the space. + Space detaching is useful for switching hosts and transferring spaces between universes." - aSpace isOpened - ifFalse: [ ^ self ]. + aSpace isOpened ifFalse: [ ^ self ]. self defer: [ self detachSpaceSynchronously: aSpace ] ] { #category : #'private - spaces' } BlParallelUniverse >> detachSpaceSynchronously: aSpace [ - "Detaches a given space from this universe without closing that space." | aHost | - "If space is not even opened we should do nothing" - aSpace isOpened - ifFalse: [ ^ self ]. - - "we have to defer the check to the next frame, otherwise the UI loop may be terminated - before frame finishes" - - "we have to store a reference to the original host because it may potentially change. - for example assume the following: - [[[ - aSpace close. - aSpace host: BlHost pickHost. - aSpace show - ]]] - - the actual termination of the host may happen after a host of the space is changed" + aSpace isOpened ifFalse: [ ^ self ]. + + "We have to defer the check to the next frame, otherwise the UI loop may be terminated before frame finishes. + We have to store a reference to the original host because it may potentially change. + Note: the actual termination of the host may happen after a host of the space is changed." aHost := aSpace host. - - "first remove space itself from space manager, to break any recursions" - spaceManager removeSpace: aSpace. - "then destroy host space" - aSpace hasHostSpace - ifTrue: [ aSpace host destroyHostSpaceFor: aSpace ]. + "First, remove the space from space manager, to break any recursion." + spaces remove: aSpace. - self - assert: [ aSpace hasHostSpace not ] - description: [ 'Host space must not have a host!' ]. - - (spaceManager hasSpaces not and: [ aHost isRunning ]) - ifTrue: [ - "we must defer host shutdown to let spaces perform actions as a result - of a space closed event" - self defer: [ - "as the last step we may want to stop the host. It may terminate - the current process, so we should do it at last" - (spaceManager hasSpaces not and: [ aHost isRunning ]) - ifTrue: [ self stopUniverse ] ] ]. - - "Raise an event indicating that the space is no longer attached to a universe" - aSpace dispatchEventWithTimestamp: BlSpaceDetachedEvent new + "Then, destroy host space" + aSpace hasHostSpace ifTrue: [ aSpace host destroyHostSpaceFor: aSpace ]. + + "Dispatch an event indicating that the space is no longer attached to a universe" + aSpace dispatchEventWithTimestamp: BlSpaceDetachedEvent new. + + (spaces isEmpty and: [ aHost isRunning ]) ifTrue: [ + "We must defer host shutdown to let spaces perform actions as a result + of a space closed event" + self defer: [ + "As the last step, we may want to stop the host. It may terminate + the current process, so we should do it at the end." + (spaces isEmpty and: [ aHost isRunning ]) ifTrue: [ + self stopUniverse ] ] ] ] { #category : #testing } @@ -287,19 +178,24 @@ BlParallelUniverse >> hasDeferredActions [ ^ deferredActions isEmpty not ] +{ #category : #testing } +BlParallelUniverse >> hasPostponedActions [ + + ^ postponedActions isEmpty not +] + { #category : #'api - spaces' } BlParallelUniverse >> hasSpace: aSpace [ "Return true if a given space is registered, false otherwise" - - ^ spaceManager hasSpace: aSpace + ^ spaces includes: aSpace ] { #category : #'api - spaces' } BlParallelUniverse >> hasSpaces [ "Return true if there are registered spaces, false otherwise" - ^ spaceManager hasSpaces + ^ spaces isNotEmpty ] { #category : #'api - ui process' } @@ -317,14 +213,8 @@ BlParallelUniverse >> hostClass [ { #category : #accessing } BlParallelUniverse >> hostClass: aHostClass [ - hostClass := aHostClass -] -{ #category : #accessing } -BlParallelUniverse >> id [ - - - ^ id + hostClass := aHostClass ] { #category : #initialization } @@ -332,8 +222,7 @@ BlParallelUniverse >> initialize [ super initialize. - id := UniqueIdGenerator generateUniqueId. - spaceManager := BlSpaceManager new. + spaces := OrderedCollection new. hostClass := BlHeadlessHost. deferredActions := WaitfreeQueue new. postponedActions := WaitfreeQueue new @@ -343,27 +232,9 @@ BlParallelUniverse >> initialize [ BlParallelUniverse >> openSpace: aSpace [ "It should be possible to add a space from the other thread" - (BlParallelUniverseOpenSpaceRequestSignal new - universeId: self id; - spaceId: aSpace id; - isRunning: aSpace host isRunning) emit. - self defer: [ self openSpaceSynchronously: aSpace ]. - aSpace host isRunning - ifFalse: [ - (BlParallelUniverseHostStartRequestSignal new - universeId: self id; - spaceId: aSpace id; - host: aSpace host class) emit. - - self startUniverse. - - (BlParallelUniverseHostStartedSignal new - universeId: self id; - spaceId: aSpace id; - host: aSpace host class; - isRunning: aSpace host isRunning) emit ] + aSpace host isRunning ifFalse: [ self startUniverse ] ] { #category : #'private - spaces' } @@ -374,29 +245,7 @@ BlParallelUniverse >> openSpaceSynchronously: aSpace [ aSpace hostSpace show. ^ self ]. - self - assert: [ aSpace hasHostSpace not ] - description: [ 'Space must not have a host space!' ]. - - "First of all we need to add space to the space manager" - spaceManager addSpace: aSpace. - - (BlParallelUniverseSpaceAddedSignal new - universeId: self id; - spaceId: aSpace id) emit. - - "then create and show it in a host space" - aSpace host createHostSpaceFor: aSpace. - - (BlParallelUniverseHostSpaceCreatedSignal new - universeId: self id; - spaceId: aSpace id) emit. - - aSpace hostSpace show. - - (BlParallelUniverseHostSpaceShownSignal new - universeId: self id; - spaceId: aSpace id) emit. + self attachSpaceSynchronously: aSpace. "Note: we should send shown event after everything else is done, because theoretically, that only space could be closed as a reaction to the event" @@ -405,15 +254,7 @@ BlParallelUniverse >> openSpaceSynchronously: aSpace [ "Notify root element that it is now visible to the user" aSpace becomeVisible. - (BlParallelUniverseSpaceRootAssignedSignal new - universeId: self id; - spaceId: aSpace id) emit. - - aSpace dispatchAddedToSceneGraph. - - (BlParallelUniverseSpaceDispatchAddedToSceneSignal new - universeId: self id; - spaceId: aSpace id) emit + aSpace dispatchAddedToSceneGraph ] { #category : #'api - ui process' } @@ -425,6 +266,16 @@ BlParallelUniverse >> postpone: aValuable [ postponedActions nextPut: aValuable ] +{ #category : #printing } +BlParallelUniverse >> printOn: aStream [ + + super printOn: aStream. + aStream + nextPut: $(; + nextPutAll: hostClass asString; + nextPut: $) +] + { #category : #pulse } BlParallelUniverse >> pulse [ @@ -437,12 +288,12 @@ BlParallelUniverse >> pulseSynchronously [ [ self tryToRunDeferredActions. - spaceManager do: [ :eachSpace | eachSpace pulse ]. + spaces do: [ :eachSpace | eachSpace pulse ]. self tryToRunPostponedActions ] on: Exception do: [ :e | - (BlParallelUniverseErrorDuringPulse new + (BlParallelUniverseErrorDuringPulseSignal new signaledError: e; yourself) emit. e pass ] @@ -457,7 +308,7 @@ BlParallelUniverse >> snapshot: save andQuit: quit [ { #category : #'api - spaces' } BlParallelUniverse >> spaces [ - ^ spaceManager spaces + ^ spaces ] { #category : #'private - lifecycle' } @@ -466,7 +317,7 @@ BlParallelUniverse >> startUniverse [ I am called outside of the UI loop (there is no UI loop yet)" hostClass start. - spaceManager start + spaces do: [ :aSpace | aSpace ensureWindowOpen ] ] { #category : #'private - lifecycle' } @@ -475,36 +326,29 @@ BlParallelUniverse >> stopUniverse [ I am called from the UI loop" hostClass stop. - spaceManager stop + spaces do: [ :anSpace | anSpace rememberVisibleStatus ] ] { #category : #'deferred message' } BlParallelUniverse >> tryToRunDeferredActions [ | nextInQueue | - (BlParallelUniverseTryToRunDeferredActionsSignal new - universeId: self id; - yourself) emit. - [ (nextInQueue := deferredActions nextOrNil) isNotNil ] whileTrue: [ - - (BlParallelUniverseRunDeferredActionSignal new - universeId: self id; - yourself) emit. - - nextInQueue value ] + [ (nextInQueue := deferredActions nextOrNil) isNotNil ] + whileTrue: [ nextInQueue value ] ] { #category : #'deferred message' } BlParallelUniverse >> tryToRunPostponedActions [ | nextInQueue | - [ (nextInQueue := postponedActions nextOrNil) isNotNil ] whileTrue: [ - nextInQueue value ] + + [ (nextInQueue := postponedActions nextOrNil) isNotNil ] + whileTrue: [ nextInQueue value ] ] { #category : #'api - ui process' } BlParallelUniverse >> uiProcessDo: aBlock [ - self hostClass uiProcessDo: aBlock + hostClass uiProcessDo: aBlock ] diff --git a/src/Bloc/BlParallelUniverseDeferredActionAddedSignal.class.st b/src/Bloc/BlParallelUniverseDeferredActionAddedSignal.class.st deleted file mode 100644 index e699598d5..000000000 --- a/src/Bloc/BlParallelUniverseDeferredActionAddedSignal.class.st +++ /dev/null @@ -1,24 +0,0 @@ -" -I am sent when a there was a deferred action added to the universe using `defer:` - -" -Class { - #name : #BlParallelUniverseDeferredActionAddedSignal, - #superclass : #BlParallelUniverseSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseDeferredActionAddedSignal class >> isRepeatable [ - ^ true -] - -{ #category : #accessing } -BlParallelUniverseDeferredActionAddedSignal class >> label [ - ^ 'Add deferred action' -] - -{ #category : #accessing } -BlParallelUniverseDeferredActionAddedSignal class >> nextSignals [ - ^ { BlParallelUniverseHostStartRequestSignal . BlParallelUniverseTryToRunDeferredActionsSignal } -] diff --git a/src/Bloc/BlParallelUniverseErrorDuringPulse.class.st b/src/Bloc/BlParallelUniverseErrorDuringPulseSignal.class.st similarity index 58% rename from src/Bloc/BlParallelUniverseErrorDuringPulse.class.st rename to src/Bloc/BlParallelUniverseErrorDuringPulseSignal.class.st index 4ff82a1db..99198abdf 100644 --- a/src/Bloc/BlParallelUniverseErrorDuringPulse.class.st +++ b/src/Bloc/BlParallelUniverseErrorDuringPulseSignal.class.st @@ -3,8 +3,8 @@ I am a signal that is raised when there is an error in the pulse. I include in myself the signaledError. " Class { - #name : #BlParallelUniverseErrorDuringPulse, - #superclass : #BlParallelUniverseSignal, + #name : #BlParallelUniverseErrorDuringPulseSignal, + #superclass : #BeaconSignal, #instVars : [ 'signaledError' ], @@ -12,13 +12,13 @@ Class { } { #category : #accessing } -BlParallelUniverseErrorDuringPulse >> signaledError [ +BlParallelUniverseErrorDuringPulseSignal >> signaledError [ ^ signaledError ] { #category : #accessing } -BlParallelUniverseErrorDuringPulse >> signaledError: anObject [ +BlParallelUniverseErrorDuringPulseSignal >> signaledError: anObject [ signaledError := anObject ] diff --git a/src/Bloc/BlParallelUniverseHostSpaceCreatedSignal.class.st b/src/Bloc/BlParallelUniverseHostSpaceCreatedSignal.class.st deleted file mode 100644 index 8917d7052..000000000 --- a/src/Bloc/BlParallelUniverseHostSpaceCreatedSignal.class.st +++ /dev/null @@ -1,19 +0,0 @@ -" -Is sent after a host space was created and assigned to the space - -" -Class { - #name : #BlParallelUniverseHostSpaceCreatedSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseHostSpaceCreatedSignal class >> label [ - ^ 'Create space host' -] - -{ #category : #accessing } -BlParallelUniverseHostSpaceCreatedSignal class >> nextSignals [ - ^ { BlParallelUniverseHostSpaceShownSignal } -] diff --git a/src/Bloc/BlParallelUniverseHostSpaceShownSignal.class.st b/src/Bloc/BlParallelUniverseHostSpaceShownSignal.class.st deleted file mode 100644 index 5b3597dcb..000000000 --- a/src/Bloc/BlParallelUniverseHostSpaceShownSignal.class.st +++ /dev/null @@ -1,19 +0,0 @@ -" -Is sent after a host space is shown - -" -Class { - #name : #BlParallelUniverseHostSpaceShownSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseHostSpaceShownSignal class >> label [ - ^ 'Show space host' -] - -{ #category : #accessing } -BlParallelUniverseHostSpaceShownSignal class >> nextSignals [ - ^ { BlParallelUniverseSpaceRootAssignedSignal } -] diff --git a/src/Bloc/BlParallelUniverseHostStartRequestSignal.class.st b/src/Bloc/BlParallelUniverseHostStartRequestSignal.class.st deleted file mode 100644 index 6b4daef18..000000000 --- a/src/Bloc/BlParallelUniverseHostStartRequestSignal.class.st +++ /dev/null @@ -1,34 +0,0 @@ -" -I am sent when a universe requests a host to start - -" -Class { - #name : #BlParallelUniverseHostStartRequestSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #instVars : [ - 'host' - ], - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseHostStartRequestSignal class >> label [ - ^ 'Request host start' -] - -{ #category : #accessing } -BlParallelUniverseHostStartRequestSignal class >> nextSignals [ - ^ { BlParallelUniverseHostStartedSignal } -] - -{ #category : #accessing } -BlParallelUniverseHostStartRequestSignal >> host [ - - - ^ host -] - -{ #category : #accessing } -BlParallelUniverseHostStartRequestSignal >> host: aBlHostClass [ - host := aBlHostClass -] diff --git a/src/Bloc/BlParallelUniverseHostStartedSignal.class.st b/src/Bloc/BlParallelUniverseHostStartedSignal.class.st deleted file mode 100644 index fb74c37e4..000000000 --- a/src/Bloc/BlParallelUniverseHostStartedSignal.class.st +++ /dev/null @@ -1,45 +0,0 @@ -" -I am sent when a universe started a host - -" -Class { - #name : #BlParallelUniverseHostStartedSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #instVars : [ - 'host', - 'isRunning' - ], - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseHostStartedSignal class >> label [ - ^ 'Start host' -] - -{ #category : #accessing } -BlParallelUniverseHostStartedSignal class >> nextSignals [ - ^ { BlParallelUniverseTryToRunDeferredActionsSignal } -] - -{ #category : #accessing } -BlParallelUniverseHostStartedSignal >> host [ - - - ^ host -] - -{ #category : #accessing } -BlParallelUniverseHostStartedSignal >> host: aBlHostClass [ - host := aBlHostClass -] - -{ #category : #accessing } -BlParallelUniverseHostStartedSignal >> isRunning [ - ^ isRunning -] - -{ #category : #accessing } -BlParallelUniverseHostStartedSignal >> isRunning: anObject [ - isRunning := anObject -] diff --git a/src/Bloc/BlParallelUniverseOpenSpaceRequestSignal.class.st b/src/Bloc/BlParallelUniverseOpenSpaceRequestSignal.class.st deleted file mode 100644 index 6956ce8cb..000000000 --- a/src/Bloc/BlParallelUniverseOpenSpaceRequestSignal.class.st +++ /dev/null @@ -1,32 +0,0 @@ -" -Is signalled when someone requests a universe to open a space. - -" -Class { - #name : #BlParallelUniverseOpenSpaceRequestSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #instVars : [ - 'isRunning' - ], - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseOpenSpaceRequestSignal class >> label [ - ^ 'Request open space' -] - -{ #category : #accessing } -BlParallelUniverseOpenSpaceRequestSignal class >> nextSignals [ - ^ { BlParallelUniverseDeferredActionAddedSignal } -] - -{ #category : #accessing } -BlParallelUniverseOpenSpaceRequestSignal >> isRunning [ - ^ isRunning -] - -{ #category : #accessing } -BlParallelUniverseOpenSpaceRequestSignal >> isRunning: anObject [ - isRunning := anObject -] diff --git a/src/Bloc/BlParallelUniverseRunDeferredActionSignal.class.st b/src/Bloc/BlParallelUniverseRunDeferredActionSignal.class.st deleted file mode 100644 index 106148585..000000000 --- a/src/Bloc/BlParallelUniverseRunDeferredActionSignal.class.st +++ /dev/null @@ -1,24 +0,0 @@ -" -Is sent when a universe performed a deferred action - -" -Class { - #name : #BlParallelUniverseRunDeferredActionSignal, - #superclass : #BlParallelUniverseSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseRunDeferredActionSignal class >> isRepeatable [ - ^ true -] - -{ #category : #accessing } -BlParallelUniverseRunDeferredActionSignal class >> label [ - ^ 'Run deferred action' -] - -{ #category : #accessing } -BlParallelUniverseRunDeferredActionSignal class >> nextSignals [ - ^ { BlParallelUniverseRunDeferredActionSignal . BlParallelUniverseSpaceAddedSignal } -] diff --git a/src/Bloc/BlParallelUniverseSignal.class.st b/src/Bloc/BlParallelUniverseSignal.class.st deleted file mode 100644 index d1af00756..000000000 --- a/src/Bloc/BlParallelUniverseSignal.class.st +++ /dev/null @@ -1,41 +0,0 @@ -Class { - #name : #BlParallelUniverseSignal, - #superclass : #BeaconSignal, - #instVars : [ - 'universeId' - ], - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #testing } -BlParallelUniverseSignal class >> isAbstract [ - ^ self = BlParallelUniverseSignal -] - -{ #category : #accessing } -BlParallelUniverseSignal class >> isRepeatable [ - "Return true if this signal is expected to be emitted regularly" - - ^ false -] - -{ #category : #accessing } -BlParallelUniverseSignal class >> label [ - ^ self subclassResponsibility -] - -{ #category : #accessing } -BlParallelUniverseSignal class >> nextSignals [ - "Return a collection of possible signals after this one" - ^ #() -] - -{ #category : #accessing } -BlParallelUniverseSignal >> universeId [ - ^ universeId -] - -{ #category : #accessing } -BlParallelUniverseSignal >> universeId: aNumber [ - universeId := aNumber -] diff --git a/src/Bloc/BlParallelUniverseSpaceAddedSignal.class.st b/src/Bloc/BlParallelUniverseSpaceAddedSignal.class.st deleted file mode 100644 index b4e323c36..000000000 --- a/src/Bloc/BlParallelUniverseSpaceAddedSignal.class.st +++ /dev/null @@ -1,19 +0,0 @@ -" -Is sent when a space was added to the space manager in a universe - -" -Class { - #name : #BlParallelUniverseSpaceAddedSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseSpaceAddedSignal class >> label [ - ^ 'Add space' -] - -{ #category : #accessing } -BlParallelUniverseSpaceAddedSignal class >> nextSignals [ - ^ { BlParallelUniverseHostSpaceCreatedSignal } -] diff --git a/src/Bloc/BlParallelUniverseSpaceDispatchAddedToSceneSignal.class.st b/src/Bloc/BlParallelUniverseSpaceDispatchAddedToSceneSignal.class.st deleted file mode 100644 index b3f1ea694..000000000 --- a/src/Bloc/BlParallelUniverseSpaceDispatchAddedToSceneSignal.class.st +++ /dev/null @@ -1,14 +0,0 @@ -" -Is sent after we let children know that they were added to the scene graph - -" -Class { - #name : #BlParallelUniverseSpaceDispatchAddedToSceneSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseSpaceDispatchAddedToSceneSignal class >> label [ - ^ 'Dispatch added to scene graph' -] diff --git a/src/Bloc/BlParallelUniverseSpaceRootAssignedSignal.class.st b/src/Bloc/BlParallelUniverseSpaceRootAssignedSignal.class.st deleted file mode 100644 index 3e283ef4f..000000000 --- a/src/Bloc/BlParallelUniverseSpaceRootAssignedSignal.class.st +++ /dev/null @@ -1,19 +0,0 @@ -" -Is sent after a space is attached to the root - -" -Class { - #name : #BlParallelUniverseSpaceRootAssignedSignal, - #superclass : #BlParallelUniverseSpaceSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseSpaceRootAssignedSignal class >> label [ - ^ 'Assign space to root element' -] - -{ #category : #accessing } -BlParallelUniverseSpaceRootAssignedSignal class >> nextSignals [ - ^ { BlParallelUniverseSpaceDispatchAddedToSceneSignal } -] diff --git a/src/Bloc/BlParallelUniverseSpaceSignal.class.st b/src/Bloc/BlParallelUniverseSpaceSignal.class.st deleted file mode 100644 index 0a1f00f0f..000000000 --- a/src/Bloc/BlParallelUniverseSpaceSignal.class.st +++ /dev/null @@ -1,25 +0,0 @@ -Class { - #name : #BlParallelUniverseSpaceSignal, - #superclass : #BlParallelUniverseSignal, - #instVars : [ - 'spaceId' - ], - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #testing } -BlParallelUniverseSpaceSignal class >> isAbstract [ - ^ self = BlParallelUniverseSpaceSignal -] - -{ #category : #accessing } -BlParallelUniverseSpaceSignal >> spaceId [ - - - ^ spaceId -] - -{ #category : #accessing } -BlParallelUniverseSpaceSignal >> spaceId: aNumber [ - spaceId := aNumber -] diff --git a/src/Bloc/BlParallelUniverseTryToRunDeferredActionsSignal.class.st b/src/Bloc/BlParallelUniverseTryToRunDeferredActionsSignal.class.st deleted file mode 100644 index 2bc3931d6..000000000 --- a/src/Bloc/BlParallelUniverseTryToRunDeferredActionsSignal.class.st +++ /dev/null @@ -1,24 +0,0 @@ -" -Is sent when a universe tries to run deferred actions - -" -Class { - #name : #BlParallelUniverseTryToRunDeferredActionsSignal, - #superclass : #BlParallelUniverseSignal, - #category : #'Bloc-Universe - Parallel' -} - -{ #category : #accessing } -BlParallelUniverseTryToRunDeferredActionsSignal class >> isRepeatable [ - ^ true -] - -{ #category : #accessing } -BlParallelUniverseTryToRunDeferredActionsSignal class >> label [ - ^ 'Try to run deferred actions' -] - -{ #category : #accessing } -BlParallelUniverseTryToRunDeferredActionsSignal class >> nextSignals [ - ^ { BlParallelUniverseRunDeferredActionSignal } -] diff --git a/src/Bloc/BlSpace.class.st b/src/Bloc/BlSpace.class.st index c4a575082..e0ca8505c 100644 --- a/src/Bloc/BlSpace.class.st +++ b/src/Bloc/BlSpace.class.st @@ -22,7 +22,6 @@ Class { #traits : 'TBlEventTarget + TBlSpaceProperties + TBlDebug', #classTraits : 'TBlEventTarget classTrait + TBlSpaceProperties classTrait + TBlDebug classTrait', #instVars : [ - 'id', 'host', 'hostSpace', 'extent', @@ -37,7 +36,7 @@ Class { 'keyboardProcessor', 'focusChain', 'dragboard', - 'nextPulseRequested', + 'pulseRequested', 'currentCursor', 'session', 'focused', @@ -56,9 +55,6 @@ Class { 'userData', 'previousVisibleStatus' ], - #classVars : [ - 'UniqueIdGenerator' - ], #category : #'Bloc-Space' } @@ -83,11 +79,6 @@ BlSpace class >> extractRoots: aSetOfElements [ ^ roots ] -{ #category : #'class initialization' } -BlSpace class >> initialize [ - UniqueIdGenerator := BlUniqueIdGenerator new -] - { #category : #'debug - simulation' } BlSpace class >> locationInside: anElement [ "Return a random space location outside of element bounds" @@ -347,8 +338,11 @@ BlSpace class >> simulateEvents: aCollectionOfEvents on: anElement [ anEvent timestamp: aSpace time now ]. aSpace pulse. - aCollectionOfEvents do: [ :anEvent | aSpace dispatchEvent: anEvent ]. - aSpace dispatchEvent: BlSpaceEventsProcessedEvent new. + aSpace + dispatchTimeEvent: BlSpaceEventsProcessedEvent + during: [ + aCollectionOfEvents do: [ :anEvent | + aSpace dispatchEvent: anEvent ] ]. aSpace pulse. topMostElement ifNotNil: [ topMostElement removeFromParent ] @@ -508,14 +502,6 @@ BlSpace class >> simulateTextInput: aString on: aBlElement [ on: aBlElement ] -{ #category : #'class initialization' } -BlSpace class >> spaceWithId: aSpaceId do: aBlock [ - ^ self allSubInstances - detect: [ :eachSpace | eachSpace id = aSpaceId ] - ifFound: aBlock - ifNone: [ nil ] -] - { #category : #accessing } BlSpace >> asReference [ @@ -559,9 +545,10 @@ BlSpace >> clearDirtyElements [ { #category : #'api - displaying' } BlSpace >> close [ - "Delegate closing work to the Universe" + "Request closing this space. This might happen in a host process (async). + This space can be reopened via `show`, either with current host or with another host." - (BlParallelUniverse forHost: self host class) closeSpace: self + host universe closeSpace: self ] { #category : #'cursor managing' } @@ -686,8 +673,8 @@ BlSpace >> dispatchTimeEvent: aSpacePhaseEventClass during: aBlock [ | aStartTime | aStartTime := self time now. - aBlock cull: self. - self eventDispatcher dispatchEvent: + aBlock value. + self dispatchEvent: (aSpacePhaseEventClass new start: aStartTime; end: self time now; @@ -913,28 +900,6 @@ BlSpace >> extent: aNewExtent [ self windowExtent: aNewExtent ] -{ #category : #'NOT-USED-private-change' } -BlSpace >> extractAttachedElements: aSetOfElements [ - ^ aSetOfElements select: [ :eachElement | - eachElement isAttachedToSceneGraph - and: [ eachElement space == self ] ] -] - -{ #category : #'NOT-USED-private-change' } -BlSpace >> extractParents: aSetOfElements suchThat: aConditionBlock [ - | theElementToProcess | - - theElementToProcess := Set new. - - aSetOfElements do: [ :eachElement | - eachElement - topMostParentSuchThat: aConditionBlock - ifFound: [ :aNotYetResolvedParent | theElementToProcess add: aNotYetResolvedParent ] - ifNone: [ theElementToProcess add: eachElement ] ]. - - ^ theElementToProcess -] - { #category : #'private - change' } BlSpace >> extractRoots: aSetOfElements [ ^ self class extractRoots: aSetOfElements @@ -1110,20 +1075,17 @@ BlSpace >> host [ { #category : #'host space - accessing' } BlSpace >> host: aHost [ "Change the host of this space. Asynchronous. If the space is opened, first destroy the host window and then open the space with a new host" - | aDetachedEventHandler | - - aDetachedEventHandler := nil. - - aDetachedEventHandler := BlEventHandler - on: BlSpaceDetachedEvent - do: [ :anEvent | - self removeEventHandler: aDetachedEventHandler. - host := aHost. - self universe attachSpace: self ]. self isOpened - ifTrue: [ self universe detachSpace: self ] ifFalse: [ host := aHost ] + ifTrue: [ + self + addEventHandlerOn: BlSpaceDetachedEvent + doOnce: [ + host := aHost. + self universe attachSpace: self ]. + + self universe detachSpace: self ] ] { #category : #'host space - accessing' } @@ -1183,27 +1145,13 @@ BlSpace >> icon: aStencil [ self fireEvent: (BlSpaceIconChangedEvent new iconStencil: aStencil) ] -{ #category : #accessing } -BlSpace >> id [ - - - ^ id -] - -{ #category : #initialization } -BlSpace >> initDispatcher [ - self eventDispatcher addEventFilter: self eventListener -] - { #category : #initialization } BlSpace >> initialize [ super initialize. - id := UniqueIdGenerator generateUniqueId. - host := BlHost pickHost. - nextPulseRequested := true. + pulseRequested := true. session := Smalltalk session. elementsNeedingPaint := Set new. elementsNeedingLayout := Set new. @@ -1214,7 +1162,7 @@ BlSpace >> initialize [ eventDispatcher := self defaultEventDispatcher. eventListener := self defaultEventListener. - self initDispatcher. + eventDispatcher addEventFilter: eventListener. mouseProcessor := BlMouseProcessor space: self. focusProcessor := BlFocusProcessor space: self. @@ -1321,10 +1269,16 @@ BlSpace >> isLayoutRequested [ BlSpace >> isOpened [ "Return true if the space was shown (by sending #show message), false otherwise. Please note, that an opened space can be hidden which does not influence the result of #isOpened" - - ^ (BlParallelUniverse existsForHost: self host class) - and: [ (BlParallelUniverse forHost: self host class) hasSpace: self ] + ^ (self host class hasUniverse) + and: [ self universe hasSpace: self ] +] + +{ #category : #pulse } +BlSpace >> isPulseRequested [ + "Return true if space pulse was requested, false otherwise" + + ^ pulseRequested ] { #category : #'window - properties' } @@ -1476,13 +1430,14 @@ BlSpace >> printOn: aStream [ { #category : #pulse } BlSpace >> processPulse [ + self ensureSession. - - self pulseRequested - ifFalse: [ ^ self ]. - + + pulseRequested ifFalse: [ ^ self ]. + "flip to false beforehand to be able to know if the next pulse was needed during the frame" - nextPulseRequested := false. + pulseRequested := false. + self frame runOn: self ] @@ -1491,13 +1446,17 @@ BlSpace >> pulse [ self processPulse ] -{ #category : #'change - rendering' } +{ #category : #pulse } BlSpace >> pulseRequested [ - "Return true if space pulse was requested, false otherwise" - - ^ nextPulseRequested + self + deprecated: 'Use #isPulseRequested instead' + transformWith: + '`@receiver pulseRequested' + -> '`@receiver isPulseRequested'. + + ^ self isPulseRequested ] { #category : #'startup - shutdown' } @@ -1539,10 +1498,10 @@ BlSpace >> requestLayout: anElement [ self requestNextPulse ] -{ #category : #'change - rendering' } +{ #category : #pulse } BlSpace >> requestNextPulse [ - nextPulseRequested := true + pulseRequested := true ] { #category : #'window - properties' } @@ -1624,10 +1583,9 @@ BlSpace >> setPosition: aPoint [ { #category : #'api - displaying' } BlSpace >> show [ - "Open me in a window and show it to the user" + "Show this space to the user, using current host and other parameters such as extent, title, etc." - "delegate showing work to the Universe" - (BlParallelUniverse forHost: self host class) openSpace: self + self universe openSpace: self ] { #category : #'api - displaying' } @@ -1724,9 +1682,8 @@ BlSpace >> ungrabFocus [ { #category : #accessing } BlSpace >> universe [ - - ^ BlParallelUniverse forHost: self host class + ^ self host universe ] { #category : #'cursor managing' } diff --git a/src/Bloc/BlSpaceDestroyedEvent.class.st b/src/Bloc/BlSpaceDestroyedEvent.class.st deleted file mode 100644 index c8209166d..000000000 --- a/src/Bloc/BlSpaceDestroyedEvent.class.st +++ /dev/null @@ -1,11 +0,0 @@ -" -I am an event raised when all normal events for closing a space have been completed. - -This event is used by the debugger to stop the UI process so it should be used with case. For reacting to the closing of a space `BlSpaceClosedEvent` should be used instead. - -" -Class { - #name : #BlSpaceDestroyedEvent, - #superclass : #BlSpaceEvent, - #category : #'Bloc-Events-Type-Space' -} diff --git a/src/Bloc/BlSpaceFrameDrawingPhase.class.st b/src/Bloc/BlSpaceFrameDrawingPhase.class.st index 3ceb976c0..cf95aec4b 100644 --- a/src/Bloc/BlSpaceFrameDrawingPhase.class.st +++ b/src/Bloc/BlSpaceFrameDrawingPhase.class.st @@ -19,6 +19,5 @@ BlSpaceFrameDrawingPhase >> runOn: aSpace [ aSpace dispatchTimeEvent: BlSpaceRenderEndEvent - during: [ :theSpace | - BlSpaceRenderSignal for: theSpace block: [ theSpace render ] ] + during: [ aSpace render ] ] diff --git a/src/Bloc/BlSpaceFrameEventPhase.class.st b/src/Bloc/BlSpaceFrameEventPhase.class.st index f01a5b9c1..abc692e81 100644 --- a/src/Bloc/BlSpaceFrameEventPhase.class.st +++ b/src/Bloc/BlSpaceFrameEventPhase.class.st @@ -19,20 +19,17 @@ BlSpaceFrameEventPhase >> runOn: aSpace [ aSpace dispatchTimeEvent: BlSpaceEventsProcessedEvent - during: [ :theSpace | - "We must update focused element before processing events, otherwise keyboard events, - for example, will be handled by the wrong element" + during: [ + "We must update focused element before processing events, otherwise keyboard events, for example, will be handled by the wrong element" aSpace doUpdateFocus. "Process events enqueued by host space and dispatch them to the scene graph" - theSpace hostSpaceDo: [ :aHostSpace | + aSpace hostSpaceDo: [ :aHostSpace | aHostSpace fetchedEventsDo: [ :anEvent | - "we have to test for existance of the host space before handling each event because - it is possible that a space is closed due to an event" - - theSpace hostSpaceDo: [ - theSpace eventDispatcher dispatchEvent: anEvent ] ] ]. - - theSpace hostSpaceDo: [ :aHostSpace | aHostSpace generateEvents ]. - theSpace mouseProcessor generateEvents ] + "we have to test for existance of the host space before handling each event because it is possible that a space is closed due to an event" + aSpace hostSpaceDo: [ + aSpace dispatchEvent: anEvent ] ] ]. + + aSpace hostSpaceDo: [ :aHostSpace | aHostSpace generateEvents ]. + aSpace mouseProcessor generateEvents ] ] diff --git a/src/Bloc/BlSpaceFrameLayoutPhase.class.st b/src/Bloc/BlSpaceFrameLayoutPhase.class.st index 066a2f852..85fb96ee1 100644 --- a/src/Bloc/BlSpaceFrameLayoutPhase.class.st +++ b/src/Bloc/BlSpaceFrameLayoutPhase.class.st @@ -19,5 +19,5 @@ BlSpaceFrameLayoutPhase >> runOn: aSpace [ aSpace dispatchTimeEvent: BlSpaceLayoutEndEvent - during: [ :theSpace | theSpace doLayout ] + during: [ aSpace doLayout ] ] diff --git a/src/Bloc/BlSpaceFrameTaskPhase.class.st b/src/Bloc/BlSpaceFrameTaskPhase.class.st index fcefe78d8..ab50e94f0 100644 --- a/src/Bloc/BlSpaceFrameTaskPhase.class.st +++ b/src/Bloc/BlSpaceFrameTaskPhase.class.st @@ -20,5 +20,5 @@ BlSpaceFrameTaskPhase >> runOn: aSpace [ aSpace dispatchTimeEvent: BlSpaceTasksEndEvent - during: [ :theSpace | theSpace runTasks ] + during: [ aSpace runTasks ] ] diff --git a/src/Bloc/BlSpaceManager.class.st b/src/Bloc/BlSpaceManager.class.st deleted file mode 100644 index c63eb2f97..000000000 --- a/src/Bloc/BlSpaceManager.class.st +++ /dev/null @@ -1,105 +0,0 @@ -" -I am a `BlUniverse` space manager. - -I contain Bloc `BlSpace|label=spaces` which can be added or removed. I am also responsible for sending pulses (tick) messages to my `BlSpace|label=spaces`. - -I am used by `BlUniverse` so that it can support multiple `BlSpace|label=spaces`. -Here are some of my core operations: -- `BlSpaceManager>>#addSpace:` -- `BlSpaceManager>>#removeSpace:` -- `BlSpaceManager>>#pulse` - send a pulse message to all spaces - -" -Class { - #name : #BlSpaceManager, - #superclass : #Object, - #traits : 'TBlDebug', - #classTraits : 'TBlDebug classTrait', - #instVars : [ - 'spaces' - ], - #category : #'Bloc-Universe' -} - -{ #category : #adding } -BlSpaceManager >> addSpace: aSpace [ - - self - assert: [ (spaces includes: aSpace) not ] - description: [ 'Can not add space that is already managed!' ]. - - spaces := spaces copyWith: aSpace -] - -{ #category : #enumerating } -BlSpaceManager >> do: aBlock [ - self spaces do: aBlock -] - -{ #category : #testing } -BlSpaceManager >> hasSpace: aSpace [ - "Return true if a given space is registered, false otherwise" - - - ^ self spaces includes: aSpace -] - -{ #category : #testing } -BlSpaceManager >> hasSpaces [ - "Return true if there are registered spaces, false otherwise" - - ^ self spaces isNotEmpty -] - -{ #category : #initialization } -BlSpaceManager >> initialize [ - super initialize. - - spaces := #() -] - -{ #category : #printing } -BlSpaceManager >> printOn: aStream [ - - super printOn: aStream. - aStream - nextPut: $(; - print: spaces size; - nextPut: $) - -] - -{ #category : #pulse } -BlSpaceManager >> pulse [ - spaces do: [ :aSpace | aSpace pulse ] -] - -{ #category : #adding } -BlSpaceManager >> removeSpace: aSpace [ - - self - assert: [ spaces includes: aSpace ] - description: [ 'Can not remove space that is not managed!' ]. - - spaces := spaces copyWithout: aSpace -] - -{ #category : #accessing } -BlSpaceManager >> spaces [ - "Return a collection of all existing 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/Bloc/BlSpaceRenderSignal.class.st b/src/Bloc/BlSpaceRenderSignal.class.st deleted file mode 100644 index 52c7a158e..000000000 --- a/src/Bloc/BlSpaceRenderSignal.class.st +++ /dev/null @@ -1,127 +0,0 @@ -" -BlSpaceRenderSignal is used to record the start and end times of space rendering. These can then be analysed and spaces that are slow, and thus are significantly impacting the frame rate, identified. - - -Public API and Key Messages - -- message one -- message two -- (for bonus points) how to create instances. - - One simple example is simply gorgeous. - -Internal Representation and Key Implementation Points. - - Instance Variables - space: - - - Implementation Points - -" -Class { - #name : #BlSpaceRenderSignal, - #superclass : #BeaconSignal, - #instVars : [ - 'space', - 'action' - ], - #classVars : [ - 'Ignore' - ], - #category : #'Bloc-Space - Support' -} - -{ #category : #filtering } -BlSpaceRenderSignal class >> dontIgnore [ - - Ignore := false. -] - -{ #category : #'instance creation' } -BlSpaceRenderSignal class >> endSpace: aSpace [ - - ^self new - space: aSpace; - action: #end; - emit -] - -{ #category : #'instance creation' } -BlSpaceRenderSignal class >> for: aSpace block: aBlock [ - - Ignore == false ifFalse: - [ ^aBlock value ]. - self startSpace: aSpace. - aBlock value. - self endSpace: aSpace. -] - -{ #category : #filtering } -BlSpaceRenderSignal class >> ignore [ - "Don't emit the signal" - - Ignore := true. -] - -{ #category : #'instance creation' } -BlSpaceRenderSignal class >> startSpace: aSpace [ - - ^self new - space: aSpace; - action: #start; - emit -] - -{ #category : #accessing } -BlSpaceRenderSignal >> action [ - ^ action -] - -{ #category : #accessing } -BlSpaceRenderSignal >> action: anObject [ - action := anObject -] - -{ #category : #'ston persistence' } -BlSpaceRenderSignal >> asDictionary [ - - | spaceSton | - - spaceSton := String streamContents: [ :stream | - stream - print: space identityHash; - << '-'; - print: space ]. - ^super asDictionary - at: #space put: spaceSton; - at: #action put: action; - yourself. -] - -{ #category : #printing } -BlSpaceRenderSignal >> printOneLineContentsOn: stream [ - - stream - print: action; - << ': '; - print: space. - -] - -{ #category : #accessing } -BlSpaceRenderSignal >> space [ - ^ space -] - -{ #category : #accessing } -BlSpaceRenderSignal >> space: anObject [ - space := anObject -] - -{ #category : #accessing } -BlSpaceRenderSignal >> target [ - "Answer the object that is the target of this signal" - - ^space -] diff --git a/src/Bloc/BlTask.class.st b/src/Bloc/BlTask.class.st index 844911b07..ccaeb0594 100644 --- a/src/Bloc/BlTask.class.st +++ b/src/Bloc/BlTask.class.st @@ -22,34 +22,17 @@ Class { #traits : 'TBlDebug', #classTraits : 'TBlDebug classTrait', #instVars : [ - 'id', 'state' ], - #classVars : [ - 'UniqueIdGenerator' - ], #category : #'Bloc-Space - Tasks' } -{ #category : #'class initialization' } -BlTask class >> initialize [ - UniqueIdGenerator := BlUniqueIdGenerator new -] - -{ #category : #accessing } -BlTask >> id [ - "Return a unique id of this task" - - - ^ id -] - { #category : #initialization } BlTask >> initialize [ + super initialize. - - id := UniqueIdGenerator generateUniqueId. - state := #new. + + state := #new ] { #category : #'private - state' } @@ -61,7 +44,7 @@ BlTask >> isComplete [ { #category : #'private - state' } BlTask >> isExecuting [ - ^ state = #executing + ^ state == #executing ] { #category : #'private - state' } @@ -122,19 +105,19 @@ BlTask >> setExecuting [ { #category : #'private - state' } BlTask >> setNew [ - state := #new. + state := #new ] { #category : #'private - state' } BlTask >> setPendingExecution [ - state := #pendingExecution. + state := #pendingExecution ] { #category : #'private - state' } BlTask >> setQueued [ - state := #queued. + state := #queued ] { #category : #'api - running' } diff --git a/src/Bloc/BlTaskAtErrorSignal.class.st b/src/Bloc/BlTaskAtErrorSignal.class.st deleted file mode 100644 index 789343dc5..000000000 --- a/src/Bloc/BlTaskAtErrorSignal.class.st +++ /dev/null @@ -1,56 +0,0 @@ -" -BlTaskAtErrorSignal is used when BlTaskAtQueue encounters an error during execution. - -- If the error occurs while evaluating a task the task is set. -- In all cases a message and the exception is set. - -## Internal Representation and Key Implementation Points. - -### Instance Variables - - exception: the exception encountered during execution - message: a message about where the error was encountered - task: the task being evaluated when the error was encountered - - -" -Class { - #name : #BlTaskAtErrorSignal, - #superclass : #BeaconSignal, - #instVars : [ - 'exception', - 'message', - 'task' - ], - #category : #'Bloc-Space - Tasks' -} - -{ #category : #accessing } -BlTaskAtErrorSignal >> exception [ - ^ exception -] - -{ #category : #accessing } -BlTaskAtErrorSignal >> exception: anObject [ - exception := anObject -] - -{ #category : #accessing } -BlTaskAtErrorSignal >> message [ - ^ message -] - -{ #category : #accessing } -BlTaskAtErrorSignal >> message: anObject [ - message := anObject -] - -{ #category : #accessing } -BlTaskAtErrorSignal >> task [ - ^ task -] - -{ #category : #accessing } -BlTaskAtErrorSignal >> task: anObject [ - task := anObject -] diff --git a/src/Bloc/BlUniqueIdGenerator.class.st b/src/Bloc/BlUniqueIdGenerator.class.st deleted file mode 100644 index 09cf5c39f..000000000 --- a/src/Bloc/BlUniqueIdGenerator.class.st +++ /dev/null @@ -1,27 +0,0 @@ -Class { - #name : #BlUniqueIdGenerator, - #superclass : #Object, - #instVars : [ - 'mutex', - 'nextUniqueId' - ], - #category : #'Bloc-Space - Support' -} - -{ #category : #accessing } -BlUniqueIdGenerator >> generateUniqueId [ - ^ mutex critical: [ - | uniqueId | - - uniqueId := nextUniqueId. - nextUniqueId := nextUniqueId + 1. - uniqueId ] -] - -{ #category : #initialization } -BlUniqueIdGenerator >> initialize [ - super initialize. - - mutex := Mutex new. - nextUniqueId := 0 -] diff --git a/src/Bloc/TBlEventTarget.trait.st b/src/Bloc/TBlEventTarget.trait.st index bbe2a4b0f..00e8ef6d6 100644 --- a/src/Bloc/TBlEventTarget.trait.st +++ b/src/Bloc/TBlEventTarget.trait.st @@ -14,7 +14,16 @@ TBlEventTarget >> addEventFilter: anEventHandler [ { #category : #'event management' } TBlEventTarget >> addEventFilterOn: anEventClass do: aBlock [ - self addEventFilter: (BlEventHandler on: anEventClass do: aBlock) + + | newEventHandler | + newEventHandler := + BlEventHandler + on: anEventClass + do: aBlock. + + self addEventFilter: newEventHandler. + + ^ newEventHandler ] { #category : #'event management' } @@ -45,6 +54,24 @@ TBlEventTarget >> addEventHandlerOn: anEventClass do: aBlock [ ^ newEventHandler ] +{ #category : #'event management' } +TBlEventTarget >> addEventHandlerOn: anEventClass doOnce: aBlock [ + "Add an event handler that will be removed right before culling the received block closure. + Answer the new `BlEventHandler`." + + | anEventHandler | + anEventHandler := BlEventHandler new. + anEventHandler + eventClass: anEventClass; + action: [ :anEvent | + self removeEventHandler: anEventHandler. + aBlock cull: anEvent ]. + + self addEventHandler: anEventHandler. + + ^ anEventHandler +] + { #category : #'shortcut management' } TBlEventTarget >> addShortcut: aShortcut [ self eventDispatcher addShortcut: aShortcut @@ -83,16 +110,15 @@ TBlEventTarget >> buildEventDispatchChain: aBlEventDispatcherChain upTo: anOther { #category : #'event management' } TBlEventTarget >> dispatchEvent: anEvent [ - "I only call my event dispatcher, so the event can be only handled by my event handlers/filters" + "Dispatch an event if my dispatcher wants it. Previously, set in the event target, forwarding target, and source (if it wasn't already set)." - anEvent hasSource - ifFalse: [ anEvent source: self ]. + anEvent hasSource ifFalse: [ anEvent source: self ]. anEvent target: self. anEvent forwardingTarget: self. - (self eventDispatcher wantsEvent: anEvent) - ifTrue: [ self eventDispatcher dispatchEvent: anEvent ] + (self eventDispatcher wantsEvent: anEvent) ifTrue: [ + self eventDispatcher dispatchEvent: anEvent ] ] { #category : #'event management accessing' } @@ -188,15 +214,12 @@ TBlEventTarget >> shortcuts [ { #category : #'event management' } TBlEventTarget >> when: anEventClass doOnce: aBlock [ - "Install an event handler just for one execution. After that the event handler is called, remove it" - | anEventHandler | - - anEventHandler := nil. - anEventHandler := BlEventHandler - on: anEventClass - do: [ :anEvent | - self removeEventHandler: anEventHandler. - aBlock cull: anEvent ]. - - self addEventHandler: anEventHandler + "Add an event handler that will be removed right before culling the received block closure." + + self + deprecated: 'Use addEventHandlerOn:doOnce: instead' + transformWith: '`@receiver when: `@arg1 doOnce: `@arg2' + -> '`@receiver addEventHandlerOn: `@arg1 doOnce: `@arg2'. + + ^ self addEventHandlerOn: anEventClass doOnce: aBlock ] diff --git a/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st b/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st index 24dc4e66b..4353fef08 100644 --- a/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st +++ b/src/BlocHost-Morphic/BlMorphicSteppingHost.class.st @@ -33,7 +33,7 @@ BlMorphicSteppingHost class >> start [ { #category : #'private - stepping' } BlMorphicSteppingHost class >> step [ - [ (BlParallelUniverse forHost: self) pulse ] + [ self universe pulse ] on: Exception do: [ :e | self start. diff --git a/src/BlocHost-OSWindow/BlOSWindowCreatedSignal.class.st b/src/BlocHost-OSWindow/BlOSWindowCreatedSignal.class.st deleted file mode 100644 index f8a2eab91..000000000 --- a/src/BlocHost-OSWindow/BlOSWindowCreatedSignal.class.st +++ /dev/null @@ -1,18 +0,0 @@ -Class { - #name : #BlOSWindowCreatedSignal, - #superclass : #BeaconSignal, - #instVars : [ - 'window' - ], - #category : #'BlocHost-OSWindow-Signal' -} - -{ #category : #accessing } -BlOSWindowCreatedSignal >> window [ - ^ window -] - -{ #category : #accessing } -BlOSWindowCreatedSignal >> window: anObject [ - window := anObject -] diff --git a/src/BlocHost-OSWindow/BlOSWindowDestroyedSignal.class.st b/src/BlocHost-OSWindow/BlOSWindowDestroyedSignal.class.st deleted file mode 100644 index 8e1036fbc..000000000 --- a/src/BlocHost-OSWindow/BlOSWindowDestroyedSignal.class.st +++ /dev/null @@ -1,18 +0,0 @@ -Class { - #name : #BlOSWindowDestroyedSignal, - #superclass : #BeaconSignal, - #instVars : [ - 'window' - ], - #category : #'BlocHost-OSWindow-Signal' -} - -{ #category : #accessing } -BlOSWindowDestroyedSignal >> window [ - ^ window -] - -{ #category : #accessing } -BlOSWindowDestroyedSignal >> window: anObject [ - window := anObject -] diff --git a/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st b/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st index 1172c7e3c..428498d0c 100644 --- a/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st +++ b/src/BlocHost-OSWindow/BlOSWindowHostSpace.class.st @@ -27,11 +27,8 @@ BlOSWindowHostSpace >> center [ { #category : #'host space - displaying' } BlOSWindowHostSpace >> close [ - - self isValid - ifTrue: [ window destroy ]. - - (BlOSWindowDestroyedSignal new window: window) emit. + + self isValid ifTrue: [ window destroy ]. window := nil ] @@ -106,9 +103,7 @@ BlOSWindowHostSpace >> initializeWithAttributes: initialAttributes [ time: space time keyboardKeyTable: keyboardKeyTable). window startTextInput. - window newBlocRenderer. - - (BlOSWindowCreatedSignal new window: window) emit + window newBlocRenderer ] { #category : #'dirty areas' }