From 4be7836d1e9460665b3a3e095b22a3006d346f60 Mon Sep 17 00:00:00 2001
From: Joana Bergsiek <joana.bergsiek@student.hpi.de>
Date: Wed, 10 Jan 2024 15:48:20 +0100
Subject: [PATCH] Adds basic objects which are used as default args when adding
 examples

---
 .../Collection.extension.st                   | 21 +++++++
 .../Sandblocks-Babylonian/Color.extension.st  | 12 ++++
 .../Sandblocks-Babylonian/Float.extension.st  |  7 +++
 .../Sandblocks-Babylonian/Form.extension.st   | 12 ++++
 .../Fraction.extension.st                     |  7 +++
 .../Interval.extension.st                     | 27 ++++++++
 .../Sandblocks-Babylonian/Morph.extension.st  |  6 ++
 .../Sandblocks-Babylonian/Number.extension.st | 12 ++++
 .../Sandblocks-Babylonian/Object.extension.st | 27 ++++++++
 .../Sandblocks-Babylonian/Point.extension.st  | 12 ++++
 .../Sandblocks-Babylonian/SBExample.class.st  |  6 ++
 .../SBStGrammarHandler.extension.st           | 62 ++++++++++++++++---
 .../Sandblocks-Babylonian/String.extension.st | 26 ++++++++
 .../Sandblocks-Babylonian/Text.extension.st   | 26 ++++++++
 .../UndefinedObject.extension.st              | 13 ++++
 packages/Sandblocks-Core/Color.extension.st   |  6 ++
 .../Sandblocks-Core/Fraction.extension.st     |  7 +++
 packages/Sandblocks-Core/Number.extension.st  |  6 ++
 packages/Sandblocks-Core/Point.extension.st   | 12 ++++
 packages/Sandblocks-Core/String.extension.st  |  6 ++
 .../UndefinedObject.extension.st              |  7 +++
 21 files changed, 312 insertions(+), 8 deletions(-)
 create mode 100644 packages/Sandblocks-Babylonian/Float.extension.st
 create mode 100644 packages/Sandblocks-Babylonian/Fraction.extension.st
 create mode 100644 packages/Sandblocks-Babylonian/Interval.extension.st
 create mode 100644 packages/Sandblocks-Babylonian/UndefinedObject.extension.st
 create mode 100644 packages/Sandblocks-Core/Fraction.extension.st
 create mode 100644 packages/Sandblocks-Core/UndefinedObject.extension.st

diff --git a/packages/Sandblocks-Babylonian/Collection.extension.st b/packages/Sandblocks-Babylonian/Collection.extension.st
index 5a5461c0..be2c32a1 100644
--- a/packages/Sandblocks-Babylonian/Collection.extension.st
+++ b/packages/Sandblocks-Babylonian/Collection.extension.st
@@ -1,5 +1,26 @@
 Extension { #name : #Collection }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Collection class >> exampleBlockContainingClass: aClass [
+
+	| class |
+	self flag: #todo. 
+	"Lazy way to avoid adding overrides with concrete classes in the huge amount of subclasses"
+	class := (self = Collection) ifTrue: [OrderedCollection] ifFalse: self. 
+	^ SBStMessageSend new
+		receiver: (SBStName contents: class name)
+		selector: #withAll:
+		arguments: {SBStArray withContents: (class withAll: ((1 to: 5) collect: [:i | aClass exampleBlock]))}
+	
+	
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Collection class >> exampleObjectContainingClass: aClass [
+
+	^ self withAll: ((1 to: 5) collect: [:i | aClass exampleObject])
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Collection >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
diff --git a/packages/Sandblocks-Babylonian/Color.extension.st b/packages/Sandblocks-Babylonian/Color.extension.st
index 984ea467..2b1e4eb7 100644
--- a/packages/Sandblocks-Babylonian/Color.extension.st
+++ b/packages/Sandblocks-Babylonian/Color.extension.st
@@ -1,5 +1,17 @@
 Extension { #name : #Color }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Color class >> exampleBlock [
+
+	^ self exampleObject asSandblock 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Color class >> exampleObject [
+
+	^ self random
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Color >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 		
diff --git a/packages/Sandblocks-Babylonian/Float.extension.st b/packages/Sandblocks-Babylonian/Float.extension.st
new file mode 100644
index 00000000..967b7a39
--- /dev/null
+++ b/packages/Sandblocks-Babylonian/Float.extension.st
@@ -0,0 +1,7 @@
+Extension { #name : #Float }
+
+{ #category : #'*Sandblocks-Babylonian' }
+Float class >> exampleObject [
+
+	^ Random new next
+]
diff --git a/packages/Sandblocks-Babylonian/Form.extension.st b/packages/Sandblocks-Babylonian/Form.extension.st
index 097d1265..f7dcf441 100644
--- a/packages/Sandblocks-Babylonian/Form.extension.st
+++ b/packages/Sandblocks-Babylonian/Form.extension.st
@@ -1,5 +1,17 @@
 Extension { #name : #Form }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Form class >> exampleBlock [
+
+	^ 'Form squeakLogo' parseAsSandblock
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Form class >> exampleObject [
+
+	^ self squeakLogo
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Form >> sbSnapshot [
 
diff --git a/packages/Sandblocks-Babylonian/Fraction.extension.st b/packages/Sandblocks-Babylonian/Fraction.extension.st
new file mode 100644
index 00000000..651f8c9e
--- /dev/null
+++ b/packages/Sandblocks-Babylonian/Fraction.extension.st
@@ -0,0 +1,7 @@
+Extension { #name : #Fraction }
+
+{ #category : #'*Sandblocks-Babylonian' }
+Fraction class >> exampleObject [
+
+	^ (Integer exampleObject  / Integer exampleObject )
+]
diff --git a/packages/Sandblocks-Babylonian/Interval.extension.st b/packages/Sandblocks-Babylonian/Interval.extension.st
new file mode 100644
index 00000000..808852c7
--- /dev/null
+++ b/packages/Sandblocks-Babylonian/Interval.extension.st
@@ -0,0 +1,27 @@
+Extension { #name : #Interval }
+
+{ #category : #'*Sandblocks-Babylonian' }
+Interval class >> exampleBlock [
+
+	^ '1 to: 10' parseAsSandblock
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Interval class >> exampleBlockContainingClass: aClass [
+
+	^ self exampleBlock 
+	
+	
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Interval class >> exampleObject [
+
+	^ 1 to: 10
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Interval class >> exampleObjectContainingClass: aClass [
+
+	^ self exampleObject
+]
diff --git a/packages/Sandblocks-Babylonian/Morph.extension.st b/packages/Sandblocks-Babylonian/Morph.extension.st
index f5f02ecb..b1ab1699 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 class >> exampleObject [
+
+	^ self new
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Morph >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
diff --git a/packages/Sandblocks-Babylonian/Number.extension.st b/packages/Sandblocks-Babylonian/Number.extension.st
index dd5d5eee..0d834790 100644
--- a/packages/Sandblocks-Babylonian/Number.extension.st
+++ b/packages/Sandblocks-Babylonian/Number.extension.st
@@ -1,5 +1,17 @@
 Extension { #name : #Number }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Number class >> exampleBlock [
+
+	^ self exampleObject asSandblock 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Number class >> exampleObject [
+
+	^ Random new nextInt: 100
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Number >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
diff --git a/packages/Sandblocks-Babylonian/Object.extension.st b/packages/Sandblocks-Babylonian/Object.extension.st
index 24f3b675..45b2b7f7 100644
--- a/packages/Sandblocks-Babylonian/Object.extension.st
+++ b/packages/Sandblocks-Babylonian/Object.extension.st
@@ -1,5 +1,32 @@
 Extension { #name : #Object }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Object class >> exampleBlock [
+
+	^ (self name, ' new') parseAsSandblock
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Object class >> exampleBlockContainingClass: aClass [
+
+	^ self exampleBlock 
+	
+	
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Object class >> exampleObject [
+
+	^ self new
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Object class >> exampleObjectContainingClass: aClass [
+
+	"For generic classes to overwrite"
+	^ self exampleObject
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Object >> sbSnapshot [
 
diff --git a/packages/Sandblocks-Babylonian/Point.extension.st b/packages/Sandblocks-Babylonian/Point.extension.st
index 2450f04a..7ff76dc6 100644
--- a/packages/Sandblocks-Babylonian/Point.extension.st
+++ b/packages/Sandblocks-Babylonian/Point.extension.st
@@ -1,5 +1,17 @@
 Extension { #name : #Point }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Point class >> exampleBlock [
+
+	^ self exampleObject asSandblock 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Point class >> exampleObject [
+
+	^ self x: Integer exampleObject  y: Integer exampleObject 
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Point >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
diff --git a/packages/Sandblocks-Babylonian/SBExample.class.st b/packages/Sandblocks-Babylonian/SBExample.class.st
index b50da227..9546ab6d 100644
--- a/packages/Sandblocks-Babylonian/SBExample.class.st
+++ b/packages/Sandblocks-Babylonian/SBExample.class.st
@@ -346,6 +346,12 @@ SBExample >> layoutCommands [
 			SBAlgebraCommand group data: {a layoutCommands. SBAlgebraCommand gap. b layoutCommands. SBAlgebraCommand softLineOrGap}]), {self lastSubmorph layoutCommands}
 ]
 
+{ #category : #'as yet unclassified' }
+SBExample >> nameBlock [
+
+	^ self submorphs second
+]
+
 { #category : #'as yet unclassified' }
 SBExample >> outOfWorld: aWorld [
 
diff --git a/packages/Sandblocks-Babylonian/SBStGrammarHandler.extension.st b/packages/Sandblocks-Babylonian/SBStGrammarHandler.extension.st
index 2863fdc5..45d6515a 100644
--- a/packages/Sandblocks-Babylonian/SBStGrammarHandler.extension.st
+++ b/packages/Sandblocks-Babylonian/SBStGrammarHandler.extension.st
@@ -4,22 +4,68 @@ Extension { #name : #SBStGrammarHandler }
 SBStGrammarHandler >> addExample [
 	<action>
 
-	| method class |
+	| method class example |
 	self block isExample ifTrue: [^ self block toggleRunning].
 	
 	method := self block containingArtefact.
 	class := method methodClass.
+	example := self createExampleIn: method of: class.
 	
 	self block sandblockEditor do: (SBInsertCommand new
 		container: method body;
 		index: 2;
-		morph: (SBExample new
-			self: (method isClassSide ifTrue: [SBStName contents: class theNonMetaClassName] ifFalse: [
-				SBStMessageSend new
-					receiver: (SBStName contents: class name)
-					selector: (method selector = #initialize ifTrue: [#basicNew] ifFalse: [#new])])
+		morph: example).
+		
+	example startRunning.
+	self block sandblockEditor select: example nameBlock.
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+SBStGrammarHandler >> createExampleIn: aMethod of: aClass [
+
+	^ SBExample new
+			self: (aMethod isClassSide 
+				ifTrue: [SBStName contents: aClass theNonMetaClassName] 
+				ifFalse: [
+					SBStMessageSend new
+						receiver: (SBStName contents: aClass name)
+						selector: (aMethod selector = #initialize ifTrue: [#basicNew] ifFalse: [#new])])
 			args: (SBStArray new
 				type: #dynamic
-				contents: (Array streamContents: [:str | method arguments size timesRepeat: [str nextPut: self block newNullBlock]]))
-			label: 'example'))
+				contents: (aMethod arguments collect: [:anArgument | 
+					self extractBlockFromArgumentName: anArgument contents]))
+			label: 'example'.
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+SBStGrammarHandler >> extractBlockFromArgumentName: aString [
+
+	| classes |
+	classes := self extractClassesFromName: aString.
+	^ (classes second = UndefinedObject) 
+		ifTrue: [classes first exampleBlock] 
+		ifFalse: [classes first exampleBlockContainingClass: classes second]
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+SBStGrammarHandler >> extractClassesFromName: aParameterName [
+
+	"Working with groups isn't supported, so we do a nested request"
+	"When it does work, use : '((?<=[\w*])[A-Z]\w*)[Oo]f([A-Z]\w*)s'"
+	(aParameterName allRegexMatches: '(?<=[\w*])[A-Z]\w*')
+		ifNotEmpty: [:theCollection | | argWOPrefix |
+			argWOPrefix := theCollection first.
+			(argWOPrefix matchesRegex: '[A-Z]\w*Of[A-Z]\w*s')
+				ifFalse: [^ {self searchClassNamed: argWOPrefix. UndefinedObject}]
+				ifTrue: [^ {
+					self searchClassNamed: ((argWOPrefix allRegexMatches: '[A-Z]\w*(?=Of[A-Z]\w*s)') first). 
+					self searchClassNamed: ((argWOPrefix allRegexMatches: '(?<=[A-Z]\w*Of)[A-Z]\w*(?=s)') first).}]].
+		
+	^ {UndefinedObject. UndefinedObject}
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+SBStGrammarHandler >> searchClassNamed: aString [
+	
+	^ (self environment classNamed: aString) ifNil: [UndefinedObject]
 ]
diff --git a/packages/Sandblocks-Babylonian/String.extension.st b/packages/Sandblocks-Babylonian/String.extension.st
index aff65572..2928514c 100644
--- a/packages/Sandblocks-Babylonian/String.extension.st
+++ b/packages/Sandblocks-Babylonian/String.extension.st
@@ -1,5 +1,31 @@
 Extension { #name : #String }
 
+{ #category : #'*Sandblocks-Babylonian' }
+String class >> exampleBlock [
+
+	^ self exampleObject asSandblock 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+String class >> exampleBlockContainingClass: aClass [
+
+	^ self exampleBlock 
+	
+	
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+String class >> exampleObject [
+
+	^ 'Hello, World'
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+String class >> exampleObjectContainingClass: aClass [
+
+	^ self exampleObject
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 String >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
diff --git a/packages/Sandblocks-Babylonian/Text.extension.st b/packages/Sandblocks-Babylonian/Text.extension.st
index 3cdbb630..5837bf47 100644
--- a/packages/Sandblocks-Babylonian/Text.extension.st
+++ b/packages/Sandblocks-Babylonian/Text.extension.st
@@ -1,5 +1,31 @@
 Extension { #name : #Text }
 
+{ #category : #'*Sandblocks-Babylonian' }
+Text class >> exampleBlock [
+
+	^ ('Text fromString: ''', self exampleObject, '''') parseAsSandblock 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Text class >> exampleBlockContainingClass: aClass [
+
+	^ self exampleBlock 
+	
+	
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Text class >> exampleObject [
+
+	^ self fromString: 'Hello, World'
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+Text class >> exampleObjectContainingClass: aClass [
+
+	^ self exampleObject
+]
+
 { #category : #'*Sandblocks-Babylonian' }
 Text >> sbWatchValueMorphFor: aSBWatchValue sized: aSBMorphResizer [
 
diff --git a/packages/Sandblocks-Babylonian/UndefinedObject.extension.st b/packages/Sandblocks-Babylonian/UndefinedObject.extension.st
new file mode 100644
index 00000000..1cb96345
--- /dev/null
+++ b/packages/Sandblocks-Babylonian/UndefinedObject.extension.st
@@ -0,0 +1,13 @@
+Extension { #name : #UndefinedObject }
+
+{ #category : #'*Sandblocks-Babylonian' }
+UndefinedObject class >> exampleBlock [
+
+	^ self exampleObject asSandblock 
+]
+
+{ #category : #'*Sandblocks-Babylonian' }
+UndefinedObject class >> exampleObject [
+
+	^ self initializedInstance
+]
diff --git a/packages/Sandblocks-Core/Color.extension.st b/packages/Sandblocks-Core/Color.extension.st
index 065997f1..2817d43f 100644
--- a/packages/Sandblocks-Core/Color.extension.st
+++ b/packages/Sandblocks-Core/Color.extension.st
@@ -6,3 +6,9 @@ Color >> asMorph: convert [
 	
 	^ convert do: [self asMorph]
 ]
+
+{ #category : #'*Sandblocks-Core' }
+Color >> asSandblock [
+
+	^ self shortPrintString parseAsSandblock
+]
diff --git a/packages/Sandblocks-Core/Fraction.extension.st b/packages/Sandblocks-Core/Fraction.extension.st
new file mode 100644
index 00000000..44b786c2
--- /dev/null
+++ b/packages/Sandblocks-Core/Fraction.extension.st
@@ -0,0 +1,7 @@
+Extension { #name : #Fraction }
+
+{ #category : #'*Sandblocks-Core' }
+Fraction >> asSandblock [ 
+
+	^ self asString parseAsSandblock 
+]
diff --git a/packages/Sandblocks-Core/Number.extension.st b/packages/Sandblocks-Core/Number.extension.st
index 27866691..47b2330d 100644
--- a/packages/Sandblocks-Core/Number.extension.st
+++ b/packages/Sandblocks-Core/Number.extension.st
@@ -30,6 +30,12 @@ Number >> asEdgeInsets [
 		bottom: self
 ]
 
+{ #category : #'*Sandblocks-Core' }
+Number >> asSandblock [
+
+	^ SBStNumber new value: self
+]
+
 { #category : #'*Sandblocks-Core' }
 Number >> sbScaled [
 
diff --git a/packages/Sandblocks-Core/Point.extension.st b/packages/Sandblocks-Core/Point.extension.st
index 23167388..f7736cdf 100644
--- a/packages/Sandblocks-Core/Point.extension.st
+++ b/packages/Sandblocks-Core/Point.extension.st
@@ -30,6 +30,18 @@ Point >> asEdgeInsets [
 		bottom: self y
 ]
 
+{ #category : #'*Sandblocks-Core' }
+Point class >> asSandblock [
+
+	^ self asString parseAsSandblock
+]
+
+{ #category : #'*Sandblocks-Core' }
+Point >> asSandblock [ 
+
+	^ self asString parseAsSandblock 
+]
+
 { #category : #'*Sandblocks-Core' }
 Point class >> fromSide: aSymbol [
 
diff --git a/packages/Sandblocks-Core/String.extension.st b/packages/Sandblocks-Core/String.extension.st
index 8a180df1..a5f54ee6 100644
--- a/packages/Sandblocks-Core/String.extension.st
+++ b/packages/Sandblocks-Core/String.extension.st
@@ -1,5 +1,11 @@
 Extension { #name : #String }
 
+{ #category : #'*Sandblocks-Core' }
+String >> asSandblock [
+
+	^ ('''',self,'''') parseAsSandblock
+]
+
 { #category : #'*Sandblocks-Core-converting' }
 String >> inStringView: converter [
 	<convert>
diff --git a/packages/Sandblocks-Core/UndefinedObject.extension.st b/packages/Sandblocks-Core/UndefinedObject.extension.st
new file mode 100644
index 00000000..259748b8
--- /dev/null
+++ b/packages/Sandblocks-Core/UndefinedObject.extension.st
@@ -0,0 +1,7 @@
+Extension { #name : #UndefinedObject }
+
+{ #category : #'*Sandblocks-Core' }
+UndefinedObject >> asSandblock [ 
+
+	^ SBUnknown new grammarHandler: SBStGrammarHandler new
+]