'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5545] on 15 November 2003 at 7:34:13 pm'! "Change Set: CompleteTranslationFor37-FIXED-dgd Date: 15 November 2003 Author: Diego Gomez Deck This changeset includes the changes all over the image to make it translatable. Basically it means: - sending of #translated message to visible strings to make them translatable - some few #format: messages to replace string concatenations of strings where the order make sense only in English This changeset was tested in a 3.7a (5423) and I solved 43 conflicts (most of them with MCP-Complete changeset). Second revision: Tested in 3.71 (5545) 19 conflicts was solved. Thanks Stef!! "! !Object methodsFor: 'error handling' stamp: 'sd 11/13/2003 21:11'! deprecated: aBlock explanation: aString "This method is OBSOLETE. Use #deprecated:block: instead." self deprecated: 'Use Object>>deprecated:block: instead of deprecated:explanation:.'. Preferences showDeprecationWarnings ifTrue: [Deprecation signal: ('{1} has been deprecated. {2}' translated format: {thisContext sender printString. aString})]. ^ aBlock value. ! ! !Object methodsFor: 'error handling' stamp: 'sd 11/13/2003 21:10'! deprecatedExplanation: aString "This method is OBSOLETE. Use #deprecated: instead." self deprecated: 'Use Object>>deprecated: instead of deprecatedExplanation:.'. Preferences showDeprecationWarnings ifTrue: [Deprecation signal: ('{1} has been deprecated. {2}' translated format: {thisContext sender printString. aString})]! ! !ChangeSet class methodsFor: 'defaults' stamp: 'dgd 9/6/2003 19:56'! defaultName ^ self uniqueNameLike: 'Unnamed' translated! ! !Command methodsFor: 'private' stamp: 'dgd 8/26/2003 21:43'! cmdWording "Answer the wording to be used to refer to the command in a menu" ^ cmdWording ifNil: ['last command' translated]! ! !CommandHistory methodsFor: 'menu' stamp: 'dgd 8/26/2003 21:42'! undoOrRedoMenuWording "Answer the wording to be used in a menu item offering undo/redo (i.e., the form used when the #infiniteUndo preference is false)" | pre | lastCommand ifNil: [^ 'can''t undo' translated]. pre _ lastCommand phase == #done ifTrue: ['undo' translated] ifFalse: ['redo' translated]. ^ pre, ' "', (lastCommand cmdWording truncateWithElipsisTo: 20), '" (z)'! ! !CurrentProjectRefactoring class methodsFor: 'flaps' stamp: 'dgd 8/31/2003 18:06'! suppressFlapsString "Answer a string characterizing whether flaps are suppressed at the moment or not" ^ (self currentFlapsSuppressed ifTrue: [''] ifFalse: ['']), 'show shared tabs (F)' translated! ! !DataType methodsFor: 'tiles' stamp: 'dgd 9/6/2003 20:29'! addWatcherItemsToMenu: aMenu forGetter: aGetter "Add watcher items to the menu if appropriate, provided the getter is not an odd-ball one for which a watcher makes no sense" (#(colorSees copy newClone getNewClone color:sees: touchesA: overlaps:) includes: aGetter) ifFalse: [aMenu add: 'simple watcher' translated selector: #tearOffWatcherFor: argument: aGetter]! ! !DescriptionForPartsBin methodsFor: 'access' stamp: 'dgd 9/2/2003 18:57'! translatedCategories "Answer translated the categoryList of the receiver" ^ self categories collect: [:each | each translated]! ! !FileList methodsFor: 'file list menu' stamp: 'dgd 9/19/2003 11:20'! fileContentsMenu: aMenu shifted: shifted "Construct aMenu to have items appropriate for the file browser's code pane, given the shift state provided" | shiftMenu services maybeLine extraLines | shifted ifTrue: [shiftMenu _ ParagraphEditor shiftedYellowButtonMenu. ^ aMenu labels: shiftMenu labelString lines: shiftMenu lineArray selections: shiftMenu selections]. fileName ifNotNil: [services _ OrderedCollection new. (#(briefHex briefFile needToGetBriefHex needToGetBrief) includes: brevityState) ifTrue: [services add: self serviceGet]. (#(fullHex briefHex needToGetFullHex needToGetBriefHex) includes: brevityState) ifFalse: [services add: self serviceGetHex]. maybeLine _ services size. (#('st' 'cs') includes: self suffixOfSelectedFile) ifTrue: [services addAll: (self servicesFromSelectorSpecs: #(fileIntoNewChangeSet: fileIn: browseChangesFile: browseFile:))]. extraLines _ OrderedCollection new. maybeLine > 0 ifTrue: [extraLines add: maybeLine]. services size > maybeLine ifTrue: [extraLines add: services size]. aMenu addServices: services for: self fullName extraLines: extraLines]. aMenu addList: { {'find...(f)' translated. #find}. {'find again (g)' translated. #findAgain}. {'set search string (h)' translated. #setSearchString}. #-. {'do again (j)' translated. #again}. {'undo (z)' translated. #undo}. #-. {'copy (c)' translated. #copySelection}. {'cut (x)' translated. #cut}. {'paste (v)' translated. #paste}. {'paste...' translated. #pasteRecent}. #-. {'do it (d)' translated. #doIt}. {'print it (p)' translated. #printIt}. {'inspect it (i)' translated. #inspectIt}. {'fileIn selection (G)' translated. #fileItIn}. #-. {'accept (s)' translated. #accept}. {'cancel (l)' translated. #cancel}. #-. {'more...' translated. #shiftedYellowButtonActivity}}. ^ aMenu ! ! !FileList methodsFor: 'file menu action' stamp: 'dgd 9/21/2003 17:37'! deleteFile "Delete the currently selected file" listIndex = 0 ifTrue: [^ self]. (self confirm: ('Really delete {1}?' translated format:{fileName})) ifFalse: [^ self]. directory deleteFileNamed: fileName. self updateFileList. brevityState _ #FileList. self get! ! !FileList methodsFor: 'to be transformed in registration' stamp: 'dgd 9/19/2003 12:06'! volumeMenu: aMenu ^ aMenu addList: { {'recent...' translated. #recentDirs}. #-. {'add server...' translated. #askServerInfo}. {'remove server...' translated. #removeServer}. #-. {'delete directory...' translated. #deleteDirectory}}. ! ! !FileList methodsFor: 'volume list and pattern' stamp: 'dgd 9/21/2003 17:36'! deleteDirectory "Remove the currently selected directory" | localDir | directory entries size = 0 ifFalse:[^self inform:'Directory must be empty' translated]. localDir _ directory pathParts last. (self confirm: ('Really delete {1}?' translated format:{localDir printString})) ifFalse: [^ self]. self volumeListIndex: self volumeListIndex-1. directory deleteDirectory: localDir. self updateFileList.! ! !FileList2 class methodsFor: 'blue ui' stamp: 'dgd 9/6/2003 19:53'! morphicViewProjectLoader2InWorld: aWorld reallyLoad: aBoolean dirFilterType: aSymbol | window aFileList buttons treePane textColor1 fileListPane pane2a pane2b treeExtent filesExtent | window _ AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. textColor1 _ Color r: 0.742 g: 0.839 b: 1.0. aFileList _ self new directory: FileDirectory default. aFileList optionalButtonSpecs: aFileList servicesForProjectLoader; fileSelectionBlock: ( aSymbol == #limitedSuperSwikiDirectoryList ifTrue: [ MessageSend receiver: self selector: #projectOnlySelectionMethod: ] ifFalse: [ self projectOnlySelectionBlock ] ); "dirSelectionBlock: self hideSqueakletDirectoryBlock;" modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 4; borderColor: (Color r: 0.355 g: 0.516 b: 1.0); useRoundedCorners. buttons _ #('OK' 'Cancel') collect: [ :each | self blueButtonText: each translated textColor: textColor1 inWindow: window ]. aWorld width < 800 ifTrue: [ treeExtent _ 150@300. filesExtent _ 350@300. ] ifFalse: [ treeExtent _ 250@300. filesExtent _ 350@300. ]. (treePane _ aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane _ aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. window addARow: { window fancyText: 'Load A Project' translated ofSize: 21 color: textColor1 }; addARowCentered: { buttons first. (Morph new extent: 30@5) color: Color transparent. buttons second }; addARow: { window fancyText: 'Please select a project' translated ofSize: 21 color: Color blue }; addARow: { (window inAColumn: {(pane2a _ window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 6}) layoutInset: 10. (window inAColumn: {(pane2b _ window inARow: {window inAColumn: {fileListPane}}) useRoundedCorners; layoutInset: 6}) layoutInset: 10. }. window fullBounds. window fillWithRamp: self blueRamp1 oriented: 0.65. pane2a fillWithRamp: self blueRamp3 oriented: (0.7 @ 0.35). pane2b fillWithRamp: self blueRamp3 oriented: (0.7 @ 0.35). buttons do: [ :each | each fillWithRamp: self blueRamp2 oriented: (0.75 @ 0). ]. buttons first on: #mouseUp send: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]) to: aFileList. buttons second on: #mouseUp send: #cancelHit to: aFileList. aFileList postOpen. window position: aWorld topLeft + (aWorld extent - window extent // 2). window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window openInWorld: aWorld.! ! !FileList2 class methodsFor: 'blue ui' stamp: 'jm 9/2/2003 21:14'! morphicViewProjectSaverFor: aProject " (FileList2 morphicViewProjectSaverFor: Project current) openInWorld " | window aFileList buttons treePane pane2 textColor1 option treeExtent buttonData buttonRow | textColor1 _ Color r: 0.742 g: 0.839 b: 1.0. aFileList _ self new directory: ServerDirectory projectDefaultDirectory. aFileList dirSelectionBlock: self hideSqueakletDirectoryBlock. window _ AlignmentMorphBob1 newColumn. window hResizing: #shrinkWrap; vResizing: #shrinkWrap. aFileList modalView: window. window setProperty: #FileList toValue: aFileList; wrapCentering: #center; cellPositioning: #topCenter; borderWidth: 4; borderColor: (Color r: 0.355 g: 0.516 b: 1.0); useRoundedCorners. buttonData _ Preferences enableLocalSave ifTrue: [#( ('Save' okHit 'Save in the place specified below, and in the Squeaklets folder on your local disk') ('Save on local disk only' saveLocalOnlyHit 'saves in the Squeaklets folder') ('Cancel' cancelHit 'return without saving') )] ifFalse: [#( ('Save' okHit 'Save in the place specified below, and in the Squeaklets folder on your local disk') ('Cancel' cancelHit 'return without saving') )]. buttons _ buttonData collect: [ :each | (self blueButtonText: each first translated textColor: textColor1 inWindow: window) setBalloonText: each third translated; hResizing: #shrinkWrap; on: #mouseUp send: each second to: aFileList ]. option _ aProject world valueOfProperty: #SuperSwikiPublishOptions ifAbsent: [#initialDirectoryList]. aProject world removeProperty: #SuperSwikiPublishOptions. World height < 500 ifTrue: [ treeExtent _ 350@150. ] ifFalse: [ treeExtent _ 350@300. ]. (treePane _ aFileList morphicDirectoryTreePaneFiltered: option) extent: treeExtent; retractable: false; borderWidth: 0. window addARowCentered: { window fancyText: 'Publish This Project' translated ofSize: 21 color: textColor1 }. buttonRow _ OrderedCollection new. buttons do: [:button | buttonRow add: button] separatedBy: [buttonRow add: ((Morph new extent: 30@5) color: Color transparent)]. " addARowCentered: { buttons first. (Morph new extent: 30@5) color: Color transparent. buttons second. (Morph new extent: 30@5) color: Color transparent. buttons third };" window addARowCentered: buttonRow; addARowCentered: { (window inAColumn: {(ProjectViewMorph on: aProject) lock}) layoutInset: 4}; addARowCentered: { window fancyText: 'Please select a folder' translated ofSize: 21 color: Color blue }; addARow: { ( window inAColumn: { (pane2 _ window inARow: {window inAColumn: {treePane}}) useRoundedCorners; layoutInset: 6 } ) layoutInset: 10 }. window fullBounds. window fillWithRamp: self blueRamp1 oriented: 0.65. pane2 fillWithRamp: self blueRamp3 oriented: (0.7 @ 0.35). buttons do: [ :each | each fillWithRamp: self blueRamp2 oriented: (0.75 @ 0). ]. window setProperty: #morphicLayerNumber toValue: 11. aFileList postOpen. window adoptPaneColor: (Color r: 0.548 g: 0.677 b: 1.0). ^ window ! ! !FileList2 class methodsFor: 'morphic ui' stamp: 'dgd 9/19/2003 12:18'! morphicViewFileSelectorForSuffixes: aList "Answer a morphic file-selector tool for the given suffix list" | dir aFileList window fixedSize midLine gap | dir _ FileDirectory default. aFileList _ self new directory: dir. aFileList optionalButtonSpecs: aFileList okayAndCancelServices. aList ifNotNil: [aFileList fileSelectionBlock: [:entry :myPattern | entry isDirectory ifTrue: [false] ifFalse: [aList includes: (FileDirectory extensionFor: entry name asLowercase)]] fixTemps]. window _ BorderedMorph new layoutPolicy: ProportionalLayout new; color: Color lightBlue; borderColor: Color blue; borderWidth: 4; layoutInset: 4; extent: 600@400; useRoundedCorners. window setProperty: #fileListModel toValue: aFileList. aFileList modalView: window. midLine _ 0.4. fixedSize _ 25. gap _ 5. self addFullPanesTo: window from: { {self textRow: 'Please select a file' translated. 0 @ 0 corner: 1 @ 0. 0@0 corner: 0@fixedSize}. {aFileList optionalButtonRow. 0 @ 0 corner: 1 @ 0. 0@fixedSize corner: 0@(fixedSize * 2)}. {aFileList morphicDirectoryTreePane. 0@0 corner: midLine@1. gap @(fixedSize * 2) corner: gap negated@0}. {aFileList morphicFileListPane. midLine @ 0 corner: 1@1. gap@(fixedSize * 2) corner: gap negated@0}. }. aFileList postOpen. ^ window ! ! !Flaps class methodsFor: 'flap mechanics' stamp: 'dgd 10/7/2003 22:47'! reinstateDefaultFlaps "Remove all existing 'standard' global flaps clear the global list, and and add fresh ones. To be called by doits in updates etc. This is a radical step, but it does *not* clobber non-standard global flaps or local flaps. To get the effect of the *former* version of this method, call Flaps freshFlapsStart" "Flaps reinstateDefaultFlaps" self globalFlapTabsIfAny do: [:aFlapTab | ({ 'Painting' translated. 'Stack Tools' translated. 'Squeak' translated. 'Menu' translated. 'Widgets' translated. 'Tools' translated. 'Supplies' translated. 'Scripting' translated. 'Objects' translated. 'Navigator' translated } includes: aFlapTab flapID) ifTrue: [self removeFlapTab: aFlapTab keepInList: false]]. "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" self addStandardFlaps. "self disableGlobalFlapWithID: 'Scripting'. self disableGlobalFlapWithID: 'Objects'." self currentWorld addGlobalFlaps. self currentWorld reformulateUpdatingMenus. ! ! !Flaps class methodsFor: 'menu commands' stamp: 'dgd 8/31/2003 19:01'! 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. 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" ! ! !Flaps class methodsFor: 'menu commands' stamp: 'dgd 8/31/2003 19:02'! explainFlaps "Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below. 'Shared flaps' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps. To get started using flaps, bring up the desktop menu and choose 'flaps...', and make the menu stay up by choosing 'keep this menu up'. If you see, in this flaps menu, a list of flap names such as 'Squeak', 'Tools', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to 'install default shared flaps'; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence. 'Project flaps' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project. If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it. If a flap is *not* set up as a parts bin (such as the default 'Squeak' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default 'Squeak' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs. Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options. You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen. Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area. If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu. The red-halo menu on a flap allows you to change the flap's properties. For greatest ease of use, request 'keep this menu up' here -- that way, you can easily explore all the options in the menu. tab color... Lets you change the color of the flap's tab. flap color... Lets you change the color of the flap itself. use textual tab... If the tab is not textual, makes it become textual. change tab wording... If the tab is already textual, allows you to edit its wording. use graphical tab... If the tab is not graphical, makes it become graphical. choose tab graphic... If the tab is already graphical, allows you to change the picture. use solid tab... If the tab is not solid, makes it become solid, i.e. appear as a solid band of color along the entire length or width of the screen. parts-bin behavior If set, then dragging an object from the flap tears off a new copy of the object. dragover If set, the flap opens on dragover and closes again on drag-leave. mouseover If set, the flap opens on mouseover and closes again on mouse-leave. cling to edge... Governs which edge (left, right, top, bottom) the flap adheres to. shared If set, the same flap will be available in all projects; if not, the flap will will occur only in one project. destroy this flap Deletes the flap. To define a new flap, use 'make a new flap', found in the 'flaps' menu. To reinstate the default system flaps, you can use 'destroy all shared flaps' from the 'flaps' menu, and once they are destroyed, choose 'install default shared flaps'. To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it. Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the 'flaps' menu -- one is called 'Stack Tools', which provides some tools useful for building stack-like content, the other is called 'Painting', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the 'flaps' menu will toggle the corresponding flap between being visible and not being visible in the project." "Open a window giving flap help." (StringHolder new contents: (self class firstCommentAt: #explainFlaps) translated) openLabel: 'Flaps' translated "Flaps explainFlaps" ! ! !Flaps class methodsFor: 'menu support' stamp: 'dgd 8/31/2003 19:39'! 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' translated. supplies setToPopOutOnMouseOver: false. Smalltalk isMorphic ifTrue: [ActiveWorld addGlobalFlaps. ActiveWorld reformulateUpdatingMenus]! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'dgd 8/31/2003 19:26'! enableClassicNavigatorChanged "The #classicNavigatorEnabled preference has changed. No senders in easily traceable in the image, but this is really sent by a Preference object!!" Preferences classicNavigatorEnabled ifTrue: [Flaps disableGlobalFlapWithID: 'Navigator' translated. Preferences enable: #showProjectNavigator. self disableGlobalFlapWithID: 'Navigator' translated.] ifFalse: [self enableGlobalFlapWithID: 'Navigator' translated. ActiveWorld addGlobalFlaps]. self doAutomaticLayoutOfFlapsIfAppropriate. Project current assureNavigatorPresenceMatchesPreference. ActiveWorld reformulateUpdatingMenus! ! !Flaps class methodsFor: 'miscellaneous' stamp: 'dgd 8/31/2003 19:28'! makeNavigatorFlapResembleGoldenBar "At explicit request, make the flap-based navigator resemble the golden bar. No senders in the image, but sendable from a doit" "Flaps makeNavigatorFlapResembleGoldenBar" Preferences setPreference: #classicNavigatorEnabled toValue: false. Preferences setPreference: #showProjectNavigator toValue: false. (self globalFlapTabWithID: 'Navigator' translated) ifNil: [SharedFlapTabs add: self newNavigatorFlap delete]. self enableGlobalFlapWithID: 'Navigator' translated. Preferences setPreference: #navigatorOnLeftEdge toValue: true. (self globalFlapTabWithID: 'Navigator' translated) arrangeToPopOutOnMouseOver: true. ActiveWorld addGlobalFlaps. self doAutomaticLayoutOfFlapsIfAppropriate. Project current assureNavigatorPresenceMatchesPreference. ! ! !Flaps class methodsFor: 'new flap' stamp: 'dgd 8/31/2003 18:58'! addLocalFlap "Menu command -- let the user add a new project-local flap. Once the new flap is born, the user can tell it to become a shared flap. Obtain an initial name and edge for the flap, launch the flap, and also launch a menu governing the flap, so that the user can get started right away with customizing it." | aMenu reply aFlapTab aWorld edge | aMenu _ MVCMenuMorph entitled: 'Where should the new flap cling?' translated. aMenu defaultTarget: aMenu. #(left right top bottom) do: [:sym | aMenu add: sym asString translated selector: #selectMVCItem: argument: sym]. edge _ aMenu invokeAt: self currentHand position in: self currentWorld. edge ifNotNil: [reply _ FillInTheBlank request: 'Wording for this flap: ' translated initialAnswer: 'Flap' translated. reply isEmptyOrNil ifFalse: [aFlapTab _ self newFlapTitled: reply onEdge: edge. (aWorld _ self currentWorld) addMorphFront: aFlapTab. aFlapTab adaptToWorld: aWorld. aMenu _ aFlapTab buildHandleMenu: ActiveHand. aFlapTab addTitleForHaloMenu: aMenu. aFlapTab computeEdgeFraction. aMenu popUpEvent: ActiveEvent in: ActiveWorld]] ! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 18:59'! 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. 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" SharedFlapTabs add: self newNavigatorFlap. self enableGlobalFlapWithID: 'Supplies' translated. self enableGlobalFlapWithID: 'Navigator' translated. SharedFlapsAllowed _ true. Project current flapsSuppressed: false. ^ SharedFlapTabs "Flaps addAndEnableEToyFlaps"! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 18:44'! addNewDefaultSharedFlaps "Add the stack tools flap and the navigator flap to the global list, but do not have them showing initially. Transitional, called by the postscript of the FlapsOnBottom update; probably dispensable afterwards." SharedFlapTabs ifNotNil: [(self globalFlapTabWithID: 'Stack Tools' translated) ifNil: [SharedFlapTabs add: self newStackToolsFlap delete]. self enableGlobalFlapWithID: 'Stack Tools' translated. (self globalFlapTabWithID: 'Navigator' translated) ifNil: [SharedFlapTabs add: self newNavigatorFlap delete]. self enableGlobalFlapWithID: 'Navigator' translated. self currentWorld addGlobalFlaps]! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 10/7/2003 22:47'! addStandardFlaps "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 ifNil: [SharedFlapTabs := OrderedCollection new]. SharedFlapTabs add: self newSqueakFlap. SharedFlapTabs add: self newSuppliesFlap. SharedFlapTabs add: self newToolsFlap. SharedFlapTabs add: self newWidgetsFlap. SharedFlapTabs add: self newStackToolsFlap. SharedFlapTabs add: self newNavigatorFlap. SharedFlapTabs add: self newPaintingFlap. self disableGlobalFlapWithID: 'Stack Tools' translated. self disableGlobalFlapWithID: 'Painting' translated. self disableGlobalFlapWithID: 'Navigator' translated. ^ SharedFlapTabs! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:38'! 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 setName: 'Supplies' translated edge: #bottom color: Color red lighter. 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 autoLineLayout: true. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:03'! 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; extent: navBar extent + (0@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 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 " ! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:56'! newObjectsFlap "Answer a fully-instantiated flap named 'Objects' to be placed at the top of the screen. Not currently called; this worked once, but probably not at the moment." | aFlapTab anObjectsTool | anObjectsTool _ ObjectsTool new. anObjectsTool initializeForFlap. anObjectsTool showCategories. 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. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:50'! newPaintingFlap "Add a flap with the paint palette in it" | aFlap aFlapTab | "Flaps reinstateDefaultFlaps. Flaps addPaintingFlap" 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 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@6). self currentWorld addMorphFront: aFlapTab. ^ aFlapTab! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 9/1/2003 11:42'! 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. 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@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. 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: 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.' translated. aButton label: 'save' translated font: (aFont _ ScriptingSystem fontForTiles). aFlap addCenteredAtBottom: aButton offset: anOffset. 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: Smalltalk; 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. aFlap addCenteredAtBottom: aButton offset: anOffset. aButton startStepping. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Squeak' translated "! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:40'! newStackToolsFlap "Add a flap with stack tools in it" | aFlapTab aStrip | aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight from: self quadsDefiningStackToolsFlap. 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 color: (Color red muchLighter "alpha: 0.2"). aStrip extent: self currentWorld width @ 70. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Stack Tools' translated"! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:39'! 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 from: quads. aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. 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 @ 78. aStrip beFlap: true. aStrip color: Color red muchLighter. aStrip autoLineLayout: true. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Supplies' translated"! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:41'! 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: self quadsDefiningToolsFlap. 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. aStrip color: (Color orange muchLighter alpha: 0.8). ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Tools' translated " ! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'dgd 8/31/2003 19:43'! 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: self quadsDefiningWidgetsFlap. 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 color: (Color blue muchLighter alpha: 0.8). aStrip autoLineLayout: true. ^ aFlapTab "Flaps replaceGlobalFlapwithID: 'Widgets' translated " ! ! !Flaps class methodsFor: 'replacement' stamp: 'dgd 10/7/2003 22:47'! 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 do: [:tab | self removeFlapTab: tab keepInList: false]. flapID = 'Stack Tools' translated ifTrue: [replacement _ self newStackToolsFlap]. flapID = 'Supplies' translated ifTrue: [replacement _ self newSuppliesFlap]. 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 "! ! !Flaps class methodsFor: 'replacement' stamp: 'dgd 8/31/2003 19:41'! replaceToolsFlap "if there is a global tools flap, replace it with an updated one." self replaceGlobalFlapwithID: 'Tools' translated "Flaps replaceToolsFlap"! ! !Flaps class methodsFor: 'shared flaps' stamp: 'dgd 8/31/2003 19:27'! 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: [#()]. Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapsWithIDs: ids "Flaps positionNavigatorAndOtherFlapsAccordingToPreference"! ! !Flaps class methodsFor: 'shared flaps' stamp: 'dgd 8/31/2003 19:29'! positionVisibleFlapsRightToLeftOnEdge: edgeSymbol butPlaceAtLeftFlapsWithIDs: idList "Lay out flaps along the designated edge right-to-left, while laying left-to-right any flaps found in the exception list Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapWithIDs: {'Navigator' translated. 'Supplies' translated} Flaps sharedFlapsAlongBottom" | leftX flapList flapsOnRight flapsOnLeft | flapList _ self globalFlapTabsIfAny select: [:aFlapTab | aFlapTab isInWorld and: [aFlapTab edgeToAdhereTo == edgeSymbol]]. flapsOnLeft _ flapList select: [:fl | idList includes: fl flapID]. flapList removeAll: flapsOnLeft. flapsOnRight _ flapList asSortedCollection: [:f1 :f2 | f1 left > f2 left]. leftX _ ActiveWorld width - 15. flapsOnRight do: [:aFlapTab | aFlapTab right: leftX - 3. leftX _ aFlapTab left]. leftX _ ActiveWorld left. flapsOnLeft _ flapsOnLeft asSortedCollection: [:f1 :f2 | f1 left > f2 left]. flapsOnLeft do: [:aFlapTab | aFlapTab left: leftX + 3. leftX _ aFlapTab right]. (flapsOnLeft asOrderedCollection, flapsOnRight asOrderedCollection) do: [:ft | ft computeEdgeFraction. ft flapID = 'Navigator' translated ifTrue: [ft referent left: (ft center x - (ft referent width//2) max: 0)]] ! ! !Flaps class methodsFor: 'shared flaps' stamp: 'dgd 10/7/2003 22:47'! 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: [:s | { 'Squeak' translated. 'Navigator' translated. 'Supplies' translated. 'Widgets' translated. 'Stack Tools' translated. 'Tools' translated. 'Painting' translated. } do: [:id | (self globalFlapTabWithID: id) ifNotNilDo: [: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. ordered , unordered asArray reverseDo: [:ft | ft setEdge: #bottom. ft right: leftX - 3. leftX _ ft left]. "Put Nav Bar centered under tab if possible" (self globalFlapTabWithID: 'Navigator' translated) ifNotNilDo: [:ft | ft referent left: (ft center x - (ft referent width//2) max: 0)]. self positionNavigatorAndOtherFlapsAccordingToPreference. ! ! !FlashFileReader methodsFor: 'reading' stamp: 'dgd 9/21/2003 17:38'! processHeader "Read header information from the source stream. Return true if successful, false otherwise." | twipsFrameSize frameRate frameCount | self processSignature ifFalse:[^false]. version _ stream nextByte. "Check for the version supported" version > self maximumSupportedVersion ifTrue:[ (self confirm:('This file''s version ({1}) is higher than the currently supported version ({2}). It may contain features that are not supported and it may not display correctly. Do you want to continue?' translated format:{version. self maximumSupportedVersion})) ifFalse:[^false]]. dataSize _ stream nextLong. "Check for the minimal file size" dataSize < 21 ifTrue:[^false]. twipsFrameSize _ stream nextRect. self recordGlobalBounds: twipsFrameSize. frameRate _ stream nextWord / 256.0. self recordFrameRate: frameRate. frameCount _ stream nextWord. self recordFrameCount: frameCount. log ifNotNil:[ log cr; nextPutAll:'------------- Header information --------------'. log cr; nextPutAll:'File version '; print: version. log cr; nextPutAll:'File size '; print: dataSize. log cr; nextPutAll:'Movie width '; print: twipsFrameSize extent x // 20. log cr; nextPutAll:'Movie height '; print: twipsFrameSize extent y // 20. log cr; nextPutAll:'Frame rate '; print: frameRate. log cr; nextPutAll:'Frame count '; print: frameCount. log cr; cr. self flushLog]. ^true! ! !Form methodsFor: 'displaying' stamp: 'dgd 8/26/2003 21:44'! setAsBackground "Set this form as a background image." | world newColor | Smalltalk isMorphic ifTrue: [world _ self currentWorld. newColor _ InfiniteForm with: self. self rememberCommand: (Command new cmdWording: 'set background to a picture' translated; undoTarget: world selector: #color: argument: world color; redoTarget: world selector: #color: argument: newColor). world color: newColor] ifFalse: [ScheduledControllers screenController model form: self. Display restoreAfter: []]! ! !GZipReadStream class methodsFor: 'fileIn/Out' stamp: 'dgd 9/21/2003 17:46'! uncompressedFileName: fullName ^((fullName endsWith: '.gz') and: [self confirm: ('{1} appears to be a compressed file. Do you want to uncompress it?' translated format:{fullName})]) ifFalse: [fullName] ifTrue:[self saveContents: fullName]! ! !MethodHolder methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:54'! addModelMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph aCustomMenu addLine. aCustomMenu add: 'whose script is this?' translated target: self action: #identifyScript ! ! !Morph methodsFor: 'debug and other' stamp: 'dgd 8/30/2003 20:36'! addDebuggingItemsTo: aMenu hand: aHandMorph aMenu add: 'debug...' translated subMenu: (self buildDebugMenu: aHandMorph)! ! !Morph methodsFor: 'debug and other' stamp: 'dgd 11/15/2003 19:28'! buildDebugMenu: aHand "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently" | aMenu aPlayer | aMenu _ MenuMorph new defaultTarget: self. aMenu addStayUpItem. (self hasProperty: #errorOnDraw) ifTrue: [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError. aMenu addLine]. (self hasProperty: #errorOnStep) ifTrue: [aMenu add: 'start stepping again' translated action: #resumeAfterStepError. aMenu addLine]. aMenu add: 'inspect morph' translated action: #inspectInMorphic:. aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain. Smalltalk isMorphic ifFalse: [aMenu add: 'inspect morph (in MVC)' translated action: #inspect]. self isMorphicModel ifTrue: [aMenu add: 'inspect model' translated target: self model action: #inspect]. (aPlayer _ self player) ifNotNil: [aMenu add: 'inspect player' translated target: aPlayer action: #inspect]. aMenu add: 'explore morph' translated target: self selector: #explore. aMenu addLine. aMenu add: 'viewer for Player' translated target: self player action: #beViewed. aMenu balloonTextForLastItem: 'Opens a viewer on my Player -- this is the same thing you get if you click on the cyan "View" halo handle' translated. aMenu add: 'viewer for Morph' translated target: self action: #viewMorphDirectly. aMenu balloonTextForLastItem: 'Opens a Viewer on this Morph, rather than on its Player' translated. aMenu addLine. aPlayer ifNotNil: [aPlayer class isUniClass ifTrue: [ aMenu add: 'browse player class' translated target: aPlayer action: #browseHierarchy]]. aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy. (self isMorphicModel) ifTrue: [aMenu add: 'browse model class' target: self model selector: #browseHierarchy]. aMenu addLine. aPlayer ifNotNil: [aMenu add: 'player protocol (tiles)' translated target: aPlayer action: #openInstanceBrowserWithTiles "#browseProtocolForPlayer"]. aMenu add: 'morph protocol (text)' translated target: self selector: #haveFullProtocolBrowsed. aMenu add: 'morph protocol (tiles)' translated target: self selector: #openInstanceBrowserWithTiles. aMenu addLine. self addViewingItemsTo: aMenu. aMenu add: 'make own subclass' translated action: #subclassMorph; add: 'internal name ' translated action: #choosePartName; add: 'save morph in file' translated action: #saveOnFile; addLine; add: 'call #tempCommand' translated action: #tempCommand; add: 'define #tempCommand' translated action: #defineTempCommand; addLine; add: 'control-menu...' translated target: self selector: #invokeMetaMenu:; add: 'edit balloon help' translated action: #editBalloonHelpText. ^ aMenu! ! !Morph methodsFor: 'debug and other' stamp: 'dgd 8/30/2003 20:43'! tempCommand "Generic backstop. If you care to, you can comment out what's below here, and substitute your own code, though the intention of design of the feature is that you leave this method as it is, and instead reimplement tempCommand in the class of whatever individual morph you care to. In any case, once you have your own #tempCommand in place, you will then be able to invoke it from the standard debugging menus." self inform: 'Before calling tempCommand, you should first give it a definition. To do this, choose "define tempCommand" from the debug menu.' translated! ! !Morph methodsFor: 'drawing' stamp: 'dgd 8/30/2003 20:20'! hasClipSubmorphsString "Answer a string that represents the clip-submophs checkbox" ^ (self clipSubmorphs ifTrue: [''] ifFalse: ['']) , 'provide clipping' translated! ! !Morph methodsFor: 'drop shadows' stamp: 'dgd 8/30/2003 16:48'! addDropShadowMenuItems: aMenu hand: aHand | menu | menu _ MenuMorph new defaultTarget: self. menu addUpdating: #hasDropShadowString action: #toggleDropShadow. menu addLine. menu add: 'shadow color...' translated target: self selector: #changeShadowColor. menu add: 'shadow offset...' translated target: self selector: #setShadowOffset:. aMenu add: 'drop shadow' translated subMenu: menu.! ! !Morph methodsFor: 'drop shadows' stamp: 'dgd 8/30/2003 16:49'! hasDropShadowString ^ (self hasDropShadow ifTrue: [''] ifFalse: ['']) , 'show shadow' translated! ! !Morph methodsFor: 'dropping/grabbing' stamp: 'dgd 8/26/2003 21:44'! undoGrabCommand "Return an undo command for grabbing the receiver" | cmd | owner ifNil: [^ nil]. "no owner - no undo" ^ (cmd _ Command new) cmdWording: 'move ' translated, self nameForUndoWording; undoTarget: self selector: #undoMove:redo:owner:bounds:predecessor: arguments: {cmd. false. owner. self bounds. (owner morphPreceding: self)}; yourself! ! !Morph methodsFor: 'e-toy support' stamp: 'dgd 9/6/2003 18:10'! makeGraphPaper | smallGrid backColor lineColor | smallGrid _ Compiler evaluate: (FillInTheBlank request: 'Enter grid size' translated initialAnswer: '16'). smallGrid ifNil: [^ self]. Utilities informUser: 'Choose a background color' translated during: [backColor _ Color fromUser]. Utilities informUser: 'Choose a line color' translated during: [lineColor _ Color fromUser]. self makeGraphPaperGrid: smallGrid background: backColor line: lineColor.! ! !Morph methodsFor: 'e-toy support' stamp: 'dgd 10/8/2003 19:30'! unlockOneSubpart | unlockables aMenu reply | unlockables _ self submorphs select: [:m | m isLocked]. unlockables size <= 1 ifTrue: [^ self unlockContents]. aMenu _ SelectionMenu labelList: (unlockables collect: [:m | m externalName]) selections: unlockables. reply _ aMenu startUpWithCaption: 'Who should be be unlocked?' translated. reply isNil ifTrue: [^ self]. reply unlock! ! !Morph methodsFor: 'fileIn/out' stamp: 'dgd 11/15/2003 19:31'! saveOnFile "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out." | aFileName fileStream ok | aFileName _ ('my {1}' translated format: {self class name}) asFileName. "do better?" aFileName _ FillInTheBlank request: 'File name? (".morph" will be added to end)' translated initialAnswer: aFileName. aFileName isEmpty ifTrue: [^ Beeper beep]. self allMorphsDo: [:m | m prepareToBeSaved]. ok _ aFileName endsWith: '.morph'. "don't double them" ok _ ok | (aFileName endsWith: '.sp'). ok ifFalse: [aFileName _ aFileName,'.morph']. fileStream _ FileStream newFileNamed: aFileName. fileStream fileOutClass: nil andObject: self. "Puts UniClass definitions out anyway"! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 16:57'! addCellLayoutMenuItems: aMenu hand: aHand "Cell (e.g., child) related items" | menu sub | menu _ MenuMorph new defaultTarget: self. menu addUpdating: #hasDisableTableLayoutString action: #changeDisableTableLayout. menu addLine. sub _ MenuMorph new defaultTarget: self. #(rigid shrinkWrap spaceFill) do:[:sym| sub addUpdating: #hResizingString: target: self selector: #hResizing: argumentList: (Array with: sym)]. menu add:'horizontal resizing' translated subMenu: sub. sub _ MenuMorph new defaultTarget: self. #(rigid shrinkWrap spaceFill) do:[:sym| sub addUpdating: #vResizingString: target: self selector: #vResizing: argumentList: (Array with: sym)]. menu add:'vertical resizing' translated subMenu: sub. aMenu ifNotNil:[aMenu add: 'child layout' translated subMenu: menu]. ^menu! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 16:51'! addLayoutMenuItems: topMenu hand: aHand | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addUpdating: #hasNoLayoutString action: #changeNoLayout. aMenu addUpdating: #hasProportionalLayoutString action: #changeProportionalLayout. aMenu addUpdating: #hasTableLayoutString action: #changeTableLayout. aMenu addLine. aMenu add: 'change layout inset...' translated action: #changeLayoutInset:. aMenu addLine. self addCellLayoutMenuItems: aMenu hand: aHand. self addTableLayoutMenuItems: aMenu hand: aHand. topMenu ifNotNil:[topMenu add: 'layout' translated subMenu: aMenu]. ^aMenu! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 20:07'! addTableLayoutMenuItems: aMenu hand: aHand | menu sub | menu _ MenuMorph new defaultTarget: self. menu addUpdating: #hasReverseCellsString action: #changeReverseCells. menu addUpdating: #hasClipLayoutCellsString action: #changeClipLayoutCells. menu addUpdating: #hasRubberBandCellsString action: #changeRubberBandCells. menu addLine. menu add: 'change cell inset...' translated action: #changeCellInset:. menu add: 'change min cell size...' translated action: #changeMinCellSize:. menu add: 'change max cell size...' translated action: #changeMaxCellSize:. menu addLine. sub _ MenuMorph new defaultTarget: self. #(leftToRight rightToLeft topToBottom bottomToTop) do:[:sym| sub addUpdating: #listDirectionString: target: self selector: #changeListDirection: argumentList: (Array with: sym)]. menu add: 'list direction' translated subMenu: sub. sub _ MenuMorph new defaultTarget: self. #(none leftToRight rightToLeft topToBottom bottomToTop) do:[:sym| sub addUpdating: #wrapDirectionString: target: self selector: #wrapDirection: argumentList: (Array with: sym)]. menu add: 'wrap direction' translated subMenu: sub. sub _ MenuMorph new defaultTarget: self. #(center topLeft topRight bottomLeft bottomRight topCenter leftCenter rightCenter bottomCenter) do:[:sym| sub addUpdating: #cellPositioningString: target: self selector: #cellPositioning: argumentList: (Array with: sym)]. menu add: 'cell positioning' translated subMenu: sub. sub _ MenuMorph new defaultTarget: self. #(topLeft bottomRight center justified) do:[:sym| sub addUpdating: #listCenteringString: target: self selector: #listCentering: argumentList: (Array with: sym)]. menu add: 'list centering' translated subMenu: sub. sub _ MenuMorph new defaultTarget: self. #(topLeft bottomRight center justified) do:[:sym| sub addUpdating: #wrapCenteringString: target: self selector: #wrapCentering: argumentList: (Array with: sym)]. menu add: 'wrap centering' translated subMenu: sub. sub _ MenuMorph new defaultTarget: self. #(none equal) do:[:sym| sub addUpdating: #listSpacingString: target: self selector: #listSpacing: argumentList: (Array with: sym)]. menu add: 'list spacing' translated subMenu: sub. sub _ MenuMorph new defaultTarget: self. #(none localRect localSquare globalRect globalSquare) do:[:sym| sub addUpdating: #cellSpacingString: target: self selector: #cellSpacing: argumentList: (Array with: sym)]. menu add: 'cell spacing' translated subMenu: sub. aMenu ifNotNil:[aMenu add: 'table layout' translated subMenu: menu]. ^menu! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 20:09'! hasClipLayoutCellsString ^ (self clipLayoutCells ifTrue: [''] ifFalse: ['']), 'clip to cell size' translated! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 16:58'! hasDisableTableLayoutString ^ (self disableTableLayout ifTrue: [''] ifFalse: ['']) , 'disable layout in tables' translated! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 10/8/2003 19:23'! hasNoLayoutString ^ (self layoutPolicy isNil ifTrue: [''] ifFalse: ['']) , 'no layout' translated! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 16:55'! hasProportionalLayoutString | layout | ^ (((layout := self layoutPolicy) notNil and: [layout isProportionalLayout]) ifTrue: [''] ifFalse: ['']) , 'proportional layout' translated! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 20:08'! hasReverseCellsString ^ (self reverseTableCells ifTrue: [''] ifFalse: ['']), 'reverse table cells' translated! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 20:09'! hasRubberBandCellsString ^ (self rubberBandCells ifTrue: [''] ifFalse: ['']), 'rubber band cells' translated! ! !Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 16:59'! hasTableLayoutString | layout | ^ (((layout := self layoutPolicy) notNil and: [layout isTableLayout]) ifTrue: [''] ifFalse: ['']) , 'table layout' translated! ! !Morph methodsFor: 'menus' stamp: 'dgd 10/8/2003 19:16'! adMiscExtrasTo: aMenu "Add a submenu of miscellaneous extra items to the menu." | realOwner realMorph subMenu | subMenu _ MenuMorph new defaultTarget: self. (self isWorldMorph not and: [self renderedMorph isSystemWindow not]) ifTrue: [subMenu add: 'put in a window' translated action: #embedInWindow]. self isWorldMorph ifFalse: [subMenu add: 'adhere to edge...' translated action: #adhereToEdge. subMenu addLine]. realOwner _ (realMorph _ self topRendererOrSelf) owner. (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue: [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)]. self affiliatedSelector ifNotNil: [subMenu add: 'open a messenger' translated action: #openMessenger. subMenu balloonTextForLastItem: 'Open a Messenger on the actual method call used when the button action of this object is triggered.' translated. subMenu addLine]. subMenu add: 'add mouse up action' translated action: #addMouseUpAction; add: 'remove mouse up action' translated action: #removeMouseUpAction; add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire. subMenu addLine. subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads. subMenu addLine. subMenu defaultTarget: self topRendererOrSelf. subMenu add: 'draw new path' translated action: #definePath. subMenu add: 'follow existing path' translated action: #followPath. subMenu add: 'delete existing path' translated action: #deletePath. subMenu addLine. self addGenieMenuItems: subMenu hand: ActiveHand. aMenu add: 'extras...' translated subMenu: subMenu! ! !Morph methodsFor: 'menus' stamp: 'dgd 11/15/2003 19:25'! addCopyItemsTo: aMenu "Add copy-like items to the halo menu" | subMenu | subMenu _ MenuMorph new defaultTarget: self. subMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:. subMenu add: 'copy text' translated action: #clipText. subMenu add: 'copy Postscript' translated action: #clipPostscript. subMenu add: 'print Postscript to file...' translated target: self selector: #printPSToFile. aMenu add: 'copy & print...' translated subMenu: subMenu! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:32'! addExportMenuItems: aMenu hand: aHandMorph "Add export items to the menu" aMenu ifNotNil: [ | aSubMenu | aSubMenu _ MenuMorph new defaultTarget: self. aSubMenu add: 'BMP file' translated action: #exportAsBMP. aSubMenu add: 'GIF file' translated action: #exportAsGIF. aSubMenu add: 'JPEG file' translated action: #exportAsJPEG. aMenu add: 'export...' translated subMenu: aSubMenu] ! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 16:44'! addFillStyleMenuItems: aMenu hand: aHand "Add the items for changing the current fill style of the Morph" | menu | self canHaveFillStyles ifFalse:[^aMenu add: 'change color...' translated target: self action: #changeColor]. menu _ MenuMorph new defaultTarget: self. self fillStyle addFillStyleMenuItems: menu hand: aHand from: self. menu addLine. menu add: 'solid fill' translated action: #useSolidFill. menu add: 'gradient fill' translated action: #useGradientFill. menu add: 'bitmap fill' translated action: #useBitmapFill. menu add: 'default fill' translated action: #useDefaultFill. aMenu add: 'fill style' translated subMenu: menu. "aMenu add: 'change color...' translated action: #changeColor"! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:14'! addHaloActionsTo: aMenu "Add items to aMenu representing actions requestable via halo" | subMenu | subMenu _ MenuMorph new defaultTarget: self. subMenu addTitle: self externalName. subMenu addStayUpItemSpecial. subMenu addLine. subMenu add: 'delete' translated action: #dismissViaHalo. subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated. self maybeAddCollapseItemTo: subMenu. subMenu add: 'grab' translated action: #openInHand. subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated. subMenu addLine. subMenu add: 'resize' translated action: #resizeFromMenu. subMenu balloonTextForLastItem: 'Change the size of this object' translated. subMenu add: 'duplicate' translated action: #maybeDuplicateMorph. subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated. subMenu addLine. subMenu add: 'property sheet' translated target: self renderedMorph action: #openAPropertySheet. subMenu balloonTextForLastItem: 'Open a property sheet for me. Allows changing lots of stuff at once.' translated. subMenu add: 'set color' translated target: self renderedMorph action: #changeColor. subMenu balloonTextForLastItem: 'Change the color of this object' translated. subMenu add: 'viewer' translated target: self action: #beViewed. subMenu balloonTextForLastItem: 'Open a Viewer that will allow everything about this object to be seen and controlled.' translated. subMenu add: 'tile browser' translated target: self action: #openInstanceBrowserWithTiles. subMenu balloonTextForLastItem: 'Open a tool that will facilitate tile scripting of this object.' translated. subMenu add: 'hand me a tile' translated target: self action: #tearOffTile. subMenu balloonTextForLastItem: 'Hand me a tile represting this object' translated. subMenu addLine. subMenu add: 'inspect' translated target: self action: #inspect. subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated. aMenu add: 'halo actions...' translated subMenu: subMenu ! ! !Morph methodsFor: 'menus' stamp: 'dgd 9/5/2003 19:26'! addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu _ MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing. subMenu add: 'set rotation center' translated action: #setRotationCenter. subMenu add: 'reset forward-direction' translated action: #resetForwardDirection. subMenu add: 'set rotation style' translated action: #setRotationStyle. subMenu add: 'erase pixels of color' translated action: #erasePixelsOfColor:. subMenu add: 'recolor pixels of color' translated action: #recolorPixelsOfColor:. subMenu add: 'reduce color palette' translated action: #reduceColorPalette:. subMenu add: 'add a border around this shape...' translated action: #addBorderToShape:. movies _ (self world rootMorphsAt: aHandMorph targetOffset) select: [:m | (m isKindOf: MovieMorph) or: [m isKindOf: SketchMorph]]. (movies size > 1) ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:30'! addPlayerItemsTo: aMenu "Add player-related items to the menu if appropriate" | aPlayer subMenu | aPlayer _ self topRendererOrSelf player. subMenu _ MenuMorph new defaultTarget: self. subMenu add: 'make a sibling instance' translated target: self action: #makeNewPlayerInstance:. subMenu balloonTextForLastItem: 'Makes another morph whose player is of the same class as this one. Both siblings will share the same scripts' translated. subMenu add: 'make multiple siblings...' translated target: self action: #makeMultipleSiblings:. subMenu balloonTextForLastItem: 'Make any number of sibling instances all at once' translated. (aPlayer belongsToUniClass and: [aPlayer class instanceCount > 1]) ifTrue: [subMenu addLine. subMenu add: 'make all siblings look like me' translated target: self action: #makeSiblingsLookLikeMe:. subMenu balloonTextForLastItem: 'make all my sibling instances look like me.' translated. subMenu add: 'bring all siblings to my location' translated target: self action: #bringAllSiblingsToMe:. subMenu balloonTextForLastItem: 'find all sibling instances and bring them to me' translated. subMenu add: 'apply status to all siblngs' translated target: self action: #applyStatusToAllSiblings:. subMenu balloonTextForLastItem: 'apply the current status of all of my scripts to the scripts of all my siblings' translated]. aMenu add: 'siblings...' translated subMenu: subMenu ! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:34'! addStackItemsTo: aMenu "Add stack-related items to the menu" | stackSubMenu | stackSubMenu _ MenuMorph new defaultTarget: self. (owner notNil and: [owner isStackBackground]) ifTrue: [self isShared ifFalse: [self couldHoldSeparateDataForEachInstance ifTrue: [stackSubMenu add: 'Background field, shared value' translated target: self action: #putOnBackground. stackSubMenu add: 'Background field, individual values' translated target: self action: #becomeSharedBackgroundField] ifFalse: [stackSubMenu add: 'put onto Background' translated target: self action: #putOnBackground]] ifTrue: [stackSubMenu add: 'remove from Background' translated target: self action: #putOnForeground. self couldHoldSeparateDataForEachInstance ifTrue: [self holdsSeparateDataForEachInstance ifFalse: [stackSubMenu add: 'start holding separate data for each instance' translated target: self action: #makeHoldSeparateDataForEachInstance] ifTrue: [stackSubMenu add: 'stop holding separate data for each instance' translated target: self action: #stopHoldingSeparateDataForEachInstance]. stackSubMenu add: 'be default value on new card' translated target: self action: #setAsDefaultValueForNewCard. (self hasProperty: #thumbnailImage) ifTrue: [stackSubMenu add: 'stop using for reference thumbnail' translated target: self action: #stopUsingForReferenceThumbnail] ifFalse: [stackSubMenu add: 'start using for reference thumbnail' translated target: self action: #startUsingForReferenceThumbnail]]]. stackSubMenu addLine]. (self isStackBackground) ifFalse: [stackSubMenu add: 'be a card in an existing stack...' translated action: #insertAsStackBackground]. stackSubMenu add: 'make an instance for my data' translated action: #abstractAModel. (self isStackBackground) ifFalse: [stackSubMenu add: 'become a stack of cards' translated action: #wrapWithAStack]. aMenu add: 'stacks and cards...' translated subMenu: stackSubMenu ! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 16:39'! addStandardHaloMenuItemsTo: aMenu hand: aHandMorph "Add standard halo items to the menu" | unlockables | self isWorldMorph ifTrue: [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph]. self mustBeBackmost ifFalse: [aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph. aMenu addLine]. self addFillStyleMenuItems: aMenu hand: aHandMorph. self addBorderStyleMenuItems: aMenu hand: aHandMorph. self addDropShadowMenuItems: aMenu hand: aHandMorph. self addLayoutMenuItems: aMenu hand: aHandMorph. self addHaloActionsTo: aMenu. owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph]. aMenu addLine. self addToggleItemsToHaloMenu: aMenu. aMenu addLine. self addCopyItemsTo: aMenu. self addPlayerItemsTo: aMenu. self addExportMenuItems: aMenu hand: aHandMorph. self addStackItemsTo: aMenu. self adMiscExtrasTo: aMenu. Preferences noviceMode ifFalse: [self addDebuggingItemsTo: aMenu hand: aHandMorph]. aMenu addLine. aMenu defaultTarget: self. aMenu addLine. unlockables _ self submorphs select: [:m | m isLocked]. unlockables size == 1 ifTrue: [aMenu add: ('unlock "{1}"' translated format: unlockables first externalName) action: #unlockContents]. unlockables size > 1 ifTrue: [aMenu add: 'unlock all contents' translated action: #unlockContents. aMenu add: 'unlock...' translated action: #unlockOneSubpart]. aMenu defaultTarget: aHandMorph. ! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:22'! addToggleItemsToHaloMenu: aMenu "Add standard true/false-checkbox items to the memu" #( (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle') (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me') (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions') (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.') (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo') (hasDragAndDropEnabledString changeDragAndDrop 'whether I am open to having objects dropped into me') ) do: [:trip | aMenu addUpdating: trip first action: trip second. aMenu balloonTextForLastItem: trip third translated]. self couldHaveRoundedCorners ifTrue: [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding. aMenu balloonTextForLastItem: 'whether my corners should be rounded']! ! !Morph methodsFor: 'menus' stamp: 'dgd 10/8/2003 18:29'! dismissButton "Answer a button whose action would be to dismiss the receiver, and whose action is to send #delete to the receiver" | aButton | aButton _ SimpleButtonMorph new. aButton target: self topRendererOrSelf; color: Color tan; label: 'X' font: Preferences standardButtonFont; actionSelector: #delete; setBalloonText: 'dismiss' translated. ^ aButton! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:23'! hasDirectionHandlesString ^ (self wantsDirectionHandles ifTrue: [''] ifFalse: ['']) , 'direction handles' translated! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:24'! hasDragAndDropEnabledString "Answer a string to characterize the drag & drop status of the receiver" ^ (self dragNDropEnabled ifTrue: [''] ifFalse: ['']) , 'accept drops' translated! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 16:19'! 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 lighter; label: '?' translated font: Preferences standardButtonFont; actionSelector: #presentHelp; setBalloonText: 'click here for help' translated. ^ aButton! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:20'! lockedString "Answer the string to be shown in a menu to represent the 'locked' status" ^ (self isLocked ifTrue: [''] ifFalse: ['']), 'be locked' translated! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:15'! maybeAddCollapseItemTo: aMenu "If appropriate, add a collapse item to the given menu" | anOwner | (anOwner _ self topRendererOrSelf owner) ifNotNil: [anOwner isWorldMorph ifTrue: [aMenu add: 'collapse' translated target: self action: #collapse]]! ! !Morph methodsFor: 'menus' stamp: 'dgd 11/15/2003 19:31'! printPSToFileNamed: aString "Ask the user for a filename and print this morph as postscript." | fileName rotateFlag | fileName _ aString asFileName. fileName _ FillInTheBlank request: 'File name? (".eps" will be added to end)' translated initialAnswer: fileName. fileName isEmpty ifTrue: [^ Beeper beep]. (fileName endsWith: '.eps') ifFalse: [fileName _ fileName,'.eps']. rotateFlag _ ((PopUpMenu labels: 'portrait (tall) landscape (wide)') translated startUpWithCaption: 'Choose orientation...' translated) = 2. (FileStream newFileNamed: fileName) nextPutAll: ( PostscriptCanvas defaultCanvasType morphAsPostscript: self rotated: rotateFlag ); close. ! ! !Morph methodsFor: 'menus' stamp: 'dgd 9/5/2003 18:25'! putOnForeground "Place the receiver, formerly on the background, onto the foreground. If the receiver needs data carried on its behalf by the card, those data will be lost, so in this case get user confirmation before proceeding." self holdsSeparateDataForEachInstance "later add the refinement of not putting up the following confirmer if only a single instance of the current background's uniclass exists" ifTrue: [self confirm: 'Caution -- every card of this background formerly had its own value for this item. If you put it on the foreground, the values of this item on all other cards will be lost' translated orCancel: [^ self]]. self removeProperty: #shared. self stack reassessBackgroundShape. "still work to be done here!!"! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:18'! resistsRemovalString "Answer the string to be shown in a menu to represent the 'resistsRemoval' status" ^ (self resistsRemoval ifTrue: [''] ifFalse: ['']), 'resist being deleted' translated! ! !Morph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:19'! stickinessString "Answer the string to be shown in a menu to represent the stickiness status" ^ (self isSticky ifTrue: [''] ifFalse: ['']) , 'resist being picked up' translated! ! !Morph methodsFor: 'meta-actions' stamp: 'dgd 8/30/2003 16:42'! addEmbeddingMenuItemsTo: aMenu hand: aHandMorph | menu | menu _ MenuMorph new defaultTarget: self. self potentialEmbeddingTargets reverseDo: [:m | menu add: (m knownName ifNil:[m class name asString]) target: m selector: #addMorphFrontFromWorldPosition: argumentList: {self}]. aMenu ifNotNil:[ menu submorphCount > 0 ifTrue:[aMenu add:'embed into' translated subMenu: menu]. ]. ^menu! ! !Morph methodsFor: 'meta-actions' stamp: 'dgd 11/15/2003 19:29'! buildMetaMenu: evt "Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph." | menu | menu _ MenuMorph new defaultTarget: self. menu addStayUpItem. menu add: 'grab' translated action: #grabMorph:. menu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:. self maybeAddCollapseItemTo: menu. menu add: 'delete' translated action: #dismissMorph:. menu addLine. menu add: 'copy text' translated action: #clipText. menu add: 'copy Postscript' translated action: #clipPostscript. menu add: 'print Postscript to file...' translated action: #printPSToFile. menu addLine. menu add: 'go behind' translated action: #goBehind. menu add: 'add halo' translated action: #addHalo:. menu add: 'duplicate' translated action: #maybeDuplicateMorph:. self addEmbeddingMenuItemsTo: menu hand: evt hand. menu add: 'resize' translated action: #resizeMorph:. "Give the argument control over what should be done about fill styles" self addFillStyleMenuItems: menu hand: evt hand. self addDropShadowMenuItems: menu hand: evt hand. self addLayoutMenuItems: menu hand: evt hand. menu addUpdating: #hasClipSubmorphsString target: self selector: #changeClipSubmorphs argumentList: #(). menu addLine. (self morphsAt: evt position) size > 1 ifTrue: [menu add: 'submorphs...' translated target: self selector: #invokeMetaMenuAt:event: argument: evt position]. menu addLine. menu add: 'inspect' translated selector: #inspectAt:event: argument: evt position. menu add: 'explore' translated action: #explore. menu add: 'browse hierarchy' translated action: #browseHierarchy. menu add: 'make own subclass' translated action: #subclassMorph. menu addLine. menu add: 'set variable name...' translated action: #choosePartName. (self isMorphicModel) ifTrue: [menu add: 'save morph as prototype' translated action: #saveAsPrototype. (self ~~ self world modelOrNil) ifTrue: [menu add: 'become this world''s model' translated action: #beThisWorldsModel]]. menu add: 'save morph in file' translated action: #saveOnFile. (self hasProperty: #resourceFilePath) ifTrue: [((self valueOfProperty: #resourceFilePath) endsWith: '.morph') ifTrue: [menu add: 'save as resource' translated action: #saveAsResource]. menu add: 'update from resource' translated action: #updateFromResource] ifFalse: [menu add: 'attach to resource' translated action: #attachToResource]. menu add: 'show actions' translated action: #showActions. menu addLine. self addDebuggingItemsTo: menu hand: evt hand. self addCustomMenuItems: menu hand: evt hand. ^ menu ! ! !Morph methodsFor: 'meta-actions' stamp: 'sd 11/13/2003 21:28'! makeMultipleSiblings: evt "Make multiple siblings, first prompting the user for how many" | result | result _ FillInTheBlank request: 'how many siblings do you want?' translated initialAnswer: '2'. result isEmptyOrNil ifTrue: [^ self]. result first isDigit ifFalse: [^ Beeper beep]. self topRendererOrSelf makeSiblings: result asInteger.! ! !Morph methodsFor: 'naming' stamp: 'dgd 8/30/2003 15:52'! innocuousName "Choose an innocuous name for the receiver -- one that does not end in the word Morph" | className allKnownNames | className _ self defaultNameStemForInstances. (className size > 5 and: [className endsWith: 'Morph']) ifTrue: [className _ className copyFrom: 1 to: className size - 5]. className _ className asString translated. allKnownNames _ self world ifNil: [OrderedCollection new] ifNotNil: [self world allKnownNames]. ^ Utilities keyLike: className asString satisfying: [:aName | (allKnownNames includes: aName) not]! ! !Morph methodsFor: 'rounding' stamp: 'dgd 9/6/2003 18:27'! roundedCornersString "Answer the string to put in a menu that will invite the user to switch to the opposite corner-rounding mode" ^ (self wantsRoundedCorners ifTrue: [''] ifFalse: ['']) , 'round corners' translated! ! !Morph methodsFor: 'text-anchor' stamp: 'dgd 9/6/2003 18:14'! hasDocumentAnchorString ^ (self textAnchorType == #document ifTrue: [''] ifFalse: ['']) , 'Document' translated! ! !Morph methodsFor: 'text-anchor' stamp: 'dgd 9/6/2003 18:14'! hasInlineAnchorString ^ (self textAnchorType == #inline ifTrue: [''] ifFalse: ['']) , 'Inline' translated! ! !Morph methodsFor: 'text-anchor' stamp: 'dgd 9/6/2003 18:14'! hasParagraphAnchorString ^ (self textAnchorType == #paragraph ifTrue: [''] ifFalse: ['']) , 'Paragraph' translated! ! !BackgroundMorph methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:56'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. running ifTrue: [aCustomMenu add: 'stop' translated action: #stopRunning] ifFalse: [aCustomMenu add: 'start' translated action: #startRunning]! ! !BorderedMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 16:47'! addBorderStyleMenuItems: aMenu hand: aHandMorph "Add border-style menu items" | subMenu | subMenu _ MenuMorph new defaultTarget: self. subMenu addTitle: 'border' translated. subMenu addStayUpItemSpecial. subMenu addList: {{'border color...' translated. #changeBorderColor:}. {'border width...' translated. #changeBorderWidth:}}. subMenu addLine. BorderStyle borderStyleChoices do: [:sym | (self borderStyleForSymbol: sym) ifNotNil: [subMenu add: sym target: self selector: #setBorderStyle: argument: sym]]. aMenu add: 'border style...' translated subMenu: subMenu ! ! !BorderedMorph methodsFor: 'menu' stamp: 'dgd 8/26/2003 21:44'! changeBorderWidth: evt | handle origin aHand newWidth oldWidth | aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin _ aHand position. oldWidth _ borderWidth. handle _ HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth _ (newPoint - origin) r asInteger // 5. self borderWidth: newWidth] lastPointDo: [:newPoint | handle deleteBalloon. self halo doIfNotNil: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change' translated; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase border width. Click when done.' hand: evt hand. handle startStepping! ! !AlignmentMorph class methodsFor: 'instance creation' stamp: 'dgd 9/20/2003 19:05'! columnPrototype "Answer a prototypical column" | sampleMorphs aColumn | sampleMorphs _ #(red yellow green) collect: [:aColor | Morph new extent: 130 @ 38; color: (Color perform: aColor); setNameTo: aColor asString; yourself]. aColumn _ self inAColumn: sampleMorphs. aColumn setNameTo: 'Column'. aColumn color: Color veryVeryLightGray. aColumn cellInset: 4; layoutInset: 6. aColumn enableDragNDrop. aColumn setBalloonText: 'Things dropped into here will automatically be organized into a column. Once you have added your own items here, you will want to remove the sample colored rectangles that this started with, and you will want to change this balloon help message to one of your own!!' translated. ^ aColumn! ! !AlignmentMorph class methodsFor: 'instance creation' stamp: 'dgd 9/20/2003 19:05'! rowPrototype "Answer a prototypical row" | sampleMorphs aRow | sampleMorphs _ (1 to: (2 + 3 atRandom)) collect: [:integer | EllipseMorph new extent: ((60 + (20 atRandom)) @ (80 + ((20 atRandom)))); color: Color random; setNameTo: ('egg', integer asString); yourself]. aRow _ self inARow: sampleMorphs. aRow setNameTo: 'Row'. aRow enableDragNDrop. aRow cellInset: 6. aRow layoutInset: 8. aRow setBalloonText: 'Things dropped into here will automatically be organized into a row. Once you have added your own items here, you will want to remove the sample colored eggs that this started with, and you will want to change this balloon help message to one of your own!!' translated. aRow color: Color veryVeryLightGray. ^ aRow "AlignmentMorph rowPrototype openInHand"! ! !AllScriptsTool methodsFor: 'initialization' stamp: 'dgd 9/19/2003 14:34'! addSecondLineOfControls "Add the second line of controls" | aRow outerButton aButton worldToUse | 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 addTransparentSpacerOfSize: (4@0). outerButton addMorphBack: (StringMorph contents: 'tickers only' translated) lock. outerButton setBalloonText: 'If checked, then only scripts that are paused or ticking will be shown' translated. aRow addMorphBack: outerButton. aRow addTransparentSpacerOfSize: 20@0. aRow addMorphBack: self helpButton. aRow addTransparentSpacerOfSize: 20@0. 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 addTransparentSpacerOfSize: (4@0). outerButton addMorphBack: (StringMorph contents: 'all instances' translated) lock. outerButton setBalloonText: 'If checked, then entries for all instances will be shown, but if not checked, scripts for only one representative of each different kind of object will be shown. Consult the help available by clicking on the purple ? for more information.' translated. aRow addMorphBack: outerButton. self addMorphBack: aRow. worldToUse _ self isInWorld ifTrue: [self world] ifFalse: [ActiveWorld]. worldToUse presenter reinvigorateAllScriptsTool: self. self layoutChanged.! ! !AllScriptsTool methodsFor: 'initialization' stamp: 'dgd 8/31/2003 19:43'! dismissButton "Answer a button whose action would be to dismiss the receiver " | aButton | aButton := super dismissButton. aButton setBalloonText: 'Click here to remove this tool from the screen; you can get another one any time you want from the Widgets flap' translated. ^ aButton! ! !AllScriptsTool methodsFor: 'initialization' stamp: 'dgd 9/19/2003 14:35'! presentHelp "Sent when a Help button is hit; provide the user with some form of help for the tool at hand" | aString | aString _ 'This tool allows you to see all the scripts for all the objects in this project. Sometimes you are only interested in those scripts that are ticking, or that are *ready* to tick when you hit the GO button (which are said to be "paused.") Check "tickers only" if you only want to see such scripts -- i.e., scripts that are either paused or ticking. If "tickers only" is *not* checked, then all scripts will be shown, whatever their status. The other checkbox, labeled "all instances", only comes into play if you have created "multiple sibling instances" (good grief) of the same object, which share the same scripts; if you have such things, it is often convenient to see the scripts of just *one* such sibling, because it will take up less space and require less mindshare -- and note that you can control a script for an object *and* all its siblings from the menu of that one that you see, via menu items such as "propagate status to siblings". If "all instances" is checked, scripts for all sibling instances will be shown, whereas if "all instances" is *not* checked, only one of each group of siblings will be selected to have its scripts shown. But how do you get "multiple sibling instances" of the same object? There are several ways: (1) Use the "make a sibling instance" or the "make multiple siblings..." menu item in the halo menu of a scripted object (2) Use the "copy" tile in a script. (3) Request "give me a copy now" from the menu associated with the "copy" item in a Viewer If you have on your screen multiple sibling instances of the same object, then you may or may want to see them all in the All Scripts tool, and that is what the "all instances" checkbox governs. Set "all instances" if you want a separate entry for each instance, as opposed to a single representative of that kind of object. Note that if you obtain a copy of an object by using the green halo handle, it will *not* be a sibling instance of the original. It will in many ways seem to be, because it will start out its life having the same scripts as the original. But it will then lead an independent life, so that changes to scripts of the original will not be reflected in it, and vice-versa. This is an important distinction, and an unavoidable one because people sometimes want the deep sharing of sibling instances and sometimes they clearly do not. But the truly understandable description of these concepts and distinctions certainly lies *ahead* of us!!'. (StringHolder new contents: aString translated) openLabel: 'About the All Scripts tool' translated! ! !AllScriptsTool methodsFor: 'toggles' stamp: 'dgd 9/19/2003 14:37'! openUpButton "Answer a button whose action would be to open up the receiver or snap it back closed" | aButton | aButton _ SimpleButtonMorph new. aButton target: self topRendererOrSelf; color: (Color r: 0.452 g: 0.839 b: 0.935); label: '¼' font: Preferences standardButtonFont; actionSelector: #toggleWhetherShowingOnlyTopControls; setBalloonText: 'open or close the lower portion that shows individual scripts' translated. ^ aButton! ! !BasicButton methodsFor: 'menus' stamp: 'dgd 8/30/2003 20:56'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'change label...' translated action: #setLabel! ! !BooklikeMorph methodsFor: 'misc' stamp: 'dgd 8/30/2003 21:13'! addBookMenuItemsTo: aCustomMenu hand: aHandMorph (self hasSubmorphWithProperty: #pageControl) ifTrue: [aCustomMenu add: 'hide page controls' translated action: #hidePageControls] ifFalse: [aCustomMenu add: 'show page controls' translated action: #showPageControls]! ! !BooklikeMorph methodsFor: 'misc' stamp: 'dgd 9/19/2003 11:04'! showingFullScreenString ^ (self isInFullScreenMode ifTrue: ['exit full screen'] ifFalse: ['show full screen']) translated! ! !BooklikeMorph methodsFor: 'misc' stamp: 'dgd 9/19/2003 11:04'! showingPageControlsString ^ (self pageControlsVisible ifTrue: ['hide page controls'] ifFalse: ['show page controls']) translated! ! !BooklikeMorph methodsFor: 'page controls' stamp: 'dgd 9/19/2003 11:34'! fullControlSpecs ^ { #spacer. #variableSpacer. {'-'. #deletePage. 'Delete this page' translated}. #spacer. {'Ç'. #firstPage. 'First page' translated}. #spacer. {'<'. #previousPage. 'Previous page' translated}. #spacer. {'¥'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}. #spacer. {'>'. #nextPage. 'Next page' translated}. #spacer. { 'È'. #lastPage. 'Final page' translated}. #spacer. {'+'. #insertPage. 'Add a new page after this one' translated}. #variableSpacer. {'×'. #fewerPageControls. 'Fewer controls' translated} } ! ! !BooklikeMorph methodsFor: 'page controls' stamp: 'dgd 9/19/2003 11:35'! shortControlSpecs ^ { #spacer. #variableSpacer. {'<'. #previousPage. 'Previous page' translated}. #spacer. {'¥'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}. #spacer. {'>'. #nextPage. 'Next page' translated}. #spacer. #variableSpacer. {'×'. #showMoreControls. 'More controls' translated} } ! ! !BookMorph methodsFor: 'insert and delete' stamp: 'dgd 9/21/2003 17:45'! deletePage | message | message _ 'Are you certain that you want to delete this page and everything that is on it? ' translated. (self confirm: message) ifTrue: [self deletePageBasic]. ! ! !BookMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:13'! addBookMenuItemsTo: aMenu hand: aHandMorph | controlsShowing subMenu | subMenu _ MenuMorph new defaultTarget: self. subMenu add: 'previous page' translated action: #previousPage. subMenu add: 'next page' translated action: #nextPage. subMenu add: 'goto page' translated action: #goToPage. subMenu add: 'insert a page' translated action: #insertPage. subMenu add: 'delete this page' translated action: #deletePage. controlsShowing _ self hasSubmorphWithProperty: #pageControl. controlsShowing ifTrue: [subMenu add: 'hide page controls' translated action: #hidePageControls. subMenu add: 'fewer page controls' translated action: #fewerPageControls] ifFalse: [subMenu add: 'show page controls' translated action: #showPageControls]. self isInFullScreenMode ifTrue: [ subMenu add: 'exit full screen' translated action: #exitFullScreen. ] ifFalse: [ subMenu add: 'show full screen' translated action: #goFullScreen. ]. subMenu addLine. subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. subMenu addLine. subMenu add: 'sort pages' translated action: #sortPages:. subMenu add: 'uncache page sorter' translated action: #uncachePageSorter. (self hasProperty: #dontWrapAtEnd) ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. subMenu addLine. subMenu add: 'search for text' translated action: #textSearch. (aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [subMenu add: 'paste book page' translated action: #pasteBookPage]. subMenu add: 'send all pages to server' translated action: #savePagesOnURL. subMenu add: 'send this page to server' translated action: #saveOneOnURL. subMenu add: 'reload all from server' translated action: #reload. subMenu add: 'copy page url to clipboard' translated action: #copyUrl. subMenu add: 'keep in one file' translated action: #keepTogether. subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: 'book...' translated subMenu: subMenu ! ! !BookMorph methodsFor: 'menu' stamp: 'dgd 9/19/2003 11:06'! invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu _ MenuMorph new defaultTarget: self. aMenu addStayUpItem. aMenu add: 'find...' translated action: #textSearch. aMenu add: 'go to page...' translated action: #goToPage. aMenu addLine. aMenu addList: { {'sort pages' translated. #sortPages}. {'uncache page sorter' translated. #uncachePageSorter}}. (self hasProperty: #dontWrapAtEnd) ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true] ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false]. aMenu addList: { {'make bookmark' translated. #bookmarkForThisPage}. {'make thumbnail' translated. #thumbnailForThisPage}}. aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls. aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen. aMenu addLine. aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:. aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:. aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:. aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:. aMenu addLine. (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue: [aMenu add: 'paste book page' translated action: #pasteBookPage]. aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype. newPagePrototype ifNotNil: [ aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype]. aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated action: #toggleDragNDrop. aMenu add: 'make all pages this size' translated action: #makeUniformPageSize. aMenu add: 'send all pages to server' translated action: #savePagesOnURL. aMenu add: 'send this page to server' translated action: #saveOneOnURL. aMenu add: 'reload all from server' translated action: #reload. aMenu add: 'copy page url to clipboard' translated action: #copyUrl. aMenu add: 'keep in one file' translated action: #keepTogether. aMenu addLine. aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook. aMenu add: 'background color for all pages...' translated action: #setPageColor. aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects. aMenu popUpEvent: self world activeHand lastEvent in: self world ! ! !BookMorph methodsFor: 'printing' stamp: 'sd 11/13/2003 21:04'! printPSToFile "Ask the user for a filename and print this morph as postscript." | fileName rotateFlag | fileName _ ('MyBook') translated asFileName. fileName _ FillInTheBlank request: 'File name? (".ps" will be added to end)' translated initialAnswer: fileName. fileName isEmpty ifTrue: [^ Beeper beep]. (fileName endsWith: '.ps') ifFalse: [fileName _ fileName,'.ps']. rotateFlag _ ((PopUpMenu labels: 'portrait (tall) landscape (wide)') translated startUpWithCaption: 'Choose orientation...' translated) = 2. (FileStream newFileNamed: fileName) nextPutAll: (DSCPostscriptCanvas morphAsPostscript: self rotated: rotateFlag); close. ! ! !BouncingAtomsMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:15'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'startInfection' translated action: #startInfection. aCustomMenu add: 'set atom count' translated action: #setAtomCount. aCustomMenu add: 'show infection history' translated action: #showInfectionHistory:. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:00'! mouseDownEvent: evt for: aSubmorph | why aMenu | why _ aSubmorph valueOfProperty: #intentOfDroppedMorphs. why == #changeTargetMorph ifTrue: [ aMenu _ MenuMorph new defaultTarget: self. { {'Rectangle'. RectangleMorph}. {'Ellipse'. EllipseMorph} } do: [ :pair | aMenu add: pair first translated target: self selector: #attachMorphOfClass:to: argumentList: {pair second. evt hand}. ]. aMenu popUpEvent: evt in: self world. ^self ]. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForActsOnMouseDownToggle ^self inARow: { self directToggleButtonFor: self getter: #targetActsOnMouseDown setter: #toggleTargetActsOnMouseDown help: 'If the button is to act when the mouse goes down' translated. self lockedString: ' Mouse-down action' translated. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForActsOnMouseUpToggle ^self inARow: { self directToggleButtonFor: self getter: #targetActsOnMouseUp setter: #toggleTargetActsOnMouseUp help: 'If the button is to act when the mouse goes up' translated. self lockedString: ' Mouse-up action' translated. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForButtonSelectorReport ^self inARow: { self lockedString: 'Action: ' translated. UpdatingStringMorph new useStringFormat; getSelector: #actionSelector; target: self targetProperties; growable: true; minimumWidth: 24; lock. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForButtonTargetReport | r | r _ self inARow: { self lockedString: 'Target: ' translated. UpdatingStringMorph new useStringFormat; getSelector: #target; target: self targetProperties; growable: true; minimumWidth: 24; lock. }. r hResizing: #shrinkWrap. self allowDropsInto: r withIntent: #changeTargetTarget. r setBalloonText: 'Drop another morph here to change the target and action of this button. (Only some morphs will work)' translated. ^self inARow: {r} ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForChangeMouseDownLook | r | r _ self inARow: { self lockedString: ' Mouse-down look ' translated. }. self allowDropsInto: r withIntent: #changeTargetMouseDownLook. r setBalloonText: 'Drop another morph here to change the visual appearance of this button when the mouse is clicked in it.' translated. ^r ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForChangeMouseEnterLook | r | r _ self inARow: { self lockedString: ' Mouse-enter look ' translated. }. self allowDropsInto: r withIntent: #changeTargetMouseEnterLook. r setBalloonText: 'Drop another morph here to change the visual appearance of this button when the mouse enters it.' translated. ^r ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForChangeVisibleMorph | r | r _ self inARow: { self lockedString: ' Change morph ' translated. }. r on: #mouseDown send: #mouseDownEvent:for: to: self. self allowDropsInto: r withIntent: #changeTargetMorph. r setBalloonText: 'Drop another morph here to change the visual appearance of this button. Or click here to get a menu of possible replacement morphs.' translated. ^r ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForMouseDownColorPicker ^self inAColumn: { (self inAColumn: { self colorPickerFor: self targetProperties getter: #mouseDownHaloColor setter: #mouseDownHaloColor:. self lockedString: 'mouse-down halo color' translated. self paneForMouseDownHaloWidth. } named: #pickerForMouseDownColor) layoutInset: 0. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:01'! paneForMouseDownHaloWidth ^(self inARow: { self buildFakeSlider: #valueForMouseDownHaloWidth selector: #adjustTargetMouseDownHaloSize: help: 'Drag in here to change the halo width' translated }) hResizing: #shrinkWrap ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:02'! paneForMouseOverColorPicker ^self inAColumn: { (self inAColumn: { self colorPickerFor: self targetProperties getter: #mouseOverHaloColor setter: #mouseOverHaloColor:. self lockedString: 'mouse-over halo color' translated. self paneForMouseOverHaloWidth. } named: #pickerForMouseOverColor) layoutInset: 0. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:02'! paneForMouseOverHaloWidth ^(self inARow: { self buildFakeSlider: #valueForMouseOverHaloWidth selector: #adjustTargetMouseOverHaloSize: help: 'Drag in here to change the halo width' translated }) hResizing: #shrinkWrap ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:02'! paneForRepeatingInterval ^(self inAColumn: { self buildFakeSlider: #valueForRepeatingInterval selector: #adjustTargetRepeatingInterval: help: 'Drag in here to change how often the button repeats while the mouse is down' translated } named: #paneForRepeatingInterval ) hResizing: #shrinkWrap ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:02'! paneForWantsFiringWhileDownToggle ^self inARow: { self directToggleButtonFor: self getter: #targetRepeatingWhileDown setter: #toggleTargetRepeatingWhileDown help: 'Turn repeating while mouse is held down on or off' translated. self lockedString: ' Mouse-down repeating ' translated. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:02'! paneForWantsRolloverToggle ^self inARow: { self directToggleButtonFor: self getter: #targetWantsRollover setter: #toggleTargetWantsRollover help: 'Turn mouse-over highlighting on or off' translated. self lockedString: ' Mouse-over highlighting' translated. } ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:03'! rebuild | buttonColor | myTarget ensuredButtonProperties. "self targetProperties unlockAnyText." "makes styling the text easier" self removeAllMorphs. self addAColumn: { self lockedString: ('Button Properties for {1}' translated format: {myTarget name}). }. self addAColumn: { self paneForButtonTargetReport. }. self addAColumn: { self paneForButtonSelectorReport. }. self addAColumn: { (self inARow: { self paneForActsOnMouseDownToggle. self paneForActsOnMouseUpToggle. }) hResizing: #shrinkWrap. }. self addAColumn: { self inARow: { (self paneForWantsFiringWhileDownToggle) hResizing: #shrinkWrap. self paneForRepeatingInterval. }. }. self addAColumn: { (self inAColumn: { self paneForWantsRolloverToggle. }) hResizing: #shrinkWrap. }. self addARow: { self paneForMouseOverColorPicker. self paneForMouseDownColorPicker. }. self addARow: { self paneForChangeMouseEnterLook. self paneForChangeMouseDownLook. }. buttonColor _ color lighter. self addARow: { self inAColumn: { self addARow: { self buttonNamed: 'Add label' translated action: #addTextToTarget color: buttonColor help: 'add some text to the button' translated. self buttonNamed: 'Remove label' translated action: #removeTextFromTarget color: buttonColor help: 'remove text from the button' translated. }. self addARow: { self buttonNamed: 'Accept' translated action: #doAccept color: buttonColor help: 'keep changes made and close panel' translated. self buttonNamed: 'Cancel' translated action: #doCancel color: buttonColor help: 'cancel changes made and close panel' translated. self transparentSpacerOfSize: 10@3. self buttonNamed: 'Main' translated action: #doMainProperties color: color lighter help: 'open a main properties panel for the morph' translated. self buttonNamed: 'Remove' translated action: #doRemoveProperties color: color lighter help: 'remove the button properties of this morph' translated. }. }. self inAColumn: { self paneForChangeVisibleMorph }. }. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 8/31/2003 22:04'! valueForRepeatingInterval | n s | n _ self targetProperties delayBetweenFirings. s _ n ifNil: [ '*none*' ] ifNotNil: [ n < 1000 ifTrue: [n printString,' ms'] ifFalse: [(n // 1000) printString,' secs'] ]. ^'interval: ' translated, s ! ! !CategoryViewer methodsFor: 'categories' stamp: 'dgd 10/8/2003 18:50'! chooseCategory "The mouse went down on my category-list control; pop up a list of category choices" | aList aMenu reply aLinePosition lineList | aList _ scriptedPlayer categoriesForViewer: self. aLinePosition _ aList indexOf: #miscellaneous ifAbsent: [nil]. aList _ aList collect: [:aCatSymbol | self currentVocabulary categoryWordingAt: aCatSymbol]. lineList _ aLinePosition ifNil: [#()] ifNotNil: [Array with: aLinePosition]. aList isEmpty ifTrue: [aList add: #'instance variables']. aMenu _ CustomMenu labels: aList lines: lineList selections: aList. reply _ aMenu startUpWithCaption: 'category' translated. reply ifNil: [^ self]. self chooseCategoryWhoseTranslatedWordingIs: reply asSymbol ! ! !CategoryViewer methodsFor: 'entries' stamp: 'dgd 9/1/2003 13:50'! infoButtonFor: aScriptOrSlotSymbol "Answer a fully-formed morph that will serve as the 'info button' alongside an entry corresponding to the given slot or script symbol. If no such button is appropriate, answer a transparent graphic that fills the same space." | aButton | (self wantsRowMenuFor: aScriptOrSlotSymbol) ifFalse: ["Fill the space with sweet nothing, since there is no meaningful menu to offer". aButton _ RectangleMorph new beTransparent extent: (17@20). aButton borderWidth: 0. ^ aButton]. aButton _ IconicButton new labelGraphic: Cursor menu. aButton target: scriptedPlayer; actionSelector: #infoFor:inViewer:; arguments: (Array with:aScriptOrSlotSymbol with: self); color: Color transparent; borderWidth: 0; shedSelvedge; actWhen: #buttonDown. aButton setBalloonText: 'Press here to get a menu' translated. ^ aButton! ! !CategoryViewer methodsFor: 'entries' stamp: 'dgd 9/1/2003 15:01'! phraseForCommandFrom: aMethodInterface "Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles" | aRow resultType cmd names argType argTile selfTile aPhrase balloonTextSelector stat inst aDocString universal tileBearingHelp | aDocString _ aMethodInterface documentationOrNil. aDocString = 'no help available' ifTrue: [aDocString _ nil]. names _ scriptedPlayer class namedTileScriptSelectors. resultType _ aMethodInterface resultType. cmd _ aMethodInterface selector. (universal _ scriptedPlayer isUniversalTiles) ifTrue: [aPhrase _ scriptedPlayer universalTilesForInterface: aMethodInterface] ifFalse: [cmd numArgs == 0 ifTrue: [aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player] ifFalse: ["only one arg supported in classic tiles, so if this is fed with a selector with > 1 arg, results will be very strange" argType _ aMethodInterface typeForArgumentNumber: 1. aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player argType: argType. argTile _ ScriptingSystem tileForArgType: argType. argTile position: aPhrase lastSubmorph position. aPhrase lastSubmorph addMorph: argTile]]. (scriptedPlayer slotInfo includesKey: cmd) ifTrue: [balloonTextSelector _ #userSlot]. (scriptedPlayer belongsToUniClass and: [scriptedPlayer class includesSelector: cmd]) ifTrue: [aDocString ifNil: [aDocString _ (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentationOrNil]. aDocString ifNil: [balloonTextSelector _ #userScript]]. tileBearingHelp _ universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]. aDocString ifNotNil: [tileBearingHelp setBalloonText: aDocString] ifNil: [balloonTextSelector ifNil: [tileBearingHelp setProperty: #inherentSelector toValue: cmd. balloonTextSelector _ #methodComment]. tileBearingHelp balloonTextSelector: balloonTextSelector]. aPhrase markAsPartsDonor. cmd == #emptyScript ifTrue: [aPhrase setProperty: #newPermanentScript toValue: true. aPhrase setProperty: #newPermanentPlayer toValue: scriptedPlayer. aPhrase submorphs second setBalloonText: 'drag and drop to add a new script' translated]. universal ifFalse: [selfTile _ self tileForSelf. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile]. aRow _ ViewerLine newRow borderWidth: 0; color: self color. aRow elementSymbol: cmd asSymbol. aRow addMorphBack: (ScriptingSystem tryButtonFor: aPhrase). aRow addMorphBack: (Morph new extent: 2@2; beTransparent). aRow addMorphBack: (self infoButtonFor: cmd). aRow addMorphBack: aPhrase. (names includes: cmd) ifTrue: [aPhrase userScriptSelector: cmd. cmd numArgs == 0 ifTrue: [aPhrase beTransparent. aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer. aRow addMorphBack: (stat _ (inst _ scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph). inst updateStatusMorph: stat]]. aRow beSticky; disableDragNDrop. ^ aRow! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'dgd 9/1/2003 13:51'! arrowSetterButton: sel args: argArray | m | m _ RectangleMorph new color: (ScriptingSystem colorForType: #command); extent: 24@TileMorph defaultH; borderWidth: 0. m addMorphCentered: (ImageMorph new image: (ScriptingSystem formAtKey: 'Gets')). m setBalloonText: 'drag from here to obtain an assignment phrase.' translated. m on: #mouseDown send: sel to: self withValue: argArray. ^ m ! ! !CategoryViewer methodsFor: 'get/set slots' stamp: 'dgd 9/1/2003 13:51'! arrowSetterButtonFor: partName type: partType | m | m _ RectangleMorph new color: (ScriptingSystem colorForType: #command); extent: 24@TileMorph defaultH; borderWidth: 0. m addMorphCentered: (ImageMorph new image: (ScriptingSystem formAtKey: 'Gets')). m setBalloonText: 'drag from here to obtain an assignment phrase.' translated. m on: #mouseDown send: #makeSetter:event:from: to: self withValue: (Array with: partName with: partType). ^ m ! ! !CategoryViewer methodsFor: 'header pane' stamp: 'dgd 9/1/2003 15:02'! addHeaderMorph "Add the header at the top of the viewer, with a control for choosing the category, etc." | header aFont aButton | header _ AlignmentMorph newRow color: self color; wrapCentering: #center; cellPositioning: #leftCenter. aFont _ Preferences standardButtonFont. header addMorph: (aButton _ SimpleButtonMorph new label: 'O' font: aFont). aButton target: self; color: Color tan; actionSelector: #delete; setBalloonText: 'remove this pane from the screen don''t worry -- nothing will be lost!!.' translated. self maybeAddArrowsTo: header. header beSticky. self addMorph: header. self addNamePaneTo: header. chosenCategorySymbol _ #basic! ! !CategoryViewer methodsFor: 'header pane' stamp: 'dgd 9/1/2003 13:46'! addNamePaneTo: header "Add the namePane, which may be a popup or a type-in depending on the type of CategoryViewer" | aButton | namePane := RectangleMorph newSticky color: Color brown veryMuchLighter. namePane borderWidth: 0. aButton := (StringButtonMorph contents: '-----' font: Preferences standardEToysFont) color: Color black. aButton target: self; arguments: Array new; actionSelector: #chooseCategory. aButton actWhen: #buttonDown. namePane addMorph: aButton. aButton position: namePane position. namePane align: namePane topLeft with: bounds topLeft + (50 @ 0). namePane setBalloonText: 'category (click here to choose a different one)' translated. header addMorphBack: namePane. (namePane isKindOf: RectangleMorph) ifTrue: [namePane addDropShadow. namePane shadowColor: Color gray]! ! !CategoryViewer methodsFor: 'header pane' stamp: 'dgd 9/1/2003 13:47'! maybeAddArrowsTo: header "Maybe add up/down arrows to the header" | wrpr | header addTransparentSpacerOfSize: 5@5. header addUpDownArrowsFor: self. (wrpr _ header submorphs last) submorphs second setBalloonText: 'previous category' translated. wrpr submorphs first setBalloonText: 'next category' translated! ! !CodecDemoMorph methodsFor: 'menus' stamp: 'dgd 8/30/2003 21:17'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'select codec' translated action: #selectCodec. ! ! !CompoundTileMorph methodsFor: 'initialization' stamp: 'dgd 10/8/2003 18:51'! initialize "initialize the state of the receiver" | r | super initialize. "" self layoutInset: 2. self listDirection: #topToBottom. self hResizing: #spaceFill; vResizing: #shrinkWrap; cellInset: 0 @ 1; minCellSize: 200 @ 14. r _ AlignmentMorph newRow color: color; layoutInset: 0. r setProperty: #demandsBoolean toValue: true. r addMorphBack: (Morph new color: color; extent: 2 @ 5). "spacer" r addMorphBack: (StringMorph new contents: 'Test' translated). r addMorphBack: (Morph new color: color; extent: 5 @ 5). "spacer" r addMorphBack: (testPart _ BooleanScriptEditor new borderWidth: 0; layoutInset: 1). testPart color: Color transparent. testPart hResizing: #spaceFill. self addMorphBack: r. r _ AlignmentMorph newRow color: color; layoutInset: 0. r addMorphBack: (Morph new color: color; extent: 30 @ 5). "spacer" r addMorphBack: (StringMorph new contents: 'Yes' translated). r addMorphBack: (Morph new color: color; extent: 5 @ 5). "spacer" r addMorphBack: (yesPart _ ScriptEditorMorph new borderWidth: 0; layoutInset: 2). yesPart hResizing: #spaceFill. yesPart color: Color transparent. self addMorphBack: r. r _ AlignmentMorph newRow color: color; layoutInset: 0. r addMorphBack: (Morph new color: color; extent: 35 @ 5). "spacer" r addMorphBack: (StringMorph new contents: 'No' translated). r addMorphBack: (Morph new color: color; extent: 5 @ 5). "spacer" r addMorphBack: (noPart _ ScriptEditorMorph new borderWidth: 0; layoutInset: 2). noPart hResizing: #spaceFill. noPart color: Color transparent. self addMorphBack: r. self bounds: self fullBounds! ! !DoubleClickExample methodsFor: 'accessing' stamp: 'dgd 8/31/2003 18:37'! balloonText ^ 'Double-click on me to change my color; single-click on me to change border color; hold mouse down within me to grow (if I''m red) or shrink (if I''m blue).' translated! ! !EToyProjectHistoryMorph methodsFor: 'as yet unclassified' stamp: 'dgd 9/20/2003 18:52'! rebuild | history r1 | history _ ProjectHistory currentHistory mostRecentCopy. changeCounter _ ProjectHistory changeCounter. self removeAllMorphs. self rubberBandCells: false. "enable growing" r1 _ self addARow: { self inAColumn: { StringMorph new contents: 'Jump...' translated; lock. }. }. r1 on: #mouseUp send: #jumpToProject to: self. history do: [ :each | ( self addARow: { (self inAColumn: { StretchyImageMorph new form: each second; minWidth: 35; minHeight: 35; lock }) vResizing: #spaceFill. self inAColumn: { StringMorph new contents: each first; lock. "StringMorph new contents: each third; lock." }. } ) color: Color paleYellow; borderWidth: 1; borderColor: #raised; vResizing: #spaceFill; on: #mouseUp send: #mouseUp:in: to: self; on: #mouseDown send: #mouseDown:in: to: self; on: #mouseMove send: #mouseMove:in: to: self; on: #mouseLeave send: #mouseLeave:in: to: self; setProperty: #projectParametersTuple toValue: each; setBalloonText: (each third isEmptyOrNil ifTrue: ['not saved'] ifFalse: [each third]) ]. "--- newTuple _ { aProject name. aProject thumbnail. aProject url. WeakArray with: aProject. }. ---"! ! !EToyProjectRenamerMorph methodsFor: 'as yet unclassified' stamp: 'jm 9/2/2003 19:39'! buttonNamed: aString action: aSymbol color: aColor help: helpString | f col | f _ SimpleButtonMorph new target: self; label: aString translated font: self myFont; color: aColor; actionSelector: aSymbol; setBalloonText: helpString translated. col _ (self inAColumn: {f}) hResizing: #spaceFill. ^col! ! !EToyProjectRenamerMorph methodsFor: 'as yet unclassified' stamp: 'dgd 10/8/2003 18:53'! validateTheProjectName | proposed | proposed _ (namedFields at: 'projectname') contents string withBlanksTrimmed. proposed isEmpty ifTrue: [ self inform: 'I do need a name for the project' translated. ^false ]. proposed size > 24 ifTrue: [ self inform: 'Please make the name 24 characters or less' translated. ^false ]. (Project isBadNameForStoring: proposed) ifTrue: [ self inform: 'Please remove any funny characters from the name' translated. ^false ]. proposed = theProject name ifTrue: [^true]. (ChangeSorter changeSetNamed: proposed) ifNotNil: [ Utilities inform: 'Sorry that name is already used' translated. ^false ]. ^true! ! !EToyProjectDetailsMorph methodsFor: 'as yet unclassified' stamp: 'jm 9/2/2003 19:39'! rebuild | bottomButtons | self removeAllMorphs. self addARow: { self lockedString: 'Please describe this project' translated. }. self addARow: { self lockedString: 'Name:' translated. self inAColumnForText: {self fieldForProjectName} }. self expandedFormat ifTrue: [ self fieldToDetailsMappings do: [ :each | self addARow: { self lockedString: each third translated. self inAColumnForText: {(self genericTextFieldNamed: each first) height: each fourth} }. ]. ]. bottomButtons _ self expandedFormat ifTrue: [ { self okButton. self cancelButton. } ] ifFalse: [ { self okButton. self expandButton. self cancelButton. } ]. self addARow: bottomButtons. self fillInDetails.! ! !EnvelopeEditorMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:19'! addCustomMenuItems: menu hand: aHandMorph super addCustomMenuItems: menu hand: aHandMorph. menu addLine. envelope updateSelector = #ratio: ifTrue: [menu add: 'choose denominator...' translated action: #chooseDenominator:]. menu add: 'adjust scale...' translated action: #adjustScale:. SoundPlayer isReverbOn ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb] ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb]. menu addLine. menu add: 'get sound from lib' translated action: #chooseSound:. menu add: 'put sound in lib' translated action: #saveSound:. menu add: 'read sound from disk...' translated action: #readFromDisk:. menu add: 'save sound on disk...' translated action: #saveToDisk:. menu add: 'save library on disk...' translated action: #saveLibToDisk:. ! ! !EtoyLoginMorph methodsFor: 'actions' stamp: 'dgd 10/8/2003 18:58'! doOK | proposed | proposed _ theNameMorph contents string. proposed isEmpty ifTrue: [^self inform: 'Please enter your login name' translated]. proposed size > 24 ifTrue: [^self inform: 'Please make the name 24 characters or less' translated]. (Project isBadNameForStoring: proposed) ifTrue: [ ^self inform: 'Please remove any funny characters' translated ]. (actionBlock value: proposed) ifTrue:[self delete].! ! !EventRecorderMorph methodsFor: 'commands' stamp: 'dgd 9/21/2003 17:54'! shrink "Shorten the tape by deleting mouseMove events that can just as well be interpolated later at playback time." | oldSize priorSize | self writeCheck. oldSize _ priorSize _ tape size. [self condense. tape size < priorSize] whileTrue: [priorSize _ tape size]. self inform: ('{1} events reduced to {2}' translated format:{oldSize. tape size}). voiceRecorder ifNotNil: [voiceRecorder suppressSilence]. saved _ false. ! ! !EventRecorderMorph methodsFor: 'initialization' stamp: 'dgd 8/30/2003 21:19'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'add voice controls' translated action: #addVoiceControls. aCustomMenu add: 'add journal file' translated action: #addJournalFile. ! ! !FillInTheBlankMorph methodsFor: 'initialization' stamp: 'sd 11/13/2003 21:07'! createAcceptButton "create the [accept] button" | result frame | result := SimpleButtonMorph new target: self; color: Color lightGreen. result borderColor: (Preferences menuAppearance3d ifTrue: [#raised] ifFalse: [result color twiceDarker]). result label: 'Accept(s)' translated; actionSelector: #accept. result setNameTo: 'accept'. frame := LayoutFrame new. frame rightFraction: 0.5; rightOffset: -10; bottomFraction: 1.0; bottomOffset: -2. result layoutFrame: frame. self addMorph: result. self updateColor: result color: result color intensity: 2. ^ result! ! !FillInTheBlankMorph methodsFor: 'initialization' stamp: 'sd 11/13/2003 21:07'! createCancelButton "create the [cancel] button" | result frame | result := SimpleButtonMorph new target: self; color: Color lightRed. result borderColor: (Preferences menuAppearance3d ifTrue: [#raised] ifFalse: [result color twiceDarker]). result label: 'Cancel(l)' translated; actionSelector: #cancel. result setNameTo: 'cancel'. frame := LayoutFrame new. frame leftFraction: 0.5; leftOffset: 10; bottomFraction: 1.0; bottomOffset: -2. result layoutFrame: frame. self addMorph: result. self updateColor: result color: result color intensity: 2. ^ result! ! !FlashMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:42'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addUpdating: #getSmoothingLevel action: #nextSmoothingLevel. aCustomMenu add:'show compressed size' translated action: #showCompressedSize.! ! !FlashMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:42'! getSmoothingLevel "Menu support" | aaLevel | aaLevel := self defaultAALevel ifNil: [1]. aaLevel = 1 ifTrue: [^ 'turn on smoothing' translated]. aaLevel = 2 ifTrue: [^ 'more smoothing' translated]. aaLevel = 4 ifTrue: [^ 'turn off smoothing' translated]! ! !FlashCharacterMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:41'! addCustomMenuItems: aMenu hand: aHand super addCustomMenuItems: aMenu hand: aHand. aMenu add:'add project target' translated action: #addProjectTarget. aMenu add:'remove project target' translated action: #removeProjectTarget.! ! !FlashButtonMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:41'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine. aCustomMenu add: 'set custom action' translated action: #addCustomAction. aCustomMenu add: 'remove all actions' translated action: #removeActions. ! ! !FlashPlayerMorph methodsFor: 'initialize' stamp: 'dgd 9/20/2003 16:42'! openInMVC | window extent | self localBounds: localBounds. extent _ bounds extent. window _ FlashPlayerWindow labelled:'Flash Player' translated. window model: (FlashPlayerModel player: self). window addMorph: self frame:(0@0 corner: 1@1). window openInMVCExtent: extent! ! !FlashPlayerMorph methodsFor: 'initialize' stamp: 'dgd 9/20/2003 16:42'! openInWorld | window extent | self localBounds: localBounds. extent _ bounds extent. window _ FlashPlayerWindow labelled:'Flash Player' translated. window model: (FlashPlayerModel player: self). window addMorph: self frame:(0@0 corner: 1@1). window openInWorldExtent: extent! ! !FlashPlayerMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:42'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'open sorter' translated action: #openSorter. aCustomMenu add: 'make controls' translated action: #makeControls. aCustomMenu addLine.! ! !GradientFillMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:45'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'gradient color' translated action: #setGradientColor:. gradientDirection == #vertical ifTrue: [aCustomMenu add: 'horizontal pan' translated action: #beHorizontal] ifFalse: [aCustomMenu add: 'vertical pan' translated action: #beVertical]. ! ! !GraphMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:45'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'open wave editor' translated action: #openWaveEditor. aCustomMenu add: 'read file' translated action: #readDataFromFile. ! ! !HaloMorph methodsFor: 'private' stamp: 'dgd 8/28/2003 15:15'! addGraphicalHandle: formKey at: aPoint on: eventName send: selector to: recipient "Add the supplied form as a graphical handle centered at the given point, and set it up to respond to the given event by sending the given selector to the given recipient. Return the handle." | handle | handle _ self addGraphicalHandleFrom: formKey at: aPoint. handle on: eventName send: selector to: recipient. handle setBalloonText: (target balloonHelpTextForHandle: handle) translated. ^ handle ! ! !HaloMorph methodsFor: 'private' stamp: 'dgd 8/28/2003 15:15'! addHandle: handleSpec on: eventName send: selector to: recipient "Add a handle within the halo box as per the haloSpec, and set it up to respond to the given event by sending the given selector to the given recipient. Return the handle." | handle aPoint iconName colorToUse | aPoint _ self positionIn: haloBox horizontalPlacement: handleSpec horizontalPlacement verticalPlacement: handleSpec verticalPlacement. handle _ EllipseMorph newBounds: (Rectangle center: aPoint extent: HandleSize asPoint) color: (colorToUse _ Color colorFrom: handleSpec color). self addMorph: handle. (iconName _ handleSpec iconSymbol) ifNotNil: [ | form | form _ ScriptingSystem formAtKey: iconName. form ifNotNil: [handle addMorphCentered: (ImageMorph new image: form; color: colorToUse makeForegroundColor; lock)]]. handle on: #mouseUp send: #endInteraction to: self. handle on: eventName send: selector to: recipient. self isMagicHalo ifTrue:[ handle on: #mouseEnter send: #handleEntered to: self. handle on: #mouseLeave send: #handleLeft to: self]. handle setBalloonText: (target balloonHelpTextForHandle: handle) translated. ^ handle ! ! !HaloMorph methodsFor: 'private' stamp: 'dgd 8/28/2003 15:15'! addHandleAt: aPoint color: aColor icon: iconName on: eventName send: selector to: recipient "Add a handle centered at the given point with the given color, and set it up to respond to the given event by sending the given selector to the given recipient. Return the handle." | handle | handle _ EllipseMorph newBounds: (Rectangle center: aPoint extent: self handleSize asPoint) color: aColor. self addMorph: handle. iconName ifNotNil: [ | form | form _ ScriptingSystem formAtKey: iconName. form ifNotNil: [handle addMorphCentered: (ImageMorph new image: form; color: aColor makeForegroundColor; lock)]]. handle on: #mouseUp send: #endInteraction to: self. handle on: eventName send: selector to: recipient. handle setBalloonText: (target balloonHelpTextForHandle: handle) translated. ^ handle ! ! !HaloMorph methodsFor: 'private' stamp: 'dgd 9/5/2003 18:32'! maybeDismiss: evt with: dismissHandle "Ask hand to dismiss my target if mouse comes up in it." evt hand obtainHalo: self. (dismissHandle containsPoint: evt cursorPoint) ifFalse: [self delete. target addHalo: evt] ifTrue: [target resistsRemoval ifTrue: [(PopUpMenu confirm: 'Really throw this away' translated trueChoice: 'Yes' translated falseChoice: 'Um, no, let me reconsider' translated) ifFalse: [^ self]]. Preferences preserveTrash ifTrue: [Preferences soundsEnabled ifTrue: [TrashCanMorph playDeleteSound]. self stopStepping. super delete. target slideToTrash: evt] ifFalse: [self delete. target dismissViaHalo]]! ! !HaloMorph methodsFor: 'private' stamp: 'dgd 10/8/2003 19:07'! startGrow: evt with: growHandle "Initialize resizing of my target. Launch a command representing it, to support Undo" | botRt | self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle. botRt _ target point: target bottomRight in: owner. positionOffset _ (self world viewBox containsPoint: botRt) ifTrue: [evt cursorPoint - botRt] ifFalse: [0@0]. self setProperty: #commandInProgress toValue: (Command new cmdWording: 'resizing' translated; undoTarget: target selector: #setExtentFromHalo: argument: target extent)! ! !HaloMorph methodsFor: 'private' stamp: 'dgd 8/26/2003 21:44'! startRot: evt with: rotHandle "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action" self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle. target isFlexMorph ifFalse: [target isInWorld ifFalse: [self setTarget: target player costume]. target addFlexShellIfNecessary]. growingOrRotating _ true. self removeAllHandlesBut: rotHandle. "remove all other handles" angleOffset _ evt cursorPoint - (target pointInWorld: target referencePosition). angleOffset _ Point r: angleOffset r degrees: angleOffset degrees - target rotationDegrees. self setProperty: #commandInProgress toValue: (Command new cmdWording: 'rotating' translated; undoTarget: target selector: #rotationDegrees: argument: target rotationDegrees) ! ! !ImageMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:46'! opacityString ^ (self isOpaque ifTrue: [''] ifFalse: ['']), 'opaque' translated! ! !MIDIControllerMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:50'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'set channel' translated action: #setChannel:. aCustomMenu add: 'set controller' translated action: #setController:. ! ! !MIDIPianoKeyboardMorph methodsFor: 'menus' stamp: 'dgd 8/30/2003 21:50'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. midiPort ifNil: [aCustomMenu add: 'play via MIDI' translated action: #openMIDIPort] ifNotNil: [ aCustomMenu add: 'play via built in synth' translated action: #closeMIDIPort. aCustomMenu add: 'new MIDI controller' translated action: #makeMIDIController:]. ! ! !MPEGDisplayMorph methodsFor: 'commands' stamp: 'dgd 10/8/2003 19:10'! setFrameRate "Ask the user to specify the desired frame rate." | rateString | rateString := FillInTheBlank request: 'Desired frames per second?' translated initialAnswer: desiredFrameRate printString. rateString isEmpty ifTrue: [^self]. desiredFrameRate := rateString asNumber asFloat. desiredFrameRate := desiredFrameRate max: 0.1! ! !MPEGDisplayMorph methodsFor: 'menu' stamp: 'dgd 9/19/2003 12:17'! invokeMenu "Invoke a menu of additonal functions." | aMenu | aMenu _ CustomMenu new. repeat ifTrue: [aMenu add: 'turn off repeat (now on)' translated action: #toggleRepeat] ifFalse: [aMenu add: 'turn on repeat (now off)' translated action: #toggleRepeat]. aMenu addList: { #-. {'set frame rate' translated. #setFrameRate}. #-. {'create JPEG movie from MPEG' translated. #createJPEGfromMPEG}. {'create JPEG movie from SqueakMovie' translated. #createJPEGfromSqueakMovie}. {'create JPEG movie from folder of frames' translated. #createJPEGfromFolderOfFrames}. #-}. (mpegFile isKindOf: JPEGMovieFile) ifTrue: [ mpegFile hasAudio ifTrue: [aMenu add: 'remove all soundtracks' translated action: #removeAllSoundtracks] ifFalse: [aMenu add: 'add soundtrack' translated action: #addSoundtrack]]. aMenu invokeOn: self defaultSelection: nil. ! ! !MPEGMoviePlayerMorph methodsFor: 'menu' stamp: 'dgd 9/19/2003 12:14'! invokeMenu "Invoke a menu of additonal functions." | aMenu | aMenu _ CustomMenu new. aMenu addList: { {'set frame rate' translated. #setFrameRate}. {'convert MPEG to JPEG movie' translated. #showFFTAtCursor}}. aMenu invokeOn: moviePlayer defaultSelection: nil. ! ! !MPEGMoviePlayerMorph methodsFor: 'private' stamp: 'dgd 9/19/2003 12:12'! addButtonRow | r | r _ AlignmentMorph newRow vResizing: #shrinkWrap; color: Color transparent. r addMorphBack: (self buttonName: 'Open' translated action: #openMPEGFile). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Menu' translated action: #invokeMenu). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Rewind' translated action: #rewindMovie). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Play' translated action: #startPlaying). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: 'Stop' translated action: #stopPlaying). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: '<' action: #previousFrame). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). r addMorphBack: (self buttonName: '>' action: #nextFrame). r addMorphBack: (Morph new extent: 4@1; color: Color transparent). self addMorphBack: r. ! ! !MPEGMoviePlayerMorph methodsFor: 'private' stamp: 'dgd 9/19/2003 12:19'! addPositionSlider | r | positionSlider _ SimpleSliderMorph new color: (Color r: 0.71 g: 0.871 b: 1.0); extent: 200@2; target: moviePlayer; actionSelector: #moviePosition:; adjustToValue: 0. r _ AlignmentMorph newRow color: Color transparent; layoutInset: 0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #rigid; height: 24. r addMorphBack: (StringMorph contents: 'start ' translated). r addMorphBack: positionSlider. r addMorphBack: (StringMorph contents: ' end' translated). self addMorphBack: r. ! ! !MPEGMoviePlayerMorph methodsFor: 'private' stamp: 'dgd 9/19/2003 12:19'! addQuitButton self submorphs second addMorphFront: (Morph new extent: 4@1; color: Color transparent); addMorphFront: ( SimpleButtonMorph new target: self; label: 'Quit' translated; actionSelector: #quit; color: (Color gray: 0.8); "old color" fillStyle: self buttonFillStyle; borderWidth: 0; borderColor: #raised) ! ! !MPEGMoviePlayerMorph methodsFor: 'private' stamp: 'dgd 9/19/2003 12:19'! addVolumeSlider | levelSlider r | levelSlider _ SimpleSliderMorph new color: (Color r: 0.71 g: 0.871 b: 1.0); extent: 200@2; target: moviePlayer; actionSelector: #volume:; adjustToValue: 0.5. r _ AlignmentMorph newRow color: Color transparent; layoutInset: 0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #rigid; height: 24. r addMorphBack: (StringMorph contents: ' soft ' translated). r addMorphBack: levelSlider. r addMorphBack: (StringMorph contents: ' loud' translated). self addMorphBack: r. ! ! !MagnifierMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:50'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine; add: 'magnification...' translated action: #chooseMagnification; addUpdating: #trackingPointerString action: #toggleTrackingPointer; addUpdating: #toggleRoundString action: #toggleRoundness.! ! !MagnifierMorph methodsFor: 'menu' stamp: 'dgd 10/8/2003 19:13'! chooseMagnification | result | result _ (SelectionMenu selections: #(1.5 2 4 8)) startUpWithCaption: ('Choose magnification (currently {1})' translated format:{magnification}). (result isNil or: [result = magnification]) ifTrue: [^ self]. magnification _ result. self extent: self extent. "round to new magnification" self changed. "redraw even if extent wasn't changed".! ! !MagnifierMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:51'! trackingPointerString ^ (trackPointer ifTrue: ['stop tracking pointer'] ifFalse: ['start tracking pointer']) translated! ! !MagnifierMorph methodsFor: 'round view' stamp: 'dgd 8/30/2003 21:51'! toggleRoundString ^ (self isRound ifTrue: ['be square'] ifFalse: ['be round']) translated! ! !FishEyeMorph methodsFor: 'menus' stamp: 'dgd 9/21/2003 17:55'! chooseMagnification self inform: 'Magnification is fixed, sorry.' translated! ! !MenuMorph methodsFor: 'accessing' stamp: 'dgd 8/30/2003 20:44'! allWordings "Answer a collection of the wordings of all items and subitems, omitting the window-list in the embed... branch and (unless a certain hard-coded preference is set) also omitting items from the debug menu" | verboten | verboten _ OrderedCollection with: 'embed into'. Preferences debugMenuItemsInvokableFromScripts ifFalse: [verboten add: 'debug...' translated]. ^ self allWordingsNotInSubMenus: verboten! ! !MenuMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:52'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine. aCustomMenu add: 'add title...' translated action: #addTitle. aCustomMenu add: 'set target...' translated action: #setTarget:. defaultTarget ifNotNil: [ aCustomMenu add: 'add item...' translated action: #addItem]. aCustomMenu add: 'add line' translated action: #addLine. (self items count:[:any| any hasSubMenu]) > 0 ifTrue:[aCustomMenu add: 'detach submenu' translated action: #detachSubMenu:].! ! !MidiInputMorph methodsFor: 'as yet unclassified' stamp: 'dgd 9/19/2003 13:33'! invokeMenu "Invoke a menu of additonal commands." | aMenu | aMenu _ CustomMenu new. aMenu add: 'add channel' translated action: #addChannel. aMenu add: 'reload instruments' translated target: AbstractSound selector: #updateScorePlayers. midiSynth isOn ifFalse: [ aMenu add: 'set MIDI port' translated action: #setMIDIPort. midiSynth midiPort ifNotNil: [aMenu add: 'close MIDI port' translated action: #closeMIDIPort]]. aMenu invokeOn: self defaultSelection: nil. ! ! !MonthMorph methodsFor: 'controls' stamp: 'dgd 8/30/2003 21:53'! startMondayOrSundayString ^ (Week startMonday ifTrue: ['start Sunday'] ifFalse: ['start Monday']) translated! ! !MonthMorph methodsFor: 'all' stamp: 'dgd 8/30/2003 21:53'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine; addUpdating: #startMondayOrSundayString action: #toggleStartMonday; add: 'jump to year...' translated action: #chooseYear.! ! !MorphicModel methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:53'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. model ifNotNil: [model addModelMenuItemsTo: aCustomMenu forMorph: self hand: aHandMorph]. self isOpen ifTrue: [aCustomMenu add: 'close editing' translated action: #closeToEdits] ifFalse: [aCustomMenu add: 'open editing' translated action: #openToEdits]. ! ! !MovieMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 21:55'! addCustomMenuItems: aCustomMenu hand: aHandMorph | movies subMenu | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine. subMenu _ MenuMorph new defaultTarget: self. frameList size > 1 ifTrue: [ subMenu add: 'repaint' translated action: #editDrawing. subMenu add: 'set rotation center' translated action: #setRotationCenter. subMenu add: 'play once' translated action: #playOnce. subMenu add: 'play loop' translated action: #playLoop. subMenu add: 'stop playing' translated action: #stopPlaying. currentFrameIndex > 1 ifTrue: [ subMenu add: 'previous frame' translated action: #previousFrame]. currentFrameIndex < frameList size ifTrue: [ subMenu add: 'next frame' translated action: #nextFrame]]. subMenu add: 'extract this frame' translated action: #extractFrame:. movies _ (self world rootMorphsAt: aHandMorph targetOffset) select: [:m | (m isKindOf: MovieMorph) or: [m isKindOf: SketchMorph]]. (movies size > 1) ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aCustomMenu add: 'movie...' translated subMenu: subMenu ! ! !MoviePlayerMorph methodsFor: 'menu' stamp: 'dgd 10/8/2003 19:32'! invokeBookMenu "Invoke the book's control panel menu." | aMenu | aMenu _ MVCMenuMorph new defaultTarget: self. aMenu add: 'make a new movie' translated action: #makeAMovie. aMenu add: 'open movie file' translated action: #openMovieFile. aMenu add: 'add sound track' translated action: #addSoundTrack. aMenu addLine. scorePlayer ifNotNil: [soundTrackForm isNil ifTrue: [aMenu add: 'show sound track' translated action: #showHideSoundTrack] ifFalse: [aMenu add: 'hide sound track' translated action: #showHideSoundTrack]]. aMenu add: 'make thumbnail' translated action: #thumbnailForThisPage. cueMorph ifNotNil: ["Should check if piano roll and score already have a start event prior to this time." aMenu add: 'end clip here' translated action: #endClipHere]. aMenu popUpEvent: self world activeHand lastEvent in: self world ! ! !NumberType methodsFor: 'tiles' stamp: 'dgd 9/6/2003 20:30'! addExtraItemsToMenu: aMenu forSlotSymbol: slotSym "If the receiver has extra menu items to add to the slot menu, here is its chance to do it. The defaultTarget of the menu is the player concerned." aMenu add: 'decimal places...' translated selector: #setPrecisionFor: argument: slotSym. aMenu balloonTextForLastItem: 'Lets you choose how many decimal places should be shown in readouts for this variable' translated! ! !NumberType methodsFor: 'tiles' stamp: 'dgd 9/6/2003 20:29'! addWatcherItemsToMenu: aMenu forGetter: aGetter "Add watcher items to the menu if appropriate, provided the getter is not an odd-ball one for which a watcher makes no sense" super addWatcherItemsToMenu: aMenu forGetter: aGetter. aMenu add: 'detailed watcher' translated selector: #tearOffFancyWatcherFor: argument: aGetter! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 10/8/2003 19:35'! rebuild self removeAllMorphs. self addARow: { self lockedString: ('Properties for {1}' translated format: {myTarget name}). }. self addARow: { self inAColumn: { self paneForCornerRoundingToggle. self paneForStickinessToggle. self paneForLockedToggle. }. }. self addARow: { self paneForMainColorPicker. self paneFor2ndGradientColorPicker. }. self addARow: { self paneForBorderColorPicker. self paneForShadowColorPicker. }. self addARow: { self buttonNamed: 'Accept' translated action: #doAccept color: color lighter help: 'keep changes made and close panel' translated. self buttonNamed: 'Cancel' translated action: #doCancel color: color lighter help: 'cancel changes made and close panel' translated. }, self rebuildOptionalButtons. thingsToRevert _ Dictionary new. "thingsToRevert at: #fillStyle: put: myTarget fillStyle." myTarget isSystemWindow ifTrue: [ thingsToRevert at: #setWindowColor: put: myTarget paneColorToUse ]. thingsToRevert at: #hasDropShadow: put: myTarget hasDropShadow. thingsToRevert at: #shadowColor: put: myTarget shadowColor. (myTarget respondsTo: #borderColor:) ifTrue: [ thingsToRevert at: #borderColor: put: myTarget borderColor. ]. thingsToRevert at: #borderWidth: put: myTarget borderWidth. thingsToRevert at: #cornerStyle: put: myTarget cornerStyle. thingsToRevert at: #sticky: put: myTarget isSticky. thingsToRevert at: #lock: put: myTarget isLocked. ! ! !ObjectPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'dgd 10/8/2003 19:37'! rebuildOptionalButtons | answer | answer _ { self transparentSpacerOfSize: 20@3. self buttonNamed: 'Button' translated action: #doButtonProperties color: color lighter help: 'open a button properties panel for the morph' translated. }. myTarget isTextMorph ifTrue: [ answer _ answer, { self buttonNamed: 'Text' translated action: #doTextProperties color: color lighter help: 'open a text properties panel for the morph' translated. }. ]. ^answer! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'sd 11/13/2003 21:03'! borderPrototype: aBorderStyle help: helpString | selector proto | selector _ BorderedMorph new. selector borderWidth: 0. selector color: Color transparent. proto _ Morph new extent: 16@16. proto color: Color transparent. proto borderStyle: aBorderStyle. selector extent: proto extent + 4. selector addMorphCentered: proto. (myTarget canDrawBorder: aBorderStyle) ifTrue:[ selector setBalloonText: helpString. selector on: #mouseDown send: #toggleBorderStyle:with:from: to: self withValue: proto. (myTarget borderStyle species == aBorderStyle species and:[ myTarget borderStyle style == aBorderStyle style]) ifTrue:[selector borderWidth: 1]. ] ifFalse:[ selector setBalloonText: 'This border style cannot be used here' translated. selector on: #mouseDown send: #beep to: Beeper. selector addMorphCentered: ((Morph new) color: (Color black alpha: 0.5); extent: selector extent). ]. ^selector! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:21'! paneFor2ndGradientColorPicker ^self inAColumn: { (self inAColumn: { self colorPickerFor: self getter: #tgt2ndGradientColor setter: #tgt2ndGradientColor:. self lockedString: '2nd gradient color' translated. self paneForRadialGradientToggle hResizing: #shrinkWrap. ( self inARow: {self paneForGradientOrigin. self paneForGradientDirection} ) hResizing: #shrinkWrap. } named: #pickerFor2ndGradientColor) layoutInset: 0. self paneForGradientFillToggle hResizing: #shrinkWrap } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:23'! paneForBorderColorPicker ^self inAColumn: { self colorPickerFor: self getter: #targetBorderColor setter: #targetBorderColor:. self lockedString: 'Border Color' translated. (self paneForBorderStyle) hResizing: #shrinkWrap; layoutInset: 5. self lockedString: 'Border style' translated. self paneForBorderWidth. } named: #pickerForBorderColor. ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:25'! paneForBorderStyle ^self inARow: { self borderPrototype: (BorderStyle width: 4 color: Color black) help:'Click to select a simple colored border' translated. self borderPrototype: (BorderStyle raised width: 4) help:'Click to select a simple raised border' translated. self borderPrototype: (BorderStyle inset width: 4) help:'Click to select a simple inset border' translated. self borderPrototype: (BorderStyle complexFramed width: 4) help:'Click to select a complex framed border' translated. self borderPrototype: (BorderStyle complexRaised width: 4) help:'Click to select a complex raised border' translated. self borderPrototype: (BorderStyle complexInset width: 4) help:'Click to select a complex inset border' translated. self borderPrototype: (BorderStyle complexAltFramed width: 4) help:'Click to select a complex framed border' translated. self borderPrototype: (BorderStyle complexAltRaised width: 4) help:'Click to select a complex raised border' translated. self borderPrototype: (BorderStyle complexAltInset width: 4) help:'Click to select a complex inset border' translated. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:29'! paneForBorderWidth ^(self inARow: { self buildFakeSlider: 'Border width' translated selector: #adjustTargetBorderWidth: help: 'Drag in here to change the border width' translated }) hResizing: #shrinkWrap ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:18'! paneForCornerRoundingToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #wantsRoundedCorners setter: #toggleCornerRounding help: 'Turn rounded corners on or off' translated. self lockedString: ' Rounded corners' translated. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:40'! paneForDropShadowToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #hasDropShadow setter: #toggleDropShadow help: 'Turn drop shadows on or off' translated. self lockedString: ' Drop shadow color' translated. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:22'! paneForGradientDirection ^(self inARow: { self buildFakeSlider: 'Direction' translated selector: #adjustTargetGradientDirection: help: 'Drag in here to change the direction of the gradient' translated }) hResizing: #shrinkWrap ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:22'! paneForGradientFillToggle ^self inARow: { self directToggleButtonFor: self getter: #targetHasGradientFill setter: #toggleTargetGradientFill help: 'Turn gradient fill on or off' translated. self lockedString: ' Gradient fill' translated. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:21'! paneForGradientOrigin ^(self inARow: { self buildFakeSlider: 'Origin' translated selector: #adjustTargetGradientOrigin: help: 'Drag in here to change the origin of the gradient' translated }) hResizing: #shrinkWrap ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:19'! paneForLockedToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #isLocked setter: #toggleLocked help: 'Turn lock on or off' translated. self lockedString: ' Lock' translated. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:20'! paneForMainColorPicker ^self inAColumn: { self colorPickerFor: self getter: #numberOneColor setter: #numberOneColor:. self lockedString: 'Color' translated. (self paneForSolidFillToggle) hResizing: #shrinkWrap. } named: #pickerForColor. ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:21'! paneForRadialGradientToggle ^self inARow: { self directToggleButtonFor: self getter: #targetRadial setter: #toggleTargetRadial help: 'Turn radial gradient on or off' translated. self lockedString: ' Radial gradient' translated. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:36'! paneForShadowOffset ^(self inARow: { self buildFakeSlider: 'Offset' translated selector: #adjustTargetShadowOffset: help: 'Drag in here to change the offset of the shadow' translated }) hResizing: #shrinkWrap ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:20'! paneForSolidFillToggle ^self inARow: { self directToggleButtonFor: self getter: #targetHasSolidFill setter: #toggleTargetSolidFill help: 'Turn solid fill on or off' translated. self lockedString: ' Solid fill' translated. } ! ! !ObjectPropertiesMorph methodsFor: 'panes' stamp: 'dgd 8/31/2003 21:18'! paneForStickinessToggle ^self inARow: { self directToggleButtonFor: myTarget getter: #isSticky setter: #toggleStickiness help: 'Turn stickiness on or off' translated. self lockedString: ' Sticky' translated. } ! ! !ObjectsTool methodsFor: 'initialization' stamp: 'dgd 8/30/2003 16:10'! initializeForFlap "Initialize the receiver to operate in a flap at the top of the screen. This worked in the past, but is not currently in the released UI and is not likely to work without some fixup." | aPane aBin | self borderWidth: 2; borderColor: Color darkGray. self layoutInset: 0. self hResizing: #shrinkWrap; vResizing: #rigid. self listDirection: #topToBottom. self listCentering: #topLeft. self cellPositioning: #topLeft. self wrapCentering: #center. aPane _ self paneForTabs: self modeTabs. aPane color: aPane color darker. aPane listSpacing: #equal. aPane cellInset: 10 @ 10. aPane listCentering: #center; height: 38. aPane wrapDirection: nil. self addMorphFront: aPane. self addMorphBack: Morph new. "Place holder for a tabs or text pane" aBin _ PartsBin newPartsBinWithOrientation: #leftToRight from: #(). aBin listDirection: #leftToRight. aBin wrapDirection: #topToBottom. aBin hResizing: #spaceFill; vResizing: #spaceFill. aBin extent: (self currentWorld width) @ 250. aBin color: Color orange muchLighter. aBin setNameTo: 'Objects' translated. aBin dropEnabled: false. self addMorphBack: aBin ! ! !ObjectsTool methodsFor: 'initialization' stamp: 'dgd 8/30/2003 16:09'! initializeToStandAlone "Initialize the receiver so that it can live as a stand-alone morph" | aPane aBin aColor | self basicInitialize. self layoutInset: 6. self listCentering: #topLeft. self cellPositioning: #topLeft. self wrapCentering: #center. self useRoundedCorners. self listDirection: #topToBottom. self hResizing: #shrinkWrap; vResizing: #shrinkWrap. aPane _ self paneForTabs: self modeTabs. aPane addMorphFront: self dismissButton. aPane addMorphBack: self helpButton. aPane color: (aColor _ aPane color) darker. aPane listSpacing: #equal. aPane cellInset: 10 @ 10. aPane listCentering: #center; height: 38. aPane wrapDirection: nil. self addMorphFront: aPane. self addMorphBack: Morph new. "Place holder for a tabs or text pane" aBin _ PartsBin newPartsBinWithOrientation: #leftToRight from: #(). aBin listDirection: #leftToRight. aBin wrapDirection: #topToBottom. aBin hResizing: #spaceFill; vResizing: #spaceFill. aBin extent: (self currentWorld width) @ 250. aBin color: aColor lighter lighter. aBin setNameTo: 'parts'. aBin dropEnabled: false. self addMorphBack: aBin. self submorphs last width: 350; hResizing: #rigid. self color: (Color r: 0.0 g: 0.839 b: 0.226). self setProperty: #initialWidth toValue: 268. self setNameTo: 'Objects' translated. self showCategories. ! ! !ObjectsTool methodsFor: 'major modes' stamp: 'dgd 8/30/2003 16:11'! modeTabs "Answer a list of buttons which, when hit, will trigger the choice of mode of the receiver" | buttonList aButton tupleList | tupleList _ #( ('alphabetic' alphabetic showAlphabeticTabs 'A separate tab for each letter of the alphabet') ('find' search showSearchPane 'Provides a type-in pane allowing you to match') ('categories' categories showCategories 'Grouped by category') "('standard' standard showStandardPane 'Standard Squeak tools supplies for building')" ). buttonList _ tupleList collect: [:tuple | aButton _ SimpleButtonMorph new label: tuple first translated. aButton actWhen: #buttonUp. aButton setProperty: #modeSymbol toValue: tuple second. aButton target: self; actionSelector: tuple third. aButton setBalloonText: tuple fourth translated. aButton]. ^ buttonList "ObjectsTool new modeTabs"! ! !ObjectsTool methodsFor: 'menu' stamp: 'dgd 8/30/2003 16:22'! addCustomMenuItems: aMenu hand: aHand "Add items to the given halo-menu, given a hand" super addCustomMenuItems: aMenu hand: aHand. aMenu addLine. aMenu add: 'alphabetic' translated target: self selector: #showAlphabeticTabs. aMenu add: 'find' translated target: self selector: #showSearchPane. aMenu add: 'categories' translated target: self selector: #showCategories. aMenu addLine. aMenu add: 'reset thumbnails' translated target: self selector: #resetThumbnails.! ! !ObjectsTool methodsFor: 'search' stamp: 'dgd 8/30/2003 16:25'! newSearchPane "Answer a type-in pane for searches" | aTextMorph aBox | aTextMorph _ TextMorph new. aTextMorph setProperty: #defaultContents toValue: '' asText allBold. aTextMorph on: #keyStroke send: #searchPaneCharacter: to: self. aTextMorph setNameTo: 'SearchPane'. aTextMorph setBalloonText: 'Type here and all entries that match will be shown.' translated. aTextMorph extent: ((self innerBounds width - 16) @ 20). aTextMorph vResizing: #rigid. aBox _ AlignmentMorph new hResizing: #spaceFill; vResizing: #shrinkWrap. aBox color: Color white. aBox addMorphBack: aTextMorph. ^ aBox! ! !ObjectsTool methodsFor: 'tabs' stamp: 'dgd 8/30/2003 16:09'! presentHelp "Sent when a Help button is hit; provide the user with some form of help for the tool at hand" 'The Objects tool allows you to browse through, and obtain copies of, many kinds of objects. You can obtain an Objects tool by choosing "Objects" from the world menu, or by the shortcut of typing alt-o (cmd-o) any time the cursor is over the desktop. There are three ways to use Objects, corresponding to the three tabs seen at the top: alphabetic - gives you separate tabs for a, b, c, etc. Click any tab, and you will see the icons of all the objects whose names begin with that letter search - gives you a type-in pane for a search string. Type any letters there, and icons of all the objects whose names match what you have typed will appear in the bottom pane. categories - provides tabs representing categories of related items. Click on any tab to see the icons of all the objects in the category. When the cursor lingers over the icon of any object, you will get balloon help for the item. When you drag an icon from Objects, it will result in a new copy of it in your hand; the new object will be deposited wherever you next click.' translated openInWorkspaceWithTitle: 'About Objects' translated! ! !PaintBoxMorph methodsFor: 'other' stamp: 'dgd 8/30/2003 21:55'! addCustomMenuItems: aCustomMenu hand: aHandMorph "super addCustomMenuItems: aCustomMenu hand: aHandMorph." "don't want the ones from ImageMorph" aCustomMenu add: 'grab stamp from screen' translated action: #grabFromScreen:. ! ! !ParagraphEditor class methodsFor: 'class initialization' stamp: 'dgd 9/5/2003 19:02'! initializeTextEditorMenus "Initialize the yellow button pop-up menu and corresponding messages." "ParagraphEditor initializeTextEditorMenus" TextEditorYellowButtonMenu _ SelectionMenu fromArray: { {'find...(f)' translated. #find}. {'find again (g)' translated. #findAgain}. {'set search string (h)' translated. #setSearchString}. #-. {'do again (j)' translated. #again}. {'undo (z)' translated. #undo}. #-. {'copy (c)' translated. #copySelection}. {'cut (x)' translated. #cut}. {'paste (v)' translated. #paste}. {'paste...' translated. #pasteRecent}. #-. {'do it (d)' translated. #doIt}. {'print it (p)' translated. #printIt}. {'inspect it (i)' translated. #inspectIt}. {'explore it (I)' translated. #exploreIt}. {'debug it' translated. #debugIt}. #-. {'accept (s)' translated. #accept}. {'cancel (l)' translated. #cancel}. #-. {'show bytecodes' translated. #showBytecodes}. #-. {'more...' translated. #shiftedTextPaneMenuRequest}. } ! ! !ParagraphEditor class methodsFor: 'class initialization' stamp: 'dgd 9/5/2003 18:52'! shiftedYellowButtonMenu "Answer the menu to be presented when the yellow button is pressed while the shift key is down" ^ SelectionMenu fromArray: { {'set font... (k)' translated. #offerFontMenu}. {'set style... (K)' translated. #changeStyle}. {'set alignment...' translated. #chooseAlignment}. #-. {'explain' translated. #explain}. {'pretty print' translated. #prettyPrint}. {'pretty print with color' translated. #prettyPrintWithColor}. {'file it in (G)' translated. #fileItIn}. {'tiles from it' translated. #selectionAsTiles}. {'recognizer (r)' translated. #recognizeCharacters}. {'spawn (o)' translated. #spawn}. #-. {'definition of word' translated. #wordDefinition}. {'verify spelling of word' translated. #verifyWordSpelling}. {'translate it' translated. #translateIt}. {'choose language' translated. #languagePrefs}. #-. {'browse it (b)' translated. #browseIt}. {'senders of it (n)' translated. #sendersOfIt}. {'implementors of it (m)' translated. #implementorsOfIt}. {'references to it (N)' translated. #referencesToIt}. #-. {'selectors containing it (W)' translated. #methodNamesContainingIt}. {'method strings with it (E)' translated. #methodStringsContainingit}. {'method source with it' translated. #methodSourceContainingIt}. {'class names containing it' translated. #classNamesContainingIt}. {'class comments with it' translated. #classCommentsContainingIt}. {'change sets with it' translated. #browseChangeSetsWithSelector}. #-. {'save contents to file...' translated. #saveContentsInFile}. {'send contents to printer' translated. #sendContentsToPrinter}. {'printer setup' translated. #printerSetup}. #-. {'special menu...' translated. #presentSpecialMenu}. {'more...' translated. #yellowButtonActivity}. } ! ! !PasteUpMorph methodsFor: 'gridding' stamp: 'dgd 9/6/2003 18:09'! setGridSpec "Gridding rectangle provides origin and modulus" | response result mx | mx _ 36. "... because it was that way before ..." response _ FillInTheBlank request: 'New grid origin (usually 0@0):' translated initialAnswer: self gridOrigin printString. response isEmpty ifTrue: [^ self]. result _ [Compiler evaluate: response] ifError: [^ self]. (result isPoint and: [(result >= (0@0)) & (result < (mx @ mx))]) ifTrue: [self gridOrigin: result] ifFalse: [self inform: ('Must be a Point with coordinates between 0 & {1}' translated format: {mx-1})]. response _ FillInTheBlank request: 'New grid spacing:' translated initialAnswer: self gridModulus printString. response isEmpty ifTrue: [^ self]. result _ [Compiler evaluate: response] ifError: [^ self]. (result isPoint and: [(result > (0@0)) & (result <= (mx @ mx))]) ifTrue: [self gridModulus: result] ifFalse: [self inform: ('Must be a Point with coordinates between 1 & {1}' translated format: {mx})]. ! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 8/30/2003 21:56'! addCustomMenuItems: menu hand: aHandMorph "Add morph-specific menu itemns to the menu for the hand" super addCustomMenuItems: menu hand: aHandMorph. self addStackMenuItems: menu hand: aHandMorph. self addPenMenuItems: menu hand: aHandMorph. self addPlayfieldMenuItems: menu hand: aHandMorph. self isWorldMorph ifTrue: [(owner isKindOf: BOBTransformationMorph) ifTrue: [self addScalingMenuItems: menu hand: aHandMorph]. Flaps sharedFlapsAllowed ifTrue: [menu addUpdating: #suppressFlapsString target: CurrentProjectRefactoring action: #currentToggleFlapsSuppressed]. menu add: 'desktop menu...' translated target: self action: #putUpDesktopMenu:]. menu addLine! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:53'! addPenMenuItems: menu hand: aHandMorph "Add a pen-trails-within submenu to the given menu" | subMenu | subMenu _ MenuMorph new defaultTarget: self. self addPenTrailsMenuItemsTo: subMenu. menu add: 'pens trails within...' translated subMenu: subMenu! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:54'! addPenTrailsMenuItemsTo: aMenu | oldTarget | "Add items relating to pen trails to aMenu" oldTarget _ aMenu defaultTarget. aMenu defaultTarget: self. aMenu add: 'clear pen trails' translated action: #clearTurtleTrails. aMenu add: 'all pens up' translated action: #liftAllPens. aMenu add: 'all pens down' translated action: #lowerAllPens. aMenu defaultTarget: oldTarget! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/5/2003 19:31'! addPlayfieldMenuItems: menu hand: aHandMorph menu add: 'playfield options...' translated target: self action: #presentPlayfieldMenu! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 8/30/2003 21:18'! addScalingMenuItems: menu hand: aHandMorph | subMenu | (subMenu _ MenuMorph new) defaultTarget: self; add: 'show application view' translated action: #showApplicationView; add: 'show factory view' translated action: #showFactoryView; add: 'show whole world view' translated action: #showFullView; add: 'expand' translated action: #showExpandedView; add: 'reduce' translated action: #showReducedView; addLine; add: 'define application view' translated action: #defineApplicationView; add: 'define factory view' translated action: #defineFactoryView. menu add: 'world scale and clip...' translated subMenu: subMenu! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:59'! autoExpansionString "Answer the string to be shown in a menu to represent the auto-phrase-expansion status" ^ ((self hasProperty: #automaticPhraseExpansion) ifTrue: [''] ifFalse: ['']) , 'auto-phrase-expansion' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:54'! autoLineLayoutString "Answer the string to be shown in a menu to represent the auto-line-layout status" ^ (self autoLineLayout ifTrue: [''] ifFalse: ['']) , 'auto-line-layout' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 18:02'! autoViewingString "Answer the string to be shown in a menu to represent the automatic-viewing status" ^ (self automaticViewing ifTrue: [''] ifFalse: ['']) , 'automatic viewing' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 18:01'! batchPenTrailsString "Answer the string to be shown in a menu to represent the batch-pen-trails enabled status" ^ (self batchPenTrails ifTrue: [''] ifFalse: ['']), 'batch pen trails' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 8/30/2003 20:42'! buildDebugMenu: aHandMorph | aMenu | aMenu _ super buildDebugMenu: aHandMorph. aMenu add: 'abandon costume history' translated target: self action: #abandonCostumeHistory. ^ aMenu! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 18:01'! fenceEnabledString "Answer the string to be shown in a menu to represent the fence enabled status" ^ (self fenceEnabled ifTrue: [''] ifFalse: ['']) , 'fence enabled' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:56'! indicateCursorString "Answer the string to be shown in a menu to represent the whether-to-indicate-cursor status" ^ (self indicateCursor ifTrue: [''] ifFalse: ['']) , 'indicate cursor' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:58'! isOpenForDragNDropString "Answer the string to be shown in a menu to represent the open-to-drag-n-drop status" ^ (self dragNDropEnabled ifTrue: [''] ifFalse: ['']) , 'open to drag & drop' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:57'! isPartsBinString "Answer the string to be shown in a menu to represent the parts-bin status" ^ (self isPartsBin ifTrue: [''] ifFalse: ['']), 'parts bin' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 17:58'! mouseOverHalosString "Answer the string to be shown in a menu to represent the mouse-over-halos status" ^ (self wantsMouseOverHalos ifTrue: [''] ifFalse: ['']) , 'mouse-over halos' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 18:00'! originAtCenterString "Answer the string to be shown in a menu to represent the origin-at-center status" ^ ((self hasProperty: #originAtCenter) ifTrue: [''] ifFalse: ['']), 'origin-at-center' translated! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/5/2003 19:33'! playfieldOptionsMenu "Answer an auxiliary menu with options specific to playfields -- too many to be housed in the main menu" | aMenu isWorld | isWorld _ self isWorldMorph. aMenu _ MenuMorph new defaultTarget: self. aMenu addStayUpItem. aMenu add: 'save on file...' translated action: #saveOnFile. aMenu add: 'save as SqueakPage at url...' translated action: #saveOnURL. aMenu add: 'update all from resources' translated action: #updateAllFromResources. (self valueOfProperty: #classAndMethod) ifNotNil: [aMenu add: 'broadcast as documentation' translated action: #saveDocPane]. aMenu add: 'round up strays' translated action: #roundUpStrays. aMenu balloonTextForLastItem: 'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.' translated. aMenu add: 'show all players' translated action: #showAllPlayers. aMenu balloonTextForLastItem: 'Make visible the viewers for all players which have user-written scripts in this playfield.' translated. aMenu add: 'hide all players' translated action: #hideAllPlayers. aMenu balloonTextForLastItem: 'Make invisible the viewers for all players in this playfield. This will save space before you publish this project' translated. aMenu addLine. aMenu add: 'shuffle contents' translated action: #shuffleSubmorphs. aMenu balloonTextForLastItem: 'Rearranges my contents in random order' translated. self griddingOn ifTrue: [aMenu add: 'turn gridding off' translated action: #griddingOnOff. aMenu add: (self gridVisible ifTrue: ['hide'] ifFalse: ['show']) translated, ' grid' translated action: #gridVisibleOnOff. aMenu add: 'set grid spacing...' translated action: #setGridSpec] ifFalse: [aMenu add: 'turn gridding on' translated action: #griddingOnOff]. aMenu addLine. #( (autoLineLayoutString toggleAutoLineLayout 'whether submorphs should automatically be laid out in lines' translated) (indicateCursorString toggleIndicateCursor 'whether the "current" submorph should be indicated with a dark black border' translated) (isPartsBinString toggleIsPartsBin 'whether dragging an object from the interior should produce a COPY of the object' translated) (isOpenForDragNDropString toggleDragNDrop 'whether objects can be dropped into and dragged out of me' translated) (mouseOverHalosString toggleMouseOverHalos 'whether objects should put up halos when the mouse is over them' translated) (autoExpansionString toggleAutomaticPhraseExpansion 'whether tile phrases, dropped on me, should automatically sprout Scriptors around them' translated) (originAtCenterString toggleOriginAtCenter 'whether the cartesian origin of the playfield should be at its lower-left corner or at the center of the playfield' translated) (showThumbnailString toggleAlwaysShowThumbnail 'whether large objects should be represented by thumbnail miniatures of themselves' translated) (fenceEnabledString toggleFenceEnabled 'whether moving objects should stop at the edge of their container' translated) (batchPenTrailsString toggleBatchPenTrails 'if true, detailed movement of pens between display updates is ignored. Thus multiple line segments drawn within a script may not be seen individually.' translated) ) do: [:triplet | (isWorld and: [#(toggleAutoLineLayout toggleIndicateCursor toggleIsPartsBin toggleAlwaysShowThumbnail) includes: triplet second]) ifFalse: [aMenu addUpdating: triplet first action: triplet second. aMenu balloonTextForLastItem: triplet third]]. aMenu addUpdating: #autoViewingString action: #toggleAutomaticViewing. aMenu balloonTextForLastItem: 'governs whether, when an object is touched inside me, a viewer should automatically be launched for it.' translated. ((isWorld not or: [self backgroundSketch notNil]) or: [presenter isNil]) ifTrue: [aMenu addLine]. isWorld ifFalse: [aMenu add: 'set thumbnail height...' translated action: #setThumbnailHeight. aMenu balloonTextForLastItem: 'if currently showing thumbnails governs the standard height for them' translated. aMenu add: 'behave like a Holder' translated action: #becomeLikeAHolder. aMenu balloonTextForLastItem: 'Set properties to make this object nicely set up to hold frames of a scripted animation.' translated]. self backgroundSketch ifNotNil: [aMenu add: 'delete background painting' translated action: #deleteBackgroundPainting. aMenu balloonTextForLastItem: 'delete the graphic that forms the background for this me.' translated]. presenter ifNil: [aMenu add: 'make detachable' translated action: #makeDetachable. aMenu balloonTextForLastItem: 'Allow this area to be separately governed by its own controls.' translated]. aMenu addLine. aMenu add: 'use standard texture' translated action: #setStandardTexture. aMenu balloonTextForLastItem: 'use a pale yellow-and-blue background texture here.' translated. aMenu add: 'make graph paper...' translated action: #makeGraphPaper. aMenu balloonTextForLastItem: 'Design your own graph paper and use it as the background texture here.' translated. aMenu addTitle: 'playfield options...' translated. ^ aMenu ! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 18:04'! presentViewMenu "Answer an auxiliary menu with options specific to viewing playfields -- this is put up from the provisional 'view' halo handle, on pasteup morphs only." | aMenu isWorld | isWorld _ self isWorldMorph. aMenu _ MenuMorph new defaultTarget: self. aMenu addStayUpItem. self addViewingItemsTo: aMenu. #( "(autoLineLayoutString toggleAutoLineLayout 'whether submorphs should automatically be laid out in lines')" (indicateCursorString toggleIndicateCursor 'whether the "current" submorph should be indicated with a dark black border') (resizeToFitString toggleResizeToFit 'whether I should automatically strive exactly to fit my contents') (behaveLikeAHolderString toggleBehaveLikeAHolder 'whether auto-line-layout, resize-to-fit, and indicate-cursor should be set to true; useful for animation control, etc.') (isPartsBinString toggleIsPartsBin 'whether dragging an object from the interior should produce a COPY of the object') (isOpenForDragNDropString toggleDragNDrop 'whether objects can be dropped into and dragged out of me') (mouseOverHalosString toggleMouseOverHalos 'whether objects should put up halos when the mouse is over them') (autoExpansionString toggleAutomaticPhraseExpansion 'whether tile phrases, dropped on me, should automatically sprout Scriptors around them') (originAtCenterString toggleOriginAtCenter 'whether the cartesian origin of the playfield should be at its lower-left corner or at the center of the playfield') (showThumbnailString toggleAlwaysShowThumbnail 'whether large objects should be represented by thumbnail miniatures of themselves') (fenceEnabledString toggleFenceEnabled 'whether moving objects should stop at the edge of their container') (autoViewingString toggleAutomaticViewing 'governs whether, when an object is touched inside me, a viewer should automatically be launched for it.') (griddingString griddingOnOff 'whether gridding should be used in my interior') (gridVisibleString gridVisibleOnOff 'whether the grid should be shown when gridding is on') ) do: [:triplet | (isWorld and: [#(toggleAutoLineLayout toggleIndicateCursor toggleIsPartsBin toggleAlwaysShowThumbnail toggleAutomaticViewing ) includes: triplet second]) ifFalse: [aMenu addUpdating: triplet first action: triplet second. aMenu balloonTextForLastItem: triplet third translated]]. aMenu addLine. aMenu add: 'round up strays' translated action: #roundUpStrays. aMenu balloonTextForLastItem: 'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.' translated. aMenu add: 'shuffle contents' translated action: #shuffleSubmorphs. aMenu balloonTextForLastItem: 'Rearranges my contents in random order' translated. aMenu add: 'set grid spacing...' translated action: #setGridSpec. aMenu balloonTextForLastItem: 'Set the spacing to be used when gridding is on' translated. isWorld ifFalse: [aMenu add: 'set thumbnail height...' translated action: #setThumbnailHeight. aMenu balloonTextForLastItem: 'if currently showing thumbnails governs the standard height for them' translated]. self backgroundSketch ifNotNil: [aMenu add: 'delete background painting' translated action: #deleteBackgroundPainting. aMenu balloonTextForLastItem: 'delete the graphic that forms the background for this me.' translated]. aMenu addLine. self addPenTrailsMenuItemsTo: aMenu. aMenu addLine. aMenu add: 'use standard texture' translated action: #setStandardTexture. aMenu balloonTextForLastItem: 'use a pale yellow-and-blue background texture here.' translated. aMenu add: 'make graph paper...' translated action: #makeGraphPaper. aMenu balloonTextForLastItem: 'Design your own graph paper and use it as the background texture here.' translated. aMenu addTitle: ('viewing options for "{1}"' translated format: {self externalName}). aMenu popUpForHand: self activeHand in: self world ! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'sd 11/13/2003 21:26'! saveOnFile "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out." | aFileName fileStream ok | self flag: #bob0302. self isWorldMorph ifTrue: [^self project saveAs]. aFileName _ ('my {1}' translated format: {self class name}) asFileName. "do better?" aFileName _ FillInTheBlank request: 'File name? (".project" will be added to end)' translated initialAnswer: aFileName. aFileName isEmpty ifTrue: [^ Beeper beep]. self allMorphsDo: [:m | m prepareToBeSaved]. ok _ aFileName endsWith: '.project'. "don't double them" ok _ ok | (aFileName endsWith: '.sp'). ok ifFalse: [aFileName _ aFileName,'.project']. fileStream _ FileStream newFileNamed: aFileName. fileStream fileOutClass: nil andObject: self. "Puts UniClass definitions out anyway"! ! !PasteUpMorph methodsFor: 'menu & halo' stamp: 'dgd 9/6/2003 18:00'! showThumbnailString "Answer the string to be shown in a menu to represent the show-thumbnails status" ^ ((self hasProperty: #alwaysShowThumbnail) ifTrue: [''] ifFalse: ['']), 'show thumbnails' translated! ! !PasteUpMorph methodsFor: 'misc' stamp: 'dgd 8/30/2003 15:52'! innocuousName ^ (self isFlap) ifTrue: ['flap' translated] ifFalse: [super innocuousName]! ! !PasteUpMorph methodsFor: 'options' stamp: 'dgd 9/6/2003 17:55'! becomeLikeAHolder (self autoLineLayout and: [self indicateCursor]) ifTrue: [^ self inform: 'This view is ALREADY behaving like a holder, which is to say, it is set to indicate the cursor and to have auto-line-layout.' translated]. self behaveLikeHolder! ! !PasteUpMorph methodsFor: 'options' stamp: 'dgd 9/6/2003 18:05'! setThumbnailHeight | reply | (self hasProperty: #alwaysShowThumbnail) ifFalse: [^ self inform: 'setting the thumbnail height is only applicable when you are currently showing thumbnails.' translated]. reply _ FillInTheBlank request: 'New height for thumbnails? ' translated initialAnswer: self heightForThumbnails printString. reply isEmpty ifTrue: [^ self]. reply _ reply asNumber. (reply > 0 and: [reply <= 150]) ifFalse: [^ self inform: 'Please be reasonable!!' translated]. self setProperty: #heightForThumbnails toValue: reply. self updateSubmorphThumbnails! ! !PasteUpMorph methodsFor: 'scripting' stamp: 'dgd 8/31/2003 19:39'! modernizeBJProject "Prepare a kids' project from the BJ fork of September 2000 -- a once-off thing for converting such projects forward to a modern 3.1a image, in July 2001. Except for the #enableOnlyGlobalFlapsWithIDs: call, this could conceivably be called upon reloading *any* project, just for safety." "ActiveWorld modernizeBJProject" ScriptEditorMorph allInstancesDo: [:m | m userScriptObject]. Flaps enableOnlyGlobalFlapsWithIDs: {'Supplies' translated}. ActiveWorld abandonOldReferenceScheme. ActiveWorld relaunchAllViewers.! ! !PasteUpMorph methodsFor: 'viewing' stamp: 'dgd 9/6/2003 17:50'! viewingByIconString "Answer a string to show in a menu representing whether the receiver is currently viewing its subparts by icon or not" ^ ((self showingListView or: [self autoLineLayout == true]) ifTrue: [''] ifFalse: ['']), 'view by icon' translated! ! !PasteUpMorph methodsFor: 'viewing' stamp: 'dgd 9/6/2003 17:50'! viewingByNameString "Answer a string to show in a menu representing whether the receiver is currently viewing its subparts by name or not" ^ ((self showingListView and: [(self valueOfProperty: #sortOrder ifAbsent: []) == #downshiftedNameOfObjectRepresented]) ifTrue: [''] ifFalse: ['']), 'view by name' translated! ! !PasteUpMorph methodsFor: 'viewing' stamp: 'dgd 9/6/2003 17:50'! viewingBySizeString "Answer a string to show in a menu representing whether the receiver is currently viewing its subparts by size or not" ^ ((self showingListView and: [(self valueOfProperty: #sortOrder ifAbsent: []) == #reportableSize]) ifTrue: [''] ifFalse: ['']), 'view by size' translated! ! !PasteUpMorph methodsFor: 'viewing' stamp: 'dgd 9/6/2003 17:51'! viewingNonOverlappingString "Answer a string to show in a menu representing whether the receiver is currently viewing its subparts by non-overlapping-icon (aka auto-line-layout)" ^ ((self showingListView or: [self autoLineLayout ~~ true]) ifTrue: [''] ifFalse: ['']), 'view with line layout' translated! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 9/21/2003 17:39'! closeUnchangedWindows "Present a menu of window titles for all windows with changes, and activate the one that gets chosen." (SelectionMenu confirm: 'Do you really want to close all windows except those with unaccepted edits?' translated) ifFalse: [^ self]. (SystemWindow windowsIn: self satisfying: [:w | w model canDiscardEdits]) do: [:w | w delete]! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 9/21/2003 17:40'! deleteNonWindows (SelectionMenu confirm: 'Do you really want to discard all objects that are not in windows?' translated) ifFalse: [^ self]. self allNonFlapRelatedSubmorphs do: [:m | m delete]! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'sd 11/13/2003 21:25'! findWindow: evt "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo." | menu expanded collapsed nakedMorphs | menu _ MenuMorph new. expanded _ SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not]. collapsed _ SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]. nakedMorphs _ self submorphsSatisfying: [:m | (m isSystemWindow not and: [(m isKindOf: StickySketchMorph) not]) and: [(m isFlapTab) not]]. (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep]. (expanded asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: w label target: w action: #activateAndForceLabelToShow. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine]. (collapsed asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: [:w | menu add: w label target: w action: #collapseOrExpand. w model canDiscardEdits ifFalse: [menu lastItem color: Color red]]. nakedMorphs isEmpty ifFalse: [menu addLine]. (nakedMorphs asSortedCollection: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do: [:w | menu add: w nameForFindWindowFeature target: w action: #comeToFrontAndAddHalo]. menu addTitle: 'find window' translated. menu popUpEvent: evt in: self.! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 8/26/2003 21:10'! putUpDesktopMenu: evt "Put up the desktop menu" ^ ((self buildWorldMenu: evt) addTitle: Preferences desktopMenuTitle translated) popUpAt: evt position forHand: evt hand in: self! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 8/26/2003 21:10'! putUpWorldMenu: evt "Put up a menu in response to a click on the desktop, triggered by evt." | menu | self bringFlapTabsToFront. evt isMouse ifTrue: [evt yellowButtonPressed ifTrue: [^ self yellowButtonClickOnDesktopWithEvent: evt]. evt shiftPressed ifTrue:[^ self findWindow: evt]]. "put up screen menu" menu _ self buildWorldMenu: evt. menu addTitle: Preferences desktopMenuTitle translated. menu popUpEvent: evt in: self. ^ menu! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 9/19/2003 11:22'! yellowButtonClickOnDesktopWithEvent: evt "Put up either the personalized menu or the world menu when the user clicks on the morphic desktop with the yellow button. The preference 'personalizedWorldMenu' governs which one is used" | aMenu | Preferences personalizedWorldMenu ifTrue: [aMenu := MenuMorph new defaultTarget: self. Preferences personalizeUserMenu: aMenu. aMenu addLine. aMenu add: 'personalize...' translated target: Preferences action: #letUserPersonalizeMenu] ifFalse: [aMenu := self buildWorldMenu: evt. aMenu addTitle: 'World' translated]. aMenu popUpEvent: evt in: self! ! !ComponentLayout methodsFor: 'menus' stamp: 'dgd 8/30/2003 21:17'! addCustomMenuItems: menu hand: aHandMorph super addCustomMenuItems: menu hand: aHandMorph. menu addLine. menu add: 'inspect model in morphic' translated action: #inspectModelInMorphic! ! !PartsBin methodsFor: 'initialization' stamp: 'dgd 8/31/2003 18:46'! listDirection: aListDirection quadList: quadList "Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form: (