'From Moshi of 3 March 2007 [latest update: #1015] on 11 September 2009 at 12:14:52 pm'!
"Change Set:		LDBJr-C-tk
Date:			11 September 2009
Author:			Ted Kaehler

Control click puts on the halo, or removes it.
Added menu items for creating a new button, creating a new text field, and explore of the LBox.  
Removing a halo also removes the current menu.
Color choosing uses the Morphic picker.
If LBox is in a stack, extra menu items show.  Including exploring the current page, background, or stack.
Incorporates bugs that Alex found in leftover LDBJr script code.
Cmd-left and right arrows now turn the page in a stack.

"!

LEventHandler subclass: #LWordWrapLayoutPre
	instanceVariableNames: 'inset client tellQueueOwner font selection selectionAnchor caret tabArray undoStack lastTypeInTransaction maxHeight missingHeight textBox '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'LObjects'!

!LBox methodsFor: 'collection' stamp: 'tk 9/2/2009 13:09'!
boxAt: index
	"fetch the box, not the translator"

	^ (contents at: index) box
! !

!LBox methodsFor: 'shape' stamp: 'tk 9/8/2009 15:39'!
color

	^ shape color! !

!LBox methodsFor: 'user actions' stamp: 'tk 9/8/2009 16:24'!
menu

	^ self valueOfProperty: #menu ifAbsent: [
		#(
			(chooseColor: 'choose color')
			(newButton: 	'new button')
			(newTextField: 'new text field')
			(delete:		'delete')
			(userCopy:	'duplicate')
			(explore:		'debug - explore')
			)
	]! !


!LBoxHaloRemover methodsFor: 'as yet unclassified' stamp: 'tk 9/1/2009 16:44'!
buttonDown: event with: anLObject

	event controlKeyPressed ifFalse: [^ self].
	event handled: self.
	event root worldState deleteHalo.
	event root worldState deleteMenu.
	whole announceGeometryChange.
	whole announce: (LHaloChanged withBox: whole).
! !


!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/1/2009 16:36'!
buttonUp: event with: anLObject

	| m mc mbw mi |
	m := LBox newMenu.
	mbw := target valueOfProperty: #menuBorderWidth ifAbsent: [2].
	target menu do: [:pair |
		mi := LBox newMenuItem: pair second target: self selector: pair first argument: event for: m.
		"mi shape borderWidth: mbw."
		m add: mi.
	].
	mc := target valueOfProperty: #menuColor ifAbsent: [Color veryLightGray].
	m shape color: mc.
	m shape borderWidth: mbw.
	event root addAsParts: m.
	event root worldState menu: m.
	event hand focus: m.
	m position: (whole globalPointFor: 0@0).
	^ event handled: self.
! !

!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/8/2009 15:46'!
chooseColor: event

ColorPickerMorph new
		choseModalityFromPreference;
		sourceHand: LesserphicMorph current activeHand;
		target: target;
		selector: #color:;
		originalColor: target color;
		putUpFor: LesserphicMorph current 
			near: LesserphicMorph current fullBoundsInWorld.
LesserphicMorph current startStepping.
"very hacky..."
	event handled: self.
	event root worldState deleteHalo.
	event root worldState deleteMenu.
	target announceGeometryChange.
	target announce: (LHaloChanged withBox: target).
! !

!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/9/2009 14:45'!
exploreBkgVars: evt
	"put up a Morphic Explorer"

	(target valueOfProperty: #ouBackground) ifNotNilDo: [:bk | 
		bk class classPool explore.
		evt root worldState deleteHalo]! !

!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/9/2009 14:44'!
explorePage: evt
	"put up a Morphic Explorer"

	(target valueOfProperty: #ouBackground) ifNotNilDo: [:bk | 
		bk page explore.
		evt root worldState deleteHalo]! !

!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/9/2009 14:45'!
exploreStack: evt
	"put up a Morphic Explorer"

	(target valueOfProperty: #ouBackground) ifNotNilDo: [:bk | 
		bk stack explore.
		evt root worldState deleteHalo]! !

!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/8/2009 16:29'!
explore: event
	"put up a Morphic Explorer"

	target explore! !

!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/8/2009 16:06'!
newButton: event
	"Create a default button"

	| button block |
	button :=  LBox newLabel: ' Click here '.
	button shape extent: 30@32.  button shape color: Color yellow.
	block := [target beep].
	(LButtonHandler withTarget: block withSelector: #value) installTo: button.
	target add: button.
	button position: 10@15.
	button shape borderWidth: 1.
	LBoxHandleInvoker installTo: button.
! !

!LBoxMenuHandler methodsFor: 'as yet unclassified' stamp: 'tk 9/8/2009 16:06'!
newTextField: event
	"Create a default button"

	|  fldBox |
	fldBox :=  LWordWrapLayoutF openTextField.
	target add: fldBox.
	fldBox position: 10@15.
	fldBox shape borderWidth: 1.
	LBoxHandleInvoker installTo: fldBox.
! !


!LDBJrPage methodsFor: 'go to card' stamp: 'tk 9/9/2009 13:27'!
deletePrivateCostume

	self backgroundCostume "the morph" contents copy 
		withIndexDo: [:mm :ind | 
			"record their positions!!"
			(mm content valueOfProperty: #cardSpecific ifAbsent: [false]) ifTrue: [
				self backgroundCostume remove: mm]].! !


!LDBJrPage class methodsFor: 'card and background' stamp: 'tk 9/8/2009 11:22'!
createFinish: newCard
	"new class and background"

	| costume varInfoDict varInfo |
	costume := newCard backgroundCostume.
	varInfoDict := newCard backgroundVarInfo.
	costume contentsNoText do: [:ea | "set inst vars to the values -- morphs"
		varInfo := varInfoDict at: ea box name asSymbol.
		newCard perform: varInfo setter with: ea box.
		"field data will be stored in card createFinish"].
	costume setProperty: #ouBackground toValue: self.	"note: a class"
	costume removeProperty: #menu.
	costume setProperty: #menu toValue: 
		self stack stackMenu, costume menu "default".
	"send the class #stack or #card to get to those"
! !

!LDBJrPage class methodsFor: 'card and background' stamp: 'aw 9/8/2009 14:18'!
textGettersInOrder
	"Getters of background fields (not field data).  The current card may have card specific data."

	| vars bvi |
	vars := self card backgroundVarInfo.
	^ (self backgroundCostume contentsNoText select: [:mm | 
			bvi := vars at: mm box name asSymbol ifAbsent: [nil].
			bvi ifNil: [false] ifNotNil: [bvi kind = #fieldForText]])
				collect: [:mm2 | mm2 box name asSymbol]! !

!LDBJrPage class methodsFor: 'card and background' stamp: 'aw 9/8/2009 14:37'!
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 contents 
		select: [:mm | (mm box hasProperty: #cardSpecific) not])
		collect: [:ea | ea name]! !

!LDBJrPage class methodsFor: 'manage scripts' stamp: 'aw 9/8/2009 14:28'!
noteRemovalOf: aSelector
	"A script may have been removed from me.  Look for event triggers and remove them."

	| crd |
	true ifTrue: [^ self].
	"We will use a completely different mechanism -- handlers, publish, subscribe"

	self == LDBJrPage ifTrue: [^ self].	"user scripts are in a subclass"
	self isGeneric 
		ifTrue: [
			self backgroundCostume contents do: [:mm | 
				self removeTriggerOf: aSelector ifSentFrom: mm box]]
		ifFalse: [(crd := self cardInstanceOfMe) ifNil: [^ self].
			crd cardMorphs do: [:mm | 
				self removeTriggerOf: aSelector ifSentFrom: mm]].! !


!LDBJrStack methodsFor: 'show page' stamp: 'tk 9/9/2009 12:49'!
nextPage
	"display the page after the current one"

	self showPageNumber: ouCardIndex + 1.	"will wrap if off the end"! !

!LDBJrStack methodsFor: 'show page' stamp: 'tk 9/9/2009 12:51'!
previousPage
	"display the page before the current one (in cardArray order)"

	self showPageNumber: ouCardIndex - 1.	"will wrap if off the end"! !

!LDBJrStack methodsFor: 'show page' stamp: 'tk 9/9/2009 12:50'!
showPageNumber: nn

	saveLock := nil.	"clear this lock"
	(ouCardArray at: (self wrapCardNumber: nn)) show! !

!LDBJrStack methodsFor: 'user interface' stamp: 'tk 9/9/2009 14:43'!
stackMenu
	"create and install the stack's menu -- later merge with existing menu.  Must do this for every background."

	^ #(
			(insertPage: 		'new page')
			(deletePage:		'delete page')
			(renameStack:		'rename stack')
			(explorePage:		'debug - explore page')
			(exploreStack:		'debug - explore stack')
			(exploreBkgVars:	'debug - explore bkgnd variables')
			)! !


!LSubscriptionRegistry methodsFor: 'query' stamp: 'tk 9/8/2009 16:32'!
hasProperty: propName

	properties ifNil: [^ false].
	^ super hasProperty: propName! !


!LWordWrapLayoutPre methodsFor: 'accessing' stamp: 'tk 9/4/2009 16:16'!
client: ss

	client := ss.	"the text that we are laying out"
	textBox := ss.		"another name for it"! !

!LWordWrapLayoutPre methodsFor: 'events' stamp: 'tk 9/1/2009 16:41'!
handles: anAnnouncement from: anLObject

	(anAnnouncement isUserEvent and: [anAnnouncement controlKeyPressed]) ifTrue: [^ false].
	anLObject == self ifTrue: [^ true].
	^ (anLObject box containsPoint: (anAnnouncement localPointFor: anLObject)) or: 
			[anAnnouncement hand focus == whole]
! !

!LWordWrapLayoutPre methodsFor: 'init and undo' stamp: 'tk 9/4/2009 16:22'!
layOut: aBox
	"Note layOut: with a capital O is what the system sends a PBox"

	self tell: aBox box to: #layout.
	tellQueueOwner worldState processActions.! !


!LWordWrapLayoutF methodsFor: 'rule actions' stamp: 'tk 9/2/2009 13:07'!
backToWordStart: box

	| letterToMove |
	"We know that the box was over the right margin"
	letterToMove := self startOfWord: box.

	(self isStartOfLine: letterToMove index) "left margin" ifTrue: [
		"Word takes entire line, break at the clipped character"
		letterToMove := box].

	"move word to next line"
	maxHeight := letterToMove shape font ascent.
	missingHeight := 0.
	letterToMove pivotPositionY: (letterToMove pivotPositionY + (letterToMove height)).
	letterToMove pivotLeft: (client shape leftAtY: letterToMove pivotPositionY) + inset x.
	self tell: letterToMove container successor to: #place! !

!LWordWrapLayoutF methodsFor: 'rule actions' stamp: 'tk 9/9/2009 12:52'!
charTypedCMD28
	"Previous page if in a stack.  Command left arrow"

	client stack previousPage! !

!LWordWrapLayoutF methodsFor: 'rule actions' stamp: 'tk 9/9/2009 12:52'!
charTypedCMD29
	"Go to the next page, if the field is in a stack.  Command right arrow"

	client stack nextPage! !

!LWordWrapLayoutF methodsFor: 'rule actions' stamp: 'tk 9/2/2009 13:10'!
isStartOfLine: index
	"Return true if the letter is at the left margin.  Only works on letters that have been placed."
	^ (client contents at: index) box left - inset x <= 
		(client shape leftAtY: (client boxAt: index) pivotPositionY) "left margin" 
! !

LEventHandler subclass: #LWordWrapLayoutPre
	instanceVariableNames: 'inset client textBox tellQueueOwner font selection selectionAnchor caret tabArray undoStack lastTypeInTransaction maxHeight missingHeight'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'LObjects'!