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]].!
packages@lists.squeakfoundation.org