Correlation View and other features

packages/Sandblocks-Babylonian/False.extension.st

@@ -0,0 +1,12 @@
+Extension { #name : #False }
+
+{ #category : #'*Sandblocks-Babylonian' }
+False >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
+
+	"This has to return a container block"
+	"Objects can choose if they want to apply a changed extent" 
+
+	^ (SBWatchValue newContainerMorphFor: aSBWatchValue) 
+		addMorphBack: ToolIcons testRed asMorph;
+		yourself
+]

packages/Sandblocks-Babylonian/Form.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : #Form }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Form >> applyResize: aPoint [
+
+	^ self scaledToSize: aPoint
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Form class >> exampleBlock [
 

packages/Sandblocks-Babylonian/ImageMorph.extension.st

@@ -0,0 +1,10 @@
+Extension { #name : #ImageMorph }
+
+{ #category : #'*Sandblocks-Babylonian' }
+ImageMorph >> applyResize: aPoint [
+
+	| form |
+	form := self form.
+	form := form applyResize: aPoint.
+	^ form asMorph
+]

packages/Sandblocks-Babylonian/Morph.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : #Morph }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> applyResize: aPoint [
+
+	^ self extent: aPoint
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Morph class >> exampleObject [
 
@@ -19,3 +25,18 @@ Morph >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 		addMorphBack: (aSBMorphResizer applyOn: self sbSnapshot asMorph);
 		yourself
 ]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> topLevelVariants [
+
+	^ Array streamContents: [:stream | self topLevelVariantsDo: [:block | stream nextPut: block]]
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Morph >> topLevelVariantsDo: aBlock [
+
+	self submorphsDo: [:morph |
+		(morph isSandblock and: [morph isVariant])
+			ifTrue: [aBlock value: morph]
+			ifFalse: [morph topLevelVariantsDo: aBlock]]
+]

packages/Sandblocks-Babylonian/Object.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : #Object }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Object >> applyResize: aPoint [
+
+	"Nothing"
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Object >> asSBWatchValue [
 

packages/Sandblocks-Babylonian/SBBlock.extension.st

@@ -23,3 +23,9 @@ SBBlock >> listensToExamples [
 
 	^ false
 ]
+
+{ #category : #'*Sandblocks-Babylonian' }
+SBBlock >> suggestedAlternationName [
+
+	^ self printString
+]

packages/Sandblocks-Babylonian/SBCluster.class.st

@@ -110,7 +110,7 @@ SBCluster >> newTopRowFrom: aCollectionOfMorphs [
 	^ self newContainerMorph 
 		listDirection: #leftToRight;
 		listCentering: #bottomRight;
-		cellPositioning: #bottomCenter;
+		cellPositioning: #topCenter;
 		hResizing: #spaceFill;
 		addAllMorphsBack: (aCollectionOfMorphs collect: [:aMorph | 
 			aMorph rotationDegrees: 90.
@@ -160,7 +160,9 @@ SBCluster >> visualizeNothingToDisplay [
 { #category : #helper }
 SBCluster >> wrapInCell: aMorph [
 
-	^ self wrapInCell: aMorph flexVertically: false flexHorizontally: false 
+	^ self morphResizer label = SBMorphResizer newIdentity label
+		ifTrue: [self wrapInCell: aMorph flexVertically: true flexHorizontally: true] 
+		ifFalse: [self wrapInCell: aMorph flexVertically: false flexHorizontally: false]
 
 ]
 

packages/Sandblocks-Babylonian/SBCorrelationCluster.class.st

@@ -0,0 +1,140 @@
+Class {
+	#name : #SBCorrelationCluster,
+	#superclass : #SBCluster,
+	#instVars : [
+		'displayedExample',
+		'displayedWatch',
+		'baseUniverse',
+		'basePermutation',
+		'correlatingUniverses'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #'instance creation' }
+SBCorrelationCluster class >> newForSize: aSBMorphResizer example: anExample watch: aWatch basePermutation: aPermutation correlating: aCollectionOfUniverses [
+
+	^ self new 
+		morphResizer: aSBMorphResizer;
+		displayedExample: anExample;
+		displayedWatch: aWatch;
+		basePermutation: aPermutation;
+		correlatingUniverses: aCollectionOfUniverses;
+		visualize;
+		yourself 
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> basePermutation [
+	^ basePermutation
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> basePermutation: anObject [
+	basePermutation := anObject
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> baseUniverse [
+
+	^ baseUniverse
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> baseUniverse: aUniverse [
+
+	baseUniverse := aUniverse
+]
+
+{ #category : #building }
+SBCorrelationCluster >> buildDisplayMatrix [
+
+	| matrix |
+
+	matrix := Matrix 
+		rows: 2
+		columns: self correlatingUniverses size + 1.
+
+	matrix atRow: 1 put: ({TextMorph new contents: self basePermutation asVariantString}, 
+	(self extractedTopHeadingsFrom: self correlatingUniverses)).
+
+	matrix at: 2 at: 1 put: (SBPermutationLabel newDisplaying: self basePermutation).
+
+	self extractRow withIndexDo: [:aCellMorph :column | matrix at: 2 at: column+1 put: aCellMorph].
+
+	^ matrix
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> correlatingUniverses [
+
+	^ correlatingUniverses
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> correlatingUniverses: aCollectionOfUniverses [
+
+	correlatingUniverses := aCollectionOfUniverses
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedExample [
+
+	^ displayedExample
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedExample: aSBExample [
+
+	displayedExample := aSBExample
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedWatch [
+
+	^ displayedWatch
+]
+
+{ #category : #accessing }
+SBCorrelationCluster >> displayedWatch: anSBExampleWatch [
+
+	displayedWatch := anSBExampleWatch
+]
+
+{ #category : #building }
+SBCorrelationCluster >> extractRow [
+
+	^ self correlatingUniverses 
+		collect: [:aUniverse | | display | 
+		display := ((aUniverse watches detect: [:aWatch | aWatch originalIdentifier = self displayedWatch identifier]) 
+					exampleToDisplay at: self displayedExample) value display.
+		self compressedMorphsForDisplay: display]
+]
+
+{ #category : #building }
+SBCorrelationCluster >> extractedTopHeadingsFrom: aCollectionOfCorrelatingUniverses [
+
+	^ aCollectionOfCorrelatingUniverses collect: [:aCorrelatingUniverse |  
+		SBPartialPermutationLabel 
+			newDisplaying: (aCorrelatingUniverse activePermutation copyRemovingVariants: self basePermutation referencedVariants)
+			referingTo: aCorrelatingUniverse]
+]
+
+{ #category : #visualisation }
+SBCorrelationCluster >> newTopRowFrom: aCollectionOfPermutationLabels [
+
+	"Width should be set, but height can vary"
+	^ self newContainerMorph 
+		listDirection: #leftToRight;
+		listCentering: #bottomRight;
+		cellPositioning: #topCenter;
+		hResizing: #spaceFill;
+		addAllMorphsBack: (aCollectionOfPermutationLabels collect: [:aLabel | 
+			self newContainerMorph 
+				addAllMorphsBack: {
+					(self 
+						wrapInCell: aLabel 
+						flexVertically: true 
+						flexHorizontally: false)  borderWidth: 0.
+					SBButton newApplyPermutationFor: (aLabel universe activePermutation).}])
+]