'From etoys2.1 of 26 July 2007 [latest update: #1547] on 12 August 2007 at 2:26:35 am'!
"Change Set:		sugarTheatre-sw
Date:			10 August 2007
Author:			Scott Wallace

Sugarizing the event theatre flaps."!


!EventPlaybackButton commentStamp: 'sw 8/10/2007 13:33' prior: 0!
Obsolete -- the functionality of this class was subsumed in March 2007 by class PlaybackInvoker.

Class retained "temporarily" in support of pre-existing content.  Probably can now be gotten rid of...


Formerly:

A button which, when clicked, will open up an event-playback space, in which the user can play an event "movie".

caption - a String --the label beneath the button's icon.

contentArea - a Worldlet - a veryDeepCopy of the contentArea of the contributing MentoringEventRecorder at the time the recording was made.

tape  - an Array of MorphicEvent objects.

voiceRecorder - a copy of the voiceRecorder of the contributing MentoringEventRecorder.!

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

!InteriorSugarSuppliesTab commentStamp: 'sw 8/10/2007 13:56' prior: 0!
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: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Mentoring'!

!InteriorSugarNavBar commentStamp: 'sw 8/12/2007 01:25' prior: 0!
Used for the "fake sugar navigator bar" that optionally appears at the top of an Event Theatre.!


!EventPlaybackButton methodsFor: 'menu ' stamp: 'sw 8/10/2007 13:30'!
changeCaption
	"Allow the user to edit the caption name for this button.  Create a new button with the new caption."

	| result interimSpace newButton |
	result := FillInTheBlank request: 'Please edit the caption' translated initialAnswer:  caption.
	result isEmptyOrNil ifTrue: [^ self].
	caption := result.
	interimSpace := EventRecordingSpace new.
	interimSpace initializeFromPlaybackButton: self.
	newButton := self class new initializeFrom: interimSpace.
	self labelGraphic: newButton imageForm! !


!EventRecordingSpace methodsFor: 'flaps' stamp: 'sw 8/12/2007 01:16'!
addSugarNavigatorFlap
	"If the content area does not have a sugar-navigator flap, give it one."

	| existing aBar |
	existing := contentArea submorphs detect: [:aMorph | aMorph isKindOf: InteriorSugarNavBar] ifNone: [nil].
	existing ifNotNil: [^ self].  "already present"

	aBar := InteriorSugarNavBar new.
	contentArea addMorphFront: aBar.
	aBar position: contentArea position.
	aBar finishInitialization.
	contentArea installFlaps

! !

!EventRecordingSpace methodsFor: 'flaps' stamp: 'sw 8/10/2007 13:51'!
addSuppliesFlap
	"If the content area does not have a Supplies flap, give it one."

	| existing aFlap actualFlap |
	existing := contentArea submorphs detect: [:aMorph | (aMorph isKindOf: FlapTab) and: [aMorph flapID = 'Supplies']] ifNone: [nil].
	existing ifNotNil: [^ self].  "already present"

	aFlap := Flaps newSuppliesFlapFromQuads: Flaps quadsDefiningPlugInSuppliesFlap positioning: #right.
	contentArea addMorphFront: (actualFlap := aFlap as: InteriorFlapTab).
	actualFlap setToPopOutOnDragOver: true.
	actualFlap edgeToAdhereTo: #bottom.
	contentArea installFlaps

! !

!EventRecordingSpace methodsFor: 'flaps' stamp: 'sw 8/11/2007 23:18'!
sugarNavigatorFlapOrNil
	"If the receiver has an existing sugar navigator flap, answer it, else answer nil"

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

!EventRecordingSpace methodsFor: 'initialization' stamp: 'sw 8/11/2007 22:38'!
initialize
	"Initialize the receiver to be a complete mentoring space"

	super initialize.

	eventRecorder := MentoringEventRecorder new.
	eventRecorder recordingSpace: self.
	self beSticky.
	self listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	self extent: 1@1.
	self borderWidth: 2; borderColor: Color gray.
	self useRoundedCorners.
	showingSoundPanel := false.

	(contentArea _ Worldlet new)
		setNameTo: 'tutorial';
		color: Color white;
		setProperty: #automaticPhraseExpansion toValue: true;
		beSticky.

	self addMorphBack: contentArea.

	controlsPanel := AlignmentMorph newRow.
	controlsPanel hResizing: #spaceFill.
	controlsPanel  listCentering: #center. 
	controlsPanel listSpacing: #equal.
	controlsPanel cellInset: 4.
	controlsPanel minHeight: 32.
	self addMorphBack: controlsPanel.

	soundPanel := AlignmentMorph newRow.
	soundPanel hResizing: #spaceFill.
	soundPanel  listCentering: #center. 
	soundPanel listSpacing: #equal.
	soundPanel cellInset: 4.
	soundPanel minHeight: 32.
	soundPanel color:  (Color r: 1.0 g: 0.839 b: 0.645).

	self makeStatusButtons.
	
	state := #readyToRecord.
	self populateControlsPanel.

	Preferences sugarNavigator
		ifTrue:
			[self addSugarNavigatorFlap]
		ifFalse:
			[self addSuppliesFlap.
			self addNavigatorFlap]! !

!EventRecordingSpace methodsFor: 'menu' stamp: 'sw 8/10/2007 13:38'!
addMenuButtonItemsTo: aMenu
	"Build the contents of the menu to be presented when the menu button in my tool-bar is clicked."

	"CAUTION:  Debugging items still present."

	aMenu addTitle: 'Recording Options'.

	aMenu addTranslatedList: #(
		('set balloon help'		setBalloonHelp  'Allows you to provide a message to be presented to a user as balloon-help when the mouse lingers over buttons that trigger playback of the tape of this event theatre')
		('shrink event tape' shrinkTape)
		"('save on file...' saveSequenceOnFile)"
		-
		('revert to version...'	offerVersions)
		('delete old versions'	deleteOldVersions)
		-).

	Preferences sugarNavigator
		ifTrue:
			[aMenu addTranslatedList: (self sugarNavigatorFlapOrNil
				ifNil: [#(('add sugar navigator flap' addSugarNavigatorFlap))]
				ifNotNil: [#(('remove sugar navigatorFlap' removeSugarNavigatorFlap))])]
		ifFalse:
			[aMenu addTranslatedList: (self navigatorFlapOrNil
				ifNil: [#(('add navigator flap' addNavigatorFlap))]
				ifNotNil: [#(('remove navigatorFlap' removeNavigatorFlap))]).

			aMenu addTranslatedList: (self suppliesFlapOrNil
				ifNil: [#(('add supplies flap' addSuppliesFlap))]
				ifNotNil: [#(('remove suppliesFlap' removeSuppliesFlap))])].

	aMenu addTranslatedList: #(
		-
		('event roll' makeHorizontalRoll 'open a horizontal piano-roll-like tool for the viewing and editing the events of this event theatre.')
		('remove event-roll' removeEventRoll  'abandon any event-roll that may be associated with this theatre.')
		-).

	self addMoreSubMenuTo: aMenu! !

!EventRecordingSpace methodsFor: 'menu' stamp: 'sw 8/11/2007 22:30'!
addMoreSubMenuTo: aMenu
	"Add the 'more...' submenu to a menu."

	| submenu |
	submenu := MenuMorph new defaultTarget: self.
	submenu addTitle: 'More options'.

	submenu addTranslatedList: #(
		('inspect event theatre' inspect)
		('inspect event recorder' inspectEventRecorder)
		('inspect sound recorder' inspectSoundRecorder)
		('inspect event tape' inspectEventTape)
		('inspect event roll' inspectEventRoll)
		('inspect nav bar' inspectNavBar)
		-
		('parse event tape' parseEventTape)
		('convert to canonical coordinates (broken)' convertToCanonicalForm)
		('movie-clip player'  addMovieClipPlayer)).

	aMenu add: 'more...' translated subMenu: submenu! !

!EventRecordingSpace methodsFor: 'sugar flaps' stamp: 'sw 8/12/2007 01:19'!
inspectNavBar
	"Debugging -- inspect a nav-bar if I have one."

	| bar |
	bar := self contentArea submorphs detect: [:m | m isKindOf: ProjectNavigationMorph] ifNone: [nil].
	bar ifNotNil: [bar inspect]! !

!EventRecordingSpace methodsFor: 'sugar flaps' stamp: 'sw 8/12/2007 00:48'!
removeSugarNavigatorFlap
	"Hide the fake interior sugar navigator."

	(contentArea findA: InteriorSugarNavBar) ifNotNilDo:
		[:aBar | aBar delete]! !

!EventRecordingSpace methodsFor: 'sugar flaps' stamp: 'sw 8/12/2007 01:20'!
sugarPartsBinQuads
	"Answer definitions for the contents of the supplies bin within the sugar-nav-bar of the event theatre."

	^  #(
	(ObjectsTool				newStandAlone				'Object Catalog'		'A tool that lets you browse the catalog of available objects')
	(AllScriptsTool			allScriptsToolForActiveWorld	'All Scripts' 		'Stop, Step, and Go buttons for controlling all your scripts at once.  The tool can also be "opened up" to control each script in your project individually.')
	(AllPlayersTool			allPlayersToolForActiveWorld	'Players'			'A tool listing all the scripted objects in the project.')
	(TrashCanMorph			new						'Trash'				'A tool for discarding objects')
	(TextMorph				boldAuthoringPrototype			'Text'				'Text that you can edit into anything you desire.')
	(RecordingControls	authoringPrototype		'Sound Recorder'				'A device for making sound recordings.')
	(RectangleMorph 		authoringPrototype		'Rectangle' 		'A rectangle')
	(EllipseMorph			authoringPrototype		'Ellipse'			'An ellipse or circle')
	(StarMorph				authoringPrototype		'Star'			'A star')
	(ScriptableButton		authoringPrototype		'Button'			'A Scriptable button')
	(BookMorph				authoringPrototype		'Book'			'A multi-paged structure')
	(ScriptingSystem		prototypicalHolder 		'Holder'			'A place for storing alternative pictures in an animation, etc.')
	(JoystickMorph			authoringPrototype		'Joystick'		'A joystick-like control')
	(PasteUpMorph			authoringPrototype		'Playfield'		'A place for assembling parts or for staging animations')) asOrderedCollection! !

!EventRecordingSpace methodsFor: 'sugar flaps' stamp: 'sw 8/12/2007 01:40'!
sugarSuppliesFlapTab
	"Build and answer a sugar-supplies flap"

	|  aFlapTab aStrip hPosition quads |
	quads := self sugarPartsBinQuads.
	aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color gray muchLighter from: quads withPreviousEntries: #().
	Flaps twiddleSuppliesButtonsIn: aStrip.
	aFlapTab _ InteriorSugarSuppliesTab new referent: aStrip beSticky.
	aFlapTab setName: 'Supplies' translated edge: #top color: Color red lighter.
	hPosition := contentArea right - (aFlapTab width + 10).
	aFlapTab position: (hPosition @ (contentArea height - aFlapTab height)).
	aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.

	aStrip extent: contentArea width @ 136.
	aStrip beFlap: true.
	aStrip autoLineLayout: true.
	
	^ aFlapTab

"Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !


!InteriorSugarSuppliesTab methodsFor: 'positioning' stamp: 'sw 8/12/2007 00:44'!
positionObject: anObject atEdgeOf: container
	"Position the object supplied at the edge of the container supplied."

	| extra |
	extra _ (sugarNavBar notNil and: [referent isInWorld]) ifTrue: [sugarNavBar height] ifFalse: [0].
	edgeToAdhereTo == #top ifTrue:
		[^ anObject top: container innerBounds top + extra].
	edgeToAdhereTo == #bottom ifTrue: 
		[^ anObject bottom: container innerBounds bottom - extra]
! !

!InteriorSugarSuppliesTab methodsFor: 'positioning' stamp: 'sw 8/12/2007 01:21'!
wantsToBeTopmost
	"If my flap is showing, then force me to be topmost."

	^ self flapShowing
! !

!InteriorSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 8/10/2007 14:00'!
arrangeToPopOutOnDragOver: aBoolean
	"See to it that I do or don't pop out on drag-over, as per the boolean.  Copied over directly from the SugarSuppliesTab method of the same name."

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

!InteriorSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 8/10/2007 14:03'!
naviHeight: anInteger
	"Accept the argument as the height of the navigator.  Copied over from SugarSuppliesTab method of the same name."

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

!InteriorSugarSuppliesTab methodsFor: 'initialization' stamp: 'sw 8/12/2007 01:21'!
sugarNavBar: aBar icon: aForm
	"Associate the receiver with the given sugar-nav-bar."

	sugarNavBar _  aBar.
	aForm ifNotNil:
		[self useTextualTab.
		self setProperty: #priorGraphic toValue: aForm.
		self useGraphicalTab].
! !


!SugarNavigatorBar methodsFor: 'buttons creation' stamp: 'sw 8/12/2007 01:22'!
makeButton: aString balloonText: anotherString for: aSymbol
	"Make a button indexed by the string, with the given balloon text; the third parameter indicates the action selector to be associated with the button."

	^ self sugarLib makeButton: aString balloonText: anotherString for: aSymbol target: self baseColor: color highLightColor: highLightColor
! !

!SugarNavigatorBar methodsFor: 'accessing' stamp: 'sw 8/12/2007 01:23'!
sugarLib
	"Answer the instance of the SugarLibrary with which the receiver is affiliated, creating it at this time if necessary."

	^ sugarLib ifNil: [sugarLib := SugarLibrary default]! !


!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/12/2007 01:21'!
chooseLanguage
	"If I have a language button, make it inoperative."
! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/12/2007 00:37'!
doNewPainting
	"Make a new painting"

	| worldlet aRect |
	ActiveWorld assureNotPaintingElse: [^ self].
	worldlet _ self ownerThatIsA: Worldlet.
	aRect := (worldlet topLeft + (0 @ self height)) corner: worldlet bottomRight.
	worldlet makeNewDrawing: (ActiveHand lastEvent copy setPosition: aRect center)! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/11/2007 22:34'!
findAProjectSimple
	"But don't..."! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/11/2007 22:33'!
newProject
	"But don't..."! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/11/2007 22:33'!
previousProject
	"But don't..."! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/11/2007 22:34'!
publishProject
	"But don't..."! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/12/2007 01:20'!
shareThisWorld
	"If I have a share button, make it inoperative."! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/11/2007 22:07'!
stopSqueak
	"But don't..."! !

!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'sw 8/12/2007 00:57'!
undoOrRedoLastCommand
	"For now we let this be alive..."

	^ super undoOrRedoLastCommand! !

!InteriorSugarNavBar methodsFor: 'morphic interaction' stamp: 'sw 8/12/2007 01:19'!
checkForResize
	"Called during the step, make sure I conform to my owner's width."

	self width: owner width! !

!InteriorSugarNavBar methodsFor: 'morphic interaction' stamp: 'sw 8/11/2007 22:32'!
step
	"thwart efforts of superclass."

	self checkForResize! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 8/12/2007 00:46'!
finishInitialization
	"After the receiver is added at its proper place in the hierarchy, this needs to be called."

	| spacer |
	self addTransparentSpacerOfSize: 40@1.

	self addButtons.

	spacer := Morph new beTransparent.
	spacer height: 10; hResizing: #spaceFill.
	self addMorphBack: spacer.

	self setupSuppliesFlap.
	self addMorphBack: supplies.
	self addTransparentSpacerOfSize: 10@1
! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 8/12/2007 00:27'!
initialize
	"Initialize the receiver."

	| |
	super initialize.
	self listDirection: #leftToRight.
	self cellInset: 10@8.
	self layoutInset: 6@0.
	self hResizing: #spaceFill.
	self vResizing: #rigid. 
	self height: 75.
	self color: ( Color r: 0.258 g: 0.258 b: 0.258).
	self adhereToEdge: #top.! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 8/12/2007 00:34'!
makeTheSimpleButtons
	"Add the buttons for use in normal kids' mode."

	^{
		self buttonPaint.
		self buttonUndo.
			}! !

!InteriorSugarNavBar methodsFor: 'initialization' stamp: 'sw 8/12/2007 01:20'!
setupSuppliesFlap
	"Set up the supplies flap."

	| anImage aForm |
	anImage _ (self sugarLib imageFor: 'supplies' color: color).
	supplies := (self ownerThatIsA: EventRecordingSpace) sugarSuppliesFlapTab.
	aForm _ Form extent: 75@75 depth: 32.
	aForm fillColor: color.
	anImage displayOn: aForm at: (aForm extent - anImage extent)//2 rule: Form over.
	supplies sugarNavBar: self icon: aForm! !


!Worldlet methodsFor: 'flaps' stamp: 'sw 8/12/2007 01:07'!
paintingFlapTab
	"If the receiver has a flap which has a paintbox, return it, else return nil"

	^ nil! !

!Worldlet methodsFor: 'initialization' stamp: 'sw 8/12/2007 00:58'!
initialize
	"Initialize the receiver."

	super initialize.
	self setNameTo: 'screen' translated;
		extent: (700@556);  "yeah"
		color: Color white;
		impartPrivatePresenter;
		beSticky;
		borderColor: (Color r: 0.677 g: 0.935 b: 0.484);
		borderWidth: 2. 
"
Worldlet new openInWorld.
"
! !