'From etoys2.1 of 26 July 2007 [latest update: #1650] on 15 September 2007 at 12:18:15 am'! "Change Set: helpFlapTab-sw Date: 15 September 2007 Author: Scott Wallace Make the textual help flaps clear the sugar bar. Constrain guides-flap tab movement. React properly to screen-size change. Also (unrelated) - fix up wording of an updating menu item. - avoid the despicable use of someInstance in a recent update."! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 9/14/2007 23:43'! 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 sugarNavigator | sugarNavigator _ Preferences sugarNavigator. aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color gray muchLighter from: quads withPreviousEntries: aCollection. self twiddleSuppliesButtonsIn: aStrip. aFlapTab _ (sugarNavigator ifTrue: [SolidSugarSuppliesTab] ifFalse: [FlapTab]) new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: (sugarNavigator ifTrue: [#top] ifFalse: [#bottom]) color: Color red lighter. aFlapTab position: (0 @ ActiveWorld sugarAllowance). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aFlapTab applyThickness: 20. aWidth := ActiveWorld width. aStrip extent: ActiveWorld width @ (76 * (1 + (1350 // aWidth))). aStrip beFlap: true. aStrip autoLineLayout: true. sugarNavigator ifTrue: [ aFlapTab useSolidTab. aFlapTab height: 20; color: (Color r: 0.804 g: 0.804 b: 0.804). ] ifFalse: [ aFlapTab color: Color red lighter ]. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Supplies' translated"! ! !FlapTab methodsFor: 'compact' stamp: 'sw 9/13/2007 12:56'! compactFlapString "Answe a string describing whether the receiver is currently compact or not." ^ (self isFlapCompact ifTrue: [''] ifFalse: ['']), 'compact flap' translated! ! !FlapTab methodsFor: 'event handling' stamp: 'sw 9/15/2007 00:09'! mouseMove: evt "Handle a mouse-move event. The event, a MorphicEvent, is passed in." | aPosition newReferentThickness adjustedPosition thick | dragged ifFalse: [(thick _ self referentThickness) > 0 ifTrue: [lastReferentThickness _ thick]]. ((self containsPoint: (aPosition _ evt cursorPoint)) and: [dragged not]) ifFalse: [flapShowing ifFalse: [self showFlap]. adjustedPosition _ aPosition - evt hand targetOffset. (edgeToAdhereTo == #bottom) ifTrue: [newReferentThickness _ inboard ifTrue: [self world height - adjustedPosition y] ifFalse: [self world height - adjustedPosition y - self height]]. (edgeToAdhereTo == #left) ifTrue: [newReferentThickness _ inboard ifTrue: [adjustedPosition x + self width] ifFalse: [adjustedPosition x]]. (edgeToAdhereTo == #right) ifTrue: [newReferentThickness _ inboard ifTrue: [self world width - adjustedPosition x] ifFalse: [self world width - adjustedPosition x - self width]]. (edgeToAdhereTo == #top) ifTrue: [newReferentThickness _ inboard ifTrue: [adjustedPosition y + self height] ifFalse: [adjustedPosition y]]. self isCurrentlySolid ifFalse: [(#(left right) includes: edgeToAdhereTo) ifFalse: [self left: adjustedPosition x] ifTrue: [self top: adjustedPosition y]]. ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue: [newReferentThickness := referent width]. self applyThickness: newReferentThickness. dragged _ true. self fitOnScreen. self computeEdgeFraction]! ! !PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/13/2007 13:20'! repositionFlapsAfterScreenSizeChange "Reposition flaps after screen size change" (Flaps globalFlapTabsIfAny, ActiveWorld localFlapTabs) do: [:aFlapTab | aFlapTab applyEdgeFractionWithin: self bounds]. Flaps doAutomaticLayoutOfFlapsIfAppropriate. ScriptingSystem cleanUpFlapTabsOnLeft! ! !PasteUpMorph methodsFor: 'world state' stamp: 'sw 9/13/2007 13:23'! sugarAllowance "Answer how much to allow at the top of the world for the sugar nav bar." | nav | ^ Preferences sugarNavigator ifFalse: [0] ifTrue: [nav := self findA: SugarNavTab. ^ nav ifNotNil: [nav height] ifNil: [self valueOfProperty: #sugarNavHeight ifAbsent: [75]]]! ! !StandardScriptingSystem methodsFor: 'help in a flap' stamp: 'sw 9/14/2007 23:42'! openInfoFlapWithLabel: aTitle helpContents: aString edge: anEdge "Open an info flap with the given label, contents, and edge" | aPlug outer leftStrip rightStrip titleRow aDismissButton aFlapTab | Preferences enable: #scrollBarsOnRight. Preferences enable: #inboardScrollbars. Preferences enable: #scrollBarsNarrow. aFlapTab := FlapTab new. aFlapTab assureExtension visible: false. aFlapTab referentMargin: (0 @ ActiveWorld sugarAllowance). 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. leftStrip layoutInset: 0; cellInset: 0; borderWidth: 0. leftStrip width: 20. leftStrip hResizing: #rigid; vResizing: #spaceFill. outer addMorphBack: leftStrip. rightStrip := AlignmentMorph newColumn. rightStrip beTransparent. rightStrip layoutInset: 0; cellInset: 0; borderWidth: 0. outer addMorphBack: rightStrip. outer clipSubmorphs: true. titleRow := AlignmentMorph newRow. titleRow borderColor: Color veryVeryLightGray; borderWidth: 1. titleRow hResizing: #spaceFill; vResizing: #shrinkWrap. titleRow beTransparent. aDismissButton := aFlapTab tanOButton. aDismissButton actionSelector: #dismissViaHalo. titleRow addMorphFront: aDismissButton. titleRow addTransparentSpacerOfSize: 8 @ 0. titleRow addMorphBack: (StringMorph contents: aTitle font: (StrikeFont familyName: 'KomikaTextKaps' size: 36)). rightStrip addMorph: titleRow. aPlug := PluggableTextMorph new. aPlug width: 540. aPlug setText: aString. aPlug textMorph beAllFont: Preferences standardEToysFont. aPlug retractable: false; scrollBarOnLeft: false. aPlug hideHScrollBarIndefinitely: true. aPlug borderColor: ScriptingSystem borderColor. aPlug setNameTo: aTitle. aPlug hResizing: #spaceFill. aPlug vResizing: #spaceFill. rightStrip addMorphBack: aPlug. aFlapTab referent ifNotNil: [aFlapTab referent delete]. aFlapTab referent: outer. aFlapTab setName: aTitle edge: anEdge color: (Color r: 0.677 g: 0.935 b: 0.484). aFlapTab submorphs first beAllFont: (StrikeFont familyName: 'KomikaTextKaps' size: 24). ActiveWorld addMorphFront: aFlapTab. aFlapTab adaptToWorld: ActiveWorld. aFlapTab computeEdgeFraction. anEdge == #left ifTrue: [aFlapTab position: (outer left @ outer top). outer extent: (540 @ ActiveWorld height)]. anEdge == #right ifTrue: [aFlapTab position: ((ActiveWorld right - aFlapTab width) @ ActiveWorld top). outer extent: (540 @ ActiveWorld height)]. outer beFlap: true. outer color: Color green veryMuchLighter. aPlug textMorph lock. aFlapTab referent hide. aFlapTab openFully. outer beSticky. leftStrip beSticky. rightStrip beSticky. ActiveWorld doOneCycle. aPlug width: 540. aPlug setText: aString. "hmm, again" aPlug color: outer color. aPlug borderWidth: 0. aPlug textMorph contents: aString wrappedTo: 520. aFlapTab applyThickness: 560. aFlapTab fitOnScreen. aFlapTab referent show. ^ aFlapTab! ! !SugarNavigatorBar methodsFor: 'help flap' stamp: 'sw 9/15/2007 00:05'! buildAndOpenHelpFlap "Called only when flaps are being created afresh." | aFlapTab outer leftStrip rightStrip aGuide | aFlapTab := FlapTab new. aFlapTab assureExtension visible: false. aFlapTab setProperty: #rigidThickness toValue: true. 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: #wantsHaloFromClick toValue: false. 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. rightStrip setProperty: #wantsHaloFromClick toValue: false. outer addMorphBack: rightStrip. outer clipSubmorphs: true. aGuide := QuickGuideMorph new. aGuide initializeIndexPage. aGuide order: QuickGuideMorph defaultOrder. rightStrip addMorphBack: aGuide. aGuide beSticky. 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 referentMargin: 0@self height. aFlapTab openFully. outer beSticky. leftStrip beSticky. rightStrip beSticky. aFlapTab applyThickness: 462. aFlapTab fitOnScreen. aFlapTab referent show. aFlapTab show. aFlapTab makeFlapCompact: true. Flaps addGlobalFlap: aFlapTab. ActiveWorld addGlobalFlaps. ScriptingSystem cleanUpFlapTabsOnLeft! !