Christoph Thiede uploaded a new version of MorphicExtrasTests to project The Trunk:
http://source.squeak.org/trunk/MorphicExtrasTests-ct.7.mcz

==================== Summary ====================

Name: MorphicExtrasTests-ct.7
Author: ct
Time: 18 October 2022, 7:56:05.431293 pm
UUID: b58b1eef-6eb4-1a42-9d0e-d6c366075056
Ancestors: MorphicExtrasTests-mt.6

Complements MorphicExtras-ct.338 (ObjectlandMorph).

=============== Diff against MorphicExtrasTests-mt.6 ===============

Item was changed:
  SystemOrganization addCategory: #'MorphicExtrasTests-Postscript Filters'!
  SystemOrganization addCategory: #'MorphicExtrasTests-Flaps'!
  SystemOrganization addCategory: #'MorphicExtrasTests-Postscript Canvases'!
+ SystemOrganization addCategory: #'MorphicExtrasTests-Demo'!

Item was added:
+ TestCase subclass: #ObjectlandTest
+ 	instanceVariableNames: 'project projects morph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'MorphicExtrasTests-Demo'!

Item was added:
+ ----- Method: ObjectlandTest class>>generateProjectScreenshots (in category 'screenshots') -----
+ generateProjectScreenshots
+ 
+ 	| configs allScreenshots originalScaleFactor originalScreenSize |
+ 	"Note: Can only test resolutions that are supported by your screen"
+ 	configs :=
+ 		{{800 @ 600. 0.75}.
+ 		{1024 @ 768. 1}.
+ 		{1366 @ 768. 1}.
+ 		{1280 @ 960. 1.25}.
+ 		{1600 @ 900. 1}.
+ 		{1920 @ 1080. 1}.
+ 		{1920 @ 1080. 1.25}.
+ 		{1920 @ 1080. 1.5}.
+ 		{1920 @ 1080. 2.0}.
+ 		{3840 @ 2160. 1}.
+ 		{3840 @ 2160. 2.5}}.
+ 	
+ 	originalScreenSize := DisplayScreen actualScreenSize.
+ 	originalScaleFactor := DisplayScreen relativeScaleFactor.
+ 	
+ 	allScreenshots := OrderedDictionary new.
+ 	[configs
+ 		do: [:config |
+ 			allScreenshots at: config put: [
+ 				| objectlandMorph screenshots morphs projects |
+ 				objectlandMorph := ObjectlandMorph new.
+ 				screenshots := OrderedDictionary new.
+ 				DisplayScreen
+ 					relativeScaleFactor: config second;
+ 					setNewScreenSize: config first.
+ 				morphs := OrderedCollection with: objectlandMorph createObjectlandProject.
+ 				morphs addAllLast: (objectlandMorph load; projectMorphs).
+ 				projects := OrderedCollection new.
+ 				[morphs
+ 					do: [:morph |
+ 						| project |
+ 						project := morph firstSubmorph project.
+ 						projects addFirst: project.
+ 						screenshots
+ 							at: project name
+ 							put: project world imageForm]
+ 					displayingProgress: 'Generating screenshots']
+ 						ensure: [
+ 							projects do: [:project |
+ 								project prepareForDelete; release]].
+ 				screenshots] value]
+ 		displayingProgress: 'Testing configs']
+ 			ensure: [
+ 				DisplayScreen
+ 					relativeScaleFactor: originalScaleFactor;
+ 					setNewScreenSize: originalScreenSize].
+ 	^ allScreenshots!

Item was added:
+ ----- Method: ObjectlandTest class>>viewProjectScreenshots (in category 'screenshots') -----
+ viewProjectScreenshots
+ 	"Generate and view screenshots of all Objectland projects for different screen configurations. This is useful for manually revising the responsive layout and morph composition of Objectland.
+ 	Note: Before running this, move your image on the largest screen that you have (see comment in #generateProjectScreenshots)!!
+ 	
+ 	self viewProjectScreenshots
+ 	"
+ 
+ 	| allScreenshots text |
+ 	allScreenshots := self generateProjectScreenshots.
+ 	
+ 	text := Text streamContents: [:stream |
+ 		allScreenshots keysAndValuesDo: [:config :screenshots |
+ 			stream
+ 				withAttribute: TextEmphasis bold do: [
+ 					stream print: config];
+ 				cr; cr.
+ 			screenshots keysAndValuesDo: [:label :screenshot |
+ 				stream
+ 					withAttribute: TextEmphasis italic do: [
+ 						stream nextPutAll: label];
+ 					cr;
+ 					withAttribute: screenshot asTextAnchor do: [
+ 						stream nextPut: Character startOfHeader];
+ 					cr; cr].
+ 			stream cr]].
+ 	
+ 	^ text editWithLabel: 'Objectland project screenshots'!

Item was added:
+ ----- Method: ObjectlandTest>>setUp (in category 'running') -----
+ setUp
+ 
+ 	super setUp.
+ 	morph := ObjectlandMorph new.!

Item was added:
+ ----- Method: ObjectlandTest>>tearDown (in category 'running') -----
+ tearDown
+ 
+ 	[project ifNotNil: [
+ 		project delete].
+ 	morph ifNotNil: [
+ 		morph projectMorphs ifNotNil: [:morphs |
+ 			morphs do: #delete]]]
+ 		valueSuppressingMessages: {'*delete*'}.
+ 	
+ 	^ super tearDown!

Item was added:
+ ----- Method: ObjectlandTest>>testCreateObjectlandProject (in category 'testing') -----
+ testCreateObjectlandProject
+ 
+ 	self
+ 		shouldnt: [project := morph createObjectlandProject]
+ 		raise: Error, Warning, Halt.!

Item was added:
+ ----- Method: ObjectlandTest>>testLoadObjectlandProject (in category 'testing') -----
+ testLoadObjectlandProject
+ 	<timeout: 30 "seconds">
+ 
+ 	project := MorphicProject new.
+ 	project world addMorph: morph.
+ 	self
+ 		shouldnt: [morph load]
+ 		raise: Error, Warning, Halt.
+ 	
+ 	self deny: [morph displayText asLowercase includesSubstring: '...'].
+ 	self assert: [morph projectMorphs size >= 3].
+ 	morph projectMorphs do: [:projectMorph |
+ 		self assert: [projectMorph model name asLowercase includesSubstring: 'fun'].
+ 		self assert: [projectMorph model world submorphs size >= 5]].!