[squeak-dev] The Trunk: MorphicExtras-nice.82.mczcommits at source.squeak.org commits at source.squeak.orgTue Mar 23 21:16:58 UTC 2010
Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-nice.82.mcz ==================== Summary ==================== Name: MorphicExtras-nice.82 Author: nice Time: 23 March 2010, 10:16:23.761 pm UUID: 3d113908-91be-4dfa-ba63-b249528683fe Ancestors: MorphicExtras-nice.81 Fix underscores =============== Diff against MorphicExtras-nice.81 =============== Item was changed: ----- Method: FlapTab>>edgeToAdhereTo: (in category 'edge') ----- edgeToAdhereTo: e + edgeToAdhereTo := e asSymbol! - edgeToAdhereTo _ e asSymbol! Item was changed: ----- Method: FlapTab>>useSolidTab (in category 'solid tabs') ----- useSolidTab | thickness colorToUse | self preserveDetails. + thickness := self valueOfProperty: #priorThickness ifAbsent: [20]. + colorToUse := self valueOfProperty: #priorColor ifAbsent: [Color red muchLighter]. - thickness _ self valueOfProperty: #priorThickness ifAbsent: [20]. - colorToUse _ self valueOfProperty: #priorColor ifAbsent: [Color red muchLighter]. self color: colorToUse. self removeAllMorphs. (self orientation == #vertical) ifTrue: [self width: thickness. self height: self currentWorld height. self position: (self position x @ 0)] ifFalse: [self height: thickness. self width: self currentWorld width. self position: (0 @ self position y)]. self borderWidth: 0. self layoutChanged.! Item was changed: ----- Method: Flaps class>>newStackToolsFlap (in category 'predefined flaps') ----- newStackToolsFlap "Add a flap with stack tools in it" | aFlapTab aStrip | + aStrip := PartsBin newPartsBinWithOrientation: #leftToRight - aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: (Color red muchLighter "alpha: 0.2") from: self quadsDefiningStackToolsFlap. + aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Stack Tools' translated edge: #bottom color: Color brown lighter lighter. aFlapTab position: ((Display width - (aFlapTab width + 226)) @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: self currentWorld width @ 78. aStrip beFlap: true. aStrip autoLineLayout: true. aStrip extent: self currentWorld width @ 70. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Stack Tools' translated"! Item was changed: ----- Method: FlapTab>>edgeFraction: (in category 'edge') ----- edgeFraction: aNumber "Set my edgeFraction to the given number, without side effects" + edgeFraction := aNumber asFloat! - edgeFraction _ aNumber asFloat! Item was changed: ----- Method: FlapTab>>tabSelected (in category 'events') ----- tabSelected "The user clicked on the tab. Show or hide the flap. Try to be a little smart about a click on a tab whose flap is open but only just barely." dragged == true ifTrue: + [^ dragged := false]. - [^ dragged _ false]. self flapShowing ifTrue: [self referentThickness < 23 "an attractive number" ifTrue: [self openFully] ifFalse: [self hideFlap]] ifFalse: [self showFlap]! Item was changed: ----- Method: FlapTab>>setToPopOutOnDragOver: (in category 'mouseover & dragover') ----- setToPopOutOnDragOver: aBoolean + self arrangeToPopOutOnDragOver: (popOutOnDragOver := aBoolean)! - self arrangeToPopOutOnDragOver: (popOutOnDragOver _ aBoolean)! Item was changed: ----- Method: Flaps class>>replacePartSatisfying:inGlobalFlapSatisfying:with: (in category 'replacement') ----- replacePartSatisfying: elementBlock inGlobalFlapSatisfying: flapBlock with: replacement "If any global flap satisfies flapBlock, look in it for a part satisfying elementBlock; if such a part is found, replace it with the replacement morph, make sure the flap's layout is made right, etc." | aFlapTab flapPasteUp anElement | + aFlapTab := self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. + flapPasteUp := aFlapTab referent. + anElement := flapPasteUp submorphs detect: [:aMorph | elementBlock value: aMorph] ifNone: [^ self]. - aFlapTab _ self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. - flapPasteUp _ aFlapTab referent. - anElement _ flapPasteUp submorphs detect: [:aMorph | elementBlock value: aMorph] ifNone: [^ self]. flapPasteUp replaceSubmorph: anElement by: replacement. flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true. "Flaps replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented label = 'scripting area']]] inGlobalFlapSatisfying: [:fl | (fl submorphs size > 0) and: [(fl submorphs first isKindOf: TextMorph) and: [(fl submorphs first contents string copyWithout: Character cr) = 'Tools']]] with: ScriptingSystem newScriptingSpace"! Item was changed: ----- Method: FlapTab>>computeEdgeFraction (in category 'edge') ----- computeEdgeFraction "Compute and remember the edge fraction" | aBox aFraction | self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]]. + aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2). + aFraction := self - aBox _ ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2). - aFraction _ self ifVertical: [(self center y - aBox top) / (aBox height max: 1)] ifHorizontal: [(self center x - aBox left) / (aBox width max: 1)]. ^ self edgeFraction: aFraction! Item was changed: ----- Method: Flaps class>>enableDisableGlobalFlapWithID: (in category 'menu commands') ----- enableDisableGlobalFlapWithID: aFlapID "Toggle the enable/disable status of the given global flap" | disabledFlapIDs aFlapTab currentProject | + (currentProject := Project current) assureFlapIntegrity. - (currentProject _ Project current) assureFlapIntegrity. Smalltalk isMorphic ifFalse: [^ self]. + disabledFlapIDs := currentProject parameterAt: #disabledGlobalFlapIDs. + (aFlapTab := self globalFlapTabWithID: aFlapID) ifNotNil: - disabledFlapIDs _ currentProject parameterAt: #disabledGlobalFlapIDs. - (aFlapTab _ self globalFlapTabWithID: aFlapID) ifNotNil: [aFlapTab hideFlap]. (disabledFlapIDs includes: aFlapID) ifTrue: [disabledFlapIDs remove: aFlapID. self currentWorld addGlobalFlaps] ifFalse: [disabledFlapIDs add: aFlapID. aFlapTab ifNotNil: [aFlapTab delete]]. self doAutomaticLayoutOfFlapsIfAppropriate! Item was changed: ----- Method: FlapTab>>applyEdgeFractionWithin: (in category 'edge') ----- applyEdgeFractionWithin: aBoundsRectangle "Make the receiver reflect remembered edgeFraction" | newPosition | edgeFraction ifNil: [^ self]. self isCurrentlySolid ifTrue: [^ self]. + newPosition := self - newPosition _ self ifVertical: [self left @ (self edgeFraction * (aBoundsRectangle height - self height))] ifHorizontal: [(self edgeFraction * (aBoundsRectangle width - self width) @ self top)]. self position: (aBoundsRectangle origin + newPosition) ! Item was changed: ----- Method: Flaps class>>addMorph:asElementNumber:inGlobalFlapSatisfying: (in category 'construction support') ----- addMorph: aMorph asElementNumber: aNumber inGlobalFlapSatisfying: flapBlock "If any global flap satisfies flapBlock, add aMorph to it at the given position. Applies to flaps that are parts bins and that like thumbnailing" | aFlapTab flapPasteUp | + aFlapTab := self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. + flapPasteUp := aFlapTab referent. - aFlapTab _ self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. - flapPasteUp _ aFlapTab referent. flapPasteUp addMorph: aMorph asElementNumber: aNumber. flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true! Item was changed: ----- Method: Flaps class>>newSuppliesFlapFromQuads:positioning: (in category 'predefined flaps') ----- newSuppliesFlapFromQuads: quads positioning: positionSymbol "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 hPosition | + aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. - aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. "self twiddleSuppliesButtonsIn: aStrip." + aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. + hPosition := positionSymbol == #center - hPosition _ positionSymbol == #center ifTrue: [(Display width // 2) - (aFlapTab width // 2)] ifFalse: [Display width - (aFlapTab width + 22)]. aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: self currentWorld width @ 136. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Supplies' translated"! Item was changed: ----- Method: FlapTab>>openFully (in category 'show & hide') ----- openFully "Make an educated guess at how wide or tall we are to be, and open to that thickness" | thickness amt | + thickness := referent boundingBoxOfSubmorphs extent max: (100 @ 100). + self applyThickness: (amt := self orientation == #horizontal - thickness _ referent boundingBoxOfSubmorphs extent max: (100 @ 100). - self applyThickness: (amt _ self orientation == #horizontal ifTrue: [thickness y] ifFalse: [thickness x]). self lastReferentThickness: amt. self showFlap! Item was changed: ----- Method: FlapTab>>objectForDataStream: (in category 'objects from disk') ----- objectForDataStream: refStrm "I am about to be written on an object file. If I am a global flap, write a proxy instead." | dp | self isGlobalFlap ifTrue: + [dp := DiskProxy global: #Flaps selector: #globalFlapTabOrDummy: - [dp _ DiskProxy global: #Flaps selector: #globalFlapTabOrDummy: args: {self flapID}. refStrm replace: self with: dp. ^ dp]. ^ super objectForDataStream: refStrm! Item was changed: ----- Method: FlapTab>>hideFlap (in category 'show & hide') ----- hideFlap | aWorld | + aWorld := self world ifNil: [self currentWorld]. - aWorld _ self world ifNil: [self currentWorld]. referent privateDelete. aWorld removeAccommodationForFlap: self. + flapShowing := false. - flapShowing _ false. self isInWorld ifFalse: [aWorld addMorphFront: self]. self adjustPositionAfterHidingFlap. aWorld haloMorphs do: [:m | m target isInWorld ifFalse: [m delete]]! Item was changed: ----- Method: FlapTab>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" + edgeToAdhereTo := #left. + flapShowing := false. + slidesOtherObjects := false. + popOutOnDragOver := false. + popOutOnMouseOver := false. + inboard := false. + dragged := false! - edgeToAdhereTo _ #left. - flapShowing _ false. - slidesOtherObjects _ false. - popOutOnDragOver _ false. - popOutOnMouseOver _ false. - inboard _ false. - dragged _ false! Item was changed: ----- Method: Flaps class>>addGlobalFlap: (in category 'shared flaps') ----- addGlobalFlap: aFlapTab "Add the given flap tab to the list of shared flaps" + SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. - SharedFlapTabs ifNil: [SharedFlapTabs _ OrderedCollection new]. SharedFlapTabs add: aFlapTab! Item was changed: ----- Method: Flaps class>>sharedFlapsAllowed (in category 'shared flaps') ----- sharedFlapsAllowed "Answer whether the shared flaps feature is allowed in this system" + ^ SharedFlapsAllowed ifNil: [SharedFlapsAllowed := SharedFlapTabs isEmptyOrNil not]! - ^ SharedFlapsAllowed ifNil: [SharedFlapsAllowed _ SharedFlapTabs isEmptyOrNil not]! Item was changed: ----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') ----- initializeFor: aPlayer topAt: aTop + scriptedPlayer := aPlayer. - scriptedPlayer _ aPlayer. self useGraphicalTab. self top: aTop! Item was changed: ----- Method: FlapTab>>applyThickness: (in category 'menu') ----- applyThickness: newThickness | toUse | + toUse := newThickness asNumber max: 0. - toUse _ newThickness asNumber max: 0. (self orientation == #vertical) ifTrue: [referent width: toUse] ifFalse: [referent height: toUse]. self positionReferent. self adjustPositionVisAVisFlap! Item was changed: ----- Method: FlapTab>>setEdgeToAdhereTo (in category 'edge') ----- setEdgeToAdhereTo | aMenu | + aMenu := MenuMorph new defaultTarget: self. - aMenu _ MenuMorph new defaultTarget: self. #(left top right bottom) do: [:sym | aMenu add: sym asString translated target: self selector: #setEdge: argument: sym]. aMenu popUpEvent: self currentEvent in: self world! Item was changed: ----- Method: Flaps class>>globalFlapTabOrDummy: (in category 'shared flaps') ----- globalFlapTabOrDummy: aName "Answer a global flap tab in the current image with the given name. If none is found, answer a dummy StringMorph for some reason (check with tk about the use of this)" | gg | + (gg := self globalFlapTab: aName) ifNil: - (gg _ self globalFlapTab: aName) ifNil: [^ StringMorph contents: aName, ' can''t be found']. ^ gg! Item was changed: ----- Method: Flaps class>>positionNavigatorAndOtherFlapsAccordingToPreference (in category 'shared flaps') ----- positionNavigatorAndOtherFlapsAccordingToPreference "Lay out flaps along the designated edge right-to-left, possibly positioning the navigator flap, exceptionally, on the left." | ids | + ids := Preferences navigatorOnLeftEdge ifTrue: [{'Navigator' translated}] ifFalse: [#()]. - ids _ Preferences navigatorOnLeftEdge ifTrue: [{'Navigator' translated}] ifFalse: [#()]. Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapsWithIDs: ids "Flaps positionNavigatorAndOtherFlapsAccordingToPreference"! Item was changed: ----- Method: FlapTab>>adaptToWorld (in category 'initialization') ----- adaptToWorld | wasShowing new | + (wasShowing := self flapShowing) ifTrue: - (wasShowing _ self flapShowing) ifTrue: [self hideFlap]. (self respondsTo: #unhibernate) ifTrue: [ + (new := self unhibernate) == self ifFalse: [ - (new _ self unhibernate) == self ifFalse: [ ^ new adaptToWorld]]. self spanWorld. self positionObject: self. wasShowing ifTrue: [self showFlap]! Item was changed: ----- Method: FlapTab>>destroyFlap (in category 'menu') ----- destroyFlap "Destroy the receiver" | reply request | + request := self isGlobalFlap - request _ self isGlobalFlap ifTrue: ['Caution -- this would permanently remove this flap, so it would no longer be available in this or any other project. Do you really want to this? '] ifFalse: ['Caution -- this is permanent!! Do you really want to do this? ']. + reply := self confirm: request translated orCancel: [^ self]. - reply _ self confirm: request translated orCancel: [^ self]. reply ifTrue: [self isGlobalFlap ifTrue: [Flaps removeFlapTab: self keepInList: false. self currentWorld reformulateUpdatingMenus] ifFalse: [referent isInWorld ifTrue: [referent delete]. self delete]]! Item was changed: ----- Method: FlapTab>>mouseUp: (in category 'event handling') ----- mouseUp: evt "The mouse came back up, presumably after having dragged the tab. Caution: if not operating full-screen, this notification can easily be *missed*, which is why the edge-fraction-computation is also being done on mouseMove." super mouseUp: evt. (self referentThickness <= 0 or: [(referent isInWorld and: [(referent boundsInWorld intersects: referent owner boundsInWorld) not])]) ifTrue: [self hideFlap. + flapShowing := false]. - flapShowing _ false]. self fitOnScreen. dragged ifTrue: [self computeEdgeFraction. + dragged := false]. - dragged _ false]. Flaps doAutomaticLayoutOfFlapsIfAppropriate! Item was changed: ----- Method: Flaps class>>globalFlapTab: (in category 'shared flaps') ----- globalFlapTab: aName "Answer the global flap tab in the current system whose flapID is the same as aName, or nil if none found." | idToMatch | + idToMatch := (aName beginsWith: 'flap: ') - idToMatch _ (aName beginsWith: 'flap: ') ifTrue: "Ted's old scheme; this convention may still be found in pre-existing content that has been externalized" [aName copyFrom: 7 to: aName size] ifFalse: [aName]. ^ self globalFlapTabsIfAny detect: [:ft | ft flapID = idToMatch] ifNone: [nil]! Item was changed: ----- Method: FlapTab>>positionObject: (in category 'positioning') ----- positionObject: anObject "anObject could be myself or my referent" + "Could consider container := referent pasteUpMorph, to allow flaps on things other than the world, but for the moment, let's skip it!!" - "Could consider container _ referent pasteUpMorph, to allow flaps on things other than the world, but for the moment, let's skip it!!" "19 sept 2000 - going for all paste ups" | pum | + pum := self pasteUpMorph ifNil: [^ self]. - pum _ self pasteUpMorph ifNil: [^ self]. ^self positionObject: anObject atEdgeOf: pum clearArea! Item was changed: ----- Method: Flaps class>>replaceGlobalFlapwithID: (in category 'replacement') ----- replaceGlobalFlapwithID: flapID "If there is a global flap with flapID, replace it with an updated one." | replacement tabs | + (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. - (tabs _ self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. tabs do: [:tab | self removeFlapTab: tab keepInList: false]. + flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. + flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlapFromQuads: - flapID = 'Stack Tools' translated ifTrue: [replacement _ self newStackToolsFlap]. - flapID = 'Supplies' translated ifTrue: [replacement _ self newSuppliesFlapFromQuads: (Preferences eToyFriendly ifFalse: [self quadsDefiningSuppliesFlap] ifTrue: [self quadsDefiningPlugInSuppliesFlap]) positioning: #right]. + flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. + flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. + flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. + flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. - flapID = 'Tools' translated ifTrue: [replacement _ self newToolsFlap]. - flapID = 'Widgets' translated ifTrue: [replacement _ self newWidgetsFlap]. - flapID = 'Navigator' translated ifTrue: [replacement _ self newNavigatorFlap]. - flapID = 'Squeak' translated ifTrue: [replacement _ self newSqueakFlap]. replacement ifNil: [^ self]. self addGlobalFlap: replacement. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps] "Flaps replaceFlapwithID: 'Widgets' translated "! Item was changed: ----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') ----- newNavigatorFlap "Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. " | aFlapTab navBar aFlap | + navBar := ProjectNavigationMorph preferredNavigator new. + aFlap := PasteUpMorph newSticky borderWidth: 0; - navBar _ ProjectNavigationMorph preferredNavigator new. - aFlap _ PasteUpMorph newSticky borderWidth: 0; extent: navBar extent + (0 at 20); color: (Color orange alpha: 0.8); beFlap: true; addMorph: navBar beSticky. aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFlap useRoundedCorners. aFlap setNameTo: 'Navigator Flap' translated. navBar fullBounds. "to establish width" + aFlapTab := FlapTab new referent: aFlap. - aFlapTab _ FlapTab new referent: aFlap. aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange. aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2)) @ (self currentWorld height - aFlapTab height). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Navigator' translated " ! Item was changed: ----- Method: Flaps class>>initializeFlapsQuads (in category 'flaps registry') ----- initializeFlapsQuads "initialize the list of dynamic flaps quads. self initializeFlapsQuads" + FlapsQuads := nil. - FlapsQuads _ nil. self registeredFlapsQuads at: 'PlugIn Supplies' put: self defaultsQuadsDefiningPlugInSuppliesFlap; at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap.. ^ self registeredFlapsQuads! Item was changed: ----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') ----- newLoneSuppliesFlap "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch" | aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly" + aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #( - aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts') (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' ) (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners') (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle') (StarMorph authoringPrototype 'Star' 'A star') (CurveMorph authoringPrototype 'Curve' 'A curve') (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides') (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.') (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.') (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control') (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.') (ScriptableButton authoringPrototype 'Button' 'A Scriptable button') (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations') (BookMorph authoringPrototype 'Book' 'A multi-paged structure') (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something') (ClockMorph authoringPrototype 'Clock' 'A simple digital clock') (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page') (BookMorph nextPageButton 'Next' 'A button that takes you to the next page') ). + aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. aStrip extent: self currentWorld width @ 78. + leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2. - leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2. aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)). aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab! Item was changed: ----- Method: FlapTab>>maybeHideFlapOnMouseLeaveDragging (in category 'show & hide') ----- maybeHideFlapOnMouseLeaveDragging | aWorld | self hasHalo ifTrue: [^ self]. referent isInWorld ifFalse: [^ self]. (dragged or: [referent bounds containsPoint: self cursorPoint]) ifTrue: [^ self]. + aWorld := self world. - aWorld _ self world. referent privateDelete. "could make me worldless if I'm inboard" aWorld ifNotNil: [aWorld removeAccommodationForFlap: self]. + flapShowing := false. - flapShowing _ false. self isInWorld ifFalse: [aWorld addMorphFront: self]. self adjustPositionAfterHidingFlap! Item was changed: ----- Method: Flaps class>>setUpSuppliesFlapOnly (in category 'menu support') ----- setUpSuppliesFlapOnly "Set up the Supplies flap as the only shared flap. A special version formulated for this stand-alone use is used, defined in #newLoneSuppliesFlap" | supplies | SharedFlapTabs isEmptyOrNil ifFalse: "get rid of pre-existing guys if any" [SharedFlapTabs do: [:t | t referent delete. t delete]]. + SharedFlapsAllowed := true. + SharedFlapTabs := OrderedCollection new. + SharedFlapTabs add: (supplies := self newLoneSuppliesFlap). - SharedFlapsAllowed _ true. - SharedFlapTabs _ OrderedCollection new. - SharedFlapTabs add: (supplies _ self newLoneSuppliesFlap). self enableGlobalFlapWithID: 'Supplies' translated. supplies setToPopOutOnMouseOver: false. Smalltalk isMorphic ifTrue: [ActiveWorld addGlobalFlaps. ActiveWorld reformulateUpdatingMenus]! Item was changed: ----- Method: MorphicModel>>compileInitMethods (in category '*MorphicExtras-compilation') ----- compileInitMethods | s nodeDict varNames | + nodeDict := IdentityDictionary new. + s := WriteStream on: (String new: 2000). + varNames := self class allInstVarNames. - nodeDict _ IdentityDictionary new. - s _ WriteStream on: (String new: 2000). - varNames _ self class allInstVarNames. s nextPutAll: 'initMorph'. 3 to: self class instSize do: [:i | (self instVarAt: i) isMorph ifTrue: + [s cr; tab; nextPutAll: (varNames at: i) , ' := '. - [s cr; tab; nextPutAll: (varNames at: i) , ' _ '. s nextPutAll: (self instVarAt: i) initString; nextPutAll: '.'. nodeDict at: (self instVarAt: i) put: (varNames at: i)]]. submorphs do: [:m | s cr; tab; nextPutAll: 'self addMorph: '. m printConstructorOn: s indent: 1 nodeDict: nodeDict. s nextPutAll: '.']. self class compile: s contents classified: 'initialization' notifying: nil.! Item was changed: ----- Method: Flaps class>>newSqueakFlap (in category 'predefined flaps') ----- newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen" | aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | + aFlap := PasteUpMorph newSticky borderWidth: 0. + aFlapTab := FlapTab new referent: aFlap. - aFlap _ PasteUpMorph newSticky borderWidth: 0. - aFlapTab _ FlapTab new referent: aFlap. aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aFlap cellInset: 14 at 14. aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 150 @ self currentWorld height. aFlap layoutPolicy: TableLayout new. aFlap wrapCentering: #topLeft. aFlap layoutInset: 2. aFlap listDirection: #topToBottom. aFlap wrapDirection: #leftToRight. "self addProjectNavigationButtonsTo: aFlap." + anOffset := 16. - anOffset _ 16. + aClock := ClockMorph newSticky. - aClock _ ClockMorph newSticky. aClock color: Color red. aClock showSeconds: false. aClock font: (TextStyle default fontAt: 3). aClock step. aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. aFlap addCenteredAtBottom: aClock offset: anOffset. + buttonColor := Color cyan muchLighter. + bb := SimpleButtonMorph new target: SmalltalkImage current. - buttonColor _ Color cyan muchLighter. - bb _ SimpleButtonMorph new target: SmalltalkImage current. bb color: buttonColor. + aButton := bb copy. - aButton _ bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. + aButton label: 'save' translated font: (aFont := ScriptingSystem fontForTiles). - aButton label: 'save' translated font: (aFont _ ScriptingSystem fontForTiles). aFlap addCenteredAtBottom: aButton offset: anOffset. + aButton := bb copy target: Utilities. - aButton _ bb copy target: Utilities. aButton actionSelector: #updateFromServer. aButton label: 'load code updates' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. + aButton := SimpleButtonMorph new target: SmalltalkImage current; actionSelector: #aboutThisSystem; - aButton _ SimpleButtonMorph new target: SmalltalkImage current; actionSelector: #aboutThisSystem; label: 'about this system' translated font: aFont. aButton color: buttonColor. aButton setBalloonText: 'click here to find out version information' translated. aFlap addCenteredAtBottom: aButton offset: anOffset. aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset. + aButton := TrashCanMorph newSticky. - aButton _ TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Squeak' translated "! Item was changed: ----- Method: FlapTab>>inboard: (in category 'disused options') ----- inboard: aBoolean + inboard := aBoolean! - inboard _ aBoolean! Item was changed: ----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') ----- 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. - id _ self flapID. #( ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects') ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.') ('Widgets' 'A variety of controls and media tools') ('Supplies' 'A source for many basic types of objects') ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented') ('Scripting' 'Tools useful when doing tile scripting') ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment') ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do: [:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]]. ^ self balloonText! Item was changed: ----- Method: FlapTab>>setEdge: (in category 'edge') ----- setEdge: anEdge "Set the edge as indicated, if possible" | newOrientation e | + e := anEdge asSymbol. - e _ anEdge asSymbol. self edgeToAdhereTo = anEdge ifTrue: [^ self]. + newOrientation := nil. - newOrientation _ nil. self orientation == #vertical ifTrue: [(#top == e or: [#bottom == e]) ifTrue: + [newOrientation := #horizontal]] - [newOrientation _ #horizontal]] ifFalse: [(#top == e or: [#bottom == e]) ifFalse: + [newOrientation := #vertical]]. - [newOrientation _ #vertical]]. self edgeToAdhereTo: e. newOrientation ifNotNil: [self transposeParts]. referent isInWorld ifTrue: [self positionReferent]. self adjustPositionVisAVisFlap! Item was changed: ----- Method: FlapTab>>showFlap (in category 'show & hide') ----- showFlap "Open the flap up" | thicknessToUse flapOwner | "19 sept 2000 - going for all paste ups <- raa note" + flapOwner := self pasteUpMorph. - flapOwner _ self pasteUpMorph. self referentThickness <= 0 ifTrue: + [thicknessToUse := lastReferentThickness ifNil: [100]. - [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" flapOwner addMorphFront: referent. flapOwner startSteppingSubmorphsOf: referent. self positionReferent. referent adaptToWorld: flapOwner]. inboard ifFalse: [self adjustPositionVisAVisFlap]. + flapShowing := true. - flapShowing _ true. self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo. flapOwner bringTopmostsToFront! Item was changed: ----- Method: FlapTab>>mouseMove: (in category 'event handling') ----- mouseMove: evt | aPosition newReferentThickness adjustedPosition thick | + dragged ifFalse: [(thick := self referentThickness) > 0 + ifTrue: [lastReferentThickness := thick]]. + ((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not]) - 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. - adjustedPosition _ aPosition - evt hand targetOffset. (edgeToAdhereTo == #bottom) ifTrue: + [newReferentThickness := inboard - [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]]. self applyThickness: newReferentThickness. + dragged := true. - dragged _ true. self fitOnScreen. self computeEdgeFraction]! Item was changed: ----- Method: Flaps class>>paintFlapButton (in category 'miscellaneous') ----- paintFlapButton "Answer a button to serve as the paint flap" | pb oldArgs brush myButton m | + pb := PaintBoxMorph new submorphNamed: #paint:. - pb _ PaintBoxMorph new submorphNamed: #paint:. pb ifNil: + [(brush := Form extent: 16 at 16 depth: 16) fillColor: Color red] - [(brush _ Form extent: 16 at 16 depth: 16) fillColor: Color red] ifNotNil: + [oldArgs := pb arguments. + brush := oldArgs third. + brush := brush copy: (2 at 0 extent: 42 at 38). + brush := brush scaledToSize: brush extent // 2]. + myButton := BorderedMorph new. - [oldArgs _ pb arguments. - brush _ oldArgs third. - brush _ brush copy: (2 at 0 extent: 42 at 38). - brush _ brush scaledToSize: brush extent // 2]. - myButton _ BorderedMorph new. myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderWidth: 2; borderColor: #raised. + myButton addMorph: (m := brush asMorph lock). - myButton addMorph: (m _ brush asMorph lock). myButton extent: m extent + (myButton borderWidth + 6). m position: myButton center - (m extent // 2). ^ myButton ! Item was changed: ----- Method: Flaps class>>clobberFlapTabList (in category 'flap mechanics') ----- clobberFlapTabList "Flaps clobberFlapTabList" + SharedFlapTabs := nil! - SharedFlapTabs _ nil! Item was changed: ----- Method: FlapTab>>lastReferentThickness: (in category 'show & hide') ----- lastReferentThickness: anInteger "Set the last remembered referent thickness to the given integer" + lastReferentThickness := anInteger! - lastReferentThickness _ anInteger! Item was changed: ----- Method: FlapTab>>fitOnScreen (in category 'positioning') ----- fitOnScreen "19 sept 2000 - allow flaps in any paste up" | constrainer t l | + constrainer := (owner ifNil: [self]) clearArea. - constrainer _ (owner ifNil: [self]) clearArea. 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 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 min: (constrainer right - self width)) max: constrainer left). l = self left ifFalse: [self left: l]. ]. self flapShowing ifFalse: [self positionObject: self atEdgeOf: constrainer]. ! Item was changed: ----- Method: Flaps class>>deleteMorphsSatisfying:fromGlobalFlapSatisfying: (in category 'construction support') ----- deleteMorphsSatisfying: deleteBlock fromGlobalFlapSatisfying: flapBlock "If any global flap satisfies flapBlock, then delete objects satisfying from deleteBlock from it. Occasionally called from do-its in updates or other fileouts." | aFlapTab flapPasteUp | + aFlapTab := self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. + flapPasteUp := aFlapTab referent. - aFlapTab _ self globalFlapTabsIfAny detect: [:aTab | flapBlock value: aTab] ifNone: [^ self]. - flapPasteUp _ aFlapTab referent. flapPasteUp submorphs do: [:aMorph | (deleteBlock value: aMorph) ifTrue: [aMorph delete]]! Item was changed: ----- Method: FlapTab>>adjustPositionVisAVisFlap (in category 'positioning') ----- adjustPositionVisAVisFlap | sideToAlignTo opposite | + opposite := Utilities oppositeSideTo: edgeToAdhereTo. + sideToAlignTo := inboard - opposite _ Utilities oppositeSideTo: edgeToAdhereTo. - sideToAlignTo _ inboard ifTrue: [opposite] ifFalse: [edgeToAdhereTo]. self perform: (Utilities simpleSetterFor: sideToAlignTo) with: (referent perform: opposite)! Item was changed: ----- Method: FlapTab>>startOrFinishDrawing: (in category 'mouseover & dragover') ----- startOrFinishDrawing: evt | w | self flapShowing ifTrue:[ + (w := self world) makeNewDrawing: evt at: w center. - (w _ self world) makeNewDrawing: evt at: w center. ] ifFalse:[ self world endDrawing: evt. ].! Item was changed: ----- Method: FlapTab>>hideFlapUnlessOverReferent (in category 'show & hide') ----- hideFlapUnlessOverReferent "Hide the flap unless the mouse is over my referent." | aWorld where | (referent isInWorld and: + [where := self outermostWorldMorph activeHand lastEvent cursorPoint. - [where _ self outermostWorldMorph activeHand lastEvent cursorPoint. referent bounds containsPoint: (referent globalPointToLocal: where)]) ifTrue: [^ self]. + (aWorld := self world) ifNil: [^ self]. "In case flap tabs just got hidden" - (aWorld _ self world) ifNil: [^ self]. "In case flap tabs just got hidden" self referent delete. aWorld removeAccommodationForFlap: self. + flapShowing := false. - flapShowing _ false. self isInWorld ifFalse: [self inboard ifTrue: [aWorld addMorphFront: self]]. self adjustPositionAfterHidingFlap! Item was changed: ----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') ----- disableGlobalFlaps: interactive "Clobber all the shared flaps structures. First read the user her Miranda rights." interactive ifTrue: [(self confirm: 'CAUTION!! This will destroy all the shared flaps, so that they will not be present in *any* project. If, later, you want them back, you will have to reenable them, from this same menu, whereupon the standard default set of shared flaps will be created. Do you really want to go ahead and clobber all shared flaps at this time?' translated) ifFalse: [^ self]]. self globalFlapTabsIfAny do: [:aFlapTab | self removeFlapTab: aFlapTab keepInList: false. aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]]. self clobberFlapTabList. + SharedFlapsAllowed := false. - SharedFlapsAllowed _ false. Smalltalk isMorphic ifTrue: [ActiveWorld restoreMorphicDisplay. ActiveWorld reformulateUpdatingMenus]. "The following reduces the risk that flaps will be created with variant IDs such as 'Stack Tools2', potentially causing some shared flap logic to fail." "Smalltalk garbageCollect." "-- see if we are OK without this" ! Item was changed: ----- Method: RemoteHandMorph>>transmitEvent: (in category 'event handling') ----- transmitEvent: aMorphicEvent "Transmit the given event to all remote connections." | firstEvt | self readyToTransmit ifFalse: [^ self]. self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. + sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. - sendBuffer ifNil: [sendBuffer _ WriteStream on: (String new: 10000)]. sendBuffer nextPutAll: aMorphicEvent storeString; cr. self lastEventTransmitted: aMorphicEvent. sendSocket isConnected ifTrue:[ sendState = #opening ifTrue: [ "connection established; disable TCP delays on sends" sendSocket setOption: 'TCP_NODELAY' value: true. "send worldExtent as first event" + firstEvt := MorphicUnknownEvent type: #worldBounds argument: self worldBounds extent. - firstEvt _ MorphicUnknownEvent type: #worldBounds argument: self worldBounds extent. sendSocket sendData: firstEvt storeString, (String with: Character cr). Transcript show: 'Connection established with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. + sendState := #connected]. - sendState _ #connected]. sendSocket sendData: sendBuffer contents. ] ifFalse: [ owner primaryHand removeEventListener: self. sendState = #connected ifTrue: [ "other end has closed; close our end" Transcript show: 'Closing connection with remote WorldMorph at '; show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. sendSocket close. + sendState := #closing]]. - sendState _ #closing]]. sendBuffer reset. ! Item was changed: ----- Method: FlapTab>>changeTabText: (in category 'textual tabs') ----- changeTabText: aString | label | aString isEmptyOrNil ifTrue: [^ self]. + label := Locale current languageEnvironment class flapTabTextFor: aString in: self. - label _ Locale current languageEnvironment class flapTabTextFor: aString in: self. label isEmptyOrNil ifTrue: [^ self]. self useStringTab: label. submorphs first delete. self assumeString: label font: Preferences standardFlapFont orientation: (Flaps orientationForEdge: self edgeToAdhereTo) color: nil. ! Item was changed: ----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') ----- addAndEnableEToyFlaps "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. - SharedFlapTabs _ OrderedCollection new. + aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right. - aSuppliesFlap _ self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right. 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 showProjectNavigator ifTrue:[ SharedFlapTabs add: self newNavigatorFlap ]. self enableGlobalFlapWithID: 'Supplies' translated. Preferences showProjectNavigator ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated ]. + SharedFlapsAllowed := true. - SharedFlapsAllowed _ true. Project current flapsSuppressed: false. ^ SharedFlapTabs "Flaps addAndEnableEToyFlaps"! Item was changed: ----- Method: FlapTab>>toggleMouseOverBehavior (in category 'mouseover & dragover') ----- toggleMouseOverBehavior + self arrangeToPopOutOnMouseOver: (popOutOnMouseOver := popOutOnMouseOver not)! - self arrangeToPopOutOnMouseOver: (popOutOnMouseOver _ popOutOnMouseOver not)! Item was changed: ----- Method: FlapTab>>useStringTab: (in category 'textual tabs') ----- useStringTab: aString | aLabel | + labelString := aString asString. + aLabel := StringMorph new contents: labelString. - labelString _ aString asString. - aLabel _ StringMorph new contents: labelString. self addMorph: aLabel. aLabel position: self position. aLabel highlightColor: self highlightColor; regularColor: self regularColor. aLabel lock. self fitContents. self layoutChanged! Item was changed: ----- Method: FlapTab>>setToPopOutOnMouseOver: (in category 'mouseover & dragover') ----- setToPopOutOnMouseOver: aBoolean + self arrangeToPopOutOnMouseOver: (popOutOnMouseOver := aBoolean)! - self arrangeToPopOutOnMouseOver: (popOutOnMouseOver _ aBoolean)! Item was changed: ----- Method: Flaps class>>globalFlapWithIDEnabledString: (in category 'menu support') ----- globalFlapWithIDEnabledString: aFlapID "Answer the string to be shown in a menu to represent the status of the givne flap regarding whether it it should be shown in this project." | aFlapTab wording | + aFlapTab := self globalFlapTabWithID: aFlapID. + wording := aFlapTab ifNotNil: [aFlapTab wording] ifNil: ['(', aFlapID, ')']. - aFlapTab _ self globalFlapTabWithID: aFlapID. - wording _ aFlapTab ifNotNil: [aFlapTab wording] ifNil: ['(', aFlapID, ')']. ^ (Project current isFlapIDEnabled: aFlapID) ifTrue: ['<on>', wording] ifFalse: ['<off>', wording]! Item was changed: ----- Method: Flaps class>>newWidgetsFlap (in category 'predefined flaps') ----- newWidgetsFlap "Answer a newly-created flap which adheres to the bottom edge of the screen and which holds prototypes of standard widgets. " | aFlapTab aStrip | + aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: (Color blue muchLighter alpha: 0.8) - aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: (Color blue muchLighter alpha: 0.8) from: self quadsDefiningWidgetsFlap. + aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Widgets' translated edge: #bottom color: Color blue lighter lighter. aFlapTab position: ((Display width - (aFlapTab width + 122)) @ (self currentWorld height - aFlapTab height)). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: self currentWorld width @ 78. aStrip beFlap: true. aStrip autoLineLayout: true. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Widgets' translated " ! Item was changed: ----- Method: Flaps class>>newToolsFlap (in category 'predefined flaps') ----- newToolsFlap "Answer a newly-created flap which adheres to the right edge of the screen and which holds prototypes of standard tools." | aFlapTab aStrip | + aStrip := PartsBin newPartsBinWithOrientation: #topToBottom andColor: (Color orange muchLighter alpha: 0.8) from: self quadsDefiningToolsFlap. - aStrip _ PartsBin newPartsBinWithOrientation: #topToBottom andColor: (Color orange muchLighter alpha: 0.8) from: self quadsDefiningToolsFlap. + aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Tools' translated edge: #right color: Color orange lighter. aFlapTab position: (self currentWorld width - aFlapTab width) @ ((Display height - aFlapTab height) // 2). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: (90 @ self currentWorld height). aStrip beFlap: true. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Tools' translated " ! Item was changed: ----- Method: FlapTab>>provideDefaultFlapIDBasedOn: (in category 'initialization') ----- provideDefaultFlapIDBasedOn: aStem "Provide the receiver with a default flap id" | aNumber usedIDs anID | + aNumber := 0. + usedIDs := FlapTab allSubInstances select: [:f | f ~~ self] thenCollect: [:f | f flapIDOrNil]. + anID := aStem. - aNumber _ 0. - usedIDs _ FlapTab allSubInstances select: [:f | f ~~ self] thenCollect: [:f | f flapIDOrNil]. - anID _ aStem. [usedIDs includes: anID] whileTrue: + [aNumber := aNumber + 1. + anID := aStem, (aNumber asString)]. - [aNumber _ aNumber + 1. - anID _ aStem, (aNumber asString)]. self flapID: anID. ^ anID! Item was changed: ----- Method: Flaps class>>newObjectsFlap (in category 'predefined flaps') ----- newObjectsFlap "Answer a fully-instantiated flap named 'Objects' to be placed at the top of the screen." | aFlapTab anObjectsTool | + anObjectsTool := ObjectsTool new. - anObjectsTool _ ObjectsTool new. anObjectsTool initializeForFlap. + aFlapTab := FlapTab new referent: anObjectsTool beSticky. - aFlapTab _ FlapTab new referent: anObjectsTool beSticky. aFlapTab setName: 'Objects' translated edge: #top color: Color red lighter. aFlapTab position: ((Display width - (aFlapTab width + 22)) @ 0). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. anObjectsTool extent: self currentWorld width @ 200. anObjectsTool beFlap: true. anObjectsTool color: Color red muchLighter. anObjectsTool clipSubmorphs: true. anObjectsTool showCategories. ^ aFlapTab! Item was changed: ----- Method: FlapTab>>toggleIsGlobalFlap (in category 'globalness') ----- toggleIsGlobalFlap "Toggle whether the receiver is currently a global flap or not" | oldWorld | self hideFlap. + oldWorld := self currentWorld. - oldWorld _ self currentWorld. self isGlobalFlap ifTrue: [Flaps removeFromGlobalFlapTabList: self. oldWorld addMorphFront: self] ifFalse: [self delete. Flaps addGlobalFlap: self. self currentWorld addGlobalFlaps]. ActiveWorld reformulateUpdatingMenus ! Item was changed: ----- Method: FlapTab>>stickOntoReferent (in category 'positioning') ----- stickOntoReferent "Place the receiver directly onto the referent -- for use when the referent is being shown as a flap" | newPosition | referent addMorph: self. edgeToAdhereTo == #left ifTrue: + [newPosition := (referent width - self width) @ self top]. - [newPosition _ (referent width - self width) @ self top]. edgeToAdhereTo == #right ifTrue: + [newPosition := (referent left @ self top)]. - [newPosition _ (referent left @ self top)]. edgeToAdhereTo == #top ifTrue: + [newPosition := self left @ (referent height - self height)]. - [newPosition _ self left @ (referent height - self height)]. edgeToAdhereTo == #bottom ifTrue: + [newPosition := self left @ referent top]. - [newPosition _ self left @ referent top]. self position: newPosition! Item was changed: ----- Method: Flaps class>>removeDuplicateFlapTabs (in category 'shared flaps') ----- removeDuplicateFlapTabs "Remove flaps that were accidentally added multiple times" "Flaps removeDuplicateFlapTabs" | tabs duplicates | SharedFlapTabs copy ifNil: [^self]. + tabs := SharedFlapTabs copy. + duplicates := Set new. - tabs _ SharedFlapTabs copy. - duplicates _ Set new. tabs do: [:tab | | same | + same := tabs select: [:each | each wording = tab wording]. - same _ tabs select: [:each | each wording = tab wording]. same isEmpty not ifTrue: [ same removeFirst. duplicates addAll: same]]. SharedFlapTabs removeAll: duplicates! Item was changed: ----- Method: Flaps class>>enableGlobalFlaps (in category 'menu support') ----- enableGlobalFlaps "Start using global flaps, given that they were not present." Cursor wait showWhile: + [SharedFlapsAllowed := true. - [SharedFlapsAllowed _ true. self globalFlapTabs. "This will create them" Smalltalk isMorphic ifTrue: [ActiveWorld addGlobalFlaps. self doAutomaticLayoutOfFlapsIfAppropriate. FlapTab allInstancesDo: [:aTab | aTab computeEdgeFraction]. ActiveWorld reformulateUpdatingMenus]]! Item was changed: ----- Method: Flaps class>>initializeStandardFlaps (in category 'predefined flaps') ----- initializeStandardFlaps "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." + SharedFlapTabs := nil. - SharedFlapTabs _ nil. self addStandardFlaps! Item was changed: ----- Method: Flaps class>>enableGlobalFlapWithID: (in category 'menu commands') ----- enableGlobalFlapWithID: aFlapID "Remove any memory of this flap being disabled in this project" | disabledFlapIDs currentProject | + (currentProject := Project current) assureFlapIntegrity. - (currentProject _ Project current) assureFlapIntegrity. Smalltalk isMorphic ifFalse: [^ self]. + disabledFlapIDs := currentProject parameterAt: #disabledGlobalFlapIDs ifAbsent: [^ self]. - disabledFlapIDs _ currentProject parameterAt: #disabledGlobalFlapIDs ifAbsent: [^ self]. disabledFlapIDs remove: aFlapID ifAbsent: [] ! Item was changed: ----- Method: FlapTab>>useTextualTab (in category 'textual tabs') ----- useTextualTab | stringToUse colorToUse | self preserveDetails. + colorToUse := self valueOfProperty: #priorColor ifAbsent: [Color green muchLighter]. - colorToUse _ self valueOfProperty: #priorColor ifAbsent: [Color green muchLighter]. submorphs notEmpty ifTrue: [self removeAllMorphs]. + stringToUse := self valueOfProperty: #priorWording ifAbsent: ['Unnamed Flap' translated]. - stringToUse _ self valueOfProperty: #priorWording ifAbsent: ['Unnamed Flap' translated]. self assumeString: stringToUse font: Preferences standardFlapFont orientation: self orientation color: colorToUse! Item was changed: ----- Method: Flaps class>>newFlapTitled:onEdge:inPasteUp: (in category 'new flap') ----- newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph "Add a flap with the given title, placing it on the given edge, in the given pasteup" | aFlapBody aFlapTab | + aFlapBody := PasteUpMorph newSticky. + aFlapTab := FlapTab new referent: aFlapBody. - aFlapBody _ PasteUpMorph newSticky. - aFlapTab _ FlapTab new referent: aFlapBody. aFlapTab setName: aString edge: anEdge color: (Color r: 0.516 g: 0.452 b: 1.0). anEdge == #left ifTrue: [aFlapTab position: (aPasteUpMorph left @ aPasteUpMorph top). aFlapBody extent: (200 @ aPasteUpMorph height)]. anEdge == #right ifTrue: [aFlapTab position: ((aPasteUpMorph right - aFlapTab width) @ aPasteUpMorph top). aFlapBody extent: (200 @ aPasteUpMorph height)]. anEdge == #top ifTrue: [aFlapTab position: ((aPasteUpMorph left + 50) @ aPasteUpMorph top). aFlapBody extent: (aPasteUpMorph width @ 200)]. anEdge == #bottom ifTrue: [aFlapTab position: ((aPasteUpMorph left + 50) @ (aPasteUpMorph bottom - aFlapTab height)). aFlapBody extent: (aPasteUpMorph width @ 200)]. aFlapBody beFlap: true. aFlapBody color: self defaultColorForFlapBackgrounds. ^ aFlapTab! Item was changed: ----- Method: FlapTab>>toggleDragOverBehavior (in category 'mouseover & dragover') ----- toggleDragOverBehavior + self arrangeToPopOutOnDragOver: (popOutOnDragOver := popOutOnDragOver not)! - self arrangeToPopOutOnDragOver: (popOutOnDragOver _ popOutOnDragOver not)! Item was changed: ----- Method: Flaps class>>registeredFlapsQuads (in category 'flaps registry') ----- registeredFlapsQuads "Answer the list of dynamic flaps quads" + FlapsQuads ifNil: [FlapsQuads := Dictionary new]. - FlapsQuads ifNil: [FlapsQuads _ Dictionary new]. ^ FlapsQuads + " FlapsQuads := nil. "! - " FlapsQuads _ nil. "! Item was changed: ----- Method: FlapTab>>acquirePlausibleFlapID (in category 'access') ----- acquirePlausibleFlapID "Give the receiver a flapID that is globally unique; try to hit the mark vis a vis the standard system flap id's, for the case when this method is invoked as part of the one-time transition" | wording | + wording := self wording. + (wording isEmpty or: [wording = '---']) ifTrue: [wording := 'Flap' translated]. - wording _ self wording. - (wording isEmpty or: [wording = '---']) ifTrue: [wording _ 'Flap' translated]. ^ self provideDefaultFlapIDBasedOn: wording! Item was changed: ----- Method: Flaps class>>sharedFlapsAlongBottom (in category 'shared flaps') ----- sharedFlapsAlongBottom "Put all shared flaps (except Painting which can't be moved) along the bottom" "Flaps sharedFlapsAlongBottom" | leftX unordered ordered | + unordered := self globalFlapTabsIfAny asIdentitySet. + ordered := Array streamContents: - unordered _ self globalFlapTabsIfAny asIdentitySet. - ordered _ Array streamContents: [:s | { 'Squeak' translated. 'Navigator' translated. 'Supplies' translated. 'Widgets' translated. 'Stack Tools' translated. 'Tools' translated. 'Painting' translated. } do: [:id | (self globalFlapTabWithID: id) ifNotNil: [:ft | unordered remove: ft. id = 'Painting' translated ifFalse: [s nextPut: ft]]]]. "Pace off in order from right to left, setting positions" + leftX := Display width-15. - leftX _ Display width-15. ordered , unordered asArray reverseDo: [:ft | ft setEdge: #bottom. + ft right: leftX - 3. leftX := ft left]. - ft right: leftX - 3. leftX _ ft left]. "Put Nav Bar centered under tab if possible" (self globalFlapTabWithID: 'Navigator' translated) ifNotNil: [:ft | ft referent left: (ft center x - (ft referent width//2) max: 0)]. self positionNavigatorAndOtherFlapsAccordingToPreference. ! Item was changed: ----- Method: FlapTab>>preserveDetails (in category 'menu') ----- preserveDetails "The receiver is being switched to use a different format. Preserve the existing details (e.g. wording if textual, grapheme if graphical) so that if the user reverts back to the current format, the details will be right" | thickness | color = Color transparent ifFalse: [self setProperty: #priorColor toValue: color]. self isCurrentlyTextual ifTrue: [self setProperty: #priorWording toValue: self existingWording] ifFalse: [self isCurrentlyGraphical ifTrue: [self setProperty: #priorGraphic toValue: submorphs first form] ifFalse: + [thickness := (self orientation == #vertical) - [thickness _ (self orientation == #vertical) ifTrue: [self width] ifFalse: [self height]. self setProperty: #priorThickness toValue: thickness]]! Item was changed: ----- Method: Flaps class>>disableGlobalFlapWithID: (in category 'menu commands') ----- disableGlobalFlapWithID: aFlapID "Mark this project as having the given flapID disabled" | disabledFlapIDs aFlapTab currentProject | + (currentProject := Project current) assureFlapIntegrity. - (currentProject _ Project current) assureFlapIntegrity. Smalltalk isMorphic ifFalse: [^ self]. + disabledFlapIDs := currentProject parameterAt: #disabledGlobalFlapIDs. + (aFlapTab := self globalFlapTabWithID: aFlapID) ifNotNil: - disabledFlapIDs _ currentProject parameterAt: #disabledGlobalFlapIDs. - (aFlapTab _ self globalFlapTabWithID: aFlapID) ifNotNil: [aFlapTab hideFlap]. (disabledFlapIDs includes: aFlapID) ifFalse: [disabledFlapIDs add: aFlapID]. aFlapTab ifNotNil: [aFlapTab delete] ! Item was changed: ----- Method: Flaps class>>newPaintingFlap (in category 'predefined flaps') ----- newPaintingFlap "Add a flap with the paint palette in it" | aFlap aFlapTab | "Flaps reinstateDefaultFlaps. Flaps addPaintingFlap" + aFlap := PasteUpMorph new borderWidth: 0. - aFlap _ PasteUpMorph new borderWidth: 0. aFlap color: Color transparent. aFlap layoutPolicy: TableLayout new. aFlap hResizing: #shrinkWrap. aFlap vResizing: #shrinkWrap. aFlap cellPositioning: #topLeft. aFlap clipSubmorphs: false. aFlap beSticky. "really?!!" aFlap addMorphFront: PaintBoxMorph new. aFlap setProperty: #flap toValue: true. aFlap fullBounds. "force layout" + aFlapTab := FlapTab new referent: aFlap. - aFlapTab _ FlapTab new referent: aFlap. aFlapTab setNameTo: 'Painting' translated. aFlapTab setProperty: #priorWording toValue: 'Paint' translated. aFlapTab useGraphicalTab. aFlapTab removeAllMorphs. aFlapTab setProperty: #paintingFlap toValue: true. aFlapTab addMorphFront: "(SketchMorph withForm: (ScriptingSystem formAtKey: #PaintingFlapPic))" self paintFlapButton. aFlapTab cornerStyle: #rounded. aFlapTab edgeToAdhereTo: #right. aFlapTab setToPopOutOnDragOver: false. aFlapTab setToPopOutOnMouseOver: false. aFlapTab on: #mouseUp send: #startOrFinishDrawing: to: aFlapTab. aFlapTab setBalloonText:'Click here to start or finish painting.' translated. aFlapTab fullBounds. "force layout" aFlapTab position: (0 at 6). self currentWorld addMorphFront: aFlapTab. ^ aFlapTab!
More information about the Squeak-dev mailing list |