From 7105d0e1e6690a0e3b08a9f3edbedb2c337a243b Mon Sep 17 00:00:00 2001 From: ClotildeToullec Date: Tue, 3 Oct 2023 16:03:34 +0200 Subject: [PATCH 1/3] Fix #asMooseSpecializedGroup --- src/Moose-Core/MooseGroup.class.st | 6 ++++++ src/Moose-Core/MooseSpecializedGroup.class.st | 1 + src/Moose-Core/Object.extension.st | 1 + 3 files changed, 8 insertions(+) diff --git a/src/Moose-Core/MooseGroup.class.st b/src/Moose-Core/MooseGroup.class.st index 8f202c20..ca9e5467 100644 --- a/src/Moose-Core/MooseGroup.class.st +++ b/src/Moose-Core/MooseGroup.class.st @@ -51,6 +51,12 @@ MooseGroup >> addAll: collection [ self entityStorage addAll: collection ] +{ #category : #converting } +MooseGroup >> asMooseSpecializedGroup [ + + ^ self specialize +] + { #category : #private } MooseGroup >> changeTypeTo: aSmalltalkClass [ self class == aSmalltalkClass ifTrue: [ ^ self ]. diff --git a/src/Moose-Core/MooseSpecializedGroup.class.st b/src/Moose-Core/MooseSpecializedGroup.class.st index df8d1424..91d02940 100644 --- a/src/Moose-Core/MooseSpecializedGroup.class.st +++ b/src/Moose-Core/MooseSpecializedGroup.class.st @@ -20,6 +20,7 @@ MooseSpecializedGroup class >> annotation [ { #category : #'instance creation' } MooseSpecializedGroup class >> withAll: collection [ + ^ (self = MooseSpecializedGroup ifTrue: [ collection commonSuperclass relatedGroupType ] ifFalse: [ self ]) new diff --git a/src/Moose-Core/Object.extension.st b/src/Moose-Core/Object.extension.st index feea9b19..c860ca5f 100644 --- a/src/Moose-Core/Object.extension.st +++ b/src/Moose-Core/Object.extension.st @@ -15,6 +15,7 @@ Object >> asMooseGroup [ { #category : #'*moose-core' } Object >> asMooseSpecializedGroup [ + ^ MooseSpecializedGroup with: self ] From a864ba6c7e95cf5ebe78fe46544436127697ca48 Mon Sep 17 00:00:00 2001 From: ClotildeToullec Date: Tue, 3 Oct 2023 16:04:30 +0200 Subject: [PATCH 2/3] Move Famix-Visualizations from Moose --- .../FM3Class.extension.st | 7 + .../FameClassConnections.class.st | 178 +++++++ .../FamixAnnotationTypeGroup.extension.st | 14 + ...xAnnotationTypeGroupConstellation.class.st | 112 ++++ .../FamixNamespaceGroup.extension.st | 20 + .../FamixNamespaceGroupHierarchy.class.st | 82 +++ ...mixNamespaceGroupOverallHierarchy.class.st | 61 +++ .../FamixPackageGroup.extension.st | 14 + .../FamixPackageGroupComplexity.class.st | 133 +++++ .../FamixTAttribute.extension.st | 7 + .../FamixTMethod.extension.st | 7 + .../FamixTType.extension.st | 26 + .../FamixTypeBlueprint.class.st | 208 ++++++++ .../FamixTypeGroup.extension.st | 47 ++ ...FamixTypeGroupBlueprintComplexity.class.st | 109 ++++ .../FamixTypeGroupNesting.class.st | 105 ++++ .../FamixTypeGroupSystemAttraction.class.st | 222 ++++++++ .../FamixTypeGroupSystemComplexity.class.st | 177 +++++++ .../FamixTypeUML.class.st | 69 +++ .../MooseAbstractVisualization.class.st | 90 ++++ .../MooseFameView.class.st | 74 +++ .../MooseGroup.extension.st | 7 + .../MooseGroupNameCloud.class.st | 107 ++++ .../MooseModel.extension.st | 15 + .../OverviewPyramid.class.st | 480 ++++++++++++++++++ .../OverviewPyramidMetrics.class.st | 170 +++++++ .../PyramidBrickFactory.class.st | 95 ++++ src/Famix-Visualizations/package.st | 1 + 28 files changed, 2637 insertions(+) create mode 100644 src/Famix-Visualizations/FM3Class.extension.st create mode 100644 src/Famix-Visualizations/FameClassConnections.class.st create mode 100644 src/Famix-Visualizations/FamixAnnotationTypeGroup.extension.st create mode 100644 src/Famix-Visualizations/FamixAnnotationTypeGroupConstellation.class.st create mode 100644 src/Famix-Visualizations/FamixNamespaceGroup.extension.st create mode 100644 src/Famix-Visualizations/FamixNamespaceGroupHierarchy.class.st create mode 100644 src/Famix-Visualizations/FamixNamespaceGroupOverallHierarchy.class.st create mode 100644 src/Famix-Visualizations/FamixPackageGroup.extension.st create mode 100644 src/Famix-Visualizations/FamixPackageGroupComplexity.class.st create mode 100644 src/Famix-Visualizations/FamixTAttribute.extension.st create mode 100644 src/Famix-Visualizations/FamixTMethod.extension.st create mode 100644 src/Famix-Visualizations/FamixTType.extension.st create mode 100644 src/Famix-Visualizations/FamixTypeBlueprint.class.st create mode 100644 src/Famix-Visualizations/FamixTypeGroup.extension.st create mode 100644 src/Famix-Visualizations/FamixTypeGroupBlueprintComplexity.class.st create mode 100644 src/Famix-Visualizations/FamixTypeGroupNesting.class.st create mode 100644 src/Famix-Visualizations/FamixTypeGroupSystemAttraction.class.st create mode 100644 src/Famix-Visualizations/FamixTypeGroupSystemComplexity.class.st create mode 100644 src/Famix-Visualizations/FamixTypeUML.class.st create mode 100644 src/Famix-Visualizations/MooseAbstractVisualization.class.st create mode 100644 src/Famix-Visualizations/MooseFameView.class.st create mode 100644 src/Famix-Visualizations/MooseGroup.extension.st create mode 100644 src/Famix-Visualizations/MooseGroupNameCloud.class.st create mode 100644 src/Famix-Visualizations/MooseModel.extension.st create mode 100644 src/Famix-Visualizations/OverviewPyramid.class.st create mode 100644 src/Famix-Visualizations/OverviewPyramidMetrics.class.st create mode 100644 src/Famix-Visualizations/PyramidBrickFactory.class.st create mode 100644 src/Famix-Visualizations/package.st diff --git a/src/Famix-Visualizations/FM3Class.extension.st b/src/Famix-Visualizations/FM3Class.extension.st new file mode 100644 index 00000000..3700678a --- /dev/null +++ b/src/Famix-Visualizations/FM3Class.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #FM3Class } + +{ #category : #'*Famix-Visualizations' } +FM3Class >> connections [ + + ^ FameClassConnections forFameClass: self +] diff --git a/src/Famix-Visualizations/FameClassConnections.class.st b/src/Famix-Visualizations/FameClassConnections.class.st new file mode 100644 index 00000000..61ef389a --- /dev/null +++ b/src/Famix-Visualizations/FameClassConnections.class.st @@ -0,0 +1,178 @@ +" +I show commplex properties of a F3Class. + +The class is shown in blue, as well as its complex properties. +The opposites of these properties are shown in gray, as well as their type. +In light blue is shown the relation between each property and its opposite. +" +Class { + #name : #FameClassConnections, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'fameClass' + ], + #category : #'Famix-Visualizations-Fame' +} + +{ #category : #accessing } +FameClassConnections class >> defaultTitle [ + ^ 'Connections' +] + +{ #category : #'as yet unclassified' } +FameClassConnections class >> forFameClass: aFM3Class [ + ^ self new + fameClass: aFM3Class; + yourself +] + +{ #category : #accessing } +FameClassConnections class >> icon [ + ^ MooseIcons mooseDependencies +] + +{ #category : #building } +FameClassConnections >> build [ + | classNode complexPropertyTypes complexProperties oppositeProperties | + classNode := self buildClassNode. + complexPropertyTypes := self buildOppositeClassesNodes. + complexProperties := self buildPropertiesNodes. + oppositeProperties := self buildOppositePropertiesNodes. + self connectClassNode: classNode toProperties: complexProperties. + self + connectProperties: complexProperties + toOpposites: oppositeProperties. + self + connectOpposites: oppositeProperties + toClass: classNode + orOtherType: complexPropertyTypes. + canvas pushBackEdges. + RSForceBasedLayout new on: canvas nodes. + super build +] + +{ #category : #building } +FameClassConnections >> buildClassNode [ + | classNode | + classNode := (self nodeFor: fameClass) + color: self highlightColor; + size: self typeNodeSize; + yourself. + canvas add: classNode. + ^ classNode +] + +{ #category : #building } +FameClassConnections >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend + text: 'FM3Class and its complex properties' + withCircleColor: self highlightColor. + legend + text: 'Properties opposites and their type (can be the FM3Class)' + withCircleColor: self oppositeColor. + legend + text: 'Opposites relations' + withBoxColor: (self highlightColor alpha: 0.5). + legend build +] + +{ #category : #building } +FameClassConnections >> buildOppositeClassesNodes [ + | nodes | + nodes := (((fameClass complexProperties collect: #type) \ {fameClass}) + asSet + collect: [ :class | + (self nodeFor: class) + color: self oppositeColor; + size: self typeNodeSize; + yourself ]) asArray. + canvas addAll: nodes. + ^ nodes +] + +{ #category : #building } +FameClassConnections >> buildOppositePropertiesNodes [ + | nodes | + nodes := (fameClass complexProperties + collect: #opposite + thenReject: #isNil) + collect: [ :opposite | + (self nodeFor: opposite) + color: self oppositeColor; + yourself ]. + canvas addAll: nodes. + ^ nodes +] + +{ #category : #building } +FameClassConnections >> buildPropertiesNodes [ + | nodes | + nodes := fameClass complexProperties + collect: [ :property | + (self nodeFor: property) + color: self highlightColor; + yourself ]. + canvas addAll: nodes. + ^ nodes +] + +{ #category : #building } +FameClassConnections >> connectClassNode: classNode toProperties: complexProperties [ + RSEdgeBuilder line + color: self highlightColor; + fromShapes: {classNode}; + toShapes: complexProperties; + connectToAll: #complexProperties +] + +{ #category : #building } +FameClassConnections >> connectOpposites: oppositeProperties toClass: classNode orOtherType: complexPropertyTypes [ + RSEdgeBuilder line + color: self oppositeColor; + fromShapes: oppositeProperties; + toShapes: {classNode} , complexPropertyTypes; + connectTo: #mmClass +] + +{ #category : #building } +FameClassConnections >> connectProperties: complexProperties toOpposites: oppositeProperties [ + RSEdgeBuilder line + color: (self highlightColor alpha: 0.5); + fromShapes: complexProperties; + toShapes: oppositeProperties; + connectTo: #opposite +] + +{ #category : #accessing } +FameClassConnections >> fameClass: aFM3Class [ + fameClass := aFM3Class +] + +{ #category : #shapes } +FameClassConnections >> highlightColor [ + ^ Color blue +] + +{ #category : #shapes } +FameClassConnections >> nodeFor: aModel [ + ^ RSCircle new + model: aModel; + popupText: #name; + draggable; + yourself +] + +{ #category : #shapes } +FameClassConnections >> oppositeColor [ + ^ Color lightGray +] + +{ #category : #shapes } +FameClassConnections >> typeNodeSize [ + ^ 20 +] diff --git a/src/Famix-Visualizations/FamixAnnotationTypeGroup.extension.st b/src/Famix-Visualizations/FamixAnnotationTypeGroup.extension.st new file mode 100644 index 00000000..e5c7178d --- /dev/null +++ b/src/Famix-Visualizations/FamixAnnotationTypeGroup.extension.st @@ -0,0 +1,14 @@ +Extension { #name : #FamixAnnotationTypeGroup } + +{ #category : #'*Famix-Visualizations' } +FamixAnnotationTypeGroup >> annotationConstellation [ + + ^ FamixAnnotationTypeGroupConstellation forAnnotationTypeGroup: self +] + +{ #category : #'*Famix-Visualizations' } +FamixAnnotationTypeGroup >> inspectorShowAnnotationConstellation [ + + + ^ self annotationConstellation asInspectorPresenter +] diff --git a/src/Famix-Visualizations/FamixAnnotationTypeGroupConstellation.class.st b/src/Famix-Visualizations/FamixAnnotationTypeGroupConstellation.class.st new file mode 100644 index 00000000..307171c4 --- /dev/null +++ b/src/Famix-Visualizations/FamixAnnotationTypeGroupConstellation.class.st @@ -0,0 +1,112 @@ +" +I show annotationTypes and the entities annotated with their instances. +" +Class { + #name : #FamixAnnotationTypeGroupConstellation, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixAnnotationTypeGroup' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixAnnotationTypeGroupConstellation class >> defaultTitle [ + ^ 'Annotations constellation' +] + +{ #category : #public } +FamixAnnotationTypeGroupConstellation class >> forAnnotationTypeGroup: aFamixAnnotationTypeGroup [ + ^ self new + famixAnnotationTypeGroup: aFamixAnnotationTypeGroup; + yourself +] + +{ #category : #accessing } +FamixAnnotationTypeGroupConstellation class >> icon [ + ^ MooseIcons mooseDependencies +] + +{ #category : #building } +FamixAnnotationTypeGroupConstellation >> build [ + | containerNodes annotationLabels | + containerNodes := self buildAnnotationContainerNodes. + annotationLabels := self buildAnnotationTypeLabels. + self connectLabels: annotationLabels toNodes: containerNodes. + RSForceBasedLayout on: canvas nodes. + canvas pushBackEdges. + super build +] + +{ #category : #building } +FamixAnnotationTypeGroupConstellation >> buildAnnotationContainerNodes [ + | annotationContainers nodes | + annotationContainers := famixAnnotationTypeGroup + flatCollectAsSet: + [ :annotationType | annotationType instances collect: #annotatedEntity ]. + nodes := annotationContainers + collect: [ :c | self nodeForAnnotatedEntity: c ]. + canvas addAll: nodes. + ^ nodes +] + +{ #category : #building } +FamixAnnotationTypeGroupConstellation >> buildAnnotationTypeLabels [ + | labels | + labels := famixAnnotationTypeGroup + collect: + [ :annotationType | self labelForAnnotationType: annotationType ]. + canvas addAll: labels. + ^ labels +] + +{ #category : #building } +FamixAnnotationTypeGroupConstellation >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend + text: 'Annotation types and the entities using their instances'. + legend text: 'Annotated entities' withCircleColor: self nodeColor. + legend build +] + +{ #category : #building } +FamixAnnotationTypeGroupConstellation >> connectLabels: annotationLabels toNodes: containerNodes [ + RSLineBuilder line + fromShapes: annotationLabels; + toShapes: containerNodes; + color: Color veryLightGray; + connectToAll: + [ :annotationType | annotationType instances collect: #annotatedEntity ] +] + +{ #category : #initialization } +FamixAnnotationTypeGroupConstellation >> famixAnnotationTypeGroup: aFamixAnnotationTypeGroup [ + famixAnnotationTypeGroup := aFamixAnnotationTypeGroup +] + +{ #category : #shapes } +FamixAnnotationTypeGroupConstellation >> labelForAnnotationType: annotationType [ + ^ (RSLabel text: annotationType name model: annotationType) + draggable; + color: Color black; + yourself +] + +{ #category : #shapes } +FamixAnnotationTypeGroupConstellation >> nodeColor [ + ^ Color lightGray +] + +{ #category : #shapes } +FamixAnnotationTypeGroupConstellation >> nodeForAnnotatedEntity: entity [ + ^ RSCircle new + model: entity; + color: self nodeColor; + popup; + draggable; + yourself +] diff --git a/src/Famix-Visualizations/FamixNamespaceGroup.extension.st b/src/Famix-Visualizations/FamixNamespaceGroup.extension.st new file mode 100644 index 00000000..78fe3d44 --- /dev/null +++ b/src/Famix-Visualizations/FamixNamespaceGroup.extension.st @@ -0,0 +1,20 @@ +Extension { #name : #FamixNamespaceGroup } + +{ #category : #'*Famix-Visualizations' } +FamixNamespaceGroup >> hierarchy [ + + ^ FamixNamespaceGroupHierarchy forNamespaceGroup: self +] + +{ #category : #'*Famix-Visualizations' } +FamixNamespaceGroup >> inspectorShowInHierarchy [ + + + ^ self withinOverallHierarchy asInspectorPresenter +] + +{ #category : #'*Famix-Visualizations' } +FamixNamespaceGroup >> withinOverallHierarchy [ + + ^ FamixNamespaceGroupOverallHierarchy forNamespaceGroup: self +] diff --git a/src/Famix-Visualizations/FamixNamespaceGroupHierarchy.class.st b/src/Famix-Visualizations/FamixNamespaceGroupHierarchy.class.st new file mode 100644 index 00000000..0da5b60a --- /dev/null +++ b/src/Famix-Visualizations/FamixNamespaceGroupHierarchy.class.st @@ -0,0 +1,82 @@ +" +I show namespaces names and their containment relations. +" +Class { + #name : #FamixNamespaceGroupHierarchy, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixNamespaceGroup' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixNamespaceGroupHierarchy class >> defaultTitle [ + ^ 'Namespaces hierarchy' +] + +{ #category : #accessing } +FamixNamespaceGroupHierarchy class >> forNamespaceGroup: aFamixNamespaceGroup [ + ^ self new + famixNamespaceGroup: aFamixNamespaceGroup; + yourself +] + +{ #category : #accessing } +FamixNamespaceGroupHierarchy class >> icon [ + ^ MooseIcons mooseSystemComplexity +] + +{ #category : #building } +FamixNamespaceGroupHierarchy >> build [ + self buildNodes. + self connectNodes. + self setLayout. + super build +] + +{ #category : #building } +FamixNamespaceGroupHierarchy >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend text: 'Edges show containment'. + legend build +] + +{ #category : #building } +FamixNamespaceGroupHierarchy >> buildNodes [ + canvas + addAll: + (famixNamespaceGroup + collect: + [ :namespace | self shapeForNamespace: namespace ]) +] + +{ #category : #building } +FamixNamespaceGroupHierarchy >> connectNodes [ + RSEdgeBuilder line + shapes: canvas nodes; + connectToAll: [ :namespace | namespace atScope: FamixTNamespace ] +] + +{ #category : #accessing } +FamixNamespaceGroupHierarchy >> famixNamespaceGroup: anObject [ + famixNamespaceGroup := anObject +] + +{ #category : #building } +FamixNamespaceGroupHierarchy >> setLayout [ + RSClusterLayout new on: canvas nodes +] + +{ #category : #shapes } +FamixNamespaceGroupHierarchy >> shapeForNamespace: namespace [ + ^ RSLabel new + model: namespace; + draggable; + text: namespace name; + yourself +] diff --git a/src/Famix-Visualizations/FamixNamespaceGroupOverallHierarchy.class.st b/src/Famix-Visualizations/FamixNamespaceGroupOverallHierarchy.class.st new file mode 100644 index 00000000..fdb852be --- /dev/null +++ b/src/Famix-Visualizations/FamixNamespaceGroupOverallHierarchy.class.st @@ -0,0 +1,61 @@ +" +I show namespaces names and their containment relations. +I show a group of namespaces and all the namespaces in their hierarchy. +Namespaces in the group are shown in black, namespace that are not in the group are shown in gray. +" +Class { + #name : #FamixNamespaceGroupOverallHierarchy, + #superclass : #FamixNamespaceGroupHierarchy, + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixNamespaceGroupOverallHierarchy class >> defaultTitle [ + ^ 'Namespace group within overall hierarchy' +] + +{ #category : #building } +FamixNamespaceGroupOverallHierarchy >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend + text: 'Namespace in the selected group' + withBoxColor: self colorForNamespaceInGroup. + legend + text: 'Namespace in the overall hierarchy' + withBoxColor: self colorForNamespaceOutsideGroup. + legend text: 'Edges show containment'. + legend build +] + +{ #category : #building } +FamixNamespaceGroupOverallHierarchy >> buildNodes [ + canvas + addAll: + ((famixNamespaceGroup + flatCollectAsSet: [ :namespace | namespace allWithScope: FamixTNamespace ]) + collect: [ :namespace | self shapeForNamespace: namespace ]) +] + +{ #category : #color } +FamixNamespaceGroupOverallHierarchy >> colorForNamespaceInGroup [ + ^ Color black +] + +{ #category : #color } +FamixNamespaceGroupOverallHierarchy >> colorForNamespaceOutsideGroup [ + ^ Color gray +] + +{ #category : #shapes } +FamixNamespaceGroupOverallHierarchy >> shapeForNamespace: namespace [ + ^ (super shapeForNamespace: namespace) + color: + ((famixNamespaceGroup includes: namespace) + ifTrue: [ self colorForNamespaceInGroup ] + ifFalse: [ self colorForNamespaceOutsideGroup ]); + yourself +] diff --git a/src/Famix-Visualizations/FamixPackageGroup.extension.st b/src/Famix-Visualizations/FamixPackageGroup.extension.st new file mode 100644 index 00000000..a22caf33 --- /dev/null +++ b/src/Famix-Visualizations/FamixPackageGroup.extension.st @@ -0,0 +1,14 @@ +Extension { #name : #FamixPackageGroup } + +{ #category : #'*Famix-Visualizations' } +FamixPackageGroup >> complexity [ + + ^ FamixPackageGroupComplexity forPackageGroup: self +] + +{ #category : #'*Famix-Visualizations' } +FamixPackageGroup >> inspectorShowComplexity [ + + + ^ self complexity asInspectorPresenter +] diff --git a/src/Famix-Visualizations/FamixPackageGroupComplexity.class.st b/src/Famix-Visualizations/FamixPackageGroupComplexity.class.st new file mode 100644 index 00000000..b030763c --- /dev/null +++ b/src/Famix-Visualizations/FamixPackageGroupComplexity.class.st @@ -0,0 +1,133 @@ +" +I show system complexity of each package in a FamixPackageGroup. + +Types are represented as boxes for which: + width = number of attributes + height = number of methods + color = number of lines of code. +Inheritance relations are show as edges. + +Missing: edges to represent inheritance between packages. For now, no layout is available that would make this information readable. +" +Class { + #name : #FamixPackageGroupComplexity, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixPackageGroup' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixPackageGroupComplexity class >> defaultTitle [ + ^ 'Packages complexity' +] + +{ #category : #accessing } +FamixPackageGroupComplexity class >> forPackageGroup: aFamixPackageGroup [ + ^ self new + famixPackageGroup: aFamixPackageGroup; + yourself +] + +{ #category : #accessing } +FamixPackageGroupComplexity class >> icon [ + ^ MooseIcons mooseDependencies +] + +{ #category : #shapes } +FamixPackageGroupComplexity >> alignLabelInShape: shape [ + RSVerticalLineLayout new + alignCenter; + on: shape nodes. + shape padding: 10 +] + +{ #category : #building } +FamixPackageGroupComplexity >> build [ + self buildNodes. + "self connectNodes." + RSFlowLayout new + gapSize: 20; + on: canvas nodes. + super build +] + +{ #category : #building } +FamixPackageGroupComplexity >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: canvas. + legend onDemand. + legend title: self class defaultTitle. + legend text: 'Packages' withBoxColor: self packageBackgroudColor. + legend title: 'Inside each package:'. + legend + polymetricWidth: 'Number of attributes' + height: 'Number of methods' + box: 'Class'. + legend text: 'Line = Inheritance'. + legend + text: 'Number of lines of code' + withFadingRamp: + {(0 -> 'white'). + (1 -> 'black')}. + legend build +] + +{ #category : #building } +FamixPackageGroupComplexity >> buildNodes [ + canvas + addAll: + (famixPackageGroup + collect: [ :package | self shapeForPackage: package ]) +] + +{ #category : #building } +FamixPackageGroupComplexity >> connectNodes [ + RSEdgeBuilder line + shapes: canvas nodes; + connectToAll: + [ :package | package queryIncomingInheritances atScope: FamixTPackage ]. + canvas pushBackEdges +] + +{ #category : #accessing } +FamixPackageGroupComplexity >> famixPackageGroup: anObject [ + famixPackageGroup := anObject +] + +{ #category : #shapes } +FamixPackageGroupComplexity >> labelForPackage: aPackage [ + | label | + label := RSLabel new. + label text: aPackage name. + ^ label +] + +{ #category : #color } +FamixPackageGroupComplexity >> packageBackgroudColor [ + ^ Color veryLightGray +] + +{ #category : #shapes } +FamixPackageGroupComplexity >> shapeForPackage: aPackage [ + | shape | + shape := RSComposite new + model: aPackage; + color: self packageBackgroudColor; + draggable; + popup; + add: (self labelForPackage: aPackage); + add: (self systemComplexityOf: aPackage); + yourself. + self alignLabelInShape: shape. + ^ shape +] + +{ #category : #shapes } +FamixPackageGroupComplexity >> systemComplexityOf: aPackage [ + ^ (aPackage allClasses asMooseSpecializedGroup systemComplexity + build; + yourself) canvas asShape +] diff --git a/src/Famix-Visualizations/FamixTAttribute.extension.st b/src/Famix-Visualizations/FamixTAttribute.extension.st new file mode 100644 index 00000000..be46f775 --- /dev/null +++ b/src/Famix-Visualizations/FamixTAttribute.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #FamixTAttribute } + +{ #category : #'*Famix-Visualizations' } +FamixTAttribute >> shapeInBlueprint: aFamixTypeBlueprint [ + + ^ aFamixTypeBlueprint shapeForAttribute: self +] diff --git a/src/Famix-Visualizations/FamixTMethod.extension.st b/src/Famix-Visualizations/FamixTMethod.extension.st new file mode 100644 index 00000000..9e1803b8 --- /dev/null +++ b/src/Famix-Visualizations/FamixTMethod.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #FamixTMethod } + +{ #category : #'*Famix-Visualizations' } +FamixTMethod >> shapeInBlueprint: aFamixTypeBlueprint [ + + ^ aFamixTypeBlueprint shapeForMethod: self +] diff --git a/src/Famix-Visualizations/FamixTType.extension.st b/src/Famix-Visualizations/FamixTType.extension.st new file mode 100644 index 00000000..c2a1bd97 --- /dev/null +++ b/src/Famix-Visualizations/FamixTType.extension.st @@ -0,0 +1,26 @@ +Extension { #name : #FamixTType } + +{ #category : #'*Famix-Visualizations' } +FamixTType >> accessorMethods [ + + ^ self methods select: #isPureAccessor +] + +{ #category : #'*Famix-Visualizations' } +FamixTType >> blueprint [ + + ^ FamixTypeBlueprint forType: self +] + +{ #category : #'*Famix-Visualizations' } +FamixTType >> inspectorShowBlueprint [ + + + ^ self blueprint asInspectorPresenter +] + +{ #category : #'*Famix-Visualizations' } +FamixTType >> uml [ + + ^ FamixTypeUML forType: self +] diff --git a/src/Famix-Visualizations/FamixTypeBlueprint.class.st b/src/Famix-Visualizations/FamixTypeBlueprint.class.st new file mode 100644 index 00000000..3c494494 --- /dev/null +++ b/src/Famix-Visualizations/FamixTypeBlueprint.class.st @@ -0,0 +1,208 @@ +" +I show the blueprint of a FamixTType. + +The visualization shows 5 layers: + - initialization methods + - public methods + - private methods + - accessors + - attributes + +Edges represent variable accesses and method invocations. +" +Class { + #name : #FamixTypeBlueprint, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixType' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #adding } +FamixTypeBlueprint class >> defaultTitle [ + ^ 'Blueprint' +] + +{ #category : #public } +FamixTypeBlueprint class >> forType: aFamixType [ + ^ self new + famixType: aFamixType; + yourself +] + +{ #category : #adding } +FamixTypeBlueprint class >> icon [ + ^ MooseIcons mooseBlueprint +] + +{ #category : #building } +FamixTypeBlueprint >> build [ + self buildLayers. + self buildEdges. + self nestLayers. + super build +] + +{ #category : #building } +FamixTypeBlueprint >> buildEdges [ + | builder edges | + "Accesses" + builder := self edgeBuilder + color: Color lightBlue; + yourself. + edges := famixType queryIncomingAccesses + flatCollect: [ :access | builder connectFrom: access source to: access target ]. + edges do: #pushBack. + + "Invocations" + builder color: (Color r: 0 g: 0 b: 0.8 alpha: 0.6 ). + edges := (famixType queryOutgoing: FamixTInvocation) + flatCollect: [ :acc | builder connectFrom: acc source toAll: acc candidates ]. + edges do: #pushBack +] + +{ #category : #building } +FamixTypeBlueprint >> buildLayerNamed: label withEntities: aGroup [ + | layer | + layer := RSComposite new borderColor: Color gray translucent. + layer + addAll: (aGroup collect: [ :entity | entity shapeInBlueprint: self ]). + layer popupText: label. + self canvas add: layer +] + +{ #category : #building } +FamixTypeBlueprint >> buildLayers [ + self layersEntities + keysAndValuesDo: + [ :title :entities | self buildLayerNamed: title withEntities: entities ] +] + +{ #category : #building } +FamixTypeBlueprint >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend text: 'From left to right:'. + legend + text: + ' Constructors, Public methods, Private methods, Accessors, Attributes'. + legend + text: 'Variable access' + withShape: + (RSBox new + extent: 15 @ 5; + color: Color lightBlue). + legend + text: 'Method invocation' + withShape: + (RSBox new + extent: 15 @ 5; + color: (Color r: 0 g: 0 b: 0.8 alpha: 0.6 )). + legend text: 'Setter' withBoxColor: Color red. + legend text: 'Getter' withBoxColor: Color orange. + legend text: 'Abstract' withBoxColor: Color cyan. + legend text: 'Overriding' withBoxColor: Color brown. + legend text: 'Constant' withBoxColor: Color gray. + legend build +] + +{ #category : #shapes } +FamixTypeBlueprint >> colorForMethod: aMethod [ + aMethod isPureAccessor + ifTrue: [ ^ Color orange ]. + aMethod isSetter + ifTrue: [ ^ Color red ]. + aMethod isGetter + ifTrue: [ ^ Color orange ]. + (aMethod isAbstract isNotNil and: [ aMethod isAbstract ]) + ifTrue: [ ^ Color cyan ]. + aMethod isOverriding + ifTrue: [ ^ Color brown ]. + aMethod isConstant + ifTrue: [ ^ Color gray ]. + ^ Color white +] + +{ #category : #shapes } +FamixTypeBlueprint >> edgeBuilder [ + ^ RSEdgeBuilder line + shapes: (self canvas nodes flatCollect: #children); + withHorizontalAttachPoint; + yourself +] + +{ #category : #accessing } +FamixTypeBlueprint >> famixType: aFamixType [ + famixType := aFamixType +] + +{ #category : #building } +FamixTypeBlueprint >> layersEntities [ + ^ {('Initializers' + -> (famixType methods select: [ :method | method isInitializer ])). + ('Interface methods' + -> + (famixType methods + select: [ :each | + each isInternalImplementation not & each isInitializer not + & each isPureAccessor not ])). + ('Implementation methods' + -> + (famixType methods + select: [ :method | method isInternalImplementation ])). + ('Accessors' + -> (famixType methods select: [ :method | method isPureAccessor ])). + ('Attributes' -> famixType attributes)} asOrderedDictionary +] + +{ #category : #building } +FamixTypeBlueprint >> nestLayers [ + | layers maxHeight | + layers := self canvas nodes. + RSHorizontalTreeLayout new + on: (layers flatCollect: #nodes) + edges: self canvas edges. + layers do: [ :layer | layer padding: 10 ]. + maxHeight := layers max: [ :layer | layer height ]. + layers do: [ :layer | layer height: maxHeight ]. + RSHorizontalLineLayout new + gapSize: 0; + on: layers +] + +{ #category : #shapes } +FamixTypeBlueprint >> shapeForAttribute: anAttribute [ + | shape | + shape := RSBox new + model: anAttribute; + borderColor: Color lightGray; + color: Color blue; + popup; + yourself. + shape @ RSDraggable. + ^ shape +] + +{ #category : #shapes } +FamixTypeBlueprint >> shapeForMethod: aMethod [ + | shape | + shape := RSBox new + model: aMethod; + color: (self colorForMethod: aMethod); + borderColor: Color lightGray; + width: (aMethod numberOfOutgoingInvocations max: 5); + height: (aMethod numberOfLinesOfCode max: 5); + popup; + yourself. + shape @ RSDraggable. + ^ shape +] + +{ #category : #accessing } +FamixTypeBlueprint >> windowTitle [ + ^ famixType name , ' blueprint' +] diff --git a/src/Famix-Visualizations/FamixTypeGroup.extension.st b/src/Famix-Visualizations/FamixTypeGroup.extension.st new file mode 100644 index 00000000..a13b1fc2 --- /dev/null +++ b/src/Famix-Visualizations/FamixTypeGroup.extension.st @@ -0,0 +1,47 @@ +Extension { #name : #FamixTypeGroup } + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> blueprintComplexity [ + ^ FamixTypeGroupBlueprintComplexity forTypeGroup: self +] + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> inspectorShowComplexity [ + + + ^ self systemComplexity asInspectorPresenter +] + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> inspectorShowNesting [ + + + ^ self nesting asInspectorPresenter +] + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> inspectorShowUML [ + + + ^ self uml asInspectorPresenter +] + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> nesting [ + ^ FamixTypeGroupNesting forTypeGroup: self +] + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> systemAttraction [ + ^ FamixTypeGroupSystemAttraction forTypeGroup: self +] + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> systemComplexity [ + ^ FamixTypeGroupSystemComplexity forTypeGroup: self +] + +{ #category : #'*Famix-Visualizations' } +FamixTypeGroup >> uml [ + ^ FamixTypeUML forTypeGroup: self +] diff --git a/src/Famix-Visualizations/FamixTypeGroupBlueprintComplexity.class.st b/src/Famix-Visualizations/FamixTypeGroupBlueprintComplexity.class.st new file mode 100644 index 00000000..1274deba --- /dev/null +++ b/src/Famix-Visualizations/FamixTypeGroupBlueprintComplexity.class.st @@ -0,0 +1,109 @@ +" +I show TypeBlueprints for each type in a FamixTypeGroup. + +Edges between blueprints represent hierarchy +" +Class { + #name : #FamixTypeGroupBlueprintComplexity, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixTypeGroup' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixTypeGroupBlueprintComplexity class >> defaultTitle [ + ^ 'Blueprint complexity' +] + +{ #category : #public } +FamixTypeGroupBlueprintComplexity class >> forTypeGroup: aFamixTypeGroup [ + ^ self new + famixTypeGroup: aFamixTypeGroup; + yourself +] + +{ #category : #accessing } +FamixTypeGroupBlueprintComplexity class >> icon [ + ^ MooseIcons mooseBlueprint +] + +{ #category : #shapes } +FamixTypeGroupBlueprintComplexity >> blueprintOfType: type [ + | singleBlueprint | + singleBlueprint := (type blueprint + build; + yourself) canvas asShape + model: type; + @ RSDraggable; + yourself. + + "The following is a hack: after copying shapes from singleBlueprint, shapes are unaware of their connected edges." + singleBlueprint edges + do: [ :edge | + edge from addConnectedEdge: edge. + edge to addConnectedEdge: edge ]. + + ^ singleBlueprint +] + +{ #category : #building } +FamixTypeGroupBlueprintComplexity >> build [ + self buildSingleTypeBlueprints. + self connectSingleBlueprints. + RSTreeLayout new on: canvas nodes edges: canvas edges. + super build +] + +{ #category : #building } +FamixTypeGroupBlueprintComplexity >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend text: 'Each class is composed of 5 parts, from left to right:'. + legend + text: + ' Constructors, Public methods, Private methods, Accessors, Variables'. + legend + text: 'Variable access' + withShape: + (RSBox new + extent: 15 @ 5; + color: Color lightBlue). + legend + text: 'Method invocation' + withShape: + (RSBox new + extent: 15 @ 5; + color: Color lightMagenta). + legend text: 'Setter' withBoxColor: Color red. + legend text: 'Getter' withBoxColor: Color orange. + legend text: 'Abstract' withBoxColor: Color cyan. + legend text: 'Overriding' withBoxColor: Color brown. + legend text: 'Constant' withBoxColor: Color gray. + legend build +] + +{ #category : #building } +FamixTypeGroupBlueprintComplexity >> buildSingleTypeBlueprints [ + canvas + addAll: (famixTypeGroup collect: [ :type | self blueprintOfType: type ]) +] + +{ #category : #building } +FamixTypeGroupBlueprintComplexity >> connectSingleBlueprints [ + RSEdgeBuilder line + shapes: canvas nodes; + color: Color veryLightGray; + withVerticalAttachPoint; + connectTo: [ :class | class superclass ]. + canvas pushBackEdges +] + +{ #category : #accessing } +FamixTypeGroupBlueprintComplexity >> famixTypeGroup: aFamixTypeGroup [ + famixTypeGroup := aFamixTypeGroup +] diff --git a/src/Famix-Visualizations/FamixTypeGroupNesting.class.st b/src/Famix-Visualizations/FamixTypeGroupNesting.class.st new file mode 100644 index 00000000..d4d5afb1 --- /dev/null +++ b/src/Famix-Visualizations/FamixTypeGroupNesting.class.st @@ -0,0 +1,105 @@ +" +I show package containment. + +I am built for a FamixTypeGroup. +I show all model packages and the classes they contain. +I highlight the types in the FamixTypeGroup. +" +Class { + #name : #FamixTypeGroupNesting, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixTypeGroup' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixTypeGroupNesting class >> defaultTitle [ + ^ 'Nesting' +] + +{ #category : #public } +FamixTypeGroupNesting class >> forTypeGroup: aFamixTypeGroup [ + ^ self new + famixTypeGroup: aFamixTypeGroup; + yourself +] + +{ #category : #accessing } +FamixTypeGroupNesting class >> icon [ + ^ MooseIcons mooseTreeMap +] + +{ #category : #building } +FamixTypeGroupNesting >> build [ + canvas + addAll: (self modelPackages collect: [ :c | self packageShapeFor: c ]). + RSRectanglePackLayout new + gap: 0.1; + on: canvas nodes. + super build +] + +{ #category : #building } +FamixTypeGroupNesting >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend text: 'Boxes represent packages and the classes they contain.'. + legend text: 'Selected classes' withBoxColor: Color blue muchLighter. + legend build +] + +{ #category : #shapes } +FamixTypeGroupNesting >> classShapeFor: aClass [ + ^ RSBox new + model: aClass; + color: + ((famixTypeGroup includes: aClass) + ifTrue: [ Color blue muchLighter ] + ifFalse: [ Color white ]); + borderColor: Color gray; + size: (aClass numberOfMethods max: 5); + popupText: [ :class | class name ]; + yourself +] + +{ #category : #shapes } +FamixTypeGroupNesting >> entitiesIn: aContainer [ + ^ (((aContainer toScope: FamixTPackage) copyWithout: aContainer) + collect: [ :c | self entitiesIn: c ]) + , + ((aContainer toScope: FamixTType) + reject: [ :class | class isStub ] + thenCollect: [ :c | self classShapeFor: c ]) +] + +{ #category : #accessing } +FamixTypeGroupNesting >> famixTypeGroup: aFamixTypeGroup [ + famixTypeGroup := aFamixTypeGroup +] + +{ #category : #accessing } +FamixTypeGroupNesting >> modelPackages [ + ^ famixTypeGroup mooseModel allPackages + select: [ :container | + container isRoot + and: [ (container toScope: FamixTType) anySatisfy: [ :c | c isStub not ] ] ] +] + +{ #category : #shapes } +FamixTypeGroupNesting >> packageShapeFor: aContainer [ + | composite | + composite := RSComposite new + model: aContainer; + borderColor: Color gray; + popupText: [ :c | c name ]; + yourself. + composite addAll: (self entitiesIn: aContainer). + RSRectanglePackLayout new on: composite nodes. + composite padding: 2. + ^ composite +] diff --git a/src/Famix-Visualizations/FamixTypeGroupSystemAttraction.class.st b/src/Famix-Visualizations/FamixTypeGroupSystemAttraction.class.st new file mode 100644 index 00000000..a5c1b69d --- /dev/null +++ b/src/Famix-Visualizations/FamixTypeGroupSystemAttraction.class.st @@ -0,0 +1,222 @@ +" +I show classes, their methods and attributes. + +My edges show hierarchy, containment, invocations and accesses. +See #buildLegend. +" +Class { + #name : #FamixTypeGroupSystemAttraction, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixTypeGroup' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixTypeGroupSystemAttraction class >> defaultTitle [ + ^ 'System attraction' +] + +{ #category : #public } +FamixTypeGroupSystemAttraction class >> forTypeGroup: aFamixTypeGroup [ + ^ self new + famixTypeGroup: aFamixTypeGroup; + yourself +] + +{ #category : #accessing } +FamixTypeGroupSystemAttraction class >> icon [ + ^ MooseIcons mooseCluster +] + +{ #category : #colors } +FamixTypeGroupSystemAttraction >> attributeColor [ + ^ Color r: 0.3 g: 0.3 b: 1.0 +] + +{ #category : #building } +FamixTypeGroupSystemAttraction >> build [ + | classesNodes methodsNodes attributesNodes | + classesNodes := self buildClassesNodes. + methodsNodes := self buildMethodsNodes. + attributesNodes := self buildAttributesNodes. + self connectClasses: classesNodes. + self connectClasses: classesNodes toMethods: methodsNodes. + self connectClasses: classesNodes toAttributes: attributesNodes. + self connectAccessesFrom: methodsNodes to: attributesNodes. + RSForceBasedLayout new on: canvas nodes. + + "Connecting after setting the layout so these edges are not taken into account when setting the layout. Much more clarity" + self connectInvocations: methodsNodes. + + canvas pushBackEdges. + super build +] + +{ #category : #building } +FamixTypeGroupSystemAttraction >> buildAttributesNodes [ + | attributesNodes | + attributesNodes := famixTypeGroup + flatCollect: [ :class | + class attributes + collect: [ :attribute | self shapeForAttribute: attribute ] ]. + canvas addAll: attributesNodes. + RSNormalizer size + shapes: attributesNodes; + scale: self smallSizeScale; + normalize: #numberOfAccesses. + ^ attributesNodes +] + +{ #category : #building } +FamixTypeGroupSystemAttraction >> buildClassesNodes [ + | classesNodes | + classesNodes := famixTypeGroup + collect: [ :class | self shapeForClass: class ]. + canvas addAll: classesNodes. + RSNormalizer size + shapes: classesNodes; + scale: self largeSizeScale; + normalize: #numberOfMethods. + ^ classesNodes +] + +{ #category : #building } +FamixTypeGroupSystemAttraction >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend text: 'Classes' withCircleColor: self classColor. + legend text: 'Methods' withCircleColor: self methodColor. + legend text: 'Attributes' withCircleColor: self attributeColor. + legend text: 'Inheritance' withBoxColor: self classColor. + legend text: 'Containment' withBoxColor: self classColor lighter. + legend text: 'Invocations' withBoxColor: self methodColor muchLighter. + legend text: 'Accesses' withBoxColor: self attributeColor muchLighter. + legend build +] + +{ #category : #building } +FamixTypeGroupSystemAttraction >> buildMethodsNodes [ + | methodsNodes | + methodsNodes := famixTypeGroup + flatCollect: + [ :class | class methods collect: [ :method | self shapeForMethod: method ] ]. + canvas addAll: methodsNodes. + RSNormalizer size + shapes: methodsNodes; + scale: self smallSizeScale; + normalize: [ :m | m invokedMethods size ]. + ^ methodsNodes +] + +{ #category : #colors } +FamixTypeGroupSystemAttraction >> classColor [ + ^ Color black +] + +{ #category : #edges } +FamixTypeGroupSystemAttraction >> connectAccessesFrom: methodsNodes to: attributesNodes [ + RSEdgeBuilder line + color: self attributeColor muchLighter; + fromShapes: attributesNodes; + toShapes: methodsNodes; + connectToAll: #accessingMethods +] + +{ #category : #edges } +FamixTypeGroupSystemAttraction >> connectClasses: classesNodes [ + RSEdgeBuilder line + color: self classColor; + shapes: classesNodes; + connectTo: #superclass +] + +{ #category : #edges } +FamixTypeGroupSystemAttraction >> connectClasses: classesNodes toAttributes: attributesNodes [ + RSEdgeBuilder line + color: self classColor lighter; + fromShapes: classesNodes; + toShapes: attributesNodes; + connectToAll: #attributes +] + +{ #category : #edges } +FamixTypeGroupSystemAttraction >> connectClasses: classesNodes toMethods: methodsNodes [ + RSEdgeBuilder line + color: self classColor lighter; + fromShapes: classesNodes; + toShapes: methodsNodes; + connectToAll: #methods +] + +{ #category : #edges } +FamixTypeGroupSystemAttraction >> connectInvocations: methodsNodes [ + RSLineBuilder line + borderColor: self methodColor muchLighter; + shapes: methodsNodes; + connectToAll: #invokedMethods +] + +{ #category : #initialization } +FamixTypeGroupSystemAttraction >> famixTypeGroup: aTypeGroup [ + famixTypeGroup := aTypeGroup +] + +{ #category : #shapes } +FamixTypeGroupSystemAttraction >> largeSizeScale [ + ^ NSScale linear range: {10 . 50} +] + +{ #category : #colors } +FamixTypeGroupSystemAttraction >> methodColor [ + ^ Color r: 1.0 g: 0.3 b: 0.3 +] + +{ #category : #shapes } +FamixTypeGroupSystemAttraction >> shapeForAttribute: anAttribute [ + ^ RSEllipse new + model: anAttribute; + popup; + draggable; + color: self attributeColor; + @ + (RSHighlightable + showEdges: [ :attribute | attribute accessors ] + using: (RSLine new color: self attributeColor darker)); + yourself +] + +{ #category : #shapes } +FamixTypeGroupSystemAttraction >> shapeForClass: aClass [ + ^ RSEllipse new + model: aClass; + popup; + draggable; + color: self classColor; + yourself +] + +{ #category : #shapes } +FamixTypeGroupSystemAttraction >> shapeForMethod: aMethod [ + ^ RSEllipse new + model: aMethod; + popup; + draggable; + color: self methodColor; + @ + (RSHighlightable + showEdges: [ :method | + method queryAllOutgoingInvocations opposites + , method queryAllIncomingInvocations opposites ] + using: (RSLine new color: self methodColor darker)); + yourself +] + +{ #category : #shapes } +FamixTypeGroupSystemAttraction >> smallSizeScale [ + ^ NSScale linear range: {5 . 10} +] diff --git a/src/Famix-Visualizations/FamixTypeGroupSystemComplexity.class.st b/src/Famix-Visualizations/FamixTypeGroupSystemComplexity.class.st new file mode 100644 index 00000000..cfe3cfc2 --- /dev/null +++ b/src/Famix-Visualizations/FamixTypeGroupSystemComplexity.class.st @@ -0,0 +1,177 @@ +" +I show types in a FamixTypeGroup. + +Types are represented as boxes for which: + width = number of attributes + height = number of methods + color = number of lines of code. + +Inheritance relations are show as edges. +" +Class { + #name : #FamixTypeGroupSystemComplexity, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'famixTypeGroup', + 'widthBlock', + 'colorBlock', + 'heightBlock' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixTypeGroupSystemComplexity class >> defaultTitle [ + ^ 'System complexity' +] + +{ #category : #public } +FamixTypeGroupSystemComplexity class >> forTypeGroup: aFamixTypeGroup [ + ^ self new + famixTypeGroup: aFamixTypeGroup; + yourself +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity class >> icon [ + ^ MooseIcons mooseSystemComplexity +] + +{ #category : #shapes } +FamixTypeGroupSystemComplexity >> basicShape [ + ^ RSBox new + borderColor: Color lightGray; + popup; + yourself +] + +{ #category : #building } +FamixTypeGroupSystemComplexity >> build [ + self buildNodes. + self buildEgdes. + self setLayout. + super build +] + +{ #category : #building } +FamixTypeGroupSystemComplexity >> buildEgdes [ + RSEdgeBuilder line + shapes: canvas nodes; + withVerticalAttachPoint; + connectFromAll: #directSuperclasses. + canvas pushBackEdges +] + +{ #category : #building } +FamixTypeGroupSystemComplexity >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: canvas. + legend onDemand. + legend title: self class defaultTitle. + legend text: ''. + legend + polymetricWidth: 'Number of attributes' + height: 'Number of methods' + box: 'Class'. + legend + text: 'Number of lines of code' + withFadingRamp: + {(0 -> 'white'). + (1 -> 'black')}. + legend text: 'Line = Inheritance'. + legend build +] + +{ #category : #building } +FamixTypeGroupSystemComplexity >> buildNodes [ + canvas + addAll: + (famixTypeGroup + collect: [ :type | + self basicShape + model: type; + yourself ]). + self normalizeNodes +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity >> colorBlock [ + ^ colorBlock + ifNil: [ colorBlock := [ :type | type numberOfLinesOfCode ] ] +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity >> colorBlock: anObject [ + colorBlock := anObject +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity >> famixTypeGroup: aTypeGroup [ + famixTypeGroup := aTypeGroup +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity >> heightBlock [ + ^ heightBlock + ifNil: [ heightBlock := [ :type | type numberOfMethods ] ] +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity >> heightBlock: anObject [ + heightBlock := anObject +] + +{ #category : #normalizing } +FamixTypeGroupSystemComplexity >> normalizeNodes [ + self normalizeNodesHeight. + self normalizeNodesWidth. + self normalizeNodesColor +] + +{ #category : #normalizing } +FamixTypeGroupSystemComplexity >> normalizeNodesColor [ + RSNormalizer color + from: Color white; + to: Color black; + shapes: canvas nodes; + normalize: self colorBlock +] + +{ #category : #normalizing } +FamixTypeGroupSystemComplexity >> normalizeNodesHeight [ + RSNormalizer height + shapes: canvas nodes; + scale: self shapesSizeScale; + normalize: self heightBlock +] + +{ #category : #normalizing } +FamixTypeGroupSystemComplexity >> normalizeNodesWidth [ + + RSNormalizer width + shapes: canvas nodes; + scale: self shapesSizeScale; + normalize: self widthBlock +] + +{ #category : #building } +FamixTypeGroupSystemComplexity >> setLayout [ + RSDominanceTreeLayout new on: canvas shapes edges: canvas edges +] + +{ #category : #normalizing } +FamixTypeGroupSystemComplexity >> shapesSizeScale [ + ^ NSScale linear range: {5 . 100} +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity >> widthBlock [ + ^ widthBlock + ifNil: [ widthBlock := [ :type | type numberOfAttributes ] ] +] + +{ #category : #accessing } +FamixTypeGroupSystemComplexity >> widthBlock: anObject [ + widthBlock := anObject +] diff --git a/src/Famix-Visualizations/FamixTypeUML.class.st b/src/Famix-Visualizations/FamixTypeUML.class.st new file mode 100644 index 00000000..23de3daa --- /dev/null +++ b/src/Famix-Visualizations/FamixTypeUML.class.st @@ -0,0 +1,69 @@ +" +I show the UML representation of a FamixTType. +" +Class { + #name : #FamixTypeUML, + #superclass : #MooseAbstractVisualization, + #instVars : [ + 'builder' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +FamixTypeUML class >> defaultTitle [ + ^ 'UML class diagram' +] + +{ #category : #public } +FamixTypeUML class >> forType: aFamixType [ + ^ self new + famixType: aFamixType; + yourself +] + +{ #category : #public } +FamixTypeUML class >> forTypeGroup: aFamixTypeGroup [ + ^ self new + famixTypeGroup: aFamixTypeGroup; + yourself +] + +{ #category : #accessing } +FamixTypeUML class >> icon [ + ^ MooseIcons mooseUml +] + +{ #category : #building } +FamixTypeUML >> build [ + builder renderIn: self canvas. + super build +] + +{ #category : #building } +FamixTypeUML >> buildLegend [ + | legend | + legend := RSLegend new. + legend container: self canvas. + legend onDemand. + legend title: self class defaultTitle. + legend build +] + +{ #category : #accessing } +FamixTypeUML >> famixType: aFamixType [ + builder classes: {aFamixType} +] + +{ #category : #accessing } +FamixTypeUML >> famixTypeGroup: aFamixTypeGroup [ + builder classes: aFamixTypeGroup +] + +{ #category : #initialization } +FamixTypeUML >> initialize [ + + super initialize. + builder := RSUMLClassBuilder new. + builder modelDescriptor forFamix +] diff --git a/src/Famix-Visualizations/MooseAbstractVisualization.class.st b/src/Famix-Visualizations/MooseAbstractVisualization.class.st new file mode 100644 index 00000000..a3782ed6 --- /dev/null +++ b/src/Famix-Visualizations/MooseAbstractVisualization.class.st @@ -0,0 +1,90 @@ +" +I am the superclass of Moose visualizations, using Roassal 3. + + +I provide an API to be displayed + - in a gt pane: #appearInPaneComposite: + - in a new window: #open. + +My subclasses should define a default title and icon, and can override #...Title methods. + +I know my visualization canvas and provide an accessor for it. +" +Class { + #name : #MooseAbstractVisualization, + #superclass : #Object, + #instVars : [ + 'canvas' + ], + #category : #'Famix-Visualizations-Core' +} + +{ #category : #accessing } +MooseAbstractVisualization class >> defaultTitle [ + ^ self subclassResponsibility +] + +{ #category : #accessing } +MooseAbstractVisualization class >> icon [ + ^ self subclassResponsibility +] + +{ #category : #display } +MooseAbstractVisualization >> asInspectorPresenter [ + + self build. + ^ SpRoassal3InspectorPresenter new + canvas: self canvas; + yourself +] + +{ #category : #building } +MooseAbstractVisualization >> build [ + self buildLegend. + canvas nodes + @ + (RSMenuActivable new + menuDo: [ :menu :node | + menu addTitle: (self mooseInterestingEntityForNode: node) mooseName. + menu + addAllFrom: (self mooseInterestingEntityForNode: node) mooseMenu ]) +] + +{ #category : #building } +MooseAbstractVisualization >> buildLegend [ + self subclassResponsibility +] + +{ #category : #accessing } +MooseAbstractVisualization >> canvas [ + ^ canvas +] + +{ #category : #accessing } +MooseAbstractVisualization >> canvas: aRSCanvas [ + + canvas := aRSCanvas +] + +{ #category : #initialization } +MooseAbstractVisualization >> initialize [ + super initialize. + canvas := RSCanvas new. + canvas @ RSCanvasController new noLegend +] + +{ #category : #building } +MooseAbstractVisualization >> mooseInterestingEntityForNode: node [ + ^ node model +] + +{ #category : #display } +MooseAbstractVisualization >> open [ + self build. + ^ self canvas openWithTitle: self windowTitle +] + +{ #category : #accessing } +MooseAbstractVisualization >> windowTitle [ + ^ self class defaultTitle +] diff --git a/src/Famix-Visualizations/MooseFameView.class.st b/src/Famix-Visualizations/MooseFameView.class.st new file mode 100644 index 00000000..67c85a1b --- /dev/null +++ b/src/Famix-Visualizations/MooseFameView.class.st @@ -0,0 +1,74 @@ +" +self new open +" +Class { + #name : #MooseFameView, + #superclass : #Object, + #category : #'Famix-Visualizations-Fame' +} + +{ #category : #default } +MooseFameView class >> defaultTitle [ + + ^ 'Fame UML' +] + +{ #category : #opening } +MooseFameView class >> fameCore [ + +