David T. Lewis uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-dtl.352.mcz
==================== Summary ====================
Name: MorphicExtras-dtl.352 Author: dtl Time: 25 November 2023, 2:56:12.072673 pm UUID: f43eae26-9022-478f-998d-f9288ded844d Ancestors: MorphicExtras-dtl.351
Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
=============== Diff against MorphicExtras-dtl.351 ===============
Item was removed: - ----- Method: AlignmentMorph>>addTransparentSpacerOfSize: (in category '*MorphicExtras-geometry') ----- - addTransparentSpacerOfSize: aPoint - "Required for several MorphicExtras and other non-Etoys stuff." - - self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)!
Item was removed: - ----- Method: BookMorph>>goToPage:transitionSpec:runTransitionScripts: (in category 'navigation') ----- - goToPage: pageNumber transitionSpec: transitionSpec runTransitionScripts: aBoolean - "Go the the given page number; use the transitionSpec supplied, and if the boolean parameter is true, run opening and closing scripts as appropriate" - - | pageMorph | - pages isEmpty ifTrue: [^ self]. - pageMorph := (self hasProperty: #dontWrapAtEnd) - ifTrue: [pages atPin: pageNumber] - ifFalse: [pages atWrap: pageNumber]. - ^ self goToPageMorph: pageMorph transitionSpec: transitionSpec runTransitionScripts: aBoolean!
Item was removed: - ----- Method: BookMorph>>goToPageMorph:runTransitionScripts: (in category 'navigation') ----- - goToPageMorph: aMorph runTransitionScripts: aBoolean - "Set the given morph as the current page. If the boolean parameter is true, then opening and closing scripts will be run" - - self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil runTransitionScripts: aBoolean - !
Item was removed: - ----- Method: BookMorph>>goToPageMorph:transitionSpec:runTransitionScripts: (in category 'navigation') ----- - goToPageMorph: newPage transitionSpec: transitionSpec runTransitionScripts: aBoolean - "Install the given page as the new current page; use the given transition spec, and if the boolean parameter is true, run closing and opening scripts on the outgoing and incoming players" - - | pageIndex aWorld oldPageIndex ascending tSpec readIn | - pages isEmpty ifTrue: [^self]. - self setProperty: #searchContainer toValue: nil. "forget previous search" - self setProperty: #searchOffset toValue: nil. - self setProperty: #searchKey toValue: nil. - pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. - readIn := newPage isInMemory not. - oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. - ascending := (oldPageIndex isNil or: [newPage == currentPage]) - ifTrue: [nil] - ifFalse: [oldPageIndex < pageIndex]. - tSpec := transitionSpec ifNil: - ["If transition not specified by requestor..." - - newPage valueOfProperty: #transitionSpec - ifAbsent: - [" ... then consult new page" - - self transitionSpecFor: self " ... otherwise this is the default"]]. - self flag: #arNote. "Probably unnecessary" - (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. - currentPage ifNotNil: [currentPage updateCachedThumbnail]. - self currentPage notNil - ifTrue: - [(((pages at: pageIndex) owner isKindOf: TransitionMorph) - and: [(pages at: pageIndex) isInWorld]) - ifTrue: [^self "In the process of a prior pageTurn"]. - aBoolean - ifTrue: [self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts]]. - ascending ifNotNil: - ["Show appropriate page transition and start new page when done" - - currentPage stopStepping. - (pages at: pageIndex) position: currentPage position. - ^(TransitionMorph - effect: tSpec second - direction: tSpec third - inverse: (ascending or: [transitionSpec notNil]) not) - showTransitionFrom: currentPage - to: (pages at: pageIndex) - in: self - whenStart: [self playPageFlipSound: tSpec first] - whenDone: - [currentPage - delete; - fullReleaseCachedState. - self insertPageMorphInCorrectSpot: (pages at: pageIndex). - self adjustCurrentPageForFullScreen. - self snapToEdgeIfAppropriate. - aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. - aBoolean - ifTrue: [self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts]]. - (aWorld := self world) ifNotNil: - ["WHY??" - - aWorld displayWorld]. - readIn - ifTrue: - [currentPage updateThumbnailUrlInBook: self url. - currentPage sqkPage computeThumbnail "just store it"]]]. - - "No transition, but at least decommission current page" - currentPage - delete; - fullReleaseCachedState]. - self insertPageMorphInCorrectSpot: (pages at: pageIndex). - self adjustCurrentPageForFullScreen. - self snapToEdgeIfAppropriate. - aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. - self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts]. - (aWorld := self world) ifNotNil: - ["WHY??" - - aWorld displayWorld]. - readIn - ifTrue: - [currentPage updateThumbnailUrl. - currentPage sqkPage computeThumbnail "just store it"]!
Item was removed: - ----- Method: BookMorph>>goto: (in category 'navigation') ----- - goto: aPlayer - self goToPageMorph: aPlayer costume!
Item was removed: - ----- Method: BookMorph>>keepTogether (in category 'menu') ----- - keepTogether - "Mark this book so that each page will not go into a separate file. Do this when pages share referenes to a common Player. Don't want many copies of that Player when bring in. Do not write pages of book out. Write the PasteUpMorph that the entire book lives in." - - self setProperty: #keepTogether toValue: true.!
Item was removed: - ----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') ----- - currentPlayerDo: aBlock - | aPlayer aPage | - (aPage := self currentPage) ifNil: [^ self]. - aPage allMorphsDo:[ :m| - (aPlayer := m player) ifNotNil: - [aBlock value: aPlayer]]!
Item was removed: - ----- Method: EventHandler>>adaptToWorld: (in category '*MorphicExtras-initialization') ----- - adaptToWorld: aWorld - "If any of my recipients refer to a world or a hand, make them now refer - to the corresponding items in the new world. (instVarNamed: is slow, later - use perform of two selectors.)" - - - #(mouseDownRecipient mouseStillDownRecipient mouseUpRecipient - mouseEnterRecipient mouseLeaveRecipient mouseEnterDraggingRecipient - mouseLeaveDraggingRecipient clickRecipient doubleClickRecipient startDragRecipient keyStrokeRecipient valueParameter) do: - [:aName | | value newValue | - (value := self instVarNamed: aName asString) ifNotNil:[ - newValue := value adaptedToWorld: aWorld. - (newValue notNil and: [newValue ~~ value]) - ifTrue: - [self instVarNamed: aName asString put: newValue]]]!
Item was removed: - ----- Method: FlapTab>>makeNewDrawing: (in category 'mouseover & dragover') ----- - makeNewDrawing: evt - self flapShowing ifTrue:[ - self world makeNewDrawing: evt. - ] ifFalse:[ - self world assureNotPaintingEvent: evt. - ].!
Item was removed: - ----- Method: FlapTab>>startOrFinishDrawing: (in category 'mouseover & dragover') ----- - startOrFinishDrawing: evt - | w | - self flapShowing ifTrue:[ - (w := self world) makeNewDrawing: evt at: w center. - ] ifFalse:[ - self world endDrawing: evt. - ].!
Item was removed: - ----- Method: FlapTab>>thicknessString (in category 'menu') ----- - thicknessString - ^ 'thickness... (currently ', self thickness printString, ')'!
Item was removed: - ----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') ----- - addAndEnableEToyFlaps - "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed." - - | aSuppliesFlap | - SharedFlapTabs - ifNotNil: [^ self]. - SharedFlapTabs := OrderedCollection new. - - 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" - - (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false]) - ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap] - ifFalse: [Preferences showProjectNavigator - ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]]. - - self enableGlobalFlapWithID: 'Supplies' translated. - - (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false]) - ifTrue: - [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated. - (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNil: - [:navTab | aSuppliesFlap sugarNavTab: navTab]] - ifFalse: [ - Preferences showProjectNavigator - ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]]. - - SharedFlapsAllowed := true. - Project current flapsSuppressed: false. - ^ SharedFlapTabs - - "Flaps addAndEnableEToyFlaps"!
Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningPlugInSuppliesFlap (in category 'predefined flaps') ----- - defaultsQuadsDefiningPlugInSuppliesFlap - "Answer a list of quads which define the objects to appear in the default Supplies flap used in the Plug-in image" - - "PartsBin reconstructAllPartsIcons" - - ^ #( - (ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of available objects') - (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'Stop, Step, and Go buttons for controlling all your scripts at once. The tool can also be "opened up" to control each script in your project individually.') - (TrashCanMorph new 'Trash' 'A tool for discarding objects') - (GrabPatchMorph new 'Grab Patch' 'Allows you to create a new Sketch by grabbing a rectangular patch from the screen') - (LassoPatchMorph new 'Lasso' 'Allows you to create a new Sketch by lassoing an area from the screen') - - (StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.') - "(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')" - (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.') - (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') - (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') - (ScriptableButton authoringPrototype 'Button' 'A Scriptable button') - "(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page') - (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')" - "(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')" - (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations') - (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.') - (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control') - (BookMorph authoringPrototype 'Book' 'A multi-paged structure') - "(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')" - (KedamaMorph newSet 'Particles' 'A Kedama World with pre-made components') - "(RandomNumberTile new 'Random' 'A random-number tile for use with tile scripting')") asOrderedCollection!
Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') ----- - defaultsQuadsDefiningScriptingFlap - "Answer a structure defining the default items in the Scripting flap. - previously in quadsDeiningScriptingFlap" - - ^ { - {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}. - {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}. - {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}. - {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}. - - {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}. - {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}. - {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. - {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}. - {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}. - {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}. - - {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. - {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. - {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}. - - {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. - - - {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. - {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}. - {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop} - } asOrderedCollection!
Item was removed: - ----- Method: Flaps class>>enableEToyFlaps (in category 'menu support') ----- - enableEToyFlaps - "Start using global flaps, plug-in version, given that they were not present." - - Cursor wait showWhile: - [self addAndEnableEToyFlaps. - self enableGlobalFlaps]!
Item was removed: - ----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') ----- - newLoneSuppliesFlap - "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..." - - | aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly" - aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: { - - {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}. - {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}. - {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}. - - {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}. - {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. - {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. - {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. - {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. - {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. - {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. - {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. - {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. - {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. - {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. - " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}." - {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. - {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. - {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}. - - {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}. - {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}. - - {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. - {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}. - {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}. - {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}. - }. - - 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 autoLineLayout: true. - - ^ aFlapTab!
Item was removed: - ----- Method: Flaps class>>newPaintingFlap (in category 'predefined flaps') ----- - newPaintingFlap - "Add a flap with the paint palette in it" - - | aFlap aFlapTab | - "Flaps reinstateDefaultFlaps. Flaps newPaintingFlap" - - 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 beFlap: 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!
Item was removed: - ----- Method: Flaps class>>paintFlapButton (in category 'miscellaneous') ----- - paintFlapButton - "Answer a button to serve as the paint flap" - - | pb oldArgs brush myButton m | - pb := PaintBoxMorph new submorphNamed: #paint:. - pb - ifNil: - [(brush := Form extent: 16@16 depth: 16) fillColor: Color red] - ifNotNil: - [oldArgs := pb arguments. - brush := oldArgs third. - brush := brush copy: (2@0 extent: 42@38). - brush := brush scaledToSize: brush extent // 2]. - myButton := BorderedMorph new. - myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderStyle: (BorderStyle raised width: 2). - myButton addMorph: (m := brush asMorph lock). - myButton extent: m extent + (myButton borderWidth + 6). - m position: myButton center - (m extent // 2). - ^ myButton - - !
Item was removed: - ----- Method: Flaps class>>possiblyReplaceEToyFlaps (in category 'construction support') ----- - possiblyReplaceEToyFlaps - "If in eToyFriendly mode, and if it's ok to reinitialize flaps, replace the existing flaps with up-too-date etoy flaps. Caution: this is destructive of existing flaps. If preserving the contents of existing flaps is important, set the preference 'okToReinitializeFlaps' to true" - - PartsBin thumbnailForPartsDescription: StickyPadMorph descriptionForPartsBin. "Puts StickyPadMorph's custom icon back in the cache which typically will have been called" - (Preferences eToyFriendly and: [Preferences okToReinitializeFlaps]) ifTrue: - [Flaps disableGlobalFlaps: false. - Flaps addAndEnableEToyFlaps. - Smalltalk isMorphic ifTrue: [Project current world enableGlobalFlaps]]. - "PartsBin clearThumbnailCache" - - "Flaps possiblyReplaceEToyFlaps"!
Item was removed: - ----- Method: Flaps class>>setUpSuppliesFlapOnly (in category 'menu support') ----- - setUpSuppliesFlapOnly - "Set up the Supplies flap as the only shared flap. A special version formulated for this stand-alone use is used, defined in #newLoneSuppliesFlap" - - | supplies | - SharedFlapTabs isEmptyOrNil ifFalse: "get rid of pre-existing guys if any" - [SharedFlapTabs do: - [:t | t referent delete. t delete]]. - - SharedFlapsAllowed := true. - SharedFlapTabs := OrderedCollection new. - SharedFlapTabs add: (supplies := self newLoneSuppliesFlap). - self enableGlobalFlapWithID: 'Supplies' translated. - supplies setToPopOutOnMouseOver: false. - - Smalltalk isMorphic ifTrue: [ - Project current world - addGlobalFlaps; - reformulateUpdatingMenus].!
Item was removed: - ----- Method: Form>>graphicForViewerTab (in category '*MorphicExtras-other') ----- - graphicForViewerTab - "Answer the graphic to be used in the tab of a viewer open on me" - - ^ self!
Item was removed: - ----- Method: MenuMorph>>allWordings (in category '*MorphicExtras-accessing') ----- - 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!
Item was removed: - ----- Method: MenuMorph>>allWordingsNotInSubMenus: (in category '*MorphicExtras-accessing') ----- - allWordingsNotInSubMenus: verbotenSubmenuContentsList - "Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContents" - - | aList | - aList := OrderedCollection new. - self items do: [:anItem | aList addAll: (anItem allWordingsNotInSubMenus: verbotenSubmenuContentsList)]. - ^ aList!
Item was removed: - ----- Method: ObjectlandMorph>>createEtoysProject (in category 'projects') ----- - createEtoysProject - - | etoysExample | - self flag: #forLater. "If we could enable etoysMode just for this project, this would be great" - - etoysExample := Player extraExampleCar. - ^ self - createProjectNamed: 'Fun with Etoys' translated - colorRamp: { - 1 -> Color plum darker. - 0 -> Color lightMagenta } - morphSpecs: { - (0.46 @ 0.6 exactCenter: 0.25 @ 0.6) -> [HelpBrowser new - rootTopic: SqueakTutorialsEToys; - showTopicNamed: #raceCar; - yourself]. - (0.3 @ 0.4 exactCenter: 0.7 @ 0.45) -> [etoysExample first addFlexShell]. "arena" - 0.3 @ 0.2 -> [AllScriptsTool newStandAlone]. - 0.7 @ 0.83 -> [etoysExample second] "script editor" } - initializeWorld: [:world | - self class liftUpSubmorphsOf: etoysExample first. - etoysExample first owner delete. - world stopRunningAll]!
Item was removed: - ImageMorph subclass: #PaintInvokingMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !PaintInvokingMorph commentStamp: '<historical>' prior: 0! - When this is dropped inside some appropriate place, then painting is invoked for that place.!
Item was removed: - ----- Method: PaintInvokingMorph class>>authoringPrototype (in category 'scripting') ----- - authoringPrototype - ^ self new image: (ScriptingSystem formAtKey: 'Painting'); markAsPartsDonor; setBalloonText: 'drop this into any playfield or book page to make a new painting there'; yourself!
Item was removed: - ----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Paint' translatedNoop - categories: {'Graphics' translatedNoop} - documentation: 'Drop this icon to start painting a new object.' translatedNoop!
Item was removed: - ----- Method: PaintInvokingMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry.!
Item was removed: - ----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'Scripting']!
Item was removed: - ----- Method: PaintInvokingMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] !
Item was removed: - ----- Method: PaintInvokingMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - self image: (ScriptingSystem formAtKey: 'Painting')!
Item was removed: - ----- Method: PaintInvokingMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - super initializeToStandAlone. - self image: (ScriptingSystem formAtKey: 'Painting')!
Item was removed: - ----- Method: PaintInvokingMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- - justDroppedInto: aPasteUpMorph event: anEvent - "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph" - aPasteUpMorph isPartsBin ifFalse:[ - self removeHalo. - self delete. - ^aPasteUpMorph makeNewDrawing: anEvent]. - ^super justDroppedInto: aPasteUpMorph event: anEvent!
Item was removed: - ----- Method: PaintInvokingMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- - wantsToBeDroppedInto: aMorph - "Only into PasteUps that are not part bins" - ^aMorph isPlayfieldLike!
Item was removed: - ----- Method: PartsBin>>morphToDropFrom: (in category 'dropping/grabbing') ----- - morphToDropFrom: aMorph - "Answer the morph to drop if the user attempts to drop aMorph" - - | aButton | - ((aMorph isKindOf: IconicButton) and: [aMorph actionSelector == #launchPartVia:label:]) - ifTrue: [^ aMorph]. - "The above handles the unusual case of a button that's already set up in a manner suitable for living in PartsBin; the archetypal example is the attempt to reposition an object within a partsflap by dragging it via the black halo handle." - - aButton := IconicButton new. - aButton color: self color; - initializeToShow: aMorph withLabel: aMorph externalName andSend: #veryDeepCopy to: aMorph veryDeepCopy. - ^ aButton!
Item was removed: - ----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - ^ {DescriptionForPartsBin - formalName: 'Holder' translatedNoop - categoryList: {'Scripting' translatedNoop} - documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop - globalReceiverSymbol: #ScriptingSystem - nativitySelector: #prototypicalHolder}!
Item was removed: - ----- Method: PasteUpMorph>>roundUpStrays (in category '*MorphicExtras-misc') ----- - roundUpStrays - self submorphs - reject: [:each | each wantsToBeTopmost] - thenDo: [:each | each goHome]. - super roundUpStrays!
Item was removed: - ----- Method: Player class>>extraExampleCar (in category '*MorphicExtras-examples') ----- - extraExampleCar - "Player extraExampleCar do: #openInWorld" - - | trackMorph wheelMorph carMorph carPlayer alertMorph wheelPlayer parent | - trackMorph := SketchMorph withForm: (Form extraCarTrack magnifyBy: RealEstateAgent scaleFactor). - trackMorph assuredPlayer; name: 'Track'. - carMorph := SketchMorph withForm: (Form extraCar magnifyBy: RealEstateAgent scaleFactor). - carPlayer := self newSubclass new - costume: (carMorph name: #Car); - yourself. - wheelMorph := SketchMorph withForm: (Form extraWheel magnifyBy: RealEstateAgent scaleFactor). - wheelPlayer := self newSubclass new - costume: (wheelMorph name: #Wheel); - yourself. - alertMorph := RectangleMorph new - useRoundedCorners; - extent: 90 px @ 50 px; - color: Color black; - assuredPlayer; - name: 'Alert'; - yourself. - {trackMorph. carMorph. wheelMorph. alertMorph} do: [:morph | - carPlayer environment at: morph name asSymbol put: morph player]. - carPlayer environment at: #Wheel put: wheelPlayer. - - Utilities useAuthorInitials: 'Objectland' during: [ - carPlayer class compile: ((self extraExampleCarSource - asString lines allButFirst copyWithFirst: #drive) - joinSeparatedBy: Character cr)]. - (carPlayer class >> #drive) decompile asScriptEditorFor: carPlayer. - carPlayer changeScript: #drive toStatus: #ticking. - carPlayer presenter stopRunningScripts. - - parent := Morph new - color: Color transparent; - extent: 700 px @ 700 px; - addAllMorphsFront: {carMorph. trackMorph. wheelMorph. alertMorph} - yourself. - trackMorph position: 19 px @ 25 px. - wheelMorph center: (trackMorph pointAtFraction: 0.3 @ 1.15). - carMorph - center: (trackMorph pointAtFraction: 0.45 @ 0.89); - rotationDegrees: 100. - alertMorph - center: (wheelMorph pointAtFraction: 1.75 @ 0.5); - addMorph: ('Alert' asTextMorph - backgroundColor: (Color paleYellow alpha: 0.6); - center: (alertMorph pointAtFraction: 0.5 @ 1.2); - yourself). - - ^ {parent. carPlayer scriptEditorFor: #drive}!
Item was removed: - ----- Method: Player class>>extraExampleCarSource (in category '*MorphicExtras-examples') ----- - extraExampleCarSource - - ^ 'extraExampleDrive - self forward: 5. - self turn: Wheel getHeading // 5'!
Item was removed: - ----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') ----- - buttonPaint - - | pb oldArgs brush myButton m | - - myButton := self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting. - pb := PaintBoxMorph new submorphNamed: #paint:. - pb ifNil: [ - (brush := Form extent: 16@16 depth: 16) fillColor: Color red - ] ifNotNil: [ - oldArgs := pb arguments. - brush := oldArgs third. - brush := brush copy: (2@0 extent: 42@38). - brush := brush scaledToSize: brush extent // 2. - ]. - myButton addMorph: (m := brush asMorph lock). - myButton extent: m extent + (myButton borderWidth + 6). - m position: myButton center - (m extent // 2). - - ^myButton - - "brush := (ScriptingSystem formAtKey: 'Painting')." - - !
Item was removed: - ----- Method: ProjectNavigationMorph>>doNewPainting (in category 'the actions') ----- - doNewPainting - - | w f | - - w := self world. - w assureNotPaintingElse: [^ self]. - (f := self owner flapTab) ifNotNil: [f hideFlap]. - w makeNewDrawing: (self primaryHand lastEvent translatedTo: w center) - !
Item was removed: - ----- Method: ProjectNavigationMorph>>editProjectInfo (in category 'the actions') ----- - editProjectInfo - - Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| - aClass - getFullInfoFor: (self world ifNil: [^self]) project - ifValid: [] - expandedFormat: true - ].!
Item was removed: - ----- Method: ProjectNavigationMorph>>makeTheSimpleButtons (in category 'buttons') ----- - makeTheSimpleButtons - - ^{ - self buttonNewProject. - - self buttonPrev. - self buttonNext. - self buttonPublish. - self buttonFind. - self buttonFullScreen. - - self buttonPaint. - }, - ( - Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] - ), - { - self buttonLanguage. - self buttonUndo. - self buttonQuit. - } - !
Item was removed: - ----- Method: ScrollableField>>cursorWrapped: (in category 'accessing') ----- - cursorWrapped: aNumber - "Set the cursor as indicated" - textMorph cursorWrapped: aNumber!
Item was removed: - ----- Method: ScrollableField>>getAllButFirstCharacter (in category 'accessing') ----- - getAllButFirstCharacter - "Obtain all but the first character from the receiver; if that - would be empty, return a black dot" - ^ textMorph getAllButFirstCharacter !
Item was removed: - ----- Method: ScrollableField>>getNumericValue (in category 'accessing') ----- - getNumericValue - "Obtain a numeric value from the receiver; if no digits, return - zero" - ^ textMorph getNumericValue !
Item was removed: - ----- Method: ScrollableField>>insertCharacters: (in category 'accessing') ----- - insertCharacters: aString - "Insert the characters from the given source at my current - cursor position" - textMorph insertCharacters: aString !
Item was removed: - ----- Method: ScrollableField>>insertContentsOf: (in category 'accessing') ----- - insertContentsOf: aPlayer - "Insert the characters from the given player at my current - cursor position" - textMorph insertContentsOf: aPlayer !
Item was removed: - ----- Method: ScrollableField>>setNumericValue: (in category 'accessing') ----- - setNumericValue: aValue - "Set the contents of the receiver to be a string obtained from - aValue" - textMorph setNumericValue: aValue !
Item was removed: - ----- Method: SimpleButtonMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - target := target adaptedToWorld: aWorld.!
Item was removed: - ----- Method: SimpleSliderMorph>>isLikelyRecipientForMouseOverHalos (in category 'e-toy support') ----- - isLikelyRecipientForMouseOverHalos - - self player ifNil: [^ false]. - self player getHeading = 0.0 ifTrue: [^ false]. - ^ true. - !
Item was removed: - ----- Method: SketchEditorMorph>>wantsHaloFromClick (in category 'e-toy support') ----- - wantsHaloFromClick - - ^ Preferences eToyFriendly not. - !
Item was removed: - ----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop} - forFlapNamed: 'Widgets'.]!
Item was removed: - ----- Method: StandardScriptingSystem class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: ScriptingSystem] !
Item was removed: - ----- Method: StringButtonMorph>>adaptToWorld: (in category 'e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - target := target adaptedToWorld: aWorld.!
Item was removed: - ----- Method: TabbedPalette>>becomeStandardPalette (in category 'misc menu items') ----- - becomeStandardPalette - self presenter standardPalette: self!
Item was removed: - ----- Method: TheWorldMenu>>adaptToWorld: (in category '*MorphicExtras-mechanics') ----- - adaptToWorld: aWorld - - myWorld := aWorld. - myProject := nil. "figure it out if and when needed. maybe make it easier to find" - myHand := aWorld primaryHand.!
Item was removed: - ----- Method: ThreePhaseButtonMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - self target: (target adaptedToWorld: aWorld).!
Item was removed: - ----- Method: ThumbnailMorph>>isEtoyReadout (in category 'scripting') ----- - isEtoyReadout - "Answer whether the receiver can serve as an etoy readout" - - ^ true!
Item was removed: - MorphicModel subclass: #TwoWayScrollPane - instanceVariableNames: 'getMenuSelector getMenuTitleSelector xScrollBar yScrollBar scroller' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Obsolete'! - - !TwoWayScrollPane commentStamp: '<historical>' prior: 0! - TwoWayScrollPane is now obsolete. You should be able to use ScrollPane to do both vertical and horizontal scrolling. - - As an example, see Morph>>inATwoWayScrollPane and change the first line to create a ScrollPane instead of a TwoWayScrollPane. It will still work. - - (EllipseMorph new extent: 200@150) inATwoWayScrollPane openInWorld - - Note that user preferences for ScrollPane may be geared toward text scrolling, so that the horizontal scrollbar may be hidden when not needed, while the vertical scrollbar is always shown. Use ScrollPane>>alwaysShowHScrollbar: or its variants to adjust this if you want the vertical & horizontal scrollbars to be shown consistently. - !
Item was removed: - ----- Method: TwoWayScrollPane class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "OK to instantiate" - ^ true!
Item was removed: - ----- Method: TwoWayScrollPane>>colorForInsets (in category 'accessing') ----- - colorForInsets - "My submorphs use the surrounding color" - owner notNil and: - [ owner color isColor ifTrue: [ ^ owner color ] ]. - ^ Color white!
Item was removed: - ----- Method: TwoWayScrollPane>>containsPoint: (in category 'geometry testing') ----- - containsPoint: aPoint - (super containsPoint: aPoint) ifTrue: [^ true]. - "Also include scrollbar when it is extended..." - "used to handle retractable scrolbar" - ^ false!
Item was removed: - ----- Method: TwoWayScrollPane>>createScrollBarNamed: (in category 'initialization') ----- - createScrollBarNamed: aString - "creates a scroll bar named as aString" - | result | - result := ScrollBar new model: self slotName: aString. - result borderStyle: (BorderStyle inset width: 2). - ^ result!
Item was removed: - ----- Method: TwoWayScrollPane>>createScroller (in category 'initialization') ----- - createScroller - "create a scroller" - | result | - result := TransformMorph new color: Color transparent. - result offset: 0 @ 0. - ^ result!
Item was removed: - ----- Method: TwoWayScrollPane>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - ^ Color transparent!
Item was removed: - ----- Method: TwoWayScrollPane>>defaultBorderStyle (in category 'initialization') ----- - defaultBorderStyle - ^ BorderStyle inset!
Item was removed: - ----- Method: TwoWayScrollPane>>doLayoutIn: (in category 'layout') ----- - doLayoutIn: layoutBounds - "layout has changed. update scroll deltas or whatever else" - - (owner notNil and: [owner hasProperty: #autoFitContents]) - ifTrue: [self fitContents]. - super doLayoutIn: layoutBounds.!
Item was removed: - ----- Method: TwoWayScrollPane>>extent: (in category 'geometry') ----- - extent: newExtent - bounds extent = newExtent ifTrue: [^ self]. - super extent: (newExtent max: 36@32). - self resizeScrollBar; resizeScroller; setScrollDeltas. - !
Item was removed: - ----- Method: TwoWayScrollPane>>fitContents (in category 'layout') ----- - fitContents - "Adjust my size to fit my contents reasonably snugly" - - self extent: scroller submorphBounds extent - + (yScrollBar width @ xScrollBar height) - + (self borderWidth*2) - !
Item was removed: - ----- Method: TwoWayScrollPane>>getMenu: (in category 'menu') ----- - getMenu: shiftKeyState - "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." - - | menu aMenu aTitle | - getMenuSelector isNil ifTrue: [^nil]. - menu := MenuMorph new defaultTarget: model. - aTitle := getMenuTitleSelector - ifNotNil: [model perform: getMenuTitleSelector]. - getMenuSelector numArgs = 1 - ifTrue: - [aMenu := model perform: getMenuSelector with: menu. - aTitle ifNotNil: [aMenu addTitle: aTitle]. - ^aMenu]. - getMenuSelector numArgs = 2 - ifTrue: - [aMenu := model - perform: getMenuSelector - with: menu - with: shiftKeyState. - aTitle ifNotNil: [aMenu addTitle: aTitle]. - ^aMenu]. - ^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'!
Item was removed: - ----- Method: TwoWayScrollPane>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^ true!
Item was removed: - ----- Method: TwoWayScrollPane>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - ^ true!
Item was removed: - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar (in category 'retractable scroll bar') ----- - hideOrShowScrollBar - - ^self "we don't support retractable at the moment"!
Item was removed: - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar:forRange: (in category 'retractable scroll bar') ----- - hideOrShowScrollBar: scrollBar forRange: range - - (self hasProperty: #hideUnneededScrollbars) ifFalse: [^ self]. - (submorphs includes: scrollBar) - ifTrue: [range <= 0 ifTrue: [scrollBar model: nil; delete]] - ifFalse: [range > 0 ifTrue: [scrollBar model: self. self resizeScrollBar; addMorph: scrollBar]] - !
Item was removed: - ----- Method: TwoWayScrollPane>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self addMorph: (yScrollBar := self createScrollBarNamed: 'yScrollBar'); - addMorph: (xScrollBar := self createScrollBarNamed: 'xScrollBar'); - addMorph: (scroller := self createScroller). - "" - self extent: 150 @ 120!
Item was removed: - ----- Method: TwoWayScrollPane>>keyStroke: (in category 'event handling') ----- - keyStroke: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - - scroller submorphs last keyStroke: evt!
Item was removed: - ----- Method: TwoWayScrollPane>>leftOrRight (in category 'menu') ----- - leftOrRight "Change scroll bar location" - - "used to handle left vs right scrollbar"!
Item was removed: - ----- Method: TwoWayScrollPane>>leftoverScrollRange (in category 'geometry') ----- - leftoverScrollRange - "Return the entire scrolling range minus the currently viewed area." - ^ self totalScrollRange - (self innerBounds extent * 3 // 4) max: 0@0 - !
Item was removed: - ----- Method: TwoWayScrollPane>>menuSelector: (in category 'menu') ----- - menuSelector: aSelector - getMenuSelector := aSelector!
Item was removed: - ----- Method: TwoWayScrollPane>>menuTitleSelector: (in category 'menu') ----- - menuTitleSelector: aSelector - getMenuTitleSelector := aSelector!
Item was removed: - ----- Method: TwoWayScrollPane>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - evt yellowButtonPressed "First check for option (menu) click" - ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self))]!
Item was removed: - ----- Method: TwoWayScrollPane>>mouseEnter: (in category 'event handling') ----- - mouseEnter: event - - "used to handle retractable scrolbar"!
Item was removed: - ----- Method: TwoWayScrollPane>>mouseLeave: (in category 'event handling') ----- - mouseLeave: event - - "used to handle retractable scrolbar"!
Item was removed: - ----- Method: TwoWayScrollPane>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]!
Item was removed: - ----- Method: TwoWayScrollPane>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]!
Item was removed: - ----- Method: TwoWayScrollPane>>rejectsEvent: (in category 'events-processing') ----- - rejectsEvent: anEvent - - scroller submorphs isEmpty ifTrue: [^true]. "something messed up here" - scroller firstSubmorph isSyntaxMorph ifTrue: [^ super rejectsEvent: anEvent]. - ^self visible not "ignore locked status"!
Item was removed: - ----- Method: TwoWayScrollPane>>resizeScrollBar (in category 'geometry') ----- - resizeScrollBar - "used to handle left vs right scrollbar" - yScrollBar bounds: (bounds topLeft extent: 16 @ (bounds height - 16)). - xScrollBar bounds: ((bounds left + 16) @ (bounds bottom - 16) extent: (bounds width - 16) @ 16). - !
Item was removed: - ----- Method: TwoWayScrollPane>>resizeScroller (in category 'geometry') ----- - resizeScroller - | inner | - "used to handle left vs right scrollbar" - inner := self innerBounds. - scroller bounds: (inner topLeft + (yScrollBar width@0) corner: (inner bottomRight - (0@xScrollBar height)))!
Item was removed: - ----- Method: TwoWayScrollPane>>retractableOrNot (in category 'menu') ----- - retractableOrNot "Change scroll bar operation" - - "used to handle retractable scrolbar"!
Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarFills: (in category 'geometry') ----- - scrollBarFills: aRectangle - "Return true if a flop-out scrollbar fills the rectangle" - "used to handle retractable scrolbar" - ^ false!
Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - scrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed!
Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarOnLeft: (in category 'menu') ----- - scrollBarOnLeft: aBoolean - - "used to handle left vs right scrollbar"!
Item was removed: - ----- Method: TwoWayScrollPane>>scrollBy: (in category 'geometry') ----- - scrollBy: delta - "Move the contents in the direction delta." - "For now, delta is assumed to have a zero x-component. Used by scrollIntoView:" - | r newOffset | - - newOffset := (scroller offset - delta max: 0@0) min: self leftoverScrollRange. - scroller offset: newOffset. - - r := self leftoverScrollRange. - r y = 0 - ifTrue: [yScrollBar value: 0.0] - ifFalse: [yScrollBar value: newOffset y asFloat / r y]. - r x = 0 - ifTrue: [xScrollBar value: 0.0] - ifFalse: [xScrollBar value: newOffset x asFloat / r x]. - !
Item was removed: - ----- Method: TwoWayScrollPane>>scrollIntoView:extra: (in category 'geometry') ----- - scrollIntoView: desiredRectangle extra: anumber - | shift | - - shift := desiredRectangle deltaToEnsureInOrCentered: ( - scroller offset extent: scroller bounds extent - ) extra: anumber. - shift = (0 @ 0) ifFalse: [self scrollBy: (0@0) - shift]. - !
Item was removed: - ----- Method: TwoWayScrollPane>>scroller (in category 'access') ----- - scroller - ^ scroller!
Item was removed: - ----- Method: TwoWayScrollPane>>setScrollDeltas (in category 'geometry') ----- - setScrollDeltas - | range scrollDelta totalRange innerBounds | - totalRange := self totalScrollRange ifNil: [^ self]. - range := self leftoverScrollRange. - innerBounds := self innerBounds. - scrollDelta := 10 @ 10. - - self hideOrShowScrollBar: xScrollBar - forRange: totalRange x - (innerBounds width - yScrollBar width). - range x <= 0 - ifTrue: [xScrollBar scrollDelta: 0.02 pageDelta: 0.2. - xScrollBar interval: 1.0] - ifFalse: [xScrollBar scrollDelta: (scrollDelta x / range x) asFloat - pageDelta: (innerBounds width - scrollDelta x / range x) asFloat. - xScrollBar interval: (innerBounds width - scrollDelta x / totalRange x) asFloat]. - - self hideOrShowScrollBar: yScrollBar - forRange: totalRange y - (innerBounds height - xScrollBar height). - range y <= 0 - ifTrue: [yScrollBar scrollDelta: 0.02 pageDelta: 0.2. - yScrollBar interval: 1.0] - ifFalse: [yScrollBar scrollDelta: (scrollDelta y / range y) asFloat - pageDelta: (innerBounds height - scrollDelta y / range y) asFloat. - yScrollBar interval: (innerBounds height - scrollDelta y / totalRange y) asFloat]!
Item was removed: - ----- Method: TwoWayScrollPane>>shiftedYellowButtonActivity (in category 'scroll bar events') ----- - shiftedYellowButtonActivity - ^ self yellowButtonActivity: true!
Item was removed: - ----- Method: TwoWayScrollPane>>totalScrollRange (in category 'geometry') ----- - totalScrollRange - - "Return the entire scrolling range." - ^ ((scroller localSubmorphBounds ifNil: [^nil]) encompass: 0@0) extent - - !
Item was removed: - ----- Method: TwoWayScrollPane>>unshiftedYellowButtonActivity (in category 'scroll bar events') ----- - unshiftedYellowButtonActivity - ^ self yellowButtonActivity: false!
Item was removed: - ----- Method: TwoWayScrollPane>>wantsSlot (in category 'access') ----- - wantsSlot - "For now do it the old way, until we sort this out" - ^ true!
Item was removed: - ----- Method: TwoWayScrollPane>>wantsYellowButtonMenu (in category 'menu') ----- - wantsYellowButtonMenu - "Answer true if the receiver wants a yellow button menu" - ^ getMenuSelector notNil!
Item was removed: - ----- Method: TwoWayScrollPane>>xScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - xScrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed!
Item was removed: - ----- Method: TwoWayScrollPane>>xScrollBarValue: (in category 'scroll bar events') ----- - xScrollBarValue: scrollValue - - "although there appear to be no senders, see Slider>>setValue:" - - scroller hasSubmorphs ifFalse: [^ self]. - scroller offset: self leftoverScrollRange x * scrollValue @ scroller offset y!
Item was removed: - ----- Method: TwoWayScrollPane>>xScrollerHeight (in category 'retractable scroll bar') ----- - xScrollerHeight - - (submorphs includes: xScrollBar) "Sorry the logic is reversed :( " - ifFalse: [^ 0 @ 0] "already included" - ifTrue: [^ 0 @ xScrollBar height] "leave space for it" - !
Item was removed: - ----- Method: TwoWayScrollPane>>yScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - yScrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed!
Item was removed: - ----- Method: TwoWayScrollPane>>yScrollBarValue: (in category 'scroll bar events') ----- - yScrollBarValue: scrollValue - - "although there appear to be no senders, see Slider>>setValue:" - - scroller hasSubmorphs ifFalse: [^ self]. - scroller offset: scroller offset x @ (self leftoverScrollRange y * scrollValue)!
Item was removed: - ----- Method: TwoWayScrollPane>>yellowButtonActivity: (in category 'scroll bar events') ----- - yellowButtonActivity: shiftKeyState - | menu | - (menu := self getMenu: shiftKeyState) ifNotNil: - [menu setInvokingView: self. - menu popUpEvent: self activeHand lastEvent in: self world]!
Item was removed: - ----- Method: UpdatingMenuItemMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - wordingProvider := wordingProvider adaptedToWorld: aWorld.!
Item was removed: - ----- Method: UpdatingRectangleMorph>>isEtoyReadout (in category 'accessing') ----- - isEtoyReadout - "Answer whether the receiver can serve as an etoy readout" - - ^ true!
Item was removed: - FlapTab subclass: #ViewerFlapTab - instanceVariableNames: 'scriptedPlayer' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Flaps'! - - !ViewerFlapTab commentStamp: 'kfr 10/28/2003 06:31' prior: 0! - ViewerFlapTab are flap tabs for etoy scripting viewers.!
Item was removed: - ----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'viewerFlapTab' translatedNoop!
Item was removed: - ----- Method: ViewerFlapTab class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "Not to be instantiated from the menu" - ^ false!
Item was removed: - ----- Method: ViewerFlapTab>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - "Add further items to the menu as appropriate. NB: Cannot call super here." - - aMenu add: 'flap color...' translated target: self action: #changeFlapColor. - aMenu addLine. - aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo. - aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior. - aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior. - aMenu addLine. - aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap. - - aMenu add: 'destroy this flap' translated action: #destroyFlap!
Item was removed: - ----- Method: ViewerFlapTab>>adjustPositionAfterHidingFlap (in category 'show & hide') ----- - adjustPositionAfterHidingFlap - "we add the width of flap itself to our referent, to reflect the actual width from the edge of the screen, including the space we leave for other flaps. see also ViewerFlapTab>>fitOnScreen" - self flag: #todo. - self referent width: self referent width + self width. - super adjustPositionAfterHidingFlap.!
Item was removed: - ----- Method: ViewerFlapTab>>allNonSubmorphMorphs (in category 'submorphs - accessing') ----- - allNonSubmorphMorphs - "Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy. Especially the non-showing pages in BookMorphs." - - ^ flapShowing - ifTrue: [#()] - ifFalse: [Array with: referent]!
Item was removed: - ----- Method: ViewerFlapTab>>changeCompactFlap (in category 'compact') ----- - changeCompactFlap - self makeFlapCompact: self isFlapCompact not.!
Item was removed: - ----- Method: ViewerFlapTab>>compactFlapString (in category 'compact') ----- - compactFlapString - ^ (self isFlapCompact - ifTrue: ['<on>compact flap'] - ifFalse: ['<off>']), 'compact flap' translated!
Item was removed: - ----- Method: ViewerFlapTab>>fitOnScreen (in category 'positioning') ----- - fitOnScreen - | constrainer | - super fitOnScreen. - "We want to leave a margin for the flaps on the side and for the global flaps at the top (like the Sugar navbar) so we reduce the referents top and its width. We undo this before hiding the flap in ViewerFlapTab>>adjustPositionAfterHidingFlap" - self flag: #todo. - constrainer := (owner ifNil: [self]) clearArea. - self flapShowing ifTrue: [ - Flaps globalFlapTabsIfAny - do: [:each | - (each edgeToAdhereTo = #top and: [each bottom > self referent top]) - ifTrue: [self referent top: each bottom]. - (each edgeToAdhereTo = #top and: [each bottom > self top]) - ifTrue: [self top: each bottom]]. - self referent width: constrainer right - self width - self right].!
Item was removed: - ----- Method: ViewerFlapTab>>graphicalMorphForTab (in category 'menu') ----- - graphicalMorphForTab - "Answer a graphical morph to serve as my tab's display" - - ^ ThumbnailMorph new objectToView: scriptedPlayer viewSelector: #graphicForViewerTab!
Item was removed: - ----- Method: ViewerFlapTab>>hibernate (in category 'transition') ----- - hibernate - "drop my viewer to save space when writing to the disk." - - referent submorphs do: - [:m | (m isViewer) ifTrue: [m delete]]!
Item was removed: - ----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') ----- - initializeFor: aPlayer topAt: aTop - - scriptedPlayer := aPlayer. - self useGraphicalTab. - self top: aTop!
Item was removed: - ----- Method: ViewerFlapTab>>isCurrentlyGraphical (in category 'accessing') ----- - isCurrentlyGraphical - ^ true!
Item was removed: - ----- Method: ViewerFlapTab>>isFlapCompact (in category 'compact') ----- - isFlapCompact - "Return true if the referent of the receiver represents a 'compact' flap" - referent layoutPolicy ifNil:[^false]. - referent layoutPolicy isTableLayout ifFalse:[^false]. - referent vResizing == #shrinkWrap ifFalse:[^false]. - ^true!
Item was removed: - ----- Method: ViewerFlapTab>>makeFlapCompact: (in category 'compact') ----- - makeFlapCompact: aBool - "Return true if the referent of the receiver represents a 'compact' flap" - aBool ifTrue:[ - referent - layoutPolicy: TableLayout new; - vResizing: #shrinkWrap; - useRoundedCorners. - ] ifFalse:[ - referent - layoutPolicy: nil; - vResizing: #rigid; - useSquareCorners. - ].!
Item was removed: - ----- Method: ViewerFlapTab>>scriptedPlayer (in category 'access') ----- - scriptedPlayer - ^ scriptedPlayer!
Item was removed: - ----- Method: ViewerFlapTab>>unhibernate (in category 'transition') ----- - unhibernate - "recreate my viewer" - - | wasShowing viewer | - referent ifNotNil: [referent isViewer ifTrue: [^self]]. - wasShowing := flapShowing. - "guard against not-quite-player-players" - viewer := ((scriptedPlayer respondsTo: #costume) - and: [scriptedPlayer costume isMorph]) - ifTrue: [self presenter viewMorph: scriptedPlayer costume] - ifFalse: [self presenter viewObjectDirectly: scriptedPlayer]. - wasShowing ifFalse: [self hideFlap]. - ^viewer!
Item was removed: - ----- Method: WebCamMorph class>>additionsToViewerCategories (in category 'scripting') ----- - additionsToViewerCategories - "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." - ^ #( - - (#'camera' ( - (slot resolution '160x120, 320x240, 640x480 or 1280x960' - WebCamResolution readWrite Player getWebCamResolution Player setWebCamResolution:) - (slot orientation 'Natural (mirrored) or navtive (as from the camera' - WebCamOrientation readWrite Player getWebCamOrientation Player setWebCamOrientation:) - (slot cameraIsOn 'Whether the camera is on/off' Boolean readWrite Player getWebCamIsOn Player setWebCamIsOn:) - (slot useFrameSize 'Resize the player to match the camera''s frame size' - Boolean readWrite Player getUseFrameSize Player setUseFrameSize:) - (slot lastFrame 'A player with the last frame' Player readOnly Player getLastFrame unused unused) - (slot showFPS 'Whether to show the samera''s frames per second' Boolean readWrite Player getShowFPS Player setShowFPS:) - )) - ) - !
packages@lists.squeakfoundation.org