'From Squeak2.9alpha of 16 June 2000 [latest update: #3395] on 3 February 2001 at 3:00:45 am'!
"Change Set:		ProjStore15-tk
Date:			3 February 2001
Author:			Ted Kaehler

Adds items to the Project menu to control whether to use new universal tiles in scriptors, and whether to make the tiles look like old EToy tiles (does nothing yet).
Bugs fixed: 
	New Player was being created on every tile copy!!!!!!
	New script had no tiles in it. (^ self) deleted too aggressively.
	Scripts now unhibernated lazily on redraw (after enter a project).  Maybe new tiles should not be removed when releaseCachedState happens?"!


!CategoryViewer methodsFor: 'get/set slots' stamp: 'tk 2/3/2001 01:57'!
newTilesFor: aPlayer command: aSpec
	| ms argTile argArray sel |
	"Return universal tiles for a command.  Record who self is."

	sel _ aSpec second.
	aSpec size > 3 
		ifTrue: [argTile _ aPlayer tileForArgType: aSpec fourth inViewer: nil.
				argArray _ Array with: (aSpec fourth == #player 
					ifTrue: [argTile actualObject]
					ifFalse: [argTile literal]).	"default value for each type"
				sel == #colorSees ifTrue: [sel _ #color:sees:.  
							argArray _ argArray, argArray].	"two colors"
				sel == #isOverColor ifTrue: [sel _ #seesColor:].
				sel == #touchesA ifTrue: [sel _ #touchesA:].
		]
		ifFalse: [argArray _ #()].
	ms _ MessageSend receiver: aPlayer selector: sel arguments: argArray.
	^ ms asTilesIn: aPlayer class! !


!MethodNode methodsFor: 'tiles' stamp: 'tk 2/3/2001 02:10'!
asMorphicSyntaxUsing: aClass
	
	| morph |
	(morph _ aClass 
		column: #method 
		on: self)
		borderWidth: 0.
	self asMorphicSyntaxIn: morph.
	block _ morph submorphs last.
	block submorphs size = 1 ifTrue: [^ morph].	"keep '^ self' if that is the only thing in method"
	block submorphs last decompile string = '^  self ' ifTrue: [
		block submorphs last delete].
	^ morph! !


!ScriptEditorMorph methodsFor: 'drawing' stamp: 'tk 2/3/2001 02:31'!
drawOn: aCanvas
	| ww |
	"need to unhibernate"

	(ww _ self world) ifNotNil: ["don't hunt agressively for a world"
		(ww valueOfProperty: #universalTiles ifAbsent: [false]) ifTrue: [
			self submorphs size < 2 ifTrue: [
				WorldState addDeferredUIMessage: [self unhibernate] fixTemps]]].
	^ super drawOn: aCanvas! !


!SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 2/3/2001 02:52'!
event: evt arrow: arrowMorph upDown: delta

	| st aList index now want instVar |
	st _ submorphs detect: [:mm | mm isKindOf: StringMorph] ifNone: [^ self].
	(self nodeClassIs: LiteralNode) ifTrue: [ "+/- 1"
		st contents: (self decompile asNumber + delta) printString.
		^ self acceptSilently.	"maybe set parseNode's key"].
	(self nodeClassIs: VariableNode) ifTrue: [ "true/false"
		st contents: (self decompile asString = 'true') not printString.
		^ self acceptSilently.	"maybe set parseNode's key"].

	(self nodeClassIs: SelectorNode) ifTrue: [
		aList _ #(+ - * / // \\ min: max:).
		index _ aList indexOf: self decompile asString.
		index  > 0 ifTrue: [
			self setBalloonText:
				(ScriptingSystem helpStringForOperator: (aList atWrap: index + delta)).
			st contents: (aList atWrap: index + delta).
			^ self acceptSilently].

		aList _ #(= ~= > >= isDivisibleBy: < <=).
		index _ aList indexOf: self decompile asString.
		index  > 0 ifTrue: [
			self setBalloonText:
				(ScriptingSystem helpStringForOperator: (aList atWrap: index + delta)).
			st contents: (aList atWrap: index + 1).
			^ self acceptSilently].

		aList _ #(== ~~).
		index _ aList indexOf: self decompile asString.
		index  > 0 ifTrue: [
			self setBalloonText:
				(ScriptingSystem helpStringForOperator: (aList atWrap: index + delta)).
			st contents: (aList atWrap: index + delta).
			^ self acceptSilently].

		'beep:' = self decompile asString ifTrue: ["replace sound arg"
			self changeSound: delta.
			^ self acceptSilently].
		].
	(self nodeClassIs: SelectorNode) ifTrue: ["kinds of assignment"
		((now _ self decompile asString) beginsWith: 'set') ifTrue:
			["a setX: 3"
			want _ 1+delta.  instVar _ (now allButFirst: 3) allButLast].
		(now endsWith: 'IncreaseBy:') ifTrue: ["a xIncreaseBy: 3 a setX: (a getX +3)."
			want _ 2+delta.  instVar _ now allButLast: 11].
		(now endsWith: 'DecreaseBy:') ifTrue: ["a xDecreaseBy: 3 a setX: (a getX -3)."
			want _ 3+delta.  instVar _ now allButLast: 11].
		(now endsWith: 'MultiplyBy:') ifTrue: ["a xMultiplyBy: 3 a setX: (a getX *3)."
			want _ 4+delta.  instVar _ now allButLast: 11].
		want ifNil: [^ self].
		instVar _ instVar asLowercase.
		want _ #(1 2 3 4) atWrap: want.
		want = 1 ifTrue: [st contents: 'set', instVar capitalized, ':'].	"setter method is present"
		want = 2 ifTrue: [st contents: instVar, 'IncreaseBy:'].
			"notUnderstood will create the method if needed"
		want = 3 ifTrue: [st contents: instVar, 'DecreaseBy:'].
			"notUnderstood will create the method if needed"
		want = 4 ifTrue: [st contents: instVar, 'MultiplyBy:'].
			"notUnderstood will create the method if needed"

		^ self acceptSilently].

! !

!SyntaxMorph methodsFor: 'menus' stamp: 'tk 2/3/2001 02:52'!
acceptSilently
	"Turn my current state into the text of a method.  Compile it in my class.  Don't rebuild the tiles."
	| cls |

	self isMethodNode ifFalse: [
		self rootTile == self ifTrue: [^ self].  "not in a script"
		^ self rootTile acceptSilently  "always accept at the root"].
	(self ownerThatIsA: ScriptEditorMorph) ifNil: [^ self].
	(cls _ self parsedInClass) ifNil: [^ self].
	cls compile: self decompile notifying: nil.

! !


!TheWorldMenu methodsFor: 'construction' stamp: 'tk 2/2/2001 14:52'!
projectMenu
	"Build the project menu for the world."
	| menu |

	menu _ self menu: 'projects...'.
	self fillIn: menu from: { 
		{ 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }.
		{ 'saveAs' . { #myProject . #saveAs } }.
		{ 'see if server version is more recent...' . { #myProject . #loadFromServer } }.
		nil.
		{ #universalTilesString . { self . #toggleTileEra }. 'yes: new tiles in scripts and viewers.
no: old tiles'}.
		{ #largeTilesString . { self . #toggleLargeTiles }. 'yes: tiles in scripts and viewers are tall and green.
no: tiles are short and transparent'}.
		nil.
	}.

	self fillIn: menu from:
		{{'show project hierarchy'. {Project. #showProjectHierarchyInWindow}. 'Opens a window that shows names and relationships of all the projects in your system.'}.
		nil}.

	self mvcProjectsAllowed ifTrue: [
		self fillIn: menu from: {
			{ 'create new mvc project'. { self . #openMVCProject } }.
		}
	].
	self fillIn: menu from: { 
		{ 'create new morphic project' . { self . #openMorphicProject } }.
		nil.
		{ 'go to previous project' . { Project . #returnToPreviousProject } }.
		{ 'go to next project' . { Project . #advanceToNextProject } }.
		{ 'jump to project...' . { #myWorld . #jumpToProject } }.
	}.
	self fillIn: menu from: {
		nil.
		{ 'save project on file...' . { #myWorld . #saveOnFile } }.
		{ 'load project from file...' . { self . #loadProject } }.
	}.
	Preferences simpleMenus ifFalse: [
		self fillIn: menu from: { 
			nil.
			{ 'save for future revert' . { #myProject . #saveForRevert } }.
			{ 'revert to saved copy' . { #myProject . #revert } }.
		}.
	].

	^ menu! !

!TheWorldMenu methodsFor: 'action' stamp: 'tk 2/2/2001 15:03'!
largeTilesString

	^ (myProject parameterAt: #largeTiles ifAbsent: [false]) not
		ifTrue: ['<yes>large tiles']
		ifFalse: ['<no>large tiles']! !

!TheWorldMenu methodsFor: 'action' stamp: 'tk 2/2/2001 15:02'!
toggleLargeTiles
	"tall or small new tiles in scriptors"

	myProject projectParameterAt: #largeTiles put: 
		(myProject parameterAt: #largeTiles ifAbsent: [false]) not! !

!TheWorldMenu methodsFor: 'action' stamp: 'tk 2/2/2001 14:48'!
toggleTileEra
	"old or new tiles in scriptors"

	myWorld setProperty: #universalTiles toValue: 
		(myWorld valueOfProperty: #universalTiles ifAbsent: [false]) not! !

!TheWorldMenu methodsFor: 'action' stamp: 'tk 2/2/2001 15:04'!
universalTilesString
	^ (myWorld valueOfProperty: #universalTiles ifAbsent: [false])
		ifTrue: ['<yes>new tiles in viewers and scripts']
		ifFalse: ['<no>new tiles in viewers and scripts']! !