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

Special buttons for controlling the supplies flap (which now has a 'solid' tab for resizing) and the flap accommodating the QuickGuide.  Hitting these buttons toggles the corresponding flap open or closed."!

FlapTab subclass: #SolidSugarSuppliesTab
	instanceVariableNames: 'sugarNavTab'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sugar'!

!SolidSugarSuppliesTab commentStamp: 'sw 9/2/2007 03:37' prior: 0!
Represents the horizontal "solid" tab by which the sugar-supplies flap can be resized.  When the supplies flap is *closed*, the tab is invisible.!

ProjectNavigationMorph subclass: #SugarNavigatorBar
	instanceVariableNames: 'sugarLib highLightColor undoButton zoomButton supplies listener suppliesFlap '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sugar'!

!Flaps class methodsFor: 'predefined flaps' stamp: 'sw 8/31/2007 02:13'!
addAndEnableEToyFlapsWithPreviousEntries: aCollection
	"Initialize the standard default out-of-box set of global flaps.  This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed."

	| aSuppliesFlap |
	SharedFlapTabs
		ifNotNil: [^ self].
	SharedFlapTabs _ OrderedCollection new.
	aSuppliesFlap _ self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right withPreviousEntries: aCollection.
	aSuppliesFlap referent setNameTo: 'Supplies Flap' translated.  "Per request from Kim Rose, 7/19/02"
	SharedFlapTabs add: aSuppliesFlap.  "The #center designation doesn't quite work at the moment"
	Preferences sugarNavigator
		ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap]
		ifFalse: [SharedFlapTabs add: self newNavigatorFlap].
	self enableGlobalFlapWithID: 'Supplies' translated.
	Preferences sugarNavigator
		ifTrue:
			[self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated.
			(self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo:
				[:navTab | aSuppliesFlap sugarNavTab: navTab]]
		ifFalse: [self enableGlobalFlapWithID: 'Navigator' translated].

	SharedFlapsAllowed _ true.
	Project current flapsSuppressed: false.
	^ SharedFlapTabs

"Flaps addAndEnableEToyFlaps"! !

!Flaps class methodsFor: 'predefined flaps' stamp: 'sw 9/1/2007 03:05'!
newSuppliesFlapFromQuads: quads positioning: positionSymbol withPreviousEntries: aCollection
	"Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen.  Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."

	|  aFlapTab aStrip aWidth |
	aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color gray muchLighter from: quads withPreviousEntries: aCollection.
	self twiddleSuppliesButtonsIn: aStrip.
	aFlapTab _ SolidSugarSuppliesTab new referent: aStrip beSticky.
	aFlapTab setName: 'Supplies' translated edge: #top color: Color red lighter.
	aFlapTab position: (0 @ SugarNavTab someInstance height).
	aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
	aFlapTab applyThickness: 20.

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

"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !


!Morph methodsFor: 'initialization' stamp: 'sw 9/2/2007 04:43'!
naviHeight: anInteger
	"Accept the argument as the height of the navigator.  This method serves as a backstop."


	
! !


!AlignmentMorph class methodsFor: 'instance creation' stamp: 'sw 9/2/2007 15:06'!
newVariableTransparentSpacer
	"Answer a new variable tranparent spacer."

	^ VariableSpacer new! !


!FlapTab methodsFor: 'access' stamp: 'sw 9/2/2007 03:33'!
referentThickness
	"Answer the 'thickness' of the referent, which is the actual flap pane.  If referent is not yet set up, answer a default value of 50."

	^ referent
		ifNil:
			[50]  "default"
		ifNotNil:
			[(self orientation == #horizontal)
				ifTrue:
					[referent height]
				ifFalse:
					[referent width]]! !

!FlapTab methodsFor: 'miscellaneous' stamp: 'sw 8/31/2007 03:24'!
balloonTextForFlapsMenu
	"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"

	| id |
	id _ self flapID.
	#(
	('Squeak'		'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
	('Tools'			'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
	('Widgets'		'A variety of controls and media tools' translatedNoop)
	('Supplies' 		'Supplies' translatedNoop)
	('Help'			'A flap providing documentation, tutorials, and other help' translatedNoop)
	('Stack Tools' 	'Tools for building stacks.  Caution!!  Powerful but young and underdocumented' translatedNoop)
	('Scripting'		'Tools useful when doing tile scripting' translatedNoop)
	('Navigator'		'Project navigator:  includes controls for navigating through linked projects.  Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
	('Painting'		'A flap housing the paint palette.  Click on the closed tab to make make a new painting' translatedNoop)) do:
		[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].

	^ self balloonText! !

!FlapTab methodsFor: 'show & hide' stamp: 'sw 8/31/2007 01:47'!
showFlap
	"Open the flap up"

	| thicknessToUse flapOwner |

	"19 sept 2000 - going for all paste ups <- raa note"
	self lazyUnhibernate.
	flapOwner _ self pasteUpMorph.
	self referentThickness <= 0
		ifTrue:
			[thicknessToUse _ lastReferentThickness ifNil: [100].
			self orientation == #horizontal
				ifTrue:
					[referent height: thicknessToUse]
				ifFalse:
					[referent width: thicknessToUse]].
	inboard ifTrue:
		[self stickOntoReferent].  "makes referent my owner, and positions me accordingly"
	referent pasteUpMorph == flapOwner
		ifFalse:
			[flapOwner accommodateFlap: self.  "Make room if needed"
			referent wantsToBeTopmost ifTrue: [
				flapOwner addMorphFront: referent.
			] ifFalse: [
				flapOwner addMorphBack: referent.
			].
			flapOwner startSteppingSubmorphsOf: referent.
			self positionReferent.
			referent adaptToWorld: flapOwner].
	inboard  ifFalse:
		[self adjustPositionVisAVisFlap].
	flapShowing _ true.
	
	(self pasteUpMorph ifNil: [ActiveWorld]) hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo.

	(flapOwner ifNil: [ActiveWorld])bringTopmostsToFront! !


!NoHaloMorph class methodsFor: 'instance creation' stamp: 'sw 9/2/2007 05:01'!
inARow: aCollectionOfMorphs
	"Answer an instance of the receiver, a row morph, with the given collection as its submorphs, and transparent in color.  Interpret the symbol #spacer in the incoming list as a request for a variable transparent spacer."

	| row |
	self logEntry.
	row _ self new.
	row layoutPolicy: TableLayout new.
	row
		listDirection: #leftToRight;
		vResizing: #shrinkWrap;
		hResizing: #spaceFill;
		layoutInset: 0;
		cellPositioning: #center;
		borderWidth: 0;
		color: Color transparent.
	aCollectionOfMorphs do:
		[ :each |  | toAdd |
			toAdd := each == #spacer
				ifTrue:
					[AlignmentMorph newVariableTransparentSpacer]
				ifFalse:
					[each].
			row addMorphBack: toAdd].
	^ row
! !


!ProjectNavigationMorph methodsFor: 'the buttons' stamp: 'sw 8/31/2007 01:31'!
buttonHelp
	"Answer a button for toggling the help flap open and closed"

	^ self makeButton: 'Help' translated balloonText: 'Help' translated for: #toggleHelp! !

!ProjectNavigationMorph methodsFor: 'the buttons' stamp: 'sw 8/31/2007 01:00'!
buttonSupplies
	"Answer a button for toggling the supplies flap open and closed"

	^ self makeButton: 'Supplies' translated balloonText: 'Supplies' translated for: #toggleSupplies! !


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

	| extra |
	extra _ (sugarNavTab notNil and: [referent isInWorld])
		ifTrue:
			[sugarNavTab height]
		ifFalse:
			[0].

	edgeToAdhereTo == #top ifTrue:
		[^ anObject top: container innerBounds top + extra].

	"bottom..."
	anObject == self
		ifFalse:   "the parts bin"
			[anObject bottom: (container innerBounds bottom - extra)]
		ifTrue:  "the tab"
			[anObject bottom: (container innerBounds bottom - (self referentThickness + extra))] ! !

!SolidSugarSuppliesTab methodsFor: 'mechanics' stamp: 'sw 9/2/2007 03:34'!
wantsToBeTopmost
	"Answer true iff flap is currently showing."

	^ self flapShowing
! !

!SolidSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 9/2/2007 03:34'!
arrangeToPopOutOnDragOver: aBoolean
	"Set up the receiver to respond appropriately to mouse-enter-dragging and mouse-leave-dragging situations."

	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]! !

!SolidSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 8/30/2007 01:34'!
initialize
	"Set up the receiver to have a solid tab."

	super initialize.
	self useSolidTab.
	"self applyThickness: 20."! !

!SolidSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 8/31/2007 03:26'!
sugarNavTab: anObject
	"Set the receiver's sugarNavTab."

	sugarNavTab _ anObject! !

!SolidSugarSuppliesTab methodsFor: 'event handling' stamp: 'sw 8/31/2007 03:15'!
mouseMove: evt
	"Handle a mouse-move within the solid tab."

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

	aPosition _ evt cursorPoint.
	edgeToAdhereTo == #top
		ifTrue:
			[adjustedPosition _ aPosition - evt hand targetOffset.
			newReferentThickness _ adjustedPosition y - sugarNavTab height]
		ifFalse:
			[adjustedPosition := aPosition + evt hand targetOffset.
			newReferentThickness := self world height - (adjustedPosition y + sugarNavTab height)].

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

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

! !

!SolidSugarSuppliesTab methodsFor: 'show & hide' stamp: 'sw 9/2/2007 03:35'!
adjustPositionAfterHidingFlap
	"Make the receiver, in effect, invisible when the flap is closed."

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

!SolidSugarSuppliesTab methodsFor: 'show & hide' stamp: 'sw 8/30/2007 01:48'!
showFlap
	"Open the flap up"

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

!SolidSugarSuppliesTab methodsFor: 'positioning' stamp: '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].

! !

!SolidSugarSuppliesTab methodsFor: 'positioning' stamp: '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! !


!SugarLibrary class methodsFor: 'singleton management' stamp: 'sw 9/2/2007 03:36'!
default
	"Answer the default instance of the receiver, which is held as a class variable.  If the Default is not yet set up, set it up at this time."

	^ Default ifNil: [Default _ self newDefault].

"
Default := nil.
"
! !

!SugarLibrary class methodsFor: 'singleton management' stamp: 'sw 9/2/2007 03:26'!
newDefault
	"Answer a new instance of SugarLibrary."

	| i |
	i _ SugarLibrary new.
	"i loadFrom: (FileDirectory on: 'C:\tmp\SugarEtoysIcon\SugarEtoysIcon\32x32')."
	i iconAt: 'new' put: self newIcon.
	i iconAt: 'prev' put: self prevIcon.
	i iconAt: 'next' put: self nextIcon.
	i iconAt: 'save' put: self saveIcon.
	i iconAt: 'open' put: self openIcon.
	i iconAt: 'paint' put: self paintIcon.
	i iconAt: 'language' put: self languageIcon.
	i iconAt: 'undo' put: self undoIcon.
	i iconAt: 'close' put: self closeIcon.
	i iconAt: 'share' put: self shareIcon.
	i iconAt: 'supplies' put: self suppliesIcon.
	i iconAt: 'stop' put: self stopIcon.
	i iconAt: 'zoom' put: self zoomIcon.

	i iconAt: 'newProject' put: (i iconAt: 'new').
	i iconAt: 'previousProject' put: (i iconAt: 'prev').
	i iconAt: 'nextProject' put: (i iconAt: 'next').
	i iconAt: 'publishProject' put: (i iconAt: 'save').
	i iconAt: 'findAProjectSimple' put: (i iconAt: 'open').
	i iconAt: 'doNewPainting' put: (i iconAt: 'paint').
	i iconAt: 'chooseLanguage' put: (i iconAt: 'language').
	i iconAt: 'undoOrRedoLastCommand' put: (i iconAt: 'undo').
	i iconAt: 'toggleSupplies' put: (i iconAt: 'supplies').
	i iconAt: 'quitSqueak' put: (i iconAt: 'close').
	i iconAt: 'shareThisWorld' put: (i iconAt: 'share').
	i iconAt: 'chooseScreenSetting' put: (i iconAt: 'zoom').
	i iconAt: 'stopSqueak' put: (i iconAt: 'stop').
	i iconAt: 'toggleHelp' put: (i iconAt: 'next').  "temporary!!"

	^  i
! !


!SugarNavigatorBar methodsFor: 'initialization' stamp: 'sw 8/31/2007 03:17'!
addButtons
	"This reimplementation, which now simply calls super, no longer needed..."

	super addButtons
! !

!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! !

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

	^{
		self buttonNewProject.

		self buttonPrev.
"		self buttonNext."
		self buttonPublish.
		self buttonFind.

		self buttonPaint.
	},
"	(
		Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()]
	),"
	{
		self buttonUndo.
		self buttonLanguage.
		self buttonShare.
		self buttonStop.
	}, 
	(((DisplayScreen actualScreenSize = OLPCVirtualScreen virtualScreenExtent)
		ifFalse: [{self buttonZoom}]
		ifTrue: [#()])),

	{	#spacer.

		self buttonSupplies.
		self buttonHelp}
! !

!SugarNavigatorBar methodsFor: 'event handling' stamp: 'sw 8/31/2007 03:26'!
setEdge: aSymbol
	"Establish the given edge to which to cling."

	(Flaps globalFlapTab: 'Supplies' translated) ifNotNilDo:
		[:s | s setEdge: aSymbol]! !

!SugarNavigatorBar methodsFor: 'help flap' stamp: 'sw 8/31/2007 02:09'!
buildAndOpenHelpFlap
	"Called only when flaps are being created afresh."

	| aFlapTab outer leftStrip rightStrip aGuide |
	aFlapTab :=  FlapTab new.
	aFlapTab assureExtension visible: false.

	outer := AlignmentMorph newRow.
	outer assureExtension visible: false.
	outer clipSubmorphs: true.
	outer beTransparent.
	outer vResizing: #spaceFill; hResizing: #spaceFill.
	outer layoutInset: 0; cellInset: 0; borderWidth: 0.
	outer setProperty: #morphicLayerNumber toValue: 26.

	leftStrip := Morph new beTransparent.  "This provides space for tabs to be seen."
	leftStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
	leftStrip width:  20.
	leftStrip hResizing: #rigid; vResizing: #spaceFill.
	outer addMorphBack: leftStrip.   

	rightStrip := AlignmentMorph newColumn.
	rightStrip color: (Color green veryMuchLighter alpha:  0.2).
	rightStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
	outer addMorphBack: rightStrip.
	outer clipSubmorphs: true.
	
	aGuide := QuickGuideMorph new.
	aGuide openInWorld.
	aGuide order: QuickGuideMorph defaultOrder.
	rightStrip addMorphBack: aGuide.

	aFlapTab referent ifNotNil: [aFlapTab referent delete].
	aFlapTab referent: outer.
	aFlapTab setName: 'Help' translated edge: #left color: (Color r: 0.677 g: 0.935 b: 0.484).
	ActiveWorld addMorphFront: aFlapTab.
	aFlapTab adaptToWorld: ActiveWorld.
	aFlapTab computeEdgeFraction.

	aFlapTab position: (outer left @ outer top).
	outer extent: (462 @ ActiveWorld height).

	outer beFlap: true.
	outer beTransparent.

	aFlapTab referent hide.
	aFlapTab openFully.

	outer beSticky.
	leftStrip beSticky.
	rightStrip beSticky.

	aFlapTab applyThickness: 462.
	aFlapTab fitOnScreen.
	aFlapTab referent show.
	aFlapTab show.
	Flaps addGlobalFlap: aFlapTab.
	ActiveWorld addGlobalFlaps! !

!SugarNavigatorBar methodsFor: 'help flap' stamp: 'sw 8/31/2007 02:03'!
toggleHelp
	"Open the help-cards flap, or close it if open."

	| ref f |
	f _ (Flaps globalFlapTab: 'Help' translated).
	f ifNotNil:
		[ref _ f referent.
		ref isInWorld
			ifTrue:
				[f hideFlap]
			ifFalse:
				[f show.
				f showFlap.
				(owner notNil and: [owner isFlapTab]) ifTrue:
					[owner edgeToAdhereTo == #top ifTrue:
						[ref position: self bottomLeft].
					owner edgeToAdhereTo == #bottom ifTrue:
						[ref bottomLeft: self topLeft]]]]
		ifNil:
			[self buildAndOpenHelpFlap]! !

SugarNavigatorBar removeSelector: #newSuppliesButton!
SugarNavigatorBar removeSelector: #setUpSuppliesFlapButtons!
ProjectNavigationMorph subclass: #SugarNavigatorBar
	instanceVariableNames: 'sugarLib highLightColor undoButton zoomButton supplies listener suppliesFlap'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sugar'!

!SugarNavigatorBar reorganize!
('initialization' addButtons inAColumn: inARow: initialize makeTheButtons makeTheSimpleButtons setSuppliesBehind sugarLib:)
('morphic interaction' checkForResize naviHeightWithFullUpdate: naviHeight: resizeButtonsAndTabTo: step wantsHalo wantsHaloFromClick)
('buttons creation' availableDisplayModes balloonTextForMode: buttonLanguage buttonPaint buttonStop buttonUndo buttonZoom chooseScreenSetting makeButton:balloonText:for: setupSuppliesFlap spacer: stringForDisplayModeIs:)
('button actions' changeDisplayModeTo: changeVirtualScreenMode currentDisplayMode doNewPainting shareThisWorld stopSqueak toggleSupplies)
('event handling' handlesMouseOver: morphicLayerNumber setEdge: undoButtonAppearance wantsDroppedMorph:event: zoomButtonAppearance)
('sharing' getBadge startSharing stopSharing)
('accessing' buttonHeight color: color:highLightColor: highLightColor highLightColor: makeGray makeGreen oldHeight sugarLib)
('*nebraska-Morphic-Remote' buttonShare)
('help flap' buildAndOpenHelpFlap toggleHelp)
!

SolidSugarSuppliesTab removeSelector: #naviHeight:!
SolidSugarSuppliesTab removeSelector: #sugarNavTab:icon:!

!SolidSugarSuppliesTab reorganize!
('mechanics' positionObject:atEdgeOf: wantsToBeTopmost)
('initialization' arrangeToPopOutOnDragOver: initialize sugarNavTab:)
('event handling' mouseMove:)
('show & hide' addCustomMenuItems:hand: adjustPositionAfterHidingFlap showFlap)
('positioning' fitOnScreen spanWorld)
!

"Postscript:"
SugarLibrary clearDefault.
SugarNavigatorBar refreshButRetainOldContents.
!