63765aeca2eb — Gerald Klix (speedy) 3 months ago
SUM: Added a lot of meta information to states.
1 files changed, 153 insertions(+), 36 deletions(-)

M haver/office/NuMach.pck.st
M haver/office/NuMach.pck.st +153 -36
@@ 1,8 1,8 @@ 
-'From Haver 6.0 [latest update: #5832] on 1 June 2023 at 6:20:16 pm'!
+'From Haver 6.0 [latest update: #5832] on 1 June 2023 at 8:22:58 pm'!
 'Description NuMach is a very simple to list.
 
 Hopefully it will serve as a base for something more elaborate.'!
-!provides: 'NuMach' 1 21!
+!provides: 'NuMach' 1 22!
 !requires: 'Cuis-Base' 60 5780 nil!
 !requires: 'FacetsMorphs' 1 3 nil!
 !requires: 'IdGeneration' 1 0 nil!

          
@@ 98,7 98,7 @@ BoxedMorph subclass: #ItemGrabHandle
 
 !classDefinition: (Modules>>#NuMach>>#AbstractItemState) category: 'NuMach-States'!
 Object subclass: #AbstractItemState
-	instanceVariableNames: 'id description model'
+	instanceVariableNames: 'id displayString description model stratum metaState'
 	classVariableNames: ''
 	poolDictionaries: ''
 	category: 'NuMach-States'

          
@@ 233,7 233,7 @@ printOn: aStream
 		print: self model;
 		nextPut: $]! !
 
-!(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'printing' stamp: 'KLG 5/31/2023 13:16:58'!
+!(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'printing' stamp: 'KLG 6/1/2023 18:51:28'!
 printOn: aStream
 	"Print a nice represantion on aStream."
 

          
@@ 242,7 242,12 @@ printOn: aStream
 			aStream
 				nextPutAll: 'State(';
 				print: id;
-				nextPut:$) ]
+				nextPut:$).
+			stratum ifNotNil: [
+				aStream
+					nextPut: $[;
+					print: stratum;
+					nextPut: $] ] ]
 		ifNil: [ aStream nextPutAll: 'State' ]! !
 
 !(Modules>>#NuMach>>#TodoItem) methodsFor: 'printing' stamp: 'KLG 5/30/2023 13:17:20'!

          
@@ 898,13 903,13 @@ initialize
 	super initialize.
 	isTopLevel := false! !
 
-!(Modules>>#NuMach>>#TodoItemContainerMorph) methodsFor: 'GUI building' stamp: 'KLG 6/1/2023 18:13:57'!
+!(Modules>>#NuMach>>#TodoItemContainerMorph) methodsFor: 'GUI building' stamp: 'KLG 6/1/2023 20:20:31'!
 buildMorphicWidget
 	"Build me."
 
 	|  morphToAdd subItemsPanel  |
 	filterButtonsPanel := LayoutMorph newRow.
-	self model state model statesDo: [ :state |
+	self model state model sortedStates do: [ :state |
 		filterButtonsPanel
 			addMorph:
 				(TargetToggleButton

          
@@ 914,10 919,15 @@ buildMorphicWidget
 					arguments: { state } ::
 						secondarySelector: #visible:onlyThisState:;
 						setBalloonText:
-							'If on, show items in state ', state displayString italic,
-							`String newLineString, String newLineString`,
-							'Description:' bold, `String newLineString`,
-							state description) ].
+'If ', 'on' italic, ' show items in state ', state displayString bold,'.
+
+Mouse button ', '1' bold italic, ' toggles the filtering of items in this state.
+
+Mouse button ', '2' bold italic, ' shows only items in this state.
+Pressing mouse button ', '2' bold italic, ' a second time ', 'inverts' italic, ' the filter.
+
+','State Description' under,'
+', state description, '.') ].
 	self addMorph: filterButtonsPanel fixedHeight: Theme current buttonPaneHeight.
 	subItemsMorph := DetailsMorph newColumn.
 	morphToAdd := self isTopLevel

          
@@ 1018,28 1028,37 @@ showSubItemsAccordingToFilter
 					visible: (filteredStates includes: subMorph model state) not ] ]
 ! !
 
-!(Modules>>#NuMach>>#TodoItemContainerMorph) methodsFor: 'filtering' stamp: 'KLG 6/1/2023 18:15:40'!
+!(Modules>>#NuMach>>#TodoItemContainerMorph) methodsFor: 'filtering' stamp: 'KLG 6/1/2023 20:05:05'!
 visible: aVisibleFlag onlyThisState: aState
 	"Filter aState according to aVisibleFlag. All other states if the negated visibility state."
 
-	| comparsionOperator |
+	| allButOneBlock comparsionOperator |
 	"D: Transcript cr; show: self; show: ' visible: '; show: aVisibleFlag; show: ' onlyThisState: '; show:aState."
-	aVisibleFlag
-		ifTrue: [
-			filteredStates := Set new.
-			self model state model statesDo: [ :state |
-				state = aState ifFalse: [
-					filteredStates add: state ] ]		]
-		ifFalse: [ filteredStates := Set with: aState ].
+	allButOneBlock := [
+		"D: Transcript cr; show: 'filter: one → '; show: aState."
+		filteredStates := Set new.
+		self model state model statesDo: [ :state |
+			state = aState ifFalse: [
+				filteredStates add: state ] ] 	].
+	filteredStates "Note: the 'nil' logic is reversed!!"
+		ifNil: [
+			allButOneBlock value.
+			comparsionOperator :=#=.
+			"D: Transcript cr; show: 'filter: ALL ⇒ 1'."
+			self assert: aVisibleFlag not ]
+		ifNotNil: [
+			aVisibleFlag
+				ifTrue: allButOneBlock
+				ifFalse: [ filteredStates := Set with: aState ].
+				comparsionOperator := aVisibleFlag ifTrue: [ #= ] ifFalse: [ #~= ] ].
 	self showSubItemsAccordingToFilter.
-	comparsionOperator := aVisibleFlag ifTrue: [ #= ] ifFalse: [ #~= ].
 	filterButtonsPanel submorphsDo: [ :filterButton |
 		filterButton 
 			isOn: (filterButton arguments first
 				perform: comparsionOperator
 				with: aState) ]! !
 
-!(Modules>>#NuMach>>#TodoItemContainerMorph) methodsFor: 'filtering' stamp: 'KLG 6/1/2023 17:45:31'!
+!(Modules>>#NuMach>>#TodoItemContainerMorph) methodsFor: 'filtering' stamp: 'KLG 6/1/2023 20:05:16'!
 visible: aVisibleFlag state: aState
 	"Add or remove aState form the set of filtered states."
 

          
@@ 1055,7 1074,9 @@ visible: aVisibleFlag state: aState
 					filteredStates
 						remove: aState
 						ifAbsent: [ needsUpdate := false ].
-					filteredStates ifEmpty: [ filteredStates := nil ] ]
+					filteredStates ifEmpty: [
+						"D: Transcript cr; show: 'FS ← nil'."
+						filteredStates := nil ] ]
 				ifFalse: [
 					(needsUpdate := filteredStates includes: aState :: not)
 						ifTrue: [ filteredStates add: aState ] ].

          
@@ 1263,12 1284,31 @@ id: anObject
 	self assert: id isNil.
 	id := anObject! !
 
+!(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'accessing' stamp: 'KLG 6/1/2023 19:03:18'!
+metaState
+	"Answer my meta state."
+
+	^ metaState ifNil: [ 2 ": active" ]! !
+
+!(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'accessing' stamp: 'KLG 6/1/2023 19:03:40'!
+metaState: aStateNumber
+	"Set my meta state."
+
+	metaState := aStateNumber! !
+
 !(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'accessing' stamp: 'KLG 6/1/2023 13:31:48'!
 model
 	"Answer my model."
 
 	^model! !
 
+!(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'accessing' stamp: 'KLG 6/1/2023 18:36:44'!
+stratum
+	"Answer my stratum."
+
+	stratum ifNil: [ self model stratifyStates ].
+	^ stratum! !
+
 !(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'initialization' stamp: 'KLG 6/1/2023 12:39:36'!
 initializeModel: aModel
 	"Initialize my model."

          
@@ 1276,6 1316,18 @@ initializeModel: aModel
 	self assert: model isNil.
 	model := aModel! !
 
+!(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'initialization' stamp: 'KLG 6/1/2023 18:38:37'!
+resetStratum
+	"Reset my stratum."
+
+	stratum := nil! !
+
+!(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'initialization' stamp: 'KLG 6/1/2023 18:38:07'!
+stratum: aStratum
+	"Set my stratum if not already done."
+
+	stratum ifNil: [ stratum := aStratum ]! !
+
 !(Modules>>#NuMach>>#AbstractItemState) methodsFor: 'comparing' stamp: 'KLG 5/30/2023 14:31:35'!
 = anOtherState
 	"Answer true if we are equal to another state."

          
@@ 1424,8 1476,28 @@ initializeStartState: aStartState
 	self assert: startState isNil.
 	startState := aStartState! !
 
-!(Modules>>#NuMach>>#StateModel) methodsFor: 'instance creation' stamp: 'KLG 6/1/2023 12:43:42'!
-forId: anIdSymbol andDescription: aDescription
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'instance creation' stamp: 'KLG 6/1/2023 19:04:07'!
+createdBusyStateNamed: anIdSymbol andDescription: aDescription
+	"Create and answer a new busy state denoted by anIdSymbol described by aDescription."
+
+	^ self 
+		createdStateNamed: anIdSymbol
+		andDescription: aDescription ::
+			metaState: 1;
+				yourself! !
+
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'instance creation' stamp: 'KLG 6/1/2023 19:04:59'!
+createdDoneStateNamed: anIdSymbol andDescription: aDescription
+	"Create and answer a new done state denoted by anIdSymbol described by aDescription."
+
+	^ self 
+		createdStateNamed: anIdSymbol
+		andDescription: aDescription ::
+			metaState: 4;
+				yourself! !
+
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'instance creation' stamp: 'KLG 6/1/2023 19:01:01'!
+createdStateNamed: anIdSymbol andDescription: aDescription
 	"Create and answer a new state denoted by anIdSymbol described by aDescription."
 
 	^ states

          
@@ 1435,46 1507,56 @@ forId: anIdSymbol andDescription: aDescr
 				description: aDescription
 				andModel: self)! !
 
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'instance creation' stamp: 'KLG 6/1/2023 19:04:44'!
+createdWaitingStateNamed: anIdSymbol andDescription: aDescription
+	"Create and answer a new waiting state denoted by anIdSymbol described by aDescription."
+
+	^ self 
+		createdStateNamed: anIdSymbol
+		andDescription: aDescription ::
+			metaState: 3;
+				yourself! !
+
 !(Modules>>#NuMach>>#StateModel) methodsFor: 'instance creation' stamp: 'KLG 6/1/2023 10:20:59'!
 stateClass
 	"Answer the class for new states."
 
 	^ self class stateClass! !
 
-!(Modules>>#NuMach>>#StateModel) methodsFor: 'states' stamp: 'KLG 6/1/2023 10:29:09'!
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'states' stamp: 'KLG 6/1/2023 19:06:34'!
 addDefaultModelStates
 	"Add the default start state and all of its follow states.
 	
 	Answer the start state."
 
 	| newState busyState activeState completedState cancledState deferredState waitingState doNextState testingState restartState |
-	newState := self forId: #new andDescription: 'I was newly created'.
+	newState := self createdStateNamed: #new andDescription: 'I was newly created'.
 	busyState := self
-		forId: #busy
+		createdBusyStateNamed: #busy
 		andDescription: 'We are activly working on that item right now'.
 	activeState := self
-		forId: #active
+		createdStateNamed: #active
 		andDescription: 'Work on that item is in progress'.
 	doNextState := self
-		forId: #doNext
+		createdStateNamed: #doNext
 		andDescription: 'I am active and should be busy ASAP'.
 	completedState := self
-		forId: #completed
+		createdDoneStateNamed: #completed
 		andDescription: 'Work on that item was completed successfully'.
 	waitingState :=		self
-		forId: #waiting
+		createdWaitingStateNamed: #waiting
 		andDescription: 'This item is waiting for the completion of another item'.
 	deferredState :=		self 
-		forId: #deferred
+		createdWaitingStateNamed: #deferred
 		andDescription: 'This item is not worked on, because of resource restrictions'.
 	cancledState := self
-		forId: #cancled
+		createdDoneStateNamed: #cancled
 		andDescription: 'This item was cancled due to lack of need or feasability'.
 	testingState := self
-		forId: #testing
+		createdStateNamed: #testing
 		andDescription: 'This deliverable of this item is tested for useability'.
 	restartState := self
-		forId: #restart
+		createdStateNamed: #restart
 		andDescription: 'We decided to restart working on completed or cancled item'.
 	
 	newState

          
@@ 1540,12 1622,47 @@ addDefaultModelStates
 
 	^ newState! !
 
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'states' stamp: 'KLG 6/1/2023 19:08:41'!
+sortedStates
+	"Answer my states sorted according to their stratum."
+
+	^ states asSortedCollection: [ :state1 :state2 | 
+		state1 metaState = state2 metaState
+			ifFalse: [ state1 metaState < state2 metaState ]
+			ifTrue: [ state1 stratum < state2 stratum ] ]! !
+
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'states' stamp: 'KLG 6/1/2023 19:28:45'!
+stateCount
+	"Answer the number of states I have."
+
+	^ states size! !
+
 !(Modules>>#NuMach>>#StateModel) methodsFor: 'states' stamp: 'KLG 6/1/2023 14:57:33'!
 statesDo: aBlock
 	"Evaluate aBlock for each of my states."
 
 	states do: aBlock! !
 
+!(Modules>>#NuMach>>#StateModel) methodsFor: 'states' stamp: 'KLG 6/1/2023 18:47:33'!
+stratifyStates
+	"Stratify my states."
+
+	| newStates statesSeen stratum |
+	states do: [ :state |state resetStratum ].
+	newStates := IdentitySet with: startState.
+	statesSeen := IdentitySet new.
+	stratum := 1.
+	[ newStates isEmpty ] whileFalse: [ | statesToVisit |
+		statesToVisit := newStates.
+		newStates := IdentitySet new.
+		statesToVisit do: [ :state |
+			state stratum: stratum.
+			statesSeen add: state.
+			state nextAllowedStates do: [ :nextState |
+				statesSeen includes: nextState :: ifFalse: [
+					newStates add: nextState ] ] ].
+		stratum := stratum + 1 ]! !
+
 !(Modules>>#NuMach>>#StateModel) class methodsFor: 'models' stamp: 'KLG 6/1/2023 10:51:50'!
 defaultModel
 	"Answer the default model."