diff --git a/packages/Sandblocks-Babylonian/False.extension.st b/packages/Sandblocks-Babylonian/False.extension.st new file mode 100644 index 00000000..82ced5c2 --- /dev/null +++ b/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 +] diff --git a/packages/Sandblocks-Babylonian/Form.extension.st b/packages/Sandblocks-Babylonian/Form.extension.st index f7dcf441..7498fa91 100644 --- a/packages/Sandblocks-Babylonian/Form.extension.st +++ b/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 [ diff --git a/packages/Sandblocks-Babylonian/ImageMorph.extension.st b/packages/Sandblocks-Babylonian/ImageMorph.extension.st new file mode 100644 index 00000000..79fb92c2 --- /dev/null +++ b/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 +] diff --git a/packages/Sandblocks-Babylonian/Morph.extension.st b/packages/Sandblocks-Babylonian/Morph.extension.st index 4c9c06bf..e7970c36 100644 --- a/packages/Sandblocks-Babylonian/Morph.extension.st +++ b/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]] +] diff --git a/packages/Sandblocks-Babylonian/Object.extension.st b/packages/Sandblocks-Babylonian/Object.extension.st index 20481b1c..52a49113 100644 --- a/packages/Sandblocks-Babylonian/Object.extension.st +++ b/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 [ diff --git a/packages/Sandblocks-Babylonian/SBBlock.extension.st b/packages/Sandblocks-Babylonian/SBBlock.extension.st index 04588846..bee7ec48 100644 --- a/packages/Sandblocks-Babylonian/SBBlock.extension.st +++ b/packages/Sandblocks-Babylonian/SBBlock.extension.st @@ -23,3 +23,9 @@ SBBlock >> listensToExamples [ ^ false ] + +{ #category : #'*Sandblocks-Babylonian' } +SBBlock >> suggestedAlternationName [ + + ^ self printString +] diff --git a/packages/Sandblocks-Babylonian/SBCluster.class.st b/packages/Sandblocks-Babylonian/SBCluster.class.st index 864eebe6..a454e812 100644 --- a/packages/Sandblocks-Babylonian/SBCluster.class.st +++ b/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] ] diff --git a/packages/Sandblocks-Babylonian/SBCorrelationCluster.class.st b/packages/Sandblocks-Babylonian/SBCorrelationCluster.class.st new file mode 100644 index 00000000..43033d83 --- /dev/null +++ b/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).}]) +] diff --git a/packages/Sandblocks-Babylonian/SBCorrelationView.class.st b/packages/Sandblocks-Babylonian/SBCorrelationView.class.st new file mode 100644 index 00000000..ee2666aa --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBCorrelationView.class.st @@ -0,0 +1,208 @@ +Class { + #name : #SBCorrelationView, + #superclass : #SBResizableResultsView, + #instVars : [ + 'variantSelection', + 'selectedVariants', + 'basePermutations', + 'groupedUniverses' + ], + #category : #'Sandblocks-Babylonian' +} + +{ #category : #building } +SBCorrelationView >> buildAllPossibleResults [ + + self multiverse activeExamples + ifEmpty: [gridContainer addMorph: (TextMorph new contents: 'No examples active'). + gridContainer width: gridContainer firstSubmorph width + 5 "a bit of margin"]. + + groupedUniverses := self groupUniversesContainingAllVariantsIn: selectedVariants. + basePermutations := self collectAllPermutationsOfSelectedVariants asOrderedCollection. + + self multiverse activeExamples do: [:anExample | + self multiverse watches do: [:aWatch | + self buildForExample: anExample watching: aWatch]] +] + +{ #category : #building } +SBCorrelationView >> buildForExample: anExample watching: aWatch [ + + gridContainer addMorphBack: (self containerRow cellPositioning: #center; + addAllMorphsBack: { + self containerRow listDirection: #topToBottom; + addAllMorphsBack: { + SBOwnTextMorph new contents: ( + '{1}, {2}' format: {anExample label. + (aWatch cleanedExpression sourceString)}). + self buildGridsFor: anExample watching: aWatch} flatten}) +] + +{ #category : #building } +SBCorrelationView >> buildGridsFor: anExample watching: aWatch [ + + ^ (basePermutations collect: [:aBasePermutation | + SBCorrelationCluster + newForSize: self selectedResizer + example: anExample + watch: aWatch + basePermutation: aBasePermutation + correlating: (self getUniversesContainingPermutation: aBasePermutation)]), + (groupedUniverses second collect: [:aNonCorrelatingUniverse | + SBCorrelationCluster + newForSize: self selectedResizer + example: anExample + watch: aWatch + basePermutation: aNonCorrelatingUniverse activePermutation + correlating: {aNonCorrelatingUniverse}]) +] + +{ #category : #building } +SBCorrelationView >> buildSelectionRow [ + + | container selectedString | + container := self containerRow. + self ensureVariantSelectionIn: container. + selectedString := 'Selected: '. + selectedVariants + ifEmpty: [ selectedString := selectedString, 'None' ] + ifNotEmpty: [ selectedString := selectedString, ((selectedVariants collect: #name) fold: [:a :b | a, ', ', Character cr, b ])]. + container addMorphBack: selectedString asMorph. + self block addMorph: container. + +] + +{ #category : #building } +SBCorrelationView >> buildVariantSelection [ + + | options topLevelVariant | + options := self multiverse variants. + topLevelVariant := options detect: [:aVariant | aVariant parentVariant isNil] ifNone: [options first]. + + ^ SBComboBox new + prefix: 'Add or Remove'; + labels: (options collect: #name); + values: options; + object: topLevelVariant; + when: #selectionChanged send: #changeVariants to: self; + displayPrefixOnly +] + +{ #category : #accessing } +SBCorrelationView >> buttons [ + + ^ {} +] + +{ #category : #building } +SBCorrelationView >> changeVariants [ + + (selectedVariants includes: variantSelection object) + ifTrue: [selectedVariants remove: variantSelection object] + ifFalse: [selectedVariants add: variantSelection object]. + + self visualize +] + +{ #category : #building } +SBCorrelationView >> collectAllPermutationsOfSelectedVariants [ + + | allPermutations | + selectedVariants ifEmpty: [^ {SBNilPermutation new referencedVariants: {}} asSet]. + allPermutations := Set new. + groupedUniverses first do: [:aUniverseContainingSelected | | base | + base := SBPermutation new referencedVariants: selectedVariants. + selectedVariants do: [:aVariant | base at: aVariant id put: (aUniverseContainingSelected activePermutation at: aVariant id)]. + allPermutations add: base]. + ^ allPermutations +] + +{ #category : #building } +SBCorrelationView >> ensureVariantSelection [ + + self multiverse variants ifEmpty: [selectedVariants := OrderedCollection new. ^ self]. + variantSelection := self buildVariantSelection. + self block addMorph: variantSelection. + + selectedVariants + ifNil: [selectedVariants := {variantSelection object} asOrderedCollection] + ifNotNil: [selectedVariants := selectedVariants select: [:aVariant | self multiverse variants includes: aVariant]]. + +] + +{ #category : #building } +SBCorrelationView >> ensureVariantSelectionIn: aMorph [ + + self multiverse variants ifEmpty: [selectedVariants := OrderedCollection new. ^ self]. + variantSelection := self buildVariantSelection. + aMorph addMorph: variantSelection. + + selectedVariants + ifNil: [selectedVariants := {variantSelection object} asOrderedCollection] + ifNotNil: [selectedVariants := selectedVariants select: [:aVariant | self multiverse variants includes: aVariant]]. + +] + +{ #category : #building } +SBCorrelationView >> getUniversesContainingPermutation: aPermutation [ + + ^ groupedUniverses first select: [:aUniverse | + aUniverse activePermutation contains: aPermutation] +] + +{ #category : #building } +SBCorrelationView >> groupUniversesContainingAllVariantsIn: aCollectionOfVariants [ + + | contains omits | + contains := OrderedCollection new. + omits := OrderedCollection new. + self multiverse universes do: [:aUniverse | + (aCollectionOfVariants allSatisfy: [:aVariant | aUniverse activePermutation referencedVariants includes: aVariant]) + ifTrue: [contains add: aUniverse] + ifFalse: [omits add: aUniverse]]. + + ^ {contains. omits.} +] + +{ #category : #building } +SBCorrelationView >> groupUniversesContainingPermutation: aPermutation [ + + | contains omits | + contains := OrderedCollection new. + omits := OrderedCollection new. + groupedUniverses first do: [:aUniverse | + (aUniverse activePermutation contains: aPermutation) + ifTrue: [contains add: aUniverse] + ifFalse: [omits add: aUniverse]]. + + ^ {contains. omits.} +] + +{ #category : #initialization } +SBCorrelationView >> initialize [ + + super initialize. + + self name: 'Correlation'. + +] + +{ #category : #actions } +SBCorrelationView >> visualize [ + + self clean. + + self buildSelectionRow. + self block addMorph: dimensionOptions. + + self buildButtonRow. + + self buildAllPossibleResults . + self concludeContainerWidth. +] + +{ #category : #accessing } +SBCorrelationView >> wantsReloadOnSaveWhenOpen [ + + ^ true +] diff --git a/packages/Sandblocks-Babylonian/SBCustomView.class.st b/packages/Sandblocks-Babylonian/SBCustomView.class.st new file mode 100644 index 00000000..13ec7048 --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBCustomView.class.st @@ -0,0 +1,98 @@ +Class { + #name : #SBCustomView, + #superclass : #SBExploriantsView, + #instVars : [ + 'viewOptions' + ], + #category : #'Sandblocks-Babylonian' +} + +{ #category : #accessing } +SBCustomView >> activeIndex [ + + ^ self viewClasses indexOf: self selectedView class +] + +{ #category : #building } +SBCustomView >> buildViewOptions [ + + | options | + options := self viewClasses collect: [:aClass | aClass new hasBeenRenamed: true]. + + ^ SBComboBox new + prefix: 'Current View: '; + labels: (options collect: #name); + values: options ; + object: options first; + when: #selectionChanged send: #switchView to: self +] + +{ #category : #initialization } +SBCustomView >> initialize [ + + super initialize. + + viewOptions := self buildViewOptions. + self name: 'Results'. + + self buildButtonRow. + + self block addMorphBack: viewOptions. + self block addMorphBack: self selectedView + +] + +{ #category : #accessing } +SBCustomView >> isOverview [ + + ^ true +] + +{ #category : #accessing } +SBCustomView >> multiverse: aSBMultiverse [ + + super multiverse: aSBMultiverse. + viewOptions values do: [:aSBNamedBlock | aSBNamedBlock multiverse: aSBMultiverse] +] + +{ #category : #accessing } +SBCustomView >> selectedView [ + + ^ viewOptions object +] + +{ #category : #updating } +SBCustomView >> switchView [ + + self selectedView block = self block lastSubmorph ifTrue: [^ self]. + + self block lastSubmorph delete. + self block addMorphBack: self selectedView block. +] + +{ #category : #accessing } +SBCustomView >> viewClasses [ + + ^ {SBPermutationGridsView. + SBExampleGridsView. + SBCorrelationView. + SBLiveView.} +] + +{ #category : #accessing } +SBCustomView >> views [ + + ^ viewOptions values +] + +{ #category : #updating } +SBCustomView >> visualize [ + + self block addMorphBack: self selectedView block. +] + +{ #category : #accessing } +SBCustomView >> wantsReloadOnSaveWhenOpen [ + + ^ self selectedView wantsReloadOnSaveWhenOpen +] diff --git a/packages/Sandblocks-Babylonian/SBDiffTabView.class.st b/packages/Sandblocks-Babylonian/SBDiffTabView.class.st index 71fec677..2a968edf 100644 --- a/packages/Sandblocks-Babylonian/SBDiffTabView.class.st +++ b/packages/Sandblocks-Babylonian/SBDiffTabView.class.st @@ -26,6 +26,8 @@ SBDiffTabView >> addButton [ { #category : #callbacks } SBDiffTabView >> artefactSaved: aMethodBlock [ + aMethodBlock = self containingArtefact ifTrue: [self updateTabNames]. + (aMethodBlock = self containingArtefact and: [self isShowingDiff]) ifTrue: [self updateSelectedTab] ] @@ -141,7 +143,8 @@ SBDiffTabView >> sourceStringFor: aNamedBlock [ ^ aNamedBlock block isBlockBody ifFalse: [aNamedBlock block sourceString] ifTrue: [ (aNamedBlock block statements collect: #sourceString) - fold: [:a :b | a, Character cr, b]] + ifEmpty: [''] + ifNotEmpty: [:theStatements | theStatements fold: [:a :b | a, Character cr, b]]] ] { #category : #accessing } diff --git a/packages/Sandblocks-Babylonian/SBExample.class.st b/packages/Sandblocks-Babylonian/SBExample.class.st index e8be6d13..706cf44e 100644 --- a/packages/Sandblocks-Babylonian/SBExample.class.st +++ b/packages/Sandblocks-Babylonian/SBExample.class.st @@ -323,7 +323,7 @@ SBExample >> lastError: anError [ "ToolSet debugException: anError" ^ reportedError := self sandblockEditor reportError: anError - process: ((Process forContext: anError signalerContext copyStack priority: Processor activeProcess priority) + process: ((Process forContext: anError signal copyStack priority: Processor activeProcess priority) shouldResumeFromDebugger: false; yourself) source: self]. diff --git a/packages/Sandblocks-Babylonian/SBExampleCluster.class.st b/packages/Sandblocks-Babylonian/SBExampleCluster.class.st index 00635bc3..16d268e3 100644 --- a/packages/Sandblocks-Babylonian/SBExampleCluster.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleCluster.class.st @@ -56,7 +56,7 @@ SBExampleCluster >> displayedIndex: aNumber [ SBExampleCluster >> extractRowsFrom: aUniverse [ ^ aUniverse watches collect: [:aWatch | | display | - display := (aWatch exampleToDisplay associations at: self displayedIndex) value display. + display := (aWatch exampleToDisplay at: (self multiverse activeExamples at: self displayedIndex)) value display. self compressedMorphsForDisplay: display] ] @@ -70,14 +70,7 @@ SBExampleCluster >> extractedLeftHeadingsFrom: aSBMultiverse [ SBExampleCluster >> extractedTopHeadingsFrom: aSBMultiverse [ ^ (aSBMultiverse universes collect: [:aUniverse | - self newContainerMorph - listDirection: #bottomToTop; - cellPositioning: #topLeft; - cellGap: 3; - cellInset: 3; - addAllMorphsBack: { - SBButton newApplyPermutationFor: aUniverse activePermutation. - SBPermutationLabel newDisplaying: aUniverse activePermutation}]) + SBPermutationLabel newDisplaying: aUniverse activePermutation]) ] { #category : #accessing } @@ -91,3 +84,32 @@ SBExampleCluster >> multiverse: aSBMultiverse [ multiverse := aSBMultiverse ] + +{ #category : #visualisation } +SBExampleCluster >> newTopRowFrom: aCollectionOfPermutationLabels [ + + "Width should be set, but height can vary" + ^ self newContainerMorph + listDirection: #leftToRight; + listCentering: #bottomRight; + cellPositioning: #topCenter; + hResizing: #spaceFill; + addAllMorphsBack: (aCollectionOfPermutationLabels collect: [:aLabel | + | wrappedLabel button | + aLabel rotationDegrees: 90. + wrappedLabel := (self wrapInCell: aLabel owner + flexVertically: true + flexHorizontally: false) borderWidth: 0. + "Rotating morphs somehow clips their right border, so dirty hack so container gets clipped 1px" + button := self newContainerMorph + cellInset: 1; + addMorphBack: (SBButton newApplyPermutationFor: aLabel permutation); + rotationDegrees: 90. + button owner width > wrappedLabel width ifTrue: [button firstSubmorph makeTiny]. + + self newContainerMorph + cellPositioning: #bottomToTop; + cellPositioning: #topCenter; + cellInset: 0@2; + addAllMorphsBack: {button owner. wrappedLabel}]) +] diff --git a/packages/Sandblocks-Babylonian/SBExampleGridsView.class.st b/packages/Sandblocks-Babylonian/SBExampleGridsView.class.st index ba829294..466a12e5 100644 --- a/packages/Sandblocks-Babylonian/SBExampleGridsView.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleGridsView.class.st @@ -41,5 +41,5 @@ SBExampleGridsView >> initialize [ super initialize. - self name: 'Example Focused'. + self name: 'Example Grouped' ] diff --git a/packages/Sandblocks-Babylonian/SBExampleTrace.class.st b/packages/Sandblocks-Babylonian/SBExampleTrace.class.st index 222aa956..cabc1804 100644 --- a/packages/Sandblocks-Babylonian/SBExampleTrace.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleTrace.class.st @@ -11,7 +11,7 @@ SBExampleTrace >> buildDisplayMatrix [ matrix := Matrix rows: 2 columns: self multiverse universes size. - displayedExample := self multiverse watches first examples at: self displayedIndex. + displayedExample := self multiverse activeExamples at: self displayedIndex. matrix atRow: 1 put: (self extractedTopHeadingsFrom: self multiverse). self multiverse universes withIndexDo: [:aUniverse :column | diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st index 8dcdcfb3..b7a29069 100644 --- a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st @@ -127,6 +127,7 @@ SBExampleWatch >> asInactiveCopy [ | copy | copy := SBInactiveExampleWatch new newIdentifier; + originalIdentifier: self identifier; expression: (SBTextBubble new contents: self cleanedExpression sourceString); modifyExpression: self modifyExpression veryDeepCopy; dimensionOptions: self dimensionOptions veryDeepCopy. @@ -334,11 +335,11 @@ SBExampleWatch >> initialize [ exampleToValues := IdentityDictionary new. watchedExpression := SBStMessageSend new. dimensionOptions := SBComboBox new - prefix: 'Morph Dimensions: '; - labels: (options collect: #label); - values: options; - object: options third; - when: #selectionChanged send: #applyResizerOnValues to: self. + prefix: 'Preview sizes: '; + labels: (options collect: #label); + values: options; + object: options third; + when: #selectionChanged send: #applyResizerOnValues to: self. modifyExpression := SBStBlockBody identityNamed: 'each'. self @@ -348,14 +349,19 @@ SBExampleWatch >> initialize [ vResizing: #shrinkWrap; hResizing: #shrinkWrap; addAllMorphsBack: { - watchedExpression. - SBRow new + watchedExpression. + SBRow new hResizing: #spaceFill; listCentering: #bottomRight; addMorphBack: dimensionOptions; - yourself. - modifyExpression}; - yourself + yourself. + SBVariant + named: 'modifyExpression' + associations: {'with' -> [modifyExpression]. 'without' -> []} + activeIndex: 2 + id: '90d7c718-89b8-7e48-8262-467d07d56880' + isActive: false}; + yourself ] { #category : #initialization } @@ -505,6 +511,13 @@ SBExampleWatch >> resetOnlyValuesFor: anExample [ ] +{ #category : #actions } +SBExampleWatch >> resolveAllLiveElements [ + + + SBMultiverse resolveIn: self sandblockEditor +] + { #category : #testing } SBExampleWatch >> resumeGraphicalUpdates [ diff --git a/packages/Sandblocks-Babylonian/SBExploriants.class.st b/packages/Sandblocks-Babylonian/SBExploriants.class.st index 0c7ca058..34e0a475 100644 --- a/packages/Sandblocks-Babylonian/SBExploriants.class.st +++ b/packages/Sandblocks-Babylonian/SBExploriants.class.st @@ -52,6 +52,23 @@ SBExploriants >> artefactSaved: aMethodBlock [ (aMethodBlock isMethod and: [self isInEditor]) ifTrue: [self tryToUpdateInBackgroundAfterChangeIn: aMethodBlock] ] +{ #category : #ui } +SBExploriants >> asTabButton: aNamedBlock [ + + | button | + button := SBButton new + label: aNamedBlock nameToDisplay do: [self setActive: aNamedBlock]; + cornerStyle: #squared; + hResizing: #spaceFill; + changeTableLayout; + makeSmall; + listDirection: #leftToRight. + + aNamedBlock = self active ifTrue: [button makeBold]. + + ^ button +] + { #category : #'ast helpers' } SBExploriants >> binding: aString for: block class: aClass ifPresent: aBlock [ @@ -67,6 +84,17 @@ SBExploriants >> binding: aString for: block class: aClass ifPresent: aBlock [ ^ nil ] +{ #category : #ui } +SBExploriants >> buildTabs [ + + self addMorphBack: (SBRow new + addAllMorphsBack: (self namedBlocks collect: [:block | self asTabButton: block]); + name: #tabs; + changeTableLayout; + listDirection: #leftToRight; + hResizing: #shrinkWrap) +] + { #category : #ui } SBExploriants >> buildView [ @@ -140,11 +168,19 @@ SBExploriants >> selector [ ^ nil ] +{ #category : #accessing } +SBExploriants >> tabs [ + + ^ (self submorphNamed: #tabs) submorphs +] + { #category : #actions } SBExploriants >> tryToUpdateInBackgroundAfterChangeIn: aMethodBlock [ | multiverse | multiverse := self active multiverse. + self active wantsReloadOnSaveWhenOpen ifFalse: [^self]. + self ignoreUpdate ifFalse: [self updateInBackgroundOnTimeoutRevertTo: multiverse] ifTrue: [ diff --git a/packages/Sandblocks-Babylonian/SBExploriantsView.class.st b/packages/Sandblocks-Babylonian/SBExploriantsView.class.st index 0516082a..403ae16c 100644 --- a/packages/Sandblocks-Babylonian/SBExploriantsView.class.st +++ b/packages/Sandblocks-Babylonian/SBExploriantsView.class.st @@ -17,7 +17,7 @@ SBExploriantsView class >> block: aSBBlock named: aString [ { #category : #'instance creation' } SBExploriantsView class >> getTabsInMultiverse: aSBMultiverse [ - ^ {SBPermutationGridsView. SBExampleGridsView. SBLiveView. SBPlainResultsView. SBVariantsView. SBHistoryView} + ^ {SBCustomView. SBPlainResultsView. SBVariantsView. SBHistoryView} collect: [:mySubclass | mySubclass newMultiverse: aSBMultiverse] ] @@ -25,6 +25,7 @@ SBExploriantsView class >> getTabsInMultiverse: aSBMultiverse [ SBExploriantsView class >> newMultiverse: aSBMultiverse [ ^ self new + hasBeenRenamed: true; multiverse: aSBMultiverse; yourself ] @@ -41,7 +42,7 @@ SBExploriantsView >> buildButtonRow [ { #category : #accessing } SBExploriantsView >> buttons [ - ^ {self updateButton. self resolveButton} + ^ {self updateButton. self resolveButton. self saveButton} ] { #category : #actions } @@ -89,7 +90,13 @@ SBExploriantsView >> initialize [ cellGap: 4; cellInset: 2; hResizing: #shrinkWrap; - vResizing: #shrinkWrap) + vResizing: #shrinkWrap). +] + +{ #category : #accessing } +SBExploriantsView >> isOverview [ + + ^false ] { #category : #accessing } @@ -103,6 +110,7 @@ SBExploriantsView >> multiverse: aSBMultiverse [ multiverse := aSBMultiverse. multiverse when: #updated send: #visualize to: self. + ^ multiverse ] { #category : #building } @@ -110,11 +118,21 @@ SBExploriantsView >> resolveButton [ ^ SBButton new icon: SBIcon iconTrash - label: 'Resolve All From Code' + label: 'Clean in Code' do: [self multiverse resolve]; cornerStyle: #squared ] +{ #category : #building } +SBExploriantsView >> saveButton [ + + ^ SBButton new + icon: SBIcon iconSave + label: 'Save As PNG' + do: [self block exportAsPNG]; + cornerStyle: #squared +] + { #category : #copying } SBExploriantsView >> snapshot [ @@ -126,7 +144,7 @@ SBExploriantsView >> updateButton [ ^ SBButton new icon: SBIcon iconRotateLeft - label: 'Re-Generate Multiverse' + label: 'Re-Generate' do: [self multiverse gatherElements; asyncKaboom]; cornerStyle: #squared ] @@ -139,9 +157,9 @@ SBExploriantsView >> visualize [ self buildButtonRow ] -{ #category : #copying } -SBExploriantsView >> wantsHistory [ - - "If returning true, will be automatically collected for an epoche in the history view" - ^ true +{ #category : #accessing } +SBExploriantsView >> wantsReloadOnSaveWhenOpen [ + + "If true, reload contents on a method save" + ^ false ] diff --git a/packages/Sandblocks-Babylonian/SBGrid.class.st b/packages/Sandblocks-Babylonian/SBGrid.class.st index 3d3298c0..9ae5f41e 100644 --- a/packages/Sandblocks-Babylonian/SBGrid.class.st +++ b/packages/Sandblocks-Babylonian/SBGrid.class.st @@ -48,13 +48,6 @@ SBGrid >> initialize [ vResizing: #shrinkWrap. ] -{ #category : #'as yet unclassified' } -SBGrid >> resizeContents: aSBMorphResizer [ - - self submorphsDo: [:aSubmorph | aSBMorphResizer applyOn: aSubmorph]. - self updateWidthToPersistColumns. -] - { #category : #visualisation } SBGrid >> updateWidthToPersistColumns [ diff --git a/packages/Sandblocks-Babylonian/SBHistoryView.class.st b/packages/Sandblocks-Babylonian/SBHistoryView.class.st index 0781adfa..3bc0216b 100644 --- a/packages/Sandblocks-Babylonian/SBHistoryView.class.st +++ b/packages/Sandblocks-Babylonian/SBHistoryView.class.st @@ -19,7 +19,7 @@ SBHistoryView >> buildEpoche [ row := self containerRow. ^ row cellGap: 0@10; - listDirection: #topToBottom; + listDirection: #topToBottom; addAllMorphsBack: {self buildMetaUsageIn: row. self buildSnapshotTabView} @@ -43,16 +43,14 @@ SBHistoryView >> buildSnapshotTabView [ ^ SBTabView namedBlocks: (self tabsToSnapshot collect: [:aTab | SBNamedBlock block: aTab snapshot named: aTab name]) - activeIndex: (SBExploriants uniqueInstance active wantsHistory - ifTrue: [SBExploriants uniqueInstance activeIndex] - ifFalse: [1]) + activeIndex: (SBExploriants uniqueInstance namedBlocks detect: #isOverview) activeIndex ] { #category : #building } SBHistoryView >> buttons [ - ^ super buttons, {self clearButton. self changeTabsButton. self saveButton } + ^ super buttons, {self clearButton. self changeTabsButton. } ] { #category : #building } @@ -127,7 +125,7 @@ SBHistoryView >> saveButton [ { #category : #accessing } SBHistoryView >> tabsToSnapshot [ - ^ SBExploriants uniqueInstance namedBlocks select: #wantsHistory + ^ (SBExploriants uniqueInstance namedBlocks detect: #isOverview) views ] { #category : #actions } @@ -135,9 +133,3 @@ SBHistoryView >> visualize [ self addEpoche ] - -{ #category : #copying } -SBHistoryView >> wantsHistory [ - - ^ false -] diff --git a/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.class.st index e769442b..8199e643 100644 --- a/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.class.st +++ b/packages/Sandblocks-Babylonian/SBInactiveExampleWatch.class.st @@ -4,6 +4,9 @@ Does not update its results anymore. Applying modification expressions is still Class { #name : #SBInactiveExampleWatch, #superclass : #SBExampleWatch, + #instVars : [ + 'originalIdentifier' + ], #category : #'Sandblocks-Babylonian' } @@ -53,6 +56,18 @@ SBInactiveExampleWatch >> listensToExamples [ ^ false ] +{ #category : #accessing } +SBInactiveExampleWatch >> originalIdentifier [ + + ^ originalIdentifier +] + +{ #category : #accessing } +SBInactiveExampleWatch >> originalIdentifier: aNumber [ + + originalIdentifier := aNumber +] + { #category : #'*Sandblocks-Babylonian' } SBInactiveExampleWatch >> saveObjectsActivePermutations [ diff --git a/packages/Sandblocks-Babylonian/SBLiveView.class.st b/packages/Sandblocks-Babylonian/SBLiveView.class.st index 6b77ce8c..111fd12e 100644 --- a/packages/Sandblocks-Babylonian/SBLiveView.class.st +++ b/packages/Sandblocks-Babylonian/SBLiveView.class.st @@ -5,7 +5,8 @@ Class { 'broadcaster', 'errorDecorator', 'errorIcon', - 'reportedError' + 'reportedError', + 'lastSave' ], #category : #'Sandblocks-Babylonian' } @@ -64,7 +65,7 @@ SBLiveView >> buildSetUpRow [ { #category : #building } SBLiveView >> buttons [ - ^ super buttons, {self rebuildButton} + ^ {self rebuildButton. self reloadLastSaveButton} ] { #category : #actions } @@ -98,6 +99,16 @@ SBLiveView >> initialize [ ] +{ #category : #building } +SBLiveView >> jumpToLastSave [ + + lastSave ifNil: [^ self]. + broadcaster containers do: [:otherContainer | + self privateRegisterListener: lastSave veryDeepCopy + for: (SBExploriants objectToPermutation at: (otherContainer valueOfProperty: #sbListener)) + in: otherContainer ] +] + { #category : #accessing } SBLiveView >> listeners [ @@ -172,6 +183,16 @@ SBLiveView >> rebuildRegisteredListenerFor: aPermutation in: aContainer [ ] +{ #category : #building } +SBLiveView >> reloadLastSaveButton [ + + ^ SBButton new + icon: SBIcon iconRotateRight + label: 'Reset To Last Synch' + do: [self jumpToLastSave ]; + cornerStyle: #squared +] + { #category : #actions } SBLiveView >> reportError: anError [ @@ -223,6 +244,7 @@ SBLiveView >> synchronizePreviewsWith: aContainer [ | replacingListener | replacingListener := (aContainer valueOfProperty: #sbListener). + lastSave := replacingListener veryDeepCopy. (broadcaster containers reject: [:someContainer | aContainer == someContainer]) do: [:otherContainer | self privateRegisterListener: replacingListener veryDeepCopy diff --git a/packages/Sandblocks-Babylonian/SBMultiverse.class.st b/packages/Sandblocks-Babylonian/SBMultiverse.class.st index 827df561..8eff50fa 100644 --- a/packages/Sandblocks-Babylonian/SBMultiverse.class.st +++ b/packages/Sandblocks-Babylonian/SBMultiverse.class.st @@ -42,6 +42,12 @@ SBMultiverse class >> new [ self shouldNotImplement ] +{ #category : #cleanup } +SBMultiverse class >> resolveIn: aSandblockEditor [ + + (self bigbangInEditorWithoutKaboom: aSandblockEditor) resolve +] + { #category : #accessing } SBMultiverse >> activeExamples [ diff --git a/packages/Sandblocks-Babylonian/SBPartialPermutationLabel.class.st b/packages/Sandblocks-Babylonian/SBPartialPermutationLabel.class.st new file mode 100644 index 00000000..4320f5dd --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBPartialPermutationLabel.class.st @@ -0,0 +1,57 @@ +Class { + #name : #SBPartialPermutationLabel, + #superclass : #TextMorph, + #instVars : [ + 'permutation', + 'universe' + ], + #category : #'Sandblocks-Babylonian' +} + +{ #category : #'initialize-release' } +SBPartialPermutationLabel class >> newDisplaying: aSBPermutation referingTo: aUniverse [ + + ^ self new + universe: aUniverse; + permutation: aSBPermutation; + updateStyling; + yourself +] + +{ #category : #'*Sandblocks-Babylonian' } +SBPartialPermutationLabel >> listensToPermutations [ + + ^ true +] + +{ #category : #accessing } +SBPartialPermutationLabel >> permutation [ + + ^ permutation +] + +{ #category : #accessing } +SBPartialPermutationLabel >> permutation: aPermutation [ + + permutation := aPermutation +] + +{ #category : #accessing } +SBPartialPermutationLabel >> universe [ + + ^ universe +] + +{ #category : #accessing } +SBPartialPermutationLabel >> universe: aUniverse [ + + universe := aUniverse +] + +{ #category : #initialization } +SBPartialPermutationLabel >> updateStyling [ + + self contents: (self universe activePermutation isActive + ifTrue: [self permutation asStylizedText] + ifFalse: [self permutation asString]) +] diff --git a/packages/Sandblocks-Babylonian/SBPartialPermutationLabel.extension.st b/packages/Sandblocks-Babylonian/SBPartialPermutationLabel.extension.st new file mode 100644 index 00000000..a4e59e1e --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBPartialPermutationLabel.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #SBPartialPermutationLabel } + +{ #category : #'*Sandblocks-Babylonian' } +SBPartialPermutationLabel >> listensToPermutations [ + + ^ true +] diff --git a/packages/Sandblocks-Babylonian/SBPermutationGridsView.class.st b/packages/Sandblocks-Babylonian/SBPermutationGridsView.class.st index 40d22be9..74636836 100644 --- a/packages/Sandblocks-Babylonian/SBPermutationGridsView.class.st +++ b/packages/Sandblocks-Babylonian/SBPermutationGridsView.class.st @@ -37,5 +37,5 @@ SBPermutationGridsView >> initialize [ super initialize. - self name: 'Permutation Focused'. + self name: 'Permutation Grouped' ] diff --git a/packages/Sandblocks-Babylonian/SBPermutationLabel.class.st b/packages/Sandblocks-Babylonian/SBPermutationLabel.class.st index 9738c059..b1a45868 100644 --- a/packages/Sandblocks-Babylonian/SBPermutationLabel.class.st +++ b/packages/Sandblocks-Babylonian/SBPermutationLabel.class.st @@ -7,7 +7,7 @@ Class { #category : #'Sandblocks-Babylonian' } -{ #category : #'as yet unclassified' } +{ #category : #'initialize-release' } SBPermutationLabel class >> newDisplaying: aSBPermutation [ ^ self new @@ -39,5 +39,5 @@ SBPermutationLabel >> permutation: aSBPermutation [ { #category : #accessing } SBPermutationLabel >> updateStyling [ - self contents: self permutation asStylizedText + self contents: self permutation asStylizedText ] diff --git a/packages/Sandblocks-Babylonian/SBPlainResultsView.class.st b/packages/Sandblocks-Babylonian/SBPlainResultsView.class.st index 6360f55f..a530636f 100644 --- a/packages/Sandblocks-Babylonian/SBPlainResultsView.class.st +++ b/packages/Sandblocks-Babylonian/SBPlainResultsView.class.st @@ -27,9 +27,3 @@ SBPlainResultsView >> initialize [ self name: 'Watches' ] - -{ #category : #copying } -SBPlainResultsView >> wantsHistory [ - - ^ false -] diff --git a/packages/Sandblocks-Babylonian/SBResizableResultsView.class.st b/packages/Sandblocks-Babylonian/SBResizableResultsView.class.st new file mode 100644 index 00000000..ab04b549 --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBResizableResultsView.class.st @@ -0,0 +1,55 @@ +Class { + #name : #SBResizableResultsView, + #superclass : #SBGridResultsView, + #instVars : [ + 'dimensionOptions' + ], + #category : #'Sandblocks-Babylonian' +} + +{ #category : #actions } +SBResizableResultsView >> applyResizer [ + + self visualize. + self multiverse sandblockEditor markSaved: SBExploriants uniqueInstance +] + +{ #category : #building } +SBResizableResultsView >> buildDimensionOptions [ + + | options | + options := SBMorphResizer standardOptions. + + ^ SBComboBox new + prefix: 'Preview sizes: '; + labels: (options collect: #label); + values: options; + object: options third; + when: #selectionChanged send: #applyResizer to: self +] + +{ #category : #initialization } +SBResizableResultsView >> initialize [ + + super initialize. + + dimensionOptions := self buildDimensionOptions +] + +{ #category : #accessing } +SBResizableResultsView >> selectedResizer [ + + ^ dimensionOptions object +] + +{ #category : #'as yet unclassified' } +SBResizableResultsView >> visualize [ + + self clean. + + self block addMorph: dimensionOptions. + self buildButtonRow. + + self buildAllPossibleResults . + self concludeContainerWidth. +] diff --git a/packages/Sandblocks-Babylonian/SBStArray.extension.st b/packages/Sandblocks-Babylonian/SBStArray.extension.st new file mode 100644 index 00000000..c537c60c --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBStArray.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #SBStArray } + +{ #category : #'*Sandblocks-Babylonian' } +SBStArray >> suggestedAlternationName [ + + ^ self sourceString +] diff --git a/packages/Sandblocks-Babylonian/SBStMessagePart.extension.st b/packages/Sandblocks-Babylonian/SBStMessagePart.extension.st new file mode 100644 index 00000000..eb8999dc --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBStMessagePart.extension.st @@ -0,0 +1,9 @@ +Extension { #name : #SBStMessagePart } + +{ #category : #'*Sandblocks-Babylonian' } +SBStMessagePart >> suggestedAlternationName [ + + ^ self isAssignment + ifTrue: ['{1} {2}' format: {self receiver. self selector suggestedAlternationName}] + ifFalse: [self contents] +] diff --git a/packages/Sandblocks-Babylonian/SBStMessageSend.extension.st b/packages/Sandblocks-Babylonian/SBStMessageSend.extension.st new file mode 100644 index 00000000..a98bfc2a --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBStMessageSend.extension.st @@ -0,0 +1,17 @@ +Extension { #name : #SBStMessageSend } + +{ #category : #'*Sandblocks-Babylonian' } +SBStMessageSend >> suggestedAlternationName [ + + ^ self isAssignment + ifTrue: ['{2}{1}' format: {self selector. self receiver suggestedAlternationName}] + ifFalse: [ + SBVariant + named: 'format: to ''{1} to {2}''' + associations: { + 'with sender' -> ['{1} to {2}' format: {self selector. self receiver suggestedAlternationName}]. + 'w/o sender' -> ['{1}' format: {self selector}]} + activeIndex: 2 + id: '1949332c-4768-ff4a-98ba-0356e4a3f2fa' + isActive: false] +] diff --git a/packages/Sandblocks-Babylonian/SBSwitchableResultsView.class.st b/packages/Sandblocks-Babylonian/SBSwitchableResultsView.class.st index 44a38b30..f1482132 100644 --- a/packages/Sandblocks-Babylonian/SBSwitchableResultsView.class.st +++ b/packages/Sandblocks-Babylonian/SBSwitchableResultsView.class.st @@ -3,39 +3,17 @@ Offer to switch between trace based and a grid based view " Class { #name : #SBSwitchableResultsView, - #superclass : #SBGridResultsView, + #superclass : #SBResizableResultsView, #instVars : [ - 'isDisplayingTrace', - 'dimensionOptions' + 'isDisplayingTrace' ], #category : #'Sandblocks-Babylonian' } -{ #category : #actions } -SBSwitchableResultsView >> applyResizer [ - - self visualize. - self multiverse sandblockEditor markSaved: SBExploriants uniqueInstance -] - -{ #category : #building } -SBSwitchableResultsView >> buildDimensionOptions [ - - | options | - options := SBMorphResizer standardOptions. - - ^ SBComboBox new - prefix: 'Morph Dimensions: '; - labels: (options collect: #label); - values: options; - object: options third; - when: #selectionChanged send: #applyResizer to: self -] - { #category : #accessing } SBSwitchableResultsView >> buttons [ - ^ super buttons, {self toggleViewButton} + ^ {self toggleViewButton} ] { #category : #accessing } @@ -50,16 +28,9 @@ SBSwitchableResultsView >> initialize [ super initialize. isDisplayingTrace := false. - dimensionOptions := self buildDimensionOptions ] -{ #category : #accessing } -SBSwitchableResultsView >> selectedResizer [ - - ^ dimensionOptions object -] - -{ #category : #'as yet unclassified' } +{ #category : #copying } SBSwitchableResultsView >> snapshot [ ^ ImageMorph new newForm: gridContainer imageForm @@ -92,14 +63,8 @@ SBSwitchableResultsView >> toggleViewButton [ cornerStyle: #squared ] -{ #category : #actions } -SBSwitchableResultsView >> visualize [ - - self clean. +{ #category : #accessing } +SBSwitchableResultsView >> wantsReloadOnSaveWhenOpen [ - self block addMorph: dimensionOptions. - self buildButtonRow. - - self buildAllPossibleResults . - self concludeContainerWidth. + ^ true ] diff --git a/packages/Sandblocks-Babylonian/True.extension.st b/packages/Sandblocks-Babylonian/True.extension.st new file mode 100644 index 00000000..d6dd96b6 --- /dev/null +++ b/packages/Sandblocks-Babylonian/True.extension.st @@ -0,0 +1,12 @@ +Extension { #name : #True } + +{ #category : #'*Sandblocks-Babylonian' } +True >> 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 testGreen asMorph; + yourself +] diff --git a/packages/Sandblocks-Core/SBComboBox.class.st b/packages/Sandblocks-Core/SBComboBox.class.st index b6259557..93a20f76 100644 --- a/packages/Sandblocks-Core/SBComboBox.class.st +++ b/packages/Sandblocks-Core/SBComboBox.class.st @@ -49,6 +49,12 @@ SBComboBox >> display: anObject [ ^ anObject printString ] +{ #category : #'as yet unclassified' } +SBComboBox >> displayPrefixOnly [ + + self contents: '' +] + { #category : #'as yet unclassified' } SBComboBox >> doubleClick: evt [ diff --git a/packages/Sandblocks-Core/SBNamedBlock.class.st b/packages/Sandblocks-Core/SBNamedBlock.class.st index 318d508d..d86ca02d 100644 --- a/packages/Sandblocks-Core/SBNamedBlock.class.st +++ b/packages/Sandblocks-Core/SBNamedBlock.class.st @@ -3,17 +3,33 @@ Class { #superclass : #SBBlock, #instVars : [ 'name', - 'block' + 'block', + 'hasBeenRenamed' ], #category : #'Sandblocks-Core' } +{ #category : #'instance creation' } +SBNamedBlock class >> block: aSBBlock [ + + ^ self new + block: aSBBlock; + name: self noRenameString +] + { #category : #'instance creation' } SBNamedBlock class >> block: aSBBlock named: aString [ ^ self new block: aSBBlock; - name: aString + name: aString; + hasBeenRenamed: aString ~= self noRenameString +] + +{ #category : #'instance creation' } +SBNamedBlock class >> noRenameString [ + + ^ '' ] { #category : #accessing } @@ -28,13 +44,26 @@ SBNamedBlock >> block: aSBBlock [ block := aSBBlock ] +{ #category : #accessing } +SBNamedBlock >> hasBeenRenamed [ + + ^ hasBeenRenamed +] + +{ #category : #accessing } +SBNamedBlock >> hasBeenRenamed: aBoolean [ + + hasBeenRenamed := aBoolean +] + { #category : #initialization } SBNamedBlock >> initialize [ super initialize. - self name: 'A Block'. - self block: (SBLabel new contents: 'Some Content'). + self hasBeenRenamed: false; + name: 'A Block'; + block: (SBLabel new contents: 'Some Content'). ] { #category : #accessing } @@ -48,3 +77,35 @@ SBNamedBlock >> name: aString [ name := aString ] + +{ #category : #accessing } +SBNamedBlock >> nameToDisplay [ + + ^ self hasBeenRenamed + ifTrue: [self name] + ifFalse: [self suggestedName] +] + +{ #category : #initialization } +SBNamedBlock >> suggestedName [ + + | limitedString | + self block statements ifEmpty: [^ 'empty' ]. + limitedString := + String streamContents: [:aStream | + aStream nextPutAll: ((self block statements collect: #suggestedAlternationName) + fold: [:a :b | a, ' ', b])] + limitedTo: 20. + limitedString size < 20 ifTrue: [^ limitedString]. + ^ limitedString , '...' +] + +{ #category : #printing } +SBNamedBlock >> writeSourceOn: aStream [ + + self hasBeenRenamed + ifTrue: [self name storeOn: aStream] + ifFalse: [self class noRenameString storeOn: aStream]. + aStream nextPutAll: ' -> '. + self block writeSourceOn: aStream +] diff --git a/packages/Sandblocks-Core/SBTabView.class.st b/packages/Sandblocks-Core/SBTabView.class.st index 80aae010..4bee0880 100644 --- a/packages/Sandblocks-Core/SBTabView.class.st +++ b/packages/Sandblocks-Core/SBTabView.class.st @@ -155,7 +155,7 @@ SBTabView >> asTabButton: aNamedBlock [ | button | button := SBEditableButton new - label: aNamedBlock name do: [self setActive: aNamedBlock]; + label: aNamedBlock nameToDisplay do: [self setActive: aNamedBlock]; cornerStyle: #squared; makeSmall; hResizing: #spaceFill; @@ -406,6 +406,12 @@ SBTabView >> setActive: aNamedBlock [ ] +{ #category : #accessing } +SBTabView >> suggestedNameLimit [ + + ^ 15 +] + { #category : #commands } SBTabView >> switchCommandFor: aNumber [ @@ -443,6 +449,7 @@ SBTabView >> tabs [ SBTabView >> updateNameFor: aNamedBlock on: aSBButton [ aNamedBlock name: aSBButton label. + aNamedBlock hasBeenRenamed: true. "Changing the extent of a tab should not affect other tabs, e.g. making a tab smaller should not make the left neighbor larger" @@ -460,6 +467,14 @@ SBTabView >> updateSelectedTab [ self tabs do: [:aButton | aButton widgetMorph hResizing: self hResizing] ] +{ #category : #ui } +SBTabView >> updateTabNames [ + + self tabs withIndexDo: [:aTab :i | + aTab basicLabel: (self namedBlocks at: i) nameToDisplay. + aTab hResizing: #shrinkWrap.] +] + { #category : #accessing } SBTabView >> view [ diff --git a/packages/Sandblocks-Core/SBTextBubble.class.st b/packages/Sandblocks-Core/SBTextBubble.class.st index 16a4d86f..23dba5aa 100644 --- a/packages/Sandblocks-Core/SBTextBubble.class.st +++ b/packages/Sandblocks-Core/SBTextBubble.class.st @@ -30,6 +30,12 @@ SBTextBubble >> absorbsInput: anEvent [ ifFalse: [super absorbsInput: anEvent] ] +{ #category : #'as yet unclassified' } +SBTextBubble >> basicContents: aString [ + + text basicContents: aString +] + { #category : #'as yet unclassified' } SBTextBubble >> bordered [ diff --git a/packages/Sandblocks-Core/SBUnknown.class.st b/packages/Sandblocks-Core/SBUnknown.class.st index 0b59ec53..6f576bd3 100644 --- a/packages/Sandblocks-Core/SBUnknown.class.st +++ b/packages/Sandblocks-Core/SBUnknown.class.st @@ -237,6 +237,12 @@ SBUnknown >> startInputAt: aNumber replacingContents: aBoolean [ ^ cmd ] +{ #category : #'as yet unclassified' } +SBUnknown >> suggestedAlternationName [ + + ^ 'empty' +] + { #category : #accessing } SBUnknown >> symbols [ diff --git a/packages/Sandblocks-Morphs/SBButton.class.st b/packages/Sandblocks-Morphs/SBButton.class.st index bdad3f64..fb411f14 100644 --- a/packages/Sandblocks-Morphs/SBButton.class.st +++ b/packages/Sandblocks-Morphs/SBButton.class.st @@ -15,7 +15,7 @@ SBButton class >> newApplyPermutationFor: aPermutation [ ^ self new icon: (SBIcon iconArrowDown - size: 8.0 sbScaled; + size: 10.0 sbScaled; color: (Color r: 0.0 g: 1 b: 0.0)) label: 'Apply' do: [aPermutation apply]; @@ -45,6 +45,13 @@ SBButton >> applyUserInterfaceTheme [ self layoutChanged ] +{ #category : #accessing } +SBButton >> basicLabel: aString [ + + (self submorphs detect: [:m | m isKindOf: self widgetClass] ifNone: [ + ^ self addMorphFront: (self textMorphFor: aString)]) basicContents: aString +] + { #category : #accessing } SBButton >> borderStyle [ @@ -260,6 +267,21 @@ SBButton >> makeSmall [ small] ] +{ #category : #'visual properties' } +SBButton >> makeTiny [ + + | widget | + self + cellGap: 0.0; + layoutInset: 0.0. + + widget := self widgetMorph. + widget ifNotNil: [ + widget + clearEmphasis; + tiny] +] + { #category : #'event handling' } SBButton >> mouseDown [ diff --git a/packages/Sandblocks-Morphs/SBIcon.class.st b/packages/Sandblocks-Morphs/SBIcon.class.st index c7ffb4ef..d5199c6c 100644 --- a/packages/Sandblocks-Morphs/SBIcon.class.st +++ b/packages/Sandblocks-Morphs/SBIcon.class.st @@ -6081,6 +6081,7 @@ SBIcon >> extent: aPoint [ [#large] -> [1.2]. [#veryLarge] -> [2]. [#small] -> [2 / 3]. + [#tiny] -> [1 / 3]. [#regular] -> [1]})) rounded] ] @@ -6177,6 +6178,13 @@ SBIcon >> svgColor: aColor [ self svg changed ] +{ #category : #drawing } +SBIcon >> tiny [ + + size := #tiny. + self extent: 0 @ 0 +] + { #category : #drawing } SBIcon >> veryLarge [ diff --git a/packages/Sandblocks-Morphs/SBOwnTextMorph.class.st b/packages/Sandblocks-Morphs/SBOwnTextMorph.class.st index f946aafd..27bf36d8 100644 --- a/packages/Sandblocks-Morphs/SBOwnTextMorph.class.st +++ b/packages/Sandblocks-Morphs/SBOwnTextMorph.class.st @@ -542,6 +542,12 @@ SBOwnTextMorph >> suffix: aString [ suffix := aString ] +{ #category : #'as yet unclassified' } +SBOwnTextMorph >> tiny [ + + self font: (TextStyle default fontOfSize: 6) +] + { #category : #'as yet unclassified' } SBOwnTextMorph >> userString [ diff --git a/packages/Sandblocks-Morphs/SBStringMorph.class.st b/packages/Sandblocks-Morphs/SBStringMorph.class.st index 253153b2..0affdb96 100644 --- a/packages/Sandblocks-Morphs/SBStringMorph.class.st +++ b/packages/Sandblocks-Morphs/SBStringMorph.class.st @@ -16,6 +16,12 @@ SBStringMorph >> applyUserInterfaceTheme [ self extent: self minExtent ] +{ #category : #accessing } +SBStringMorph >> basicContents: newContents [ + + contents := newContents. +] + { #category : #accessing } SBStringMorph >> bold [ @@ -107,7 +113,13 @@ SBStringMorph >> reportValue: anObject [ { #category : #'as yet unclassified' } SBStringMorph >> small [ - self font: (TextStyle default fontOfSize: 10 sbScaled) + self font: (TextStyle default fontOfSize: 10) +] + +{ #category : #'as yet unclassified' } +SBStringMorph >> tiny [ + + self font: (TextStyle default fontOfSize: 6) ] { #category : #accessing } diff --git a/packages/Sandblocks-Smalltalk/SBLabel.extension.st b/packages/Sandblocks-Smalltalk/SBLabel.extension.st index e7cb18e4..315fb2a9 100644 --- a/packages/Sandblocks-Smalltalk/SBLabel.extension.st +++ b/packages/Sandblocks-Smalltalk/SBLabel.extension.st @@ -18,12 +18,6 @@ SBLabel >> asToggledCode: converter [ do: {SBStBlockBody new statements: {self contents parseAsSandblock asSandblock}}] ] -{ #category : #'*Sandblocks-Smalltalk' } -SBLabel >> isSmalltalk [ - - ^ true -] - { #category : #'*Sandblocks-Smalltalk' } SBLabel >> updatePCFrom: anObject [ ] diff --git a/packages/Sandblocks-Smalltalk/SBStGrammarHandler.class.st b/packages/Sandblocks-Smalltalk/SBStGrammarHandler.class.st index 25cf51f4..48655465 100644 --- a/packages/Sandblocks-Smalltalk/SBStGrammarHandler.class.st +++ b/packages/Sandblocks-Smalltalk/SBStGrammarHandler.class.st @@ -40,6 +40,42 @@ SBStGrammarHandler >> browseSenders [ self block sandblockEditor open: calls first compiledMethod] ] +{ #category : #'action helpers' } +SBStGrammarHandler >> buildEachCommandForSelected: aBlock callingAlternativesBuilder: aSelector [ + + | parent variant before | + parent := aBlock parentSandblock. + before := aBlock submorphBefore. + variant := SBVariant new. + ^ SBWrapCommand new + outer: variant; + inner: aBlock; + wrap: [:outer :inner | + variant + named: (self variantNameFor: {inner} in: parent preceedingBlock: before) + alternatives: (self perform: aSelector with: {inner}) + activeIndex: 2]; + yourself +] + +{ #category : #'action helpers' } +SBStGrammarHandler >> buildMultiselectCommandOnVariant: aVariant selected: aCollectionOfBlocks callingAlternativesBuilder: aSelector [ + + | parent before | + parent := aCollectionOfBlocks first parentSandblock. + before := aCollectionOfBlocks first submorphBefore. + ^ SBWrapConsecutiveCommand new + selectAfter: #block; + outer: aVariant; + targets: aCollectionOfBlocks; + wrap: [:outer :inner | + aVariant + named: (self variantNameFor: inner in: parent preceedingBlock: before) + alternatives: (self perform: aSelector with: inner) + activeIndex: 2]; + yourself +] + { #category : #'callback helpers' } SBStGrammarHandler >> changeToBlockView: aWindow [ @@ -87,8 +123,8 @@ SBStGrammarHandler >> debugExpression [ SBStGrammarHandler >> defaultAlternativesForBlocks: aCollectionOfBlocks [ ^ { - SBNamedBlock block: (SBStBlockBody new statements: aCollectionOfBlocks) named: 'original'. - SBNamedBlock block: (SBStBlockBody new statements: aCollectionOfBlocks veryDeepCopy) named: 'alternative'. } + SBNamedBlock block: (SBStBlockBody new statements: aCollectionOfBlocks). + SBNamedBlock block: (SBStBlockBody new statements: aCollectionOfBlocks veryDeepCopy). } ] { #category : #'action helpers' } @@ -426,6 +462,36 @@ SBStGrammarHandler >> useThirdArgument [ self useArgument: 3 ] +{ #category : #'action helpers' } +SBStGrammarHandler >> variantNameFor: aCollectionOfBlocks in: aParentBlock [ + + aParentBlock sandblockEditor = aParentBlock ifTrue: [^ aCollectionOfBlocks printString]. + + aParentBlock isTopLevel ifTrue: [^ aParentBlock printString]. + + aParentBlock isMessageSend ifTrue: [^ aCollectionOfBlocks first submorphBefore printString]. + (aParentBlock isAssignment and: [aParentBlock receiver isVariant not]) ifTrue: [^ aParentBlock receiver sourceString, ' := ']. + + aCollectionOfBlocks size = 1 ifTrue: [^ aCollectionOfBlocks first sourceString]. + + ^ '{1}' format: {(aCollectionOfBlocks collect: [:aBlock | aBlock sourceString]) + fold: [:a :b | a, ', ', Character cr, b ]} +] + +{ #category : #'action helpers' } +SBStGrammarHandler >> variantNameFor: aCollectionOfBlocks in: aParentBlock preceedingBlock: aNeighbor [ + + aParentBlock isMessageSend + ifTrue: [^ aNeighbor ifNil: [aParentBlock suggestedAlternationName] ifNotNil: [aNeighbor suggestedAlternationName]]. + + (aParentBlock isAssignment and: [aParentBlock receiver isVariant not]) ifTrue: [^ aParentBlock suggestedAlternationName]. + + aCollectionOfBlocks size = 1 ifTrue: [^ aCollectionOfBlocks first suggestedAlternationName]. + + ^ '{1}' format: {(aCollectionOfBlocks collect: [:aBlock | aBlock suggestedAlternationName]) + fold: [:a :b | a, ', ', Character cr, b ]} +] + { #category : #actions } SBStGrammarHandler >> wrapAsArgument [ @@ -449,17 +515,10 @@ SBStGrammarHandler >> wrapEachInOptionalVariant [ self assert: self block isSelected. - self block sandblockEditor doMultiSelectionEach: [:selected | | variant | - variant := SBVariant new. - SBWrapCommand new - outer: variant; - inner: selected; - wrap: [:outer :inner | - variant - named: inner printString - alternatives: (self defaultOptionalAlternativesForBlocks: {inner}) - activeIndex: 2]; - yourself] + self block sandblockEditor doMultiSelectionEach: [:selected | + self + buildEachCommandForSelected: selected + callingAlternativesBuilder: #defaultOptionalAlternativesForBlocks:] ] { #category : #actions } @@ -468,17 +527,10 @@ SBStGrammarHandler >> wrapEachInVariant [ self assert: self block isSelected. - self block sandblockEditor doMultiSelectionEach: [:selected | | variant | - variant := SBVariant new. - SBWrapCommand new - outer: variant; - inner: selected; - wrap: [:outer :inner | - variant - named: inner printString - alternatives: (self defaultAlternativesForBlocks: {inner}) - activeIndex: 2]; - yourself] + self block sandblockEditor doMultiSelectionEach: [:selected | + self + buildEachCommandForSelected: selected + callingAlternativesBuilder: #defaultAlternativesForBlocks:] ] { #category : #'action helpers' } @@ -603,16 +655,10 @@ SBStGrammarHandler >> wrapInOptionalVariant [ variant := SBVariant new. self block sandblockEditor multiSelectionIsConsecutive ifFalse: [^ self]. self block sandblockEditor doMultiSelection: [:selected | - SBWrapConsecutiveCommand new - selectAfter: #block; - outer: variant; - targets: selected; - wrap: [:outer :inner | - variant - named: inner printString - alternatives: (self defaultOptionalAlternativesForBlocks: inner) - activeIndex: 2]; - yourself]. + self + buildMultiselectCommandOnVariant: variant + selected: selected + callingAlternativesBuilder: #defaultOptionalAlternativesForBlocks:]. variant sandblockEditor select: variant nameBlock. variant sandblockEditor save: variant containingArtefact tryFixing: true quick: false. @@ -660,16 +706,10 @@ SBStGrammarHandler >> wrapInVariant [ variant := SBVariant new. self block sandblockEditor multiSelectionIsConsecutive ifFalse: [^ self]. self block sandblockEditor doMultiSelection: [:selected | - SBWrapConsecutiveCommand new - selectAfter: #block; - outer: variant; - targets: selected; - wrap: [:outer :inner | - variant - named: inner printString - alternatives: (self defaultAlternativesForBlocks: inner) - activeIndex: 2]; - yourself]. + self + buildMultiselectCommandOnVariant: variant + selected: selected + callingAlternativesBuilder: #defaultAlternativesForBlocks:]. variant sandblockEditor select: variant nameBlock. variant sandblockEditor save: variant containingArtefact tryFixing: true quick: false. diff --git a/packages/Sandblocks-Smalltalk/SBStLiteral.class.st b/packages/Sandblocks-Smalltalk/SBStLiteral.class.st index 6a9c93d5..b1850388 100644 --- a/packages/Sandblocks-Smalltalk/SBStLiteral.class.st +++ b/packages/Sandblocks-Smalltalk/SBStLiteral.class.st @@ -137,6 +137,12 @@ SBStLiteral >> startInputCommand [ yourself ] +{ #category : #'as yet unclassified' } +SBStLiteral >> suggestedAlternationName [ + + ^ self sourceString +] + { #category : #'as yet unclassified' } SBStLiteral >> textMorphClass [ diff --git a/packages/Sandblocks-Smalltalk/SBVariant.class.st b/packages/Sandblocks-Smalltalk/SBVariant.class.st index db5c1df5..cf98b2cf 100644 --- a/packages/Sandblocks-Smalltalk/SBVariant.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariant.class.st @@ -81,21 +81,21 @@ SBVariant class >> named: aString associations: aCollectionOfAssociations active | defaultBehavior requestor requiredPermutation | aNumber <= 0 ifTrue: [^ nil]. - defaultBehavior := (aCollectionOfAssociations at: aNumber) value value. + defaultBehavior := (aCollectionOfAssociations at: aNumber) value. "Inactive variants ignore any active or dynamic permutation shenanigans" - aBoolean ifFalse: [^ defaultBehavior]. + aBoolean ifFalse: [^ defaultBehavior value]. "Always prioritize the permutation which is marked as active" - SBActiveVariantPermutation value ifNotNil: [^ (aCollectionOfAssociations at: (SBActiveVariantPermutation value at: uuid)) value value]. + SBActiveVariantPermutation value ifNotNil: [^ (aCollectionOfAssociations at: (SBActiveVariantPermutation value at: uuid) ifAbsent: [^ defaultBehavior value]) value value]. "The requesting object does not require dynamic update behavior in which it needs to know a certain alternative" - SBExploriants objectToPermutation at: (requestor := thisContext sender receiver) ifAbsent: [^ defaultBehavior]. + SBExploriants objectToPermutation at: (requestor := thisContext sender receiver) ifAbsent: [^ defaultBehavior value]. "The permutation is outdated and does not know this variant" - (requiredPermutation := SBExploriants objectToPermutation at: requestor) at: uuid ifAbsent: [^ defaultBehavior]. + (requiredPermutation := SBExploriants objectToPermutation at: requestor) at: uuid ifAbsent: [^ defaultBehavior value]. "An outdated permutation in which an alternative with a higher index than current has been deleted" - aCollectionOfAssociations at: (requiredPermutation at: uuid) ifAbsent: [^ defaultBehavior]. + aCollectionOfAssociations at: (requiredPermutation at: uuid) ifAbsent: [^ defaultBehavior value]. - ^ (aCollectionOfAssociations at: (requiredPermutation at: uuid)) value value + ^ (aCollectionOfAssociations at: (requiredPermutation at: uuid) ifAbsent: [^defaultBehavior value]) value value ] { #category : #'instance creation' } @@ -146,7 +146,7 @@ SBVariant >> activeIndex [ ^ self widget activeIndex ] -{ #category : #actions } +{ #category : #accessing } SBVariant >> activeMutateCommandWithNewValue: aBoolean [ ^ SBMutatePropertyCommand new @@ -157,6 +157,38 @@ SBVariant >> activeMutateCommandWithNewValue: aBoolean [ oldValue: self isActive ] +{ #category : #converting } +SBVariant >> allPermutations [ + + | allPermutations | + allPermutations := OrderedCollection new. + self allPermutations: allPermutations currentPath: (SBPermutation new referencedVariants: OrderedCollection new). + ^ allPermutations +] + +{ #category : #converting } +SBVariant >> allPermutations: allPermutations currentPath: aPermutation [ + + "Private helper function" + self flag: #todo. "A bit of a mess. - jb" + ^ self namedBlocks withIndexCollect: [:aNamedBlock :i | + | topLevelVariants currentPath | + topLevelVariants := aNamedBlock block topLevelVariants select: #isActive. + currentPath := aPermutation copyWith: (self id -> i). + currentPath referencedVariants: (aPermutation referencedVariants copyWith: self). + topLevelVariants + ifEmpty: [allPermutations add: currentPath] + ifNotEmpty: [:childVariants | | permutations nestedPermutations | + nestedPermutations := childVariants collect: [:child | child allPermutations: OrderedCollection new currentPath: currentPath]. + permutations := nestedPermutations first. + (2 to: topLevelVariants size) do: [:index | | nestedPermutation | + nestedPermutation := nestedPermutations at: index. + permutations := permutations gather: [:aNestedPermutation | + nestedPermutation collect: [:aNestedNestedPermutation | SBPermutation newCombinedOf: aNestedPermutation and: aNestedNestedPermutation]]]. + allPermutations addAll: permutations. + permutations ]] +] + { #category : #accessing } SBVariant >> alternatives [ @@ -182,29 +214,6 @@ SBVariant >> alternativesEqual: otherAlternatives [ areSame] ] -{ #category : #converting } -SBVariant >> asNestedPaths [ - - | allPaths | - allPaths := OrderedCollection new. - self asNestedPaths: allPaths currentPath: (SBPermutation new referencedVariants: OrderedCollection new). - ^ allPaths -] - -{ #category : #converting } -SBVariant >> asNestedPaths: allPaths currentPath: aPermutation [ - - "Private helper function" - self namedBlocks withIndexCollect: [:aNamedBlock :i | | nestedVariants currentPath | - nestedVariants := aNamedBlock block childSandblocks select: #isVariant. - currentPath := aPermutation copyWith: (self id -> i). - currentPath referencedVariants: (aPermutation referencedVariants copyWith: self). - nestedVariants - ifEmpty: [allPaths add: currentPath] - ifNotEmpty: [:children | children do: [:child | - child asNestedPaths: allPaths currentPath: currentPath]]] -] - { #category : #converting } SBVariant >> asProxy [ @@ -215,12 +224,13 @@ SBVariant >> asProxy [ SBVariant >> beActive [ - | command | - command := self activeMutateCommandWithNewValue: true. + | commands | + commands := OrderedCollection new. + self nestedActiveCommands: commands. self sandblockEditor - ifNil: [command do] - ifNotNil:[:theEditor | theEditor do: command]. + ifNil: [commands do: #do] + ifNotNil:[:theEditor | commands do: [:aCommand | theEditor do: aCommand]]. self containingArtefact sandblockEditor save: self containingArtefact tryFixing: true quick: false. ] @@ -229,12 +239,13 @@ SBVariant >> beActive [ SBVariant >> beInactive [ - | command | - command := self activeMutateCommandWithNewValue: false. + | commands | + commands := OrderedCollection new. + self nestedInactiveCommands: commands. self sandblockEditor - ifNil: [command do] - ifNotNil:[:theEditor | theEditor do: command]. + ifNil: [commands do: #do] + ifNotNil:[:theEditor | commands do: [:aCommand | theEditor do: aCommand]]. self containingArtefact sandblockEditor save: self containingArtefact tryFixing: true quick: false. ] @@ -364,6 +375,24 @@ SBVariant >> namedBlocks [ ^ self widget namedBlocks ] +{ #category : #callbacks } +SBVariant >> nestedActiveCommands: allCommands [ + + allCommands add: (self activeMutateCommandWithNewValue: true). + self namedBlocks do: [:aNamedBlock | + aNamedBlock block topLevelVariants do: [:aVariant | + aVariant nestedActiveCommands: allCommands]] +] + +{ #category : #callbacks } +SBVariant >> nestedInactiveCommands: allCommands [ + + allCommands add: (self activeMutateCommandWithNewValue: false). + self namedBlocks do: [:aNamedBlock | + aNamedBlock block topLevelVariants do: [:aVariant | + aVariant nestedInactiveCommands: allCommands]] +] + { #category : #actions } SBVariant >> replaceSelfWithBlock: aNamedBlock [ @@ -419,6 +448,13 @@ SBVariant >> replaceValuesFrom: anotherVariant [ self named: anotherVariant name alternatives: anotherVariant alternatives activeIndex: anotherVariant activeIndex ] +{ #category : #actions } +SBVariant >> resolveAllLiveElements [ + + + SBMultiverse resolveIn: self sandblockEditor +] + { #category : #accessing } SBVariant >> statementsFor: aNamedBlock [ @@ -473,10 +509,7 @@ SBVariant >> writeSourceOn: aStream [ self name storeOn: aStream. aStream nextPutAll: ' associations: {'. self alternatives - do: [:aNamedBlock | - aNamedBlock name storeOn: aStream. - aStream nextPutAll: ' -> '. - aNamedBlock block writeSourceOn: aStream] + do: [:aNamedBlock | aNamedBlock writeSourceOn: aStream] separatedBy: [aStream nextPut: $.]. aStream nextPutAll: '} activeIndex: '. self activeIndex storeOn: aStream. diff --git a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st index 6c12054e..7caf7153 100644 --- a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st @@ -17,7 +17,8 @@ SBVariantProxy class >> for: aVariant [ { #category : #callbacks } SBVariantProxy >> artefactChanged: anArtefact [ - anArtefact = self ifTrue: [ self updateOriginalWithOwnValues ]. + + anArtefact = self ifTrue: [self updateOriginalWithOwnValues ]. (anArtefact = self containedMethod) ifTrue: [ self updateSelfAfterMethodUpdate: anArtefact ] @@ -101,10 +102,16 @@ SBVariantProxy >> updateOriginalWithOwnValues [ variantThatNeedsChanging ifNil: [^self delete]. original replaceBy: (original := self firstSubmorph copyBlock). - original isVariant ifFalse: [^ self delete]. + original isVariant + ifFalse: [ + self containedMethod save. + ^ self delete]. variantThatNeedsChanging replaceValuesFrom: original copyBlock. - self sandblockEditor markChanged: self containedMethod + self containedMethod isInEditor + ifTrue: [self sandblockEditor markChanged: self containedMethod] + ifFalse: [self containedMethod save]. + ] { #category : #callbacks } diff --git a/packages/Sandblocks-Utils/SBNilPermutation.class.st b/packages/Sandblocks-Utils/SBNilPermutation.class.st index cae6fe46..fa33ef43 100644 --- a/packages/Sandblocks-Utils/SBNilPermutation.class.st +++ b/packages/Sandblocks-Utils/SBNilPermutation.class.st @@ -14,5 +14,23 @@ SBNilPermutation >> apply [ { #category : #converting } SBNilPermutation >> asString [ - ^ 'Current setting without any variants' + ^ 'No Variation' +] + +{ #category : #converting } +SBNilPermutation >> asVariantString [ + + ^ 'No Variation' +] + +{ #category : #accessing } +SBNilPermutation >> isActive [ + + ^ false +] + +{ #category : #accessing } +SBNilPermutation >> isNilPermutation [ + + ^ true ] diff --git a/packages/Sandblocks-Utils/SBPermutation.class.st b/packages/Sandblocks-Utils/SBPermutation.class.st index 9ab5af5f..64cb68df 100644 --- a/packages/Sandblocks-Utils/SBPermutation.class.st +++ b/packages/Sandblocks-Utils/SBPermutation.class.st @@ -17,7 +17,7 @@ SBPermutation class >> allPermutationsOf: aCollectionOfVariants [ | permutations topLevelVariants nestedPermutations | aCollectionOfVariants ifEmpty:[^{SBNilPermutation new referencedVariants: {}}]. topLevelVariants := aCollectionOfVariants select: [:aVariant | aVariant parentVariant isNil]. - nestedPermutations := topLevelVariants collect: #asNestedPaths. + nestedPermutations := topLevelVariants collect: #allPermutations. permutations := nestedPermutations first. (2 to: topLevelVariants size) do: [:i | | nestedPermutation | @@ -33,7 +33,9 @@ SBPermutation class >> allPermutationsOf: aCollectionOfVariants [ SBPermutation class >> newCombinedOf: onePermutation and: anotherPermutation [ | result | - result := self new referencedVariants: (onePermutation referencedVariants, anotherPermutation referencedVariants). + result := self new referencedVariants: + ((onePermutation referencedVariants, anotherPermutation referencedVariants) asSet + sorted: [:a :b | a name <= b name]). result addAll: onePermutation. result addAll: anotherPermutation. ^ result @@ -63,8 +65,8 @@ SBPermutation >> asString [ "collecting instead of calling (a active name), ', ', (b active name) in fold as one variant only will not return a string but a variant" ^ (self referencedVariants collect: [:aVariant | - aVariant name, ': ', (aVariant blockAt: (self at: aVariant id)) name]) - fold: [:a :b | a, ', ', b ] + aVariant name, ': ', (aVariant blockAt: (self at: aVariant id)) nameToDisplay ]) + fold: [:a :b | a, ', ', Character cr, b ] ] @@ -81,12 +83,75 @@ SBPermutation >> asStylizedText [ ] +{ #category : #converting } +SBPermutation >> asVariantString [ + + ^ (self referencedVariants collect: [:aVariant | aVariant name]) fold: [:a :b | a, ', ', Character cr, b ] + + +] + +{ #category : #accessing } +SBPermutation >> contains: anotherPermutation [ + + anotherPermutation associationsDo: [:idToNum | + (self includesKey: idToNum key) ifFalse: [^false]. + (self at: idToNum key) ~= idToNum value ifTrue: [^false]]. + + ^ true +] + +{ #category : #'initialize-release' } +SBPermutation >> copyRemovingPermutation: aPermutation [ + + | copy | + copy := self veryDeepCopy. + copy referencedVariants: (copy referencedVariants reject: [:aVariant | + aPermutation includesKey: aVariant id]). + + aPermutation associationsDo: [:idToNum | + copy at: idToNum key ifPresent: [:theValue | theValue = idToNum value + ifTrue: [copy removeKey: idToNum key]]]. + ^ copy + +] + +{ #category : #'initialize-release' } +SBPermutation >> copyRemovingVariants: aCollectionOfVariants [ + + | copy | + copy := self class new. + copy referencedVariants: (self referencedVariants reject: [:aVariant | aCollectionOfVariants includes: aVariant]). + copy referencedVariants ifEmpty: [^ SBNilPermutation new referencedVariants: {}]. + "copy := self veryDeepCopy. + copy referencedVariants: (copy referencedVariants difference: aCollectionOfVariants)." + + self associationsDo: [:anAssc | copy add: anAssc]. + aCollectionOfVariants do: [:aVariant | copy removeKey: aVariant id ifAbsent: []]. + ^ copy + +] + +{ #category : #'initialize-release' } +SBPermutation >> initialize [ + + super initialize. + + self referencedVariants: OrderedCollection new. +] + { #category : #accessing } SBPermutation >> isActive [ ^ self activeScore = self referencedVariants size ] +{ #category : #accessing } +SBPermutation >> isNilPermutation [ + + ^ false +] + { #category : #accessing } SBPermutation >> referencedVariants [ diff --git a/packages/Sandblocks-Watch/SBLineChart.class.st b/packages/Sandblocks-Watch/SBLineChart.class.st index cb68eb91..e341c9ec 100644 --- a/packages/Sandblocks-Watch/SBLineChart.class.st +++ b/packages/Sandblocks-Watch/SBLineChart.class.st @@ -35,7 +35,7 @@ SBLineChart >> datapointDefaultColor [ { #category : #'visualization - constants' } SBLineChart >> datapointExtent [ - ^ 4@4 + ^ 2@2 ] { #category : #geometry } @@ -82,7 +82,7 @@ SBLineChart >> newDatapointFor: aValue at: positionIndex [ "There is an extra Morph containing the datapoint itself so the tooltip is far easier to activate through more area" ^ Morph new height: self targetHeight; - left: ((positionIndex - 0.5) * self spaceBetweenPoints) rounded; + left: ((positionIndex - 0.5) * self spaceBetweenPoints ) rounded; width: self spaceBetweenPoints; color: Color transparent; balloonText: aValue printString; @@ -166,7 +166,7 @@ SBLineChart >> positiveGradientColor [ { #category : #'visualization - constants' } SBLineChart >> spaceBetweenPoints [ - ^ 10 + ^ 6 ] { #category : #visualization } diff --git a/packages/Sandblocks-Watch/SBMorphResizer.class.st b/packages/Sandblocks-Watch/SBMorphResizer.class.st index 9f071191..d68bcd71 100644 --- a/packages/Sandblocks-Watch/SBMorphResizer.class.st +++ b/packages/Sandblocks-Watch/SBMorphResizer.class.st @@ -14,13 +14,13 @@ Class { { #category : #'initialize-release' } SBMorphResizer class >> newBig [ - ^ self newLabeled: 'big' transforming: [:aMorph | aMorph extent: 350@350] + ^ self newLabeled: 'big' transforming: [:anObject | anObject applyResize: 350@350] ] { #category : #'initialize-release' } SBMorphResizer class >> newIdentity [ - ^ self newLabeled: 'original' transforming: [:aMorph | "Do nothing"] + ^ self newLabeled: 'original' transforming: [:anObject | "Do nothing" anObject] ] { #category : #'initialize-release' } @@ -35,25 +35,25 @@ SBMorphResizer class >> newLabeled: aName transforming: aBlockTakingASingleParam { #category : #'initialize-release' } SBMorphResizer class >> newMedium [ - ^ self newLabeled: 'medium' transforming: [:aMorph | aMorph extent: 150@150] + ^ self newLabeled: 'medium' transforming: [:anObject | anObject applyResize: 150@150] ] { #category : #'initialize-release' } SBMorphResizer class >> newSmall [ - ^ self newLabeled: 'small' transforming: [:aMorph | aMorph extent: 100@100] + ^ self newLabeled: 'small' transforming: [:anObject | anObject applyResize: 100@100] ] { #category : #'initialize-release' } SBMorphResizer class >> newThumbmail [ - ^ self newLabeled: 'thumbmail' transforming: [:aMorph | aMorph extent: 40@40] + ^ self newLabeled: 'thumbmail' transforming: [:anObject | anObject applyResize: 40@40] ] { #category : #'initialize-release' } SBMorphResizer class >> newTiny [ - ^ self newLabeled: 'tiny' transforming: [:aMorph | aMorph extent: 15@15] + ^ self newLabeled: 'tiny' transforming: [:anObject | anObject applyResize: 15@15] ] { #category : #'initialize-release' } @@ -70,8 +70,8 @@ SBMorphResizer class >> standardOptions [ { #category : #actions } SBMorphResizer >> applyOn: aMorph [ - self transformFunction value: aMorph. - ^ aMorph + ^ self transformFunction value: aMorph. + ] { #category : #'initialize-release' } diff --git a/packages/Sandblocks-Watch/SBWatchView.class.st b/packages/Sandblocks-Watch/SBWatchView.class.st index f4ad57f0..da79ce91 100644 --- a/packages/Sandblocks-Watch/SBWatchView.class.st +++ b/packages/Sandblocks-Watch/SBWatchView.class.st @@ -320,9 +320,9 @@ SBWatchView >> resizeThrough: aMorphResizer [ "Clearing everything here as Morphs get distorted when resized multiple times." | valuesMorph | valuesMorph := self watchValuesContainer. - valuesMorph addAllMorphsBack: (self displayedMorphs - collect: #sbSnapshot - thenDo: [:aMorph | aMorphResizer applyOn: aMorph]). + valuesMorph addAllMorphsBack: (watchValues + collect: #asValueMorph + thenDo: [:aMorph | (aMorphResizer applyOn: aMorph)]). self displayOnScrollPane: valuesMorph. self fallbackResizer: aMorphResizer.