[squeak-dev] The Trunk: MorphicExtras-ct.338.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Oct 18 17:55:44 UTC 2022


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

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

Name: MorphicExtras-ct.338
Author: ct
Time: 18 October 2022, 7:55:41.245293 pm
UUID: fe629685-5d6a-d543-8fe9-729d5d675a7a
Ancestors: MorphicExtras-ct.337

Adds ObjectlandMorph, the final part of the reconstruction of Objectland (formerly also known as "The Worlds of Squeak"). This version marks the (probably) last commit in a series of changes that I started making nearly 3 years ago [1]. Essential aims of the project were to revive the colorful collection of examples around the capacities of Squeak which was lastly delivered with Squeak 3.7, convert each example into code to provide a rich set of how-to examples to newbies in Squeak, and integrate it into the Trunk image again.

[1] Most relevant versions have the keyword "Objectland" in their name, so you could use your favorite squeak-dev browsing tool to find them all. :-) See also: http://forum.world.st/The-Inbox-MorphicExtras-ct-267-mcz-td5104764.html

=============== Diff against MorphicExtras-ct.337 ===============

Item was added:
+ Morph subclass: #ObjectlandMorph
+ 	instanceVariableNames: 'factoryState carouselState displayMorph eyes rootProjectMorph projectMorphs isGhost'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'MorphicExtras-Demo'!
+ 
+ !ObjectlandMorph commentStamp: 'ct 10/18/2022 18:44' prior: 0!
+ I hold an amount of examples around the Worlds of Squeak. As soon as I am activated, I insert a list of projects into my world. While building, I display some loading animation. I can be opened from the Objects Pin tool or also from the world's "open" menu. Click me multiple times to reveal a hidden feature!!!

Item was added:
+ ----- Method: ObjectlandMorph class>>cheeseForm (in category 'resources') -----
+ cheeseForm
+ 	"Credits: Cheese by qubodup - uploaded on April 6, 2015, 9:59 am. https://openclipart.org/detail/216862/cheese. CC0 License."
+ 
+ 	^ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self cheeseFormContents readStream)!

Item was added:
+ ----- Method: ObjectlandMorph class>>cheeseFormContents (in category 'resources') -----
(excessive size, no diff calculated)

Item was added:
+ ----- Method: ObjectlandMorph class>>createObjectlandProject (in category 'instance creation') -----
+ createObjectlandProject
+ 
+ 	| projectWindow |
+ 	projectWindow := Project current world
+ 		submorphThat: [:m | (m model isKindOf: Project) and: [m model name beginsWith: 'The Worlds of Squeak']]
+ 		ifNone: [^ self new createObjectlandProject].
+ 	^ projectWindow beKeyWindow!

Item was added:
+ ----- Method: ObjectlandMorph class>>descriptionForPartsBin (in category 'PartsBin') -----
+ descriptionForPartsBin
+ 
+ 	^ self
+ 		partName: 'Objectland' translatedNoop
+ 		categories: {'Demo' translatedNoop. 'Just for Fun' translatedNoop}
+ 		documentation: 'A collection of funny and educational examples introducing different domains of Squeak, including Morphic, Etoys, and others' translatedNoop!

Item was added:
+ ----- Method: ObjectlandMorph class>>fill:with:factory:ifOverflow: (in category 'support') -----
+ fill: aMorph with: n factory: factoryBlock ifOverflow: errorBlock
+ 	"Flood aMorph with n non-overlapping submorphs built by factoryBlock. Answer value of errorBlock if there is not enough space in the receiver."
+ 
+ 	| random |
+ 	self flag: #todo. "move or rename"
+ 	
+ 	random := ThreadSafeRandom value.
+ 	^ ((1 to: n) collect: [:x | factoryBlock value])
+ 		do: [:morph |
+ 			| areas center |
+ 			areas := (self freeAreasIn: aMorph insetBy: morph extent + 1)
+ 				ifEmpty: [^ errorBlock value].
+ 			center := (areas atRandom: random)
+ 				pointAtFraction: random next @ random next.
+ 			morph center: center.
+ 			aMorph addMorph: morph];
+ 		yourself!

Item was added:
+ ----- Method: ObjectlandMorph class>>freeAreasIn:insetBy: (in category 'support') -----
+ freeAreasIn: aMorph insetBy: inset
+ 	"Collect all areas inside of aMorph's bounds that are not covered by any submorph. Answer a Set of disjunct Rectangles."
+ 
+ 	| areas |
+ 	areas := Set new.
+ 	(aMorph bounds insetBy: inset)
+ 		allAreasOutsideList: (aMorph submorphs collect: [:m | m bounds outsetBy: inset])
+ 		do: [:rect | areas add: rect].
+ 	^ areas select: #hasPositiveExtent.!

Item was added:
+ ----- Method: ObjectlandMorph class>>initialize (in category 'initialize-release') -----
+ initialize
+ 
+ 	self registerInOpenMenu.!

Item was added:
+ ----- Method: ObjectlandMorph class>>liftUpSubmorphsOf: (in category 'support') -----
+ liftUpSubmorphsOf: aMorph
+ 
+ 	^ self
+ 		liftUpSubmorphsOf: aMorph
+ 		to: aMorph topRendererOrSelf owner!

Item was added:
+ ----- Method: ObjectlandMorph class>>liftUpSubmorphsOf:to: (in category 'support') -----
+ liftUpSubmorphsOf: aMorph to: ownerMorph
+ 
+ 	aMorph submorphs reversed
+ 		inject: ownerMorph
+ 		into: [:previous :morph |
+ 			| morphBounds |
+ 			morphBounds := morph boundsIn: ownerMorph.
+ 			ownerMorph addMorph: morph inFrontOf: previous.
+ 			morph bounds: morphBounds].!

Item was added:
+ ----- Method: ObjectlandMorph class>>openObjectland (in category 'instance creation') -----
+ openObjectland
+ 	"ObjectlandMorph openObjectland"
+ 
+ 	| project |
+ 	project := self createObjectlandProject.
+ 	project isInWorld ifFalse: [project openAsTool].
+ 	"project model enter."
+ 	^ project!

Item was added:
+ ----- Method: ObjectlandMorph class>>registerInOpenMenu (in category 'initialize-release') -----
+ registerInOpenMenu
+ 
+ 	TheWorldMenu registerOpenCommand: {'Objectland'. {self. #openObjectland}}.!

Item was added:
+ ----- Method: ObjectlandMorph class>>unload (in category 'initialize-release') -----
+ unload
+ 
+ 	self unregisterInOpenMenu.!

Item was added:
+ ----- Method: ObjectlandMorph class>>unregisterInOpenMenu (in category 'initialize-release') -----
+ unregisterInOpenMenu
+ 
+ 	TheWorldMenu unregisterOpenCommand: 'Objectland'.!

Item was added:
+ ----- Method: ObjectlandMorph>>build:atLocation:forOwner: (in category 'project creation') -----
+ build: buildable atLocation: location forOwner: ownerMorph
+ 	"Prepare buildable to be displayed at location in ownerMorph, but do not yet add it to ownerMorph. The sender will do this later.
+ 		buildable: a Morph or Model that understands #buildWith:, or a block that answers one of the former
+ 		location: Rectangle or Point, relative to owner's bounds"
+ 
+ 	| widget morph hResizing vResizing |
+ 	widget := buildable isBlock
+ 		ifTrue: [buildable cull: ownerMorph]
+ 		ifFalse: [buildable].
+ 	morph := widget buildWith: MorphicToolBuilder new.
+ 	
+ 	hResizing := morph hResizing. vResizing := morph vResizing.
+ 	morph
+ 		fullBounds;
+ 		layoutFrame: (
+ 			LayoutFrame fractions: (location isPoint
+ 				ifTrue: [morph extent / ownerMorph extent exactCenter: location]
+ 				ifFalse: [location]));
+ 		hResizing: #spaceFill; vResizing: #spaceFill.
+ 	"Compute proportional layout for the morph without embedding it into ownerMorph."
+ 	morph
+ 		layoutInBounds: (morph layoutFrame
+ 			layout: morph bounds
+ 			in: ownerMorph layoutBounds)
+ 		positioning: #center.
+ 	morph hResizing: hResizing; vResizing: vResizing.
+ 	
+ 	^ morph!

Item was added:
+ ----- Method: ObjectlandMorph>>buildInto:specs: (in category 'project creation') -----
+ buildInto: ownerMorph specs: specs
+ 	"Build the given morph specs into ownerMorph. Make sure that all morphs appear at the same time in the ownerMorph."
+ 
+ 	^ specs
+ 		collect: [:spec |
+ 			self
+ 				build: spec value
+ 				atLocation: spec key
+ 				forOwner: ownerMorph]
+ 		thenDo: [:morph |
+ 			ownerMorph addMorph: morph]!

Item was added:
+ ----- Method: ObjectlandMorph>>createEtoysProject (in category 'projects') -----
+ createEtoysProject
+ 
+ 	| etoysExample |
+ 	self flag: #forLater. "If we could enable etoysMode just for this project, this would be great"
+ 	
+ 	etoysExample := Player extraExampleCar.
+ 	^ self
+ 		createProjectNamed: 'Fun with Etoys' translated
+ 		colorRamp: {
+ 			1 -> Color plum darker.
+ 			0 -> Color lightMagenta }
+ 		morphSpecs: {
+ 			(0.46 @ 0.6 exactCenter: 0.25 @ 0.6) -> [HelpBrowser new
+ 				rootTopic: SqueakTutorialsEToys;
+ 				showTopicNamed: #raceCar;
+ 				yourself].
+ 			(0.3 @ 0.4 exactCenter: 0.7 @ 0.45) -> [etoysExample first addFlexShell]. "arena"
+ 			0.3 @ 0.2 -> [AllScriptsTool newStandAlone].
+ 			0.7 @ 0.83 -> [etoysExample second] "script editor" }
+ 		initializeWorld: [:world |
+ 			self class liftUpSubmorphsOf: etoysExample first.
+ 			etoysExample first owner delete.
+ 			world stopRunningAll]!

Item was added:
+ ----- Method: ObjectlandMorph>>createGamesProject (in category 'projects') -----
+ createGamesProject
+ 
+ 	^ self
+ 		createProjectNamed: 'Fun with Games' translated
+ 		colorRamp: {
+ 			0 -> Color green muchDarker.
+ 			1 -> (Color green alphaMixed: 0.25 with: Color black) }
+ 		morphSpecs: {
+ 			0.2 @ 0.7 -> [self makeGiftFor: FreeCell new labeled: 'Free Cell'].
+ 			0.35 @ 0.8 -> [self makeGiftFor: CrosticPanel new labeled: 'Crostic Panel'].
+ 			0.25 @ 0.35 -> [CipherPanel new].
+ 			0.8 @ 0.25 -> [SameGame new].
+ 			0.62 @ 0.7 -> [Tetris new pause].
+ 			(0.25 @ 0.5 exactCenter: 0.85 @ 0.7) -> [ChineseCheckers new].
+ 	}!

Item was added:
+ ----- Method: ObjectlandMorph>>createGraphicsProject (in category 'projects') -----
+ createGraphicsProject
+ 
+ 	^ self
+ 		createProjectNamed: 'Fun with Graphics' translated
+ 		colorRamp: {
+ 			0 -> (Color r: 1 g: 0.916 b: 0.585).
+ 			1 -> (Color r: 1 g: 0.804 b: 0.008) }
+ 		morphSpecs: {
+ 			(0.08 @ 0.15 exactCenter: 0.08 @ 0.7) -> [
+ 				SketchMorph extraExampleCook].
+ 			(0.08 @ 0.15 exactCenter: 0.77 @ 0.1) -> [
+ 				SketchMorph extraExampleWizard].
+ 			(0.12 @ 0.15 exactCenter: 0.35 @ 0.2) -> [
+ 				BannerMorph example addFlexShell].
+ 			(0.15 @ 0.15 exactCenter: 0.1 @ 0.18) -> [
+ 				WatchMorph example].
+ 			0.12 @ 0.41 -> [
+ 				CalendarMorph new
+ 					color: Color green muchDarker;
+ 					date: (Date year: 1996 month: 09 day: 24); step;
+ 					rotationDegrees: -2;
+ 					owner].
+ 			0.83 @ 0.58 -> [
+ 				PolygonMorph extraExampleTextFlow].
+ 			0.55 @ 0.72 -> [
+ 				CurveMorph extraExampleTextFlow addFlexShell scale: RealEstateAgent scaleFactor].
+ 			(0.27 @ 0.2 exactCenter: 0.33 @ 0.77) -> [
+ 				BouncingAtomsMorph new
+ 					rotationDegrees: 1;
+ 					color: Color orange darker;
+ 					yourself].
+ 			(0.08 @ 0.15 exactCenter: 0.46 @ 0.12) -> [
+ 				StarMorph new
+ 					addHandles;
+ 					balloonText: 'Drag my yellow handles to resize me, or click on my other handles to reshape me';
+ 					yourself].
+ 			(0.1 @ 0.2 exactCenter: 0.51 @ 0.42) -> [
+ 				FishEyeMorph new
+ 					flag: #todo "maxExtent: 0.09 @ 0.17";
+ 					addFlexShell].
+ 			(0.18 @ 0.24 exactCenter: 0.62 @ 0.17) -> [:world |
+ 				(NewColorPickerMorph
+ 					on: world
+ 					originalColor: world fillStyle colorRamp last value
+ 					setColorSelector: #gradientFillColor:)
+ 					rotationDegrees: 11;
+ 					yourself].
+ 			0.34 @ 0.4 -> [
+ 				PolygonMorph extraExampleTrapezePlus].
+ 			(0.14 @ 0.14 exactCenter: 0.72 @ 0.64) -> [
+ 				| curve |
+ 				(curve := CurveMorph extraExampleArrow)
+ 					addMorph: ('... snazzy bevelled edges!!' asTextMorph
+ 						center: (curve pointAtFraction: 0.75 @ 0.3);
+ 						rotationDegrees: 25;
+ 						owner);
+ 					addFlexShell].
+ 			0.125 @ 0.9 -> [
+ 				self makeGiftFor: ObjectsTool newStandAlone labeled: 'Objects Tool'].
+ 			0.85 asPoint -> [
+ 				EventRecorderMorph new].
+ 			0.95 @ 0.23 -> [
+ 				BlobMorph new].
+ 			0.28 @ 0.91 -> [
+ 				BlobMorph new].
+ 			0.34 @ 0.08 -> [
+ 				BlobMorph new]. }
+ 		initializeWorld: [:world | self class
+ 			fill: world
+ 			with: 20
+ 			factory: [TetrisPieceMorph random]
+ 			ifOverflow: []]!

Item was added:
+ ----- Method: ObjectlandMorph>>createObjectlandProject (in category 'projects') -----
+ createObjectlandProject
+ 
+ 	Cursor wait showWhile: [
+ 		rootProjectMorph := self
+ 			createProjectNamed: 'The Worlds of Squeak!!' translated
+ 			colorRamp: { 0 -> Color tungsten. 1 -> Color black }
+ 			morphSpecs: { (0.2 asPoint exactCenter: 0.5 asPoint) -> [self addFlexShell] }
+ 			initializeWorld: [:world |
+ 				| previousButton closeButton |
+ 				"Unlike our children, *we* want a separate changeset indeed."
+ 				world project useOwnChangeSetWithCurrentName.
+ 				
+ 				previousButton := world findA: RectangleMorph.
+ 				closeButton := self newCloseProjectButton.
+ 				closeButton firstSubmorph image: (closeButton firstSubmorph image scaledToHeight: previousButton firstSubmorph image height).
+ 				world addMorph: (closeButton
+ 					position: world clearArea topLeft + 5 px;
+ 					yourself).
+ 				previousButton topLeft: closeButton topRight + (5 px @ 0).
+ 				world fillStyle
+ 					radial: true;
+ 					origin: world center]].
+ 	
+ 	factoryState := #ready.
+ 	
+ 	^ rootProjectMorph!

Item was added:
+ ----- Method: ObjectlandMorph>>createProjectNamed:colorRamp:morphSpecs: (in category 'project creation') -----
+ createProjectNamed: name colorRamp: colorRamp morphSpecs: specs
+ 
+ 	^ self
+ 		createProjectNamed: name
+ 		colorRamp: colorRamp
+ 		morphSpecs: specs
+ 		initializeWorld: []!

Item was added:
+ ----- Method: ObjectlandMorph>>createProjectNamed:colorRamp:morphSpecs:initializeWorld: (in category 'project creation') -----
+ createProjectNamed: name colorRamp: colorRamp morphSpecs: specs initializeWorld: aBlock
+ 
+ 	| project |
+ 	project := MorphicProject new.
+ 	project useParentChangeSetButSetProjectName: name.
+ 	project flapsSuppressed: true.
+ 	project world useGradientFill.
+ 	project world fillStyle
+ 		radial: false;
+ 		colorRamp: colorRamp.
+ 	project world addMorph: (self newPreviousProjectButton
+ 		position: project world clearArea topLeft + 5 px;
+ 		yourself).
+ 	
+ 	self buildInto: project world specs: specs.
+ 	
+ 	aBlock cull: project world.
+ 	
+ 	^ ProjectViewMorph newProjectViewInAWindowFor: project!

Item was added:
+ ----- Method: ObjectlandMorph>>createSoundsProject (in category 'projects') -----
+ createSoundsProject
+ 
+ 	| scorePlayerMorph |
+ 	^ self
+ 		createProjectNamed: 'Fun with Sounds' translated
+ 		colorRamp: {
+ 			0 -> (Color r: 1 g: 0.369 b: 0.227).
+ 			1 -> (Color r: 1 g: 0.164 b: 0.408) }
+ 		morphSpecs: {
+ 			0.25 @ 0.4 -> [
+ 				scorePlayerMorph := ScorePlayerMorph extraExample].
+ 			(0.45 @ 0.25 exactCenter: 0.73 @ 0.2) -> [
+ 				PianoRollScoreMorph new on: scorePlayerMorph scorePlayer].
+ 			(0.55 @ 0.3 exactCenter: 0.35 @ 0.82) -> [
+ 				PianoKeyboardMorph newStandAlone beSticky addFlexShell rotationDegrees: 12].
+ 			0.77 @ 0.5 -> [
+ 				SpectrumAnalyzerMorph new showSignal].
+ 			0.2 @ 0.89 -> [
+ 				RecordingControlsMorph new].
+ 			0.8 @ 0.8 -> [self newStopAllSoundsButton]
+ 		}!

Item was added:
+ ----- Method: ObjectlandMorph>>createToolsProject (in category 'projects') -----
+ createToolsProject
+ 
+ 	^ self
+ 		createProjectNamed: 'Fun with Tools' translated
+ 		colorRamp:  {
+ 			0 -> (Color r: 0.353 g: 0.784 b: 0.983).
+ 			1 -> (Color r: 0.321 g: 0.929 b: 0.78) }
+ 		morphSpecs: {
+ 			0.45 @ 0.3 -> [Workspace extraExample2].
+ 			0.2 @ 0.23 -> [Workspace extraExample1].
+ 			0.32 @ 0.7 -> [HelpBrowser new
+ 				rootTopic: CustomHelp;
+ 				showTopicNamed: #basicDevelopmentTools;
+ 				yourself].
+ 			(0.25 @ 0.15 exactCenter: 0.6 @ 0.9) -> [:world | world project transcript].
+ 			(0.35 @ 0.25 exactCenter: 0.78 @ 0.2) -> [
+ 				PreferenceBrowser prototypicalToolWindow refreshWindowColor].
+ 			(0.4 @ 0.5 exactCenter: 0.77 @ 0.5) -> [Browser new
+ 				setClass: Browser selector: #buildDefaultBrowserWith:].
+ 		}!

Item was added:
+ ----- Method: ObjectlandMorph>>displayText (in category 'display') -----
+ displayText
+ 
+ 	^ displayMorph contents!

Item was added:
+ ----- Method: ObjectlandMorph>>displayText: (in category 'display') -----
+ displayText: aText
+ 
+ 	displayMorph contents: aText.
+ 	
+ 	self isInWorld ifFalse: [^ self].
+ 	self
+ 		fullBounds; "update width from displayMorph"
+ 		referencePositionInWorld: self world extent / 2.!

Item was added:
+ ----- Method: ObjectlandMorph>>eyeColor: (in category 'display') -----
+ eyeColor: aColor
+ 
+ 	eyes do: [:eye | eye color: aColor]!

Item was added:
+ ----- Method: ObjectlandMorph>>fillObjectlandProject (in category 'projects') -----
+ fillObjectlandProject
+ 
+ 	^ self fillObjectlandProjectWith: {
+ 		self createEtoysProject.
+ 		self createGamesProject.
+ 		self createGraphicsProject.
+ 		self createToolsProject.
+ 		self createSoundsProject
+ 	}!

Item was added:
+ ----- Method: ObjectlandMorph>>fillObjectlandProjectWith: (in category 'project creation') -----
+ fillObjectlandProjectWith: elements
+ 
+ 	| positions projects |
+ 	positions := (1 to: elements size) collect: [:index |
+ 		1 / 4 asPoint exactCenter: (3 / 4 asPoint
+ 			rotateBy: 1 - index * 2 * Float pi / elements size + 0.4
+ 			about: 1 / 2 asPoint)].
+ 	
+ 	projects := "Morph rememberProvenanceDuring: ["
+ 		self buildInto: self world specs: (positions with: elements collect: #->)"]".
+ 	projects do: [:window |
+ 		| projectViewMorph |
+ 		projectViewMorph := window firstSubmorph.
+ 		projectViewMorph updateThumbnail: true].
+ 	
+ 	^ projects!

Item was added:
+ ----- Method: ObjectlandMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: anEvent
+ 
+ 	^ true!

Item was added:
+ ----- Method: ObjectlandMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	^ self initialize: true!

Item was added:
+ ----- Method: ObjectlandMorph>>initialize: (in category 'initialization') -----
+ initialize: isGhostBoolean
+ 
+ 	| mascotMorph |
+ 	super initialize.
+ 	isGhost := isGhostBoolean.
+ 	
+ 	self
+ 		color: Color transparent;
+ 		layoutInset: 5 px;
+ 		changeTableLayout;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		beSticky.
+ 	
+ 	mascotMorph := MovingEyeMorph perform:
+ 		(isGhost
+ 			ifFalse: [#extraExampleSqueakIsWatchingYou]
+ 			ifTrue: [#extraExampleSqueakGhostIsWatchingYou]).
+ 	 mascotMorph := mascotMorph addFlexShell
+ 		scale: RealEstateAgent scaleFactor reciprocal;
+ 		yourself.
+ 	eyes := mascotMorph allMorphs select: [:morph | morph isKindOf: MovingEyeMorph].
+ 	self addMorphBack: mascotMorph.
+ 	
+ 	displayMorph := StringMorph new
+ 		fontName: #BitstreamVeraSans pointSize: (42 / RealEstateAgent scaleFactor);
+ 		color: (isGhost ifFalse: [Color black] ifTrue: [Color white]);
+ 		contents: '';
+ 		yourself.
+ 	self addMorphBack: displayMorph.
+ 	
+ 	carouselState := 1 @ 0.!

Item was added:
+ ----- Method: ObjectlandMorph>>initializeToStandAlone (in category 'initialization') -----
+ initializeToStandAlone
+ 
+ 	self initialize: false.
+ 	
+ 	self displayText: 'Objectland' translated.
+ 	^ self addFlexShell
+ 		height: Project current world height // 5;
+ 		yourself!

Item was added:
+ ----- Method: ObjectlandMorph>>isGhost (in category 'accessing') -----
+ isGhost
+ 
+ 	^ isGhost!

Item was added:
+ ----- Method: ObjectlandMorph>>load (in category 'loading') -----
+ load
+ 
+ 	self displayText: 'Traveling to Objectland...' translated.
+ 	
+ 	projectMorphs := self fillObjectlandProject.
+ 	
+ 	self displayText: 'Welcome to Objectland!!' translated.!

Item was added:
+ ----- Method: ObjectlandMorph>>makeGiftFor:labeled: (in category 'project creation') -----
+ makeGiftFor: aMorph labeled: aStringOrText
+ 
+ 	| gift |
+ 	gift := SketchMorph new
+ 		form: self class cheeseForm;
+ 		extent: 100 px @ 100 px;
+ 		balloonText: aStringOrText;
+ 		yourself.
+ 	gift
+ 		on: #mouseDown
+ 		send: #value
+ 		to:
+ 			[aMorph openCenteredInWorld.
+ 			gift delete].
+ 	^ gift!

Item was added:
+ ----- Method: ObjectlandMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: anEvent
+ 
+ 	anEvent yellowButtonPressed ifTrue: [^ super mouseUp: anEvent].
+ 	(self containsPoint: anEvent cursorPoint) ifFalse: [^ super mouseUp: anEvent].
+ 	
+ 	factoryState ifNil: [^ self startLoading].
+ 	
+ 	carouselState := carouselState leftRotated. "simple 4-state machine"!

Item was added:
+ ----- Method: ObjectlandMorph>>newButtonLabeled:icon:color:action: (in category 'project creation') -----
+ newButtonLabeled: aString icon: aForm color: aColor action: aBlock
+ 
+ 	^ RectangleMorph new
+ 		changeTableLayout;
+ 		listDirection: #leftToRight;
+ 		wrapCentering: #center;
+ 		layoutInset: 5 px;
+ 		cellGap: 10 px;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		color: aColor;
+ 		addMorphBack: aForm scaleIconToDisplay asMorph;
+ 		addMorphBack: aString asMorph;
+ 		addMouseUpActionWith: (MessageSend
+ 			receiver: aBlock selector: #value);
+ 		yourself!

Item was added:
+ ----- Method: ObjectlandMorph>>newCloseProjectButton (in category 'project creation') -----
+ newCloseProjectButton
+ 
+ 	^ self
+ 		newButtonLabeled: 'Close project' translated
+ 		icon: MenuIcons smallCancelIcon
+ 		color: Color salmon
+ 		action: [Project current close]!

Item was added:
+ ----- Method: ObjectlandMorph>>newPreviousProjectButton (in category 'project creation') -----
+ newPreviousProjectButton
+ 
+ 	^ self
+ 		newButtonLabeled: 'Previous project' translated
+ 		icon: MenuIcons backIcon
+ 		color: Color cantaloupe
+ 		action: [Project returnToPreviousProject]!

Item was added:
+ ----- Method: ObjectlandMorph>>newStopAllSoundsButton (in category 'project creation') -----
+ newStopAllSoundsButton
+ 
+ 	^ SimpleButtonMorph new
+ 		target: SoundService;
+ 		actionSelector: #stop;
+ 		label: 'Stop all sounds';
+ 		yourself!

Item was added:
+ ----- Method: ObjectlandMorph>>outOfWorld: (in category 'submorphs - add/remove') -----
+ outOfWorld: aWorld
+ 
+ 	projectMorphs ifNotNil: [
+ 		(UserDialogBoxMorph new
+ 			title: 'Close Objectland?' translated;
+ 			createButton: 'Yes -- destroy all projects' translated value: true;
+ 			createButton: 'No -- only close the mascot' translated value: false;
+ 			selectedButtonIndex: 1;
+ 			registerKeyboardShortcuts;
+ 			preferredPosition: self currentHand position;
+ 			getUserResponse)
+ 				ifTrue:
+ 					[[projectMorphs do: [:m | m delete]]
+ 						valueSupplyingAnswer: #('*really want to delete the project*' true).
+ 					projectMorphs := nil]].
+ 	
+ 	^ super outOfWorld: aWorld!

Item was added:
+ ----- Method: ObjectlandMorph>>projectMorphs (in category 'accessing') -----
+ projectMorphs
+ 
+ 	^ projectMorphs!

Item was added:
+ ----- Method: ObjectlandMorph>>startLoading (in category 'loading') -----
+ startLoading
+ 
+ 	factoryState := #loading.
+ 	[self load.
+ 	factoryState := #complete]
+ 		forkAt: Processor userBackgroundPriority!

Item was added:
+ ----- Method: ObjectlandMorph>>step (in category 'stepping') -----
+ step
+ 
+ 	factoryState caseOf: {
+ 		[nil] -> [].
+ 		[#ready] -> [self startLoading].
+ 		[#loading] -> [
+ 			| animVar |
+ 			animVar := (Time millisecondClockValue / 300) sin + 1 / 2.
+ 			self eyeColor: (Color h: 82 s: animVar * 0.8 v:
+ 				(self isGhost ifFalse: [animVar / 2] ifTrue: [1]))].
+ 		[#complete] -> [
+ 			| dAngle |
+ 			self eyeColor: (self isGhost ifFalse: [Color black] ifTrue: [Color white]).
+ 			dAngle := 0.42 degreesToRadians * carouselState y.
+ 			projectMorphs do: [:morph | morph center: (morph center / self world extent
+ 				rotateBy: dAngle about: 0.5 asPoint) * self world extent]].
+ 	}!

Item was added:
+ ----- Method: ObjectlandMorph>>stepTime (in category 'stepping') -----
+ stepTime
+ 
+ 	^ 30!

Item was added:
+ ----- Method: Project>>useOwnChangeSetWithCurrentName (in category '*MorphicExtras-accessing') -----
+ useOwnChangeSetWithCurrentName
+ 
+ 	self setChangeSet: nil.
+ 	self name: self explicitName.
+ 	self explicitName: nil.!

Item was added:
+ ----- Method: Project>>useParentChangeSetButSetProjectName: (in category '*MorphicExtras-accessing') -----
+ useParentChangeSetButSetProjectName: aString
+ 
+ 	self removeChangeSetIfPossible.
+ 	self setChangeSet: ChangeSet current.
+ 	self explicitName: aString.!



More information about the Squeak-dev mailing list