Presents watches in a simple grid per permutation (does not handle ov…

…erflow yet)
hpi-swa · Nov 14, 2023 · 527cf4c · 527cf4c
1 parent 677d513
commit 527cf4c
Show file tree

Hide file tree

Showing 8 changed files with 284 additions and 4 deletions.
diff --git a/packages/Sandblocks-Babylonian/SBCluster.class.st b/packages/Sandblocks-Babylonian/SBCluster.class.st
@@ -0,0 +1,147 @@
+Class {
+	#name : #SBCluster,
+	#superclass : #Morph,
+	#instVars : [
+		'morphResizer'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #'initialize-release' }
+SBCluster class >> newFromWatches: aCollectionOfSBExampleWatches havingSize: aSBMorphResizer [
+
+	^ self new 
+		morphResizer: aSBMorphResizer;
+		buildFromWatches: aCollectionOfSBExampleWatches;
+		yourself 
+
+]
+
+{ #category : #visualisation }
+SBCluster >> buildFromWatches: aCollectionOfSBExampleWatches [
+
+	| matrix |
+	matrix := self watchesAsMatrix: aCollectionOfSBExampleWatches.
+	(matrix rowCount < 2 or: [matrix columnCount < 2]) ifTrue: [ ^ self].
+
+	self addAllMorphsBack: {
+		self newTopRowFrom: (matrix atRow: 1) allButFirst. "ignore placeholder morph"
+		self newContainerMorph 
+			listDirection: #leftToRight;
+			cellInset: 0;
+			addAllMorphsBack: {
+				self newLeftColumnFrom: (matrix atColumn: 1) allButFirst. "ignore placeholder morph"
+				SBGrid newDisplaying: 
+					((matrix atRows: 2 to: matrix rowCount columns: 2 to: matrix columnCount)
+						collect: [:aMorph | self wrapInCell: aMorph])}}
+]
+
+{ #category : #initialization }
+SBCluster >> initialize [ 
+
+	super initialize.
+
+	self 
+		color: Color white;
+		changeTableLayout;
+		listDirection: #topToBottom;
+		vResizing: #shrinkWrap;
+		hResizing: #shrinkWrap
+]
+
+{ #category : #accessing }
+SBCluster >> morphResizer [
+
+	^ morphResizer
+]
+
+{ #category : #accessing }
+SBCluster >> morphResizer: aSBMorphResizer [
+
+	morphResizer := aSBMorphResizer
+]
+
+{ #category : #helper }
+SBCluster >> newCellMorph [
+
+	^ self morphResizer applyOn: (
+		Morph new
+			color: Color blue;
+			changeTableLayout;
+			listDirection: #topToBottom;
+			listCentering: #center;
+			wrapCentering: #center;
+			hResizing: #rigid;
+			vResizing: #rigid)
+]
+
+{ #category : #helper }
+SBCluster >> newContainerMorph [
+
+	^ Morph new
+		color: Color banana;
+		changeTableLayout;
+		listDirection: #topToBottom;
+		hResizing: #shrinkWrap;
+		vResizing: #shrinkWrap;
+		cellInset: SBGrid cellInsetValue
+]
+
+{ #category : #visualisation }
+SBCluster >> newLeftColumnFrom: aCollectionOfMorphs [
+
+	"Height should be set, but width can vary"
+	^ self newContainerMorph 
+		cellPositioning: #rightCenter;
+		addAllMorphsBack: (aCollectionOfMorphs collect: [:aMorph | 
+			(self wrapInCell: aMorph flexVertically: false flexHorizontally: true)
+				listDirection: #rightToLeft])
+]
+
+{ #category : #visualisation }
+SBCluster >> newTopLeftCornerPlaceholder [
+
+	^ self newCellMorph
+]
+
+{ #category : #visualisation }
+SBCluster >> newTopRowFrom: aCollectionOfMorphs [
+
+	"Width should be set, but height can vary"
+	^ self newContainerMorph 
+		listDirection: #leftToRight;
+		listCentering: #bottomRight;
+		cellPositioning: #bottomCenter;
+		hResizing: #spaceFill;
+		addAllMorphsBack: (aCollectionOfMorphs collect: [:aMorph | 
+			aMorph rotationDegrees: 90.
+			self wrapInCell: aMorph owner flexVertically: true flexHorizontally: false])
+]
+
+{ #category : #converting }
+SBCluster >> watchesAsMatrix: aCollectionOfSBExampleWatches [
+
+	"Determine how watches are dissected to create a grid. We assume inclusion of headings per default"
+	^ self subclassResponsibility. 
+]
+
+{ #category : #helper }
+SBCluster >> wrapInCell: aMorph [
+
+	^ self wrapInCell: aMorph flexVertically: false flexHorizontally: false 
+
+]
+
+{ #category : #helper }
+SBCluster >> wrapInCell: aMorph flexVertically: aVBoolean flexHorizontally: aHBoolean [
+
+	| cell |
+	cell := self newCellMorph.
+
+	aVBoolean ifTrue: [cell vResizing: #shrinkWrap].
+	aHBoolean ifTrue: [cell hResizing: #shrinkWrap].
+
+	cell addMorph: aMorph.
+
+	^ cell
+]
diff --git a/packages/Sandblocks-Babylonian/SBExampleCluster.class.st b/packages/Sandblocks-Babylonian/SBExampleCluster.class.st
@@ -0,0 +1,12 @@
+Class {
+	#name : #SBExampleCluster,
+	#superclass : #SBCluster,
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #'as yet unclassified' }
+SBExampleCluster >> watchesAsMatrix: aCollectionOfSBExampleWatches [
+
+	"Determine how watches are dissected to create a grid"
+	^ self subclassResponsibility. 
+]
diff --git a/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st b/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st
@@ -21,6 +21,12 @@ SBExampleValueDisplay >> clear [
 	hadValue := false
 ]
 
+{ #category : #accessing }
+SBExampleValueDisplay >> display [
+
+	^ display
+]
+
 { #category : #accessing }
 SBExampleValueDisplay >> displayedWatchValueBlocks [
 
@@ -91,6 +97,12 @@ SBExampleValueDisplay >> label: aString [
 	label contents: aString
 ]
 
+{ #category : #accessing }
+SBExampleValueDisplay >> labelMorph [
+
+	^ label
+]
+
 { #category : #layout }
 SBExampleValueDisplay >> layoutCommands [
 

diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st
@@ -188,6 +188,12 @@ SBExampleWatch >> exampleStopped: anExample [
 		exampleToDisplay removeKey: anExample]
 ]
 
+{ #category : #accessing }
+SBExampleWatch >> exampleToDisplay [
+
+	^ exampleToDisplay
+]
+
 { #category : #accessing }
 SBExampleWatch >> exampleToDisplay: anExampleToDisplayDict [
 
@@ -200,6 +206,12 @@ SBExampleWatch >> exampleToValues: anExampleToCollectionOfObjectsDict [
 	exampleToValues := anExampleToCollectionOfObjectsDict
 ]
 
+{ #category : #accessing }
+SBExampleWatch >> examples [
+
+	^ exampleToDisplay keys
+]
+
 { #category : #accessing }
 SBExampleWatch >> expression [
 
@@ -244,7 +256,7 @@ SBExampleWatch >> initialize [
 	exampleToValues := Dictionary new.
 	watchedExpression := SBStMessageSend new.
 	dimensionOptions := SBComboBox new
-			prefix: 'Dimensions: ';
+			prefix: 'Morph Dimensions: ';
 			labels: (options collect: #label);
 			values: options;
 			object: options third;

diff --git a/packages/Sandblocks-Babylonian/SBGrid.class.st b/packages/Sandblocks-Babylonian/SBGrid.class.st
@@ -0,0 +1,62 @@
+Class {
+	#name : #SBGrid,
+	#superclass : #Morph,
+	#instVars : [
+		'columnCount'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #constants }
+SBGrid class >> cellInsetValue [
+
+	^ 5
+]
+
+{ #category : #'initialize-release' }
+SBGrid class >> newDisplaying: aMatrixOfMorphs [
+
+	^ self new
+		buildFromMatrix: aMatrixOfMorphs;
+		yourself
+]
+
+{ #category : #visualisation }
+SBGrid >> buildFromMatrix: aMatrixOfMorphs [
+
+	self submorphs copy do: #abandon.
+	columnCount := aMatrixOfMorphs columnCount.
+
+	aMatrixOfMorphs do: [:aMorph | self addMorphBack: aMorph].
+	self updateWidthToPersistColumns.
+]
+
+{ #category : #initialization }
+SBGrid >> initialize [ 
+
+	super initialize.
+	columnCount := 5.
+
+	self 
+		color: Color transparent;
+		layoutPolicy: TableLayout new;
+		listDirection: #leftToRight;
+		wrapDirection: #topToBottom;
+		wrapCentering: #topLeft;
+		cellInset: self class cellInsetValue;
+		width: 500;
+		vResizing: #shrinkWrap.
+]
+
+{ #category : #'as yet unclassified' }
+SBGrid >> resizeContents: aSBMorphResizer [
+
+	self submorphsDo: [:aSubmorph | aSBMorphResizer applyOn: aSubmorph].
+	self updateWidthToPersistColumns.
+]
+
+{ #category : #visualisation }
+SBGrid >> updateWidthToPersistColumns [
+
+	 self width: (columnCount * (self submorphs first width + (2 * self class cellInsetValue)))
+]
diff --git a/packages/Sandblocks-Babylonian/SBPermutationCluster.class.st b/packages/Sandblocks-Babylonian/SBPermutationCluster.class.st
@@ -0,0 +1,32 @@
+Class {
+	#name : #SBPermutationCluster,
+	#superclass : #SBCluster,
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #visualisation }
+SBPermutationCluster >> extractedLeftHeadingsFrom: aCollectionOfSBExampleWatches [
+
+	^ (aCollectionOfSBExampleWatches collect: [:aWatch | aWatch expression])
+]
+
+{ #category : #visualisation }
+SBPermutationCluster >> extractedTopHeadingsFrom: aCollectionOfSBExampleWatches [
+
+	^ (aCollectionOfSBExampleWatches first exampleToDisplay values collect: [:aDisplay | aDisplay labelMorph])
+]
+
+{ #category : #visualisation }
+SBPermutationCluster >> watchesAsMatrix: aCollectionOfSBExampleWatches [
+
+	| matrix |
+	matrix := Matrix 
+		rows: aCollectionOfSBExampleWatches size + 1
+		columns: (aCollectionOfSBExampleWatches first examples size) + 1.
+	matrix atRow: 1 put: ({self newTopLeftCornerPlaceholder}, (self extractedTopHeadingsFrom: aCollectionOfSBExampleWatches)).
+	matrix atColumn: 1 put: ({self newTopLeftCornerPlaceholder}, (self extractedLeftHeadingsFrom: aCollectionOfSBExampleWatches)).
+	aCollectionOfSBExampleWatches withIndexDo: [:aWatch :row | 
+		aWatch exampleToDisplay withIndexDo: [:exampleDisplayAssc :column | . 
+		matrix at: row+1 at: column+1 put: (exampleDisplayAssc display)]].
+	^ matrix
+]
diff --git a/packages/Sandblocks-Babylonian/SBResultsView.class.st b/packages/Sandblocks-Babylonian/SBResultsView.class.st
@@ -85,8 +85,11 @@ SBResultsView >> buildPermutationFor: aPermutation collectingWatchesFrom: aColle
 
 	self block addAllMorphsBack: { SBOwnTextMorph new contents: aPermutation asString.
 									self applyButtonFor: aPermutation. 
-									(self containerRow listDirection: #leftToRight) 
-										addAllMorphsBack: (self allWatchesIn: aCollectionOfMethodBlocks).
+									(self containerRow listDirection: #leftToRight)
+										 addMorph: ((
+											SBPermutationCluster
+												newFromWatches: (self allWatchesIn: aCollectionOfMethodBlocks)
+												havingSize: (SBMorphResizer newSmall))).
 									LineMorph from: 0@0 to: 50@0 color: Color black width: 2}
 ]
 

diff --git a/packages/Sandblocks-Watch/SBWatchView.class.st b/packages/Sandblocks-Watch/SBWatchView.class.st
@@ -216,7 +216,7 @@ SBWatchView >> layoutCommands [
 { #category : #layout }
 SBWatchView >> maxWidth [
 
-	^ 350
+	^ 10
 ]
 
 { #category : #accessing }