17938860495

Committed 23 Sep 2025 07:28AM UTC coverage: 66.75% (+0.4%) from 66.37%

Build # 17938860495

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #1423 from moosetechnology/a-good-cleaning

New settings implementation

Run Details

2683 of 3100 new or added lines in 117 files covered. (86.55%)

105 existing lines in 29 files now uncovered.

20400 of 30562 relevant lines covered (66.75%)

1.33 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

90.49

/src/MooseIDE-Visualization/MiSystemComplexityBuilder.class.st

Class {
        #name : 'MiSystemComplexityBuilder',
        #superclass : 'HSimpleVisualizationBuilder',
        #instVars : [
                'nodeMooseIDDict'
        ],
        #category : 'MooseIDE-Visualization-System Complexity',
        #package : 'MooseIDE-Visualization',
        #tag : 'System Complexity'
}

{ #category : 'hooks' }
MiSystemComplexityBuilder >> addInteractionsToShape: aShape [

        | node |
        aShape announcer: self nodeAnnouncer.
        node := aShape model.
        node
                removeInteractionIfPresent: self class;
                when: HCollapseEvent do: [ :evt |
                        self rebuildShape: aShape.
                        self normalizeShapes.
                        self relayout: self container nodes parent: rootNode ]
                for: self;
                when: HExpandEvent
                do: [ :evt | self rebuildRootShape: aShape ]
                for: self
]

{ #category : 'building' }
MiSystemComplexityBuilder >> build [

        self initializeRootNode.
        self setDependencies.
        self renderIn: self container.
        self buildLegend.
        ^ self container
]

{ #category : 'building' }
MiSystemComplexityBuilder >> buildLegend [

        | legend box |
        legend := RSLegend new.
        legend withFrame.
        legend container: self container.
        legend onDemand.
        legend title: 'System complexity'.
        legend text: ' '.
        box := legend
                       polymetricWidth: mapModel widthMetric asWords
                       height: mapModel heightMetric asWords
                       box: 'Class'.
        self paintLegendBox: box.
        legend text: ' '.
        legend text: mapModel colorMetric asWords withFadingRamp: {
                        (0 -> mapModel startColor).
                        (1 -> mapModel endColor) }.
        legend text: ' '.
        legend text: 'Line = Inheritance'.
        legend build
]

{ #category : 'building' }
MiSystemComplexityBuilder >> buildNodeFromEntity: anEntity [

        | node |
        node := HNode new
                        rawModel: anEntity;
                        name: (self mapModel displayedName value: anEntity);
                        style: MiHSystemComplexityStyle new;
                        addAll:
                                ((anEntity children asOrderedCollection sort: [ :c1 :c2 |
                                                  c1 name < c2 name ]) collect: [ :e |
                                                 self buildNodeFromEntity: e ]);
                        collapse;
                        yourself.
        nodeMooseIDDict at: anEntity mooseID put: node.
        ^ node
]

{ #category : 'building' }
MiSystemComplexityBuilder >> colorBlock [

        ^ [ :e | mapModel colorMetric value: e rawModel ]
]

{ #category : 'public - hooks' }
MiSystemComplexityBuilder >> colorFor: node [
        ^ Color fromHexString: '2980B9'
]

{ #category : 'building' }
MiSystemComplexityBuilder >> elements [

        ^ self types entityStorage
]

{ #category : 'initialization' }
MiSystemComplexityBuilder >> initialize [

        super initialize.
        nodeMooseIDDict := Dictionary new
]

{ #category : 'building' }
MiSystemComplexityBuilder >> initializeRootNode [

        (rootNode := HNode new) addAll:
                (self elements collect: [ :e | self buildNodeFromEntity: e ])
]

{ #category : 'layout' }
MiSystemComplexityBuilder >> layoutOn: aGroupOfShapes parent: shape [

        aGroupOfShapes ifEmpty: [ ^ self ].

        self relayout: aGroupOfShapes parent: shape
]

{ #category : 'accessing - attributes' }
MiSystemComplexityBuilder >> menuItemStrategy [

        ^ MiSystemComplexityMenuItemStrategy new
]

{ #category : 'hooks' }
MiSystemComplexityBuilder >> nodeAnnouncer [
        "plug new events here"

        baseNode ifNotNil: [ ^ baseNode announcer ].
        baseNode := RSComposite new
                            @ self popup;
                            @ self menuInteraction;
                            @
                                    (HGhostDraggable new color:
                                                     Smalltalk ui theme caretColor);
                            @ RSNodeOnTopWhenPositionChanged new;
                            yourself.
        ^ baseNode announcer
]

{ #category : 'building' }
MiSystemComplexityBuilder >> normalizeColor [

        | colorMetric scale |
        colorMetric := mapModel colorMetric.
        scale := self
                         normalizeMetric: colorMetric
                         threshold: mapModel colorMetricThreshold.
        scale range: {
                        mapModel startColor.
                        mapModel endColor }.
        self container nodes do: [ :each |
                        (each propertyAt: #background) color:
                                (scale scale: (colorMetric value: each model rawModel)) ]
]

{ #category : 'building' }
MiSystemComplexityBuilder >> normalizeHeight [

        | heightMetric scale |
        heightMetric := mapModel heightMetric.
        scale := self
                         normalizeMetric: heightMetric
                         threshold: mapModel heightMetricThreshold.
        scale range: { 20. 400 }.
        self container nodes do: [ :each |
                        (each propertyAt: #background) height:
                                (scale scale: (heightMetric value: each model rawModel)) ]
]

{ #category : 'building' }
MiSystemComplexityBuilder >> normalizeMetric: metric threshold: threshold [
        "When all elements are homogeneous, we want to show that the difference is small by making them look similar. They are considered homogeneous when the difference between the min and max values of the metric is below the threshold."

        | min max |
        "start by finding min and max"
        min := SmallInteger maxVal.
        max := 0.
        self container nodes do: [ :shape |
                        | value |
                        value := metric value: shape model rawModel.
                        min := min min: value.
                        max := max max: value ].

        "widen the domain by the difference if it is below the threshold, which reduces the effective range and thus makes the elements more similar"
        ^ NSScale linear domain: (max - min > threshold
                           ifTrue: [
                                           {
                                                   min.
                                                   max } ]
                           ifFalse: [
                                           {
                                                   (min - max / 2 + min).
                                                   (max - min / 2 + max) } ])
]

{ #category : 'building' }
MiSystemComplexityBuilder >> normalizeShapes [

        self normalizeWidth.
        self normalizeHeight.
        self normalizeColor.
        self container nodes do: [ :canvasShape |
                        canvasShape model isExpanded ifFalse: [
                                        RSVerticalLineLayout new alignCenter on: canvasShape children.
                                        canvasShape adjustToChildren ] ]
]

{ #category : 'building' }
MiSystemComplexityBuilder >> normalizeWidth [

        | widthMetric scale |
        widthMetric := mapModel widthMetric.
        scale := self
                         normalizeMetric: widthMetric
                         threshold: mapModel widthMetricThreshold.
        scale range: { 20. 400 }.
        self container nodes do: [ :each |
                        (each propertyAt: #background) width:
                                (scale scale: (widthMetric value: each model rawModel)) ]
]

{ #category : 'building' }
MiSystemComplexityBuilder >> paintLegendBox: aComposite [

        | actualBox |
        actualBox := (aComposite nodes reject: #isLabel) anyOne.
        actualBox
                color: (mapModel startColor alphaMixed: 0.5 with: mapModel endColor);
                borderWidth: 2
]

{ #category : 'hooks' }
MiSystemComplexityBuilder >> rebuildRootShape: shape [

        super rebuildRootShape: shape.
        self relayout: self container nodes parent: self rootNode
]

{ #category : 'layout' }
MiSystemComplexityBuilder >> relayout: aGroupOfShapes parent: shape [

        RSDominanceTreeLayout new
                childrenSortBlock: [ :shapeA :shapeB | shapeA model name < shapeB model name ];
                horizontalGap: 20;
                on: aGroupOfShapes
]

{ #category : 'building' }
MiSystemComplexityBuilder >> relayoutChildren: aGroupOfShapes parent: shape [

        shape layout ifNil: [
                        RSFlowLayout new
                                gapSize: 10;
                                on: aGroupOfShapes.
                        ^ self ].
        shape layout on: aGroupOfShapes
]

{ #category : 'rendering' }
MiSystemComplexityBuilder >> renderIn: aCanvas [

        | rootShapes |
        aCanvas color: Smalltalk ui theme backgroundColor.

        rootShapes := self childrenShapes: aCanvas.
        shapes := rootShapes flatCollect: [ :s | s withAllSChildren ].
        self addInteractions: shapes.
        aCanvas schildren: rootShapes.
        aCanvas addAll: rootShapes.
        aCanvas @ self menuInteraction.
        rootNode
                when: HNodeAddedEvent
                do: [ :evt |
                        | newShape |
                        newShape := (self shapeFor: evt newChild) sparent: aCanvas.
                        newShape position: aCanvas camera position.
                        rootShapes add: newShape.
                        aCanvas add: newShape.
                        aCanvas signalUpdate ]
                for: self.

        self normalizeShapes.
        self renderLinesIn: aCanvas.
        self layoutOn: rootShapes parent: rootNode
]

{ #category : 'hooks' }
MiSystemComplexityBuilder >> renderLinesIn: aCanvas [

        | arrow |
        arrow := RSShapeFactory triangle.
        arrow extent: 10 @ 5.
        arrow := arrow asMarker.
        arrow offset: -2.5.
        RSLineBuilder orthoVertical
                shapes: aCanvas nodes;
                attachPoint: (RSVerticalAttachPoint new startOffset: 5);
                markerStart: arrow;
                connectFromAll: #dependentsFromLinks.
        aCanvas pushBackEdges
]

{ #category : 'building' }
MiSystemComplexityBuilder >> setDependencies [

        rootNode children do: [ :each | self setDependenciesFor: each ]
]

{ #category : 'building' }
MiSystemComplexityBuilder >> setDependenciesFor: aNode [

        aNode rawModel directSubclasses do: [ :e |
                        nodeMooseIDDict
                                at: e mooseID
                                ifPresent: [ :hNode | aNode dependencyTo: hNode ] ]
]

{ #category : 'accessing' }
MiSystemComplexityBuilder >> types [

        ^ self mapModel entities
]

1	Class {
2	#name : 'MiSystemComplexityBuilder',
3	#superclass : 'HSimpleVisualizationBuilder',
4	#instVars : [
5	'nodeMooseIDDict'
6	],
7	#category : 'MooseIDE-Visualization-System Complexity',
8	#package : 'MooseIDE-Visualization',
9	#tag : 'System Complexity'
10	}
11
12	{ #category : 'hooks' }
13	MiSystemComplexityBuilder >> addInteractionsToShape: aShape [	2✔
14		2✔
15	\| node \|	2✔
16	aShape announcer: self nodeAnnouncer.	2✔
17	node := aShape model.	2✔
18	node	2✔
19	removeInteractionIfPresent: self class;	2✔
20	when: HCollapseEvent do: [ :evt \|	2✔
21	self rebuildShape: aShape.	2✔
22	self normalizeShapes.	2✔
23	self relayout: self container nodes parent: rootNode ]	2✔
24	for: self;	2✔
25	when: HExpandEvent	2✔
26	do: [ :evt \| self rebuildRootShape: aShape ]	2✔
27	for: self	2✔
28	]	2✔
29
30	{ #category : 'building' }
31	MiSystemComplexityBuilder >> build [	2✔
32		2✔
33	self initializeRootNode.	2✔
34	self setDependencies.	2✔
35	self renderIn: self container.	2✔
36	self buildLegend.	2✔
37	^ self container	2✔
38	]	2✔
39
40	{ #category : 'building' }
41	MiSystemComplexityBuilder >> buildLegend [	2✔
42		2✔
43	\| legend box \|	2✔
44	legend := RSLegend new.	2✔
45	legend withFrame.	2✔
46	legend container: self container.	2✔
47	legend onDemand.	2✔
48	legend title: 'System complexity'.	2✔
49	legend text: ' '.	2✔
50	box := legend	2✔
51	polymetricWidth: mapModel widthMetric asWords	2✔
52	height: mapModel heightMetric asWords	2✔
53	box: 'Class'.	2✔
54	self paintLegendBox: box.	2✔
55	legend text: ' '.	2✔
56	legend text: mapModel colorMetric asWords withFadingRamp: {	2✔
57	(0 -> mapModel startColor).	2✔
58	(1 -> mapModel endColor) }.	2✔
59	legend text: ' '.	2✔
60	legend text: 'Line = Inheritance'.	2✔
61	legend build	2✔
62	]	2✔
63
64	{ #category : 'building' }
65	MiSystemComplexityBuilder >> buildNodeFromEntity: anEntity [	2✔
66		2✔
67	\| node \|	2✔
68	node := HNode new	2✔
69	rawModel: anEntity;	2✔
70	name: (self mapModel displayedName value: anEntity);	2✔
71	style: MiHSystemComplexityStyle new;	2✔
72	addAll:	2✔
73	((anEntity children asOrderedCollection sort: [ :c1 :c2 \|	2✔
74	c1 name < c2 name ]) collect: [ :e \|	2✔
75	self buildNodeFromEntity: e ]);	2✔
76	collapse;	2✔
77	yourself.	2✔
78	nodeMooseIDDict at: anEntity mooseID put: node.	2✔
79	^ node	2✔
80	]	2✔
81
82	{ #category : 'building' }
83	MiSystemComplexityBuilder >> colorBlock [	×
84		×
NEW 85	^ [ :e \| mapModel colorMetric value: e rawModel ]	×
86	]	×
87
88	{ #category : 'public - hooks' }
89	MiSystemComplexityBuilder >> colorFor: node [	×
90	^ Color fromHexString: '2980B9'	×
91	]	×
92
93	{ #category : 'building' }
94	MiSystemComplexityBuilder >> elements [	2✔
95		2✔
96	^ self types entityStorage	2✔
97	]	2✔
98
99	{ #category : 'initialization' }
100	MiSystemComplexityBuilder >> initialize [	2✔
101		2✔
102	super initialize.	2✔
103	nodeMooseIDDict := Dictionary new	2✔
104	]	2✔
105
106	{ #category : 'building' }
107	MiSystemComplexityBuilder >> initializeRootNode [	2✔
108		2✔
109	(rootNode := HNode new) addAll:	2✔
110	(self elements collect: [ :e \| self buildNodeFromEntity: e ])	2✔
111	]	2✔
112
113	{ #category : 'layout' }
114	MiSystemComplexityBuilder >> layoutOn: aGroupOfShapes parent: shape [	2✔
115		2✔
116	aGroupOfShapes ifEmpty: [ ^ self ].	2✔
117		2✔
118	self relayout: aGroupOfShapes parent: shape	2✔
119	]	2✔
120
121	{ #category : 'accessing - attributes' }
122	MiSystemComplexityBuilder >> menuItemStrategy [	×
123		×
124	^ MiSystemComplexityMenuItemStrategy new	×
125	]	×
126
127	{ #category : 'hooks' }
128	MiSystemComplexityBuilder >> nodeAnnouncer [	2✔
129	"plug new events here"	2✔
130		2✔
131	baseNode ifNotNil: [ ^ baseNode announcer ].	2✔
132	baseNode := RSComposite new	2✔
133	@ self popup;	2✔
134	@ self menuInteraction;	2✔
135	@	2✔
136	(HGhostDraggable new color:	2✔
137	Smalltalk ui theme caretColor);	2✔
138	@ RSNodeOnTopWhenPositionChanged new;	2✔
139	yourself.	2✔
140	^ baseNode announcer	2✔
141	]	2✔
142
143	{ #category : 'building' }
144	MiSystemComplexityBuilder >> normalizeColor [	2✔
145		2✔
146	\| colorMetric scale \|	2✔
147	colorMetric := mapModel colorMetric.	2✔
148	scale := self	2✔
149	normalizeMetric: colorMetric	2✔
150	threshold: mapModel colorMetricThreshold.	2✔
151	scale range: {	2✔
152	mapModel startColor.	2✔
153	mapModel endColor }.	2✔
154	self container nodes do: [ :each \|	2✔
155	(each propertyAt: #background) color:	2✔
156	(scale scale: (colorMetric value: each model rawModel)) ]	2✔
157	]	2✔
158
159	{ #category : 'building' }
160	MiSystemComplexityBuilder >> normalizeHeight [	2✔
161		2✔
162	\| heightMetric scale \|	2✔
163	heightMetric := mapModel heightMetric.	2✔
164	scale := self	2✔
165	normalizeMetric: heightMetric	2✔
166	threshold: mapModel heightMetricThreshold.	2✔
167	scale range: { 20. 400 }.	2✔
168	self container nodes do: [ :each \|	2✔
169	(each propertyAt: #background) height:	2✔
170	(scale scale: (heightMetric value: each model rawModel)) ]	2✔
171	]	2✔
172
173	{ #category : 'building' }
174	MiSystemComplexityBuilder >> normalizeMetric: metric threshold: threshold [	2✔
175	"When all elements are homogeneous, we want to show that the difference is small by making them look similar. They are considered homogeneous when the difference between the min and max values of the metric is below the threshold."	2✔
176		2✔
177	\| min max \|	2✔
178	"start by finding min and max"	2✔
179	min := SmallInteger maxVal.	2✔
180	max := 0.	2✔
181	self container nodes do: [ :shape \|	2✔
182	\| value \|	2✔
183	value := metric value: shape model rawModel.	2✔
184	min := min min: value.	2✔
185	max := max max: value ].	2✔
186		2✔
187	"widen the domain by the difference if it is below the threshold, which reduces the effective range and thus makes the elements more similar"	2✔
188	^ NSScale linear domain: (max - min > threshold	2✔
189	ifTrue: [	2✔
190	{	2✔
191	min.	2✔
192	max } ]	2✔
193	ifFalse: [	2✔
194	{	2✔
195	(min - max / 2 + min).	2✔
196	(max - min / 2 + max) } ])	2✔
197	]	2✔
198
199	{ #category : 'building' }
200	MiSystemComplexityBuilder >> normalizeShapes [	2✔
201		2✔
202	self normalizeWidth.	2✔
203	self normalizeHeight.	2✔
204	self normalizeColor.	2✔
205	self container nodes do: [ :canvasShape \|	2✔
206	canvasShape model isExpanded ifFalse: [	2✔
207	RSVerticalLineLayout new alignCenter on: canvasShape children.	2✔
208	canvasShape adjustToChildren ] ]	2✔
209	]	2✔
210
211	{ #category : 'building' }
212	MiSystemComplexityBuilder >> normalizeWidth [	2✔
213		2✔
214	\| widthMetric scale \|	2✔
215	widthMetric := mapModel widthMetric.	2✔
216	scale := self	2✔
217	normalizeMetric: widthMetric	2✔
218	threshold: mapModel widthMetricThreshold.	2✔
219	scale range: { 20. 400 }.	2✔
220	self container nodes do: [ :each \|	2✔
221	(each propertyAt: #background) width:	2✔
222	(scale scale: (widthMetric value: each model rawModel)) ]	2✔
223	]	2✔
224
225	{ #category : 'building' }
226	MiSystemComplexityBuilder >> paintLegendBox: aComposite [	2✔
227		2✔
228	\| actualBox \|	2✔
229	actualBox := (aComposite nodes reject: #isLabel) anyOne.	2✔
230	actualBox	2✔
231	color: (mapModel startColor alphaMixed: 0.5 with: mapModel endColor);	2✔
232	borderWidth: 2	2✔
233	]	2✔
234
235	{ #category : 'hooks' }
236	MiSystemComplexityBuilder >> rebuildRootShape: shape [	×
237		×
238	super rebuildRootShape: shape.	×
239	self relayout: self container nodes parent: self rootNode	×
240	]	×
241
242	{ #category : 'layout' }
243	MiSystemComplexityBuilder >> relayout: aGroupOfShapes parent: shape [	2✔
244		2✔
245	RSDominanceTreeLayout new	2✔
246	childrenSortBlock: [ :shapeA :shapeB \| shapeA model name < shapeB model name ];	2✔
247	horizontalGap: 20;	2✔
248	on: aGroupOfShapes	2✔
249	]	2✔
250
251	{ #category : 'building' }
252	MiSystemComplexityBuilder >> relayoutChildren: aGroupOfShapes parent: shape [	×
253		×
NEW 254	shape layout ifNil: [	×
NEW 255	RSFlowLayout new	×
NEW 256	gapSize: 10;	×
NEW 257	on: aGroupOfShapes.	×
NEW 258	^ self ].	×
NEW 259	shape layout on: aGroupOfShapes	×
UNCOV 260	]	×
261
262	{ #category : 'rendering' }
263	MiSystemComplexityBuilder >> renderIn: aCanvas [	2✔
264		2✔
265	\| rootShapes \|	2✔
266	aCanvas color: Smalltalk ui theme backgroundColor.	2✔
267		2✔
268	rootShapes := self childrenShapes: aCanvas.	2✔
269	shapes := rootShapes flatCollect: [ :s \| s withAllSChildren ].	2✔
270	self addInteractions: shapes.	2✔
271	aCanvas schildren: rootShapes.	2✔
272	aCanvas addAll: rootShapes.	2✔
273	aCanvas @ self menuInteraction.	2✔
274	rootNode	2✔
275	when: HNodeAddedEvent	2✔
276	do: [ :evt \|	2✔
277	\| newShape \|	2✔
278	newShape := (self shapeFor: evt newChild) sparent: aCanvas.	2✔
279	newShape position: aCanvas camera position.	2✔
280	rootShapes add: newShape.	2✔
281	aCanvas add: newShape.	2✔
282	aCanvas signalUpdate ]	2✔
283	for: self.	2✔
284		2✔
285	self normalizeShapes.	2✔
286	self renderLinesIn: aCanvas.	2✔
287	self layoutOn: rootShapes parent: rootNode	2✔
288	]	2✔
289
290	{ #category : 'hooks' }
291	MiSystemComplexityBuilder >> renderLinesIn: aCanvas [	2✔
292		2✔
293	\| arrow \|	2✔
294	arrow := RSShapeFactory triangle.	2✔
295	arrow extent: 10 @ 5.	2✔
296	arrow := arrow asMarker.	2✔
297	arrow offset: -2.5.	2✔
298	RSLineBuilder orthoVertical	2✔
299	shapes: aCanvas nodes;	2✔
300	attachPoint: (RSVerticalAttachPoint new startOffset: 5);	2✔
301	markerStart: arrow;	2✔
302	connectFromAll: #dependentsFromLinks.	2✔
303	aCanvas pushBackEdges	2✔
304	]	2✔
305
306	{ #category : 'building' }
307	MiSystemComplexityBuilder >> setDependencies [	2✔
308		2✔
309	rootNode children do: [ :each \| self setDependenciesFor: each ]	2✔
310	]	2✔
311
312	{ #category : 'building' }
313	MiSystemComplexityBuilder >> setDependenciesFor: aNode [	2✔
314		2✔
315	aNode rawModel directSubclasses do: [ :e \|	2✔
316	nodeMooseIDDict	2✔
317	at: e mooseID	2✔
318	ifPresent: [ :hNode \| aNode dependencyTo: hNode ] ]	2✔
319	]	2✔
320
321	{ #category : 'accessing' }
322	MiSystemComplexityBuilder >> types [	2✔
323		2✔
324	^ self mapModel entities	2✔
325	]	2✔

moosetechnology / MooseIDE / 17938860495

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous