Optimize expand all children. Was taking too much time.

src/Hierarchical-Model-Events/HExpandChildrenEvent.class.st

@@ -0,0 +1,8 @@
+"
+Event signaling that all chidren in the canvas.
+"
+Class {
+	#name : #HExpandChildrenEvent,
+	#superclass : #HEvent,
+	#category : #'Hierarchical-Model-Events'
+}

src/Hierarchical-Model/HNode.class.st

@@ -269,7 +269,8 @@ HNode >> expand [
 
 { #category : #public }
 HNode >> expandChildren [
-	children do: [ :child | child expand ].
+	children do: [ :child | child isExpanded: true ].
+	self announce: HExpandChildrenEvent new
 ]
 
 { #category : #public }
@@ -381,6 +382,12 @@ HNode >> isExpanded [
 	^ isExpanded
 ]
 
+{ #category : #testing }
+HNode >> isExpanded: aBoolean [ 
+
+	isExpanded := aBoolean
+]
+
 { #category : #testing }
 HNode >> isLinksExpanded [
 	^ isLinksExpanded

src/Hierarchical-Roassal3-Menu/HExpandCanvasChildrenMenuItem.class.st

@@ -9,7 +9,7 @@ Class {
 
 { #category : #execution }
 HExpandCanvasChildrenMenuItem >> execute [
-	visualization rootNode expandChildren
+	[visualization rootNode expandChildren] timeProfile
 ]
 
 { #category : #accessing }

src/Hierarchical-Roassal3/HDefaultStyle.class.st

@@ -61,6 +61,7 @@ HDefaultStyle >> buildCompositeFullNodeIn: shape [
 	shape schildren: childrenShapes.
 	childrenShapes do: [ :child | child sparent: shape ].
 	children := childrenShapes asShape padding: 10.
+	children useRTree.
 	childrenShapes do: [ :child | child model position: child position ].
 	title width < children width
 		ifTrue: [ 

src/Hierarchical-Roassal3/HSimpleVisualizationBuilder.class.st

@@ -277,6 +277,13 @@ HSimpleVisualizationBuilder >> elasticBoxFor: aRSCanvas [
 	^ elastic
 ]
 
+{ #category : #hooks }
+HSimpleVisualizationBuilder >> expandChildren [
+
+	self container shapes do: #remove.
+	self renderIn: self container
+]
+
 { #category : #hooks }
 HSimpleVisualizationBuilder >> fixShadowForSelectedShape: shape and: newShape [
 	| canvas selectedShapes border |
@@ -487,35 +494,44 @@ HSimpleVisualizationBuilder >> removeShapeWithAllChildren: shape [
 
 ]
 
-{ #category : #hooks }
+{ #category : #rendering }
 HSimpleVisualizationBuilder >> 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 send: #addNewNode: to: self.
+
+	aCanvas useRTree.
+	(aCanvas hasInteraction: RSMenuActivable) ifFalse: [
+		aCanvas @ self menuInteraction ].
+	(aCanvas hasInteraction: self) ifFalse: [  
+	rootNode
+		when: HNodeAddedEvent send: #addNewNode: to: self;
+		when: HExpandChildrenEvent
+		do: [ :evt | self expandChildren ]
+		for: self] .
 	self renderLinesIn: aCanvas.
 	self layoutOn: rootShapes parent: rootNode
 ]
 
 { #category : #hooks }
 HSimpleVisualizationBuilder >> renderLinesIn: aCanvas [
+
 	| announcer high |
 	self lineBuilder
 		canvas: aCanvas;
 		shapes: shapes;
-		connectFromAll: #dependentsFromLinks.
+		connectFromAll: [ :n | n dependentsFromLinks ].
 	announcer := Announcer new.
 	high := RSHighlightable red.
 	high onShape: announcer.
 	self menuInteraction onShape: announcer.
-	aCanvas lines do: [ :line| line announcer: announcer ].
+	aCanvas lines do: [ :line | line announcer: announcer ]
 ]
 
 { #category : #accessing }