Grid views

packages/Sandblocks-Babylonian/Form.extension.st

@@ -10,7 +10,6 @@ Form >> sbSnapshot [
 Form >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
 	^ (SBWatchValue newContainerMorphFor: aSBWatchValue)  
-		addMorphBack: (SBIcon iconFor: aSBWatchValue watchedValueIdentityHash) asMorph;
 		addMorphBack: (aSBMorphResizer applyOn: self asMorph);
 		yourself
 ]

packages/Sandblocks-Babylonian/Morph.extension.st

@@ -4,7 +4,6 @@ Extension { #name : #Morph }
 Morph >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
 	^ (SBWatchValue newContainerMorphFor: aSBWatchValue)  
-		addMorphBack: (SBIcon iconFor: aSBWatchValue watchedValueIdentityHash) asMorph;
 		addMorphBack: (aSBMorphResizer applyOn: self sbSnapshot asMorph);
 		yourself
 ]

packages/Sandblocks-Babylonian/Point.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #Point }
+
+{ #category : #'*Sandblocks-Babylonian' }
+Point >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
+
+	^ (SBWatchValue newContainerMorphFor: aSBWatchValue) 
+		addMorphBack: self asMorph;
+		yourself
+]

packages/Sandblocks-Babylonian/SBCluster.class.st

@@ -0,0 +1,164 @@
+Class {
+	#name : #SBCluster,
+	#superclass : #Morph,
+	#instVars : [
+		'morphResizer'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #visualisation }
+SBCluster >> compressedMorphsForDisplay: aSBWatchView [
+
+	| displayedMorphs |
+	displayedMorphs := aSBWatchView displayedMorphs collect: [:aMorph | 
+			aMorph watchValue morphResizer: self morphResizer. 
+			aMorph watchValue asValueMorph].
+	^ (displayedMorphs size = 1) 
+		ifTrue: [displayedMorphs first]
+		ifFalse: [self newCellMorph 
+					borderWidth: 0;
+					when: #clicked send: #exploreValues to: aSBWatchView;
+					listDirection: #leftToRight;
+					wrapDirection: #topToBottom;
+					addAllMorphsBack: displayedMorphs]
+]
+
+{ #category : #initialization }
+SBCluster >> initialize [ 
+
+	super initialize.
+
+	self 
+		color: Color transparent;
+		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 transparent ;
+			changeTableLayout;
+			borderWidth: 1;
+			borderStyle: (BorderStyle width: 1 color: (Color gray alpha: 0.3));
+			listDirection: #topToBottom;
+			listCentering: #center;
+			wrapCentering: #center;
+			hResizing: #rigid;
+			vResizing: #rigid)
+]
+
+{ #category : #helper }
+SBCluster >> newContainerMorph [
+
+	^ Morph new
+		color: Color transparent ;
+		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;
+				borderWidth: 0])
+]
+
+{ #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) borderWidth: 0])
+]
+
+{ #category : #visualisation }
+SBCluster >> visualize [
+
+	| matrix |
+	self submorphs copy do: #delete.
+
+	matrix := self buildDisplayMatrix.
+	matrix ifEmpty: [ ^ 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 : #helper }
+SBCluster >> wrapInCell: aMorph [
+
+	^ self wrapInCell: aMorph flexVertically: false flexHorizontally: false 
+
+]
+
+{ #category : #helper }
+SBCluster >> wrapInCell: aMorph flexVertically: aVBoolean flexHorizontally: aHBoolean [
+
+	| cell targetExtent|
+	cell := self newCellMorph.
+
+	aVBoolean ifTrue: [cell vResizing: #shrinkWrap].
+	aHBoolean ifTrue: [cell hResizing: #shrinkWrap].
+
+	(((aMorph fullBounds extent <= cell extent) 
+		or: [aVBoolean and: (aMorph fullBounds width <= cell width)]) 
+		or: [aHBoolean and: (aMorph fullBounds height <= cell height)])
+			ifTrue: [cell addMorph: aMorph. ^ cell].
+
+	targetExtent := cell extent - (cell borderWidth@cell borderWidth).
+	aVBoolean ifTrue: [targetExtent setX: targetExtent x setY: aMorph fullBounds height].
+	aHBoolean ifTrue: [targetExtent setX: aMorph fullBounds width setY: targetExtent height].
+
+	self flag: #todo. "Another way besides turning into an image to keep interactions.-jb"
+	cell addMorph: (ImageMorph new 
+		newForm: (aMorph iconOrThumbnailOfSize: targetExtent);
+		when: #clicked send: #triggerEvent: to: aMorph with: #clicked).
+	cell on: #click send: #value to: [cell submorphs first triggerEvent: #clicked].
+	^ cell
+]

packages/Sandblocks-Babylonian/SBExampleCluster.class.st

@@ -0,0 +1,89 @@
+Class {
+	#name : #SBExampleCluster,
+	#superclass : #SBCluster,
+	#instVars : [
+		'displayedIndex',
+		'multiverse'
+	],
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #'initialize-release' }
+SBExampleCluster class >> newForSize: aSBMorphResizer multiverse: aSBMultiverse displaying: aNumber [
+
+	^ self new 
+		morphResizer: aSBMorphResizer;
+		multiverse: aSBMultiverse;
+		displayedIndex: aNumber;
+		visualize;
+		yourself 
+
+]
+
+{ #category : #visualisation }
+SBExampleCluster >> buildDisplayMatrix [
+
+	| matrix |
+	matrix := Matrix 
+		rows: (self multiverse universes first watches size) + 1
+		columns: self multiverse universes size + 1.
+
+	matrix atRow: 1 put: ({self newTopLeftCornerPlaceholder}, 
+		(self extractedTopHeadingsFrom: self multiverse)).
+	matrix atColumn: 1 put: ({self newTopLeftCornerPlaceholder}, 
+		(self extractedLeftHeadingsFrom: self multiverse)).
+
+	self multiverse universes withIndexDo: [:aUniverse :column | 
+		(self extractRowsFrom: aUniverse) withIndexDo: [:aCellMorph :row| 
+			matrix at: row+1 at: column+1 put: aCellMorph]].
+
+	^ matrix
+]
+
+{ #category : #accessing }
+SBExampleCluster >> displayedIndex [
+
+	^ displayedIndex
+]
+
+{ #category : #accessing }
+SBExampleCluster >> displayedIndex: aNumber [
+
+	displayedIndex := aNumber
+]
+
+{ #category : #visualisation }
+SBExampleCluster >> extractRowsFrom: aUniverse [
+
+	^ aUniverse watches collect: [:anExample | | display | 
+		display := (anExample exampleToDisplay associations at: self displayedIndex) value display.
+		self compressedMorphsForDisplay: display]
+]
+
+{ #category : #visualisation }
+SBExampleCluster >> extractedLeftHeadingsFrom: aSBMultiverse [
+
+	^ (aSBMultiverse universes first watches collect: [:aWatch | aWatch expression copy])
+]
+
+{ #category : #visualisation }
+SBExampleCluster >> extractedTopHeadingsFrom: aSBMultiverse [
+
+	^ (aSBMultiverse universes collect: [:aUniverse | 
+		self newContainerMorph 
+			addAllMorphsBack: {
+				SBStringMorph new contents: aUniverse activePermutation asString.
+				SBButton newApplyPermutationFor: aUniverse activePermutation}])
+]
+
+{ #category : #accessing }
+SBExampleCluster >> multiverse [
+
+	^ multiverse
+]
+
+{ #category : #accessing }
+SBExampleCluster >> multiverse: aSBMultiverse [
+
+	multiverse := aSBMultiverse
+]

packages/Sandblocks-Babylonian/SBExampleGridsView.class.st

@@ -0,0 +1,42 @@
+Class {
+	#name : #SBExampleGridsView,
+	#superclass : #SBGridResultsView,
+	#category : #'Sandblocks-Babylonian'
+}
+
+{ #category : #building }
+SBExampleGridsView >> buildAllPossibleResults [
+
+	self multiverse activeExamples withIndexDo: [:anExample :anIndex | self buildExampleFor: anIndex]
+]
+
+{ #category : #building }
+SBExampleGridsView >> buildExampleFor: aNumber [
+
+	gridContainer addMorphBack: (self containerRow cellPositioning: #center;
+		addAllMorphsBack: {
+			self containerRow listDirection: #topToBottom;
+				addAllMorphsBack: { 
+					SBOwnTextMorph new contents: 'example: ', (self multiverse activeExamples at: aNumber) label.
+					SBExampleCluster 
+						newForSize: morphResizer
+						multiverse: self multiverse 
+						displaying: aNumber}.
+		LineMorph from: 0@0 to: 0@50 color: Color black width: 2}).
+
+	self updateContainerWidth.
+]
+
+{ #category : #updating }
+SBExampleGridsView >> gridObjects [
+
+	^ self multiverse activeExamples
+]
+
+{ #category : #initialization }
+SBExampleGridsView >> initialize [ 
+
+	super initialize.
+
+	self name: 'Example Grid View'.
+]

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 [
 

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;