'From Squeak3.1alpha of 28 February 2001 [latest update: #4154] on 14 June 2001 at 2:29:36 am'! "Change Set: partsBin-sw Date: 14 June 2001 Author: Scott Wallace Provides a simple new basis for parts-bin functionality, and redefines the default flaps in the system to use it. Icons in these new parts bins have labels and balloon help, and the new morphs launched by each are formulated dynamically, which makes for quite a savings in space consumption of the default flaps, and obviates the need to rejimmie the default flaps when a preference such as #optionalButtons is toggled. The parts bins can be readily added to (just use dNd) and deleted from (use the dismiss box in an element's halo). Some recourse is added for the problem of people expecting to use a parts bin by *clicking* on items rather than by 'tearing off copies' using a drag gesture: Items that have just come from a parts bin are now not accepted for drop into a parts bin. And if a drop of an item torn off from a parts bin would leave the newborn partially off-screen, it is forced to be fully visible after the drop. Another standard default flap, 'Widgets', is added, with quite a few handy items. The Tools flap has a number of additions (e.g. Transcript, Preferences, Process browser, Recent-Submissions brower) The actual choice of 'Standard' flaps, flap names, flap colors, flap locations, flap contents, are all just works in progress. Mechanisms now exist to make it much easier to define different contents for these or other parts-donor flaps."! PasteUpMorph subclass: #PartsBin instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-PartsBin'! SketchMorph subclass: #Thumbnail instanceVariableNames: 'maximumWidth minimumHeight ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-PartsBin'! !Thumbnail commentStamp: 'sw 6/13/2001 18:17' prior: 0! A morph that serves as a thumbnail of a given form.! !Object methodsFor: 'user interface' stamp: 'sw 6/12/2001 11:09'! launchPartVia: aSelector "Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins" | aMorph | aMorph _ self perform: aSelector. aMorph setProperty: #beFullyVisibleAfterDrop toValue: true. aMorph openInHand! ! !Browser class methodsFor: 'instance creation' stamp: 'sw 6/11/2001 17:38'! prototypicalToolWindow "Answer an example of myself seen in a tool window, for the benefit of parts-launching tools" | aWindow | aWindow _ self new openAsMorphEditing: nil. aWindow setLabel: 'System Browser'; applyModelExtent. ^ aWindow! ! !ChangeSorter class methodsFor: 'services' stamp: 'sw 6/13/2001 00:56'! prototypicalToolWindow "Answer a window representing a prototypical instance of the receiver" ^ self new morphicWindow applyModelExtent! ! !DualChangeSorter class methodsFor: 'opening' stamp: 'sw 6/11/2001 17:38'! prototypicalToolWindow "Answer an example of myself seen in a tool window, for the benefit of parts-launching tools" ^ self new morphicWindow applyModelExtent! ! !FileList class methodsFor: 'instance creation' stamp: 'sw 6/11/2001 17:38'! prototypicalToolWindow "Answer an example of myself seen in a tool window, for the benefit of parts-launching tools" ^ self openAsMorph applyModelExtent! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'sw 6/11/2001 21:31'! fileOutChanges "Bug workaround for squeak-flap 'fileOutChanges' buttons which for a while were mistakenly sending their requests here..." ^ Utilities fileOutChanges! ! !Flaps class methodsFor: 'menu support' stamp: 'sw 6/14/2001 01:22'! 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). self enableGlobalFlapWithID: 'Supplies'. supplies setToPopOutOnMouseOver: false. Smalltalk isMorphic ifTrue: [ActiveWorld addGlobalFlaps. ActiveWorld reformulateUpdatingMenus]! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/14/2001 02:18'! 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 _ OrderedCollection new. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap delete. SharedFlapTabs add: self newPaintingFlap delete. self enableGlobalFlapWithID: 'Squeak'. self enableGlobalFlapWithID: 'Supplies'. self enableGlobalFlapWithID: 'Tools'. self enableGlobalFlapWithID: 'Controls'. self disableGlobalFlapWithID: 'Stack Tools'. self disableGlobalFlapWithID: 'Painting'. SharedFlapTabs do: [:aFlapTab | aFlapTab setToPopOutOnMouseOver: false]. "The above amends some historic behavior imparted by the initializers of the individual flaps" ^ SharedFlapTabs "Flaps reinstateDefaultFlaps"! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/14/2001 01:45'! 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 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 setNameTo: 'Supplies'. aFlapTab assumeString: 'Supplies' font: Preferences standardFlapFont orientation: #horizontal color: Color red lighter. aFlapTab edgeToAdhereTo: #bottom; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: false. aStrip extent: self currentWorld width @ 78. leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2. aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)). aStrip beFlap: true. aStrip color: Color red muchLighter. aStrip hResizing: #spaceFill. aStrip autoLineLayout: true. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/11/2001 17:42'! newSqueakFlap "Answer a new default 'Squeak' flap for the left edge of the screen" | aFlap aFlapTab aButton aClock buttonColor anOffset bb | aFlap _ PasteUpMorph newSticky borderWidth: 0. aFlapTab _ FlapTab new referent: aFlap. aFlapTab setNameTo: 'Squeak'. aFlapTab assumeString: 'Squeak' font: Preferences standardFlapFont orientation: #vertical color: Color brown lighter lighter. aFlapTab edgeToAdhereTo: #left; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: true. aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). aFlap beFlap: true. aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). aFlap extent: 200 @ self currentWorld height. self addProjectNavigationButtonsTo: aFlap. anOffset _ 16. buttonColor _ Color green muchLighter. bb _ SimpleButtonMorph new target: Smalltalk. bb color: buttonColor. aButton _ bb copy. aButton actionSelector: #saveSession. aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.'. aButton label: 'snapshot'. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton _ bb copy target: Utilities. aButton actionSelector: #fileOutChanges. aButton label: 'file out changes'. aButton setBalloonText: 'File out the current change set to disk.'. aFlap addMorph: aButton. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton _ bb copy target: Flaps. aButton actionSelector: #browseRecentSubmissions. aButton setBalloonText: 'Open a message-list browser showing the 20 most-recently-submitted methods.'. aButton label: 'recent submissions'. aFlap addCenteredAtBottom: aButton offset: anOffset. 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.'. aFlap addCenteredAtBottom: aClock offset: anOffset. aButton _ bb copy target: Preferences. aButton actionSelector: #openPreferencesInspector. aButton setBalloonText: 'Open a window allowing me to view and change various Preferences.'. aButton label: 'preferences...'. aButton color: Color cyan muchLighter. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton _ bb copy target: Utilities. aButton actionSelector: #updateFromServer. aButton label: 'load code updates'. aButton color: Color cyan muchLighter. aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.'. aFlap addCenteredAtBottom: aButton offset: anOffset. self addSystemStatusLinesTo: aFlap. aButton _ TrashCanMorph newSticky. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab "Flaps reinstateDefaultFlaps"! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/14/2001 02:18'! newStackToolsFlap "Add a flap with stack tools in it" | aFlapTab aStrip | aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight from: #( (StackMorph authoringPrototype 'Stack' 'A multi-card data base' ) (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background') (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background') (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background') (SketchMorph exampleBackgroundSketch 'Background picture' 'A graphic that will have a different value on every card of the background.') (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player') (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack') (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack') ) . aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab assumeString: 'Stack Tools' font: Preferences standardFlapFont orientation: #horizontal color: Color brown lighter lighter. aFlapTab edgeToAdhereTo: #bottom; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: false. aStrip extent: self currentWorld width @ 78. aFlapTab position: ((Display width - (aFlapTab width + 22)) @ (self currentWorld height - aFlapTab height)). aStrip beFlap: true. aStrip hResizing: #spaceFill. aStrip autoLineLayout: true. aFlapTab position: ((Display width - (aFlapTab width + 226)) @ (self currentWorld height - aFlapTab height)). aStrip color: (Color red muchLighter "alpha: 0.2"). aStrip extent: self currentWorld width @ 70. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/14/2001 02:16'! newSuppliesFlap "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen" | aFlapTab aStrip | aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight from: #( (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.') (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.') (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something') (ScriptableButton authoringPrototype 'Button' 'A Scriptable button') (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.') (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') (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control') (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 setNameTo: 'Supplies'. aFlapTab assumeString: 'Supplies' font: Preferences standardFlapFont orientation: #horizontal color: Color red lighter. aFlapTab edgeToAdhereTo: #bottom; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: false. aStrip extent: self currentWorld width @ 78. aFlapTab position: ((Display width - (aFlapTab width + 22)) @ (self currentWorld height - aFlapTab height)). aStrip beFlap: true. aStrip color: Color red muchLighter. aStrip hResizing: #spaceFill. aStrip autoLineLayout: true. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/14/2001 02:17'! 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 from: #( (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') (Transcript openAsMorph 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') (Workspace prototypicalToolWindow 'Workspace' 'A Work is a simple window for editing text. You can later save the contents to a file if you desire.') (FileList prototypicalToolWindow 'File List' 'A File List is a tool for browsing folders and files on disks and on ftp types.') (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A Method Finder is a tool for finding methods by name') (Preferences preferencesControlPanel 'Preferences' 'Allows you to control numerous options') (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') (Preferences annotationEditingWindow 'Annotations' 'Allows you to specify the annotations to be shown in the annotation panes of browsers, etc.') (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set') ). " (Scamper openAsMorph 'Scamper' 'A web browser') (Project newMorphic 'Project' 'Creates a new project') (Celeste open 'EMail Reader' 'Celeste -- an EMail reader')" aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setNameTo: 'Tools'. aFlapTab assumeString: 'Tools' font: Preferences standardFlapFont orientation: #vertical color: Color orange lighter. aFlapTab edgeToAdhereTo: #right; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: false. aStrip extent: (90 @ self currentWorld height). aFlapTab position: (self currentWorld width - aFlapTab width) @ ((Display height - aFlapTab height) // 2). aStrip beFlap: true. aStrip color: (Color orange muchLighter alpha: 0.8). aStrip vResizing: #spaceFill. ^ aFlapTab "Flaps replaceToolsFlap" ! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/13/2001 21:25'! 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 from: #( (TrashCanMorph new 'Trash' 'A tool for discarding objects') (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts') (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there') (GeeMailMorph new 'Gee-Mail' 'A place to present annotated content') (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') (MPEGMoviePlayerMorph authoringPrototype 'Movie Player' 'A Player for MPEG movies') (FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running') (MagnifierMorph newRound 'Magnifier' 'A magnifying glass') (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world') (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.') (BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')). aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setNameTo: 'Widgets'. aFlapTab assumeString: 'Widgets' font: Preferences standardFlapFont orientation: #horizontal color: Color blue lighter lighter. aFlapTab edgeToAdhereTo: #bottom; inboard: false. aFlapTab setToPopOutOnDragOver: true. aFlapTab setToPopOutOnMouseOver: false. aStrip extent: self currentWorld width @ 78. aFlapTab position: ((Display width - (aFlapTab width + 122)) @ (self currentWorld height - aFlapTab height)). aStrip beFlap: true. aStrip color: (Color blue muchLighter alpha: 0.8). aStrip hResizing: #spaceFill. aStrip autoLineLayout: true. ^ aFlapTab "Flaps replaceWidgetsFlap" ! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 6/13/2001 21:16'! widgetsFlapTab "Answer the tab that represents the shared widgets flap, or nil if none." ^ self globalFlapTabWithID: 'Widgets'! ! !Flaps class methodsFor: 'replacement' stamp: 'sw 6/14/2001 02:17'! replaceToolsFlap "if there is a global tools flap, replace it with an updated one." | aFlapTab | aFlapTab _ self toolsFlapTab ifNil: [^ self]. self removeFlapTab: aFlapTab keepInList: false. self addGlobalFlap: self newToolsFlap. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps] "Flaps replaceToolsFlap"! ! !Flaps class methodsFor: 'replacement' stamp: 'sw 6/13/2001 21:17'! replaceWidgetsFlap "If there is a global widgets flap, replace it with an updated one." | aFlapTab | aFlapTab _ self widgetsFlapTab ifNil: [^ self]. self removeFlapTab: aFlapTab keepInList: false. self addGlobalFlap: self newWidgetsFlap. self currentWorld ifNotNil: [self currentWorld addGlobalFlaps] "Flaps replaceWidgetsFlap"! ! !MessageSet methodsFor: 'private' stamp: 'sw 6/12/2001 21:07'! inMorphicWindowLabeled: labelString "Answer a morphic window with the given label that can display the receiver" | window listFraction | window _ (SystemWindow labelled: labelString) model: self. listFraction _ 0.2. window addMorph: self buildMorphicMessageList frame: (0@0 extent: 1@listFraction). self addLowerPanesTo: window at: (0@listFraction corner: 1@1) with: nil. window setUpdatablePanesFrom: #(messageList). ^ window! ! !MessageSet methodsFor: 'private' stamp: 'sw 6/13/2001 00:59'! openAsMorphNamed: labelString inWorld: aWorld "Open the receiver in a morphic window in the given world" (self inMorphicWindowLabeled: labelString) openInWorld: aWorld! ! !Morph methodsFor: 'accessing' stamp: 'sw 6/11/2001 17:02'! beFlap: aBool "Mark the receiver with the #flap property, or unmark it" aBool ifTrue: [self setProperty: #flap toValue: true] ifFalse: [self removeProperty: #flap]! ! !Morph methodsFor: 'accessing' stamp: 'sw 6/13/2001 01:04'! isFlap "Answer whether the receiver claims to be a flap" ^ self hasProperty: #flap! ! !Morph methodsFor: 'dropping/grabbing' stamp: 'sw 6/13/2001 19:42'! justDroppedInto: aMorph event: anEvent "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph" | aWindow partsBinCase cmd aStack | self formerOwner: nil. self formerPosition: nil. cmd _ self valueOfProperty: #undoGrabCommand. cmd ifNotNil:[aMorph rememberCommand: cmd. self removeProperty: #undoGrabCommand]. (partsBinCase _ aMorph isPartsBin) ifFalse: [self isPartsDonor: false]. (aWindow _ aMorph ownerThatIsA: SystemWindow) ifNotNil: [aWindow isActive ifFalse: [aWindow activate]]. (self isInWorld and: [partsBinCase not]) ifTrue: [self world startSteppingSubmorphsOf: self]. "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage." "An object launched by certain parts-launcher mechanisms should end up fully visible..." (self hasProperty: #beFullyVisibleAfterDrop) ifTrue: [aMorph == ActiveWorld ifTrue: [self goHome]. self removeProperty: #beFullyVisibleAfterDrop]. (self holdsSeparateDataForEachInstance and: [(aStack _ self stack) notNil]) ifTrue: [aStack reassessBackgroundShape] ! ! !Morph methodsFor: 'menus' stamp: 'sw 6/12/2001 21:01'! dismissButton "Answer a button whose action would be to dismiss the receiver" | aButton | aButton _ SimpleButtonMorph new. aButton target: self; color: Color red muchLighter; label: 'X' font: Preferences standardButtonFont; actionSelector: #delete; setBalloonText: 'remove this object from the screen.'. ^ aButton! ! !Morph methodsFor: 'menus' stamp: 'sw 6/13/2001 19:42'! helpButton "Answer a button whose action would be to put up help concerning the receiver" | aButton | aButton _ SimpleButtonMorph new. aButton target: self; color: Color magenta lighter lighter; label: '?' font: Preferences standardButtonFont; actionSelector: #presentHelp; setBalloonText: 'provide help for this object'. ^ aButton! ! !Morph methodsFor: 'menus' stamp: 'sw 6/13/2001 19:44'! ilmalmerhelpButton "Answer a button whose action would be to put up help concerning the receiver" | aButton | aButton _ SimpleButtonMorph new. aButton target: self; color: Color magenta lighter lighter; label: '?' font: Preferences standardButtonFont; actionSelector: #presentHelp; setBalloonText: 'provide help for this object'. ^ aButton! ! !Morph methodsFor: 'menus' stamp: 'sw 6/12/2001 21:08'! presentHelp "Present a help message if there is one available" self inform: 'Sorry, no help has been provided here yet.'! ! !AllScriptsTool methodsFor: 'initialization' stamp: 'sw 6/13/2001 16:37'! initializeFor: aPresenter "Initialize the receiver as a tool which shows, and allows the user to change the status of, all the instantiations of all the user-written scripts in the world" | aButton aRow outerButton | presenter _ aPresenter. showingOnlyActiveScripts _ true. showingAllInstances _ true. self color: Color brown muchLighter muchLighter; wrapCentering: #center; cellPositioning: #topCenter; vResizing: #shrinkWrap; hResizing: #shrinkWrap. self useRoundedCorners. self borderWidth: 4; borderColor: Color brown darker. aRow _ AlignmentMorph newRow. aRow listCentering: #justified; color: Color transparent. aRow addMorphFront: self dismissButton. aRow addMorphBack: ScriptingSystem scriptControlButtons. aRow addMorphBack: self helpButton. self addMorphFront: aRow. aRow _ AlignmentMorph newRow listCentering: #center; color: Color transparent. outerButton _ AlignmentMorph newRow. outerButton wrapCentering: #center; cellPositioning: #leftCenter. outerButton color: Color transparent. outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap. outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox). aButton target: self; actionSelector: #toggleWhetherShowingOnlyActiveScripts; getSelector: #showingOnlyActiveScripts. outerButton addMorphBack: (StringMorph contents: 'tickers only') lock. outerButton setBalloonText: 'If checked, then only scripts that are paused or ticking will be shown'. aRow addMorphBack: outerButton. outerButton _ AlignmentMorph newRow. outerButton wrapCentering: #center; cellPositioning: #leftCenter. outerButton color: Color transparent. outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap. outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox). aButton target: self; actionSelector: #toggleWhetherShowingAllInstances; getSelector: #showingAllInstances. outerButton addMorphBack: (StringMorph contents: 'all instances') lock. outerButton setBalloonText: 'If checked, then status of all instances will be shown, but if not checked, scripts for only one exemplar of each uniclass will be shown'. aRow addMorphBack: outerButton. self addMorphBack: aRow. aPresenter updateContentsFor: self. self layoutChanged.! ! !AllScriptsTool methodsFor: 'initialization' stamp: 'sw 6/14/2001 02:13'! presentHelp "Sent when a Help button is hit; provide the user with some form of help for the tool at hand" self inform: 'This tool allows you to see all the scripts for all the objects in this project. Check "tickers only" if you only want to see scripts that are ticking or paused Set "all instances" if you want a separate entry for each instance, as opposed to a single entry per class'! ! !AllScriptsTool class methodsFor: 'instance creation' stamp: 'sw 6/12/2001 11:52'! allScriptsToolForActiveWorld "Launch an AllScriptsTool to view scripts of the active world" | aTool | aTool _ self newColumn. aTool initializeFor: ActiveWorld presenter. ^ aTool! ! !BookMorph class methodsFor: 'scripting' stamp: 'sw 6/13/2001 17:14'! nextPageButton "Answer a button that will take the user to the next page of its enclosing book" | aButton | aButton _ SimpleButtonMorph new. aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow. aButton setNameTo: 'next'. ^ aButton! ! !BookMorph class methodsFor: 'scripting' stamp: 'sw 6/13/2001 17:13'! previousPageButton "Answer a button that will take the user to the previous page of its enclosing book" | aButton | aButton _ SimpleButtonMorph new. aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'. aButton setNameTo: 'previous'. ^ aButton! ! !FlapTab methodsFor: 'positioning' stamp: 'sw 6/13/2001 21:43'! mouseUp: evt "The mouse came back up, presumably after having dragged the tab" super mouseUp: evt. (self referentThickness <= 0 or: [(referent isInWorld and: [(referent boundsInWorld intersects: referent owner boundsInWorld) not])]) ifTrue: [self hideFlap. flapShowing _ false]. dragged _ false. self fitOnScreen.! ! !FlapTab methodsFor: 'miscellaneous' stamp: 'sw 6/14/2001 02:15'! 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' 'A flap with various generally-useful controls for updating the system, navigating among projects, etc.') ('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 sharply underdocumented') ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do: [:pair | id = pair first ifTrue: [^ pair second]]. ^ self balloonText! ! !FrameRateMorph class methodsFor: 'instance creation' stamp: 'sw 6/13/2001 00:57'! authoringPrototype "Answer a morph representing a prototypical instance of the receiver" | aMorph | aMorph _ self new. aMorph color: Color blue. aMorph step. ^ aMorph! ! !IconicButton methodsFor: 'initialization' stamp: 'sw 6/13/2001 21:49'! initializeToShow: aMorph withLabel: aLabel andSend: aSelector to: aReceiver "Initialize the receiver to show the current appearnce of aMorph on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the provided selector to the provided receiver" | labeledItem aThumbnail | labeledItem _ AlignmentMorph newColumn beTransparent. labeledItem borderWidth: 0. aThumbnail _ Thumbnail new. aThumbnail makeThumbnailFromForm: aMorph imageForm. labeledItem addMorph: aThumbnail. labeledItem addMorphBack: (Morph new extent: (4@4)) beTransparent. labeledItem addMorphBack: (NameStringInHalo contents: aLabel font: (StrikeFont familyName: 'Atlanta' size: 9)). self beTransparent; labelGraphic: labeledItem imageForm; borderWidth: 0; target: aReceiver; actionSelector: #launchPartVia:; arguments: {aSelector}; actWhen: #buttonDown! ! !MagnifierMorph class methodsFor: 'instance creation' stamp: 'sw 6/13/2001 00:49'! newRound "Answer a round Magnifier" | aMagnifier sm | aMagnifier _ self new. sm _ ScreeningMorph new position: aMagnifier position. sm addMorph: aMagnifier. sm addMorph: (EllipseMorph newBounds: aMagnifier bounds). ^ sm! ! !PackagePaneBrowser class methodsFor: 'instance creation' stamp: 'sw 6/11/2001 17:39'! prototypicalToolWindow "Answer an example of myself seen in a tool window, for the benefit of parts-launching tools" | aWindow | aWindow _ self new openAsMorphEditing: nil. aWindow setLabel: 'Package Browser'. aWindow applyModelExtent. ^ aWindow ! ! !PartsBin methodsFor: 'drag & drop' stamp: 'sw 6/13/2001 17:36'! morphToDropFrom: aMorph "Answer the morph to drop if the user attempts to drop aMorph" | aButton | aButton _ IconicButton new. aButton initializeToShow: aMorph withLabel: aMorph externalName andSend: #veryDeepCopy to: aMorph veryDeepCopy. ^ aButton! ! !PartsBin methodsFor: 'drag & drop' stamp: 'sw 6/13/2001 17:47'! wantsDroppedMorph: aMorph event: evt "Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves" (aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue: ["Sign that this was launched from a parts bun, probably indeed this very parts bin" ^ false]. ^ super wantsDroppedMorph: aMorph event: evt! ! !PartsBin methodsFor: 'initialization' stamp: 'sw 6/13/2001 17:36'! listDirection: aListDirection quadList: quadList "Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form: (