diff --git a/src/ReMobidyc-Language/RMDAbstractAssignableAttributeVariableNode.class.st b/src/ReMobidyc-Language/RMDAbstractAssignableAttributeVariableNode.class.st index 7924de2..0687f83 100644 --- a/src/ReMobidyc-Language/RMDAbstractAssignableAttributeVariableNode.class.st +++ b/src/ReMobidyc-Language/RMDAbstractAssignableAttributeVariableNode.class.st @@ -15,6 +15,28 @@ RMDAbstractAssignableAttributeVariableNode class >> attributeVariable: aRMDAttri yourself ] +{ #category : #accessing } +RMDAbstractAssignableAttributeVariableNode class >> classForOperator: aString [ + + aString = self deltaOperator ifTrue: [ + ^ RMDAssignableDeltaAttributeVariableNode ]. + aString = self differentialOperator ifTrue: [ + ^ RMDAssignableDifferentialAttributeVariableNode ]. + ^ RMDAssignableAttributeVariableNode +] + +{ #category : #accessing } +RMDAbstractAssignableAttributeVariableNode class >> deltaOperator [ + + ^ 'Δ' +] + +{ #category : #accessing } +RMDAbstractAssignableAttributeVariableNode class >> differentialOperator [ + + ^ 'd/dt ' +] + { #category : #'instance creation' } RMDAbstractAssignableAttributeVariableNode class >> identifier: aString agent: anotherString [ ^ self new @@ -22,6 +44,13 @@ RMDAbstractAssignableAttributeVariableNode class >> identifier: aString agent: a yourself ] +{ #category : #'instance creation' } +RMDAbstractAssignableAttributeVariableNode class >> operator: aString attributeVariable: aRMDAttributeVariableNode [ + + ^ (self classForOperator: aString) attributeVariable: + aRMDAttributeVariableNode +] + { #category : #comparing } RMDAbstractAssignableAttributeVariableNode >> = anObject [ ^ self class = anObject class @@ -33,6 +62,13 @@ RMDAbstractAssignableAttributeVariableNode >> agent [ ^ attributeVariable agent ] +{ #category : #accessing } +RMDAbstractAssignableAttributeVariableNode >> agent: aString [ + + self attributeVariable: + (RMDAttributeVariableNode identifier: self identifier agent: aString) +] + { #category : #accessing } RMDAbstractAssignableAttributeVariableNode >> attributeVariable [ ^ attributeVariable @@ -73,6 +109,12 @@ RMDAbstractAssignableAttributeVariableNode >> operator [ ^ self subclassResponsibility ] +{ #category : #converting } +RMDAbstractAssignableAttributeVariableNode >> operator: aString [ + + ^ self class operator: aString attributeVariable: attributeVariable +] + { #category : #copying } RMDAbstractAssignableAttributeVariableNode >> postCopy [ diff --git a/src/ReMobidyc-Language/RMDAgentDefinitionNode.class.st b/src/ReMobidyc-Language/RMDAgentDefinitionNode.class.st index 855275b..821b3c6 100644 --- a/src/ReMobidyc-Language/RMDAgentDefinitionNode.class.st +++ b/src/ReMobidyc-Language/RMDAgentDefinitionNode.class.st @@ -232,6 +232,13 @@ RMDAgentDefinitionNode >> isAgentDefinitionNode [ ^ true ] +{ #category : #testing } +RMDAgentDefinitionNode >> isCorrectSyntax [ + + ^ (RMDGrammar current agentDefinition end parse: self printString) + = self +] + { #category : #accessing } RMDAgentDefinitionNode >> name [ diff --git a/src/ReMobidyc-Language/RMDAnimatInitializerNode.class.st b/src/ReMobidyc-Language/RMDAnimatInitializerNode.class.st index 00bb76c..02902ee 100644 --- a/src/ReMobidyc-Language/RMDAnimatInitializerNode.class.st +++ b/src/ReMobidyc-Language/RMDAnimatInitializerNode.class.st @@ -88,6 +88,13 @@ RMDAnimatInitializerNode >> isAnimatInitializerNode [ ^ true ] +{ #category : #testing } +RMDAnimatInitializerNode >> isCorrectSyntax [ + + ^ (RMDGrammar current animatInitializer end parse: self printString) + = self +] + { #category : #accessing } RMDAnimatInitializerNode >> population [ ^ population diff --git a/src/ReMobidyc-Language/RMDAssignableAttributeVariableNode.class.st b/src/ReMobidyc-Language/RMDAssignableAttributeVariableNode.class.st index c5b2dcd..876bfbe 100644 --- a/src/ReMobidyc-Language/RMDAssignableAttributeVariableNode.class.st +++ b/src/ReMobidyc-Language/RMDAssignableAttributeVariableNode.class.st @@ -4,6 +4,12 @@ Class { #category : #'ReMobidyc-Language-AST' } +{ #category : #accessing } +RMDAssignableAttributeVariableNode >> identifier: aString [ + + self attributeVariable identifier: aString +] + { #category : #testing } RMDAssignableAttributeVariableNode >> isAssignableAttributeVariableNode [ ^ true diff --git a/src/ReMobidyc-Language/RMDAttributeDeclarationNode.class.st b/src/ReMobidyc-Language/RMDAttributeDeclarationNode.class.st index 0d54ce7..946ecbd 100644 --- a/src/ReMobidyc-Language/RMDAttributeDeclarationNode.class.st +++ b/src/ReMobidyc-Language/RMDAttributeDeclarationNode.class.st @@ -25,6 +25,12 @@ RMDAttributeDeclarationNode class >> identifier: aString unit: aRMDUnit initiali yourself ] +{ #category : #'typical instances' } +RMDAttributeDeclarationNode class >> template [ + + ^ self identifier: '' unit: RMDUnit noDimension +] + { #category : #comparing } RMDAttributeDeclarationNode >> = anObject [ @@ -93,6 +99,34 @@ RMDAttributeDeclarationNode >> isAttributeDeclarationNode [ ^ true ] +{ #category : #testing } +RMDAttributeDeclarationNode >> isCorrectSyntax [ + + ^ (RMDGrammar current attributeDeclaration end parse: + self printString) = self +] + +{ #category : #testing } +RMDAttributeDeclarationNode >> isCorrectTypeWithSubject: aString in: aRMDSimulationModel [ + + | agentDefinition | + agentDefinition := aRMDSimulationModel + agentDefinitionAt: aString + ifAbsent: [ ^ false ]. + [ + aRMDSimulationModel typechecker + typecheck: self + subject: aString + object: nil + utilities: agentDefinition utilityDefinitions ] + on: RMDError + do: [ :ex | ^ false ]. + ^ (agentDefinition attributeDeclarations contains: [ + :attributeDeclaration | + attributeDeclaration ~~ self and: [ + attributeDeclaration identifier = self identifier ] ]) not +] + { #category : #accessing } RMDAttributeDeclarationNode >> nameWithUnit [ diff --git a/src/ReMobidyc-Language/RMDAttributeDefinitionNode.class.st b/src/ReMobidyc-Language/RMDAttributeDefinitionNode.class.st index e3cb67b..241d95b 100644 --- a/src/ReMobidyc-Language/RMDAttributeDefinitionNode.class.st +++ b/src/ReMobidyc-Language/RMDAttributeDefinitionNode.class.st @@ -20,11 +20,29 @@ RMDAttributeDefinitionNode >> asPresenter [ ^ RMDAttributeDefinitionBrowser on: self ] +{ #category : #accessing } +RMDAttributeDefinitionNode >> identifier [ + + ^ self variable identifier +] + +{ #category : #accessing } +RMDAttributeDefinitionNode >> identifier: aString [ + self variable identifier: aString +] + { #category : #testing } RMDAttributeDefinitionNode >> isAttributeDefinitionNode [ ^ true ] +{ #category : #testing } +RMDAttributeDefinitionNode >> isCorrectSyntax [ + + ^ (RMDGrammar current attributeDefinition end parse: self printString) + = self +] + { #category : #accessing } RMDAttributeDefinitionNode >> operator [ ^ '=' @@ -68,3 +86,15 @@ RMDAttributeDefinitionNode >> printShortOn: aStream [ super printShortOn: aStream. aStream nextPut: $' ] + +{ #category : #accessing } +RMDAttributeDefinitionNode >> variableOperator [ + + ^ variable operator +] + +{ #category : #accessing } +RMDAttributeDefinitionNode >> variableOperator: aString [ + + variable := variable operator: aString +] diff --git a/src/ReMobidyc-Language/RMDAttributeInitializerNode.class.st b/src/ReMobidyc-Language/RMDAttributeInitializerNode.class.st index 0da59a3..d0ab0b5 100644 --- a/src/ReMobidyc-Language/RMDAttributeInitializerNode.class.st +++ b/src/ReMobidyc-Language/RMDAttributeInitializerNode.class.st @@ -65,6 +65,13 @@ RMDAttributeInitializerNode >> isAttributeInitializerNode [ ^ true ] +{ #category : #testing } +RMDAttributeInitializerNode >> isCorrectSyntax [ + + ^ (RMDGrammar current attributeInitializer end parse: + self printString) = self +] + { #category : #copying } RMDAttributeInitializerNode >> postCopy [ diff --git a/src/ReMobidyc-Language/RMDConditionNode.class.st b/src/ReMobidyc-Language/RMDConditionNode.class.st index 3fb5c7d..7e3088b 100644 --- a/src/ReMobidyc-Language/RMDConditionNode.class.st +++ b/src/ReMobidyc-Language/RMDConditionNode.class.st @@ -29,6 +29,12 @@ RMDConditionNode >> isConditionNode [ ^ true ] +{ #category : #testing } +RMDConditionNode >> isCorrectSyntax [ + + ^ (RMDGrammar current condition end parse: self printString) = self +] + { #category : #accessing } RMDConditionNode >> precedence [ ^ self subclassResponsibility diff --git a/src/ReMobidyc-Language/RMDExpressionNode.class.st b/src/ReMobidyc-Language/RMDExpressionNode.class.st index 99ebf42..b86d107 100644 --- a/src/ReMobidyc-Language/RMDExpressionNode.class.st +++ b/src/ReMobidyc-Language/RMDExpressionNode.class.st @@ -39,6 +39,12 @@ RMDExpressionNode >> insertTrace [ ^ RMDTraceNode on: super insertTrace ] +{ #category : #testing } +RMDExpressionNode >> isCorrectSyntax [ + + ^ (RMDGrammar current expression end parse: self printString) = self +] + { #category : #testing } RMDExpressionNode >> isExpressionNode [ ^ true diff --git a/src/ReMobidyc-Language/RMDGrammar.class.st b/src/ReMobidyc-Language/RMDGrammar.class.st index 999aa50..b46fd20 100644 --- a/src/ReMobidyc-Language/RMDGrammar.class.st +++ b/src/ReMobidyc-Language/RMDGrammar.class.st @@ -150,7 +150,7 @@ RMDGrammar >> _identifier [ { #category : #'parsers-atoms' } RMDGrammar >> _literal [ - ^ self numberString , self type optional ==> [ :pair | + ^ self decimalString / self pi , self type optional ==> [ :pair | self literalNodeClass literal: pair first unit: (pair second ifNil: [ RMDUnit noDimension ]) ] @@ -1341,7 +1341,10 @@ RMDGrammar >> numberOfIndividualsInWorldDirectiveNodeClass [ { #category : #'parsers-atoms' } RMDGrammar >> numberString [ - ^ self decimalString / self pi + ^ self decimalString , self type optional ==> [ :pair | + self literalNodeClass + literal: pair first + unit: (pair second ifNil: [ RMDUnit noDimension ]) ] ] { #category : #'parsers-definitions' } diff --git a/src/ReMobidyc-Language/RMDLifeDirectiveNode.class.st b/src/ReMobidyc-Language/RMDLifeDirectiveNode.class.st index 9fbbd01..73a5e5a 100644 --- a/src/ReMobidyc-Language/RMDLifeDirectiveNode.class.st +++ b/src/ReMobidyc-Language/RMDLifeDirectiveNode.class.st @@ -25,6 +25,12 @@ RMDLifeDirectiveNode >> childrenTransform: aBlock [ ] +{ #category : #testing } +RMDLifeDirectiveNode >> hasNewAgents [ + + ^ false +] + { #category : #comparing } RMDLifeDirectiveNode >> hash [ ^ self class hash diff --git a/src/ReMobidyc-Language/RMDNewDirectiveNode.class.st b/src/ReMobidyc-Language/RMDNewDirectiveNode.class.st index 5dfa066..644c2b1 100644 --- a/src/ReMobidyc-Language/RMDNewDirectiveNode.class.st +++ b/src/ReMobidyc-Language/RMDNewDirectiveNode.class.st @@ -59,6 +59,12 @@ RMDNewDirectiveNode >> childrenTransform: aBlock [ quantity ifNotNil: [ quantity := aBlock value: quantity ] ] +{ #category : #testing } +RMDNewDirectiveNode >> hasNewAgents [ + + ^ true +] + { #category : #comparing } RMDNewDirectiveNode >> hash [ diff --git a/src/ReMobidyc-Language/RMDPatchInitializerNode.class.st b/src/ReMobidyc-Language/RMDPatchInitializerNode.class.st index 2bb7bf4..d92bc8b 100644 --- a/src/ReMobidyc-Language/RMDPatchInitializerNode.class.st +++ b/src/ReMobidyc-Language/RMDPatchInitializerNode.class.st @@ -89,6 +89,13 @@ RMDPatchInitializerNode >> hash [ bitXor: size hash) bitXor: length hash ] +{ #category : #testing } +RMDPatchInitializerNode >> isCorrectSyntax [ + + ^ (RMDGrammar current patchInitializer end parse: self printString) + = self +] + { #category : #testing } RMDPatchInitializerNode >> isPatchInitializerNode [ ^ true diff --git a/src/ReMobidyc-Language/RMDStageDirectiveNode.class.st b/src/ReMobidyc-Language/RMDStageDirectiveNode.class.st index 0be98a0..5a726f1 100644 --- a/src/ReMobidyc-Language/RMDStageDirectiveNode.class.st +++ b/src/ReMobidyc-Language/RMDStageDirectiveNode.class.st @@ -36,6 +36,12 @@ RMDStageDirectiveNode >> animatIdentifier: aString [ ifFalse: [ aString ] ] +{ #category : #testing } +RMDStageDirectiveNode >> hasNewAgents [ + + ^ true +] + { #category : #comparing } RMDStageDirectiveNode >> hash [ diff --git a/src/ReMobidyc-Language/RMDSyntaxNode.class.st b/src/ReMobidyc-Language/RMDSyntaxNode.class.st index e417013..b44f724 100644 --- a/src/ReMobidyc-Language/RMDSyntaxNode.class.st +++ b/src/ReMobidyc-Language/RMDSyntaxNode.class.st @@ -25,22 +25,29 @@ RMDSyntaxNode >> asString [ { #category : #converting } RMDSyntaxNode >> asTextWithHighlights: aCollectionOfIntervalOrRMDSyntaxNode [ + ^ self + asTextWithHighlights: aCollectionOfIntervalOrRMDSyntaxNode + color: Color red +] + +{ #category : #converting } +RMDSyntaxNode >> asTextWithHighlights: aCollectionOfIntervalOrRMDSyntaxNode color: aColor [ + | sections nodes newText | sections := OrderedCollection new: aCollectionOfIntervalOrRMDSyntaxNode size + 10. - nodes := Set new: - aCollectionOfIntervalOrRMDSyntaxNode size + 1. - aCollectionOfIntervalOrRMDSyntaxNode do: [ :highlight | + nodes := Set new: aCollectionOfIntervalOrRMDSyntaxNode size + 1. + aCollectionOfIntervalOrRMDSyntaxNode do: [ :highlight | highlight isInterval ifTrue: [ sections add: highlight ] ifFalse: [ nodes add: highlight ] ]. - newText := (String streamContents: [ :stream | + newText := (String streamContents: [ :stream | self printOn: stream ifIncludedIn: nodes addSectionTo: sections ]) asText. - sections do: [ :section | - newText makeColor: Color red from: section first to: section last ]. + sections do: [ :section | + newText makeColor: aColor from: section first to: section last ]. ^ newText ] @@ -75,6 +82,35 @@ RMDSyntaxNode >> copyReplace: aDictionary [ ^ self shallowCopy replaceChildren: aDictionary ] +{ #category : #printing } +RMDSyntaxNode >> errorNodesInTypecheck: aRMDType subject: aString object: anotherString utilities: anArrayOfRMDUtilityDefinitionNode in: aRMDTypechecker permitUnresolvedAttributeReference: aBool [ + + | errorNodes | + errorNodes := OrderedCollection new: 10. + [ + [ + [ + [ + aRMDType unify: (aRMDTypechecker + typecheck: self + subject: aString + object: anotherString + utilities: anArrayOfRMDUtilityDefinitionNode) ] + on: RMDTypeUnificationError + do: [ :ex | errorNodes add: self ] ] + on: RMDUnresolvedPlaceholderError + do: [ :ex | ex resume: RMDType any ] ] + on: RMDUndefinedAttributeError , RMDUndefinedAnimatError + do: [ :ex | + aBool = true ifFalse: [ errorNodes add: ex node ]. + ex resume: RMDType any ] ] + on: RMDSemanticError + do: [ :ex | + errorNodes add: ex node. + ex resume: RMDType any ]. + ^ errorNodes +] + { #category : #testing } RMDSyntaxNode >> hasConditionPlaceholder: aRMDPlaceholder [ @@ -95,6 +131,83 @@ RMDSyntaxNode >> hash [ ^ self subclassResponsibility ] +{ #category : #printing } +RMDSyntaxNode >> highlightedSourceTyped: aRMDType in: aRMDTypechecker [ + + ^ self + highlightedSourceTyped: aRMDType + subject: nil + in: aRMDTypechecker +] + +{ #category : #printing } +RMDSyntaxNode >> highlightedSourceTyped: aRMDType subject: aString in: aRMDTypechecker [ + + ^ self + highlightedSourceTyped: aRMDType + subject: aString + object: nil + in: aRMDTypechecker +] + +{ #category : #printing } +RMDSyntaxNode >> highlightedSourceTyped: aRMDType subject: aString object: anotherString in: aRMDTypechecker [ + + ^ self + highlightedSourceTyped: aRMDType + subject: aString + object: anotherString + utilities: nil + in: aRMDTypechecker +] + +{ #category : #printing } +RMDSyntaxNode >> highlightedSourceTyped: aRMDType subject: aString object: anotherString utilities: anArrayOfRMDUtilityDefinitionNode in: aRMDTypechecker [ + + ^ self + highlightedSourceTyped: aRMDType + subject: aString + object: anotherString + utilities: anArrayOfRMDUtilityDefinitionNode + in: aRMDTypechecker + permitUnresolvedAttributeReference: false +] + +{ #category : #printing } +RMDSyntaxNode >> highlightedSourceTyped: aRMDType subject: aString object: anotherString utilities: anArrayOfRMDUtilityDefinitionNode in: aRMDTypechecker permitUnresolvedAttributeReference: aBool [ + + ^ self + asTextWithHighlights: (self + errorNodesInTypecheck: aRMDType + subject: aString + object: anotherString + utilities: anArrayOfRMDUtilityDefinitionNode + in: aRMDTypechecker + permitUnresolvedAttributeReference: aBool) + color: (Color yellow mixed: 0.7 with: Color black) +] + +{ #category : #printing } +RMDSyntaxNode >> highlightedSourceTyped: aRMDType subject: aString utilities: anArrayOfRMDUtilityDefinition in: aRMDTypechecker [ + + ^ self + highlightedSourceTyped: aRMDType + subject: aString + object: nil + utilities: anArrayOfRMDUtilityDefinition + in: aRMDTypechecker +] + +{ #category : #printing } +RMDSyntaxNode >> highlightedSourceTyped: aRMDType utilities: anArrayOfRMDUtilityDefinition in: aRMDTypechecker [ + + ^ self + highlightedSourceTyped: aRMDType + subject: nil + utilities: anArrayOfRMDUtilityDefinition + in: aRMDTypechecker +] + { #category : #enumerating } RMDSyntaxNode >> includesNode: aRMDSyntaxNode [ self @@ -223,6 +336,20 @@ RMDSyntaxNode >> isConjunctionNode [ ^ false ] +{ #category : #testing } +RMDSyntaxNode >> isCorrectTypeWithSubject: aString object: anotherString utilities: anArrayOfRMDUtilityDefinition in: aRMDSimulationModel [ + + [ + aRMDSimulationModel typechecker + typecheck: self + subject: aString + object: anotherString + utilities: anArrayOfRMDUtilityDefinition ] + on: RMDError + do: [ :ex | ^ false ]. + ^ true +] + { #category : #testing } RMDSyntaxNode >> isDeUnitExpressionNode [ @@ -571,6 +698,32 @@ RMDSyntaxNode >> isVisualizationFileNode [ ^ false ] +{ #category : #testing } +RMDSyntaxNode >> isWellTypedWithSubject: aString object: anotherString utilities: anArrayOfRMDUtilityDefinition in: aRMDSimulationModel permitsUnresolvedAttributeReference: aBool [ + + [ + [ + [ + [ + aRMDSimulationModel typechecker + typecheck: self + subject: aString + object: anotherString + utilities: anArrayOfRMDUtilityDefinition ] + on: RMDScopedSemanticError + do: [ :ex | ex resume: ex exception outer ] ] + on: RMDTypeUnificationError + do: [ :ex | ^ false ] ] + on: RMDUndefinedAttributeError , RMDUnresolvedPlaceholderError + , RMDUndefinedAnimatError + do: [ :ex | + aBool = true ifFalse: [ ^ false ]. + ex resume: RMDType any ] ] + on: RMDSemanticError + do: [ :ex | ^ false ]. + ^ true +] + { #category : #testing } RMDSyntaxNode >> isWorldAttributeVariableNode [ diff --git a/src/ReMobidyc-Language/RMDUtilityDefinitionNode.class.st b/src/ReMobidyc-Language/RMDUtilityDefinitionNode.class.st index ca97dc6..7f21a98 100644 --- a/src/ReMobidyc-Language/RMDUtilityDefinitionNode.class.st +++ b/src/ReMobidyc-Language/RMDUtilityDefinitionNode.class.st @@ -27,6 +27,46 @@ RMDUtilityDefinitionNode >> childrenTransform: aBlock [ definitionBody := aBlock value: definitionBody ] +{ #category : #accessing } +RMDUtilityDefinitionNode >> identifier [ + + ^ self variable identifier +] + +{ #category : #accessing } +RMDUtilityDefinitionNode >> identifier: aString [ + + self variable identifier: aString +] + +{ #category : #testing } +RMDUtilityDefinitionNode >> isCorrectSyntax [ + + ^ (RMDGrammar current utilityDefinition end parse: self printString) + = self +] + +{ #category : #testing } +RMDUtilityDefinitionNode >> isCorrectTypeWithSubject: aString in: aRMDSimulationModel [ + + | agentDefinition | + agentDefinition := aRMDSimulationModel + agentDefinitionAt: aString + ifAbsent: [ ^ false ]. + [ + aRMDSimulationModel typechecker + typecheck: self + subject: aString + object: nil + utilities: agentDefinition utilityDefinitions ] + on: RMDError + do: [ :ex | ^ false ]. + ^ (agentDefinition utilityDefinitions contains: [ + :attributeDeclaration | + attributeDeclaration ~~ self and: [ + attributeDeclaration identifier = self identifier ] ]) not +] + { #category : #testing } RMDUtilityDefinitionNode >> isUtilityDefinitionNode [ ^ true diff --git a/src/ReMobidyc-Language/RMDWorldInitializerNode.class.st b/src/ReMobidyc-Language/RMDWorldInitializerNode.class.st index 126caa0..2bb9231 100644 --- a/src/ReMobidyc-Language/RMDWorldInitializerNode.class.st +++ b/src/ReMobidyc-Language/RMDWorldInitializerNode.class.st @@ -26,6 +26,13 @@ RMDWorldInitializerNode >> agentName [ ^ 'World' ] +{ #category : #testing } +RMDWorldInitializerNode >> isCorrectSyntax [ + + ^ (RMDGrammar current worldInitializer end parse: self printString) + = self +] + { #category : #testing } RMDWorldInitializerNode >> isWorldInitializerNode [ ^ true diff --git a/src/ReMobidyc-Language/String.extension.st b/src/ReMobidyc-Language/String.extension.st index a624cde..75baa91 100644 --- a/src/ReMobidyc-Language/String.extension.st +++ b/src/ReMobidyc-Language/String.extension.st @@ -42,6 +42,12 @@ String >> asRMDExpressionDo: aBlock ifError: errorBlock [ ifFalse: [ aBlock ]) cull: node ] +{ #category : #'*ReMobidyc-Language' } +String >> asRMDExpressionOrNil [ + + ^ self asRMDExpressionDo: [ :node | node ] ifError: [ ] +] + { #category : #'*ReMobidyc-Language' } String >> asRMDSimulationDefinition [ @@ -73,6 +79,25 @@ String >> asRMDUnit [ ifFalse: [ node ] ] ] +{ #category : #'*ReMobidyc-Language' } +String >> asRMDUnitOrNil [ + + | node | + ^ (node := RMDGrammar current unit end parse: self) isPetit2Success + ifTrue: [ node ] + ifFalse: [ nil ] +] + +{ #category : #'*ReMobidyc-Language' } +String >> asRMDUnitOrNoDimension [ + + | node | + node := RMDGrammar current unit end parse: self. + ^ node isPetit2Failure + ifTrue: [ RMDUnit noDimension ] + ifFalse: [ node ] +] + { #category : #'*ReMobidyc-Language' } String >> asRMDWorldDefinition [ @@ -82,3 +107,9 @@ String >> asRMDWorldDefinition [ ifTrue: [ RMDSyntaxError signal: node ] ifFalse: [ node ] ] + +{ #category : #'*ReMobidyc-Language' } +String >> isCorrectRMDIdentifier [ + + ^ (RMDGrammar current identifier end parse: self) = self +] diff --git a/src/ReMobidyc-Spec2/RMDActionDefinitionBrowser.class.st b/src/ReMobidyc-Spec2/RMDActionDefinitionBrowser.class.st index 0bd5a05..d840fa8 100644 --- a/src/ReMobidyc-Spec2/RMDActionDefinitionBrowser.class.st +++ b/src/ReMobidyc-Spec2/RMDActionDefinitionBrowser.class.st @@ -11,12 +11,10 @@ Class { 'removeUtilityButton', 'moveUpUtilityButton', 'moveDownUtilityButton', - 'editUtilityButton', 'attributeDefinitionList', 'addAttributeButton', 'moveUpAttributeButton', 'moveDownAttributeButton', - 'editAttributeButton', 'removeAttributeButton', 'subjectAgent' ], @@ -64,7 +62,6 @@ RMDActionDefinitionBrowser class >> defaultLayout [ add: #removeAttributeButton expand: false; add: #moveUpAttributeButton expand: false; add: #moveDownAttributeButton expand: false; - add: #editAttributeButton expand: false; yourself) height: self inputTextHeight)) expand: true @@ -80,7 +77,6 @@ RMDActionDefinitionBrowser class >> defaultLayout [ add: #removeUtilityButton expand: false; add: #moveUpUtilityButton expand: false; add: #moveDownUtilityButton expand: false; - add: #editUtilityButton expand: false; yourself) height: self inputTextHeight)) expand: true @@ -94,14 +90,9 @@ RMDActionDefinitionBrowser >> addAttributeDefinition [ | newDefinition | newDefinition := RMDAttributeDefinitionNode template. - (newDefinition asPresenter - simulationModel: self simulationModel; - subjectAgent: subjectAgent; - objectAgent: node object; - yourself) openDialog okAction: [ - node attributeDefinitions: - (node attributeDefinitions copyWith: newDefinition). - self nodeChanged ] + node attributeDefinitions: + (node attributeDefinitions copyWith: newDefinition). + self nodeChanged ] { #category : #operations } @@ -109,10 +100,17 @@ RMDActionDefinitionBrowser >> addUtilityDefinition [ | newDefinition | newDefinition := RMDUtilityDefinitionNode template. - newDefinition asPresenter openDialog okAction: [ - node utilityDefinitions: - (node utilityDefinitions copyWith: newDefinition). - self nodeChanged ] + node utilityDefinitions: + (node utilityDefinitions copyWith: newDefinition). + self nodeChanged +] + +{ #category : #accessing } +RMDActionDefinitionBrowser >> agentDefinition [ + + ^ self simulationModel + agentDefinitionAt: self subjectAgent + ifAbsent: [ nil ] ] { #category : #menus } @@ -127,12 +125,6 @@ RMDActionDefinitionBrowser >> attributeDefinitionListMenu [ icon: self addIcon; enabled: addAttributeButton isEnabled; action: [ self addAttributeDefinition ] ]; - addItem: [ :item | - item - name: 'Edit...'; - icon: self editIcon; - enabled: editAttributeButton isEnabled; - action: [ self editAttributeDefinition ] ]; addItem: [ :item | item name: 'Remove'; @@ -259,8 +251,8 @@ RMDActionDefinitionBrowser >> initializePresenters [ yourself. objectField := self newHighlightingSyntaxNodeTextInput parser: - RMDGrammar current agentIdentifier optional trimBlanks - end; + RMDGrammar current agentIdentifier optional + trimBlanks end; placeholder: '(object)'; autoAccept: true; whenLastValidSyntaxNodeChangedDo: [ :animat | @@ -281,13 +273,74 @@ RMDActionDefinitionBrowser >> initializePresenters [ help: 'Edit directives such as new, stage, die and kill'; yourself. - attributeDefinitionList := self newList - display: [ :attributeDef | - attributeDef printString ]; + attributeDefinitionList := self newTable + addColumn: ((RMDColorTriangleTableColumn + subjectBlock: [ self subjectAgent ] + objectBlock: [ node object ] + utilitiesBlock: [ + node utilityDefinitions ] + simulationModel: [ + self simulationModel ]) + permitUnresolvedAttributeReference; + namecrashBlock: [ :attrDef | + (attributeDefinitionList items + select: [ :a | + a identifier = attrDef identifier ]) + size = 1 ]); + addColumn: + (RMDPossessionalAgentDropListTableColumn + new + objectBlock: [ node object ]; + directiveBlock: [ node lifeDirectives ]; + yourself); + addColumn: + RMDVariableOperatorDropListTableColumn + new; + addColumn: + ((RMDIdentifierTableColumn evaluated: [ + :attrDef | + attrDef variable identifier ]) + validationBlock: [ :item | + (attributeDefinitionList items + select: [ :attrDecl | + attrDecl identifier + = item identifier ]) size = 1 ]; + extraAcceptAction: [ + attributeDefinitionList refresh ]; + width: 150); + addColumn: + ((SpStringTableColumn evaluated: [ + ''' = ' ]) width: 20); + addColumn: + ((RMDExpressionTableColumn evaluated: [ + :item | item definitionBody ]) + permitUnresolvedAttributeReference; + unitBlock: [ :def | + (self simulationModel + agentDefinitionAt: + self subjectAgent + ifAbsent: [ nil ]) ifNotNil: [ + :agentDef | + agentDef + unitOfAttribute: def identifier + ifAbsent: [ nil ] ] ]; + simulationModelBlock: [ + self simulationModel ]; + subjectBlock: [ self subjectAgent ]; + objectBlock: [ node object ]; + utilitiesBlock: [ + node utilityDefinitions ]; + onAcceptEdition: [ :item :expr | + item definitionBody: expr. + attributeDefinitionList refresh. + utilityDefinitionList refresh ]; + yourself); + hideColumnHeaders; + beResizable; whenSelectionChangedDo: [ - self updateAttributeButtons ]; + self updateAttributeButtons ]; contextMenu: [ - self attributeDefinitionListMenu ]; + self attributeDefinitionListMenu ]; yourself. addAttributeButton := self newButton label: ''; @@ -316,21 +369,57 @@ RMDActionDefinitionBrowser >> initializePresenters [ 'Move the selected attribute definition down'; disable; yourself. - editAttributeButton := self newButton - label: ''; - icon: self editIcon; - action: [ self editAttributeDefinition ]; - help: - 'Edit the definition of the selected attribute'; - disable; - yourself. - utilityDefinitionList := self newList - display: [ :utilityDef | - utilityDef printString ]; + utilityDefinitionList := self newTable + beResizable; + hideColumnHeaders; + addColumn: ((RMDColorTriangleTableColumn + subjectBlock: [ self subjectAgent ] + objectBlock: [ node object ] + utilitiesBlock: [ + node utilityDefinitions ] + simulationModel: [ + self simulationModel ]) + permitUnresolvedAttributeReference; + namecrashBlock: [ :utilDef | + (utilityDefinitionList items select: [ + :udef | + udef identifier = utilDef identifier ]) + size = 1 ]); + addColumn: (RMDIdentifierTableColumn new + validationBlock: [ :item | + (utilityDefinitionList items select: [ + :utilDef | + utilDef identifier = item identifier ]) + size = 1 ]; + extraAcceptAction: [ + attributeDefinitionList refresh. + utilityDefinitionList refresh ]; + width: 150; + yourself); + addColumn: + ((SpStringTableColumn evaluated: [ ' = ' ]) + width: 20); + addColumn: + ((RMDExpressionTableColumn evaluated: [ + :item | item definitionBody ]) + permitUnresolvedAttributeReference; + simulationModelBlock: [ + self simulationModel ]; + subjectBlock: [ self subjectAgent ]; + objectBlock: [ node object ]; + utilitiesBlock: [ + node utilityDefinitions ]; + onAcceptEdition: [ :item :expr | + item definitionBody: expr. + attributeDefinitionList refresh. + utilityDefinitionList refresh ]; + yourself); + whenModelChangedDo: [ + utilityDefinitionList selectItem: nil ]; whenSelectionChangedDo: [ - self updateUtilityButtons ]; + self updateUtilityButtons ]; contextMenu: [ - self utilityDefinitionListMenu ]; + self utilityDefinitionListMenu ]; yourself. addUtilityButton := self newButton label: ''; @@ -359,14 +448,6 @@ RMDActionDefinitionBrowser >> initializePresenters [ 'Move the selected utility definition down'; disable; yourself. - editUtilityButton := self newButton - label: ''; - icon: self editIcon; - action: [ self editUtilityDefinition ]; - help: - 'Edit the definition of the selected utility variable'; - disable; - yourself. self whenBuiltDo: [ self withWidgetDo: [ :w | w @@ -478,6 +559,12 @@ RMDActionDefinitionBrowser >> nodeChanged [ self updateTitle ] +{ #category : #accessing } +RMDActionDefinitionBrowser >> objectAgent [ + + ^ objectField text asString trim +] + { #category : #accessing } RMDActionDefinitionBrowser >> preferredHeight [ ^ 600 @@ -578,12 +665,11 @@ RMDActionDefinitionBrowser >> updateAttributeButtons [ | hasSelection | hasSelection := attributeDefinitionList selectedItem notNil. removeAttributeButton enabled: hasSelection. - moveUpAttributeButton enabled: (hasSelection and: [ + moveUpAttributeButton enabled: (hasSelection and: [ attributeDefinitionList selection selectedIndex >= 2 ]). - moveDownAttributeButton enabled: (hasSelection and: [ + moveDownAttributeButton enabled: (hasSelection and: [ attributeDefinitionList selection selectedIndex - < attributeDefinitionList items size ]). - editAttributeButton enabled: hasSelection + < attributeDefinitionList items size ]) ] { #category : #updating } @@ -598,12 +684,11 @@ RMDActionDefinitionBrowser >> updateUtilityButtons [ | hasSelection | hasSelection := utilityDefinitionList selectedItem notNil. removeUtilityButton enabled: hasSelection. - moveUpUtilityButton enabled: (hasSelection and: [ + moveUpUtilityButton enabled: (hasSelection and: [ utilityDefinitionList selection selectedIndex >= 2 ]). - moveDownUtilityButton enabled: (hasSelection and: [ + moveDownUtilityButton enabled: (hasSelection and: [ utilityDefinitionList selection selectedIndex - < utilityDefinitionList items size ]). - editUtilityButton enabled: hasSelection + < utilityDefinitionList items size ]) ] { #category : #menus } @@ -618,12 +703,6 @@ RMDActionDefinitionBrowser >> utilityDefinitionListMenu [ icon: self addIcon; enabled: addUtilityButton isEnabled; action: [ self addUtilityDefinition ] ]; - addItem: [ :item | - item - name: 'Edit...'; - icon: self editIcon; - enabled: editUtilityButton isEnabled; - action: [ self editUtilityDefinition ] ]; addItem: [ :item | item name: 'Remove'; diff --git a/src/ReMobidyc-Spec2/RMDAgentDefinitionBrowser.class.st b/src/ReMobidyc-Spec2/RMDAgentDefinitionBrowser.class.st index 21a9f17..0283a24 100644 --- a/src/ReMobidyc-Spec2/RMDAgentDefinitionBrowser.class.st +++ b/src/ReMobidyc-Spec2/RMDAgentDefinitionBrowser.class.st @@ -9,7 +9,6 @@ Class { 'removeAttributeButton', 'moveUpAttributeButton', 'moveDownAttributeButton', - 'editAttributeButton', 'addDataSourceButton', 'removeDataSourceButton', 'openDataSourceButton', @@ -18,7 +17,6 @@ Class { 'removeUtilityButton', 'moveUpUtilityButton', 'moveDownUtilityButton', - 'editUtilityButton', 'rendererList', 'addRendererButton', 'removeRendererButton', @@ -49,7 +47,6 @@ RMDAgentDefinitionBrowser class >> defaultLayout [ add: #removeAttributeButton width: self buttonHeight; add: #moveUpAttributeButton width: self buttonHeight; add: #moveDownAttributeButton width: self buttonHeight; - add: #editAttributeButton width: self buttonHeight; yourself) height: self buttonHeight; add: 'Data source' expand: false; @@ -68,7 +65,6 @@ RMDAgentDefinitionBrowser class >> defaultLayout [ add: #removeUtilityButton width: self buttonHeight; add: #moveUpUtilityButton width: self buttonHeight; add: #moveDownUtilityButton width: self buttonHeight; - add: #editUtilityButton width: self buttonHeight; yourself) height: self buttonHeight; yourself); @@ -114,20 +110,11 @@ RMDAgentDefinitionBrowser class >> isAbstract [ RMDAgentDefinitionBrowser >> addAttribute [ | attributeNode | - ((attributeNode := RMDAttributeDeclarationNode - identifier: '' - unit: RMDUnit noDimension) asPresenter - simulationModel: self simulationModel; - agentName: self agentName; - utilities: self agentDefinition utilityDefinitions; - yourself) openDialog - title: 'Add attribute to ' , self agentName; - okAction: [ - self definitionDo: [ :definition | - definition attributeDeclarations: - (definition attributeDeclarations copyWith: attributeNode). - self addInitializerWithAttribute: attributeNode animat: animat. - self updateAttributeList ] ] + attributeNode := RMDAttributeDeclarationNode template. + self definitionDo: [ :definition | + definition attributeDeclarations: + (definition attributeDeclarations copyWith: attributeNode). + self updateAttributeList ] ] { #category : #operations } @@ -140,11 +127,6 @@ RMDAgentDefinitionBrowser >> addDataSource [ self updateDataSourceButtons ] ] ] -{ #category : #private } -RMDAgentDefinitionBrowser >> addInitializerWithAttribute: aRMDAttributeNode animat: anotherString [ - ^ self subclassResponsibility -] - { #category : #operations } RMDAgentDefinitionBrowser >> addRenderer [ @@ -184,11 +166,10 @@ RMDAgentDefinitionBrowser >> addUtility [ | newDefinition | newDefinition := RMDUtilityDefinitionNode template. - newDefinition asPresenter openDialog okAction: [ - self definitionDo: [ :definition | - definition utilityDefinitions: - (definition utilityDefinitions copyWith: newDefinition). - self updateUtilityList ] ] + self definitionDo: [ :definition | + definition utilityDefinitions: + (definition utilityDefinitions copyWith: newDefinition) ]. + self updateUtilityList ] { #category : #accessing } @@ -215,12 +196,6 @@ RMDAgentDefinitionBrowser >> attributeListMenu [ icon: self addIcon; enabled: addAttributeButton isEnabled; action: [ self addAttribute ] ]; - addItem: [ :item | - item - name: 'Edit'; - icon: self editIcon; - enabled: editAttributeButton isEnabled; - action: [ self editAttribute ] ]; addItem: [ :item | item name: 'Remove'; @@ -249,31 +224,6 @@ RMDAgentDefinitionBrowser >> definitionDo: aBlock [ ^ self subclassResponsibility ] -{ #category : #operations } -RMDAgentDefinitionBrowser >> editAttribute [ - - attributeList selection selectedItem ifNotNil: [ - :originalAttributeNode | - | newAttributeNode | - newAttributeNode := originalAttributeNode copy. - (newAttributeNode asPresenter - simulationModel: self simulationModel; - agentName: self agentName; - utilities: self agentDefinition utilityDefinitions; - yourself) openDialog - title: 'Edit attribute of ' , self agentName; - okAction: [ - self definitionDo: [ :definition | - definition attributeDeclarations: - ((definition attributeDeclarations copyWithout: - originalAttributeNode) copyWith: newAttributeNode). - self - removeInitializerWithAttribute: originalAttributeNode - animat: animat; - addInitializerWithAttribute: newAttributeNode animat: animat. - self updateAttributeList ] ] ] -] - { #category : #operations } RMDAgentDefinitionBrowser >> editRenderer [ ^ self notYetImplemented @@ -300,22 +250,6 @@ RMDAgentDefinitionBrowser >> editTask [ self updateSourceText ] ] ] ] ] -{ #category : #operations } -RMDAgentDefinitionBrowser >> editUtility [ - - utilityList selectedItem ifNotNil: [ :oldDefinition | - | newDefinition index | - newDefinition := oldDefinition copy. - newDefinition asPresenter openDialog okAction: [ - self definitionDo: [ :definition | - definition utilityDefinitions - at: - (index := definition utilityDefinitions indexOf: oldDefinition) - put: newDefinition. - self updateUtilityList. - utilityList selectIndex: index ] ] ] -] - { #category : #initialization } RMDAgentDefinitionBrowser >> initializePresenters [ @@ -324,31 +258,41 @@ RMDAgentDefinitionBrowser >> initializePresenters [ beSingleSelection; beResizable; showColumnHeaders; - addColumn: ((SpStringTableColumn - title: 'name' - evaluated: [ :item | item identifier ]) + addColumn: ((RMDColorTriangleTableColumn + subjectBlock: [ self agentName ] + utilitiesBlock: [ + self definitionDo: #utilityDefinitions ] + simulationModel: [ self simulationModel ]) + namecrashBlock: [ :adef | + (attributeList items select: [ :a | + a identifier = adef identifier ]) size = 1 ]); + addColumn: + ((RMDIdentifierTableColumn title: 'name') + validationBlock: [ :item | + (attributeList items select: [ :attrDecl | + attrDecl identifier = item identifier ]) + size = 1 ]; + extraAcceptAction: [ attributeList refresh ]; width: 150; yourself); - addColumn: - ((SpStringTableColumn - title: 'unit' - evaluated: [ :item | - | unit | - unit := item unit. - unit hasDimension - ifTrue: [ unit printString ] - ifFalse: [ '' ] ]) + addColumn: ((RMDUnitTableColumn title: 'unit') + beEditable; + extraAcceptAction: [ attributeList refresh ]; width: 100; yourself); - addColumn: - (SpStringTableColumn - title: 'initial value' - evaluated: [ :item | - | expr | - expr := item initializerExpression. - expr - ifNotNil: [ expr printString ] - ifNil: [ '' ] ]); + addColumn: ((RMDExpressionTableColumn + title: 'initial value' + evaluated: [ :item | + item initializerExpression ]) + unitBlock: [ :item | item unit ]; + simulationModelBlock: [ self simulationModel ]; + subjectBlock: [ self agentName ]; + utilitiesBlock: [ + self definitionDo: #utilityDefinitions ]; + onAcceptEdition: [ :item :expr | + item initializerExpression: expr. + attributeList refresh ]; + yourself); whenModelChangedDo: [ attributeList selectItem: nil ]; whenSelectionChangedDo: [ @@ -378,13 +322,6 @@ RMDAgentDefinitionBrowser >> initializePresenters [ help: 'Move the selected attribute down'; disable; yourself. - editAttributeButton := self newButton - icon: self editIcon; - action: [ self editAttribute ]; - help: - 'Edit the definition of the selected attribute'; - disable; - yourself. openDataSourceButton := self newButton icon: self tabularIcon; action: [ self openDataSource ]; @@ -407,18 +344,36 @@ RMDAgentDefinitionBrowser >> initializePresenters [ beSingleSelection; beResizable; showColumnHeaders; - addColumn: ((SpStringTableColumn - title: 'name' - evaluated: [ :item | item variable identifier ]) + addColumn: ((RMDColorTriangleTableColumn + subjectBlock: [ self agentName ] + utilitiesBlock: [ + self definitionDo: #utilityDefinitions ] + simulationModel: [ self simulationModel ]) + namecrashBlock: [ :adef | + (utilityList items select: [ :a | + a identifier = adef identifier ]) size = 1 ]); + addColumn: ((RMDIdentifierTableColumn title: 'name') + validationBlock: [ :item | + (utilityList items select: [ :utilDef | + utilDef identifier = item identifier ]) size + = 1 ]; + extraAcceptAction: [ + attributeList refresh. + utilityList refresh ]; width: 150; yourself); - addColumn: - (SpStringTableColumn - title: 'value' - evaluated: [ :item | - | expr | - expr := item definitionBody. - expr ifNotNil: [ expr printString ] ifNil: [ '' ] ]); + addColumn: ((RMDExpressionTableColumn + title: 'value' + evaluated: [ :item | item definitionBody ]) + simulationModelBlock: [ self simulationModel ]; + subjectBlock: [ self agentName ]; + utilitiesBlock: [ + self definitionDo: #utilityDefinitions ]; + onAcceptEdition: [ :item :expr | + item definitionBody: expr. + attributeList refresh. + utilityList refresh ]; + yourself); whenModelChangedDo: [ utilityList selectItem: nil ]; whenSelectionChangedDo: [ self updateUtilityButtons ]; contextMenu: [ self utilityListMenu ]; @@ -449,13 +404,6 @@ RMDAgentDefinitionBrowser >> initializePresenters [ 'Move the selected utility definition down'; disable; yourself. - editUtilityButton := self newButton - icon: self editIcon; - action: [ self editUtility ]; - help: - 'Edit the definition of the selected utility definition'; - disable; - yourself. rendererList := self newComponentList beSingleSelection; whenModelChangedDo: [ rendererList selectItem: nil ]; @@ -542,7 +490,8 @@ RMDAgentDefinitionBrowser >> initializePresenters [ help: 'Edit the definition of the selected task'; disable; yourself. - sourceText := (self newSourceWith: RMDGrammar current actionDefinition) + sourceText := (self newSourceWith: + RMDGrammar current actionDefinition) beNotEditable; whenLastValidSyntaxNodeChangedDo: [ :syntaxNode | ]; yourself @@ -697,17 +646,16 @@ RMDAgentDefinitionBrowser >> openDataSource [ { #category : #operations } RMDAgentDefinitionBrowser >> removeAttribute [ - attributeList selection selectedItem ifNotNil: [ :attributeNode | + attributeList selection selectedItem ifNotNil: [ :attributeNode | (self newLabel label: 'OK to remove ' , attributeNode identifier , '?'; yourself) openDialog title: 'Remove attribute from ' , self agentName; extent: 400 @ (self class buttonHeight * 3.5); - okAction: [ - self definitionDo: [ :definitionNode | + okAction: [ + self definitionDo: [ :definitionNode | definitionNode attributeDeclarations: (definitionNode attributeDeclarations copyWithout: attributeNode). - self removeInitializerWithAttribute: attributeNode animat: animat. self updateAttributeList ] ] ] ] @@ -721,11 +669,6 @@ RMDAgentDefinitionBrowser >> removeDataSource [ self updateDataSourceButtons ] ] -{ #category : #private } -RMDAgentDefinitionBrowser >> removeInitializerWithAttribute: aRMDAttributeNode animat: anotherString [ - ^ self subclassResponsibility -] - { #category : #operations } RMDAgentDefinitionBrowser >> removeRenderer [ @@ -838,10 +781,12 @@ RMDAgentDefinitionBrowser >> renderersDo: aBlock [ RMDAgentDefinitionBrowser >> setModeler: aRMDSimulationModeler [ modeler := aRMDSimulationModeler. - self updateAttributeList. - self updateRendererList. - self updateTaskList. - self updateDataSourceButtons + self + updateAttributeList; + updateUtilityList; + updateRendererList; + updateTaskList; + updateDataSourceButtons ] { #category : #accessing } @@ -905,17 +850,15 @@ RMDAgentDefinitionBrowser >> updateAttributeButtons [ removeAttributeButton enabled: selected. moveUpAttributeButton enabled: (selected and: [ index > 1 ]). moveDownAttributeButton enabled: - (selected and: [ index < attributeList items size ]). - editAttributeButton enabled: selected + (selected and: [ index < attributeList items size ]) ] { #category : #updating } RMDAgentDefinitionBrowser >> updateAttributeList [ - self definitionDo: [ :definition | - attributeList items: definition attributeDeclarations. - definition complementUtilityDefinitions ]. - self updateUtilityList + self definitionDo: [ :definition | + attributeList items: definition attributeDeclarations ]. + utilityList refresh ] { #category : #updating } @@ -986,15 +929,15 @@ RMDAgentDefinitionBrowser >> updateUtilityButtons [ removeUtilityButton enabled: selected. moveUpUtilityButton enabled: (selected and: [ index > 1 ]). moveDownUtilityButton enabled: - (selected and: [ index < utilityList items size ]). - editUtilityButton enabled: selected + (selected and: [ index < utilityList items size ]) ] { #category : #updating } RMDAgentDefinitionBrowser >> updateUtilityList [ - self definitionDo: [ :definition | - utilityList items: definition utilityDefinitions ] + self definitionDo: [ :definition | + utilityList items: definition utilityDefinitions ]. + attributeList refresh ] { #category : #menus } @@ -1009,12 +952,6 @@ RMDAgentDefinitionBrowser >> utilityListMenu [ icon: self addIcon; enabled: addUtilityButton isEnabled; action: [ self addUtility ] ]; - addItem: [ :item | - item - name: 'Edit'; - icon: self editIcon; - enabled: editUtilityButton isEnabled; - action: [ self editUtility ] ]; addItem: [ :item | item name: 'Remove'; diff --git a/src/ReMobidyc-Spec2/RMDAnimatDefinitionBrowser.class.st b/src/ReMobidyc-Spec2/RMDAnimatDefinitionBrowser.class.st index 3abcb4f..ab79c68 100644 --- a/src/ReMobidyc-Spec2/RMDAnimatDefinitionBrowser.class.st +++ b/src/ReMobidyc-Spec2/RMDAnimatDefinitionBrowser.class.st @@ -35,7 +35,6 @@ RMDAnimatDefinitionBrowser class >> defaultLayout [ add: #moveUpAttributeButton width: self buttonHeight; add: #moveDownAttributeButton width: self buttonHeight; - add: #editAttributeButton width: self buttonHeight; add: #spreadAttributeButton width: self buttonHeight; yourself) height: self buttonHeight; @@ -55,7 +54,6 @@ RMDAnimatDefinitionBrowser class >> defaultLayout [ add: #removeUtilityButton width: self buttonHeight; add: #moveUpUtilityButton width: self buttonHeight; add: #moveDownUtilityButton width: self buttonHeight; - add: #editUtilityButton width: self buttonHeight; add: #spreadUtilityButton width: self buttonHeight; yourself) height: self buttonHeight; @@ -125,19 +123,6 @@ RMDAnimatDefinitionBrowser >> addIconRendererMenu [ (RMDAnimatIconRenderer on: animat iconName: iconName) ] ] ] ] ] -{ #category : #private } -RMDAnimatDefinitionBrowser >> addInitializerWithAttribute: aRMDAttributeNode animat: aString [ - - self simulationModel simulationDefinition animatInitializers do: [ - :animatInitializer | - animatInitializer animat = aString ifTrue: [ - animatInitializer attributeInitializers: - (animatInitializer attributeInitializers copyWith: - (RMDAttributeInitializerNode - identifier: aRMDAttributeNode identifier - expression: nil)) ] ] -] - { #category : #operations } RMDAnimatDefinitionBrowser >> addNewIconToSimulationModelDo: aBlock [ @@ -248,17 +233,6 @@ RMDAnimatDefinitionBrowser >> initializePresenters [ yourself ] -{ #category : #private } -RMDAnimatDefinitionBrowser >> removeInitializerWithAttribute: aRMDAttributeNode animat: aString [ - - self simulationModel simulationDefinition animatInitializers do: [ - :animatInitializer | - animatInitializer animat = aString ifTrue: [ - animatInitializer attributeInitializers: - (animatInitializer attributeInitializers reject: [ :initializer | - initializer identifier = aRMDAttributeNode identifier ]) ] ] -] - { #category : #operations } RMDAnimatDefinitionBrowser >> renameSpecies [ diff --git a/src/ReMobidyc-Spec2/RMDColorTriangleTableColumn.class.st b/src/ReMobidyc-Spec2/RMDColorTriangleTableColumn.class.st new file mode 100644 index 0000000..2449a5c --- /dev/null +++ b/src/ReMobidyc-Spec2/RMDColorTriangleTableColumn.class.st @@ -0,0 +1,244 @@ +Class { + #name : #RMDColorTriangleTableColumn, + #superclass : #SpImageTableColumn, + #instVars : [ + 'subjectBlock', + 'objectBlock', + 'utilitiesBlock', + 'simulationModelBlock', + 'namecrashBlock', + 'permitsUnresolvedAttributeReference' + ], + #classVars : [ + 'GreenTriangleIcon', + 'RedTriangleIcon', + 'YellowTriangleIcon' + ], + #category : #'ReMobidyc-Spec2-Columns' +} + +{ #category : #icons } +RMDColorTriangleTableColumn class >> greenTriangleIcon [ + + ^ GreenTriangleIcon ifNil: [ + | form canvas | + form := Form extent: 11 @ 11 depth: 32. + canvas := form getCanvas. + canvas fillColor: Color transparent. + canvas + drawPolygon: { + (2 @ 2). + (10 @ 5). + (2 @ 9) } + color: Color green + borderWidth: 1 + borderColor: Color darkGray. + GreenTriangleIcon := form ] +] + +{ #category : #icons } +RMDColorTriangleTableColumn class >> redTriangleIcon [ + + ^ RedTriangleIcon ifNil: [ + | form canvas | + form := Form extent: 11 @ 11 depth: 32. + canvas := form getCanvas. + canvas fillColor: Color transparent. + canvas + drawPolygon: { + (1 @ 1). + (10 @ 5). + (1 @ 10) } + color: Color red + borderWidth: 1 + borderColor: Color lightGray. + RedTriangleIcon := form ] +] + +{ #category : #'instance creation' } +RMDColorTriangleTableColumn class >> subjectBlock: agentNameBlock objectBlock: objectBlock utilitiesBlock: utilitiesBlock simulationModel: simulationModelBlock [ + + ^ self new + subjectBlock: agentNameBlock; + objectBlock: objectBlock; + utilitiesBlock: utilitiesBlock; + simulationModelBlock: simulationModelBlock; + yourself +] + +{ #category : #'instance creation' } +RMDColorTriangleTableColumn class >> subjectBlock: agentNameBlock utilitiesBlock: utilitiesBlock simulationModel: simulationModelBlock [ + + ^ self new + subjectBlock: agentNameBlock; + utilitiesBlock: utilitiesBlock; + simulationModelBlock: simulationModelBlock; + yourself +] + +{ #category : #icons } +RMDColorTriangleTableColumn class >> yellowTriangleIcon [ + + ^ YellowTriangleIcon ifNil: [ + | form canvas | + form := Form extent: 11 @ 11 depth: 32. + canvas := form getCanvas. + canvas fillColor: Color transparent. + canvas + drawPolygon: { + (1 @ 1). + (10 @ 5). + (1 @ 10) } + color: Color yellow + borderWidth: 1 + borderColor: Color darkGray. + YellowTriangleIcon := form ] +] + +{ #category : #defaults } +RMDColorTriangleTableColumn >> defaultEvaluation [ + + ^ [ :item | + item isCorrectSyntax + ifTrue: [ + ((item + errorNodesInTypecheck: RMDType any + subject: self subject + object: self object + utilities: self utilities + in: self simulationModel typechecker + permitUnresolvedAttributeReference: + self permitsUnresolvedAttributeReference) isEmpty and: [ + namecrashBlock isNil or: [ namecrashBlock cull: item ] ]) + ifTrue: [ self greenTriangleIcon ] + ifFalse: [ self yellowTriangleIcon ] ] + ifFalse: [ self redTriangleIcon ] ] +] + +{ #category : #icons } +RMDColorTriangleTableColumn >> greenTriangleIcon [ + + ^ self class greenTriangleIcon +] + +{ #category : #initialize } +RMDColorTriangleTableColumn >> initialize [ + + super initialize. + self evaluated: self defaultEvaluation. + self width: 14 +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> namecrashBlock [ + + ^ namecrashBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> namecrashBlock: aBlock [ + + namecrashBlock := aBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> object [ + + ^ objectBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> objectBlock [ + + ^ objectBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> objectBlock: aBlock [ + + objectBlock := aBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> permitUnresolvedAttributeReference [ + + permitsUnresolvedAttributeReference := true +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> permitsUnresolvedAttributeReference [ + + ^ permitsUnresolvedAttributeReference = true +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> permitsUnresolvedAttributeReference: aBoolean [ + + permitsUnresolvedAttributeReference := aBoolean +] + +{ #category : #icons } +RMDColorTriangleTableColumn >> redTriangleIcon [ + + ^ self class redTriangleIcon +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> simulationModel [ + + ^ simulationModelBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> simulationModelBlock [ + + ^ simulationModelBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> simulationModelBlock: aBlock [ + + simulationModelBlock := aBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> subject [ + + ^ subjectBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> subjectBlock [ + + ^ subjectBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> subjectBlock: aBlock [ + + subjectBlock := aBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> utilities [ + + ^ utilitiesBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> utilitiesBlock [ + + ^ utilitiesBlock +] + +{ #category : #accessing } +RMDColorTriangleTableColumn >> utilitiesBlock: aBlock [ + + utilitiesBlock := aBlock +] + +{ #category : #icons } +RMDColorTriangleTableColumn >> yellowTriangleIcon [ + + ^ self class yellowTriangleIcon +] diff --git a/src/ReMobidyc-Spec2/RMDExpressionTableColumn.class.st b/src/ReMobidyc-Spec2/RMDExpressionTableColumn.class.st new file mode 100644 index 0000000..2ad7b99 --- /dev/null +++ b/src/ReMobidyc-Spec2/RMDExpressionTableColumn.class.st @@ -0,0 +1,193 @@ +Class { + #name : #RMDExpressionTableColumn, + #superclass : #RMDSyntaxTableColumn, + #instVars : [ + 'basicEvaluation', + 'basicAcceptAction', + 'unitBlock', + 'subjectBlock', + 'objectBlock', + 'utilitiesBlock', + 'simulationModelBlock', + 'permitsUnresolvedAttributeReference' + ], + #category : #'ReMobidyc-Spec2-Columns' +} + +{ #category : #defaults } +RMDExpressionTableColumn >> defaultAcceptAction [ + + ^ [ :item :stringOrText | + | string expression | + string := stringOrText asString trimRight. + expression := RMDGrammar current expression end parse: + string trimRight. + expression isPetit2Success + ifTrue: [ + basicAcceptAction ifNotNil: [ + basicAcceptAction cull: item cull: expression ] ] + ifFalse: [ + self textWidgetContent: (string asText + addAttribute: TextColor red + from: (expression position + 1 min: string size max: 1) + to: string size; + yourself) ] ] +] + +{ #category : #defaults } +RMDExpressionTableColumn >> defaultColorAction [ + + ^ nil +] + +{ #category : #defaults } +RMDExpressionTableColumn >> defaultEvaluationBlock [ + + ^ [ :item | + basicEvaluation + ifNotNil: [ + (basicEvaluation cull: item) + ifNotNil: [ :expr | + expr + highlightedSourceTyped: + ((unitBlock ifNotNil: [ unitBlock cull: item ]) + ifNotNil: [ :unit | RMDType unit: unit ] + ifNil: [ RMDType any ]) + subject: self subject + object: self object + utilities: self utilities + in: self simulationModel typechecker + permitUnresolvedAttributeReference: self permitsUnresolvedAttributeReference ] + ifNil: [ '' ] ] + ifNil: [ '' ] ] +] + +{ #category : #defaults } +RMDExpressionTableColumn >> defaultTextChangedAction [ + + ^ [ :item :string :widget | + | result | + result := RMDGrammar current expression end parse: + string asString trimRight. + result isPetit2Failure ifTrue: [ + widget text runs: (string asString asText + addAttribute: TextColor red + from: (result position + 1 min: string size max: 1) + to: string size; + yourself) runs. + widget textArea compose ] ] +] + +{ #category : #accessing } +RMDExpressionTableColumn >> evaluated: aBlock [ + + basicEvaluation := aBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> object [ + + ^ objectBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDExpressionTableColumn >> objectBlock [ + + ^ objectBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> objectBlock: aBlock [ + + objectBlock := aBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> onAcceptEdition: aBlock [ + + basicAcceptAction := aBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> permitUnresolvedAttributeReference [ + + permitsUnresolvedAttributeReference := true +] + +{ #category : #accessing } +RMDExpressionTableColumn >> permitsUnresolvedAttributeReference [ + + ^ permitsUnresolvedAttributeReference = true +] + +{ #category : #accessing } +RMDExpressionTableColumn >> permitsUnresolvedAttributeReference: aBool [ + + permitsUnresolvedAttributeReference := aBool = true +] + +{ #category : #accessing } +RMDExpressionTableColumn >> simulationModel [ + + ^ simulationModelBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDExpressionTableColumn >> simulationModelBlock [ + + ^ simulationModelBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> simulationModelBlock: aBlock [ + + simulationModelBlock := aBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> subject [ + + ^ subjectBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDExpressionTableColumn >> subjectBlock [ + + ^ subjectBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> subjectBlock: aBlock [ + + subjectBlock := aBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> unitBlock [ + + ^ unitBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> unitBlock: aBlock [ + + unitBlock := aBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> utilities [ + + ^ utilitiesBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDExpressionTableColumn >> utilitiesBlock [ + + ^ utilitiesBlock +] + +{ #category : #accessing } +RMDExpressionTableColumn >> utilitiesBlock: aBlock [ + + utilitiesBlock := aBlock +] diff --git a/src/ReMobidyc-Spec2/RMDIdentifierTableColumn.class.st b/src/ReMobidyc-Spec2/RMDIdentifierTableColumn.class.st new file mode 100644 index 0000000..a29af71 --- /dev/null +++ b/src/ReMobidyc-Spec2/RMDIdentifierTableColumn.class.st @@ -0,0 +1,65 @@ +Class { + #name : #RMDIdentifierTableColumn, + #superclass : #RMDSyntaxTableColumn, + #instVars : [ + 'validationBlock' + ], + #category : #'ReMobidyc-Spec2-Columns' +} + +{ #category : #defaults } +RMDIdentifierTableColumn >> defaultAcceptAction [ + + ^ [ :item :stringOrText | + | string | + string := stringOrText asString trim. + item identifier: string. + extraAcceptAction ifNotNil: [ + extraAcceptAction cull: item cull: string ] ] +] + +{ #category : #defaults } +RMDIdentifierTableColumn >> defaultColorAction [ + + ^ [ :item | + item identifier isCorrectRMDIdentifier + ifTrue: [ + (validationBlock isNil or: [ (validationBlock cull: item) = true ]) + ifTrue: [ Color black ] + ifFalse: [ Color yellow muchDarker ] ] + ifFalse: [ Color red ] ] +] + +{ #category : #defaults } +RMDIdentifierTableColumn >> defaultEvaluationBlock [ + + ^ [ :item | item identifier ifEmpty: [ '-' ] ] +] + +{ #category : #defaults } +RMDIdentifierTableColumn >> defaultTextChangedAction [ + + ^ [ :item :string :widget | + | result | + result := RMDGrammar current identifier end parse: + string asString trimRight. + result isPetit2Failure ifTrue: [ + widget text runs: (string asString asText + addAttribute: TextColor red + from: (result position + 1 min: string size max: 1) + to: string size; + yourself) runs. + widget textArea compose ] ] +] + +{ #category : #accessing } +RMDIdentifierTableColumn >> validationBlock [ + + ^ validationBlock +] + +{ #category : #accessing } +RMDIdentifierTableColumn >> validationBlock: aBlock [ + + validationBlock := aBlock +] diff --git a/src/ReMobidyc-Spec2/RMDPatchDefinitionBrowser.class.st b/src/ReMobidyc-Spec2/RMDPatchDefinitionBrowser.class.st index f4aa6e0..b0190bd 100644 --- a/src/ReMobidyc-Spec2/RMDPatchDefinitionBrowser.class.st +++ b/src/ReMobidyc-Spec2/RMDPatchDefinitionBrowser.class.st @@ -12,18 +12,6 @@ RMDPatchDefinitionBrowser class >> on: aRMDSimulationModeler [ yourself ] -{ #category : #private } -RMDPatchDefinitionBrowser >> addInitializerWithAttribute: aRMDAttributeNode animat: anotherString [ - - self simulationModel simulationDefinition patchInitializer ifNotNil: [ - :initializer | - initializer attributeInitializers: - (initializer attributeInitializers copyWith: - (RMDAttributeInitializerNode - identifier: aRMDAttributeNode identifier - expression: nil)) ] -] - { #category : #menus } RMDPatchDefinitionBrowser >> addRendererMenu [ @@ -57,18 +45,8 @@ RMDPatchDefinitionBrowser >> agentName [ { #category : #accessing } RMDPatchDefinitionBrowser >> definitionDo: aBlock [ - self simulationModel ifNotNil: [ :model | - model patchDefinition ifNotNil: aBlock ] -] - -{ #category : #private } -RMDPatchDefinitionBrowser >> removeInitializerWithAttribute: aRMDAttributeNode animat: anotherString [ - - self simulationModel simulationDefinition patchInitializer ifNotNil: [ - :initializer | - initializer attributeInitializers: - (initializer attributeInitializers reject: [ :attributeInitializer | - attributeInitializer identifier = aRMDAttributeNode identifier ]) ] + ^ self simulationModel ifNotNil: [ :model | + model patchDefinition ifNotNil: aBlock ] ] { #category : #operations } diff --git a/src/ReMobidyc-Spec2/RMDPossessionalAgentDropListTableColumn.class.st b/src/ReMobidyc-Spec2/RMDPossessionalAgentDropListTableColumn.class.st new file mode 100644 index 0000000..a18eed7 --- /dev/null +++ b/src/ReMobidyc-Spec2/RMDPossessionalAgentDropListTableColumn.class.st @@ -0,0 +1,236 @@ +Class { + #name : #RMDPossessionalAgentDropListTableColumn, + #superclass : #SpDropListTableColumn, + #instVars : [ + 'subjectBlock', + 'objectBlock', + 'directiveBlock', + 'initialSelectionBlock' + ], + #category : #'ReMobidyc-Spec2-Columns' +} + +{ #category : #examples } +RMDPossessionalAgentDropListTableColumn class >> example [ + + ^ SpTablePresenter new + addColumn: (SpStringTableColumn title: 'Name' evaluated: #name); + addColumn: + ((SpDropListTableColumn title: 'Value' evaluated: [ {true . false} ]) + width: 50; + yourself); + items: self class environment allClasses; + beResizable; + open +] + +{ #category : #visiting } +RMDPossessionalAgentDropListTableColumn >> acceptColumnVisitor: aBuilder [ + + ^ aBuilder visitRMDPossessionalAgentDropListColumn: self +] + +{ #category : #defaults } +RMDPossessionalAgentDropListTableColumn >> defaultDisplay [ + + ^ [ :agent | self displayAgent: agent ] +] + +{ #category : #defaults } +RMDPossessionalAgentDropListTableColumn >> defaultEvaluation [ + + ^ [ self possibleAgents ] +] + +{ #category : #defaults } +RMDPossessionalAgentDropListTableColumn >> defaultInitialSelectionBlock [ + + ^ [ :attributeDefinition | attributeDefinition variable agent ] +] + +{ #category : #defaults } +RMDPossessionalAgentDropListTableColumn >> defaultSelectedItemChangedAction [ + + ^ [ :attributeDefinition :agent | + attributeDefinition variable agent: agent ] +] + +{ #category : #defaults } +RMDPossessionalAgentDropListTableColumn >> defaultStartWithSelection [ + + ^ true +] + +{ #category : #defaults } +RMDPossessionalAgentDropListTableColumn >> defaultWidth [ + + ^ 80 +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> directiveBlock [ + + ^ directiveBlock +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> directiveBlock: aBlock [ + + directiveBlock := aBlock +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> displayAgent: agent [ + + agent ifNil: [ ^ 'my' ]. + agent = #world ifTrue: [ ^ 'world''s' ]. + agent = #here ifTrue: [ ^ 'here''s' ]. + agent = #new ifTrue: [ ^ 'new' ]. + agent = #the ifTrue: [ ^ 'the' ]. + ^ agent uncapitalized , '''s' +] + +{ #category : #controlling } +RMDPossessionalAgentDropListTableColumn >> ifNewDirective: aBlock [ + + (directiveBlock ifNotNil: #value) ifNotNil: [ :lifeDirectives | + lifeDirectives contains: #hasNewAgents ] +] + +{ #category : #controlling } +RMDPossessionalAgentDropListTableColumn >> ifObject: aBlock [ + + ^ (objectBlock ifNotNil: #value) ifNotNil: aBlock +] + +{ #category : #controlling } +RMDPossessionalAgentDropListTableColumn >> ifWorldSubject: worldBlock ifPatchSubject: patchBlock ifAnimatSubject: animatBlock [ + + self subject ifNotNil: [ :subject | + subject = #World ifTrue: [ ^ worldBlock value ]. + subject = #Patch ifTrue: [ ^ patchBlock value ] ]. + ^ animatBlock value +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> initialSelection: aRMDAttributeDefinitionNode [ + + ^ initialSelectionBlock ifNotNil: [ + initialSelectionBlock cull: aRMDAttributeDefinitionNode ] +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> initialSelectionBlock [ + + ^ initialSelectionBlock +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> initialSelectionBlock: aBlock [ + + initialSelectionBlock := aBlock +] + +{ #category : #initialization } +RMDPossessionalAgentDropListTableColumn >> initialize [ + + super initialize. + evaluation := self defaultEvaluation. + display := self defaultDisplay. + self startWithSelection: self defaultInitialSelectionBlock. + selectedItemChangedAction := self defaultSelectedItemChangedAction. + self width: self defaultWidth +] + +{ #category : #testing } +RMDPossessionalAgentDropListTableColumn >> isAnimatSubject [ + + ^ (self isWorldSubject or: [ self isPatchSubject ]) not +] + +{ #category : #testing } +RMDPossessionalAgentDropListTableColumn >> isPatchSubject [ + + ^ (subjectBlock ifNotNil: #value) = 'Patch' +] + +{ #category : #testing } +RMDPossessionalAgentDropListTableColumn >> isWorldSubject [ + + ^ (subjectBlock ifNotNil: #value) = 'World' +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> object [ + + ^ objectBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> objectBlock [ + + ^ objectBlock +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> objectBlock: aBlock [ + + objectBlock := aBlock +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> possibleAgents [ + + ^ Array streamContents: [ :stream | + stream nextPut: nil. + self + ifWorldSubject: [ ] + ifPatchSubject: [ stream nextPut: #world ] + ifAnimatSubject: [ + stream + nextPut: #world; + nextPut: #here ]. + self ifObject: [ :object | stream nextPut: object uncapitalized ]. + self ifNewDirective: [ stream nextPut: #new ]. + stream nextPut: #the ] +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> startWithSelection [ + + initialSelectionBlock ifNil: [ + initialSelectionBlock := self defaultInitialSelectionBlock ]. + super startWithSelection +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> startWithSelection: aBlock [ + + initialSelectionBlock ifNil: [ initialSelectionBlock := aBlock ]. + super startWithSelection +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> startWithoutSelection [ + + initialSelectionBlock := nil. + super startWithoutSelection +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> subject [ + + ^ subjectBlock ifNotNil: #value +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> subjectBlock [ + + ^ subjectBlock +] + +{ #category : #accessing } +RMDPossessionalAgentDropListTableColumn >> subjectBlock: aBlock [ + + subjectBlock := aBlock +] diff --git a/src/ReMobidyc-Spec2/RMDPresenter.class.st b/src/ReMobidyc-Spec2/RMDPresenter.class.st index 1257e3d..edb3deb 100644 --- a/src/ReMobidyc-Spec2/RMDPresenter.class.st +++ b/src/ReMobidyc-Spec2/RMDPresenter.class.st @@ -124,6 +124,24 @@ RMDPresenter >> filterIcon [ ^ form ] +{ #category : #icons } +RMDPresenter >> greenTriangleIcon [ + + | form canvas | + form := Form extent: 11 @ 11 depth: 32. + canvas := form getCanvas. + canvas fillColor: Color transparent. + canvas + drawPolygon: { + (2 @ 2). + (10 @ 5). + (2 @ 9) } + color: Color green + borderWidth: 1 + borderColor: Color darkGray. + ^ form +] + { #category : #icons } RMDPresenter >> historyIcon [ @@ -349,6 +367,24 @@ RMDPresenter >> pushIcon [ ^ icon ] +{ #category : #icons } +RMDPresenter >> redTriangleIcon [ + + | form canvas | + form := Form extent: 11 @ 11 depth: 32. + canvas := form getCanvas. + canvas fillColor: Color transparent. + canvas + drawPolygon: { + (1 @ 1). + (10 @ 5). + (1 @ 10) } + color: Color red + borderWidth: 1 + borderColor: Color lightGray. + ^ form +] + { #category : #icons } RMDPresenter >> removeIcon [ ^ Smalltalk ui icons remove @@ -415,7 +451,7 @@ RMDPresenter >> saveIcon [ { #category : #icons } RMDPresenter >> saveIconWith: aString [ - | form label font x y | + | form label font | form := Form extent: 24 @ 24 depth: 32. font := TextStyle defaultFont. label := Form @@ -470,7 +506,8 @@ RMDPresenter >> tabularIcon [ { #category : #icons } RMDPresenter >> upIcon [ - ^ Smalltalk ui icons up + + ^ Smalltalk ui iconNamed: #up ] { #category : #icons } @@ -483,3 +520,21 @@ RMDPresenter >> updateIcon [ RMDPresenter >> versionsIcon [ ^ Smalltalk ui icons iconNamed: #smallProfile ] + +{ #category : #icons } +RMDPresenter >> yellowTriangleIcon [ + + | form canvas | + form := Form extent: 11 @ 11 depth: 32. + canvas := form getCanvas. + canvas fillColor: Color transparent. + canvas + drawPolygon: { + (1 @ 1). + (10 @ 5). + (1 @ 10) } + color: Color yellow + borderWidth: 1 + borderColor: Color darkGray. + ^ form +] diff --git a/src/ReMobidyc-Spec2/RMDSimulationModeler.class.st b/src/ReMobidyc-Spec2/RMDSimulationModeler.class.st index 4e9149a..4ebb1c4 100644 --- a/src/ReMobidyc-Spec2/RMDSimulationModeler.class.st +++ b/src/ReMobidyc-Spec2/RMDSimulationModeler.class.st @@ -285,20 +285,8 @@ RMDSimulationModeler >> initializePresenters [ { #category : #initialization } RMDSimulationModeler >> initializeWindow: aWindowPresenter [ - | cachedAns | - cachedAns := nil. super initializeWindow: aWindowPresenter. - aWindowPresenter initialExtent: 1000 @ 600. - aWindowPresenter whenWillCloseDo: [ :willCloseAnnouncement | - cachedAns ifNil: [ - cachedAns := true. - (willCloseAnnouncement canClose and: [ - UIManager default - confirm: 'Export the model before close?' - orCancel: [ - willCloseAnnouncement denyClose. - cachedAns := nil. - false ] ]) ifTrue: [ self save ] ] ] + aWindowPresenter initialExtent: 1000 @ 600 ] { #category : #private } @@ -319,6 +307,15 @@ RMDSimulationModeler >> modelFileReference: aFileReferenceOrNil [ self updateWindowTitle ] +{ #category : #controlling } +RMDSimulationModeler >> okToClose [ + + (UIManager default + confirm: 'Export the model before close?' + orCancel: [ ^ false ]) ifTrue: [ self save ]. + ^ true +] + { #category : #operations } RMDSimulationModeler >> open [ diff --git a/src/ReMobidyc-Spec2/RMDSourceTextPresenter.class.st b/src/ReMobidyc-Spec2/RMDSourceTextPresenter.class.st index 04ab8a8..0c43ef3 100644 --- a/src/ReMobidyc-Spec2/RMDSourceTextPresenter.class.st +++ b/src/ReMobidyc-Spec2/RMDSourceTextPresenter.class.st @@ -12,7 +12,8 @@ Class { '#parser', '#simulationModelBlock', '#subjectBlock', - '#objectBlock' + '#objectBlock', + '#permitsUnresolvedAttributeReference' ], #category : #'ReMobidyc-Spec2-Widgets' } @@ -139,6 +140,24 @@ RMDSourceTextPresenter >> parser: aPP2Node [ parser := aPP2Node ] +{ #category : #api } +RMDSourceTextPresenter >> permitUnresolvedAttributeReference [ + + permitsUnresolvedAttributeReference := true +] + +{ #category : #api } +RMDSourceTextPresenter >> permitsUnresolvedAttributeReference [ + + ^ permitsUnresolvedAttributeReference +] + +{ #category : #api } +RMDSourceTextPresenter >> permitsUnresolvedAttributeReference: aBool [ + + permitsUnresolvedAttributeReference := aBool = true +] + { #category : #api } RMDSourceTextPresenter >> prettyPrint [ @@ -211,27 +230,26 @@ RMDSourceTextPresenter >> typechecker [ { #category : #private } RMDSourceTextPresenter >> updateHighlights: aString [ - | errorNodes | - errorNodes := OrderedCollection new: 10. - syntaxNode - ifNotNil: [ - [ - [ self typechecker typecheck: syntaxNode subject: self subject object: self object] - on: RMDTypeError - do: [ :ex | - errorNodes add: ex node. - ex resume: ex type2 ] ] - on: RMDError - do: [ :ex | - errorNodes add: ex node. - ex resume: RMDType any ] ] - ifNil: [ - parser ifNotNil: [ - | node | - node := parser end parse: aString. - node isPetit2Failure ifTrue: [ - errorNodes add: ((node position max: 1) to: aString size) ] ] ]. - highlights := errorNodes + highlights := syntaxNode + ifNotNil: [ + syntaxNode + errorNodesInTypecheck: RMDType any + subject: self subject + object: self object + utilities: #( ) + in: self typechecker + permitUnresolvedAttributeReference: + self permitsUnresolvedAttributeReference ] + ifNil: [ + | errorNodes | + errorNodes := OrderedCollection new: 10. + parser ifNotNil: [ + | node | + node := parser end parse: aString. + node isPetit2Failure ifTrue: [ + errorNodes add: + ((node position max: 1) to: aString size) ] ]. + errorNodes ] ] { #category : #'api-events' } diff --git a/src/ReMobidyc-Spec2/RMDSyntaxTableColumn.class.st b/src/ReMobidyc-Spec2/RMDSyntaxTableColumn.class.st new file mode 100644 index 0000000..3e904f2 --- /dev/null +++ b/src/ReMobidyc-Spec2/RMDSyntaxTableColumn.class.st @@ -0,0 +1,90 @@ +Class { + #name : #RMDSyntaxTableColumn, + #superclass : #SpStringTableColumn, + #instVars : [ + 'textChangedAction', + 'extraAcceptAction' + ], + #category : #'ReMobidyc-Spec2-Columns' +} + +{ #category : #visiting } +RMDSyntaxTableColumn >> acceptColumnVisitor: aBuilder [ + + ^ aBuilder visitRMDSyntaxColumn: self +] + +{ #category : #defaults } +RMDSyntaxTableColumn >> defaultAcceptAction [ + + ^ self subclassResponsibility +] + +{ #category : #defaults } +RMDSyntaxTableColumn >> defaultColorAction [ + + ^ self subclassResponsibility +] + +{ #category : #defaults } +RMDSyntaxTableColumn >> defaultEvaluationBlock [ + + ^ self subclassResponsibility +] + +{ #category : #defaults } +RMDSyntaxTableColumn >> defaultTextChangedAction [ + + ^ self subclassResponsibility +] + +{ #category : #accessing } +RMDSyntaxTableColumn >> extraAcceptAction [ + + ^ extraAcceptAction +] + +{ #category : #accessing } +RMDSyntaxTableColumn >> extraAcceptAction: aBlock [ + + extraAcceptAction := aBlock +] + +{ #category : #initialization } +RMDSyntaxTableColumn >> initialize [ + + super initialize. + evaluation := self defaultEvaluationBlock. + textChangedAction := self defaultTextChangedAction. + acceptAction := self defaultAcceptAction. + colorAction := self defaultColorAction. + self beEditable +] + +{ #category : #accessing } +RMDSyntaxTableColumn >> textChangedAction [ + + ^ textChangedAction +] + +{ #category : #accessing } +RMDSyntaxTableColumn >> textChangedAction: aBlock [ + + textChangedAction := aBlock +] + +{ #category : #private } +RMDSyntaxTableColumn >> textWidgetContent: aText [ + + | context presenter | + context := thisContext. + presenter := nil. + [ presenter class = SpTextInputFieldPresenter ] whileFalse: [ + context := context sender. + context ifNil: [ ^ nil ]. + presenter := context receiver ]. + presenter withAdapterDo: [ :adapter | + adapter widgetDo: [ :widget | + widget text runs: aText runs. + widget textArea compose ] ] +] diff --git a/src/ReMobidyc-Spec2/RMDTaskDefinitionBrowser.class.st b/src/ReMobidyc-Spec2/RMDTaskDefinitionBrowser.class.st index 5262762..fc00784 100644 --- a/src/ReMobidyc-Spec2/RMDTaskDefinitionBrowser.class.st +++ b/src/ReMobidyc-Spec2/RMDTaskDefinitionBrowser.class.st @@ -352,7 +352,9 @@ RMDTaskDefinitionBrowser >> initializePresenters [ 'Edit the definition of the selected action'; disable; yourself. - templateText := (self newSourceWith: RMDGrammar current actionDefinition) + templateText := (self newSourceWith: + RMDGrammar current actionDefinition) + permitUnresolvedAttributeReference; enabled: false; beNotEditable; yourself. @@ -453,7 +455,8 @@ RMDTaskDefinitionBrowser >> initializePresenters [ 'Edit the selected replacement rule'; disable; yourself. - sourceText := (self newSourceWith: RMDGrammar current actionDefinition) + sourceText := (self newSourceWith: + RMDGrammar current actionDefinition) enabled: false; beNotEditable; whenLastValidSyntaxNodeChangedDo: [ :syntaxNode | ]; diff --git a/src/ReMobidyc-Spec2/RMDUnitTableColumn.class.st b/src/ReMobidyc-Spec2/RMDUnitTableColumn.class.st new file mode 100644 index 0000000..26e566d --- /dev/null +++ b/src/ReMobidyc-Spec2/RMDUnitTableColumn.class.st @@ -0,0 +1,65 @@ +Class { + #name : #RMDUnitTableColumn, + #superclass : #RMDSyntaxTableColumn, + #instVars : [ + 'basicAcceptAction' + ], + #category : #'ReMobidyc-Spec2-Columns' +} + +{ #category : #defaults } +RMDUnitTableColumn >> defaultAcceptAction [ + + ^ [ :item :stringOrText | + | string unit | + string := stringOrText asString trimRight. + unit := string + ifEmpty: [ RMDUnit noDimension ] + ifNotEmpty: [ RMDGrammar current unit end parse: string ]. + unit isPetit2Success + ifTrue: [ + item unit: unit. + extraAcceptAction ifNotNil: [ extraAcceptAction cull: item ] ] + ifFalse: [ + self textWidgetContent: (string asText + addAttribute: TextColor red + from: (unit position + 1 min: string size max: 1) + to: string size; + yourself) ] ] +] + +{ #category : #defaults } +RMDUnitTableColumn >> defaultColorAction [ + + ^ nil +] + +{ #category : #defaults } +RMDUnitTableColumn >> defaultEvaluationBlock [ + + ^ [ :item | + | unit | + unit := item unit. + unit hasDimension + ifTrue: [ unit printString ] + ifFalse: [ '' ] ] +] + +{ #category : #defaults } +RMDUnitTableColumn >> defaultTextChangedAction [ + + ^ [ :item :stringOrText :widget | + | string result | + string := stringOrText asString trimRight. + result := string + ifEmpty: [ RMDUnit noDimension ] + ifNotEmpty: [ :str | + RMDGrammar current unit end parse: str ]. + result isPetit2Failure ifTrue: [ + widget text runs: (string asText + addAttribute: TextColor red + from: (result position + 1 min: string size max: 1) + to: string size; + yourself) runs. + widget textArea compose ] ] +] diff --git a/src/ReMobidyc-Spec2/RMDVariableOperatorDropListTableColumn.class.st b/src/ReMobidyc-Spec2/RMDVariableOperatorDropListTableColumn.class.st new file mode 100644 index 0000000..b362b39 --- /dev/null +++ b/src/ReMobidyc-Spec2/RMDVariableOperatorDropListTableColumn.class.st @@ -0,0 +1,126 @@ +Class { + #name : #RMDVariableOperatorDropListTableColumn, + #superclass : #SpDropListTableColumn, + #instVars : [ + 'initialSelectionBlock' + ], + #category : #'ReMobidyc-Spec2-Columns' +} + +{ #category : #examples } +RMDVariableOperatorDropListTableColumn class >> example [ + + ^ SpTablePresenter new + addColumn: (SpStringTableColumn title: 'Name' evaluated: #name); + addColumn: + ((SpDropListTableColumn title: 'Value' evaluated: [ {true . false} ]) + width: 50; + yourself); + items: self class environment allClasses; + beResizable; + open +] + +{ #category : #visiting } +RMDVariableOperatorDropListTableColumn >> acceptColumnVisitor: aBuilder [ + + ^ aBuilder visitRMDVariableOperatorDropListColumn: self +] + +{ #category : #defaults } +RMDVariableOperatorDropListTableColumn >> defaultDisplay [ + + ^ [ :operator | operator ] +] + +{ #category : #defaults } +RMDVariableOperatorDropListTableColumn >> defaultEvaluation [ + + ^ [ self possibleOperators ] +] + +{ #category : #defaults } +RMDVariableOperatorDropListTableColumn >> defaultInitialSelectionBlock [ + + ^ [ :attributeDefinition | attributeDefinition variableOperator ] +] + +{ #category : #defaults } +RMDVariableOperatorDropListTableColumn >> defaultSelectedItemChangedAction [ + + ^ [ :attributeDefinition :operator | + attributeDefinition variableOperator: operator ] +] + +{ #category : #defaults } +RMDVariableOperatorDropListTableColumn >> defaultStartWithSelection [ + + ^ true +] + +{ #category : #defaults } +RMDVariableOperatorDropListTableColumn >> defaultWidth [ + + ^ 50 +] + +{ #category : #accessing } +RMDVariableOperatorDropListTableColumn >> initialSelection: aRMDAttributeDefinitionNode [ + + ^ initialSelectionBlock ifNotNil: [ + initialSelectionBlock cull: aRMDAttributeDefinitionNode ] +] + +{ #category : #accessing } +RMDVariableOperatorDropListTableColumn >> initialSelectionBlock [ + + ^ initialSelectionBlock +] + +{ #category : #accessing } +RMDVariableOperatorDropListTableColumn >> initialSelectionBlock: aBlock [ + + initialSelectionBlock := aBlock +] + +{ #category : #initialization } +RMDVariableOperatorDropListTableColumn >> initialize [ + + super initialize. + evaluation := self defaultEvaluation. + display := self defaultDisplay. + self startWithSelection: self defaultInitialSelectionBlock. + selectedItemChangedAction := self defaultSelectedItemChangedAction. + self width: self defaultWidth +] + +{ #category : #accessing } +RMDVariableOperatorDropListTableColumn >> possibleOperators [ + + ^ { + ''. + RMDAbstractAssignableAttributeVariableNode deltaOperator. + RMDAbstractAssignableAttributeVariableNode differentialOperator } +] + +{ #category : #accessing } +RMDVariableOperatorDropListTableColumn >> startWithSelection [ + + initialSelectionBlock ifNil: [ + initialSelectionBlock := self defaultInitialSelectionBlock ]. + super startWithSelection +] + +{ #category : #accessing } +RMDVariableOperatorDropListTableColumn >> startWithSelection: aBlock [ + + initialSelectionBlock ifNil: [ initialSelectionBlock := aBlock ]. + super startWithSelection +] + +{ #category : #accessing } +RMDVariableOperatorDropListTableColumn >> startWithoutSelection [ + + initialSelectionBlock := nil. + super startWithoutSelection +] diff --git a/src/ReMobidyc-Spec2/RMDWorldDefinitionBrowser.class.st b/src/ReMobidyc-Spec2/RMDWorldDefinitionBrowser.class.st index b7080eb..7395455 100644 --- a/src/ReMobidyc-Spec2/RMDWorldDefinitionBrowser.class.st +++ b/src/ReMobidyc-Spec2/RMDWorldDefinitionBrowser.class.st @@ -12,18 +12,6 @@ RMDWorldDefinitionBrowser class >> on: aRMDSimulationModeler [ yourself ] -{ #category : #private } -RMDWorldDefinitionBrowser >> addInitializerWithAttribute: aRMDAttributeNode animat: anotherString [ - - self simulationModel simulationDefinition worldInitializer ifNotNil: [ - :initializer | - initializer attributeInitializers: - (initializer attributeInitializers copyWith: - (RMDAttributeInitializerNode - identifier: aRMDAttributeNode identifier - expression: nil)) ] -] - { #category : #menus } RMDWorldDefinitionBrowser >> addRendererMenu [ @@ -38,8 +26,8 @@ RMDWorldDefinitionBrowser >> agentName [ { #category : #accessing } RMDWorldDefinitionBrowser >> definitionDo: aBlock [ - self simulationModel ifNotNil: [ :model | - model worldDefinition ifNotNil: aBlock ] + ^ self simulationModel ifNotNil: [ :model | + model worldDefinition ifNotNil: aBlock ] ] { #category : #initialization } @@ -49,16 +37,6 @@ RMDWorldDefinitionBrowser >> initializePresenters [ addRendererButton disable ] -{ #category : #private } -RMDWorldDefinitionBrowser >> removeInitializerWithAttribute: aRMDAttributeNode animat: anotherString [ - - self simulationModel simulationDefinition worldInitializer ifNotNil: [ - :initializer | - initializer attributeInitializers: - (initializer attributeInitializers reject: [ :attributeInitializer | - attributeInitializer identifier = aRMDAttributeNode identifier ]) ] -] - { #category : #operations } RMDWorldDefinitionBrowser >> renameAttribute: aString to: anotherString [ diff --git a/src/ReMobidyc-Spec2/SpMorphicTableCellBuilder.extension.st b/src/ReMobidyc-Spec2/SpMorphicTableCellBuilder.extension.st new file mode 100644 index 0000000..8b27625 --- /dev/null +++ b/src/ReMobidyc-Spec2/SpMorphicTableCellBuilder.extension.st @@ -0,0 +1,109 @@ +Extension { #name : #SpMorphicTableCellBuilder } + +{ #category : #'*ReMobidyc-Spec2' } +SpMorphicTableCellBuilder >> visitRMDPossessionalAgentDropListColumn: aDropListTableColumn [ + + | presenter morph | + presenter := SpDropListPresenter new + addStyle: 'table'; + items: (aDropListTableColumn readObject: self item); + yourself. + + (aDropListTableColumn initialSelection: self item) + ifNotNil: [ :selection | presenter selectItem: selection ] + ifNil: [ presenter selectIndex: 1 ]. + aDropListTableColumn display ifNotNil: [ + presenter display: aDropListTableColumn display ]. + aDropListTableColumn selectedItemChangedAction ifNotNil: [ + presenter selection whenChangedDo: [ :selection | + aDropListTableColumn selectedItemChangedAction + cull: self item + cull: (selection ifNotNil: [ presenter selectedItem ]) ] ]. + + morph := presenter build. + presenter adapter applyStyle: morph. + + self addCellMorph: morph column: aDropListTableColumn +] + +{ #category : #'*ReMobidyc-Spec2' } +SpMorphicTableCellBuilder >> visitRMDSyntaxColumn: aTableColumn [ + + | content item | + item := self item. + + content := aTableColumn readObject: item. + "add properties" + content := self + addAlignmentColumn: aTableColumn + item: item + to: content. + content := self addColorColumn: aTableColumn item: item to: content. + content := self addItalicColumn: aTableColumn item: item to: content. + content := self addBoldColumn: aTableColumn item: item to: content. + content := self + addUnderlineColumn: aTableColumn + item: item + to: content. + + aTableColumn isEditable + ifTrue: [ + self visitRMDSyntaxColumnEditable: aTableColumn on: content ] + ifFalse: [ "add cell" + self addCell: content column: aTableColumn. + "add background (this is a special case of properties, + since background needs to be applied to the cell and not to the text)" + self + addBackgroundColorColumn: aTableColumn + item: item + toMorph: cell ] +] + +{ #category : #'*ReMobidyc-Spec2' } +SpMorphicTableCellBuilder >> visitRMDSyntaxColumnEditable: aTableColumn on: content [ + + | presenter morph | + presenter := self dataSource model newTextInput + addStyle: 'compact'; + text: content; + yourself. + + "add cell" + morph := presenter build. + aTableColumn textChangedAction ifNotNil: [ :action | + presenter whenTextChangedDo: [ :text | + action cull: self item cull: text cull: morph ] ]. + aTableColumn acceptAction ifNotNil: [ :action | + presenter whenSubmitDo: [ :text | action cull: self item cull: text ]. + morph announcer + when: MorphLostFocus + do: [ action cull: self item cull: morph text ] ]. + presenter adapter applyStyle. + self addCellMorph: morph column: aTableColumn +] + +{ #category : #'*ReMobidyc-Spec2' } +SpMorphicTableCellBuilder >> visitRMDVariableOperatorDropListColumn: aDropListTableColumn [ + + | presenter morph | + presenter := SpDropListPresenter new + addStyle: 'table'; + items: (aDropListTableColumn readObject: self item); + yourself. + + (aDropListTableColumn initialSelection: self item) + ifNotNil: [ :selection | presenter selectItem: selection ] + ifNil: [ presenter selectIndex: 1 ]. + aDropListTableColumn display ifNotNil: [ + presenter display: aDropListTableColumn display ]. + aDropListTableColumn selectedItemChangedAction ifNotNil: [ + presenter selection whenChangedDo: [ :selection | + aDropListTableColumn selectedItemChangedAction + cull: self item + cull: (selection ifNotNil: [ presenter selectedItem ]) ] ]. + + morph := presenter build. + presenter adapter applyStyle: morph. + + self addCellMorph: morph column: aDropListTableColumn +] diff --git a/src/ReMobidyc-Spec2/SpWindowPresenter.extension.st b/src/ReMobidyc-Spec2/SpWindowPresenter.extension.st new file mode 100644 index 0000000..5d995eb --- /dev/null +++ b/src/ReMobidyc-Spec2/SpWindowPresenter.extension.st @@ -0,0 +1,9 @@ +Extension { #name : #SpWindowPresenter } + +{ #category : #'*ReMobidyc-Spec2' } +SpWindowPresenter >> okToClose [ + "Sent to models when a window closing. + Allows this check to be independent of okToChange." + + ^ presenter ifNotNil: #okToClose ifNil: [ super okToClose ] +]