'From etoys2.1 of 26 July 2007 [latest update: #1576] on 3 September 2007 at 4:28:59 am'!
"Change Set:		evtTheatreSugarFlaps-sw
Date:			3 September 2007
Author:			Scott Wallace

Complete the porting of sugar-nav-bar and sugar-supplies-bin changes in the outer UI to the flaps used on the edge of an event theatre."!

InteriorFlapTab subclass: #InteriorSolidSugarSuppliesTab
	instanceVariableNames: 'sugarNavBar'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Mentoring'!

!InteriorSolidSugarSuppliesTab commentStamp: 'sw 9/3/2007 04:19' prior: 0!
A "solid" flap tab used in conjunction with the sugar supplies bin used on the interior of an event theatre.!

InteriorFlapTab subclass: #InteriorSugarSuppliesTab
	instanceVariableNames: 'sugarNavTab sugarNavBar '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Mentoring'!

!InteriorSugarSuppliesTab commentStamp: 'sw 9/1/2007 02:22' prior: 0!
DISUSED...  Superseded by InteriorSolidSugarSuppliesTab.  Retained for a while for backward compatability, in consideration of existing content.

A flap-tab for the the *fake* fake Sugar supplies flap at the top of an event-recording theatre or event-playback theatre.

Because this object cannot inherit both from InteriorFlapTab and from SugarSuppliesTab, it inherits only from the former, with  code copied over from the latter as needed.!

SugarNavigatorBar subclass: #InteriorSugarNavBar
	instanceVariableNames: 'edgeToAdhereTo '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Mentoring'!

!EventRecordingSpace methodsFor: 'flaps' stamp: 'sw 9/1/2007 02:07'!
sugarNavBarOrNil
	"If I have a fake-sugar-nav-bar, answer it, else answer nil."

	^ contentArea submorphs detect: [:aMorph | aMorph isKindOf: InteriorSugarNavBar] ifNone: [nil]! !

!EventRecordingSpace methodsFor: 'sugar flaps' stamp: 'sw 9/1/2007 03:05'!
sugarSuppliesFlapTab
	"Build and answer an interior sugar-supplies flap"

	|  aFlapTab aStrip quads |
	quads := self sugarPartsBinQuads.
	aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color gray muchLighter from: quads withPreviousEntries: #().
	Flaps twiddleSuppliesButtonsIn: aStrip.
	aFlapTab _ InteriorSolidSugarSuppliesTab new referent: aStrip beSticky.
	aFlapTab sugarNavBar: self sugarNavBarOrNil.
	aFlapTab setName: 'Supplies' translated edge: #top color: Color red lighter.
	aFlapTab position: (contentArea topLeft + (0 @ SugarNavTab new height)).
	aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
	aFlapTab applyThickness: 20.

	aStrip extent: contentArea width @ (76 * (1 + (1350 // contentArea width))).
	aStrip beFlap: true.
	aStrip autoLineLayout: true.
	aFlapTab useSolidTab.
	aFlapTab height: 20; color:  (Color r: 0.804 g: 0.804 b: 0.804).

	^ aFlapTab! !


!InteriorSolidSugarSuppliesTab methodsFor: 'mechanics' stamp: 'sw 9/1/2007 02:02'!
navBarHeight
	"Answer the height of the nav-bar of the evt theatre with which the receiver is associated."

	^ sugarNavBar height! !

!InteriorSolidSugarSuppliesTab methodsFor: 'mechanics' stamp: 'sw 9/1/2007 03:22'!
positionObject: anObject atEdgeOf: container
	"Position an object -- either the receiver or its referent -- on the edge of the container."

	| extra |
	extra := self navBarHeight - 2.
	edgeToAdhereTo == #top
		ifTrue:
			[anObject top: container innerBounds top + extra]
		ifFalse: 
			[anObject bottom: (container innerBounds bottom - extra)] ! !

!InteriorSolidSugarSuppliesTab methodsFor: 'mechanics' stamp: 'sw 9/3/2007 04:13'!
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost objects in its owner"

	^ self flapShowing
! !

!InteriorSolidSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 9/3/2007 04:15'!
arrangeToPopOutOnDragOver: aBoolean
	"Set up the receiver with the right dragover properties."

	aBoolean
		ifTrue:
			[referent on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self.
			self on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self]
		ifFalse:
			[self on: #mouseEnterDragging send: nil to: nil.
			referent on: #mouseLeaveDragging send: nil to: nil.
			self on: #mouseLeaveDragging send: nil to: nil]! !

!InteriorSolidSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 9/1/2007 02:08'!
initialize
	"Set up the receiver to have a solid tab."

	super initialize.
	self beSticky! !

!InteriorSolidSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 9/3/2007 03:49'!
naviHeight: anInteger
	"Set the navigator height."

	submorphs ifEmpty: [^ self].
	submorphs first extent: anInteger@anInteger.
! !

!InteriorSolidSugarSuppliesTab methodsFor: 'event handling' stamp: 'sw 9/1/2007 04:05'!
mouseMove: evt
	"Handle a mouse-move within the solid tab."

	| aPosition newReferentThickness adjustedPosition thick aWorldlet |
	dragged ifFalse: [(thick _ self referentThickness) > 0
		ifTrue: [lastReferentThickness _ thick]].

	aWorldlet := self ownerThatIsA: Worldlet.
	aPosition := evt cursorPoint - aWorldlet position.
	edgeToAdhereTo == #top
		ifTrue:
			[adjustedPosition _ aPosition - evt hand targetOffset.
			newReferentThickness _ adjustedPosition y - self navBarHeight]
		ifFalse:
			[adjustedPosition := aPosition - evt hand targetOffset.
			newReferentThickness := aWorldlet height - (adjustedPosition y + self navBarHeight + self height)].

	self applyThickness: newReferentThickness.
	dragged _ true.
	self fitOnScreen! !

!InteriorSolidSugarSuppliesTab methodsFor: 'show & hide' stamp: 'sw 9/3/2007 04:14'!
adjustPositionAfterHidingFlap
	"The flap has has been hidden; adjust the tab's position.  In this case, the tab reduces to zero height."

	super adjustPositionAfterHidingFlap.
	self setProperty: #heightWhenOpen toValue: self height.
	self height: 0	! !

!InteriorSolidSugarSuppliesTab methodsFor: 'show & hide' stamp: 'sw 8/31/2007 17:08  <  sw 8/30/2007 01:48'!
showFlap
	"Open the flap up"

	self height: (self valueOfProperty: #heightWHenOpen ifAbsent: [20]).
	super showFlap! !

!InteriorSolidSugarSuppliesTab methodsFor: 'positioning' stamp: 'sw 8/31/2007 17:08  <  sw 8/30/2007 02:05'!
fitOnScreen
	"19 sept 2000 - allow flaps in any paste up"
	| constrainer t l |
	constrainer _ owner ifNil: [self].
	self flapShowing "otherwise no point in doing this"
		ifTrue:[self spanWorld].
	self orientation == #vertical ifTrue: [
		t _ ((self top min: (constrainer bottom- self height)) max: constrainer top).
		t = self top ifFalse: [self top: t].
	] ifFalse: [
		l _ ((self left min: (constrainer right - self width)) max: constrainer left).
		l = self left ifFalse: [self left: l].
	].
	self flapShowing ifFalse: [self positionObject: self atEdgeOf: constrainer].

! !

!InteriorSolidSugarSuppliesTab methodsFor: 'positioning' stamp: 'sw 8/31/2007 17:08  <  sw 8/31/2007 03:25'!
spanWorld
	"Make the receiver's width commensurate with that of the container."

	super spanWorld.
	self width:  self pasteUpMorph width! !

!InteriorSolidSugarSuppliesTab methodsFor: 'accessing' stamp: 'sw 9/3/2007 04:14'!
sugarNavBar: aBar
	"Establish the value of the sugarNavBar instance variable."

	sugarNavBar := aBar! !

!InteriorSolidSugarSuppliesTab methodsFor: 'nil' stamp: 'sw 9/1/2007 04:07'!
addCustomMenuItems: aMenu hand: aHand
	"Overridden in order to thwart super."

! !


!SugarNavigatorBar methodsFor: 'initialization' stamp: 'sw 9/2/2007 05:00'!
inARow: aCollectionOfMorphs
	"Answer a row morph with the given collection as its submorphs.  Interpret the symbol #spacer in the incoming list as a request for a variable transparent spacer."

	^ NoHaloMorph inARow: aCollectionOfMorphs! !


!InteriorSugarNavBar methodsFor: 'morphic interaction' stamp: 'sw 9/3/2007 04:15'!
changeColor
	"Change the color of the receiver -- triggered, e.g. from a menu"

	ColorPickerMorph new
		choseModalityFromPreference;
		sourceHand: self activeHand;
		target: self;
		selector: #color:;
		originalColor: color;
		putUpFor: self near: self fullBoundsInWorld! !

!InteriorSugarNavBar methodsFor: 'morphic interaction' stamp: 'sw 9/3/2007 04:11'!
resizeButtonsAndTabTo: newDim
	"The user has chosen a new height for the nav bar; make the buttons follow suit."

	| frame wantsSupplies |
	wantsSupplies := supplies notNil and: [supplies flapShowing].
	wantsSupplies ifTrue: [supplies hideFlap].
	frame _ undoButton owner.
	frame submorphs do: [:e |
		e naviHeight: newDim].
	frame height: newDim.
	self height: newDim.
	wantsSupplies ifTrue: [supplies showFlap]! !

!InteriorSugarNavBar methodsFor: 'morphic interaction' stamp: 'sw 9/2/2007 03:54'!
wantsHaloFromClick
	"Answer that I would take a halo from a click..."

	^ true
! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 9/3/2007 03:25'!
addButtons
	"Add the sugar buttons, delimited on each end by spacers."

	self addTransparentSpacerOfSize: 30@1.
	super addButtons.
	self addTransparentSpacerOfSize: 30@1! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 9/3/2007 03:37'!
finishInitialization
	"After the receiver is added at its proper place in the hierarchy, this needs to be called."

	self addButtons.
	self adhereToEdge: #top.
	self setNameTo: 'Navigator Flap' translated
! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 8/31/2007 03:58'!
makeTheSimpleButtons
	"Add the buttons for use in normal kids' mode."

	^{
		self buttonPaint.
		self buttonUndo.
		#spacer.
		self buttonSupplies.
			}! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 9/1/2007 01:27'!
setupSuppliesFlap
	"Set up the interior supplies flap."

	supplies := (self ownerThatIsA: EventRecordingSpace) sugarSuppliesFlapTab.
	self pasteUpMorph addMorphFront: supplies.
	^ supplies! !

!InteriorSugarNavBar methodsFor: 'button actions' stamp: 'sw 9/2/2007 04:53'!
destroyFlap
	"Simply delete the receiver."

	self delete! !

!InteriorSugarNavBar methodsFor: 'button actions' stamp: 'sw 9/1/2007 01:27'!
toggleSupplies
	"Toggle the whether the interior supplies flap is open."

	| ref aFlapTab |
	aFlapTab _ self pasteUpMorph flapTabs
				detect: [:s | (s isKindOf: FlapTab)
						and: [s flapID = 'Supplies' translated]]
				ifNone: [self setupSuppliesFlap].
	ref _ aFlapTab referent.
	ref isInWorld
		ifTrue:
			[aFlapTab hideFlap]
		ifFalse:
			[aFlapTab showFlap.
			(owner notNil and: [owner isFlapTab])
				ifTrue: [owner edgeToAdhereTo == #top
						ifTrue: [ref position: self bottomLeft].
					owner edgeToAdhereTo == #bottom
						ifTrue: [ref bottomLeft: self topLeft]]]! !

!InteriorSugarNavBar methodsFor: 'menus' stamp: 'sw 9/2/2007 04:28'!
addCustomMenuItems: aMenu hand: aHandMorph
	"Add further items to the menu as appropriate"

	aMenu addLine.
	aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
	aMenu add: 'destroy this flap' translated action: #destroyFlap.

	aMenu addLine.

	aMenu add: 'use default green look' translated action: #makeGreen.
	aMenu add: 'use default gray look' translated action: #makeGray.
	aMenu add: 'color...' translated target: self action: #changeColor.
	aMenu add: 'highlight color...' translated target: self action: #changeHighlightColor.
	aMenu add: 'height...' translated target: self action: #changeNaviHeight.
! !

!InteriorSugarNavBar methodsFor: 'accessing' stamp: 'sw 9/1/2007 03:23'!
adhereToEdge: aSymbol
	"Set the value of edgeToAdhereTo, and position the receiver accordingly"

	edgeToAdhereTo := aSymbol.
	super adhereToEdge: aSymbol.
	supplies ifNotNil: [supplies setEdge: aSymbol]! !

!InteriorSugarNavBar methodsFor: 'accessing' stamp: 'sw 9/1/2007 01:45'!
edgeToAdhereTo
	"Answer the value of edgeToAdhereTo"

	^ edgeToAdhereTo! !

!InteriorSugarNavBar methodsFor: 'events' stamp: 'sw 9/2/2007 04:39'!
changeHighlightColor
	"Put up a color picker allowing the user to select a highlight color."

	ColorPickerMorph new
		choseModalityFromPreference;
		sourceHand: self activeHand;
		target: self;
		selector: #highLightColor:;
		originalColor: self color;
		putUpFor: self near: self fullBoundsInWorld! !

!InteriorSugarNavBar methodsFor: 'events' stamp: 'sw 9/3/2007 03:41'!
changeNaviHeight
	"Allow the user to choose a new height for the navigator."

	| f n |
	f _ FillInTheBlank request: 'new height of the bar'  translated initialAnswer: self height asString.
	n _ f asNumber min: (self pasteUpMorph height // 2) max: 0.
	self naviHeight: n.! !

!InteriorSugarNavBar methodsFor: 'edge' stamp: 'sw 9/2/2007 04:29'!
edgeString
	"Answer a string characterizing the edge to which I cling."

	^ 'cling to edge... (current: {1})' translated format: {edgeToAdhereTo translated}! !

!InteriorSugarNavBar methodsFor: 'edge' stamp: 'sw 9/2/2007 04:37'!
setEdgeToAdhereTo
	"Put up a menu allowing user to specify the edge."

	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	#(top bottom) do:
		[:sym | aMenu add: sym asString translated target: self selector:  #adhereToEdge: argument: sym].
	aMenu popUpEvent: self currentEvent in: self world! !

InteriorSugarNavBar removeSelector: #edgeToAdhereTo:!
InteriorSugarNavBar removeSelector: #inARow:!
InteriorSugarNavBar removeSelector: #positioningString!
InteriorSugarNavBar removeSelector: #togglePositioning!
InteriorSugarNavBar removeSelector: #wantsHalo!
SugarNavigatorBar subclass: #InteriorSugarNavBar
	instanceVariableNames: 'edgeToAdhereTo'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Mentoring'!
InteriorFlapTab subclass: #InteriorSugarSuppliesTab
	instanceVariableNames: 'sugarNavBar'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Mentoring'!
InteriorSolidSugarSuppliesTab removeSelector: #sugarNavBar:icon:!
InteriorSolidSugarSuppliesTab removeSelector: #sugarNavTab:!
InteriorSolidSugarSuppliesTab removeSelector: #sugarNavTab:icon:!