'From etoys3.0 of 11 February 2008 [latest update: #1894] on 25 February 2008 at 11:54:12 pm'!
"Change Set:		SISSPlayerAndWorkspace-yo
Date:			25 February 2008
Author:			Yoshiki Ohshima

Make it possible to write out an uniclass without its instance.  Also, make it possible to save a project with naked tiles."!


!Object methodsFor: '*sixx-private' stamp: 'yo 2/19/2008 23:34'!
fromSexp: sexp from: from to: to
	| className classObj idref obj cls meta uniId |
	idref := self idrefFromSexp: sexp.
	(obj _ self findIdref: idref context: to) ifNotNil: [^ obj].

	meta _ sexp attributeAt: #metaclass ifAbsent: [''].
	uniId _ sexp attributeAt: #uniclass ifAbsent: [''].
	(uniId ~= '' and: [meta ~= 'true']) ifTrue: [
		cls _ self fromSexp: (from at: uniId asSymbol) from: from to: to.
		(obj _ self findIdref: idref context: to) ifNotNil: [^ obj].
		^ cls sissCreateInstanceFromSexp: sexp idref: idref from: from to: to.
	].
	sexp keyword == #slot ifTrue: [
		className _ sexp attributeAt: #class ifAbsent: [
			^ self fromSexp: (from at: idref) from: from to: to.
		].
	] ifFalse: [
		className _ sexp keyword.
	].
	classObj _ self classFromClassName: className.
	(uniId ~= '' and: [meta = 'true']) ifTrue: [
		classObj _ self uniclassUnder: classObj fromSexp: sexp from: from to: to.
		to addClass: classObj.
		^ classObj
	].
	to addClass: classObj.
	^ classObj sissCreateInstanceFromSexp: sexp idref: idref from: from to: to
! !


!CompoundTileMorph methodsFor: '*siss-interface' stamp: 'yo 2/19/2008 23:54'!
sissComeFullyUpOnReloadFrom: from to: to

	testPart borderWidth: 0; layoutInset: 1; color: Color transparent; height: 10; hResizing: #spaceFill.
	yesPart borderWidth: 0; layoutInset: 2; hResizing: #spaceFill; color: Color transparent.
	noPart borderWidth: 0; layoutInset: 2; hResizing: #spaceFill; color: Color transparent.! !


!PasteUpMorph methodsFor: '*siss-interface' stamp: 'yo 2/20/2008 14:45'!
sissScanObjectsAsEtoysProject

	| dict ret |
	dict _ SISSDictionaryForScanning new initialize.
	self cleanUpReferences.
	dict boundaryObjects add: Utilities scrapsBook.
	Utilities scrapsBook pages do: [:p | dict boundaryObjects add: p].
	worldState ifNotNil: [self hands do: [:h | dict boundaryObjects add: h]].
	ret _ dict sissScanObjectsFrom: self.
	^ ret.
! !

!PasteUpMorph methodsFor: '*siss-interface' stamp: 'yo 2/20/2008 14:58'!
sissWriteValue
	"Override if you wish"

	| new |
	self prepareToBeSaved.
	new _ self clone.
	new privateSubmorphs: (submorphs reject: [:e |
		(e isKindOf: SolidSugarSuppliesTab)
			or: [(e isKindOf: Viewer)
				or: [(e isKindOf: SugarNavTab)
					or: [((e isKindOf: SystemWindow) and: [(e model isKindOf: Workspace) not])
						or: [(e isMemberOf: FlapTab) and: [e isGlobalFlap]]]]]]).
	new instVarNamed: 'presenter' put: nil.
	new instVarNamed: 'worldState' put: nil.
	new privateExtension: self extension copy.
	new extension removeOtherProperties.
	self extension otherProperties keysDo: [:sym |
		(#(commandKeySelectors lastKeystroke locked) includes: sym) ifFalse: [
			new setProperty: sym toValue: (self extension valueOfProperty: sym)
		].
	].

	^ new.
! !


!Player methodsFor: '*siss-interface' stamp: 'yo 2/19/2008 23:23'!
sissContentsInto: newElem context: dictionary
	| cls |
	super sissContentsInto: newElem context: dictionary.
	(self class isUniClass) ifTrue: [
		cls _ self class sissElementInContext: dictionary.
		cls ifNil: [^ self].
		cls attributeAt: #uniclass put: cls idref.
		newElem attributeAt: #uniclass put: cls idref.
	].
! !


!KedamaSequenceExecutionStub methodsFor: '*siss-interface' stamp: 'yo 2/20/2008 16:40'!
sissContentsInto: newElem context: dictionary

	| cls |
	self sissChildrenInto: newElem context: dictionary.
	(self class isUniClass) ifTrue: [
		cls _ self class sissElementInContext: dictionary.
		cls ifNil: [^ self].
		cls attributeAt: #uniclass put: cls idref.
		newElem attributeAt: #uniclass put: cls idref.
		cls attributeAt: #exemplar put: (newElem elements detect: [:e | (e attributeAt: #name) = 'exampler']) idref.
	].
! !


!KedamaTurtleVectorPlayer2 methodsFor: '*siss-interface' stamp: 'yo 2/20/2008 16:40'!
sissContentsInto: newElem context: dictionary

	| cls |
	self sissChildrenInto: newElem context: dictionary.
	(self class isUniClass) ifTrue: [
		cls _ self class sissElementInContext: dictionary.
		cls ifNil: [^ self].
		cls attributeAt: #uniclass put: cls idref.
		newElem attributeAt: #uniclass put: cls idref.
		cls attributeAt: #exemplar put: (newElem elements detect: [:e | (e attributeAt: #name) = 'exampler']) idref.
	].
! !


!ScriptEditorMorph methodsFor: 'serializations' stamp: 'yo 2/20/2008 00:18'!
sissComeFullyUpOnReloadFrom: from to: to

	| sexp isTiles morphs row b o methodNode p |
	(self owner notNil and: [self owner owner notNil and: [self owner owner notNil and: [self owner owner owner isMemberOf: TimesRepeatTile]]]) ifTrue: [^ self].
	(self owner notNil and: [self owner owner notNil and: [self owner owner isKindOf: CompoundTileMorph]]) ifTrue: [^ self].
	sexp _ self valueOfProperty: #script.
	self removeProperty: #script.
	b _ bounds.
	o _ owner.
	p _ playerScripted.
	self initialize.
	bounds _ b.
	owner _ o.
	playerScripted _ p.
	sexp ifNil: [^ self].
	self setMorph: playerScripted costume scriptName: (sexp attributeAt: #scriptName) asSymbol.

	isTiles _ (sexp attributeAt: #language ifAbsent: ['Squeak']) = 'Etoys'.
	isTiles ifTrue: [
		morphs _ (ScriptEditorMorphBuilder context: to playerScripted: playerScripted topEditor: self) fromSexp: (sexp elements detect: [:e | e keyword = #sequence] ifNone: []).
		morphs do: [:e |
			row _ self addNewRow.
			row addMorph: e.
		].
		self install.
	] ifFalse: [
		methodNode _ ParseNodeBuilder new script: sexp with: to in: playerScripted costume referenceWorld.
		playerScripted class addSelectorSilently: methodNode selector withMethod: (methodNode generate: #(0 0 0 0)).
		"playerScripted class compileSilently: code classified: 'scripts'."
		self userScriptObject becomeTextuallyCoded.
		(self submorphs copyFrom: 2 to: self submorphs size) do: [:m | m delete].
		self showSourceInScriptor.
		(playerScripted class scripts at: scriptName) currentScriptEditor: self.
		"(self class scripts at: scriptName) formerScriptingTiles self."
	].
	super sissComeFullyUpOnReloadFrom: from to: to.
! !

!ScriptEditorMorph methodsFor: 'serializations' stamp: 'yo 2/19/2008 12:11'!
sissExportSpecification
	^ playerScripted ifNotNil: [#(('bounds' #bounds)
		('owner' #owner)
		('playerScripted' #playerScripted)
		)] ifNil: [#()].
! !


!SISSDictionaryForScanning methodsFor: 'all' stamp: 'yo 2/19/2008 11:47'!
sissScanObjectsFrom: object

	| ret n child |

	ret _ object sissElementInContext: self.

	ret ifNil: [^ self sissScanObjectsFrom: nil].

	ret isString ifTrue: [
		"if object is just a literal, make up an element and return it."
		n _ SExpElement keyword: object class name.
		n attributeAt: #value put: ret.
		^ n
	].

	"Final fix up for scriptors."
	self keys do: [:e |
		(e isMemberOf: ScriptEditorMorph) ifTrue: [
			e playerScripted ifNotNil: [
				child _ e sexpScriptWith: self.
				(self at: e) addElements: (Array with: child).
			].
		]
	].
	^ self contents
! !


!SISSDictionaryForGuideBook methodsFor: 'all' stamp: 'yo 2/20/2008 00:25'!
sissScanObjectsFrom: book

	| ret n child object |

	object _ (book pages copyWith: book color).

	ret _ object sissElementInContext: self.

	ret ifNil: [^ self sissScanObjectsFrom: nil].

	ret isString ifTrue: [
		"if object is just a literal, make up an element and return it."
		n _ SExpElement keyword: object class name.
		n attributeAt: #value put: ret.
		^ n
	].

	book world player ifNotNil: [self forceAdd: book world player].

	"Final fix up for scriptors."
	self keys do: [:e |
		(e isMemberOf: ScriptEditorMorph) ifTrue: [
			e playerScripted ifNotNil: [
				child _ e sexpScriptWith: self.
				(self at: e) addElements: (Array with: child).
			].
		]
	].
	^ self contents
! !


!SystemWindow methodsFor: '*siss-interface' stamp: 'yo 2/20/2008 14:34'!
sissExportSpecification

	^ #(('bounds' #bounds)
		('owner' #owner)
		('label' #label)
		('model' #model)
	)
! !


!SystemWindow class methodsFor: '*siss-private' stamp: 'yo 2/20/2008 14:59'!
sissCreateInstanceFromSexp: sexp idref: idref from: from to: to

	| model w contents dict |

	dict _ self sissSlotsFromSexp: sexp from: from to: to.
	model _ dict at: #model ifAbsent: [].

	model ifNotNil: [
		(model isMemberOf: Workspace) ifTrue: [
			model embeddedInMorphicWindowLabeled: (dict at: #label).
			model sissSetContents: model contents.
		].
		w _ model dependents detect: [:e | e isMemberOf: SystemWindow] ifNone: [nil].
		w privateOwner: (dict at: #owner).
		w ifNotNil: [
			w bounds: (dict at: #bounds).
			idref ifNotNil: [to at: idref put: w].
			^ w.
		].
	] ifNil: [
		contents _ dict at: #contents ifAbsent: [].
		w _ contents embedInWindow.
		w privateOwner: (dict at: #owner).
		w bounds: (self fromSexp: (sexp elements detect: [:e | e keyword = #slot and: [(e attributeAt: #name) = #bounds]]) from: from to: to).
		idref ifNotNil: [to at: idref put: w].
		^ w.
	].
	w _  SystemWindow new.
	w privateOwner: (dict at: #owner).
	idref ifNotNil: [to at: idref put: w].
	^ w.
! !


!TimesRepeatTile methodsFor: 'code generation' stamp: 'yo 2/20/2008 00:04'!
sissComeFullyUpOnReloadFrom: from to: to

	whatToRepeatPart borderWidth: 0; layoutInset: 0; hResizing: #spaceFill;
		vResizing: #shrinkWrap;
		color: Color transparent;
		setNameTo: 'Script to repeat'.! !


!Workspace methodsFor: 'accessing' stamp: 'yo 2/20/2008 13:13'!
bindings

	^ bindings
! !

!Workspace methodsFor: 'object fileIn' stamp: 'yo 2/20/2008 14:19'!
sissExportSpecification

	^ #(('contents' #sissGetContents)
		('bindings' #bindings)
		('acceptDroppedMorphs' #acceptsDroppingMorphForReference)
	)! !

!Workspace methodsFor: 'object fileIn' stamp: 'yo 2/21/2008 16:26'!
sissGetContents

	| textMorph |
	textMorph _ self dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [nil].
	textMorph notNil ifTrue: [^ textMorph textMorph paragraph text].

	^ ''.
! !

!Workspace methodsFor: 'object fileIn' stamp: 'yo 2/20/2008 14:31'!
sissSetContents: aText

	| textMorph |
	textMorph _ self dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [nil].
	textMorph notNil ifTrue: [textMorph setText: aText asText].
! !


!Workspace class methodsFor: 'instance creation' stamp: 'yo 2/20/2008 15:23'!
sissCreateInstanceFromSexp: sexp idref: idref from: from to: to

	| b dict bindings |
	b _ self new.
	idref ifNotNil: [to at: idref put: b].
	dict _ self sissSlotsFromSexp: sexp from: from to: to.
	bindings _ dict at: #bindings ifAbsent: [].
	bindings ifNotNil: [b setBindings: bindings].
	b contents: (dict at: #contents).
	b acceptsDroppingMorphForReference: (dict at: #acceptDroppedMorphs).
	^ b.
! !

Workspace removeSelector: #contents!
Workspace removeSelector: #getContents!

!SISSDictionaryForGuideBook reorganize!
('all' sissScanObjectsFrom:)
!


!ScriptEditorMorph reorganize!
('access' enforceImplicitSelf generateParseNodeDirectly morph myMorph printOn: scriptContainer scriptInstantiation viewerTile)
('buttons' chooseFrequency chooseTrigger destroyScript dismiss editMethodDescription hasParameter install installWithNewLiteral makeIsolatedCodePane playerScripted restoreScriptName: scriptee scriptName scriptTitle setupMethodMorph showSourceInScriptor tryMe updateStatus updateStatusMorph:)
('caching' releaseCachedState resetHandWithTile)
('copying' veryDeepFixupWith: veryDeepInner:)
('drawing' drawOn:)
('dropping/grabbing' acceptDroppingMorph:event: assureParameterTilesValid indexOfMorphAbove: prepareToUndoDropOf: removeDropSpaces removeSpaces repelsMorph:event: startTracking stopTracking trackDropZones wantsDroppedMorph:event: willingToBeDiscarded)
('event handling' comeFullyUpOnReload: handlesMouseOverDragging: handlesMouseOver: mouseEnterDragging: mouseEnter: mouseLeaveDragging: mouseLeave:)
('e-toy support' adaptToWorld: isCandidateForAutomaticViewing isTileEditor localeChanged objectViewed replaceReferencesToSlot:inPlayer:with:)
('frequency' setFrequencyTo: typeInFrequency)
('initialization' defaultBorderWidth defaultColor initialize phrase: playerScripted: setMorph: setMorph:scriptName: updateHeader updateToPlayer:)
('initialize buttons' addDismissButtonTo: addYesNoToHand buttonRowForEditor handUserNumericConstantTile replaceRow1)
('layout' minHeight)
('menu' autoFitOnOff autoFitString fixLayout fixLayoutOfSubmorphsNotIn: sexpScriptWith:)
('menu commands' addCommandFeedback: findObject openObjectsViewer)
('menus' addCustomMenuItems:hand: wantsHaloHandleWithSelector:inHalo:)
('objects from disk')
('other' addGoldBoxItemsTo: addParameter becomeTextuallyCoded ceaseHavingAParameter codeString extent: handUserButtonDownTile handUserButtonUpTile handUserFunctionTile handUserParameterTile handUserRandomTile handUserTileForSelf handUserTimesRepeatTile hasKedamaTurtlePlayer hasScriptInvoking:ofPlayer: hasScriptReferencing:ofPlayer: hibernate insertUniversalTiles insertUniversalTilesForClass:selector: isEmpty isTextuallyCoded methodNodeMorph methodString modernize offerScriptorMenu offerSimplerScriptorMenu parseNodeWith: recompileScript recreateScript reinsertSavedTiles: renameScript renameScriptTo: revertScriptVersion scriptParseNodeIn: setScriptNameTo: setTimeStamp sexpWith: showingCarets showingCaretsString storeCodeOn:indent: tearOfButtonToFireScript tileRows timeStamp toggleShowingCarets toggleWhetherShowingTiles unhibernate userScriptObject)
('save & revert' revertToTileVersion savedTileVersionsCount saveScriptVersion)
('scripting' bringUpToDate fixUpCarets isTileScriptingElement)
('submorphs-accessing')
('submorphs-add/remove' dismissViaHalo)
('testing' setParameterType: stepTime typeForParameter)
('textually-coded scripts' showingMethodPane showingMethodPane:)
('tiles from method' fromExistingMethod:forPlayer:)
('*customevents-buttons' actuallyDestroyScript methodNode)
('*customevents-other' explainStatusAlternatives)
('private' addNewRow insertTileRow:after: removeEmptyRows rowInsertionIndexFor: scriptEdited)
('serializations' sissComeFullyUpOnReloadFrom:to: sissExportSpecification sissInitializeFrom:from:to:)
('gold box' goldBoxMenu offerGoldBoxMenu)
!


!CompoundTileMorph reorganize!
('access' associatedPlayer labelMorphs myMorph scriptee)
('code generation' blockNodeElements:with: blockNode:with: codeString parseNodeWith: parseNodeWith:asStatement: sexpBlockElementsFor:with: sexpBlockFor:with: sexpWith: storeCodeBlockFor:on:indent: storeCodeOn:indent:)
('dropping/grabbing' asEmptyPermanentScriptor wantsDroppedMorph:event:)
('e-toy support' isTileEditor)
('event handling' handlesMouseDown: handlesMouseOverDragging: handlesMouseOver: mouseDown: mouseEnterDragging: mouseEnter: mouseLeaveDragging: mouseLeave:)
('initialization' defaultBorderWidth defaultColor delegatingMouseEnter: fixUponLoad:seg: initialize unhibernate updateWordingToMatchVocabulary)
('layout' acceptDroppingMorph:event: justAddedAsTileRow)
('miscellaneous' aboutToBeAcceptedInScriptor addCommandFeedback: install justDroppedInto:event: justGrabbedFromViewer justGrabbedFromViewerOrNil justGrabbedFromViewer: recompileScript removeHighlightFeedback resultType rowOfRightTypeFor:forActor: scriptEdited tileRows tile:isOnLineAfter: type)
('mouse' prepareToUndoDropOf: targetPartFor:)
('testing' isTileScriptingElement)
('*siss-interface' sissComeFullyUpOnReloadFrom:to:)
!