'From Moshi of 3 March 2007 [latest update: #658] on 14 January 2008 at 5:11:57 pm'!
"Change Set:		OmniUser-2-tk
Date:			14 January 2008
Author:			Ted Kaehler

This large set of changes brings OUDo up to a level where it can be used.  'OUDo' is the new name of OmniUser, our HyperCard-in-Squeak.  

Objects inside pages can be removed.  Stacks can be imported from tab-delimited files.
Cmd-LeftArrow goes to prev page.
Cmd-RightArrow goes to next page.
Cmd-1 goes to first page.
Cmd-2 goes to last page.
These only work when no text field has a cursor in it.  Click on the card outside a text field.
See demo stack OUDo-demo.pr in http://tinlizzie.org/share/OUDo/ 
"!


!OUCard commentStamp: 'tk 12/19/2007 00:03' prior: 0!
An OUCard holds info specific to this card and is not a viewable object.  Holds contents of a shared background fields, local morphs, and data in local morphs.  OUCard is an abstract class.  Class variables are the morphs and variables shared by the entire background.

OUCard  = abstract class.
an OUCard23 (subclass of OUCard) = card whose background has fields or scripts, but no card-specific morphs or vars or scripts.  Background scripts are held in OUCard23.  OUCard23 is the generic class for this background.
an OUCardSP9 (subclass of OUCard23) = card with card-specific morphs or vars or scripts.

In scripts, load and store contents of a field with a getter or setter.  When card is showing, setter stores in field with contents:.  When card is not showing, setter stores in card's inst var xxxxData.

cardName
ouCardIndex				my index in stack's ouCardArray.  A cache.

These messages are in every card, implemented in OUCardNN.
self stack
self backgroundName
self backgroundCostume
self backgroundVarInfo

Card morphs must have property #cardSpecific set to true.  Properties #viewOrder and #viewOrderMask must be present (see below).  Morphs are marked sticky.  The grab handle will be missing to avoid accidental removal from the card.

When a morph is removed, what do we do with the instance variable?  Install a value of RemovedMorph with morph, stackname, cardIndex, card class and timestamp.  Later clear them out.  When dropped into another card, clear out old.  (use removedMorph:)

OUCard class instance variable:  different one for each subclass of OUCard.
ouCardVarInfo -- Dictionary of (inst var name symbol  -> OUVarInfo).  See below.
		
------
OUVarInfo
     getter, setter selector, location, kind, 
     data getter, default value
Stack object (inst of OUStack)
     stackName
     ouCardArray 
     ouCardIndex - current showing
     ouStackVarInfo -- dictionary, (name -> OUVarInfo) use perform: to access vars
Class OUStackXX
     <stack inst vars here>
     instance side methods
Card  OUCard  abstract
     cardName
     ouCardIndex
 
OUCard class, class inst vars
      ouCardVarInfo -- dictionary, use perform to access (name -> OUVarInfo) *ONLY* for things specific to this card. <costumePart, plainVariable, cardFieldForText, cardData>.  Empty in generic class, but code needs to talk about it.  (fieldForTextData is in Background's ouBackgroundVars)

OUCardXX   (generic card of this background)
     <inst vars of field data of background objects>
     holds methods for this background
OUCardXX class vars
     (defined anew in each class.  Must use accessors in other methods, since not defined in OUCard.)
	(accessors are on instance side and are not capitalized)
     Stack  (if cards used in diff stacks, make inst var)
     BackgroundName
     BackgroundCostume -- morph that is current card, property #ouBackground -> OUCardXX
     BackgroundVarInfo -- dictionary (name -> OUVarInfo) <fieldForText fieldData costumePart plainVariable, staticFieldForText, staticData>.  
     <inst vars of background objects>

OUCardSPY  (subclass for one card only)
	viewOrder  -- (csel csel bsel csel bsel csel bsel bsel) where sel is getter of a morph
	viewOrderMask -- 'CCBCBCBB' to tell if card or background
    <inst vars have object only seen on this card>
    descriptions in ouCardVarInfo, class inst var defined in OUCard class.
	No class variables in this class.

bkgnd script (in OUCardXX)
     Button1  -- background obj
     self button1  -- same
     self field1Data  -- from current card
     self -- current card (vars and scripts)
     self -- background (vars and scripts)
     BFieldData -- shared field
     BField contents -- shared field
     self script1 -- script in this background
     self script2 -- script on this card only
     Stack -- our stack

card specific script (in OUCardSPY)
     all same as above plus...
     button2 -- on this card
     field2 -- on this card
     field2Data -- on this card
     self script2 -- script on this card only
     self -- current card (vars and scripts)
     self -- background (vars and scripts)
-----
Any morph can be a holder of card-specific data if it implements: #contents #contents:.  (See kindOf:)
Text search is done on the data inst vars that contain a Text or String.  Any deep submorph that implements #contents and returns a Text or String is searched also.  (May need hints to make these go fast.)
-----
Card morph view order:  viewOrder, an inst var in card specific class has Array (csel csel bsel csel bsel csel bsel bsel) sels are getters for both card morphs and bkgnd fields.  viewOrderMask is string of 'CBCCBBC'.  (No viewOrder property in morph.)
     When background field order changes, do not run through cards.  Instead, compute new submorph order when need to display it.  
     Policy: When move bk fld forward Interp as send front bk fld back.  So card morphs migrate forward.  Added field comes just before next known one.  
     Rename of a field is propogated to cards.  Delete of field is propogated.  (easy)
     Order changing commands: Bring forward, push backward, send to back, bring to front.
----!

Object subclass: #OUSearchState
	instanceVariableNames: 'stack card startCard getter container offset backgroundDataGetters gettersIndex keys keyFoundIndex keyTryIndex primaryKey'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'OmniUser'!

!OUSearchState commentStamp: 'tk 11/6/2007 09:47' prior: 0!
Text search in an OUStack:  
Search for a set of fragments.  A fragment is the beginning of a word.
Search for a card that contains all fragments on it somewhere.
Select and highlight the primary key (the first fragment in the list to search for).

Resuming is just like a normal search.  If card has not been nilled by a page turn, and (getter container offset) still points at the primary key, then start the search from that container and offset.

Same as BookMorph text search except:  search directly in the containers.  Rotate key to search on.  

When all keys found on a card, re-find primaryKey, and search on it when user continues a search.

stack	
card		where searching now, or most recently found.  nil if user changed cards.
startCard	where this search began.
getter		current card getter for a data field of text, or nil.
container	current card-specific or deep morph with text that has no getter, or nil.
offset		within container or text
backgroundDataGetters	list of selectors
gettersIndex				one we are searching now
keys				list of fragents.  We change the order.
keyFoundIndex	furthest one found
keyTryIndex		one we are looking for now
primaryKey		user's first key. the one to highlight

[old] User may choose to search again.  To resume a search:
1. Check that the primary key's container is still present. (else treat it as a new search)
2. Check to see that the primary key is still at the offset. (else treat it as a new search)
3. Check that all secondary keys are still in the card. (else treat it as a new search)
4. Search rest of the container for another occurance of the primary key.
5. Search rest of containers on that card.
6. Search the cards till end of stack.
7. Search from page 1 to the page before the start page.
8. Resuming state is cleared when the user leaves the card.
9. Resuming state is cleared when the user changes any search key.

!


!OUStack commentStamp: 'tk 11/17/2007 22:29' prior: 0!
An OUStack holds many cards, which may be of different Backgrounds.  The stack is not a viewable object, and does not have a morph.  The user sees the morph of the current background.  
	A Stack does not have stack-specific morphs, fields, or field data values.  It does have user-defined variables and scripts.  
	Stacks with no variables or scripts are instances of this class.  Others are instances of UniClass subclasses.

stackName 
ouCardArray 	OrderedCollection.
ouCardIndex 
ouFutureCardIndex
ouStackVarInfo -- Dictionary of OUVarInfos that tell about variables.  Variables are inst vars of a stack uniclass.  kinds are only: plainVariable!


!Object methodsFor: 'copying' stamp: 'tk 12/18/2007 20:08'!
veryDeepCopyWith: deepCopier
	"Copy me and the entire tree of objects I point to.  An object in the tree twice is copied once, and both references point to him.  deepCopier holds a dictionary of objects we have seen.  Some classes refuse to be copied.  Some classes are picky about which fields get deep copied."
	| class index sub subAss new uc sup has mine |
	deepCopier references at: self ifPresent: [:newer | ^ newer]. 	"already did him"
	class _ self class.
	class isMeta ifTrue: ["receiver is a class"
		^ (self isSystemDefined not and: [deepCopier newUniClasses "allowed"]) 
			ifTrue: [self copyUniClassWith: deepCopier]
			ifFalse: [self]].
	new _ self clone.
	(class isSystemDefined not and: [deepCopier newUniClasses "allowed"]) ifTrue: [
		uc _ deepCopier uniClasses at: class ifAbsent: [nil].
		uc ifNil: [
			uc _ self copyUniClassWith: deepCopier.
			"does store new copy into references and uniClasses"].
		new _ uc new.
		new copyFrom: self].	"copy inst vars in case any are weak"
	deepCopier references at: self put: new.	"remember"
	(class isVariable and: [class isPointers]) ifTrue: 
		[index _ self basicSize.
		[index > 0] whileTrue: 
			[sub _ self basicAt: index.
			(subAss _ deepCopier references associationAt: sub ifAbsent: [nil])
				ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)]
				ifNotNil: [new basicAt: index put: subAss value].
			index _ index - 1]].
	"Ask each superclass if it wants to share (weak copy) any inst vars"
	new veryDeepInner: deepCopier.		"does super a lot"

	"other superclasses want all inst vars deep copied"
	sup _ class.  index _ class instSize.
	[has _ sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil].
	has _ has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true].
	mine _ sup instVarNames.
	has ifTrue: [index _ index - mine size]	"skip inst vars"
		ifFalse: [1 to: mine size do: [:xx |
				sub _ self instVarAt: index.
				(subAss _ deepCopier references associationAt: sub ifAbsent: [nil])
						"use association, not value, so nil is an exceptional value"
					ifNil: [new instVarAt: index put: 
								(sub veryDeepCopyWith: deepCopier)]
					ifNotNil: [new instVarAt: index put: subAss value].
				index _ index - 1]].
	(sup _ sup superclass) == nil] whileFalse.
	new rehash.	"force Sets and Dictionaries to rehash"
	^ new
! !


!DeepCopier methodsFor: 'full copy' stamp: 'tk 12/17/2007 18:56'!
mapClassVarsInUniMethods
	"redirect class var associations in method literals."

| newValue lits assoc |
uniClasses "values" do: [:newC |
	((newC inheritsFrom: OUCard) or: [newC inheritsFrom: OUStack]) ifTrue: [
	{newC. newC class} do: [:newClass |
		newClass selectorsDo: [:sel | 
			lits _ (newClass compiledMethodAt: sel) literals.
			1 to: lits size do: [:ii |
				assoc _ lits at: ii.
				newValue _ references at: assoc ifAbsent: [nil].
				newValue ifNotNil: [
					newClass methodDictionary at: sel put: 
						(newClass compiledMethodAt: sel) clone.	"were sharing it"
					(newClass compiledMethodAt: sel) literalAt: ii put: newValue]]]]]].
! !

!DeepCopier methodsFor: 'full copy' stamp: 'tk 12/18/2007 19:24'!
mapUniClasses
	"For new Uniclasses, map their class vars to the new objects.  And their additional class instance vars.  (scripts slotInfo) and cross references like (player321)."
	"Players also refer to each other using associations in the References dictionary.  Search the methods of our Players for those.  Make new entries in References and point to them."

| pp newKey pool newP |
newUniClasses ifFalse: [^ self].	"All will be siblings.  uniClasses is empty"
"Uniclasses use class vars to hold onto siblings who are referred to in code"
pp _ Player class superclass instSize.
uniClasses do: [:playersClass | "values = new ones"
	(playersClass inheritsFrom: Player) ifTrue: [
		playersClass classPool associationsDo: [:assoc |
			assoc value: (assoc value veryDeepCopyWith: self)].
		playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self).	"pp+1"
		"(pp+2) slotInfo was deepCopied in copyUniClass and that's all it needs"
		pp+3 to: playersClass class instSize do: [:ii | 
			playersClass instVarAt: ii put: 
				((playersClass instVarAt: ii) veryDeepCopyWith: self)]]].
pool _ nil.
"Make new entries in References and point to them."
references keysDo: [:old |
	(old isPlayerLike and: [old costume ouCardNameLock not]) ifTrue: [
		pool ifNil: [pool _ old costume referenceWorld referencePool].
			newKey _ (newP _ references at: old) uniqueNameForReference.
			"now installed in References"
			newP costume setNameTo: newKey]].
pool ifNotNil: [self mapUniClassMethods: pool].
self mapClassVarsInUniMethods.! !

!DeepCopier methodsFor: 'full copy' stamp: 'tk 12/18/2007 19:48'!
mapUniClassMethods: pool
	"Players also refer to each other using associations in the References dictionary.  Search the literals of the methods of our Players for those.  There are already new entries in project-local References and point to them."
| newKey newAssoc oldSelList newSelList newValue |

uniClasses "values" do: [:newClass |
	oldSelList _ OrderedCollection new.   newSelList _ OrderedCollection new.
	newClass selectorsDo: [:sel | 
		(newClass compiledMethodAt: sel)	 literals do: [:assoc |
			assoc isVariableBinding ifTrue: [
				assoc == (pool associationAt: assoc key ifAbsent: []) ifTrue: ["ours"
					newValue _ references at: assoc value ifAbsent: [].
					newValue ifNotNil: [
						newKey _ newValue externalName asSymbol.
						(assoc key ~= newKey) & (pool includesKey: newKey) ifTrue: [
							newAssoc _ pool associationAt: newKey.
							newClass methodDictionary at: sel put: 
								(newClass compiledMethodAt: sel) clone.	"were sharing it"
							(newClass compiledMethodAt: sel)
								literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc)
								put: newAssoc.
							(oldSelList includes: assoc key) ifFalse: [
								oldSelList add: assoc key.  newSelList add: newKey]]]]]]].
	oldSelList with: newSelList do: [:old :new |
			newClass replaceSilently: old to: new]].	"This is text replacement and can be wrong"! !


!Morph methodsFor: '*connectors-naming' stamp: 'nk 1/23/2004 15:58'!
innocuousName
	"Choose an innocuous name for the receiver -- one that does not end in the word Morph"

	| className allKnownNames |
	className _ self defaultNameStemForInstances.
	(className size > 5 and: [className endsWith: 'Morph'])
		ifTrue: [className _ className copyFrom: 1 to: className size - 5].
	(className size > 2 and: [ className beginsWith: 'NC'])
		ifTrue: [ className _ className copyFrom: 3 to: className size]. "Get rid of NC"

	className _ className asString translated.
	allKnownNames _ self world ifNil: [OrderedCollection new] ifNotNil: [self world allKnownNames].
	^ Utilities keyLike: className asString satisfying:
		[:aName | (allKnownNames includes: aName) not]! !

!Morph methodsFor: 'copying' stamp: 'tk 1/9/2008 13:24'!
veryDeepCopy
	"Do a complete tree copy starting with this morph.  If original was embedded in a card, it has property #cardSpecific.  Copy is not in the card, so remove it."

	| new |
	new _ super veryDeepCopy.
	new removeProperty: #cardSpecific.
	^ new! !

!Morph methodsFor: 'debug and other' stamp: 'tk 11/18/2007 08:15'!
buildDebugMenu: aHand
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu aPlayer aModel |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addStayUpItem.
	(self hasProperty: #errorOnDraw) ifTrue:
		[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
		aMenu addLine].
	(self hasProperty: #errorOnStep) ifTrue:
		[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
		aMenu addLine].

	aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
    aMenu add: 'explore morph' translated target: self selector: #explore.
	aMenu add: 'inspect properties' action: #inspectMorphsProperties.
	aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
	self valueOfProperty: #ouBackground ifPresentDo: [:bk |
		aMenu add: 'explore card & stack' translated 
			target: {bk card. bk. bk stack. bk card class. self} selector: #explore].
	Smalltalk isMorphic ifFalse:
		[aMenu add: 'inspect morph (in MVC)' translated action: #inspect].

	(aModel _ self modelOrNil) ifNotNil:
		[aMenu addLine.
		aMenu add: 'inspect model' translated target: aModel action: #inspect.
		aMenu add: 'explore model' target: aModel action: #explore.
		aMenu add: 'model protocol' target: aModel action: #haveFullProtocolBrowsed].

	(aPlayer _ self player) ifNotNil:
		[aMenu add: 'inspect player' translated target: aPlayer action: #inspect].

	aMenu addLine.
	aPlayer ifNotNil:
		[aMenu add: 'viewer for Player' translated target: self player action: #beViewed.
	aMenu balloonTextForLastItem: 'Opens a viewer on my Player -- this is the same thing you get if you click on the cyan "View" halo handle' translated].

	aMenu add: 'viewer for Morph' translated target: self action: #viewMorphDirectly.
	aMenu balloonTextForLastItem: 'Opens a Viewer on this Morph, rather than on its Player' translated.
	aMenu add: 'morph protocol' translated target: self  selector: #haveFullProtocolBrowsed.

	aMenu addLine.

	self addViewingItemsTo: aMenu.
	aMenu 
		add: 'make own subclass' translated action: #subclassMorph;
		add: 'internal name ' translated action: #choosePartName;
		add: 'save morph in file' translated  action: #saveOnFile;
		addLine;

		add: 'control-menu...' translated target: self selector: #invokeMetaMenu:.

	^ aMenu! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'tk 11/30/2007 15:22'!
aboutToBeGrabbedBy: aHand
	"The receiver is being grabbed by a hand.
	Perform necessary adjustments (if any) and return the actual morph
	that should be added to the hand."
	| extentToHandToHand cmd |

	Smalltalk at: #OUCard ifPresent: [:cls |
		(cls isObsolete not and: [cls~~nil]) ifTrue: [
			(cls askRemoveFromStack: self) ifFalse: [^ nil]]].
		"If in a Stack, warn about losing data on many cards.  ^nil will abort grab"

	self formerOwner: owner.
	self formerPosition: self position.
	cmd _ self undoGrabCommand.
	cmd ifNotNil:[self setProperty: #undoGrabCommand toValue: cmd].
	(extentToHandToHand _ self valueOfProperty: #expandedExtent)
			ifNotNil:
				[self removeProperty: #expandedExtent.
				self extent: extentToHandToHand].
	^self "Grab me"! !

!Morph methodsFor: 'e-toy support' stamp: 'tk 1/7/2008 15:27'!
allMorphsAndBookPagesInto: aSet
	"Return a set of all submorphs.  Don't forget the hidden ones like BookMorph pages that are not showing.  Consider only objects that are in memory (see allNonSubmorphMorphs)." 

	submorphs do: [:m | m allMorphsAndBookPagesInto: aSet].
	self allNonSubmorphMorphs do: [:m | 
			(aSet includes: m) ifFalse: ["Stop infinite recursion"
				aSet add: m.	"Stop a different infinite recursion"
				m allMorphsAndBookPagesInto: aSet]].
	aSet add: self.
	self player ifNotNil:
		[self player allScriptEditors do: [:e | e allMorphsAndBookPagesInto: aSet]].
	^ aSet! !

!Morph methodsFor: 'event handling' stamp: 'tk 1/14/2008 15:06'!
arrowKeyOUStack: anEvent
	"Check if the event is a left or right arrow and if we are a card in a stack and Command key is pressed."

	| asc bkg |
	asc := anEvent keyCharacter asciiValue.
	(asc = 28 or: [asc = 29]) ifTrue: ["arrow keys"
		anEvent commandKeyPressed ifTrue: [
			bkg _ self valueOfProperty: #ouBackground ifAbsent: [^ self].
			asc = 28 ifTrue: ["Left pressed"  bkg stack previousCard].
			asc = 29 ifTrue: ["Right pressed"  bkg stack nextCard]]].! !

!Morph methodsFor: 'event handling' stamp: 'tk 1/14/2008 16:09'!
arrowKeyOUStack: anEvent execute: forReal
	"Check if the event is a left or right arrow, and if we are a card in a stack, and Command key is pressed.  Return boolean.  If forReal is true, then do the action (nextCard or prevCard)."

	| asc bkg ok |
	anEvent commandKeyPressed ifFalse: [^ false].
	asc := anEvent keyCharacter asciiValue.
	ok _ false.
	asc = 28 ifTrue: [ok _ true].
	asc = 29 ifTrue: [ok _ true].
	asc = 49 ifTrue: [ok _ true].
	asc = 52 ifTrue: [ok _ true].
	ok ifFalse: [^ false].
	bkg _ self valueOfProperty: #ouBackground ifAbsent: [^ false].
	forReal ifFalse: [^ true].	"one of ours, but no action.  Just testing"

	asc = 28 ifTrue: ["Left arrow pressed"  bkg stack previousCard].
	asc = 29 ifTrue:  ["Right arrow pressed"  bkg stack nextCard].
	asc = 49 ifTrue: ["^1 First card"  bkg stack showFirstCard].
	asc = 52 ifTrue: ["^4 Last card"  bkg stack showLastCard].
! !

!Morph methodsFor: 'event handling' stamp: 'tk 1/14/2008 15:52'!
handlesKeyboard: evt
	"Return true if the receiver wishes to handle the given keyboard event"

	(self arrowKeyOUStack: evt execute: false) ifTrue: [^ true].
	self eventHandler ifNotNil: [^ self eventHandler handlesKeyboard: evt].
	^ false
! !

!Morph methodsFor: 'event handling' stamp: 'tk 1/14/2008 15:51'!
keyStroke: anEvent
	"Handle a keystroke event.  The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler keyStroke: anEvent fromMorph: self].
	self arrowKeyOUStack: anEvent execute: true.! !

!Morph methodsFor: 'halos and balloon help' stamp: 'tk 12/3/2007 14:53'!
addRoleInStackBeneath: nameInHalo inHalo: halo
	"See if receiver is inside an OUStack.   In the Halo, add a small notation below the name of the object.   'in card' 'is the background' 'in background' 'deep in background' 'deep in card'. Always below name, so may be off screen." 

	| rr st |
	(rr _ self roleInStack) ifNil: [^ self].	"not in a stack"
	st _ (StringMorph new) contents: rr; lock; color: Color gray.
	st position: nameInHalo bottomCenter - (st width //2 -1 @ 0).
	halo addMorph: st.! !

!Morph methodsFor: 'halos and balloon help' stamp: 'tk 12/4/2007 14:40'!
roleInStack
	"See if receiver is inside an OUStack.   Return nil, or 'in card' 'is the background' 'in background' 'deep in background' 'deep in card'. " 
	">>>> tryToRenamePart:to:role: depends on the wording returned here.  If you edit this method, you must also edit tryToRenamePart:to:role:  <<<<<<<"

	| prev str |
	str _ prev _ nil.
	self orOwnerSuchThat: [:oo | 
		(oo hasProperty: #cardSpecific) ifTrue: [
			oo == self ifTrue: [str _ 'in card'] ifFalse: [str _ 'deep in card']].
		str ifNil: [ (oo hasProperty: #ouBackground) ifTrue: [
			oo == self ifTrue: [str _ 'is the background'].
			str ifNil: [ prev == self 
				ifTrue: [str _ 'in background'] ifFalse: [str _ 'deep in background']]]].
		prev _ oo.
		str ~~ nil].
	^ str! !

!Morph methodsFor: 'initialization' stamp: 'tk 12/2/2007 11:26'!
dismissViaHalo
	"The user has clicked in the delete halo-handle.  This provides a hook in case some concomitant action should be taken, or if the particular morph is not one which should be put in the trash can, for example."

	| cmd |
	Smalltalk at: #OUCard ifPresent: [:cls |
		(cls isObsolete not and: [cls~~nil]) ifTrue: [
			(cls askRemoveFromStack: self) ifFalse: [^ nil]]].
		"If in a Stack, warn about losing data on many cards."

	self setProperty: #lastPosition toValue: self positionInWorld.
	self dismissMorph.
	Preferences preserveTrash ifTrue: [ 
		Preferences slideDismissalsToTrash
			ifTrue:[self slideToTrash: nil]
			ifFalse:[TrashCanMorph moveToTrash: self].
	].

	cmd _ Command new cmdWording: 'dismiss ' translated, self externalName.
	cmd undoTarget: ActiveWorld selector: #reintroduceIntoWorld: argument: self.
	cmd redoTarget: ActiveWorld selector: #onceAgainDismiss: argument: self.
	ActiveWorld rememberCommand: cmd! !

!Morph methodsFor: 'initialization' stamp: 'tk 12/2/2007 11:23'!
openInHand
	"Attach the receiver to the current hand in the current morphic world"

	Smalltalk at: #OUCard ifPresent: [:cls |
		(cls isObsolete not and: [cls~~nil]) ifTrue: [
			(cls askRemoveFromStack: self) ifFalse: [^ nil]]].
		"If in a Stack, warn about losing data on many cards."

	self currentHand attachMorph: self! !

!Morph methodsFor: 'menus' stamp: 'tk 11/30/2007 16:49'!
addOUScriptItemTo: aMenu
	"Add 'edit scripts' to the menu if the object is in an Omni-User Stack.  (Different from StackMorph!!)"

	| bkgndM |
	bkgndM _ self orOwnerSuchThat: [:oo | oo hasProperty: #ouBackground].
	bkgndM ifNotNil: [
		aMenu add: 'edit scripts' translated target: (bkgndM valueOfProperty: #ouBackground) 
			selector: #showScriptEditorOn:
			argumentList: (Array with: self).
		aMenu add: 'grab out of card' translated target: self
			selector: #openInHand].
	bkgndM ifNil: [
		aMenu add: 'be a card in a new stack' translated target: OUStack 
			selector: #newAround:
			argumentList: (Array with: self)].
	aMenu addLine.
! !

!Morph methodsFor: 'menus' stamp: 'tk 11/18/2007 09:10'!
addStackItemsTo: aMenu
	"Add stack-related items to the menu"
	| stackSubMenu |
	stackSubMenu _ MenuMorph new defaultTarget: self.
	self valueOfProperty: #ouBackground  ifPresentDo: [:bk | "self is background costume showing a card"
		stackSubMenu add: 'new card' translated target: bk action: #insertCard.
		stackSubMenu add: 'new background' translated target: bk action: #insertBackground.
		stackSubMenu items size > 0 ifTrue: [stackSubMenu addLine].
		stackSubMenu add: 'delete card' translated target: bk action: #deleteCard.
		].
	stackSubMenu items size > 0 ifTrue: [
		aMenu add: 'stacks and cards...' translated subMenu: stackSubMenu].



"###### ancient code #######
 older StackMorph items
	(owner notNil and: [owner isStackBackground]) ifTrue:
		[self isShared
			ifFalse:
				[self couldHoldSeparateDataForEachInstance
					ifTrue:
						[stackSubMenu add: 'Background field, shared value' translated target: self action: #putOnBackground.
						stackSubMenu add: 'Background field, individual values' translated target: self action: #becomeSharedBackgroundField]
					ifFalse:
						[stackSubMenu add: 'put onto Background' translated target: self action: #putOnBackground]]
			ifTrue:
				[stackSubMenu add: 'remove from Background' translated target: self action: #putOnForeground.
				self couldHoldSeparateDataForEachInstance ifTrue:
					[self holdsSeparateDataForEachInstance
						ifFalse:
							[stackSubMenu add: 'start holding separate data for each instance' translated target: self action: #makeHoldSeparateDataForEachInstance]
						ifTrue:
							[stackSubMenu add: 'stop holding separate data for each instance' translated target: self action: #stopHoldingSeparateDataForEachInstance].
							stackSubMenu add: 'be default value on new card' translated target: self action: #setAsDefaultValueForNewCard.
							(self hasProperty: #thumbnailImage)
								ifTrue:
									[stackSubMenu add: 'stop using for reference thumbnail' translated target: self action: #stopUsingForReferenceThumbnail]
								ifFalse:
									[stackSubMenu add: 'start using for reference thumbnail' translated target: self action: #startUsingForReferenceThumbnail]]].
				stackSubMenu addLine].

	(self isStackBackground) ifFalse:
		[stackSubMenu add: 'be a card in an existing stack...' translated action: #insertAsStackBackground].
	stackSubMenu add: 'make an instance for my data' translated action: #abstractAModel.
	(self isStackBackground) ifFalse:
		[stackSubMenu add: 'become a stack of cards' translated action: #wrapWithAStack].
"! !

!Morph methodsFor: 'menus' stamp: 'tk 11/20/2007 17:49'!
addStandardHaloMenuItemsTo: aMenu hand: aHandMorph
	"Add standard halo items to the menu.  Note -- PasteUpMorphs that are serving as Worlds are handled by a separate protocol."

	self addOUScriptItemTo: aMenu.
	Preferences eToyFriendly ifFalse: [self addStackItemsTo: aMenu].
	aMenu addLine.
	self mustBeBackmost ifFalse:
		[aMenu add: 'send rearward' translated action: #goBehindOne.
		aMenu add: 'send to rear' translated action: #goBehind.
		aMenu add: 'bring frontward' translated action: #comeForwardOne.
		aMenu add: 'bring to front' translated action: #comeToFront.
		aMenu addWithLabel: 'embed...' translated enablement: #embedEnabled action: #showEmbedMenu.
		aMenu balloonTextForLastItem: 'present a menu of potential embeddeding targets for this object, and embed it in the one chosen.' translated.
		aMenu addLine].

	self addFillStyleMenuItems: aMenu hand: aHandMorph.
	self addBorderStyleMenuItems: aMenu hand: aHandMorph.
	self addDropShadowMenuItems: aMenu hand: aHandMorph.
	Preferences eToyFriendly ifFalse:
		[self addHaloActionsTo: aMenu.
		self addLayoutMenuItems: aMenu hand: aHandMorph].
	owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph].
	aMenu addLine.
	self addToggleItemsToHaloMenu: aMenu.
	aMenu addLine.
	Preferences eToyFriendly ifFalse: [self addCopyItemsTo: aMenu].
	self addPlayerItemsTo: aMenu.
	Preferences eToyFriendly ifFalse:
		[self addExportMenuItems: aMenu hand: aHandMorph].
	self addMiscExtrasTo: aMenu.
	Preferences eToyFriendly ifFalse: [Preferences noviceMode ifFalse:
		[self addDebuggingItemsTo: aMenu hand: aHandMorph]].
	aMenu addLine.
	self addLockingItemsTo: aMenu.
	aMenu defaultTarget: aHandMorph
! !

!Morph methodsFor: 'meta-actions' stamp: 'tk 11/30/2007 16:10'!
addEmbeddingMenuItemsTo: aMenu hand: aHandMorph
	"Construct a menu offerring embed targets for the receiver.  If the incoming menu is is not degenerate, add the constructed menu as a submenu; in any case, answer the embed-target menu"

	| menu w |
	menu _ MenuMorph new defaultTarget: self.
	w _ self world.
	self potentialEmbeddingTargets reverseDo: [:m |
		menu add: (m == w 
				ifTrue: ['desktop' translated] 
				ifFalse: [m knownName ifNil:[m class name asString]]) 
					target: m selector: #embedChecking: argumentList: {self topRendererOrSelf}.
		m == self topRendererOrSelf owner ifTrue:
			[menu lastItem color: Color red]].
	aMenu ifNotNil:
		[menu submorphCount > 0 
			ifTrue:[aMenu add:'embed into' translated subMenu: menu]].
	^ menu! !

!Morph methodsFor: 'naming' stamp: 'tk 12/18/2007 17:31'!
ouCardNameLock
	"Return true if an OUCard has this morph in a named instance variable.  If so, caller must not change it's name during a veryDeepCopy or for any other reason (except user rename)."

	| bb varInfo |
	(self hasProperty: #cardSpecific) ifTrue: [^ true].
	owner ifNil: [^ false].	"OK to rename"
	bb _ owner valueOfProperty: #ouBackground ifAbsent: [^ false].
	varInfo _ bb backgroundVarInfo.
	Symbol hasInterned: self knownName ifTrue: [:ss |
		^ #(fieldForText costumePart staticFieldForText) includes: 	
				(varInfo at: ss) kind].
	^ false! !

!Morph methodsFor: 'naming' stamp: 'tk 12/4/2007 14:37'!
tryToRenameTo: aName
	"A new name has been submited; make sure it's appropriate, and react accordingly.  This circumlocution provides the hook by which the simple renaming of a field can result in a change to variable names in a stack."

	| aStack roleString |
	(roleString _ self roleInStack) ifNotNil: [
		^ OUCard tryToRenamePart: self to: aName role: roleString].
		"it does the rename"

	(self holdsSeparateDataForEachInstance and: [(aStack _ self stack) notNil])
		ifTrue:
			["old StackMorph"
			self topRendererOrSelf setNameTo: aName.
			aStack reassessBackgroundShape]
		ifFalse:
			["normal case"
			self renameTo: aName]! !

!Morph methodsFor: 'submorphs-accessing' stamp: 'tk 12/19/2007 00:07'!
allNonSubmorphMorphs
	"Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy.  For this stack, all other backgrounds and private card morphs."

	self valueOfProperty: #ouBackground ifPresentDo: [:bb | 
			^ bb stack allNonSubmorphMorphs].

	^ #() 
! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'tk 11/20/2007 19:07'!
comeForwardOne
	"Move the receiver one morph closer in z-order."

	| topRend |
	topRend := self topRendererOrSelf.
	topRend owner ifNotNilDo: [:own | 
		own privateAddMorph: topRend atIndex: ((own submorphs indexOf: topRend) - 1 max: 1)].! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'tk 11/20/2007 19:12'!
goBehindOne
	"Move the receiver one morph further in z-order."

	| topRend |
	topRend := self topRendererOrSelf.
	topRend owner ifNotNilDo: [:own | 
		own privateAddMorph: topRend atIndex: (own submorphs indexOf: topRend) + 2].! !

!Morph methodsFor: '*connectors-embeddings' stamp: 'tk 11/30/2007 16:08'!
embedChecking: aMorph
	"Users has asked that aMorph be embedded in the receiver.  See if this implies removal from a stack."

	aMorph owner == self ifFalse: ["is being moved"
		Smalltalk at: #OUCard ifPresent: [:cls |
			(cls isObsolete not and: [cls~~nil]) ifTrue: [
				(cls askRemoveFromStack: aMorph) ifFalse: [^ nil]]]].
			"If in a Stack, warn about losing data on many cards."

	self addMorphFrontFromWorldPosition: aMorph.! !

!Morph methodsFor: '*connectors-embeddings' stamp: 'tk 11/30/2007 16:08'!
embedInto: evt
	"Embed the receiver into some other morph"
	|  menu target |

	"Not used anymore!!"
	menu _ CustomMenu new.
	self potentialEmbeddingTargets  do: [:m | 
		menu add: (m knownName ifNil:[m class name asString]) action: m].
	target _ menu startUpWithCaption: ('Embed ' translated , self externalName, ' into...' translated).
	target ifNil:[^self].

	target addMorphFrontFromWorldPosition: self.! !


!HaloMorph methodsFor: 'private' stamp: 'tk 12/3/2007 14:51'!
addName
	"Add a name readout at the bottom of the halo."

	| nn |
	Preferences uniqueNamesInHalos ifTrue:
		[target assureExternalName].

	nn _ self addNameBeneath: self basicBox string: target externalName.
	innerTarget addRoleInStackBeneath: nn inHalo: self.
! !


!Object class methodsFor: 'copying' stamp: 'tk 12/17/2007 19:14'!
veryDeepCopyUniclassWith: deepCopier
	"Duplicate the reciever, a uniclass.  Useful when a uniclass with instances has an abstract uniclass.  receiver is the astract superclass.  Test if copy was already made."

	| uc |
	"(self isSystemDefined not and: [deepCopier newUniClasses]) ifFalse: [^ self]."	"already known"
	uc _ deepCopier uniClasses at: self ifAbsent: [nil].
	uc ifNil: [
		uc _ self copyUniClassWith: deepCopier.
		"does store new uniclass into references and uniClasses"].
	^ uc! !


!OmniUserObject class methodsFor: 'uniCLass' stamp: 'tk 1/9/2008 13:14'!
chooseUniqueClassName
	"Upon import, OUCard5SP1 may become OUCard5SP7 while its superclass is renamed OUCard9.  Ugly.  Later: Make them consistant.  Will be slow if 1000 card-specific classes." 
	| i className cn |
	cn _ self name.
	[cn last isDigit] whileTrue: [cn _ cn allButLast].
	"do our own since withoutTrailingDigits takes too much off the end"
	
	i _ 1.
	[className _ (cn, i printString) asSymbol.
	 Smalltalk includesKey: className]
		whileTrue: [i _ i + 1].
	^ className! !

!OmniUserObject class methodsFor: 'uniCLass' stamp: 'tk 11/19/2007 14:19'!
newUniqueClassInstVars: instVarString classInstVars: classInstVarString
	"Create a unique class directly under this class.  Need finer control than Object class gives."

	| aName aClass instVarss extra ii |
	instVarss _ instVarString.
	extra _ self isGeneric ifTrue: ['SP'] ifFalse: [''].
	extra = 'SP' ifTrue: [
			(instVarss beginsWith: 'viewOrder viewOrderMask') ifFalse: [
				instVarss _ 'viewOrder viewOrderMask ', instVarss]]
		ifFalse: [self name last isDigit ifTrue: [
				self error: 'card specific class may not have a subclass']].
	ii _ 1.
	[aName _ (self name, extra, ii printString) asSymbol.
	 Smalltalk includesKey: aName]
			whileTrue: [ii _ ii + 1].

	aClass _ self subclass: aName instanceVariableNames: instVarss 
		classVariableNames: '' poolDictionaries: '' category: self categoryForUniclasses.
	classInstVarString size > 0 ifTrue:
		[aClass class instanceVariableNames: classInstVarString].		"never used"
	^ aClass! !


!OUCard methodsFor: 'accessing' stamp: 'tk 11/20/2007 11:18'!
costume

	^ self backgroundCostume	"a local class var"! !

!OUCard methodsFor: 'accessing' stamp: 'tk 1/10/2008 10:25'!
name
	^ cardName! !

!OUCard methodsFor: 'manage scripts' stamp: 'tk 12/6/2007 16:48'!
acceptButton: evt mouseUp: acceptButton
	"Only works in a scriptEditor type background with the proper fields.  Do not rely on 'self'.  It is not the current card."

	| cls isCard rec sel stk cd editorCD header trigger |
	(self backgroundCostume hasProperty: #scriptEditor) ifFalse: [
		^ self inform: 'must be inside a script editor'].
	editorCD _ self stack card.	"may have been sent to wrong editor card"
	stk _ editorCD object594 stack.
	cd _ stk card.
	cls _ cd class ouGenericCardClass. 	"where background scripts are stored"
	header _ editorCD theScriptData "theScript contents" string copyUpTo: Character cr.
	trigger _ (header findTokens: ' ') atPin: 3.
	trigger last == $: 
		ifTrue: [trigger _ trigger allButLast asSymbol]
		ifFalse: [self inform: 'Second part of message name is not a legal trigger. 
Message will only run when called from another method.'.
			trigger _ nil].

	isCard _ cd isCardTypeMorph: editorCD object594.
	rec _ self wherePutScriptData = 'S' ifTrue: [cls _ stk class. stk] ifFalse: [cd].
	isCard ifTrue: [
		cd class ~~ cls ifTrue: [cls _ cd class] 
				ifFalse: [^ self inform: 'can''t make new card class yet']].
					"fix this. calling code has tried.  User changed to card-specific"
	"compile script"
	sel _ cls compile: editorCD theScriptData classified: 'scripts'.
	trigger ifNil: [^ self].

	"install trigger"
	self wherePutScriptData = 'B' 
		ifTrue: [editorCD object594 on: trigger send: #sendSelector:evt:from: 
					to: cd class withValue: sel] 
		ifFalse: [editorCD object594 on: trigger send: sel to: rec].
! !

!OUCard methodsFor: 'manage scripts' stamp: 'tk 11/25/2007 22:10'!
explainStatusAlternatives
	"Explain the scripting-status alternatives."

	ScriptingSystem putUpInfoPanelFor:(self statusHelpString) title: 'Script Status' translated extent: 800@500! !

!OUCard methodsFor: 'manage scripts' stamp: 'tk 11/26/2007 20:09'!
presentScriptStatusPopUp
	"Put up a menu of status alternatives and carry out the request"

	| reply  menu |
	menu _ MenuMorph new.
	menu add: #mouseDown target: menu selector: #modalSelection: argument: #mouseDown.
	menu add: #mouseStillDown target: menu selector: #modalSelection: argument: #mouseStillDown.
	menu add: #mouseUp target: menu selector: #modalSelection: argument: #mouseUp; addLine.
	menu add: #mouseEnter target: menu selector: #modalSelection: argument: #mouseEnter.
	menu add: #mouseLeave target: menu selector: #modalSelection: argument: #mouseLeave.
	menu add: #mouseEnterDragging target: menu selector: #modalSelection: argument: #mouseEnterDragging.
	menu add: #mouseLeaveDragging target: menu selector: #modalSelection: argument: #mouseLeaveDragging. 	menu addLine.

	menu add: 'what do these mean?' target: menu selector: #modalSelection: argument: #explainStatusAlternatives.

	"(opening			when I am being opened
	 closing			when I am being closed
	 keystroke  "
	
	menu addLine.
	menu addTitle: 'When should this script run?' translated.
	"menu submorphs last delete."
	menu invokeModal.
	reply := menu modalSelection.

	reply == #explainStatusAlternatives ifTrue: [^ self explainStatusAlternatives].

	reply ifNotNil: [self objectNmData: reply]
! !

!OUCard methodsFor: 'manage scripts' stamp: 'tk 10/30/2007 21:53'!
sendSelector: sel evt: event from: targetMorph
	"Only come through this entry rarely.  See acceptButton:mouseUp:.  Run the script of a card object.  Have the current card of this background handle the script.  If this background is not showing, use the card it was compiled with. (or first card of this background in the stack?)  (The issue is, which card's data to use when a field is mentioned.)
	An ellipse wants to run the selector #ellipse:mouseUp: on mouse up.  Want to send this:
	card ellipse: event mouseUp: ellipseMorph
"

	^ self class sendSelector: sel evt: event from: targetMorph! !

!OUCard methodsFor: 'manage scripts' stamp: 'tk 1/10/2008 09:54'!
statusHelpString
	^ '<no trigger> -- run when called by another script
',
"paused -- ready to run all the time
ticking -- run all the time
"
'mouseDown -- run when mouse goes down on me
mouseStillDown -- while mouse still down
mouseUp -- when mouse is released
mouseEnter -- when mouse enters my bounds, with button up
mouseLeave -- when mouse exits my bounds, with button up
mouseEnterDragging -- when mouse enters my bounds, with button down
mouseLeaveDragging -- when mouse exits my bounds, with button down
keyStroke -- run when user presses a key on the keyboard'! !

!OUCard methodsFor: 'add objects' stamp: 'tk 1/10/2008 11:56'!
beInCardFinish: newMorph
	"A new class may have been created for this card.  Self is the new instance.  We have been installed."
	| newName cvi dataVI nameSet |

	self class == self background ouGenericCardClass ifTrue: [
		^ self error: 'card specific info can''t go in generic card var info'].
	newName _ newMorph knownName.
	self class createInstVarAccessorsFor: newName.
	cvi _ OUVarInfo new.
	cvi getter: newName asSymbol.
	cvi setter: (newName, ':') asSymbol.
	cvi level: #card.
	cvi kind: (self kindInCard: newMorph).
	"cvi defaultValue: nil."
	self ouCardVarInfo at: cvi getter put: cvi. 	"save.  specific to this class"
	self card perform: cvi setter with: newMorph.
	cvi kind == #cardFieldForText ifTrue: [
		nameSet _ self class allSelectors asSet as: Set.	"force #ellipse to be equal to 'ellipse'  "
		cvi dataGetter: (self class uniqueNameFor: (cvi getter, 'Contents') notIn: nameSet).
		dataVI _ OUVarInfo new.
		dataVI getter: cvi dataGetter.
		dataVI setter: (dataVI getter, ':') asSymbol.
		dataVI level: #card.
		dataVI kind: #cardData.
		dataVI field: cvi getter.
		dataVI defaultValue: ''.
		self ouCardVarInfo at: dataVI getter put: dataVI.		"save"
		self addInstanceVarNamed: dataVI getter withValue: newMorph contents.
		"maybe later add both inst vars at the same time to save time"
		self class createAccessorCardData: dataVI getter.
		].
! !

!OUCard methodsFor: 'add objects' stamp: 'tk 12/2/2007 11:41'!
beInCard: newMorph

	| nameSet newName crd |
	newMorph beSticky.
	newMorph setProperty: #cardSpecific toValue: true.

	nameSet _ self class allSelectors asSet as: Set.	"force #ellipse to be equal to 'ellipse'  "
	newName _ self class uniqueNameFor: newMorph notIn: nameSet.
	"If not already a one-card class, then make it be one"
	self class == self ouGenericCardClass
		ifTrue: [
			crd _ self createUniUniclassAdding: newName.	"copy values and replace card in stack"
			crd class ouCardVarInfo: IdentityDictionary new.
			]
		ifFalse: ["already card--specific"
			crd _ self.
			crd addInstanceVarNamed: newName withValue: newMorph.
			].
	crd beInCardFinish: newMorph.
! !

!OUCard methodsFor: 'add objects' stamp: 'tk 11/19/2007 19:24'!
checkBackgroundSketch
	"If background has a backgroundSketch, and it is not named, give it a name, and inst var and accessors"

	| bc |
	bc _ self backgroundCostume.
	(bc respondsTo: #backgroundSketch) ifFalse: [^ self].
	bc backgroundSketch ifNil: [^ self].
	(self respondsTo: #backgroundSketch) ifTrue: [
		"in case it changed"
		self backgroundSketch: bc backgroundSketch.
		^ self].
	"add it as a class variable"

	bc backgroundSketch setNamePropertyTo: 'backgroundSketch'.
	self class beInBackground: bc backgroundSketch.
! !

!OUCard methodsFor: 'add objects' stamp: 'tk 11/19/2007 14:30'!
createUniUniclassAdding: newInstVarName
	"Make a new subclass, with added inst var, make inst, copy the data, replace inst in stack and morph"

	| newCard |
	newCard _ (self class newUniqueClassInstVars: newInstVarName classInstVars: '') initialInstance.
	self stack updateCardIndex: self. 	"sets my ouCardIndex"
	newCard copyFrom: self.
	newCard class createInstVarAccessorsFor: 'viewOrder'.
	newCard class createInstVarAccessorsFor: 'viewOrderMask'.
	newCard viewOrder: #().
	newCard viewOrderMask: ''.	"will be filled in when we leave the card"

	"Must find all places where a card is stored!!  Try to be faster than using become:"
	self stack ouCardArray at: ouCardIndex put: newCard.
	^ newCard! !

!OUCard methodsFor: 'add objects' stamp: 'tk 12/7/2007 09:24'!
insertCard

	self class insertCard! !

!OUCard methodsFor: 'add objects' stamp: 'tk 10/30/2007 21:11'!
isCardTypeMorph: aMorph
	"return true if a card-specific morph, or a submorph of one.  A script for this object will be in the most specific subclass.  Return false if object is in background or generic card.
	Ambiguous case of a script for the card -- is it a background script, or only for this card?  Answer true."

	aMorph orOwnerSuchThat: [:oo | 
		(oo hasProperty: #ouBackground) ifTrue: [^ false].
		(oo hasProperty: #cardSpecific) ifTrue: [^ true].
		false "try next owner"].
	^ true "go for most specific, even if there is none"! !

!OUCard methodsFor: 'add objects' stamp: 'tk 11/5/2007 13:59'!
kindInCard: aMorph
	"as a default, decide what role this submorph plays.  Does it have an additional inst var per card for the data?"

	(aMorph respondsTo: #contents:) ifTrue: [^ #cardFieldForText].
	"Later expand this to other holders of per-card data"
	^ #costumePart! !

!OUCard methodsFor: 'go to card' stamp: 'tk 1/9/2008 16:53'!
addPrivateCostume
	"blend in my card-specific morphs"

	| bkm bkSels ind acm where |
	self class isGeneric ifTrue: [^ self].
	self viewOrder size = 0 ifTrue: [^ self].
	"insert front to back, so they get in the right places"
	bkm _ self backgroundCostume.
	bkSels _ self class viewOrderBk asOrderedCollection.
	ind _ 0.
	self viewOrder with: self viewOrderMask do: [:sel :code |
		ind _ ind + 1.
		code == $C 
			ifTrue: ["card specific"
				acm _ self perform: sel.
				ind <= bkm submorphs size
					ifTrue: [bkm privateAddMorph: acm atIndex: ind]
					ifFalse: [bkm addMorphNearBack: acm].
				acm valueOfProperty: #relLoc ifPresentDo: [:delta |
					acm position: delta + bkm position]]
			ifFalse: [
				where _ bkSels indexOf: sel.
				where = 0 ifTrue: [ind _ ind - 1]. 	"keep next at this rank"
				"Do not clean up viewOrder now.  Will be fixed when leave card"
				where = 1 ifTrue: ["all is good" bkSels removeFirst].
				where > 1 ifTrue: [ind _ ind - 1.
						bkSels removeAt: where]]. 	"hope we get in sync again"
		].
	self doubleCheckPvtCostume.! !

!OUCard methodsFor: 'go to card' stamp: 'tk 11/20/2007 17:23'!
deletePrivateCostume

	self backgroundCostume "the morph" submorphs copy doWithIndex: [:mm :ind | 
		"record their positions!!"
		(mm valueOfProperty: #cardSpecific ifAbsent: [false]) ifTrue: [
			mm delete]].! !

!OUCard methodsFor: 'go to card' stamp: 'tk 1/9/2008 16:53'!
doubleCheckPvtCostume
	"A private morph might not have been recorded by saveViewOrder, or was added by a script when the card was not showing.  Verify that every inst var morph is showing, and add any that are not."

	| vo |
	vo _ self viewOrder size > 8 ifTrue: [self viewOrder asSet] ifFalse: [self viewOrder].
	self class ouCardVarInfo do: [:cvarInfo |
		(cvarInfo kind == #cardFieldForText or: 
			[cvarInfo kind == #costumePart]) ifTrue: [
				(vo includes: cvarInfo getter) ifFalse: ["oops!!"
					self backgroundCostume addMorphFront: 
						(self perform: cvarInfo getter).
					self inform: cvarInfo getter, ' had to be added by the catcher.'.]]].
! !

!OUCard methodsFor: 'go to card' stamp: 'tk 11/19/2007 19:35'!
loadFromInstVars
	"load up fields with data stored in this card"

	| mm |
	"debug"
	self stack ouCardIndex = ouCardIndex ifTrue: [self inform: 'loading card that is already showing'].
	self stack ouFutureCardIndex = self stack ouCardIndex ifTrue: [self inform: 'expected different card'].

	self backgroundVarInfo do: [:bvarInfo | "store inst var into morph's contents"
		bvarInfo kind == #fieldForText ifTrue: [
			mm _ self perform: bvarInfo getter. 	"container"
			mm contents: (self perform: bvarInfo dataGetter)]].! !

!OUCard methodsFor: 'go to card' stamp: 'tk 11/19/2007 19:09'!
saveToInstVars
	"field text in background will be lost unless we save it into inst vars of this card"

	| mm |
	self checkBackgroundSketch.	"the way a new submorph can sneak in"
	self backgroundVarInfo do: [:bvarInfo | "set inst var to the value morph contents"
		bvarInfo kind == #fieldData ifTrue: [
			mm _ self perform: bvarInfo field.	"container's name"
			self perform: bvarInfo setter with: mm contents copy]].
	"card specific costume parts (morphs) are already stored"
	self cardMorphs do: [:pm |
		pm setProperty: #relLoc 
			toValue: (pm position - self backgroundCostume position)].
	self saveViewOrder.! !

!OUCard methodsFor: 'go to card' stamp: 'tk 11/20/2007 11:24'!
saveViewOrder
	"preserve the intermixing of card specific objects and background objects.  front to back ordering."

	| sel dict vom |
	self class isGeneric ifTrue: [^ self].
	self viewOrder: (self backgroundCostume submorphs collect: [:mm |
		(sel _ mm knownName) 
			ifNil: [self inform: 'Unknown morph: ', mm printString]
			ifNotNil: [
				sel _ sel asSymbol.	"should be already"
				(self respondsTo: sel) ifFalse: [
					self inform: 'Unknown morph: ', mm printString]].
		sel]).
	dict _ self class ouCardVarInfo.
	vom _ String new: self viewOrder size.
	self viewOrder withIndexDo: [:asel :indd |
		vom at: indd put: ( 
			(dict includesKey: asel) ifTrue: [$C] ifFalse: [$B])].
	self viewOrderMask: vom.! !

!OUCard methodsFor: 'remove objects' stamp: 'tk 1/13/2008 18:24'!
deleteCard
	"remove this card, even if it is not showing.  ask first.  ask if last card in background.  Refuse if last card in stack.  If card-specific, remove class."

	self deleteCardAsk ifFalse: [^ self].	"use said no"
	"remove card"
	"if specific, remove class"
	"if only, and class instanceCount <= 1, delete generic class"
	self deleteCardPvt.
! !

!OUCard methodsFor: 'remove objects' stamp: 'tk 1/13/2008 18:20'!
deleteCardAsk
	"Ask the user about deleting this card.  Warn if last card in background.  Refuse if last card in stack.  Return true if user says OK."

	| stk menu choice |
	menu _ PopUpMenu labelArray: 
		{'Delete card' translated. 'Keep card' translated}.
	choice _ menu startUpWithCaption: 'Really erase the information on this card?'.
	choice = 1 ifFalse: [^ false]. 	

	stk _ self stack.
	stk ouCardArray size = 1 ifTrue: [self inform: 'This is the only card in the stack.  
Use Delete Stack to remove the entire stack.'.
		^ false].
	(stk onlyOneCardIn: self ouGenericCardClass) ifTrue: [
		"user is looking at only card. warn."
		menu _ PopUpMenu labelArray: 
			{'Delete card and background' translated. 'Cancel' translated}.
		choice _ menu startUpWithCaption: 'This is the last card in this background.
Really delete all fields of this background?'.
		choice = 1 ifFalse: [^ false]]. 	
	^ true! !

!OUCard methodsFor: 'remove objects' stamp: 'tk 1/13/2008 18:16'!
deleteCardPvt
	"remove card.  if specific, remove class.  if only, and class instanceCount <= 1, delete generic class.  No asking user -- caller does that"

	self stack deleteCardPvt: self
! !

!OUCard methodsFor: 'remove objects' stamp: 'tk 12/6/2007 11:18'!
deleteClassVarFrom: varInfo
	"delete all trace of the object described in varInfo."

	| dataVI obj genCls |
	obj _ self perform: varInfo getter.
	"test for data accessor"
	genCls _ self ouGenericCardClass.
	varInfo kind == #fieldForText ifTrue: [
		dataVI _ (genCls classPool at: #BackgroundVarInfo) 
						removeKey: varInfo dataGetter.
		self class removeSelector: dataVI getter.
		self class removeSelector: dataVI setter.
		self removeMyInstVarName: dataVI getter].
	varInfo kind == #staticFieldForText ifTrue: [
		dataVI _ (genCls classPool at: #BackgroundVarInfo) at: varInfo dataGetter.
		self deleteClassVarFrom: dataVI].
	(genCls classPool at: #BackgroundVarInfo) removeKey: varInfo getter.
	genCls removeSelector: varInfo getter.
	genCls removeSelector: varInfo setter.
	genCls removeClassVarName: varInfo getter capitalized.

	(obj isMorph and: [obj knownName == varInfo getter]) ifTrue: [
		"a morph.  In case grabbed and used elsewhere"
		obj sticky: false; removeProperty: #cardSpecific].
! !

!OUCard methodsFor: 'remove objects' stamp: 'tk 11/30/2007 11:27'!
deleteInstVarFrom: varInfo
	"delete all trace of the card-specific object described in varInfo."

	| dataVI obj |
	obj _ self perform: varInfo getter.
	"test for data accessor"
	varInfo dataGetter ifNotNil: [
		dataVI _ self ouCardVarInfo at: varInfo dataGetter.
		self deleteInstVarFrom: dataVI].
	self ouCardVarInfo removeKey: varInfo getter.
	self class removeSelector: varInfo getter.
	self class removeSelector: varInfo setter.
	self removeMyInstVarName: varInfo getter.

	(obj isMorph and: [obj knownName == varInfo getter]) ifTrue: [
		"a morph.  In case grabbed and used elsewhere"
		obj sticky: false; removeProperty: #cardSpecific].
! !

!OUCard methodsFor: 'remove objects' stamp: 'tk 11/30/2007 10:32'!
removeCostumePart: aMorph
	"Caller will actually remove the morph.  A card-specific costume part (inst var).  Delete inst var.  Delete varInfo entry.  If holds data, delete that inst var and varInfo entry."

	self deleteInstVarFrom: 
		(self ouCardVarInfo at: aMorph knownName asSymbol 
			ifAbsent: [self inform: 'no inst var for this object!!'. ^ nil]).! !

!OUCard methodsFor: 'remove objects' stamp: 'tk 11/30/2007 11:11'!
removeMyInstVarName: varName
	"Actual inst var may be in this class, or in the generic background superclass (i.e. fieldData of a background field)."

	(self class instVarNames includes: varName) 
		ifTrue: [self class removeInstVarName: varName]
		ifFalse: [self class superclass removeInstVarName: varName].
			"background fieldData while looking at a card-specific card"
! !

!OUCard methodsFor: 'edit objects' stamp: 'tk 1/10/2008 12:51'!
renamePart: oldName to: newName
	"rename the card-specific costume part, a morph, and fix vars dictionary.  Can also handle a simple variable.  See class side message for a background part.  Also renames the dataGetter.  User will need to change uses of this part in scripts."

	| simple oldKey aMorph legal cvi nameSet cls varInfosCard dvi oldDName |
	oldKey _ oldName asSymbol.
	varInfosCard _ self ouCardVarInfo.
	cvi _ varInfosCard at: oldKey 
			ifAbsent: [^ self inform: 'no card variable called ', oldName].
	simple _ (cvi kind == #plainVariable) or: [cvi kind == #cardData].
	aMorph _ self perform: oldKey.
	simple ifFalse: [
		aMorph isMorph ifFalse: [self error: 'need to handle this case']].
	varInfosCard removeKey: oldKey.
	nameSet _ self class allSelectors asSet.		"on the inst side"
		"nameSet addAll: self allClassVarNames. done inside uniqueNameFor:notIn:"
		"might want to check selectors in all subclasses also"
	legal _ self class uniqueNameFor: newName withFirstCharacterDownshifted notIn: nameSet.
	cls _ self class.	"not generic!!"
	cls removeSelectorSilently: cvi getter.	"accessors"
	cls removeSelectorSilently: cvi setter.
	cvi getter: legal asSymbol.
	cvi setter: (cvi getter, ':') asSymbol.
	cls renameSilentlyInstVar: oldName to: cvi getter.
		"value is preserved.  changes the scripts too"
	"crd perform: cvi setter with: aMorph."
	varInfosCard at: cvi getter put: cvi.		"other values unchanged"
	cls createInstVarAccessorsFor: legal.
	cvi dataGetter ifNotNil: [
		dvi _ varInfosCard at: cvi dataGetter.
		dvi field: cvi getter.	"renamed"
		oldDName _ dvi getter.
		cls removeSelectorSilently: dvi getter.	"code uses old field name to get contents"
		cls removeSelectorSilently: dvi setter.
		"rename it to xxxContents"
		varInfosCard removeKey: cvi dataGetter.
		cvi dataGetter: (cvi getter, 'Contents') asSymbol.
		dvi getter: cvi dataGetter.
		dvi setter: (dvi getter, ':') asSymbol.
		varInfosCard at: dvi getter put: dvi.		"new key"
		cls renameSilentlyInstVar: oldDName to: dvi getter.
		"value is preserved.  changes the scripts too"
		cls createAccessorCardData: dvi getter.		"create new code using new field name"
		].
	simple ifFalse: [aMorph setNamePropertyTo: cvi getter].

! !

!OUCard methodsFor: 'copying' stamp: 'tk 12/15/2007 00:14'!
copyUniClassWith: deepCopier
	"my class is a subclass of OUCard.  Return another class just like my class.  Share the costume list."

	^ self class copyUniClassWith: deepCopier! !

!OUCard methodsFor: 'copying' stamp: 'tk 1/8/2008 17:24'!
veryDeepFixupWith: deepCopier

	super veryDeepFixupWith: deepCopier.
! !

!OUCard methodsFor: 'copying' stamp: 'tk 1/8/2008 12:09'!
veryDeepInner: deepCopier
	"Special code that handles user-added instance variables of a uniClass.
	Copy all of my instance variables.  Some need to be not copied at all, but shared.  This is special code for the dictionary.  See DeepCopier."
	| instVar assoc |

	super veryDeepInner: deepCopier.
	1 to: self class instSize do: [:index |
		instVar _ self instVarAt: index.
		(assoc _ deepCopier references associationAt: instVar ifAbsent: [nil])
				"use association, not value, so nil is an exceptional value"
			ifNil: [self instVarAt: index put: (instVar veryDeepCopyWith: deepCopier)]
			ifNotNil: [self instVarAt: index put: assoc value].
		].
! !


!OUCard class methodsFor: 'accessing' stamp: 'tk 11/20/2007 11:22'!
backgroundCostume

	^ self ouGenericCardClass classPool at: #BackgroundCostume
! !

!OUCard class methodsFor: 'accessing' stamp: 'tk 12/18/2007 17:38'!
backgroundVarInfo
	"OUCard does not have a class var BackgroundVarInfo.  It is the database of info about background costume parts and slots (see OUCard comment).  But, every subclass does have one."

	^ self ouGenericCardClass classPool 
			at: #BackgroundVarInfo 
			ifAbsent: [self inform: 'class without BackgroundVarInfo'.
				Dictionary new]! !

!OUCard class methodsFor: 'accessing' stamp: 'tk 10/30/2007 21:18'!
stack
	^ self ouGenericCardClass classPool at: #Stack! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 12/6/2007 11:16'!
addVariable: varName
	"Add a plain variable to this background.  Scripts are on the instance side, but variable is a class variable."

	| nameSet newName vi genCls |
	nameSet _ self allSelectors asSet.		"on the inst side"
		"nameSet addAll: self allClassVarNames. done inside uniqueNameFor:notIn:"
		"might want to check selectors in all subclasses also"
	newName _ (self uniqueNameFor: varName notIn: nameSet) capitalized.
	genCls _ self ouGenericCardClass.
	genCls addClassVarName: newName.
	genCls createInstVarAccessorsFor: newName.
	vi _ OUVarInfo new.
	vi getter: newName withFirstCharacterDownshifted asSymbol.
	vi setter: (vi getter, ':') asSymbol.
	vi level: #background.
	vi kind: #plainVariable.
	"vi defaultValue: nil."
	(genCls classPool at: #BackgroundVarInfo) at: vi getter put: vi. 	"save"
	"value is nil"! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/5/2007 14:01'!
askCardOrBkgnd: newMorph
	"ask user if the new morph is on every card of this background, or only this card"

	| aMenu |
	(self card hasCostumePart: newMorph) ifTrue: [^ self].		"accidental drop of existing part"
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addTitle: 'Put this object on' translated.
	aMenu add: 'all cards of this background' translated target: self
			selector: #beInBackground:
			argumentList: (Array with: newMorph).
	aMenu add: 'this card only' translated target: self card
			selector: #beInCard:
			argumentList: (Array with: newMorph).
	(self kindFor: newMorph) == #fieldForText ifTrue: [
		aMenu add: 'identical label text on all cards' translated target: self
				selector: #beSharedText:
				argumentList: (Array with: newMorph)].
	aMenu addLine.
	aMenu add: 'undo the drop' translated target: ActiveHand world
			selector: #addMorph:
			argumentList: (Array with: newMorph).
	aMenu add: 'oops.  leave as it was' translated target: self
			selector: #yourself.
	aMenu popUpInWorld.
! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/27/2007 23:10'!
askRemoveFromStack: aMorph
	"Warn user that removal of a background Morph will lose data on other cards."

	| cls menu choice gen |
"	true ifTrue: [^ true].	DO NOT REMOVE TILL IT WORKS"
	aMorph owner ifNil: [^ true].	
	gen _ aMorph owner valueOfProperty: #ouBackground ifAbsent: [^ true].
	gen superclass == OUCard ifFalse: [self inform: 'background is a specific class'].
	cls _ gen card class.	"may be specific"
	self == OUCard ifFalse: [
		(self == gen or: [self == cls]) ifFalse: [
			self inform: 'Removing costume part on a non-showing card.']].
			"later test this case"
	(aMorph hasProperty: #cardSpecific) ifTrue: ["don't ask, but do remove inst var"
		"May be a pause -- grab first, then remove inst var??"
		cls card removeCostumePart: aMorph.	"assume it is on the current card"
		^ true].
	(cls stack onlyOneCardIn: gen) ifFalse: [
	 	"user is looking at only card, OK to grab"
		menu _ PopUpMenu labelArray: 
			{'Delete costume part on many cards' translated. 'No.  Leave unchanged' translated}.
		choice _ menu startUpWithCaption: 'This costume part is on several cards.
Really delete it from all cards of this background?'.
		choice = 1 ifFalse: [^ false]]. 	
	cls removeCostumePart: aMorph.
	^ true

! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 1/10/2008 11:56'!
beInBackground: newMorph
	"make a local class variable for it.  A card of this background must be showing."

	| nameSet newName vi dataVI viList genCls |
	newMorph beSticky.
	nameSet _ self allSelectors asSet.		"on the inst side"
		"nameSet addAll: self allClassVarNames. done inside uniqueNameFor:notIn:"
		"might want to check selectors in all subclasses also"
	newName _ (self uniqueNameFor: newMorph notIn: nameSet) capitalized.
	(genCls _ self ouGenericCardClass) addClassVarName: newName.
	genCls createInstVarAccessorsFor: newName.
	vi _ OUVarInfo new.
	vi getter: newName withFirstCharacterDownshifted asSymbol.
	vi setter: (vi getter, ':') asSymbol.
	vi level: #background.
	vi kind: (self kindFor: newMorph).
	"vi defaultValue: nil."
	(viList _ genCls classPool at: #BackgroundVarInfo) at: vi getter put: vi. 	"save"
	self card perform: vi setter with: newMorph.
	vi kind == #fieldForText ifTrue: [
		vi dataGetter: (self uniqueNameFor: (vi getter, 'Contents') notIn: nameSet).
		dataVI _ OUVarInfo new.
		dataVI getter: vi dataGetter.
		dataVI setter: (dataVI getter, ':') asSymbol.
		dataVI level: #background.
		dataVI kind: #fieldData.
		dataVI field: vi getter.
		dataVI defaultValue: ''.
		viList at: dataVI getter put: dataVI.		"save in same background dictionary"
		genCls new "just need any instance" 
			addInstanceVarNamed: dataVI getter 
			withValue: newMorph contents.
		genCls createInstVarAccessorsFieldData: dataVI getter.
		"self card perform: dataVI setter with: newMorph contents."
		].
	"morph does not need any special properties set"
	"installed at front (1) of subMorphs.  User can move near and far.  Where ever it is at store time, it will be recorded in saveViewOrder"
! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 10/30/2007 22:18'!
beSharedText: newMorph
	"make a class variable for it.  Text is not per card, but the same on all cards."

	| nameSet newName vi dataVI viList genCls |
	newMorph beSticky.
	nameSet _ self allSelectors asSet.		"on the inst side"
		"nameSet addAll: self allClassVarNames. done inside uniqueNameFor:notIn:"
		"might want to check selectors in all subclasses also"
	newName _ (self uniqueNameFor: newMorph notIn: nameSet) capitalized.
	(genCls _ self ouGenericCardClass) addClassVarName: newName.
	genCls createInstVarAccessorsFor: newName.
	vi _ OUVarInfo new.
	vi getter: newName withFirstCharacterDownshifted asSymbol.
	vi setter: (vi getter, ':') asSymbol.
	vi level: #background.
	vi kind: (self kindFor: newMorph).	"will change it in a moment"
	"vi defaultValue: nil."
	(viList _ genCls classPool at: #BackgroundVarInfo) at: vi getter put: vi. 	"save"
	self card perform: vi setter with: newMorph.
	vi kind == #fieldForText "about to change this" ifTrue: [
		vi kind: #staticFieldForText. 	"the truth"
		vi dataGetter: (vi getter, 'Data') asSymbol.
		dataVI _ OUVarInfo new.
		dataVI getter: vi dataGetter.
		dataVI setter: (dataVI getter, ':') asSymbol.
		dataVI level: #background.
		dataVI kind: #staticData.
		dataVI field: vi getter.
		dataVI defaultValue: ''.
		viList at: dataVI getter put: dataVI.		"save in same background dictionary"
		genCls addClassVarName: dataVI getter capitalized.
		genCls createAccessorStaticData: dataVI getter capitalized.
		self card perform: dataVI setter with: newMorph contents.
		].
! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 12/4/2007 15:04'!
costumeCloneSimple
	"Return a morph very much like the current costume, with no submorphs, and just a few properties copied."

	| currentMorph aMorph |
	currentMorph _ self card backgroundCostume.
	aMorph _ currentMorph class initializedInstance.
	aMorph color: currentMorph color.
	aMorph fillStyle: currentMorph fillStyle.
	aMorph borderWidth: currentMorph borderWidth.
	aMorph borderColor: currentMorph borderColor.
	aMorph borderStyle: currentMorph borderStyle.
	aMorph bounds: currentMorph bounds.
	aMorph sticky: currentMorph isSticky.
	aMorph renameTo: currentMorph externalName, '2'.	"just a hack"
	^ aMorph
	! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/5/2007 14:21'!
createAccessorStaticData: aName
	"Special accessor methods created.  aName is capitalized.  self is generic class.  A class var is for data of a field shared by all cards of this background.  Data is always the contents of the fieldMorph.  OUVarInfo entries must be present"
	"shared2data  ^ self shared2 contents"
	"shared2data: aString  
		shared2data _ aString.
		self shared2 contents: aString"

	| newMessage cvi bvi list |
	list _ "generic class" classPool at: #BackgroundVarInfo.
	cvi _ list at: aName withFirstCharacterDownshifted asSymbol 
			ifAbsent: [^ self inform: 'bkgnd var info not there'].
	cvi kind == #staticData ifFalse: [^ self inform: 'bkgnd var info not there'].
	bvi _ list at: cvi field.

	newMessage _ cvi getter, '
	"Answer the contents of shared background field ' translated, aName, '"

	^ self ', bvi getter, ' contents'.

	self compile: newMessage classified: 'accessing' notifying: nil.

	newMessage _ cvi setter, ' anObject
	"Store text into shared background field ' translated, aName, '"

	', aName, ' _ anObject' translated, '.
	self ', bvi getter, ' contents: ', 'anObject' translated.

	self compile: newMessage classified: 'accessing' notifying: nil.! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 12/18/2007 17:38'!
createInstVarAccessorsFieldData: aName
	"Special methods created.  Assume inst var is for field data.  (If self is current card, load/store from fieldMorph with contents.  Else load/store the inst var.)"
	"field1data  ^ self stack card == self ifTrue: [self field1 contents] ifFalse: [field1data]"
	"field1data: aString  
		field1data _ aString.
		self stack card == self ifTrue: [self field1 contents: aString]"

	| newMessage setter cvi bvi varInfos |
	varInfos _ self backgroundVarInfo.
	cvi _ varInfos at: aName withFirstCharacterDownshifted asSymbol 
			ifAbsent: [^ self].
	cvi kind == #fieldData ifFalse: [^ self createInstVarAccessorsFor: aName].	"normal"
	bvi _ varInfos at: (cvi field).

	newMessage _ aName asLegalSelector, '
	"Answer the value of ' translated, cvi getter, '"

	^ self stack card == self ifTrue: [self ', bvi getter, ' contents] ifFalse: [', cvi getter, ']'.

	self compile: newMessage classified: 'accessing' notifying: nil.

	setter _ cvi getter asLegalSelector, ':'.
	newMessage _ setter, ' anObject
	"Set the value of ' translated, cvi getter, '"

	', cvi getter, ' _ anObject' translated, '.
	self stack card == self ifTrue: [self ', bvi getter, ' contents: ', 'anObject' translated, ']'.

			self compile: newMessage classified: 'accessing' notifying: nil.! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 12/6/2007 11:10'!
createOUInstVarAccessorsFor: aName
	"Create one of four kinds of getters and setters.  Look for aName in BackgroundVarInfo and cardVarInfo.  If kind is fieldData, use createAccessorFieldData:,  If kind is cardData, use createAccessorCardData:, If kind is staticData, use createAccessorStaticData:, If level is background, make sure aName is capitalized and use super.  Else use super.  OK is self is not the generic class."

	| genCls bvid vi |
	genCls _ self ouGenericCardClass.
	(bvid _ genCls classPool at: #BackgroundVarInfo) ifNotNil: [
		vi _ bvid at: aName withFirstCharacterDownshifted asSymbol ifAbsent: [nil].
		vi ifNotNil: [
			vi kind == #fieldData ifTrue: [^ genCls createAccessorFieldData: aName].
			vi kind == #staticData ifTrue: [^ genCls createAccessorStaticData: aName].
			vi level == #background ifTrue: [
				aName first isUppercase ifFalse: [self error: 'new kind of field data?'].
				^ genCls createInstVarAccessorsFor: aName]. 	"must place in generic class"
			^ super createInstVarAccessorsFor: aName]].
	ouCardVarInfo ifNotNil: [
		vi _ ouCardVarInfo at: aName asSymbol ifAbsent: [nil].
		vi ifNotNil: [
			vi kind == #cardData ifTrue: [^ self createAccessorCardData: aName]]].
	^ super createInstVarAccessorsFor: aName! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 1/13/2008 18:22'!
deleteCard
	"remove the current card.  Warn if last card in background.  Refuse if last card in stack.  If card-specific, remove class."

	| cd |
 	"show next card"
	cd _ self card.
	cd deleteCardAsk ifFalse: [^ self].	"use said no"
	cd stack nextCard.	"show card after this one" 

	"remove card"
	"if specific, remove class"
	"if only, and class instanceCount <= 1, delete generic class"
	cd deleteCardPvt.

! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 12/6/2007 21:13'!
insertCard
	"Create a new card of the same background as the current card.  Place it behind the current card.  Move to the new card.  Fields have default values."

	| stk newCard |
	(stk _ self stack) insetCardPrep.
	newCard _ self ouGenericCardClass new.
	newCard createFinish.
	stk ouCardArray at: stk ouFutureCardIndex put: newCard.

	newCard show.	"sets ouCardIndex"
	^ newCard! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/17/2007 22:33'!
isGeneric
	"Is this the class with no card-specific parts (a background)?"

	^ superclass == OUCard! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/5/2007 13:57'!
kindFor: aMorph
	"as a default, decide whether this submorph is of kind: plainVariable, staticData, staticFieldMorph, fieldForText, costumePart (a normal morph)"

	(aMorph respondsTo: #contents:) ifTrue: [^ #fieldForText].
	"Later expand this to other holders of per-card data"
	^ #costumePart! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 12/6/2007 11:11'!
nameForDeepMorph: aMorph cardSide: isCard
	"This morph may be a deep submorph.  If so, make a legal name and return it.  Not for giving it an inst var, but for giving it a unique script name."

	| trial sel crd |
	trial _ aMorph knownName.
	((trial includes: $<) or: [trial includes: $ ]) ifFalse: [
		crd _ self card.
		sel _ trial asSymbol.
		isCard ifFalse: [(crd backgroundVarInfo) at: sel ifPresent: [:val | 
			(crd perform: sel) == aMorph ifTrue: [^ sel]]].
		isCard ifTrue: [ouCardVarInfo at: sel ifPresent: [:val | 
			(crd perform: sel) == aMorph ifTrue: [^ sel]]]].

	"know name is not in use for a variable.  Not making accessors.  No conflict"
	^ self uniqueNameFor: trial notIn: Set new.
	! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/18/2007 08:29'!
nextCard
	"go to next card and show it"
	self stack nextCard! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/28/2007 00:33'!
removeCostumePart: aMorph
	"Caller will actually remove the morph.  A background costume part (class var).  Delete class var.  Delete varInfo entry.  If holds data, delete that inst var and varInfo entry."

	self card deleteClassVarFrom: 
		((self ouGenericCardClass classPool at: #BackgroundVarInfo) 
				at: aMorph knownName asSymbol 
				ifAbsent: [self inform: 'no class var for this object!!'. ^ nil])
! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 1/10/2008 13:09'!
renamePart: oldName to: newName
	"rename the background costume part, a morph, and fix vars dictionary.  Can also handle a simple variable.  Use instance side message for a card part."

	| simple oldKey aMorph legal cvi crd nameSet genCls varInfos dvi oldDName |
	oldKey _ oldName withFirstCharacterDownshifted asSymbol.
	crd _ self card.
	varInfos _ crd backgroundVarInfo.	"class var, but accessor on inst side"
	cvi _ varInfos at: oldKey 
			ifAbsent: [^ self inform: 'no bkgnd variable ', oldName].
	simple _ (cvi kind == #plainVariable) or: [cvi kind == #fieldData].
	aMorph _ crd perform: oldKey.
	simple ifFalse: [
		aMorph isMorph ifFalse: [self error: 'need to handle this case']].
	varInfos removeKey: oldKey.
	nameSet _ self allSelectors asSet.		"on the inst side"
		"nameSet addAll: self allClassVarNames. done inside uniqueNameFor:notIn:"
		"might want to check selectors in all subclasses also"
	legal _ (self uniqueNameFor: newName notIn: nameSet) capitalized.
	genCls _ self ouGenericCardClass.
	genCls removeSelectorSilently: cvi getter.	"accessors"
	genCls removeSelectorSilently: cvi setter.
	cvi getter: legal withFirstCharacterDownshifted asSymbol.
	cvi setter: (cvi getter, ':') asSymbol.
	genCls removeClassVarName: oldName capitalized.
	genCls addClassVarName: legal.
	varInfos at: cvi getter put: cvi.		"values unchanged"
	genCls createInstVarAccessorsFor: legal.
	cvi dataGetter ifNotNil: [
		dvi _ varInfos at: cvi dataGetter.
		dvi field: cvi getter.	"renamed"
		oldDName _ dvi getter.
		genCls removeSelectorSilently: dvi getter.	"code uses old field name to get contents"
		genCls removeSelectorSilently: dvi setter.
		"rename it to xxxContents"
		varInfos removeKey: cvi dataGetter.
		cvi dataGetter: (cvi getter, 'Contents') asSymbol.
		dvi getter: cvi dataGetter.
		dvi setter: (dvi getter, ':') asSymbol.
		varInfos at: dvi getter put: dvi.		"new key"
		dvi kind == #fieldData 
			ifTrue: [genCls renameSilentlyInstVar: oldDName to: dvi getter]
			ifFalse: ["static text"
				genCls removeClassVarName: oldDName capitalized.
				genCls addClassVarName: dvi getter capitalized].
		genCls createInstVarAccessorsFieldData: dvi getter.		"create new code using new field name"
			"knows if it is inst var or class var"
		].
	crd perform: cvi setter with: aMorph.
	simple ifFalse: [aMorph setNamePropertyTo: cvi getter].	"lowercase"
! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 10/30/2007 21:38'!
sendSelector: sel evt: event from: targetMorph
	"Run the script of a background object.  Have the current card of this background handle the script.  If this background is not showing, use the card it was compiled with. (or first card of this background in the stack?)  (The issue is, which card's data to use when a field is mentioned.)  
	An ellipse wants to run the selector #ellipse:mouseUp: on mouse up.  Want to send this:
	card ellipse: event mouseUp: ellipseMorph
"

	self ouGenericCardClass == self stack card class ouGenericCardClass ifTrue: [
		"Current card has my background"
		^ self stack card perform: sel with: event with: targetMorph].

	^ self perform: sel with: event with: targetMorph! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 12/6/2007 10:49'!
tryToRenamePart: aMorph to: aName role: roleString
	"Rename an existing costume part.  Change the name to a non-conflicting legal selector based on aName.  Do change the morph's name."

	aName = aMorph knownName ifTrue: [^ aName].
	"true ifTrue: [^ aMorph renameTo: aName]." 	"### keep till this works"
	roleString = 'in card' ifTrue: [
		aMorph stack card renamePart: aMorph knownName to: aName.
		^ aMorph knownName].
	roleString = 'in background' ifTrue: [
		aMorph stack background renamePart: aMorph knownName to: aName.
		^ aMorph knownName].
	"  'is the background'  'deep in background' 'deep in card'   "
	^ aMorph renameTo: aName! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 1/10/2008 12:25'!
uniqueNameFor: mm notIn: setOfNames
	"Examine the morph mm and assign it a unique name.  first char is lowercase, but check for uppercase conflict also.  If mm is a String, we are naming a variable.  Self is specific class."

	| unique nn bad |
	nn _ setOfNames size - 4.
	unique _ mm isString ifTrue: [mm] 
		ifFalse: [mm knownName].
	unique _ unique ifNil: [mm class name].
	[unique last isDigit] whileTrue: [unique _ unique allButLast].
	(unique includes: $<) ifTrue: [unique _ mm class name].
	(unique includes: $ ) ifTrue: [unique _ mm class name].
	unique _ unique asLegalSelector.	"also makes first letter lower case"
	[bad _ setOfNames includes: unique.
	 bad _ bad or: [(self bindingOf: unique capitalized asSymbol) notNil].	"class vars and classes"
	 bad] whileTrue: [
		unique _ unique, (nn _ nn + 1) printString.
		unique at: 1 put: (unique first asLowercase)].
	unique _ unique asSymbol.
	mm isString ifFalse: [mm setNamePropertyTo: unique].
	setOfNames add: unique.
	^ unique! !

!OUCard class methodsFor: 'card and background' stamp: 'tk 11/20/2007 11:07'!
viewOrderBk
	"Return an array of selectors of background morphs in front-to-back order.  We depend on names of morphs being lowercase Symbols.  (Card morphs might be present.)"

	^ self backgroundCostume submorphs 
		select: [:mm | (mm hasProperty: #cardSpecific) not]
		thenCollect: [:ea | ea knownName]! !

!OUCard class methodsFor: 'manage scripts' stamp: 'tk 12/6/2007 16:44'!
loadScriptEditorOn: aMorph stub: editStr in: aClass
	"find a script editor, add a card, and install all the info to put a script in this object"

	| se editorBK editorCD me |
	se _ aMorph world submorphThat: [:mm | mm hasProperty: #scriptEditor] 
			ifNone: [^ self inform: 'no script editor in world'].
	"testing current background -- what if that card not showing?  Turn to it..."
	editorBK _ se valueOfProperty: #ouBackground ifAbsent: [^ self].
	editorBK insertCard. 	"and show it"
	editorCD _ editorBK card.
	editorCD object594: aMorph.
	"know card is showing"
	editorCD description contents: (aMorph knownName, ';  ', self card cardName, ';  ', 
		(classPool at: #BackgroundName), ';  ', self stack stackName).
	me _ aClass == self.
	editorCD wherePutScript contents: 
		(me ifTrue: ['B'] ifFalse: [aClass superclass == self ifTrue: ['C'] ifFalse: ['S']]).
	editorCD title contents: 'When to run:'.
	editorCD theScript contents: editStr.
	editorCD backgroundCostume comeToFront.	"show editor to the user"
! !

!OUCard class methodsFor: 'manage scripts' stamp: 'tk 1/10/2008 10:55'!
showScriptEditorOn: aMorph
	"Compile a default method, then put up a MessageSet with it and other scripts."

	| cm aClass editStr mName sel corb |
	cm _ self card isCardTypeMorph: aMorph.
	aClass _ cm ifTrue: [self card class] ifFalse: [self ouGenericCardClass].
	"give object a proper name"
	mName _ aClass nameForDeepMorph: aMorph cardSide: cm.

	"look for existing script"
	sel _ (mName, ':mouseUp:') asSymbol.
	editStr _ aClass sourceCodeAt: sel ifAbsent: [].
	editStr ifNil: [editStr _ aClass superclass sourceCodeAt: sel ifAbsent: []].

	"starter script"
	corb _ cm ifTrue: ['card'] ifFalse: ['background'].
editStr ifNil: [editStr _ mName, ': evt mouseUp: morphClickedOn
	"Script for ', corb, ' object ', mName, ' triggered by mouseUp.  For other triggers, (OUCard new explainStatusAlternatives)"

'.
	"compile script"
	sel _ aClass compile: editStr classified: 'scripts'.
	"install trigger"
	cm not "bkgnd" 
		ifTrue: [aMorph on: #mouseUp send: #sendSelector:evt:from: 
					to: aClass withValue: sel] 
		ifFalse: [aMorph on: #mouseUp send: sel to: self card].
	].

	"Put up a Browser on existing user-defined methods"
	(self showScriptsBrowser) selectedMessageName: sel.
! !

!OUCard class methodsFor: 'manage scripts' stamp: 'tk 1/9/2008 18:36'!
showScriptEditorStackOn: aMorph
	"Script Editor is a special stack.  If a card-specific object, class is most specific card class.  Else the generic card class (for this background).
	OUStack6
	OUCard1	(generic, shared, includes background scripts)
	OUCardDS3	(specific to this card)
	Also show inst vars and values, and background inst vars and values.
Editor is a card in this stack.  add a new one at end of stack.  For now, editor is stand-alone.
	Script fired by this object is in a card class.  Object must have a unique name, suitable to be an inst var name.  Script selector is objectName:mouseUp:.  Set up object to fire that script.  Categories: background, bkgnd object, card, card object, card subObject.
	If this script is the first card-specific thing, causing a new uniClass, how does user indicate this?  Put C into box."

	"old"

	"Is this object's card the current card?  Yes."
	| cm aClass editStr mName |
	cm _ self card isCardTypeMorph: aMorph.
	aClass _ cm ifTrue: [self card class] ifFalse: [self ouGenericCardClass].
	"give object a proper name"
	mName _ aClass nameForDeepMorph: aMorph cardSide: cm.

	"look for existing script"

	"starter script"
	editStr _ mName, ': evt mouseUp: morphClickedOn
	"Script is specific to this object, but stored in card''s class"

	'.
	"Put up a Browser on existing user-defined methods"
	"self showScriptsBrowser."
	"Put up a morph for editing code"
	self loadScriptEditorOn: aMorph stub: editStr in: aClass.	"simple one"
! !

!OUCard class methodsFor: 'manage scripts' stamp: 'tk 1/10/2008 10:52'!
showScriptsBrowser
	"Put up a message set list on the scripts in the card class, generic card class, and stack class"

	| classes messageSet aList catInd cn extra |
	classes _ Array with: self stack class with: self ouGenericCardClass.
	self card class == self ouGenericCardClass ifFalse: [
		classes _ classes, (Array with: self card class)].

	aList _ OrderedCollection new.
	classes do: [:cls |
		(catInd _ cls organization categories indexOf: #scripts) > 0 ifTrue: [
			(cls organization listAtCategoryNumber: catInd) do: [:sel |
				aList add: (MethodReference new setStandardClass: cls 
								methodSymbol: sel)]]
		].

	messageSet _ MessageSet messageList: aList.
	cn _ self card name = 'a card' ifTrue: ['card ', self card ouCardIndex printString]
					ifFalse: [self card name].
	extra _ self stack name = 'a stack' ifTrue: [''] ifFalse: [' in stack ', self stack name].
	^ MessageSet openAsMorph: messageSet name: 'Scripts for ', cn, 
			' and its background', extra.
! !

!OUCard class methodsFor: 'import data' stamp: 'tk 1/11/2008 12:25'!
addCardsFromAFile
	"Using the current background, create new cards by reading in data from a file.  The data are in each record must be tab-delimited.  The data must be in the same order as the front-to-back order of the background text fields. "

	| aFileStream |
	(aFileStream _ FileList2 modalFileSelector) ifNil: [^ Beeper beep].
	self addCardsFromString: aFileStream contentsOfEntireFile
		slotNames: self textGettersInOrder.
	aFileStream close! !

!OUCard class methodsFor: 'import data' stamp: 'tk 1/13/2008 18:58'!
addCardsFromString: aString slotNames: slotNames 
	"Using the current background, add cards from a string, which is expected be tab- and return-delimited"

	| count crd more flds aLine |
	count := 0.
	more _ slotNames copy atAllPut: ''.
	aString asString linesDo: [:aLine1 | 
		aLine1 notEmpty ifTrue: 
			[aLine _ aLine1 copyReplaceAll: '		' "tab tab" with: '	 	' "tab space tab".
			aLine size = aLine1 size ifFalse: [
				aLine1 _ aLine1 copyReplaceAll: '		' "tab tab" with: '	 	' "tab space tab"].
			flds _ aLine findTokens: '	'.
			flds size < slotNames size ifTrue: [
				flds _ flds, more].
			flds size > slotNames size ifTrue: [
				flds _ flds copyFrom: 1 to: slotNames size].
			flds second = ' ' ifFalse: ["special test for this example"
				count := count + 1.
				crd _ self insertCard.
				slotNames with: flds do: [:getter :text | 
					(crd perform: getter "a field morph") contents: text]]]].
	self inform: count asString , ' card(s) added' translated.! !

!OUCard class methodsFor: 'import data' stamp: 'tk 12/6/2007 20:56'!
textGettersInOrder
	"Getters of background fields (not field data).  The current card may have card specific data."

	| vars bvi |
	vars _ self card backgroundVarInfo.
	^ self backgroundCostume submorphs select: [:mm | 
			bvi _ vars at: mm knownName asSymbol ifAbsent: [nil].
			bvi ifNil: [false] ifNotNil: [bvi kind = #fieldForText]]
		thenCollect: [:mm2 | mm2 knownName asSymbol]! !

!OUCard class methodsFor: 'fix up' stamp: 'tk 11/19/2007 14:56'!
fix1

|  |
OUCard allSubclassesDoGently: [:ccc | 
	ccc isGeneric ifFalse: [
		(ccc instVarNames includes: 'viewOrder') ifFalse: [
			ccc addInstVarName: 'viewOrder'.
			ccc addInstVarName: 'viewOrderMask'.
			ccc createInstVarAccessorsFor: 'viewOrder'.
			ccc createInstVarAccessorsFor: 'viewOrderMask'.
			ccc allInstancesDo: [:crd | crd viewOrder: #().
				crd viewOrderMask: ''].	"will be filled in when we leave the card"
			
			]]].
! !

!OUCard class methodsFor: 'fix up' stamp: 'tk 11/20/2007 19:26'!
fix2
	World allMorphsDo: [:mm |
		mm removeProperty: #viewOrder].! !

!OUCard class methodsFor: 'copying' stamp: 'tk 12/17/2007 19:11'!
copyUniClassWith: deepCopier
	"receiver is a subclass of OUCard.  Return another class just like it."

	| newCls newSup |
	newSup _ self superclass.
	self isGeneric ifFalse: [newSup _ self superclass veryDeepCopyUniclassWith: deepCopier].

	newCls _ newSup 
		newUniqueClassInstVars: self instanceVariablesString 
		classInstVars: self class instanceVariablesString.
	deepCopier references at: self put: newCls.
	deepCopier uniClasses at: self put: newCls.
	(self class allInstVarNames at: 8) = 'classPool' ifFalse: [self error: 'Class has new inst vars.  Fix this code'].
	newCls instVarAt: 8 put: (self classPool veryDeepCopyWith: deepCopier).
	newCls copyAddedStateFrom: self.  "All class inst vars for inter Player refs"
	newCls copyMethodDictionaryFrom: self. 	"mapUniClassMethods: will rewrite class var refs.  Does it per class, and the class side too."
	newCls class copyMethodDictionaryFrom: self class.
	newCls ouCardVarInfo: (self ouCardVarInfo veryDeepCopyWith: deepCopier).

	^ newCls
! !

!OUCard class methodsFor: 'uniClass' stamp: 'tk 1/9/2008 06:15'!
baseUniclass
	"see ImageSegment declareAndPossiblyRename:"
	^ self! !


!OUStack methodsFor: 'stack' stamp: 'tk 11/6/2007 15:45'!
allCardsDo: aBlock

	ouCardArray do: [:cc | aBlock value: cc].! !

!OUStack methodsFor: 'stack' stamp: 'tk 11/17/2007 22:30'!
createWith: aMorph
	"A new stack, and set this morph up as the first background"

	| crd |
	stackName _ 'a stack'.
	ouCardIndex _ 0.
	ouFutureCardIndex _ 1.
	ouStackVarInfo _ IdentityDictionary new.
	crd _ OUCard createWith: aMorph with: self.
	ouCardArray _ OrderedCollection with: crd.
	ouCardIndex _ 1.

	"aMorph setProperty: #ouStack toValue: self.  -- hold onto card only"
	"bkgnd showCard: ouCardIndex     already showing"! !

!OUStack methodsFor: 'stack' stamp: 'tk 1/13/2008 16:02'!
deleteAllButOne
	"Delete all cards of this background except the one showing.  Useful when reading a file of data, and you make a mistake."

	| crd cls thisCrdInd newArray |
	crd _ ouCardArray at: ouCardIndex.
	cls _ crd class ouGenericCardClass.
	newArray _ ouCardArray select: [:cc | 
		(cc class == cls or: [cc class superclass == cls])
			ifTrue: [cc == crd]
			ifFalse: [true]].	"other background"
	thisCrdInd _ 0.
	newArray withIndexDo: [:ccc :ind |
		ccc == crd ifTrue: [thisCrdInd _ ind].
		ccc ouCardIndex: ind].
	ouCardArray _ newArray.
	ouCardIndex _ thisCrdInd.
	"same card showing"! !

!OUStack methodsFor: 'stack' stamp: 'tk 1/13/2008 18:16'!
deleteCardPvt: indexOrCard
	"remove a card.  if specific, remove class.  if only, and class instanceCount <= 1, delete generic class.  Do not ask user -- caller does that.  Do not adjust who is showing."

	| only gen crd index |
	index _ indexOrCard isInteger 
		ifTrue: [indexOrCard] 
		ifFalse: [self updateCardIndex: indexOrCard.  indexOrCard ouCardIndex].
	crd _ ouCardArray at: index. 	"error of out of bounds"
	only _ self onlyOneCardIn: (gen _ crd ouGenericCardClass).
	ouCardArray removeAt: index.
	ouCardIndex > index ifTrue: [
		ouCardIndex _ ouCardIndex - 1.
		self card "other" ouCardIndex: ouCardIndex].	"adjust"
	only ifTrue: [gen instanceCount > 1 ifTrue: [only _ false]].
		"In the future, Other stacks may hold one of me"
	
	crd class isGeneric ifFalse: ["card specific, only one, can remove"
		crd cardMorphs do: [:mm | mm delete].
		crd class removeFromSystem].
	only ifTrue: [gen removeFromSystem].	"remove background"! !

!OUStack methodsFor: 'stack' stamp: 'tk 11/17/2007 21:57'!
onlyOneCardIn: genericClass
	"Return true if there is only one card of this background in the stack. Return true for 0 cards also."

	| cnt cd |
	cnt _ 0.
	ouCardIndex to: (ouCardIndex - 1 + ouCardArray size) do: [:ind |
		"start at known card in case all of this background are together"
		cd _ ouCardArray atWrap: ind.
		cd class == genericClass 
			ifTrue: [cnt _ cnt + 1]
			ifFalse: [cd class superclass == genericClass ifTrue: [cnt _ cnt + 1]].
		cnt > 1 ifTrue: [^ false]
		].
	^ cnt <= 1! !

!OUStack methodsFor: 'stack' stamp: 'tk 1/14/2008 16:10'!
showFirstCard

	self showCardNumber: 1! !

!OUStack methodsFor: 'stack' stamp: 'tk 1/14/2008 16:10'!
showLastCard

	self showCardNumber: ouCardArray size! !

!OUStack methodsFor: 'stack' stamp: 'tk 1/13/2008 18:31'!
updateCardIndex: aCard
	"verify or reset the card's index cache"

	| ind |
	aCard ouCardIndex <= ouCardArray size ifTrue: [
		(ouCardArray at: aCard ouCardIndex) == aCard ifTrue: [^ ouCardIndex]].
	"check nearby"
	ind _ ouCardArray indexOf: aCard startingAt: (aCard ouCardIndex - 10 max: 1) ifAbsent: [0].
	ind > 0 ifTrue: [aCard ouCardIndex: ind.  ^ ind].
	"check everywhere"
	(ind _ ouCardArray indexOf: aCard) = 0 ifTrue: [^ 0].
	aCard ouCardIndex: ind.
	^ ind! !

!OUStack methodsFor: 'copying' stamp: 'tk 1/8/2008 17:11'!
allNonSubmorphMorphs
	"Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy.  For this stack, all other backgrounds and private card morphs."

	| nonShowing setOfBackgrounds |
	nonShowing _ IdentitySet new.
	setOfBackgrounds _ IdentitySet new.
	setOfBackgrounds add: self card class.	"assume this background is showing"
	ouCardArray do: [:aCard |
		aCard isString "place holder" ifFalse: [
			(setOfBackgrounds includes: aCard class) ifFalse: [	
				nonShowing add: aCard backgroundCostume.
				setOfBackgrounds add: aCard class].
			aCard class isGeneric ifFalse: [nonShowing addAll: aCard cardMorphs]]].
	^ nonShowing ! !

!OUStack methodsFor: 'accessing' stamp: 'tk 12/6/2007 10:56'!
background
	"Since the card has all of the background accessors, this method will not be used normally"

	^ self card class! !

!OUStack methodsFor: 'accessing' stamp: 'tk 11/16/2007 11:45'!
card

	ouCardIndex = 0 ifTrue: [^ nil].	"creating stack"
	^ ouCardArray atWrap: ouCardIndex! !

!OUStack methodsFor: 'accessing' stamp: 'tk 1/10/2008 10:49'!
name
	^ stackName! !


!OUVarInfo methodsFor: 'as yet unclassified' stamp: 'tk 11/30/2007 15:06'!
printOn: strm

	strm nextPutAll: 'VInfo('; nextPutAll: getter; space; 
		nextPutAll: kind; space; nextPut: level first; nextPut: $).
	! !


!PasteUpMorph methodsFor: 'event handling' stamp: 'tk 1/14/2008 15:52'!
handlesKeyboard: evt

	(self arrowKeyOUStack: evt execute: false) ifTrue: [^ true].
	^self isWorldMorph or:[evt keyCharacter == Character tab and:[self tabAmongFields]]! !

!PasteUpMorph methodsFor: '*siss-interface' stamp: 'tk 12/18/2007 19:22'!
uniqueNameForReferenceFor: aPlayer

	| aName nameSym stem knownClassVars cos |
	(aName _ self uniqueNameForReferenceOrNilFor: aPlayer) ifNotNil: [^ aName].
	(cos _ aPlayer costume) ifNotNil: [
		cos ouCardNameLock ifTrue: [^ cos knownName]].
		"and don't put into references"
	(stem _ aPlayer knownName) ifNil:
		[stem _ aPlayer defaultNameStemForInstances asString].
	stem _ stem select: [:ch | ch isLetter or: [ch isDigit]].
	stem size == 0 ifTrue: [stem _ 'A'].
	stem first isLetter ifFalse:
		[stem _ 'A', stem].
	stem _ stem capitalized.
	knownClassVars _ ScriptingSystem allKnownClassVariableNames.
	aName _ Utilities keyLike: stem satisfying:
		[:jinaLake |
			nameSym _ jinaLake asSymbol.
			 ((self referencePool includesKey: nameSym) not and:
				[(Smalltalk includesKey: nameSym) not]) and:
						[(knownClassVars includes: nameSym) not]].

	self makeReference: aName asSymbol to: aPlayer.
	^ aName! !


!Player methodsFor: 'copying' stamp: 'tk 12/18/2007 23:38'!
copyUniClassWith: deepCopier
	"my class is a subclass of Player.  Return another class just like my class.  Share the costume list."
	
	^ self class copyUniClassWith: deepCopier! !


!Player class methodsFor: 'other' stamp: 'tk 12/18/2007 23:38'!
copyUniClassWith: deepCopier
	"my class is a subclass of Player.  Return another class just like my class.  Share the costume list."
	| newCls |
	newCls _ self officialClass 
		newUniqueClassInstVars: self instanceVariablesString 
		classInstVars: self class instanceVariablesString.
	deepCopier references at: self put: newCls.
	deepCopier uniClasses at: self put: newCls.
	newCls copyMethodDictionaryFrom: self.
	newCls class copyMethodDictionaryFrom: self class.
	newCls scripts: self privateScripts.	"duplicate this in mapUniClasses"
	newCls slotInfo: (self privateSlotInfo veryDeepCopyWith: deepCopier).
	newCls copyAddedStateFrom: self.  "All class inst vars for inter Player refs"
	^ newCls
! !

OUCard class removeSelector: #addStackTypeBeneath:inHalo:!
OUCard class removeSelector: #showScriptEditorStrackOn:!

!OUCard class reorganize!
('accessing' backgroundCostume backgroundVarInfo card ouCardVarInfo ouCardVarInfo: stack)
('card and background' addVariable: askCardOrBkgnd: askRemoveFromStack: beInBackground: beSharedText: collectBkgndVars: costumeCloneSimple createAccessorCardData: createAccessorFieldData: createAccessorStaticData: createAccessorsForAllInstVars createFinish: createInstVarAccessorsFieldData: createOUInstVarAccessorsFor: createWith:with: deleteCard gatherInstVarValues: insertBackground insertCard isGeneric kindFor: nameForDeepMorph:cardSide: nextCard ouGenericCardClass previousCard removeCostumePart: renamePart:to: sendSelector:evt:from: tryToRenamePart:to:role: uniqueNameFor:notIn: viewOrderBk)
('manage scripts' loadScriptEditorOn:stub:in: showScriptEditorOn: showScriptEditorStackOn: showScriptsBrowser)
('import data' addCardsFromAFile addCardsFromString:slotNames: textGettersInOrder)
('fix up' fix1 fix2)
('copying' copyUniClassWith:)
('uniClass' baseUniclass isUniClass officialClass)
!

OUCard removeSelector: #cardMorphsInfoSorted!
OUCard removeSelector: #cardViewOrderAdd:after:bkgndClass:!
OUCard removeSelector: #cardViewOrderAdd:between:and:bkgndClass:!
OUCard removeSelector: #statusHelpStringFor:!
OUCard removeSelector: #viewOrderAfterDeleteAt:!
OUCard removeSelector: #viewOrderAfterInsert:!
OUCard removeSelector: #viewOrderOf:was:isNow:!

!OUCard reorganize!
('accessing' background card cardName cardName: costume morph name ouCardIndex ouCardIndex: ouCardVarInfo ouGenericCardClass)
('manage scripts' acceptButton:mouseUp: explainStatusAlternatives presentScriptStatusPopUp sendSelector:evt:from: statusHelpString)
('add objects' beInCardFinish: beInCard: checkBackgroundSketch createFinish createUniUniclassAdding: hasCostumePart: insertCard isCardTypeMorph: kindInCard: printOn:)
('go to card' addPrivateCostume cardMorphs deletePrivateCostume doubleCheckPvtCostume loadFromInstVars saveToInstVars saveViewOrder show)
('remove objects' deleteCard deleteCardAsk deleteCardPvt deleteClassVarFrom: deleteInstVarFrom: deleteMorph: removeCostumePart: removeMyInstVarName:)
('edit objects' renamePart:to:)
('copying' copyUniClassWith: veryDeepFixupWith: veryDeepInner:)
('== unconverted ==' addVariableOnEveryCard: addVariable: verify)
!


!OmniUserObject class reorganize!
('uniCLass' chooseUniqueClassName isSystemDefined newUniqueClassInstVars:classInstVars:)
!

Morph removeSelector: #addStackTypeBeneath:inHalo:!
Object removeSelector: #veryDeepCopyUniclass:with:!