'From Moshi of 3 March 2007 [latest update: #1422] on 15 June 2010 at 12:25:04 pm'!
"Change Set:		Lesser2-ZG-tk
Date:			3 June 2010
Author:			Ted Kaehler

Experiment to allow viewing of page-specific objects on other pages via a LViewBox.  Used to compose a view from other things in the stack.

Bug (now patched) where the ViewBox is not visible after a page turn.  To see the bug: 
	LDBJrPage new testNewStack4
	(It will ask to put object on card or stack, choose
		This Page only     )
	You are looking at page 2.  The field is the LViewBox we want.  Click next page twice.  It is not there!!  Click where it should be.  It will show up!!

Fixed bug in text insertion point.  mouseUp must send layoutChanged.

To add a nav bar outside of a stack, get an inspector on a costume (box) of a page of a stack and do:
self topContainer add: self stack navBarExternal.

In general say:  (destination add: aStack navBarExternal)

Fixed editScripts in a stack to not wipe out an existing button action or script.

Made Builds able to happen on a page of a stack.  Data stored in a property of the page object (not an LBox).  Builds will survive when a normal playfield is converted to a stack.

"!


!LBoxMenuHandler methodsFor: 'menu commands' stamp: 'tk 6/4/2010 14:07'!
editScripts: event
	"Compile a default method, then put up a MessageSet with it and other scripts."

	| cm aClass editStr mName sel corb pg bh |
	bh :=target componentAt: #ButtonHandler.
	bh ifNotNil: [
		bh  selector = #beep ifFalse: ["already set up"  ^ bh inspect]].
	pg := target stack page.
	cm _ pg isCardTypeMorph: target.
	aClass _ cm ifTrue: [pg class] ifFalse: [pg ouGenericCardClass].
	"give object a proper name"
	mName _ aClass nameForDeepMorph: target cardSide: cm.

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

	"starter script"
	corb _ cm ifTrue: ['card'] ifFalse: ['background'].
	editStr _ mName, ': boxClickedOn mouseUp: clickEvent
	"Script for ', corb, ' object ', mName, ' triggered by mouseUp."

'.
	"compile script"
	sel _ aClass compile: editStr classified: 'scripts'.
	self beStackButton: event.	"target is the button"
	"compile makes class install the trigger in method noteCompilationOf: meta:"
	bh  selector: sel; argument: target.

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


!LBoxBuildHandler methodsFor: 'builds' stamp: 'tk 6/7/2010 15:53'!
restoreStageFrom: array
	"Put my contents objects back to another configuration using the array corresponding to my contents of (sub-object name, position, false if hidden)."


	| ind bx |
	ind := 1.
	array do: [:triple |
		bx := target atName: triple first.
		bx ifNotNil: [
				target reorder: bx beAt: ind.
				ind := ind + 1.
				bx position: triple second.
				bx visible: (triple at: 3)]].

	ind to: target contents size do: [:ii |
		bx := target contents at: ii.
		"hide it, but keep it"
		bx visible: false].
! !


!LBoxBuildHandler class methodsFor: 'as yet unclassified' stamp: 'tk 6/2/2010 17:37'!
initialize: newPage newBkgnd: costume
	"do this when a box is converted to a background in a stack.  Move any build info over to the page."

	(costume valueOfProperty: #buildStages) ifNotNilDo: [:aValue |
		newPage setProperty: #buildStages toValue: aValue.
		costume removeProperty:  #buildStages].
	(costume valueOfProperty: #buildIndex) ifNotNilDo: [:aValue |
		newPage setProperty: #buildindex toValue: aValue.
		costume removeProperty:  #buildIndex].
! !


!LDBJrDemo class methodsFor: 'viewBox composition' stamp: 'tk 6/4/2010 10:39'!
viewOfFld: fldName pagesFwd: pDelta on: hostPage
	"Make a view on this page of the page-specific field on the page that is pDelta pages away."

	| pp bx |
	pp := hostPage stack pageNAfter: pDelta.
	bx := LViewBox on: (pp perform: fldName).
	hostPage backgroundCostume add: bx.
	bx transformation: (MatrixTransform2x3 withScale: 1.0).
	bx position: (pp perform: fldName) position - (0@100).
	LBoxHandleInvoker new installTo: bx.
! !


!LDBJrPage methodsFor: 'go to card' stamp: 'tk 6/14/2010 16:59'!
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.
				self ouGenericCardClass classPool at: #PageTurnInProgress put: true.
				ind <= bkm contents size
					ifTrue: [bkm add: acm afterIndex: ind-1]
					ifFalse: [bkm addLast: acm].
				self ouGenericCardClass classPool at: #PageTurnInProgress put: false.
				(acm isKindOf: LViewBox) ifTrue: [acm viewee invalidRect.
					acm viewee layoutChanged]]
			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"
		].
	bkm worldState requestFullRepaint.
	self doubleCheckPvtCostume.! !

!LDBJrPage methodsFor: 'testing' stamp: 'tk 6/14/2010 14:38'!
testNewStack4
	"Create a new stack from code.  Two backgrounds.  Two fields.
	LDBJrPage new testNewStack4
	"
	| ww crd bkgnd fldBox txt bk button |
	Preferences disable: #cmdGesturesEnabled.
	ww := LesserphicMorph new.
	LWindowHandler installTo: ww window.
	LDropHandler new installTo: ww window.
	ww extent: (480@580) + (100@100).
	bk := LBox extent: 510@500 color: Color white.
		bk instVarNamed: 'contents' put: LCollection new.	
		(bk instVarNamed: 'wholeContents') at: 2 put: bk contents.
	LBoxHandleInvoker installTo: bk.
	LDropHandler new installTo: bk.
	ww window add: bk.
	bk position: 10@10.  bk shape borderWidth: 2.

	LDBJrStack newAround: bk. 
	crd := bk stack page.
	bkgnd := crd ouGenericCardClass.
	crd backgroundName: 'FirstBkgnd'.
	bk contents on: LCollectionInserted to: bkgnd. 
	bk contents on: LCollectionRemoved to: bkgnd. 

	fldBox :=  LWordWrapLayoutF openTextField.
	bk add: fldBox.
	bkgnd card beInCard: fldBox.
	fldBox topLeft: 250 @ 190;  extent: 200@150.
	fldBox shape borderWidth: 1.
	txt := 'Page specific field\\' withCRs.
	fldBox layout selection: (0 to: fldBox contents size +1); charTyped08.	"delete all"
	txt do: [:cc | fldBox layout insertChar: cc asciiValue].

	button :=  LBox newButton: ' Next Page ->'.
	button shape color: Color yellow.
	(LButtonHandler withTarget: bkgnd stack withSelector: #nextCard) installTo: button.
	bk add: button.
	button position: 100@450.
	button shape borderWidth: 1.
	LBoxHandleInvoker installTo: button.
	bkgnd beInBackground: button.

	ww openInWorld.
	bkgnd insertPage.
	LDBJrDemo viewOfFld: fldBox name 
		pagesFwd: -1 on: bkgnd card.

	^ bk! !


!LDBJrPage class methodsFor: 'card and background' stamp: 'tk 6/2/2010 17:31'!
createFinish: newPage
	"new class and background"

	| costume varInfoDict varInfo |
	costume := newPage backgroundCostume.
	varInfoDict := newPage backgroundVarInfo.
	costume contentsNoText do: [:ea | "set inst vars to the values -- morphs"
		varInfo := varInfoDict at: ea name asSymbol.
		newPage perform: varInfo setter with: ea.
		"field data will be stored in card createFinish"].
	costume setProperty: #ouBackground toValue: self.	"note: a class"
	"send the class #stack or #card to get to those"
	"classes that need to do something when a box is converted to a background in a stack"
	#(LBoxBuildHandler ) do: [:clName |
		(Smalltalk at: clName) initialize: newPage newBkgnd: costume].
! !


!LDBJrStack methodsFor: 'add page' stamp: 'tk 6/2/2010 17:20'!
createWith: aBox
	"A new stack, and set this morph up as the first background"

	| crd |
	stackName := 'a stack'.
	ouCardIndex := 0.
	ouFutureCardIndex := 1.
	ouStackVarInfo := IdentityDictionary new.
	crd := LDBJrPage createWith: aBox with: self.
	ouCardArray := OrderedCollection with: crd.
	ouCardIndex := 1.
	modified := true.

	"bkgnd showCard: ouCardIndex     already showing"

	"Install background script that brings the stack to the front"
	crd class installDefaultBkgndScript.! !

!LDBJrStack methodsFor: 'show page' stamp: 'tk 6/3/2010 15:59'!
pageNAfter: delta
	"return the page object (do not show it) that is delta after the current page"

	^ ouCardArray at: (self wrapCardNumber: (ouCardIndex + delta))! !

!LDBJrStack methodsFor: 'user interface' stamp: 'tk 6/3/2010 15:44'!
navBarExternal
	"Create a Nav Bar for a stack (self) that can operate outside the stack"

	| nav |
	nav := self class createNavBar.
	nav contentsDo: [:bb | (self beStackButton: bb selector: nil) target: self].
	^ nav! !


!LWordWrapLayoutF methodsFor: 'rule actions' stamp: 'tk 6/4/2010 11:30'!
buttonUp: anEvent with: letterOrField

	anEvent handled: self.
	client layoutChanged.! !


!LWorldState methodsFor: 'as yet unclassified' stamp: 'tk 6/14/2010 16:58'!
requestFullRepaint

	damageRecorder doFullRepaint! !

LDBJrDemo class removeSelector: #setup1!
LDBJrDemo class removeSelector: #setup1:!
LBoxBuildHandler removeSelector: #initialize:newBkgnd:!