From 8c40fcd653e587936ea9e3ef3c8835a3c60eeae0 Mon Sep 17 00:00:00 2001 From: Jan Bliznicenko Date: Tue, 18 Jun 2024 12:19:06 +0200 Subject: [PATCH] Moved to Tonel 3 --- .../BaselineOfOpenPonk.class.st | 19 ++-- repository/BaselineOfOpenPonk/package.st | 2 +- .../DCGTAbstractVertexOrdering.class.st | 8 +- .../DynaCASE-Layouting/DCGTEdge.class.st | 20 ++-- .../DynaCASE-Layouting/DCGTGraph.class.st | 46 ++++---- .../DynaCASE-Layouting/DCGTNode.class.st | 38 +++---- .../DCGTPartitioner.class.st | 14 +-- .../DCGTPlanarization.class.st | 10 +- .../DCGTVertexOrdering.class.st | 12 ++- .../DCGraphVizLayout.class.st | 40 +++---- .../DCGraphVizLayoutXml.class.st | 44 ++++---- .../DynaCASE-Layouting/DCLayoutUtils.class.st | 16 +-- .../DynaCASE-Layouting/DCOCNode.class.st | 24 +++-- .../DCOCOverlapEdge.class.st | 12 ++- .../DCOCQueueEntry.class.st | 36 ++++--- .../DynaCASE-Layouting/DCOCRouter.class.st | 50 ++++----- .../DCOCRouterTest.class.st | 16 +-- .../DCRTEdgeLabelLayout.class.st | 102 +++++++++--------- .../DCRTEdgeLabelLayoutTest.class.st | 26 ++--- .../DCRTEdgeLabelLayoutVisualizer.class.st | 38 +++---- .../DCRTLBipartiteGraph.class.st | 24 +++-- .../DCRTLClusterNode.class.st | 12 ++- .../DynaCASE-Layouting/DCRTLClusters.class.st | 18 ++-- .../DynaCASE-Layouting/DCRTLEdge.class.st | 14 +-- .../DCRTLFeatureNode.class.st | 12 ++- .../DynaCASE-Layouting/DCRTLGraph.class.st | 20 ++-- .../DCRTLHungarianSolver.class.st | 58 +++++----- .../DCRTLHungarianSolverTest.class.st | 24 +++-- .../DynaCASE-Layouting/DCRTLNode.class.st | 20 ++-- .../DynaCASE-Layouting/DCRTLPosition.class.st | 44 ++++---- .../DCRTLPositionNode.class.st | 16 +-- .../DynaCASE-Layouting/GraphViz.extension.st | 4 +- .../MalGraphAlgorithm.extension.st | 10 +- .../DynaCASE-Layouting/Rectangle.extension.st | 10 +- repository/DynaCASE-Layouting/package.st | 2 +- .../OpenPonk-Morphic/OPTabLabelMorph.class.st | 12 ++- .../OSWindowMorphicEventHandler.extension.st | 4 +- repository/OpenPonk-Morphic/package.st | 2 +- .../OPDownloadStats.class.st | 35 +++--- .../OpenPonk-Releaser/OPReleaser.class.st | 37 +++---- repository/OpenPonk-Releaser/package.st | 2 +- .../OPCommanderCommandDescription.class.st | 31 +++--- .../OPCommanderCommandEditorTool.class.st | 25 ++--- repository/OpenPonk-Tools/package.st | 2 +- 44 files changed, 538 insertions(+), 473 deletions(-) diff --git a/repository/BaselineOfOpenPonk/BaselineOfOpenPonk.class.st b/repository/BaselineOfOpenPonk/BaselineOfOpenPonk.class.st index df68f08bd..687855bb7 100644 --- a/repository/BaselineOfOpenPonk/BaselineOfOpenPonk.class.st +++ b/repository/BaselineOfOpenPonk/BaselineOfOpenPonk.class.st @@ -3,12 +3,13 @@ I am baseline for the core and all-in-one dynacase. https://dynacase.github.io/ " Class { - #name : #BaselineOfOpenPonk, - #superclass : #BaselineOf, - #category : #BaselineOfOpenPonk + #name : 'BaselineOfOpenPonk', + #superclass : 'BaselineOf', + #category : 'BaselineOfOpenPonk', + #package : 'BaselineOfOpenPonk' } -{ #category : #baselines } +{ #category : 'baselines' } BaselineOfOpenPonk >> baseline: spec [ @@ -30,7 +31,7 @@ BaselineOfOpenPonk >> baseline: spec [ with: #( 'OpenPonk-Core' 'OpenPonk-Morphic' 'OpenPonk-Spec' ) ] ] -{ #category : #baselines } +{ #category : 'baselines' } BaselineOfOpenPonk >> externalProjectsBaseline: spec [ spec @@ -63,7 +64,7 @@ BaselineOfOpenPonk >> externalProjectsBaseline: spec [ spec repository: 'github://pharo-graphics/RoassalExporters:v1.02' ] ] -{ #category : #baselines } +{ #category : 'baselines' } BaselineOfOpenPonk >> internalProjectsBaseline: spec [ spec baseline: 'NewTools' with: [ @@ -76,7 +77,7 @@ BaselineOfOpenPonk >> internalProjectsBaseline: spec [ spec repository: 'github://openponk/synchronized-links/repository' ] ] -{ #category : #baselines } +{ #category : 'baselines' } BaselineOfOpenPonk >> removeExplicitRequirementsFromPackage: aPackageName [ | regExp packages | @@ -94,7 +95,7 @@ BaselineOfOpenPonk >> removeExplicitRequirementsFromPackage: aPackageName [ thenDo: #removeFromSystem ] ] ] -{ #category : #baselines } +{ #category : 'baselines' } BaselineOfOpenPonk >> removePackage: aPackageName [ | regExp packages | @@ -106,7 +107,7 @@ BaselineOfOpenPonk >> removePackage: aPackageName [ each removeFromSystem ] ] -{ #category : #baselines } +{ #category : 'baselines' } BaselineOfOpenPonk >> removeRoassalExplicitRequirements [ #( Roassal Numeric RTree OpenPonk OP OntoUML ) do: [ :eachName | diff --git a/repository/BaselineOfOpenPonk/package.st b/repository/BaselineOfOpenPonk/package.st index 46a001c3e..4d046632f 100644 --- a/repository/BaselineOfOpenPonk/package.st +++ b/repository/BaselineOfOpenPonk/package.st @@ -1 +1 @@ -Package { #name : #BaselineOfOpenPonk } +Package { #name : 'BaselineOfOpenPonk' } diff --git a/repository/DynaCASE-Layouting/DCGTAbstractVertexOrdering.class.st b/repository/DynaCASE-Layouting/DCGTAbstractVertexOrdering.class.st index 08da19c52..282f6191f 100644 --- a/repository/DynaCASE-Layouting/DCGTAbstractVertexOrdering.class.st +++ b/repository/DynaCASE-Layouting/DCGTAbstractVertexOrdering.class.st @@ -1,5 +1,7 @@ Class { - #name : #DCGTAbstractVertexOrdering, - #superclass : #Object, - #category : 'DynaCASE-Layouting-DGT' + #name : 'DCGTAbstractVertexOrdering', + #superclass : 'Object', + #category : 'DynaCASE-Layouting-DGT', + #package : 'DynaCASE-Layouting', + #tag : 'DGT' } diff --git a/repository/DynaCASE-Layouting/DCGTEdge.class.st b/repository/DynaCASE-Layouting/DCGTEdge.class.st index 5d4ba5f79..c59711d90 100644 --- a/repository/DynaCASE-Layouting/DCGTEdge.class.st +++ b/repository/DynaCASE-Layouting/DCGTEdge.class.st @@ -1,14 +1,16 @@ Class { - #name : #DCGTEdge, - #superclass : #Object, + #name : 'DCGTEdge', + #superclass : 'Object', #instVars : [ 'from', 'to' ], - #category : 'DynaCASE-Layouting-DGT' + #category : 'DynaCASE-Layouting-DGT', + #package : 'DynaCASE-Layouting', + #tag : 'DGT' } -{ #category : #'instance creation' } +{ #category : 'instance creation' } DCGTEdge class >> from: aSource to: aTarget [ ^ self new from: aSource; @@ -16,13 +18,13 @@ DCGTEdge class >> from: aSource to: aTarget [ yourself ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTEdge >> from [ ^ from ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTEdge >> from: aDCGTNode [ |oldRef| from = aDCGTNode ifTrue: [ ^ self ]. @@ -32,7 +34,7 @@ DCGTEdge >> from: aDCGTNode [ from ifNotNil: [ from addEdge: self ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTEdge >> printOn: aStream [ aStream nextPutAll: '{ '. self from printOn: aStream. @@ -41,13 +43,13 @@ DCGTEdge >> printOn: aStream [ aStream nextPutAll: ' }' ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTEdge >> to [ ^ to ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTEdge >> to: aDCGTNode [ |oldRef| to = aDCGTNode ifTrue: [ ^ self ]. diff --git a/repository/DynaCASE-Layouting/DCGTGraph.class.st b/repository/DynaCASE-Layouting/DCGTGraph.class.st index 1efc2c79a..5b6333c7b 100644 --- a/repository/DynaCASE-Layouting/DCGTGraph.class.st +++ b/repository/DynaCASE-Layouting/DCGTGraph.class.st @@ -1,14 +1,16 @@ Class { - #name : #DCGTGraph, - #superclass : #Object, + #name : 'DCGTGraph', + #superclass : 'Object', #instVars : [ 'nodes', 'edges' ], - #category : 'DynaCASE-Layouting-DGT' + #category : 'DynaCASE-Layouting-DGT', + #package : 'DynaCASE-Layouting', + #tag : 'DGT' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTGraph class >> graphModel [ ' DCGTGraph { } @@ -25,53 +27,53 @@ DCGTGraph --> edges DCGTEdge[*]; ' asClassDiagram open ] -{ #category : #'adding/removing' } +{ #category : 'adding/removing' } DCGTGraph >> addEdge: aDCGTEdge [ (edges includes: aDCGTEdge) ifTrue: [ ^ self ]. edges add: aDCGTEdge ] -{ #category : #'adding/removing' } +{ #category : 'adding/removing' } DCGTGraph >> addNode: aDCGTNode [ (nodes includes: aDCGTNode) ifTrue: [ ^ self ]. nodes add: aDCGTNode ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTGraph >> degreeFor: aVertex [ ^ (self edgesFor: aVertex) size ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTGraph >> edges [ ^ edges ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTGraph >> edges: aCollection [ edges := aCollection ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTGraph >> edgesFor: aVertex [ ^ self edges select: [ :each | each from = aVertex | (each to = aVertex) ] ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTGraph >> edgesForAll: aVertexSet [ ^ self edges select: [ :each | (aVertexSet includes: each from) and: [ aVertexSet includes: each to ] ] ] -{ #category : #initialization } +{ #category : 'initialization' } DCGTGraph >> initialize [ super initialize. nodes := OrderedCollection new. edges := OrderedCollection new ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTGraph >> neighborsOf: aVertex [ ^ (self edgesFor: aVertex) collect: [ :each | @@ -80,30 +82,30 @@ DCGTGraph >> neighborsOf: aVertex [ ifFalse: [ each to ] ] ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTGraph >> nodes [ ^ nodes ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTGraph >> nodes: aCollection [ nodes := aCollection ] -{ #category : #'adding/removing' } +{ #category : 'adding/removing' } DCGTGraph >> removeEdge: aDCGTEdge [ (edges includes: aDCGTEdge) ifFalse: [ ^ self ]. edges remove: aDCGTEdge ] -{ #category : #'adding/removing' } +{ #category : 'adding/removing' } DCGTGraph >> removeNode: aDCGTNode [ (nodes includes: aDCGTNode) ifFalse: [ ^ self ]. nodes remove: aDCGTNode ] -{ #category : #visualization } +{ #category : 'visualization' } DCGTGraph >> renderIn: aView [ | b | b := RTMondrian new. @@ -123,7 +125,7 @@ DCGTGraph >> renderIn: aView [ ^ b view ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTGraph >> vertexInducedBy: aVertexSet [ ^ self class new nodes: aVertexSet; @@ -131,18 +133,18 @@ DCGTGraph >> vertexInducedBy: aVertexSet [ yourself ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTGraph >> vertices [ ^ self nodes ] -{ #category : #visualization } +{ #category : 'visualization' } DCGTGraph >> visualization [ ^ self renderIn: RTView new ] -{ #category : #visualization } +{ #category : 'visualization' } DCGTGraph >> visualize [ self visualization open ] diff --git a/repository/DynaCASE-Layouting/DCGTNode.class.st b/repository/DynaCASE-Layouting/DCGTNode.class.st index 04c289330..1b8961a91 100644 --- a/repository/DynaCASE-Layouting/DCGTNode.class.st +++ b/repository/DynaCASE-Layouting/DCGTNode.class.st @@ -1,88 +1,90 @@ Class { - #name : #DCGTNode, - #superclass : #Object, + #name : 'DCGTNode', + #superclass : 'Object', #instVars : [ 'edges', 'model' ], - #category : 'DynaCASE-Layouting-DGT' + #category : 'DynaCASE-Layouting-DGT', + #package : 'DynaCASE-Layouting', + #tag : 'DGT' } -{ #category : #'instance creation' } +{ #category : 'instance creation' } DCGTNode class >> model: aModel [ ^ self new model: aModel; yourself ] -{ #category : #'instance creation' } +{ #category : 'instance creation' } DCGTNode class >> on: aModel [ ^ self new model: aModel; yourself ] -{ #category : #'adding/removing' } +{ #category : 'adding/removing' } DCGTNode >> addEdge: aDCGTEdge [ (edges includes: aDCGTEdge) ifTrue: [ ^ self ]. edges add: aDCGTEdge ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTNode >> degree [ ^ self edges size ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTNode >> edges [ ^ edges ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTNode >> edges: aCollection [ [ edges isNotEmpty ] whileTrue: [ self removeEdge: edges anyOne ]. aCollection do: [ :each | self addEdge: each ] ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTNode >> inDegree [ ^ self incoming size ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTNode >> incoming [ ^ self edges select: [ :each | each to = self ] ] -{ #category : #initialization } +{ #category : 'initialization' } DCGTNode >> initialize [ super initialize. edges := OrderedCollection new ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTNode >> model [ ^ model ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTNode >> model: anObject [ model := anObject ] -{ #category : #geometry } +{ #category : 'geometry' } DCGTNode >> outDegree [ ^ self outgoing size ] -{ #category : #accessing } +{ #category : 'accessing' } DCGTNode >> outgoing [ ^ self edges select: [ :each | each from = self ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTNode >> printOn: aStream [ aStream nextPutAll: 'N'. aStream nextPut: $(. @@ -90,7 +92,7 @@ DCGTNode >> printOn: aStream [ aStream nextPut: $) ] -{ #category : #'adding/removing' } +{ #category : 'adding/removing' } DCGTNode >> removeEdge: aDCGTEdge [ (edges includes: aDCGTEdge) ifFalse: [ ^ self ]. diff --git a/repository/DynaCASE-Layouting/DCGTPartitioner.class.st b/repository/DynaCASE-Layouting/DCGTPartitioner.class.st index 0b6c5844f..d28e955b6 100644 --- a/repository/DynaCASE-Layouting/DCGTPartitioner.class.st +++ b/repository/DynaCASE-Layouting/DCGTPartitioner.class.st @@ -2,12 +2,14 @@ I am the second phase of GT " Class { - #name : #DCGTPartitioner, - #superclass : #Object, - #category : 'DynaCASE-Layouting-DGT' + #name : 'DCGTPartitioner', + #superclass : 'Object', + #category : 'DynaCASE-Layouting-DGT', + #package : 'DynaCASE-Layouting', + #tag : 'DGT' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTPartitioner >> independentSetFor: aGraph [ | set graph v | set := OrderedCollection new. @@ -21,7 +23,7 @@ DCGTPartitioner >> independentSetFor: aGraph [ ^ set ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTPartitioner >> overlapGraphFor: aGraph ordering: anOrdering [ | overlap one another a b c d tmp | overlap := DCGTGraph new. @@ -47,7 +49,7 @@ DCGTPartitioner >> overlapGraphFor: aGraph ordering: anOrdering [ ^ overlap ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTPartitioner >> partition: aGraph ordering: anOrdering [ | overlap left right rest | overlap := self overlapGraphFor: aGraph ordering: anOrdering. diff --git a/repository/DynaCASE-Layouting/DCGTPlanarization.class.st b/repository/DynaCASE-Layouting/DCGTPlanarization.class.st index f1fe7a4e5..09d5cec4b 100644 --- a/repository/DynaCASE-Layouting/DCGTPlanarization.class.st +++ b/repository/DynaCASE-Layouting/DCGTPlanarization.class.st @@ -14,12 +14,14 @@ See [2] M. E. F. E. M. Kaufmann, “An Approach for Mixed Upward Planarization,” Graph Algorithms and Applications 4, vol. 4, p. 203, 2006. " Class { - #name : #DCGTPlanarization, - #superclass : #Object, - #category : 'DynaCASE-Layouting-DGT' + #name : 'DCGTPlanarization', + #superclass : 'Object', + #category : 'DynaCASE-Layouting-DGT', + #package : 'DynaCASE-Layouting', + #tag : 'DGT' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTPlanarization class >> example [ | a b c d e g ord pi part over parts | a := DCGTNode model: #A. diff --git a/repository/DynaCASE-Layouting/DCGTVertexOrdering.class.st b/repository/DynaCASE-Layouting/DCGTVertexOrdering.class.st index 5dc114657..1b5e148c1 100644 --- a/repository/DynaCASE-Layouting/DCGTVertexOrdering.class.st +++ b/repository/DynaCASE-Layouting/DCGTVertexOrdering.class.st @@ -2,19 +2,21 @@ Basic vertex ordering for undirected graphs. " Class { - #name : #DCGTVertexOrdering, - #superclass : #DCGTAbstractVertexOrdering, - #category : 'DynaCASE-Layouting-DGT' + #name : 'DCGTVertexOrdering', + #superclass : 'DCGTAbstractVertexOrdering', + #category : 'DynaCASE-Layouting-DGT', + #package : 'DynaCASE-Layouting', + #tag : 'DGT' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTVertexOrdering >> firstVertexFor: aGraph [ | minDeg | minDeg := (aGraph nodes collect: #inDegree) min. ^ (aGraph nodes select: [ :each | each inDegree = minDeg ]) detectMin: #outDegree ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCGTVertexOrdering >> orderingFor: aGraph [ | d rcl v perm graph | graph := aGraph. diff --git a/repository/DynaCASE-Layouting/DCGraphVizLayout.class.st b/repository/DynaCASE-Layouting/DCGraphVizLayout.class.st index df8b657c8..52ee581f5 100644 --- a/repository/DynaCASE-Layouting/DCGraphVizLayout.class.st +++ b/repository/DynaCASE-Layouting/DCGraphVizLayout.class.st @@ -1,14 +1,16 @@ Class { - #name : #DCGraphVizLayout, - #superclass : #RTLayout, + #name : 'DCGraphVizLayout', + #superclass : 'RTLayout', #instVars : [ 'directed', 'undirected' ], - #category : 'DynaCASE-Layouting-GraphViz' + #category : 'DynaCASE-Layouting-GraphViz', + #package : 'DynaCASE-Layouting', + #tag : 'GraphViz' } -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> addEdgesTo: gv for: els [ directed withIndexDo: @@ -28,7 +30,7 @@ DCGraphVizLayout >> addEdgesTo: gv for: els [ (#id -> (#E , (directed size + i) asString))} ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> addNodesTo: gv for: els [ els withIndexDo: @@ -41,13 +43,13 @@ DCGraphVizLayout >> addNodesTo: gv for: els [ (#height -> (self pixelToInch: each height))} ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> applyLayout: aCollection to: els [ aCollection collect: [ :each | (els at: (self nodeIndexFor: each)) translateTo: (self nodePositionFor: each) ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> applyLayoutToEdges: aCollection [ | allEdges | allEdges := directed , undirected. @@ -72,7 +74,7 @@ DCGraphVizLayout >> applyLayoutToEdges: aCollection [ allEdges ifNotEmpty: [ allEdges anyOne view signalUpdate ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> createEmptyGraph [ | gv | (gv := GraphViz new) @@ -85,7 +87,7 @@ DCGraphVizLayout >> createEmptyGraph [ ^ gv ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> doExecute: els [ | gv group layout | gv := self createEmptyGraph. @@ -100,7 +102,7 @@ DCGraphVizLayout >> doExecute: els [ self applyLayoutToEdges: (layout xPath: '//g[@class="edge"]') ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> edgeLayoutToRoute: anEdge [ ^ DCOCRouter collinearizeRoute: @@ -108,29 +110,29 @@ DCGraphVizLayout >> edgeLayoutToRoute: anEdge [ convertPathData flatCollect: #second) ] -{ #category : #converting } +{ #category : 'converting' } DCGraphVizLayout >> inchToPixel: aNumber [ ^ aNumber * 72 ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> indexFor: aNodeOrEdge [ ^ (aNodeOrEdge attributeAt: #id) allButFirst asNumber ] -{ #category : #'initialize-release' } +{ #category : 'initialize-release' } DCGraphVizLayout >> initialize [ super initialize. directed := #(). undirected := #() ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> nodeIndexFor: aNode [ ^ (aNode attributeAt: #id) allButFirst asNumber ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> nodePositionFor: aNode [ | corners | corners := (((aNode / #polygon) first attributeAt: #points) splitOn: ' ') @@ -138,24 +140,24 @@ DCGraphVizLayout >> nodePositionFor: aNode [ ^ (corners min corner: corners max) center ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> on: el directed: directedEdges undirected: undirectedEdges [ directed := directedEdges. undirected := undirectedEdges. ^ self applyOn: el ] -{ #category : #converting } +{ #category : 'converting' } DCGraphVizLayout >> pixelToInch: aNumber [ ^ (aNumber / 72.0) asFloat ] -{ #category : #converting } +{ #category : 'converting' } DCGraphVizLayout >> pointToPixel: aNumber [ ^ aNumber * 96 ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayout >> positionFrom: aStringPair [ | pos | pos := aStringPair splitOn: ','. diff --git a/repository/DynaCASE-Layouting/DCGraphVizLayoutXml.class.st b/repository/DynaCASE-Layouting/DCGraphVizLayoutXml.class.st index 2a00fc867..2f8d13ba8 100644 --- a/repository/DynaCASE-Layouting/DCGraphVizLayoutXml.class.st +++ b/repository/DynaCASE-Layouting/DCGraphVizLayoutXml.class.st @@ -1,14 +1,16 @@ Class { - #name : #DCGraphVizLayoutXml, - #superclass : #RTLayout, + #name : 'DCGraphVizLayoutXml', + #superclass : 'RTLayout', #instVars : [ 'directed', 'undirected' ], - #category : 'DynaCASE-Layouting-GraphViz' + #category : 'DynaCASE-Layouting-GraphViz', + #package : 'DynaCASE-Layouting', + #tag : 'GraphViz' } -{ #category : #example } +{ #category : 'example' } DCGraphVizLayoutXml class >> example [ |v es a b c| v := RTView new. @@ -31,7 +33,7 @@ DCGraphVizLayout new on: es directed: {a} undirected: {b . c}. v @ RTEmptyViewContextInteraction @ RTZoomableView @ RTDraggableView. ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> addEdgesTo: gv for: els [ directed withIndexDo: @@ -51,7 +53,7 @@ DCGraphVizLayoutXml >> addEdgesTo: gv for: els [ (#id -> (#E , (directed size + i) asString))} ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> addNodesTo: gv for: els [ els withIndexDo: @@ -64,13 +66,13 @@ DCGraphVizLayoutXml >> addNodesTo: gv for: els [ (#height -> (self pixelToInch: each height))} ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> applyLayout: aCollection to: els [ aCollection collect: [ :each | (els at: (self nodeIndexFor: each)) translateTo: (self nodePositionFor: each) ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> applyLayoutToEdges: aCollection [ | allEdges | allEdges := directed , undirected. @@ -95,7 +97,7 @@ DCGraphVizLayoutXml >> applyLayoutToEdges: aCollection [ allEdges ifNotEmpty: [ allEdges anyOne view signalUpdate ] ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> createEmptyGraph [ | gv | (gv := GraphViz new) @@ -108,12 +110,12 @@ DCGraphVizLayoutXml >> createEmptyGraph [ ^ gv ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> createGraphFor: els [ ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> doExecute: els [ | gv group layout | gv := self createEmptyGraph. @@ -127,7 +129,7 @@ DCGraphVizLayoutXml >> doExecute: els [ self applyLayoutToEdges: layout // #edge ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> edgeLayoutToRoute: anEdge [ ^ "DCOCRouter collinearizeRoute:" @@ -135,51 +137,51 @@ DCGraphVizLayoutXml >> edgeLayoutToRoute: anEdge [ collect: [ :each | self positionFrom: each ]) ] -{ #category : #converting } +{ #category : 'converting' } DCGraphVizLayoutXml >> inchToPixel: aNumber [ ^ aNumber * 96 ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> indexFor: aNodeOrEdge [ ^ (aNodeOrEdge xPath: 'attr[@name="id"]') first contentString allButFirst asNumber ] -{ #category : #'initialize-release' } +{ #category : 'initialize-release' } DCGraphVizLayoutXml >> initialize [ super initialize. directed := #(). undirected := #() ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> nodeIndexFor: aNode [ ^ (aNode xPath: 'attr[@name="id"]') first contentString allButFirst asNumber ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> nodePositionFor: aNode [ ^ self positionFrom: (aNode xPath: 'attr[@name="pos"]') first contentString ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> on: el directed: directedEdges undirected: undirectedEdges [ directed := directedEdges. undirected := undirectedEdges. ^ self applyOn: el ] -{ #category : #converting } +{ #category : 'converting' } DCGraphVizLayoutXml >> pixelToInch: aNumber [ ^ (aNumber / 96) asFloat ] -{ #category : #converting } +{ #category : 'converting' } DCGraphVizLayoutXml >> pointToPixel: aNumber [ ^ aNumber * 96 ] -{ #category : #hook } +{ #category : 'hook' } DCGraphVizLayoutXml >> positionFrom: aStringPair [ | pos | pos := ((aStringPair beginsWith: 'e,') diff --git a/repository/DynaCASE-Layouting/DCLayoutUtils.class.st b/repository/DynaCASE-Layouting/DCLayoutUtils.class.st index e81ece7dc..6c921834d 100644 --- a/repository/DynaCASE-Layouting/DCLayoutUtils.class.st +++ b/repository/DynaCASE-Layouting/DCLayoutUtils.class.st @@ -1,15 +1,17 @@ Class { - #name : #DCLayoutUtils, - #superclass : #Object, - #category : 'DynaCASE-Layouting-GlobalEdgeLabels' + #name : 'DCLayoutUtils', + #superclass : 'Object', + #category : 'DynaCASE-Layouting-GlobalEdgeLabels', + #package : 'DynaCASE-Layouting', + #tag : 'GlobalEdgeLabels' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCLayoutUtils >> addBoundingBoxFor: aCollection [ aCollection do: [ :each | self addBoundingBoxTo: each ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCLayoutUtils >> addBoundingBoxTo: anElement [ | bb | bb := RTBox new @@ -22,7 +24,7 @@ DCLayoutUtils >> addBoundingBoxTo: anElement [ bb trachelShape pushBehind: anElement trachelShape. ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCLayoutUtils >> computeSolutionSpaceFor: aBox line: aLine [ | vertA vertB space direction | space := OrderedCollection new. @@ -46,7 +48,7 @@ DCLayoutUtils >> computeSolutionSpaceFor: aBox line: aLine [ ^ space ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCLayoutUtils >> showSolutionSpaceForLabel: aLabel edge: anEdge [ | line space polygon | (anEdge hasAttribute: #solutionSpace) diff --git a/repository/DynaCASE-Layouting/DCOCNode.class.st b/repository/DynaCASE-Layouting/DCOCNode.class.st index 3b98495d6..1fdf901d5 100644 --- a/repository/DynaCASE-Layouting/DCOCNode.class.st +++ b/repository/DynaCASE-Layouting/DCOCNode.class.st @@ -1,18 +1,20 @@ Class { - #name : #DCOCNode, - #superclass : #DCGTNode, + #name : 'DCOCNode', + #superclass : 'DCGTNode', #instVars : [ 'element' ], - #category : 'DynaCASE-Layouting-OCR' + #category : 'DynaCASE-Layouting-OCR', + #package : 'DynaCASE-Layouting', + #tag : 'OCR' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCNode >> direction [ ^ self element encompassingRectangle sideNearestTo: self model ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCNode >> dirnsFrom: previousNode [ | res | res := Set new. @@ -27,24 +29,24 @@ DCOCNode >> dirnsFrom: previousNode [ ^ res ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCNode >> distanceTo: aNode [ "Manhattan distance between two nodes." ^ (self model x - aNode model x) abs + (self model y - aNode model y) abs ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCNode >> element [ ^ element ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCNode >> element: anElement [ element := anElement ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCNode >> leftOf: aDirection [ ^ {(#top -> #left). (#left -> #bottom). @@ -52,7 +54,7 @@ DCOCNode >> leftOf: aDirection [ (#right -> #top)} asDictionary at: aDirection ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCNode >> reverseOf: aDirection [ ^ {(#top -> #bottom). (#right -> #left). @@ -60,7 +62,7 @@ DCOCNode >> reverseOf: aDirection [ (#left -> #right)} asDictionary at: aDirection ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCNode >> rightOf: aDirection [ ^ {(#top -> #right). (#right -> #bottom). diff --git a/repository/DynaCASE-Layouting/DCOCOverlapEdge.class.st b/repository/DynaCASE-Layouting/DCOCOverlapEdge.class.st index 16ceda196..5e55b0b8b 100644 --- a/repository/DynaCASE-Layouting/DCOCOverlapEdge.class.st +++ b/repository/DynaCASE-Layouting/DCOCOverlapEdge.class.st @@ -1,18 +1,20 @@ Class { - #name : #DCOCOverlapEdge, - #superclass : #DCGTEdge, + #name : 'DCOCOverlapEdge', + #superclass : 'DCGTEdge', #instVars : [ 'routes' ], - #category : 'DynaCASE-Layouting-OCR' + #category : 'DynaCASE-Layouting-OCR', + #package : 'DynaCASE-Layouting', + #tag : 'OCR' } -{ #category : #accessing } +{ #category : 'accessing' } DCOCOverlapEdge >> routes [ ^ routes ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCOverlapEdge >> routes: anObject [ routes := anObject ] diff --git a/repository/DynaCASE-Layouting/DCOCQueueEntry.class.st b/repository/DynaCASE-Layouting/DCOCQueueEntry.class.st index edca62a09..c4794ae92 100644 --- a/repository/DynaCASE-Layouting/DCOCQueueEntry.class.st +++ b/repository/DynaCASE-Layouting/DCOCQueueEntry.class.st @@ -1,6 +1,6 @@ Class { - #name : #DCOCQueueEntry, - #superclass : #Object, + #name : 'DCOCQueueEntry', + #superclass : 'Object', #instVars : [ 'node', 'direction', @@ -9,40 +9,42 @@ Class { 'parent', 'cost' ], - #category : 'DynaCASE-Layouting-OCR' + #category : 'DynaCASE-Layouting-OCR', + #package : 'DynaCASE-Layouting', + #tag : 'OCR' } -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> bends [ ^ bends ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> bends: anObject [ bends := anObject ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> cost [ ^ cost ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> cost: anObject [ cost := anObject ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> direction [ ^ direction ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> direction: anObject [ direction := anObject ] -{ #category : #computing } +{ #category : 'computing' } DCOCQueueEntry >> estimateTo: aDestination [ | isSame isOpposite isOrthogonal isExpected isExact isDestExpected | isSame := self direction = aDestination direction. @@ -64,33 +66,33 @@ DCOCQueueEntry >> estimateTo: aDestination [ ifTrue: [ ^ 4 ] ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> length [ parent ifNil: [ ^ 0 ]. ^ self parent length + (self node distanceTo: self parent node) ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> node [ ^ node ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> node: anObject [ node := anObject ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> parent [ ^ parent ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> parent: anObject [ parent := anObject ] -{ #category : #computing } +{ #category : 'computing' } DCOCQueueEntry >> priorityFrom: aSource to: aDestination [ false ifTrue: @@ -99,7 +101,7 @@ DCOCQueueEntry >> priorityFrom: aSource to: aDestination [ ifFalse: [ ^ self node distanceTo: aDestination ] ] -{ #category : #accessing } +{ #category : 'accessing' } DCOCQueueEntry >> route [ | route step | route := OrderedCollection new. diff --git a/repository/DynaCASE-Layouting/DCOCRouter.class.st b/repository/DynaCASE-Layouting/DCOCRouter.class.st index dfb825fd7..2310f8d40 100644 --- a/repository/DynaCASE-Layouting/DCOCRouter.class.st +++ b/repository/DynaCASE-Layouting/DCOCRouter.class.st @@ -10,12 +10,14 @@ I route edges of a graph in an orthogonal style for vertices with fixed position ] [1]M. Wybrow, K. Marriott, and P. J. Stuckey, “Orthogonal connector routing,” in Graph Drawing, 2010, pp. 219–231. " Class { - #name : #DCOCRouter, - #superclass : #Object, - #category : 'DynaCASE-Layouting-OCR' + #name : 'DCOCRouter', + #superclass : 'Object', + #category : 'DynaCASE-Layouting-OCR', + #package : 'DynaCASE-Layouting', + #tag : 'OCR' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter class >> collinearizeRoute: aRoute [ | newRoute direction step | newRoute := OrderedCollection with: aRoute first with: aRoute second. @@ -34,7 +36,7 @@ DCOCRouter class >> collinearizeRoute: aRoute [ ^ newRoute asArray ] -{ #category : #examples } +{ #category : 'examples' } DCOCRouter class >> exampleRouting [ |v es router visGraph g el seg conn conn2 r1 r2 routes ordering| v := RTView new. @@ -113,7 +115,7 @@ v @ RTDraggableView @ RTZoomableView. ^ v ] -{ #category : #examples } +{ #category : 'examples' } DCOCRouter class >> exampleVisibility [ |v es router visGraph g e seg| v := RTView new. @@ -154,7 +156,7 @@ v @ RTDraggableView @ RTZoomableView. ^ v ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> applyRoute: aPath to: anEdge [ anEdge shape router points: aPath. anEdge update. @@ -162,28 +164,28 @@ DCOCRouter >> applyRoute: aPath to: anEdge [ anEdge view signalUpdate ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> collinearizeRoutes: routes [ ^ routes collect: [ :each | self class collinearizeRoute: each ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> determineRoutes: elements [ ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> determineRoutesFor: edges [ ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> generateSegments: aGraph boxes: boxes [ self generateSegments: aGraph boxes: boxes fixedAxis: #x. self generateSegments: aGraph boxes: boxes fixedAxis: #y ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> generateSegments: aGraph boxes: boxes fixedAxis: anAxis [ | fixed lines seg otherAxis | otherAxis := anAxis = #x @@ -206,7 +208,7 @@ DCOCRouter >> generateSegments: aGraph boxes: boxes fixedAxis: anAxis [ ifNone: [ aGraph addEdge: (DCGTEdge from: a to: b) ] ] ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> interestingPointFor: anElement [ "Retrieve an interesting point for an element. This are corners of the element and some fixed number of connectors (for now centres)." @@ -215,18 +217,18 @@ DCOCRouter >> interestingPointFor: anElement [ ^ (r corners , (self sideCentersFor: r)) asSet ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> interestingPointsFor: elements [ ^ elements collect: [ :each | each -> (self interestingPointFor: each) ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> orderingFor: routes [ | overlapGraph | overlapGraph := self overlapGraphFor: routes. ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> overlapGraphFor: routes [ | overlapGraph nodesLookup candidates | overlapGraph := DCGTGraph new. @@ -252,7 +254,7 @@ DCOCRouter >> overlapGraphFor: routes [ ^ overlapGraph ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> routeFor: anEdge visibility: visGraph [ | starts ends paths | starts := (self sideCentersFor: (anEdge from encompassingRectangle expandBy: 10)) @@ -265,7 +267,7 @@ DCOCRouter >> routeFor: anEdge visibility: visGraph [ ^ (paths detectMin: #length) route ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> routeFrom: src to: dst visibility: aVisGraph [ | queue srcEntry next reached top closed | queue := Heap new. @@ -299,14 +301,14 @@ DCOCRouter >> routeFrom: src to: dst visibility: aVisGraph [ ^ top ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> routesFor: edges visibility: visGraph [ | routes | routes := edges collect: [ :each | each -> (self routeFor: each visibility: visGraph) ]. routes do: [ :pair | self applyRoute: pair value to: pair key ] ] -{ #category : #running } +{ #category : 'running' } DCOCRouter >> run [ self visibilityGraph. self determineRoutes. @@ -314,7 +316,7 @@ DCOCRouter >> run [ self visualRepresentation" ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> segmentizeRoutes: routes [ | segments | segments := Dictionary new. @@ -326,7 +328,7 @@ DCOCRouter >> segmentizeRoutes: routes [ ^ segments ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> separateRoutes: routes [ | segments | segments := self segmentizeRoutes: routes. @@ -334,7 +336,7 @@ DCOCRouter >> separateRoutes: routes [ ^ routes ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> sideCentersFor: aRectangle [ ^ Array with: aRectangle topCenter @@ -343,7 +345,7 @@ DCOCRouter >> sideCentersFor: aRectangle [ with: aRectangle leftCenter ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouter >> visibilityGraphFor: elements [ | boundaries i xi yi boxes nodes graph | boxes := elements collect: [ :each | each encompassingRectangle expandBy: 9 ]. diff --git a/repository/DynaCASE-Layouting/DCOCRouterTest.class.st b/repository/DynaCASE-Layouting/DCOCRouterTest.class.st index 7a756c0b4..dfe801ba3 100644 --- a/repository/DynaCASE-Layouting/DCOCRouterTest.class.st +++ b/repository/DynaCASE-Layouting/DCOCRouterTest.class.st @@ -1,13 +1,15 @@ Class { - #name : #DCOCRouterTest, - #superclass : #TestCase, + #name : 'DCOCRouterTest', + #superclass : 'TestCase', #instVars : [ 'router' ], - #category : 'DynaCASE-Layouting-OCR' + #category : 'DynaCASE-Layouting-OCR', + #package : 'DynaCASE-Layouting', + #tag : 'OCR' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCOCRouterTest >> routeVisualization [ |v p route pstr| v := RTView new. @@ -33,19 +35,19 @@ route do: [ :each | v @ RTZoomableView @ RTDraggableView. ] -{ #category : #running } +{ #category : 'running' } DCOCRouterTest >> setUp [ router := DCOCRouter new ] -{ #category : #tests } +{ #category : 'tests' } DCOCRouterTest >> testCollinearizeRoute [ self assert: (router class collinearizeRoute: {0@0 . 10@0 . 10@10 . 10@20 . 30@20 . 50 @ 20 . 50 @ 40}) equals: {0@0 . 10@0 . 10@20 . 50 @ 20 . 50 @ 40} ] -{ #category : #tests } +{ #category : 'tests' } DCOCRouterTest >> testInterestingPoint [ | e | e := RTBox new diff --git a/repository/DynaCASE-Layouting/DCRTEdgeLabelLayout.class.st b/repository/DynaCASE-Layouting/DCRTEdgeLabelLayout.class.st index 3b7223257..c1553961a 100644 --- a/repository/DynaCASE-Layouting/DCRTEdgeLabelLayout.class.st +++ b/repository/DynaCASE-Layouting/DCRTEdgeLabelLayout.class.st @@ -1,6 +1,6 @@ Class { - #name : #DCRTEdgeLabelLayout, - #superclass : #RTEdgeDrivenLayout, + #name : 'DCRTEdgeLabelLayout', + #superclass : 'RTEdgeDrivenLayout', #instVars : [ 'labels', 'assignedLabels', @@ -16,10 +16,12 @@ Class { 'labelToEdgeMapping', 'preferences' ], - #category : 'DynaCASE-Layouting-GlobalEdgeLabels' + #category : 'DynaCASE-Layouting-GlobalEdgeLabels', + #package : 'DynaCASE-Layouting', + #tag : 'GlobalEdgeLabels' } -{ #category : #examples } +{ #category : 'examples' } DCRTEdgeLabelLayout class >> example [ |v es edges lines utils edgeLabels| utils := DCLayoutUtils new. @@ -88,7 +90,7 @@ v canvas camera focusOnCenterScaled: (521.0@700.0). ^ v ] -{ #category : #examples } +{ #category : 'examples' } DCRTEdgeLabelLayout class >> example2 [ |v es edges lines utils edgeLabels| utils := DCLayoutUtils new. @@ -144,7 +146,7 @@ v canvas camera focusOnCenterScaled: (450.0@700.0). ^ v ] -{ #category : #examples } +{ #category : 'examples' } DCRTEdgeLabelLayout class >> exampleClusters [ |v es edges lines utils edgeLabels| utils := DCLayoutUtils new. @@ -208,24 +210,24 @@ v canvas camera focusOnCenterScaled: (521.0@700.0). ^ v ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> allEdgeMarks [ ^ (self edges collect: [ :each | each -> (self edgeMarksFor: each) ]) as: OrderedDictionary ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> applyAssignment: aDictionary [ aDictionary keysAndValuesDo: [ :feature :position | (self labelForEdge: feature model) translateTo: position center ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> batchOfUnassignedLabels [ ^ self edges collect: [ :e | self labelForEdge: e ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> clusterGraphsFor: anOverlapGraph [ | clusters graph | clusters := self clustersFor: anOverlapGraph. @@ -246,7 +248,7 @@ DCRTEdgeLabelLayout >> clusterGraphsFor: anOverlapGraph [ graph ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> clustersFor: anOverlapGraph [ | classGraph clusters | (classGraph := MalGraphStructure new). @@ -284,7 +286,7 @@ DCRTEdgeLabelLayout >> clustersFor: anOverlapGraph [ removeDuplicates asArray ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> completeClusterFor: aGraph [ | degrees removed | (self isComplete: aGraph) @@ -296,12 +298,12 @@ DCRTEdgeLabelLayout >> completeClusterFor: aGraph [ ^ self completeClustersFor: (self clusterGraphsFor: aGraph) ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> completeClustersFor: clusterGraphs [ ^ clusterGraphs flatCollect: [ :each | self completeClusterFor: each ] ] -{ #category : #cost } +{ #category : 'cost' } DCRTEdgeLabelLayout >> costForFeature: aFeatureNode cluster: aClusterNode edges: matchingGraph [ ^ matchingGraph edges detect: [ :e | e from = aFeatureNode & (e to = aClusterNode) ] @@ -317,12 +319,12 @@ DCRTEdgeLabelLayout >> costForFeature: aFeatureNode cluster: aClusterNode edges: ifNone: [ Float infinity ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> defaultSpacing [ ^ 30 ] -{ #category : #hook } +{ #category : 'hook' } DCRTEdgeLabelLayout >> doExecute: elementsCollection [ | action | action := [ withVisualization @@ -333,7 +335,7 @@ DCRTEdgeLabelLayout >> doExecute: elementsCollection [ ifFalse: [ action value ] ] -{ #category : #hook } +{ #category : 'hook' } DCRTEdgeLabelLayout >> doExecuteNormal: elementsCollection [ | edgeMarks positions overlapGraph clusterGraphs completeClusters matchingGraph assignment | elements := elementsCollection. @@ -352,7 +354,7 @@ DCRTEdgeLabelLayout >> doExecuteNormal: elementsCollection [ unassignedLabels ifNotEmpty: [ self doExecute: elementsCollection ] ] -{ #category : #hook } +{ #category : 'hook' } DCRTEdgeLabelLayout >> doExecuteVisualized: elementsCollection [ | edgeMarks positions overlapGraph clusterGraphs completeClusters matchingGraph assignment conf | conf := visualizer class Configuration. @@ -401,17 +403,17 @@ DCRTEdgeLabelLayout >> doExecuteVisualized: elementsCollection [ unassignedLabels ifNotEmpty: [ self doExecuteVisualized: elementsCollection ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> edgeForLabel: aLabel [ ^ edgeForLabel cull: aLabel cull: self ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> edgeForLabelStrategy: aTwoArgBlock [ edgeForLabel := aTwoArgBlock ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> edgeMarksFor: anEdge [ | line angle direction | line := RTLineSegment @@ -427,17 +429,17 @@ DCRTEdgeLabelLayout >> edgeMarksFor: anEdge [ asArray ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> elements [ ^ elements , assignedLabels ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> elements: aCollection [ elements := aCollection ] -{ #category : #hook } +{ #category : 'hook' } DCRTEdgeLabelLayout >> findAssignmentFor: aMatchingGraph [ | matrix features clusters solver solution assignment | features := aMatchingGraph nodes select: #isFeature. @@ -466,7 +468,7 @@ DCRTEdgeLabelLayout >> findAssignmentFor: aMatchingGraph [ ^ assignment asDictionary ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> indexPositions: aDictionary [ "assign each position a globally (within the view) unique ID so it can be tracked later" @@ -490,13 +492,13 @@ DCRTEdgeLabelLayout >> indexPositions: aDictionary [ ^ indexed ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> initialPositions [ ^ (self batchOfUnassignedLabels collect: [ :each | each -> (self initialPositionsFor: each) ]) as: OrderedDictionary ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> initialPositionsFor: aLabel [ | marks size w h extent | extent := aLabel extent. @@ -535,7 +537,7 @@ DCRTEdgeLabelLayout >> initialPositionsFor: aLabel [ collect: [ :each | each bounds: ((each position corner: each position) expandBy: extent / 2) ] ] -{ #category : #'initialize-release' } +{ #category : 'initialize-release' } DCRTEdgeLabelLayout >> initialize [ super initialize. labels := nil. @@ -549,24 +551,24 @@ DCRTEdgeLabelLayout >> initialize [ preferences := Dictionary new ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> isComplete: aGraph [ "|E| = |N|*(|N|-1)/2" ^ aGraph edges size = (aGraph nodes size * (aGraph nodes size - 1) / 2) ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> labelForEdge: anEdge [ ^ labelForEdge cull: anEdge cull: self ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> labelForEdgeStrategy: aTwoArgBlock [ ^ labelForEdge := aTwoArgBlock ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> labelToEdgeMapping: aDictionary [ labelToEdgeMapping := aDictionary. self edgeForLabelStrategy: [ :label :me | labelToEdgeMapping at: label ]. @@ -577,24 +579,24 @@ DCRTEdgeLabelLayout >> labelToEdgeMapping: aDictionary [ detect: [ :lbl | unassignedLabels includes: lbl ] ] ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> labels [ ^ labels ifNil: [ labels := self edges collect: labelsStrategy thenReject: #isNil ] ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> labels: aCollection [ labels := aCollection. unassignedLabels := aCollection asOrderedCollection. assignedLabels := OrderedCollection new ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> labelsStrategy: aBlock [ labelsStrategy := aBlock ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> matchingGraphFor: anOverlapGraph classes: clusterGraphs [ | matchingGraph clusterNode | matchingGraph := MalGraphStructure new. @@ -617,7 +619,7 @@ DCRTEdgeLabelLayout >> matchingGraphFor: anOverlapGraph classes: clusterGraphs [ ^ matchingGraph ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> overlapGraphFor: aDictionary [ | graph oldGraph positions added | (graph := MalGraphStructure new) edgeClass: MalGraphEdge. @@ -648,7 +650,7 @@ DCRTEdgeLabelLayout >> overlapGraphFor: aDictionary [ ^ graph ] -{ #category : #cost } +{ #category : 'cost' } DCRTEdgeLabelLayout >> penaltyForEdgeProximity: aPosition of: anEdge [ | line closestAnotherDistance edgeDistance from to | from := [ :e | e shape startingPointOf: e ]. @@ -670,7 +672,7 @@ DCRTEdgeLabelLayout >> penaltyForEdgeProximity: aPosition of: anEdge [ ifFalse: [ 1 ]" ] -{ #category : #cost } +{ #category : 'cost' } DCRTEdgeLabelLayout >> penaltyForElementProximity: aPosition of: anEdge [ | closestDistance | closestDistance := (elements @@ -678,7 +680,7 @@ DCRTEdgeLabelLayout >> penaltyForElementProximity: aPosition of: anEdge [ ^ 11 - closestDistance rounded max: 0 ] -{ #category : #cost } +{ #category : 'cost' } DCRTEdgeLabelLayout >> penaltyForOrientation: aPosition of: anEdge [ self preferences at: aPosition feature @@ -697,7 +699,7 @@ DCRTEdgeLabelLayout >> penaltyForOrientation: aPosition of: anEdge [ ifAbsent: [ ^ 0 ] ] -{ #category : #cost } +{ #category : 'cost' } DCRTEdgeLabelLayout >> penaltyForProximity: aPosition of: anEdge [ | p1 p2 | p1 := self penaltyForEdgeProximity: aPosition of: anEdge. @@ -705,7 +707,7 @@ DCRTEdgeLabelLayout >> penaltyForProximity: aPosition of: anEdge [ ^ p1 max: p2 ] -{ #category : #cost } +{ #category : 'cost' } DCRTEdgeLabelLayout >> penaltyForRanking: aPosition of: anEdge [ self preferences at: aPosition feature @@ -718,17 +720,17 @@ DCRTEdgeLabelLayout >> penaltyForRanking: aPosition of: anEdge [ ifAbsent: [ ^ aPosition ranking ] ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> preferences [ ^ preferences ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> preferences: aDictionary [ preferences := aDictionary ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> removeFeatureOverlaps: aDictionary [ "Remove all positions overlapping another edge or element, but not label." @@ -740,7 +742,7 @@ DCRTEdgeLabelLayout >> removeFeatureOverlaps: aDictionary [ ^ newMap ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> removeFeatureOverlapsFor: aLabel positions: aCollection [ "Remove all positions overlapping another edge or element, but not label." @@ -775,22 +777,22 @@ DCRTEdgeLabelLayout >> removeFeatureOverlapsFor: aLabel positions: aCollection [ ^ rectangles ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> spacing [ ^ spacing ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> spacing: aNumber [ spacing := aNumber ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayout >> withProgressBar [ withProgressBar := true ] -{ #category : #accessing } +{ #category : 'accessing' } DCRTEdgeLabelLayout >> withVisualization [ withVisualization := true ] diff --git a/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutTest.class.st b/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutTest.class.st index 7914bfa77..f4062c59c 100644 --- a/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutTest.class.st +++ b/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutTest.class.st @@ -1,6 +1,6 @@ Class { - #name : #DCRTEdgeLabelLayoutTest, - #superclass : #TestCase, + #name : 'DCRTEdgeLabelLayoutTest', + #superclass : 'TestCase', #instVars : [ 'view', 'elements', @@ -8,16 +8,18 @@ Class { 'layout', 'label' ], - #category : 'DynaCASE-Layouting-GlobalEdgeLabels' + #category : 'DynaCASE-Layouting-GlobalEdgeLabels', + #package : 'DynaCASE-Layouting', + #tag : 'GlobalEdgeLabels' } -{ #category : #asserting } +{ #category : 'asserting' } DCRTEdgeLabelLayoutTest >> assertPosition: actual equals: expected [ #(#ranking #maxRanking #position #orientation #bounds) do: [ :each | self assert: (actual perform: each) equals: (expected perform: each) ] ] -{ #category : #'instance creation' } +{ #category : 'instance creation' } DCRTEdgeLabelLayoutTest >> initialPositions [ ^ {(DCRTLPosition new ranking: 1 of: 3; @@ -41,7 +43,7 @@ DCRTEdgeLabelLayoutTest >> initialPositions [ bounds: (-14 @ -39 corner: 24 @ -1))} ] -{ #category : #'instance creation' } +{ #category : 'instance creation' } DCRTEdgeLabelLayoutTest >> positions [ ^ {(label -> @@ -53,7 +55,7 @@ DCRTEdgeLabelLayoutTest >> positions [ index: 2)})} asOrderedDictionary ] -{ #category : #running } +{ #category : 'running' } DCRTEdgeLabelLayoutTest >> setUp [ view := RTView new. elements := RTBox new @@ -74,7 +76,7 @@ DCRTEdgeLabelLayoutTest >> setUp [ layout labels: {label} ] -{ #category : #tests } +{ #category : 'tests' } DCRTEdgeLabelLayoutTest >> testEdgeMarks [ | marks | layout spacing: 30. @@ -88,7 +90,7 @@ DCRTEdgeLabelLayoutTest >> testEdgeMarks [ (75 @ 0)} ] -{ #category : #tests } +{ #category : 'tests' } DCRTEdgeLabelLayoutTest >> testIndexPositions [ | positions | positions := layout removeFeatureOverlapsFor: label positions: self initialPositions. @@ -99,7 +101,7 @@ DCRTEdgeLabelLayoutTest >> testIndexPositions [ self assert: positions second index equals: 2 ] -{ #category : #tests } +{ #category : 'tests' } DCRTEdgeLabelLayoutTest >> testInitialPositions [ | positions | layout spacing: 50. @@ -111,7 +113,7 @@ DCRTEdgeLabelLayoutTest >> testInitialPositions [ self assertPosition: positions fourth equals: self initialPositions fourth ] -{ #category : #tests } +{ #category : 'tests' } DCRTEdgeLabelLayoutTest >> testOverlapGraphFor [ | graph | graph := layout overlapGraphFor: self positions. @@ -121,7 +123,7 @@ DCRTEdgeLabelLayoutTest >> testOverlapGraphFor [ self assert: graph edges size equals: 2 ] -{ #category : #tests } +{ #category : 'tests' } DCRTEdgeLabelLayoutTest >> testRemoveFeatureOverlaps [ | positions | positions := layout removeFeatureOverlapsFor: label positions: self initialPositions. diff --git a/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutVisualizer.class.st b/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutVisualizer.class.st index 317019d23..e500ab1cf 100644 --- a/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutVisualizer.class.st +++ b/repository/DynaCASE-Layouting/DCRTEdgeLabelLayoutVisualizer.class.st @@ -1,6 +1,6 @@ Class { - #name : #DCRTEdgeLabelLayoutVisualizer, - #superclass : #Object, + #name : 'DCRTEdgeLabelLayoutVisualizer', + #superclass : 'Object', #instVars : [ 'layouter', 'view' @@ -8,15 +8,17 @@ Class { #classVars : [ 'Configuration' ], - #category : 'DynaCASE-Layouting-GlobalEdgeLabels' + #category : 'DynaCASE-Layouting-GlobalEdgeLabels', + #package : 'DynaCASE-Layouting', + #tag : 'GlobalEdgeLabels' } -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayoutVisualizer class >> Configuration [ ^ Configuration ifNil: [ Configuration := self defaultConfiguration ] ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayoutVisualizer class >> defaultConfiguration [ ^ Dictionary new at: #edgeMarks put: true; @@ -31,7 +33,7 @@ DCRTEdgeLabelLayoutVisualizer class >> defaultConfiguration [ yourself ] -{ #category : #'as yet unclassified' } +{ #category : 'as yet unclassified' } DCRTEdgeLabelLayoutVisualizer class >> openConfiguration [