diff --git a/src/Molecule-Examples/MolMyClockSystem.class.st b/src/Molecule-Examples/MolMyClockSystem.class.st index ddbdf531..4eb6c46a 100644 --- a/src/Molecule-Examples/MolMyClockSystem.class.st +++ b/src/Molecule-Examples/MolMyClockSystem.class.st @@ -29,16 +29,16 @@ MolMyClockSystem class >> start [ | cm | cm := MolComponentManager default. self deploy. - - cm homeServices instanciateComponent: MolMyServerTimeComponentImpl. - cm homeServices instanciateComponent: MolMyClockComponentImpl. - cm homeServices instanciateComponent: MolMyUserFacadeComponentImpl. - cm homeServices instanciateComponent: MolMyAlarmComponentImpl. - + + cm homeServices instantiateComponent: MolMyServerTimeComponentImpl. + cm homeServices instantiateComponent: MolMyClockComponentImpl. + cm homeServices instantiateComponent: MolMyUserFacadeComponentImpl. + cm homeServices instantiateComponent: MolMyAlarmComponentImpl. + cm homeServices activateComponent: MolMyServerTimeComponentImpl. cm homeServices activateComponent: MolMyClockComponentImpl. cm homeServices activateComponent: MolMyUserFacadeComponentImpl. - cm homeServices activateComponent: MolMyAlarmComponentImpl. + cm homeServices activateComponent: MolMyAlarmComponentImpl ] { #category : #launcher } diff --git a/src/Molecule-IDE/MolComponentImpl.extension.st b/src/Molecule-IDE/MolComponentImpl.extension.st index 6685d2fe..71cf0d9d 100644 --- a/src/Molecule-IDE/MolComponentImpl.extension.st +++ b/src/Molecule-IDE/MolComponentImpl.extension.st @@ -16,7 +16,7 @@ MolComponentImpl >> asRSMoleculeShape [ fontSize: 18; yourself. - contracts := MolComponentToRoassal contractFromMolComponentImpl: self. + contracts := MolComponentToRoassal makeContractShapesFor: self. RSVerticalLineLayout new alignCenter; @@ -39,11 +39,17 @@ MolComponentImpl >> asRSMoleculeShape [ composite adjustToChildren. composite extent: composite extent + (0 @ 20). composite @ (RSMenuActivable new menuDo: [ :aMenuMorph :anRSBox | - aMenuMorph - add: 'Inspect' - target: self - selector: #inspect - argument: #( ) ]). + (aMenuMorph + add: 'Inspect component' + target: self + selector: #inspect + argument: #( )) icon: + (Smalltalk ui icons iconNamed: #smallInspectIt). + (aMenuMorph + add: 'Browse component' + target: self + selector: #browse + argument: #( )) icon: (Smalltalk ui icons iconNamed: #nautilus) ]). ^ composite ] diff --git a/src/Molecule-IDE/MolComponentToRoassal.class.st b/src/Molecule-IDE/MolComponentToRoassal.class.st index a7bebe90..725d0769 100644 --- a/src/Molecule-IDE/MolComponentToRoassal.class.st +++ b/src/Molecule-IDE/MolComponentToRoassal.class.st @@ -11,20 +11,24 @@ Class { #category : #'Molecule-IDE-Inspectors' } +{ #category : #resources } +MolComponentToRoassal class >> activateLogoOf: aRSBox [ + + (aRSBox propertyAt: #activateLogo) value +] + { #category : #model } MolComponentToRoassal class >> associationsAllConsumedEventsAndTargetsFor: aMolComponent [ ^ aMolComponent componentConnector - ifNotNil: [ :e | - e eventsSubscribers associations collect: [ :asso | + ifNotNil: [ :connector | + connector eventsSubscribers associations collect: [ :asso | MolRSContractModelTarget new eventClass: asso key; name: asso value; component: aMolComponent; - color: self eventColor; - rsLogo: self eventLogoIn; yourself ] ] - ifNil: [ OrderedCollection new ] + ifNil: [ { } ] ] { #category : #model } @@ -35,8 +39,6 @@ MolComponentToRoassal class >> associationsAllProducedEventsAndTargetsFor: aMolC eventClass: event; name: aMolComponent componentName; component: aMolComponent; - color: self eventColor; - rsLogo: self eventLogoOut; yourself ] ] @@ -48,8 +50,6 @@ MolComponentToRoassal class >> associationsAllProvidedParametersAndTargetsFor: a eventClass: event; name: aMolComponent componentName; component: aMolComponent; - color: self parameterColor; - rsLogo: self parameterLogoOut; yourself ] ] @@ -61,8 +61,6 @@ MolComponentToRoassal class >> associationsAllProvidedServicesAndTargetsFor: aMo eventClass: event; name: aMolComponent componentName; component: aMolComponent; - color: self serviceColor; - rsLogo: self serviceLogoOut; yourself ] ] @@ -70,32 +68,28 @@ MolComponentToRoassal class >> associationsAllProvidedServicesAndTargetsFor: aMo MolComponentToRoassal class >> associationsAllUsedParametersAndTargetsFor: aMolComponent [ ^ aMolComponent componentConnector - ifNotNil: [ :e | - e parametersProviders associations collect: [ :asso | + ifNotNil: [ :connector | + connector parametersProviders associations collect: [ :asso | MolRSContractModelTarget new eventClass: asso key; name: asso value; component: aMolComponent; - color: self parameterColor; - rsLogo: self parameterLogoIn; yourself ] ] - ifNil: [ OrderedCollection new ] + ifNil: [ { } ] ] { #category : #model } MolComponentToRoassal class >> associationsAllUsedServicesAndTargetsFor: aMolComponent [ ^ aMolComponent componentConnector - ifNotNil: [ :e | - e servicesProviders associations collect: [ :asso | + ifNotNil: [ :connector | + connector servicesProviders associations collect: [ :asso | MolRSContractModelTarget new eventClass: asso key; name: asso value; component: aMolComponent; - color: self serviceColor; - rsLogo: self serviceLogoIn; yourself ] ] - ifNil: [ OrderedCollection new ] + ifNil: [ { } ] ] { #category : #'instance creation' } @@ -145,13 +139,16 @@ MolComponentToRoassal class >> canvasFromMultipleComponents: aCollectionOfCompon allAssociatedTargets do: [ :target | lineBuilder useAssociation: source -> target. "We use the rsShape included in the model to update the logo display on the graph." - source rsLogoActivate. - target rsLogoActivate. + self activateLogoOf: (lineBuilder fromShapes shapeFromModel: source). + self activateLogoOf: (lineBuilder toShapes shapeFromModel: target). ghostLineBuilder useAssociation: source component -> target component ] ]. - + "We change the color of not connected components" - componentShapes reject: [ :shape | shape hasLines ] thenDo: [ :notConnectedComponent | notConnectedComponent color: Color yellow muchLighter ]. + componentShapes + reject: [ :shape | shape hasLines ] + thenDo: [ :notConnectedComponent | + notConnectedComponent color: Color yellow muchLighter ]. "We create a layout for the components: - if they are not connected: they will be aligned on the top-left corner. @@ -186,104 +183,67 @@ MolComponentToRoassal class >> canvasFromSingleComponent: aMolComponent [ ^ canvas ] -{ #category : #'instance creation' } -MolComponentToRoassal class >> contractFromMolComponentImpl: aMolComponent [ +{ #category : #color } +MolComponentToRoassal class >> contractColorFor: aMolRSContractModel [ - | contractsAll contractsIn contractsOut model | - contractsIn := self contractsInFor: aMolComponent. - contractsOut := self contractsOutFor: aMolComponent. + (aMolRSContractModel eventClass includesTrait: MolComponentEvents) + ifTrue: [ ^ self eventColor ]. + (aMolRSContractModel eventClass includesTrait: MolComponentServices) + ifTrue: [ ^ self serviceColor ]. + ^ self parameterColor +] - model := contractsIn model asOrderedCollection - , contractsOut model asOrderedCollection. +{ #category : #resources } +MolComponentToRoassal class >> contractLogoFor: aMolRSContractModel [ - (contractsIn children isEmpty and: [ - contractsOut children isNotEmpty ]) ifTrue: [ - contractsIn - add: (RSBox new - extent: contractsOut extent; - color: Color transparent; - model: aMolComponent; - yourself); - adjustToChildren ]. - (contractsOut children isEmpty and: [ - contractsIn children isNotEmpty ]) ifTrue: [ - contractsOut - add: (RSBox new - extent: contractsIn extent; - color: Color transparent; - model: aMolComponent; - yourself); - adjustToChildren ]. + (aMolRSContractModel eventClass includesTrait: MolComponentEvents) + ifTrue: [ ^ self eventLogo ]. + (aMolRSContractModel eventClass includesTrait: MolComponentServices) + ifTrue: [ ^ self serviceLogo ]. + ^ self parameterLogo +] - contractsAll := RSComposite new - shapes: { - contractsIn. - contractsOut }; - yourself. - contractsAll model: model. +{ #category : #color } +MolComponentToRoassal class >> eventColor [ - RSHorizontalLineLayout new - alignTop; - on: contractsAll shapes. - contractsAll adjustToChildren. - ^ contractsAll + ^ Color blue muchLighter ] -{ #category : #'instance creation' } -MolComponentToRoassal class >> contractsFromMolRSContracts: aCollectionOfMolRSContractModel [ - - ^ aCollectionOfMolRSContractModel collect: [ :rsContractModel | - | linkBox eventBox eventName logo | - eventName := RSLabel new - text: rsContractModel eventClass printString; - color: Color black; - yourself. - - eventBox := RSBox new - withBorder; - color: rsContractModel color; - extent: eventName extent + 10; - cornerRadius: rsContractModel rsCornerRadius; - yourself. - - linkBox := RSBox new - extent: 1 asPoint; - color: Color transparent; - model: rsContractModel; - yourself. - logo := rsContractModel rsLogo. - rsContractModel isContractSource - ifTrue: [ - linkBox position: eventBox extent x / 2 @ 0. - logo position: eventBox extent x / -2 - 16 @ 0 ] - ifFalse: [ - linkBox position: eventBox extent x / -2 @ 0. - logo position: eventBox extent x / 2 + 16 @ 0 ]. - - RSComposite new - shapes: { - linkBox. - eventBox. - eventName. - logo }; - adjustToChildren; - model: rsContractModel eventClass; - yourself ] +{ #category : #resources } +MolComponentToRoassal class >> eventLogo [ + + | rsLogoIn rsLogoOut | + rsLogoIn := RSPieSlice new + withBorder; + externalRadius: 12; + innerRadius: 9; + alphaAngle: -90; + betaAngle: 90; + color: self eventColor; + yourself. + rsLogoOut := RSCircle new + withBorder; + color: self eventColor; + size: 10 asPoint; + yourself. + ^ RSComposite new shapes: { + rsLogoIn. + rsLogoOut } ] { #category : #'instance creation' } -MolComponentToRoassal class >> contractsInFor: aMolComponent [ +MolComponentToRoassal class >> makeContractConsumerShapesFor: aMolComponent [ | connectors services events parameters | - services := self contractsFromMolRSContracts: - (self associationsAllUsedServicesAndTargetsFor: - aMolComponent) sorted. - events := self contractsFromMolRSContracts: - (self associationsAllConsumedEventsAndTargetsFor: - aMolComponent) sorted. - parameters := self contractsFromMolRSContracts: - (self associationsAllUsedParametersAndTargetsFor: - aMolComponent) sorted. + services := (self associationsAllUsedServicesAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeSingleContractShapeFor: each ]. + events := (self associationsAllConsumedEventsAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeSingleContractShapeFor: each ]. + parameters := (self associationsAllUsedParametersAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeSingleContractShapeFor: each ]. connectors := RSComposite new shapes: events , services , parameters; @@ -299,18 +259,19 @@ MolComponentToRoassal class >> contractsInFor: aMolComponent [ ] { #category : #'instance creation' } -MolComponentToRoassal class >> contractsOutFor: aMolComponent [ +MolComponentToRoassal class >> makeContractProviderShapesFor: aMolComponent [ - | connectors services events parameters | - services := self contractsFromMolRSContracts: - (self associationsAllProvidedServicesAndTargetsFor: - aMolComponent) sorted. - events := self contractsFromMolRSContracts: - (self associationsAllProducedEventsAndTargetsFor: - aMolComponent) sorted. - parameters := self contractsFromMolRSContracts: - (self associationsAllProvidedParametersAndTargetsFor: - aMolComponent) sorted. + | connectors events services parameters | + + services := (self associationsAllProvidedServicesAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeSingleContractShapeFor: each ]. + events := (self associationsAllProducedEventsAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeSingleContractShapeFor: each ]. + parameters := (self associationsAllProvidedParametersAndTargetsFor: + aMolComponent) sorted collect: [ :each | + self makeSingleContractShapeFor: each ]. connectors := RSComposite new shapes: events , services , parameters; @@ -325,50 +286,123 @@ MolComponentToRoassal class >> contractsOutFor: aMolComponent [ ^ connectors ] -{ #category : #color } -MolComponentToRoassal class >> eventColor [ +{ #category : #'instance creation' } +MolComponentToRoassal class >> makeContractShapesFor: aMolComponent [ - ^ Color blue muchLighter -] + | contractsAll contractsIn contractsOut model | + contractsIn := self makeContractConsumerShapesFor: aMolComponent. + contractsOut := self makeContractProviderShapesFor: aMolComponent. -{ #category : #resources } -MolComponentToRoassal class >> eventLogo [ + model := contractsIn model asOrderedCollection + , contractsOut model asOrderedCollection. - | rsLogoIn rsLogoOut | - rsLogoIn := RSPieSlice new - withBorder; - externalRadius: 12; - innerRadius: 9; - alphaAngle: -90; - betaAngle: 90; - color: self eventColor; - yourself. - rsLogoOut := RSCircle new - withBorder; - color: self eventColor; - size: 10 asPoint; - yourself. - ^ RSComposite new shapes: { - rsLogoIn. - rsLogoOut } -] + (contractsIn children isEmpty and: [ + contractsOut children isNotEmpty ]) ifTrue: [ + contractsIn + add: (RSBox new + extent: contractsOut extent; + color: Color transparent; + model: aMolComponent; + yourself); + adjustToChildren ]. + (contractsOut children isEmpty and: [ + contractsIn children isNotEmpty ]) ifTrue: [ + contractsOut + add: (RSBox new + extent: contractsIn extent; + color: Color transparent; + model: aMolComponent; + yourself); + adjustToChildren ]. -{ #category : #resources } -MolComponentToRoassal class >> eventLogoIn [ + contractsAll := RSComposite new + shapes: { + contractsIn. + contractsOut }; + yourself. + contractsAll model: model. - | rsLogo | - rsLogo := self eventLogo. - rsLogo nodes second color: Color transparent; border: nil. - ^ rsLogo + RSHorizontalLineLayout new + alignTop; + on: contractsAll shapes. + contractsAll adjustToChildren. + ^ contractsAll ] -{ #category : #resources } -MolComponentToRoassal class >> eventLogoOut [ +{ #category : #'instance creation' } +MolComponentToRoassal class >> makeSingleContractShapeFor: aMolRSContractModel [ - | rsLogo | - rsLogo := self eventLogo. - rsLogo nodes first color: Color transparent; border: nil. - ^ rsLogo + | linkBox eventBox eventName logo composite color | + eventName := RSLabel new + text: aMolRSContractModel eventClass printString; + color: Color black; + yourself. + + color := self contractColorFor: aMolRSContractModel. + eventBox := RSBox new + withBorder; + color: color; + extent: eventName extent + 10; + yourself. + + logo := self contractLogoFor: aMolRSContractModel. + linkBox := RSBox new + extent: 1 asPoint; + color: Color transparent; + model: aMolRSContractModel; + propertyAt: #activateLogo put: [ + logo nodes do: [ :each | + each + color: (color + alpha: 1; + adjustSaturation: 0.3 brightness: 0.09); + withBorder ] ]; + yourself. + + aMolRSContractModel isContractSource + ifTrue: [ + eventBox cornerRadius: (RSCornerRadius new left: 10). + linkBox position: eventBox extent x / 2 @ 0. + logo nodes first + color: Color transparent; + border: nil. + logo position: eventBox extent x / -2 - 16 @ 0 ] + ifFalse: [ + eventBox cornerRadius: (RSCornerRadius new right: 10). + linkBox position: eventBox extent x / -2 @ 0. + logo nodes second + color: Color transparent; + border: nil. + logo position: eventBox extent x / 2 + 16 @ 0 ]. + + composite := RSComposite new + shapes: { + linkBox. + eventBox. + eventName. + logo }; + adjustToChildren; + model: aMolRSContractModel eventClass; + yourself. + composite @ (RSMenuActivable new menuDo: [ :aMenuMorph :anRSBox | + | separator | + separator := false. + (aMenuMorph + add: 'Browse Trait' + target: aMolRSContractModel eventClass + selector: #browse + argument: #( )) icon: (Smalltalk ui icons iconNamed: #nautilus). + aMolRSContractModel eventClass selectors do: [ :selector | + (aMolRSContractModel canBreakOn: selector) ifTrue: [ + separator ifFalse: [ + separator := true. + aMenuMorph addSeparator ]. + (aMenuMorph + add: 'Halt once on #' , selector + target: aMolRSContractModel + selector: #breakOnceOnSelector: + argument: selector) icon: (Smalltalk ui icons iconNamed: #halt) ] ] ]). + ^ composite ] { #category : #color } @@ -404,28 +438,6 @@ MolComponentToRoassal class >> parameterLogo [ rsLogoOut } ] -{ #category : #resources } -MolComponentToRoassal class >> parameterLogoIn [ - - | rsLogo | - rsLogo := self parameterLogo. - rsLogo nodes second - color: Color transparent; - border: nil. - ^ rsLogo -] - -{ #category : #resources } -MolComponentToRoassal class >> parameterLogoOut [ - - | rsLogo | - rsLogo := self parameterLogo. - rsLogo nodes first - color: Color transparent; - border: nil. - ^ rsLogo -] - { #category : #color } MolComponentToRoassal class >> serviceColor [ @@ -461,28 +473,6 @@ MolComponentToRoassal class >> serviceLogo [ rsLogoOut } ] -{ #category : #resources } -MolComponentToRoassal class >> serviceLogoIn [ - - | rsLogo | - rsLogo := self serviceLogo. - rsLogo nodes second - color: Color transparent; - border: nil. - ^ rsLogo -] - -{ #category : #resources } -MolComponentToRoassal class >> serviceLogoOut [ - - | rsLogo | - rsLogo := self serviceLogo. - rsLogo nodes first - color: Color transparent; - border: nil. - ^ rsLogo -] - { #category : #'see class side' } MolComponentToRoassal >> seeClassSide [ ] diff --git a/src/Molecule-IDE/MolHomeServices.extension.st b/src/Molecule-IDE/MolHomeServices.extension.st index 30911401..87c53869 100644 --- a/src/Molecule-IDE/MolHomeServices.extension.st +++ b/src/Molecule-IDE/MolHomeServices.extension.st @@ -6,9 +6,21 @@ MolHomeServices >> inspectionDeployedComponentsGraph [ | canvas components | components := self deployedComponents flatCollect: #values. - canvas := MolComponentToRoassal canvasFromMultipleComponents: components. + canvas := MolComponentToRoassal canvasFromMultipleComponents: + components. ^ SpRoassalInspectorPresenter new canvas: canvas; yourself ] + +{ #category : #'*Molecule-IDE' } +MolHomeServices >> openRoassalView [ + + | components canvas | + components := self deployedComponents flatCollect: #values. + canvas := MolComponentToRoassal canvasFromMultipleComponents: + components. + + ^ canvas openWithTitle: 'MolHomeService' +] diff --git a/src/Molecule-IDE/MolRSContractModel.class.st b/src/Molecule-IDE/MolRSContractModel.class.st index f2d92594..9f6c0971 100644 --- a/src/Molecule-IDE/MolRSContractModel.class.st +++ b/src/Molecule-IDE/MolRSContractModel.class.st @@ -15,29 +15,34 @@ Class { #instVars : [ 'component', 'name', - 'eventClass', - 'color', - 'rsLogo' + 'eventClass' ], #category : #'Molecule-IDE-Inspectors' } +{ #category : #testing } +MolRSContractModel class >> isAbstract [ + + ^ self == MolRSContractModel +] + { #category : #comparing } MolRSContractModel >> <= aMolRSContractModel [ ^ self eventClass name < aMolRSContractModel eventClass name ] -{ #category : #accessing } -MolRSContractModel >> color [ +{ #category : #debug } +MolRSContractModel >> breakOnceOnSelector: aSelector [ + + (self component breakOnceOnCallTo: aSelector) - ^ color ] -{ #category : #accessing } -MolRSContractModel >> color: anObject [ +{ #category : #debug } +MolRSContractModel >> canBreakOn: aString [ - color := anObject + ^ self explicitRequirement ] { #category : #accessing } @@ -67,7 +72,7 @@ MolRSContractModel >> eventClass: anObject [ { #category : #testing } MolRSContractModel >> isContractSource [ - ^ false + ^ self explicitRequirement ] { #category : #accessing } @@ -81,26 +86,3 @@ MolRSContractModel >> name: anObject [ name := anObject ] - -{ #category : #'as yet unclassified' } -MolRSContractModel >> rsCornerRadius [ - - ^ self shouldBeImplemented -] - -{ #category : #'as yet unclassified' } -MolRSContractModel >> rsLogo [ - - ^ rsLogo -] - -{ #category : #accessing } -MolRSContractModel >> rsLogo: aRSComposite [ - rsLogo := aRSComposite -] - -{ #category : #'as yet unclassified' } -MolRSContractModel >> rsLogoActivate [ - - self rsLogo nodes do: [ :each | each color: (self color alpha: 1; adjustSaturation: 0.3 brightness: 0.09); withBorder ] -] diff --git a/src/Molecule-IDE/MolRSContractModelSource.class.st b/src/Molecule-IDE/MolRSContractModelSource.class.st index f3097df7..8e889074 100644 --- a/src/Molecule-IDE/MolRSContractModelSource.class.st +++ b/src/Molecule-IDE/MolRSContractModelSource.class.st @@ -8,13 +8,14 @@ Class { } { #category : #testing } -MolRSContractModelSource >> isContractSource [ +MolRSContractModelSource >> canBreakOn: aString [ + + ^ (self eventClass includesTrait: MolComponentServices) or: [ self eventClass includesTrait: MolComponentParameters ] - ^ true ] -{ #category : #'as yet unclassified' } -MolRSContractModelSource >> rsCornerRadius [ +{ #category : #testing } +MolRSContractModelSource >> isContractSource [ - ^ RSCornerRadius new left: 10 + ^ true ] diff --git a/src/Molecule-IDE/MolRSContractModelTarget.class.st b/src/Molecule-IDE/MolRSContractModelTarget.class.st index 6c82102a..5bdead73 100644 --- a/src/Molecule-IDE/MolRSContractModelTarget.class.st +++ b/src/Molecule-IDE/MolRSContractModelTarget.class.st @@ -7,7 +7,14 @@ Class { #category : #'Molecule-IDE-Inspectors' } -{ #category : #'as yet unclassified' } -MolRSContractModelTarget >> rsCornerRadius [ - ^ RSCornerRadius new right: 10 +{ #category : #testing } +MolRSContractModelTarget >> canBreakOn: aString [ + ^ self eventClass includesTrait: MolComponentEvents + +] + +{ #category : #testing } +MolRSContractModelTarget >> isContractSource [ + + ^ false ]