Changeset: Eliminating global state from Morphic

Wow Christoph, this is great work :-)

I cannot review in detail now but I loaded your changes into my image
and all is good so far.

I am going to strongly urge that we get this into trunk as soon as we
can, but I also want to challenge us all to see if we can eliminate the
bindings entirely from the Environment. In the case of the global World
variable, we were able to make it an instance variable in Project. It is
possible that we could do something similar with the other global bindings.

I is really GREAT to see this, thank you for taking it on :-)

Dave


On Sat, Sep 12, 2020 at 02:37:59PM +0000, Thiede, Christoph wrote:
> Hi all,
>
>
> recent discussions have shown just another time that in spite of its overall modular and object-oriented design, the Morphic System still incorporates a number of global state variables that impede modular processes in some situations. For instance, running or even debugging any form of UI simulation code in a background process was likely to cause problems because, via the global state variables, two planned-to-be-independent projects undesirably shared their events, hands, and worlds. Concrete systems suffering from this global state include various UI tests executed using AutoTDD [1], or the screenshot generation framework for Squeak by Example [2] which I had the joy to co-develop.
>
>
> The attached changeset tackles these issues for all packages in the Trunk by wrapping the following three globals into process-local accessors: ActiveEvent, ActiveHand, and ActiveWorld.
>
> As the changeset contains patches of over 300 selectors in more than 100 classes every single line of which you probably will not feel like reading in detail, here is a summary of all changes I applied:
>
>   *   Added #activeEvent[:], #activeHand[:], and #activeWorld[:] process-local accessors on Object as Morphic-Kernel extensions. The actual values are stored directly on the active process in the manner of a ProcessSpecificVariable. For backward compatibility, the global variables are still kept up to date here.
>   *   Added #activateHand:during: and #activateWorld:during: as dynamic scope setters on Object as Morphic-Kernel extensions.
>   *   Replaced all references to ActiveEvent, ActiveHand, and ActiveWorld by "self activeEvent", "self activeHand", and "self activeWorld" accordingly. I also spent some time reflecting in which cases you actually would like to receive a possible nil value and ended up with changing the most senders that are not involved into the critical event processing logic into their "#current*" equivalents (#currentEvent, #currentHand, and #currentWorld) which already guarantee to return non-nil values. In the case of #currentWorld, I also replaced many senders with "Project current world" that were not invoked in an event-related context.
>   *   While skimming over all the implementations, I also applied a number of really minor refactorings: improve multilingual support by adding some "#translated"s to user strings, remove nil checks that could never be reached, and reformat some of the very hardest to read methods I came across.
>
>
> Please review! I'm looking forward to eliminating these unnecessary artifacts of global state and making Squeak an even more purely object-oriented and modular system by merging these changes into the Trunk.
>
>
> Best,
>
> Christoph
>
>
> [1] https://github.com/hpi-swa-teaching/AutoTDD
>
> [2] https://github.com/codeZeilen/SqueakByExample-english/

Content-Description: Hide activeVariables.2.cs
> 'From Squeak6.0alpha of 6 September 2020 [latest update: #19838] on 12 September 2020 at 4:29:53 pm'!

!Object methodsFor: 'user interface' stamp: 'ct 9/12/2020 14:13'!
launchPartVia: aSelector label: aString
        "Obtain a morph by sending aSelector to self, and attach it to the morphic hand.  This provides a general protocol for parts bins"

        | aMorph |
        aMorph := self perform: aSelector.
        aMorph setNameTo: (Project current world unusedMorphNameLike: aString).
        aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
        aMorph openInHand.! !

!Object methodsFor: '*Protocols' stamp: 'ct 9/12/2020 14:14'!
haveFullProtocolBrowsedShowingSelector: aSelector
        "Open up a Lexicon on the receiver, having it open up showing aSelector, which may be nil"
        "(2@3) haveFullProtocolBrowsed"

        | aBrowser |
        aBrowser := (Smalltalk at: #InstanceBrowser ifAbsent: [^ nil]) new
                useVocabulary: Vocabulary fullVocabulary.
        aBrowser
                openOnObject: self
                inWorld: Project current world
                showingSelector: aSelector! !

!Object methodsFor: '*Etoys-Squeakland-user interface' stamp: 'ct 9/12/2020 14:13'!
launchPartOffsetVia: aSelector label: aString
        "Obtain a morph by sending aSelector to self, and attach it to the morphic hand.  This provides a general protocol for parts bins.  This variant makes the morph offset from the hand position by an amount suitable for tile-scripting in some circumstances."

        | aMorph |
        aMorph := self perform: aSelector.
        aMorph setNameTo: (Project current world unusedMorphNameLike: aString).
        aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
        aMorph setProperty: #offsetForAttachingToHand toValue: 10@ -10.
        aMorph fullBounds.
        aMorph openInHand! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:45'!
activateHand: aHand during: aBlock

        | priorHand |
        priorHand := self activeHand.
        self activeHand: aHand.
        ^ aBlock ensure: [
                self activeHand: priorHand]! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 16:12'!
activateWorld: aWorld during: aBlock

        | priorWorld |
        priorWorld := self activeWorld.
        self activeWorld: aWorld.
        ^ aBlock ensure: [
                self activeWorld: priorWorld]! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:53'!
activeEvent
        "Answer the active morphic event for the current process, or nil if no event is active.
        Private!! Usually, you will want to send #currentEvent instead."

        ^ Processor activeProcess environmentAt: #ActiveEvent ifAbsent: [nil]! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:53'!
activeEvent: anEvent
        "Set the active morphic event for the current process. Can be nil."

        Processor activeProcess environmentAt: #ActiveEvent put: anEvent.
       
        "for backword compatibility <6.0"
        ActiveEvent := anEvent.! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:52'!
activeHand
        "Answer the active HandMorph for the current process, or nil if no hand is active.
        Private!! Usually, you will want to send #currentHand instead."

        ^ Processor activeProcess environmentAt: #ActiveHand ifAbsent: [nil]! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:51'!
activeHand: aHand
        "Set the active HandMorph for the current process. Can be nil."

        Processor activeProcess environmentAt: #ActiveHand put: aHand.
       
        "for backword compatibility <6.0"
        ActiveHand := aHand.! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:52'!
activeWorld
        "Answer the active morphic world for the current process, or nil if no world is active.
        Private!! Usually, you will want to send #currentWorld instead."

        ^ Processor activeProcess environmentAt: #ActiveWorld ifAbsent: [nil]! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:52'!
activeWorld: aWorld
        "Set the active morphic world for the current process. Can be nil."

        Processor activeProcess environmentAt: #ActiveWorld put: aWorld.
       
        "for backword compatibility <6.0"
        ActiveWorld := aWorld.! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:33'!
currentEvent
        "Answer the current Morphic event.  This method never returns nil."
       
        ^ self activeEvent ifNil: [self currentHand lastEvent]! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:17'!
currentHand
        "Return a usable HandMorph -- the one associated with the object's current environment.  This method will always return a hand, even if it has to conjure one up as a last resort.  If a particular hand is actually handling events at the moment (such as a remote hand or a ghost hand), it will be returned."

        ^ self activeHand ifNil: [self currentWorld primaryHand]! !

!Object methodsFor: '*Morphic-Kernel' stamp: 'ct 9/12/2020 15:01'!
currentWorld
        "Answer a morphic world that is the current UI focus."

        ^ self activeWorld ifNil: [Project current world]! !


!BrowseTest methodsFor: 'private' stamp: 'ct 9/11/2020 18:05'!
currentBrowsers

        ^ (Project current world submorphsSatisfying: [:each |
                (each isKindOf: SystemWindow)
                        and: [each model isKindOf: Browser]]) asSet! !

!BrowseTest methodsFor: 'private' stamp: 'ct 9/11/2020 18:04'!
currentHierarchyBrowsers

        ^ (Project current world submorphsSatisfying: [:each |
                (each isKindOf: SystemWindow)
                        and: [each model isKindOf: HierarchyBrowser]]) asSet! !


!FillInTheBlank class methodsFor: 'instance creation' stamp: 'ct 9/12/2020 14:40'!
request: queryString
        "Create an instance of me whose question is queryString. Invoke it
        centered at the cursor, and answer the string the user accepts. Answer
        the empty string if the user cancels."

        "UIManager default request: 'Your name?'"

        ^ self
                request: queryString
                initialAnswer: ''
                centerAt: (self currentHand ifNil: [Sensor]) cursorPoint! !

!FillInTheBlank class methodsFor: 'instance creation' stamp: 'ct 9/12/2020 14:40'!
request: queryString initialAnswer: defaultAnswer
        "Create an instance of me whose question is queryString with the given
        initial answer. Invoke it centered at the given point, and answer the
        string the user accepts. Answer the empty string if the user cancels."

        "UIManager default
                request: 'What is your favorite color?'
                initialAnswer: 'red, no blue. Ahhh!!'"

        ^ self
                request: queryString
                initialAnswer: defaultAnswer
                centerAt: (self currentHand ifNil: [Sensor]) cursorPoint! !

!FillInTheBlank class methodsFor: 'instance creation' stamp: 'ct 9/12/2020 14:41'!
request: queryString initialAnswer: defaultAnswer onCancelReturn: cancelResponse

        ^ self
                request: queryString
                initialAnswer: defaultAnswer
                centerAt: (self currentHand ifNil: [Sensor]) cursorPoint
                onCancelReturn: cancelResponse! !


!Flaps class methodsFor: 'construction support' stamp: 'ct 9/11/2020 20:09'!
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"! !

!Flaps class methodsFor: 'menu commands' stamp: 'ct 9/11/2020 19:49'!
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.
        self initializeFlapsQuads.
        SharedFlapsAllowed := false.
        Smalltalk isMorphic ifTrue: [
                Project current world
                        restoreMorphicDisplay;
                        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 support' stamp: 'ct 9/11/2020 20:08'!
enableGlobalFlaps
        "Start using global flaps, given that they were not present."

        Cursor wait showWhile: [
                SharedFlapsAllowed := true.
                self globalFlapTabs. "This will create them"
                Smalltalk isMorphic ifTrue: [
                        Project current world addGlobalFlaps.
                        self doAutomaticLayoutOfFlapsIfAppropriate.
                        FlapTab allInstancesDo: [:tab | tab computeEdgeFraction].
                        Project current world reformulateUpdatingMenus]]! !

!Flaps class methodsFor: 'menu support' stamp: 'ct 9/11/2020 20:09'!
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].! !

!Flaps class methodsFor: 'miscellaneous' stamp: 'ct 9/11/2020 20:08'!
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.
                        Project current world addGlobalFlaps].

        self doAutomaticLayoutOfFlapsIfAppropriate.
        Project current assureNavigatorPresenceMatchesPreference.
        Project current world reformulateUpdatingMenus.! !

!Flaps class methodsFor: 'miscellaneous' stamp: 'ct 9/11/2020 20:09'!
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.
        Project current world addGlobalFlaps.
        self doAutomaticLayoutOfFlapsIfAppropriate.
        Project current assureNavigatorPresenceMatchesPreference.       ! !

!Flaps class methodsFor: 'new flap' stamp: 'ct 9/11/2020 17:58'!
addLocalFlap

        ^ self addLocalFlap: self currentEvent! !

!Flaps class methodsFor: 'new flap' stamp: 'ct 9/11/2020 17:59'!
addLocalFlap: anEvent
        "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."

        | title edge |
        edge := self askForEdgeOfNewFlap.
        edge ifNil: [^ self].
       
        title := UIManager default request: 'Wording for this flap:' translated initialAnswer: 'Flap' translated.
        title isEmptyOrNil ifTrue: [^ self].
       
        ^ self addLocalFlap: anEvent titled: title onEdge: edge! !

!Flaps class methodsFor: 'new flap' stamp: 'ct 9/11/2020 17:59'!
addLocalFlap: anEvent titled: title onEdge: edge

        | flapTab menu world |
        flapTab := self newFlapTitled: title onEdge: edge.
        (world := anEvent hand world) addMorphFront: flapTab.
        flapTab adaptToWorld: world.
        menu := flapTab buildHandleMenu: anEvent hand.
        flapTab addTitleForHaloMenu: menu.
        flapTab computeEdgeFraction.
        menu popUpEvent: anEvent in: world.! !

!Flaps class methodsFor: 'shared flaps' stamp: 'ct 9/11/2020 20:09'!
enableOnlyGlobalFlapsWithIDs: survivorList
        "In the current project, suppress all global flaps other than those with ids in the survivorList"

        self globalFlapTabsIfAny do: [:flapTab |
                (survivorList includes: flapTab flapID)
                        ifTrue: [self enableGlobalFlapWithID: flapTab flapID]
                        ifFalse: [self disableGlobalFlapWithID: flapTab flapID]].
        Project current world addGlobalFlaps

        "Flaps enableOnlyGlobalFlapsWithIDs: #('Supplies')"! !

!Flaps class methodsFor: 'shared flaps' stamp: 'ct 9/11/2020 20:09'!
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 := OrderedCollection new.
        flapsOnRight := OrderedCollection new.
       
        flapList do: [:fl |
                (idList includes: fl flapID)
                        ifTrue: [ flapsOnLeft addLast: fl ]
                        ifFalse: [ flapsOnRight addLast: fl ] ].

        leftX := Project current world width - 15.

        flapsOnRight
                sort: [:f1 :f2 | f1 left > f2 left];
                do: [:aFlapTab |
                        aFlapTab right: leftX - 3.
                        leftX := aFlapTab left].

        leftX := Project current world left.

        flapsOnLeft
                sort: [:f1 :f2 | f1 left > f2 left];
                do: [:aFlapTab |
                        aFlapTab left: leftX + 3.
                        leftX := aFlapTab right].

        flapList do:
                [:ft | ft computeEdgeFraction.
                ft flapID = 'Navigator' translated ifTrue:
                        [ft referent left: (ft center x - (ft referent width//2) max: 0)]]! !

!Flaps class methodsFor: '*Etoys-Squeakland-predefined flaps' stamp: 'ct 9/12/2020 14:29'!
newSuppliesFlapFromQuads: quads positioning: positionSymbol withPreviousEntries: aCollection
        "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen.  Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."

        |  aFlapTab aStrip aWidth sugarNavigator |
        sugarNavigator := SugarNavigatorBar showSugarNavigator.
        aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color gray muchLighter from: quads withPreviousEntries: aCollection.
        self twiddleSuppliesButtonsIn: aStrip.
        aFlapTab := (sugarNavigator ifTrue: [SolidSugarSuppliesTab] ifFalse: [FlapTab]) new referent: aStrip beSticky.
        aFlapTab setName: 'Supplies' translated edge: (sugarNavigator ifTrue: [#top] ifFalse: [#bottom]) color: Color red lighter.
        aFlapTab position: (0 @ Project current world sugarAllowance).
        aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
        aFlapTab applyThickness: 20.

        aWidth := self currentWorld width.
        aStrip extent: aWidth @ (76 * (1 + (1350 // aWidth))).
        aStrip beFlap: true.
        aStrip autoLineLayout: true.
        aStrip vResizeToFit: true.
        sugarNavigator
                ifTrue: [
                        aFlapTab useSolidTab.
                        aFlapTab height: 20; color:  (Color r: 0.804 g: 0.804 b: 0.804)]
                ifFalse: [
                        aFlapTab color:  Color red lighter].
       
        ^ aFlapTab

        "Flaps replaceGlobalFlapwithID: 'Supplies' translated"! !


!Form class methodsFor: '*Morphic-examples' stamp: 'ct 9/11/2020 19:49'!
exampleColorSees
        "Form exampleColorSees"
        "First column as above shows the sneaky red/yellow pirate sneaking up on the blue/peach galleon.
        Second column shows the 1bpp made from the red/yellow/transparent - white -> ignore this, black -> test this
        Third shows the hit area - where red touches blue - superimposed on the original scene.
        Fourth column is the tally of hits via the old algorithm
        Last column shows the tally of hits via the new prim"  
               
        | formA formB maskA  offset tally map intersection left top dCanvas sensitiveColor soughtColor index |
        formA := formB := maskA := offset := tally := map := intersection :=  nil. "just to shut up the compiler when testing"
        Project current world restoreMorphicDisplay; doOneCycle.
       
        sensitiveColor := Color red.
        soughtColor := Color blue.

        top := 50.
        dCanvas := FormCanvas on: Display.
        -50 to: 80 by: 10 do:[:p|
                offset:= p@0. "vary this to check different states"
                left := 10.

                formA := (Form extent: 100@50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths".
                formB := Form extent: 100@50 depth: 32.

                "make a red square in the middle of the form"
                (FormCanvas on: formA) fillRectangle: (25@25 extent: 50@5) fillStyle: sensitiveColor.
                (FormCanvas on: formA) fillRectangle: (25@30 extent: 50@5) fillStyle: Color transparent.
                (FormCanvas on: formA) fillRectangle: (25@35 extent: 50@50) fillStyle: Color yellow.
                "formA displayOn: Display at: left@top rule: Form paint.
                dCanvas frameRectangle: (left@top extent: formA extent) width:2 color: Color green.
                left := left + 150."

                "make a blue block on the right half of the form"
                (FormCanvas on: formB) fillRectangle: (50@0 extent: 50@100) fillStyle: soughtColor.
                (FormCanvas on: formB) fillRectangle: (60@0 extent: 10@100) fillStyle: Color palePeach.
                "formB displayOn: Display at: left@top rule: Form paint.
                dCanvas frameRectangle: (left@top extent: formA extent) width:2 color: Color green.
                left := left + 150."

                intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox).

                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 150.
       
                maskA := Form extent: intersection extent depth: 1.

                map := Bitmap new: (1 bitShift: (formA depth min: 15)).
                map at: (index := sensitiveColor indexInMap: map) put: 1.

                maskA copyBits: (intersection translateBy:  offset negated) from: formA at: 0@0 colorMap: map.
                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                maskA displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.        left := left + 150.

                "intersect world pixels of the color we're looking for with sensitive pixels mask"
                map at: index put: 0.  "clear map and reuse it"
                map at: (soughtColor indexInMap: map) put: 1.

                maskA
                  copyBits: intersection
                        from: formB at: 0@0 clippingBox: formB boundingBox
                        rule: Form and
                        fillColor: nil
                        map: map.

                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                maskA displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 170.
               
                (maskA tallyPixelValues at: 2) asString asDisplayText displayOn: Display at: left@(top +20).
                left := left + 70.
               
                "now try using the new primitive"
                tally := (BitBlt
                        destForm: formB
                        sourceForm: formA
                        fillColor: nil
                        combinationRule: 3 "really ought to work with nil but prim code checks"
                        destOrigin: intersection origin
                        sourceOrigin: (offset negated max: 0@0)
                        extent: intersection extent
                        clipRect: intersection)
                                primCompareColor: ((sensitiveColor pixelValueForDepth: formA depth) ) to: ((soughtColor pixelValueForDepth: formB depth) ) test: (Form compareMatchColor bitOr: Form compareTallyFlag).
                tally  asString asDisplayText displayOn: Display at: left@(top +20).
                top:= top + 60]! !

!Form class methodsFor: '*Morphic-examples' stamp: 'ct 9/11/2020 19:49'!
exampleTouchTest
        "Form exampleTouchTest"
        "Demonstrate the algorithm used in Scratch code to determine if a sprite's non-transparent pixels touch a
        non-transparent pixel of the background upon which it is displayed.
        First column shows a form with a red block in the midst of transparent area sneaking up on a form with a transparent LHS and blue RHS.   The green frame shows the intersection area.
        Second column shows in grey the part of the red that is within the intersection.
        Third column shows in black the blue that is within the intersection.
        Fourth column shows just the A touching B area.
        Fifth column is the tally of hits via the old algorithm
        Last column shows the tally of hits via the new prim"
        |formA formB maskA maskB offset tally map intersection left top dCanvas|
        formA := formB := maskA := maskB := offset := tally := map := intersection :=  nil. "just to shut up the compiler when testing"

        Project current world restoreMorphicDisplay; doOneCycle.

        top := 50.
        dCanvas := FormCanvas on: Display.
        -50 to: 80 by: 10 do:[:p|
                offset:= p@0. "vary this to check different states"
                left := 10.

                formA := Form extent: 100@50 depth: 32.
                formB := Form extent: 100@50 depth: 16.

                "make a red square in the middle of the form"
                (FormCanvas on: formA) fillRectangle: (25@25 extent: 50@5) fillStyle: Color yellow.
                (FormCanvas on: formA) fillRectangle: (25@30 extent: 50@5) fillStyle: Color transparent.
                (FormCanvas on: formA) fillRectangle: (25@35 extent: 50@50) fillStyle: Color red.
                "formA displayOn: Display at: left@top rule: Form paint.
                dCanvas frameRectangle: (left@top extent: formA extent) width:2 color: Color green.
                left := left + 150."

                "make a blue block on the right half of the form"
                (FormCanvas on: formB) fillRectangle: (50@0 extent: 50@100) fillStyle: Color blue.
                (FormCanvas on: formB) fillRectangle: (60@0 extent: 10@100) fillStyle: Color palePeach.
                "formB displayOn: Display at: left@top rule: Form paint.
                dCanvas frameRectangle: (left@top extent: formA extent) width:2 color: Color green.
                left := left + 150."

                intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox).

                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 150.

                maskA := Form extent: intersection extent depth: 2.
                formA displayOn: maskA at: offset  - intersection origin rule: Form paint.
                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                maskA displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 150.

                maskB := Form extent: intersection extent depth: 2.
                formB displayOn: maskB at: intersection origin negated rule: Form paint.
                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                maskB displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 150.

                map := Bitmap new: 4 withAll: 1.
                map at: 1 put: 0.  "transparent"

                maskA copyBits: maskA boundingBox from: maskA at: 0@0 colorMap: map.
                "maskA displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 150."

                maskB copyBits: maskB boundingBox from: maskB at: 0@0 colorMap: map.
                "maskB displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 150."

                maskB displayOn: maskA at: 0@0 rule: Form and.
                maskA displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 170.
               
                (maskA boundingBox area -( maskA tallyPixelValues at: 1)) asString asDisplayText displayOn: Display at: left@(top +20).
                left := left + 70.
               
                "now try using the new primitive"
                tally := (BitBlt
                        destForm: formB
                        sourceForm: formA
                        fillColor: nil
                        combinationRule: 3 "really ought to work with nil but prim code checks"
                        destOrigin: intersection origin
                        sourceOrigin: (offset negated max: 0@0)
                        extent: intersection extent
                        clipRect: intersection)
                                primCompareColor: ((Color transparent pixelValueForDepth: formA depth) bitAnd: 16rFFFFFF) to: ((Color transparent pixelValueForDepth: formB depth) bitAnd: 16rFFFFFF) test: (Form compareNotColorANotColorB bitOr: Form compareTallyFlag).
                tally  asString asDisplayText displayOn: Display at: left@(top +20).
                top:= top + 60]! !

!Form class methodsFor: '*Morphic-examples' stamp: 'ct 9/11/2020 19:49'!
exampleTouchingColor
        "Form exampleTouchingColor"
        "Demonstrate the algorithm used in Scratch code to determine if a sprite's non-transparent pixels touch a
        particular color pixel of the background upon which it is displayed.
        First column as above shows the sneaky red/yellow pirate sneaking up on the blue/peach galleon.
        Second column shows the 1bpp made from the red/yellow/transparent - white -> ignore this, black -> test this
        Third shows the hit area (black) superimposed on the original scene
        Fourth column is the tally of hits via the old algorithm
        Last column shows the tally of hits via the new prim"  
        |formA formB maskA  offset tally map intersection left top dCanvas ignoreColor soughtColor|
        formA := formB := maskA := offset := tally := map := intersection :=  nil. "just to shut up the compiler when testing"
        Project current world restoreMorphicDisplay; doOneCycle.

        ignoreColor := Color transparent.
        soughtColor := Color blue.

        top := 50.
        dCanvas := FormCanvas on: Display.
        -50 to: 80 by: 10 do:[:p|
                offset:= p@0. "vary this to check different states"
                left := 10.

                formA := (Form extent: 100@50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths".
                formB := Form extent: 100@50 depth: 32.

                "make a red square in the middle of the form"
                (FormCanvas on: formA) fillRectangle: (25@25 extent: 50@5) fillStyle: Color red.
                (FormCanvas on: formA) fillRectangle: (25@30 extent: 50@5) fillStyle: Color transparent.
                (FormCanvas on: formA) fillRectangle: (25@35 extent: 50@50) fillStyle: Color yellow.
                "formA displayOn: Display at: left@top rule: Form paint.
                dCanvas frameRectangle: (left@top extent: formA extent) width:2 color: Color green.
                left := left + 150."

                "make a blue block on the right half of the form"
                (FormCanvas on: formB) fillRectangle: (50@0 extent: 50@100) fillStyle: soughtColor.
                (FormCanvas on: formB) fillRectangle: (60@0 extent: 10@100) fillStyle: Color palePeach.
                "formB displayOn: Display at: left@top rule: Form paint.
                dCanvas frameRectangle: (left@top extent: formA extent) width:2 color: Color green.
                left := left + 150."

                intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox).

                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 150.
       
                maskA := Form extent: intersection extent depth: 1.

                map := Bitmap new: (1 bitShift: (formA depth min: 15)).
                map atAllPut: 1.
                map at: ( ignoreColor indexInMap: map) put: 0.

                maskA copyBits: (intersection translateBy:  offset negated) from: formA at: 0@0 colorMap: map.
                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                maskA displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.        left := left + 150.

                "intersect world pixels of the color we're looking for with sensitive pixels mask"
                map atAllPut: 0.  "clear map and reuse it"
                map at: (soughtColor indexInMap: map) put: 1.

                maskA
                  copyBits: intersection
                        from: formB at: 0@0 clippingBox: formB boundingBox
                        rule: Form and
                        fillColor: nil
                        map: map.

                formB displayOn: Display at: left@top rule: Form paint.
                formA displayOn: Display at: (left@top) + offset rule: Form paint.
                maskA displayOn: Display at: (left@top) + intersection origin rule: Form paint.
                dCanvas frameRectangle: (intersection translateBy: left@top) width:2 color: Color green.
                left := left + 170.
               
                (maskA tallyPixelValues at: 2) asString asDisplayText displayOn: Display at: left@(top +20).
                left := left + 70.
               
                "now try using the new primitive"
                tally := (BitBlt
                        destForm: formB
                        sourceForm: formA
                        fillColor: nil
                        combinationRule: 3 "really ought to work with nil but prim code checks"
                        destOrigin: intersection origin
                        sourceOrigin: (offset negated max: 0@0)
                        extent: intersection extent
                        clipRect: intersection)
                                primCompareColor: ((ignoreColor pixelValueForDepth: formA depth) bitAnd: 16rFFFFFF) to: ((soughtColor pixelValueForDepth: formB depth) bitAnd: 16rFFFFFF) test: (Form compareNotColorAMatchColorB bitOr: Form compareTallyFlag).
                tally  asString asDisplayText displayOn: Display at: left@(top +20).
                top:= top + 60]! !


!HandBugs methodsFor: 'tests' stamp: 'ct 9/12/2020 14:41'!
testTargetPoint
"self new testTargetPoint"
"self run: #testTargetPoint"

        "This should not throw an exception."
        self currentHand targetPoint

! !


!Lexicon methodsFor: 'menu commands' stamp: 'ct 9/11/2020 20:16'!
offerMenu
        "Offer a menu to the user, in response to the hitting of the menu button on the tool pane"

        | aMenu |
        aMenu := MenuMorph new defaultTarget: self.
        aMenu addTitle: 'Lexicon' translated.
        aMenu addStayUpItem.
        aMenu addTranslatedList: #(
                ('vocabulary...'                         chooseVocabulary)
                ('what to show...'                      offerWhatToShowMenu)
                -
                ('inst var refs (here)'         setLocalInstVarRefs)
                ('inst var assignments (here)'          setLocalInstVarDefs)
                ('class var refs (here)'                setLocalClassVarRefs)
                -
                ('navigate to a sender...'       navigateToASender)
                ('recent...'                                     navigateToRecentMethod)
                ('show methods in current change set'   showMethodsInCurrentChangeSet)
                ('show methods with initials...'        showMethodsWithInitials)
                -
                "('toggle search pane'           toggleSearch)"
                -
                ('browse full (b)'                       browseMethodFull)
                ('browse hierarchy (h)'         browseClassHierarchy)
                ('browse protocol (p)'          browseFullProtocol)
                -
                ('fileOut'                                      fileOutMessage)
                ('printOut'                                     printOutMessage)
                -
                ('senders of... (n)'                    browseSendersOfMessages)
                ('implementors of... (m)'               browseMessages)
                ('versions (v)'                          browseVersions)
                ('inheritance (i)'                      methodHierarchy)
                -
                ('references... (r)'                             browseVariableReferences)
                ('assignments... (a)'                            browseVariableAssignments)
                -
                ('more...'                                      shiftedYellowButtonActivity)).
       
        ^ aMenu popUpInWorld: self currentWorld! !


!InstanceBrowser methodsFor: 'menu commands' stamp: 'ct 9/11/2020 20:12'!
offerMenu
        "Offer a menu to the user, in response to the hitting of the menu button on the tool pane"

        | aMenu |
        aMenu := MenuMorph new defaultTarget: self.
        aMenu title: ('Messages of {1}' translated format: {objectViewed nameForViewer}).
        aMenu addStayUpItem.
        aMenu addTranslatedList: #(
                ('vocabulary...'                         chooseVocabulary)
                ('what to show...'                      offerWhatToShowMenu)
                -
                ('inst var refs (here)'         setLocalInstVarRefs)
                ('inst var defs (here)'         setLocalInstVarDefs)
                ('class var refs (here)'                setLocalClassVarRefs)
                -

                ('navigate to a sender...'       navigateToASender)
                ('recent...'                                     navigateToRecentMethod)
                ('show methods in current change set'
                                                                        showMethodsInCurrentChangeSet)
                ('show methods with initials...'
                                                                        showMethodsWithInitials)
                -
                "('toggle search pane'           toggleSearch)"

                -
                -
                ('browse full (b)'                       browseMethodFull)
                ('browse hierarchy (h)'         browseClassHierarchy)
                ('browse protocol (p)'          browseFullProtocol)
                -
                ('fileOut'                                      fileOutMessage)
                ('printOut'                                     printOutMessage)
                -
                ('senders of... (n)'                    browseSendersOfMessages)
                ('implementors of... (m)'               browseMessages)
                ('versions (v)'                          browseVersions)
                ('inheritance (i)'                      methodHierarchy)
                -
                ('references... (r)'                             browseVariableReferences)
                ('assignments... (a)'                            browseVariableAssignments)
                -
                ('viewer on me'                         viewViewee)
                ('inspector on me'                      inspectViewee)
                -
                ('more...'                                      shiftedYellowButtonActivity)).
       
        ^ aMenu popUpInWorld: self currentWorld! !


!ListChooser methodsFor: 'actions' stamp: 'ct 9/12/2020 14:42'!
accept
        "if the user submits with no valid entry, make them start over"
       
        | choice |
        self canAccept ifFalse: [
                self canAdd ifTrue: [^ self add].
                ^ self changed: #textSelection].
       
        choice := self selectedItem.
       
        self canAdd ifTrue: [
                "Ask the user whether to add the new item or choose the list selection."
                (UserDialogBoxMorph
                        confirm: 'You can either choose an existing item or add a new one.\What do you want?' translated withCRs
                        title: 'Choose or Add' translated
                        trueChoice: choice asString
                        falseChoice: self searchText asString at: self currentHand position)
                                ifNil: ["Cancelled" self result: nil. ^ self]
                                ifNotNil: [:answer |
                                        answer ifTrue: [self result: choice] ifFalse: [self result: self searchText asString]]
                ] ifFalse: [self result: choice].
       
        self changed: #close.! !


!LocaleTest methodsFor: 'running' stamp: 'ct 9/12/2020 14:42'!
setUp

        previousID := Locale current localeID.
        previousKeyboardInterpreter := self currentHand instVarNamed: 'keyboardInterpreter'.
        previousClipboardInterpreter := Clipboard default instVarNamed: 'interpreter'.
        self currentHand clearKeyboardInterpreter.
        Clipboard default clearInterpreter.! !

!LocaleTest methodsFor: 'running' stamp: 'ct 9/12/2020 14:42'!
tearDown

        self currentHand instVarNamed: 'keyboardInterpreter' put: previousKeyboardInterpreter.
        Clipboard default instVarNamed: 'interpreter' put: previousClipboardInterpreter.
        Locale switchToID: (LocaleID isoLanguage: previousID).! !

!LocaleTest methodsFor: 'tests' stamp: 'ct 9/12/2020 14:43'!
testLocaleChanged
        "self debug: #testLocaleChanged"
        "LanguageEnvironment >> startUp is called from Prject >> localeChanged"
        <timeout: 60> "takes quite a while"
        Project current updateLocaleDependents.
        self assert: (self currentHand instVarNamed: 'keyboardInterpreter') isNil description: 'non-nil keyboardInterpreter'.
        self assert: (Clipboard default instVarNamed: 'interpreter') isNil description: 'non-nil interpreter'.
        Locale switchToID: (LocaleID isoLanguage: 'ja').
        self assert: 'ja' equals: Locale current localeID isoLanguage.
        Locale switchToID: (LocaleID isoLanguage: 'en').
        self assert: 'en' equals: Locale current localeID isoLanguage.! !


!MCCodeTool methodsFor: 'menus' stamp: 'ct 9/11/2020 20:17'!
browseFullProtocol
        "Open up a protocol-category browser on the value of the receiver's current selection.    If in mvc, an old-style protocol browser is opened instead.  Someone who still uses mvc might wish to make the protocol-category-browser work there too, thanks."

        (Smalltalk isMorphic and: [Smalltalk hasClassNamed: #Lexicon]) ifFalse: [^ self spawnFullProtocol].
        self selectedClassOrMetaClass ifNotNil: [:class |
                ^ (Smalltalk at: #Lexicon) new
                        openOnClass: class
                        inWorld: self currentWorld
                        showingSelector: self selectedMessageName].
        ^ nil! !


!Morph methodsFor: 'copying' stamp: 'ct 9/12/2020 14:20'!
duplicate
        "Make and return a duplicate of the receiver"

        | newMorph aName w aPlayer topRend |
        ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate].

        self okayToDuplicate ifFalse: [^ self].
        aName := (w := self world) ifNotNil:
                [w nameForCopyIfAlreadyNamed: self].
        newMorph := self veryDeepCopy.
        aName ifNotNil: [newMorph setNameTo: aName].

        newMorph arrangeToStartStepping.
        newMorph privateOwner: nil. "no longer in world"
        newMorph isPartsDonor: false. "no longer parts donor"
        (aPlayer := newMorph player) belongsToUniClass ifTrue:
                [aPlayer class bringScriptsUpToDate].
        aPlayer ifNotNil: [self currentWorld presenter flushPlayerListCache].
        ^ newMorph! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ct 9/12/2020 14:20'!
justDroppedInto: aMorph event: anEvent
        "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"

        | partsBinCase cmd |
        (self formerOwner notNil and: [self formerOwner ~~ aMorph])
                ifTrue: [self removeHalo].
        self formerOwner: nil.
        self formerPosition: nil.
        cmd := self valueOfProperty: #undoGrabCommand.
        cmd ifNotNil:[aMorph rememberCommand: cmd.
                                self removeProperty: #undoGrabCommand].
        (partsBinCase := aMorph isPartsBin) ifFalse:
                [self isPartsDonor: false].
        (self isInWorld and: [partsBinCase not]) ifTrue:
                [self world startSteppingSubmorphsOf: self].
        "Note an unhappy inefficiency here:  the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."

        "An object launched by certain parts-launcher mechanisms should end up fully visible..."
        (self hasProperty: #beFullyVisibleAfterDrop) ifTrue:
                [aMorph == self currentWorld ifTrue:
                        [self goHome].
                self removeProperty: #beFullyVisibleAfterDrop].! !

!Morph methodsFor: 'dropping/grabbing' stamp: 'ct 9/12/2020 14:19'!
slideToTrash: evt
        "Perhaps slide the receiver across the screen to a trash can and make it disappear into it.  In any case, remove the receiver from the screen."

        | aForm trash startPoint endPoint morphToSlide |
        ((self renderedMorph == ScrapBook default scrapBook) or: [self renderedMorph isKindOf: TrashCanMorph]) ifTrue:
                [self dismissMorph.  ^ self].
        TrashCanMorph slideDismissalsToTrash ifTrue:
                [morphToSlide := self representativeNoTallerThan: 200 norWiderThan: 200 thumbnailHeight: 100.
                aForm := morphToSlide imageForm offset: (0@0).
                trash := self currentWorld
                        findDeepSubmorphThat:
                                [:aMorph | (aMorph isKindOf: TrashCanMorph) and:
                                        [aMorph topRendererOrSelf owner == self currentWorld]]
                        ifAbsent:
                                [trash := TrashCanMorph new.
                                trash position: self currentWorld bottomLeft - (0 @ (trash extent y + 26)).
                                trash openInWorld.
                                trash].
                endPoint := trash fullBoundsInWorld center.
                startPoint := self topRendererOrSelf fullBoundsInWorld center - (aForm extent // 2)].
        self dismissMorph.
        self currentWorld displayWorld.
        TrashCanMorph slideDismissalsToTrash ifTrue:
                [aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15].
        ScrapBook default addToTrash: self! !

!Morph methodsFor: 'event handling' stamp: 'ct 9/12/2020 14:45'!
yellowButtonActivity: shiftState
        "Find me or my outermost owner that has items to add to a 
        yellow button menu. 
        shiftState is true if the shift was pressed. 
        Otherwise, build a menu that contains the contributions from 
        myself and my interested submorphs, 
        and present it to the user."
        | menu |
        self isWorldMorph
                ifFalse: [| outerOwner |
                        outerOwner := self outermostOwnerWithYellowButtonMenu.
                        outerOwner
                                ifNil: [^ self].
                        outerOwner == self
                                ifFalse: [^ outerOwner yellowButtonActivity: shiftState]].
        menu := self buildYellowButtonMenu: self currentHand.
        menu
                addTitle: self externalName
                icon: (self iconOrThumbnailOfSize: (Preferences tinyDisplay ifTrue: [16] ifFalse: [28])).
        menu popUpInWorld: self currentWorld! !

!Morph methodsFor: 'menu' stamp: 'ct 9/11/2020 18:00'!
buildYellowButtonMenu: aHand
        "Build the morph menu for the yellow button."

        | menu |
        menu := MenuMorph new defaultTarget: self.
        self addNestedYellowButtonItemsTo: menu event: self currentEvent.
        MenuIcons decorateMenu: menu.
        ^ menu! !

!Morph methodsFor: 'menus' stamp: 'ct 9/12/2020 14:44'!
addMiscExtrasTo: 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)].
       
        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 addGestureMenuItems: subMenu hand: self currentHand.
       
        aMenu add: 'extras...' translated subMenu: subMenu! !

!Morph methodsFor: 'menus' stamp: 'ct 9/12/2020 14:21'!
chooseNewGraphicCoexisting: aBoolean
        "Allow the user to choose a different form for her form-based morph"

        | replacee aGraphicalMenu |
        self isInWorld ifFalse: "menu must have persisted for a not-in-world object."
                [aGraphicalMenu := Project current world submorphThat:
                                [:m | (m isKindOf: GraphicalMenu) and: [m target == self]]
                         ifNone:
                                [^ self].
                ^ aGraphicalMenu show; flashBounds].
        aGraphicalMenu := GraphicalMenu new
                                initializeFor: self
                                withForms: self reasonableForms
                                coexist: aBoolean.
        aBoolean
                ifTrue: [self primaryHand attachMorph: aGraphicalMenu]
                ifFalse: [replacee := self topRendererOrSelf.
                        replacee owner replaceSubmorph: replacee by: aGraphicalMenu]! !

!Morph methodsFor: 'meta-actions' stamp: 'ct 9/12/2020 14:20'!
indicateAllSiblings
        "Indicate all the receiver and all its siblings by flashing momentarily."

        | aPlayer allBoxes |
        (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [^ self "error: 'not uniclass'"].
        allBoxes := aPlayer class allInstances
                select: [:m | m costume world == self currentWorld]
                thenCollect: [:m | m costume boundsInWorld].

        5 timesRepeat:
                [Display flashAll: allBoxes andWait: 120].! !

!Morph methodsFor: 'meta-actions' stamp: 'ct 9/11/2020 18:00'!
resizeFromMenu
        "Commence an interaction that will resize the receiver"

        ^ self resizeMorph: self currentEvent! !

!Morph methodsFor: 'structure' stamp: 'ct 9/12/2020 15:17'!
activeHand
       
        ^ super activeHand ifNil: [
                self isInWorld
                        ifTrue: [self world activeHand]
                        ifFalse: [nil]]! !

!Morph methodsFor: 'structure' stamp: 'ct 9/12/2020 14:40'!
primaryHand

        | outer |
        outer := self outermostWorldMorph ifNil: [^ nil].
        ^ outer activeHand ifNil: [outer firstHand]! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ct 9/12/2020 14:45'!
deleteUnlessHasFocus
        "Runs on a step timer because we cannot be guaranteed to get focus change events."
        (self currentHand keyboardFocus ~= self and: [ self isInWorld ]) ifTrue:
                [ self
                         stopSteppingSelector: #deleteUnlessHasFocus ;
                         delete ]! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'ct 9/12/2020 14:20'!
dismissViaHalo
        "The user has clicked in the delete halo-handle.  This provides a hook in case some concomitant action should be taken, or if the particular morph is not one which should be put in the trash can, for example."

        | cmd |
        self setProperty: #lastPosition toValue: self positionInWorld.
        self dismissMorph.
        TrashCanMorph preserveTrash ifTrue: [
                TrashCanMorph slideDismissalsToTrash
                        ifTrue:[self slideToTrash: nil]
                        ifFalse:[TrashCanMorph moveToTrash: self].
        ].

        cmd := Command new cmdWording: 'dismiss ' translated, self externalName.
        cmd undoTarget: Project current world selector: #reintroduceIntoWorld: argument: self.
        cmd redoTarget: Project current world selector: #onceAgainDismiss: argument: self.
        Project current world rememberCommand: cmd.! !

!Morph methodsFor: 'e-toy support' stamp: 'ct 9/12/2020 14:19'!
referencePlayfield
        "Answer the PasteUpMorph to be used for cartesian-coordinate reference"

        | former |
        owner ifNotNil:
                [(self topRendererOrSelf owner isHandMorph and: [(former := self formerOwner) notNil])
                        ifTrue:
                                [former := former renderedMorph.
                                ^ former isPlayfieldLike
                                        ifTrue: [former]
                                        ifFalse: [former referencePlayfield]]].

        self allOwnersDo: [:o | o isPlayfieldLike ifTrue: [^ o]].
        ^ Project current world! !

!Morph methodsFor: '*Etoys-support' stamp: 'ct 9/12/2020 14:45'!
handMeTilesToFire
        "Construct a phrase of tiles comprising a line of code that will 'fire' this object, and hand it to the user"

        self currentHand attachMorph: (self assuredPlayer tilesToCall: MethodInterface firingInterface)! !

!Morph methodsFor: '*Etoys-Squeakland-geometry' stamp: 'ct 9/12/2020 14:19'!
stagingArea
        "Answer a containing Worldlet, or the World if none."

        ^ (self ownerThatIsA: Worldlet) ifNil: [self currentWorld]! !

!Morph methodsFor: '*Etoys-Squeakland-meta-actions' stamp: 'ct 9/12/2020 14:22'!
changeColorTarget: anObject selector: aSymbol originalColor: aColor hand: aHand showPalette: showPalette
        "Put up a color picker for changing some kind of color.  May be modal or modeless, depending on #modalColorPickers setting"
        | c aRectangle |
        self flag: #arNote. "Simplify this due to anObject == self for almost all cases"
        c := ColorPickerMorph new.
        c
                choseModalityFromPreference;
                sourceHand: aHand;
                target: anObject;
                selector: aSymbol;
                originalColor: aColor.
                showPalette ifFalse: [c initializeForJustCursor].
                aRectangle := (anObject == self currentWorld)
                        ifTrue: [self currentHand position extent: (20@20)]
                        ifFalse: [anObject isMorph
                                ifFalse: [Rectangle center: self position extent: (20@20)]
                                ifTrue: [anObject fullBoundsInWorld]].
       
        c putUpFor: anObject near: aRectangle.! !

!Morph methodsFor: '*Etoys-Squeakland-meta-actions' stamp: 'ct 9/12/2020 14:45'!
showEmbedMenu
        "Put up a menu offering embed targets.  Emphasize the current position.  Theoretically this method will only be called when there are at least two alternatives."

        | aMenu |
        aMenu := self addEmbeddingMenuItemsTo: nil hand: self currentHand.
        aMenu title: ('embed {1} in...' translated format: {self externalName }).
        aMenu popUpInWorld! !

!Morph methodsFor: '*Etoys-Squeakland-e-toy support' stamp: 'ct 9/12/2020 14:20'!
hideWillingnessToAcceptDropFeedback
        "Make the receiver stop looking ready to show some welcoming feedback"
       
        self currentWorld removeHighlightFeedback
       
        ! !

!Morph methodsFor: '*Etoys-Squeakland-e-toy support' stamp: 'ct 9/12/2020 14:19'!
showWillingnessToAcceptDropFeedback
        "Make the receiver look ready to show show some welcoming feedback"
       
        | aMorph |
        aMorph := RectangleMorph new bounds: self bounds..
        aMorph beTransparent; borderWidth: 4; borderColor: (Color green); lock.
        aMorph setProperty: #affilliatedPad toValue: (self ownerThatIsA: TilePadMorph).
        self currentWorld addHighlightMorph: aMorph for: self outmostScriptEditor.! !

!Morph methodsFor: '*Etoys-Squeakland-initialization' stamp: 'ct 9/12/2020 15:17'!
openInWorldOrWorldlet
        "Open in the world-like creature affiliated with the active Hand."

        | aRecorder aWorldlet |
        (self currentHand isKindOf: HandMorphForReplay) ifTrue:
                [((aRecorder := self currentHand recorder) isKindOf: MentoringEventRecorder)
                        ifTrue:
                                [aWorldlet := aRecorder contentArea.
                                self center: aWorldlet center.
                                aWorldlet addMorphFront: self.
                                ^ self]].

        self openInWorld.! !


!AllPlayersTool methodsFor: 'reinvigoration' stamp: 'ct 9/12/2020 14:25'!
reinvigorate
        "Referesh the contents of the receiver"

        (submorphs copyFrom: 3 to: submorphs size) do: [:m | m delete].
        self currentWorld doOneCycleNow.
        self playSoundNamed: 'scritch'.
        (Delay forMilliseconds: 700) wait.
        self currentWorld presenter reinvigoratePlayersTool: self.
        self playSoundNamed: 'scratch'.! !


!AllScriptsTool methodsFor: 'initialization' stamp: 'ct 9/12/2020 14:26'!
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 font: ScriptingSystem fontForEToyButtons) 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 font: ScriptingSystem fontForEToyButtons) 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: [self currentWorld].
        worldToUse presenter reinvigorateAllScriptsTool: self.
        self layoutChanged.! !


!BookMorph methodsFor: 'menu' stamp: 'ct 9/12/2020 14:39'!
findText: keys inStrings: rawStrings startAt: startIndex container: oldContainer pageNum: pageNum
        "Call once to search a page of the book.  Return true if found and highlight the text.  oldContainer should be NIL. 
        (oldContainer is only non-nil when (1) doing a 'search again' and (2) the page is in memory and (3) keys has just one element.  oldContainer is a TextMorph.)"

        | container wasIn strings old good insideOf place start |
        good := true.
        start := startIndex.
        strings := oldContainer ifNil:
                                        ["normal case"

                                        rawStrings]
                                ifNotNil:
                                        [(pages at: pageNum) isInMemory
                                                ifFalse: [rawStrings]
                                                ifTrue: [(pages at: pageNum) allStringsAfter: oldContainer]].
        keys do:
                        [:searchString | | thisWord |
                        "each key"

                        good
                                ifTrue:
                                        [thisWord := false.
                                        strings do:
                                                        [:longString | | index |
                                                        (index := longString
                                                                                findString: searchString
                                                                                startingAt: start
                                                                                caseSensitive: false) > 0
                                                                ifTrue:
                                                                        [thisWord not & (searchString == keys first)
                                                                                ifTrue:
                                                                                        [insideOf := longString.
                                                                                        place := index].
                                                                        thisWord := true].
                                                        start := 1].    "only first key on first container"
                                        good := thisWord]].
        good
                ifTrue:
                        ["all are on this page"

                        wasIn := (pages at: pageNum) isInMemory.
                        self goToPage: pageNum.
                        wasIn
                                ifFalse:
                                        ["search again, on the real current text.  Know page is in."

                                        ^self
                                                findText: keys
                                                inStrings: ((pages at: pageNum) allStringsAfter: nil)
                                                startAt: startIndex
                                                container: oldContainer
                                                pageNum: pageNum        "recompute"]].
        (old := self valueOfProperty: #searchContainer) ifNotNil:
                        [(old respondsTo: #editor)
                                ifTrue:
                                        [old editor selectFrom: 1 to: 0.        "trying to remove the previous selection!!"
                                        old changed]].
        good
                ifTrue:
                        ["have the exact string object"

                        (container := oldContainer) ifNil:
                                        [container := self
                                                                highlightText: keys first
                                                                at: place
                                                                in: insideOf]
                                ifNotNil:
                                        [container userString == insideOf
                                                ifFalse:
                                                        [container := self
                                                                                highlightText: keys first
                                                                                at: place
                                                                                in: insideOf]
                                                ifTrue:
                                                        [(container isTextMorph)
                                                                ifTrue:
                                                                        [container editor selectFrom: place to: keys first size - 1 + place.
                                                                        container changed]]].
                        self setProperty: #searchContainer toValue: container.
                        self setProperty: #searchOffset toValue: place.
                        self setProperty: #searchKey toValue: keys.     "override later"
                        self currentHand newKeyboardFocus: container.
                        ^true].
        ^false! !

!BookMorph methodsFor: 'navigation' stamp: 'ct 9/12/2020 14:26'!
goToPageMorph: newPage transitionSpec: transitionSpec
        "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly.  Apply the transitionSpec provided."

        | 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"].
                        self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
                        self removeViewersOnSubsIn: self currentWorld presenter.
                        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].
                                                                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).        "sets currentPage"
        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"].
        self currentWorld presenter flushPlayerListCache.! !

!BookMorph methodsFor: '*Etoys-Squeakland-menu' stamp: 'ct 9/12/2020 14:38'!
addAdvancedItemsTo: aMenu
        "Add advanced items to a menu which allow the user to affect all the pages of the book.  NB balloon help msgs still pending."

        | subMenu |
        subMenu := MenuMorph new defaultTarget: self.
        subMenu addTranslatedList: #(
                ('make all pages the same size as this page' makeUniformPageSize 'Make all the pages of this book be the same size as the page currently showing.')
        ('set background color for all pages' #setPageColor 'Choose a color to assign as the background color for all of this book''s pages')
                -
                ('uncache page sorter'   uncachePageSorter)
                ('make a thread of projects in this book'  buildThreadOfProjects)
                -
                ('make this the template for new pages' setNewPagePrototype)) translatedNoop.
       
        "NB  The following 2 items do not get auto-updated in a persistent menu."
        newPagePrototype ifNotNil: [
                subMenu add: 'clear new-page template' translated action: #clearNewPagePrototype].
        self isInFullScreenMode
                ifTrue: [
                        subMenu add: 'exit full screen' translated action: #exitFullScreen]
                ifFalse: [
                        subMenu add: 'show full screen' translated action: #goFullScreen].
       
        (self currentHand pasteBuffer isKindOf: PasteUpMorph) ifTrue: [
                subMenu addLine.
                subMenu add: 'paste book page' translated   action: #pasteBookPage].
       
        aMenu add: 'advanced...' translated subMenu: subMenu.! !


!CategoryViewer methodsFor: 'get/set slots' stamp: 'ct 9/12/2020 14:39'!
makeUniversalTilesGetter: aMethodInterface event: evt from: aMorph
        "Button in viewer performs this to make a universal-tiles getter and attach it to hand."

        | newTiles |
        newTiles := self newGetterTilesFor: scriptedPlayer methodInterface: aMethodInterface.
        newTiles setProperty: #beScript toValue: true.
        owner ifNil: [^ newTiles].
        self currentHand attachMorph: newTiles.
        newTiles align: newTiles topLeft with: evt hand position + (7@14).! !

!CategoryViewer methodsFor: 'macpal' stamp: 'ct 9/11/2020 19:42'!
currentVocabulary
        "Answer the vocabulary currently installed in the viewer.  The outer StandardViewer object holds this information."

        ^ self outerViewer
                ifNotNil: [:viewer | viewer currentVocabulary]
                ifNil: [(self world ifNil: [self currentWorld]) currentVocabularyFor: scriptedPlayer]! !

!CategoryViewer methodsFor: '*Etoys-Squeakland-categories' stamp: 'ct 9/11/2020 19:42'!
assureCategoryFullyVisible
        "Keep deleting categoryviewers other than the receiver  until the receiver is fully visible."

        | ready toDelete |
        ready := false.
        [(self bounds bottom > self world bottom) and: [ready not]] whileTrue: [
                owner submorphs size > 2
                        ifTrue: [
                                toDelete := owner submorphs allButFirst reversed
                                        detect: [:cv | cv ~~ self]
                                        ifNone: [^ self].
                                toDelete delete.
                                self world doOneCycleNow]
                        ifFalse: [
                                ready := true]].! !


!CompoundTileMorph methodsFor: '*Etoys-Squeakland-miscellaneous' stamp: 'ct 9/11/2020 19:44'!
addCommandFeedback: evt
        "Add screen feedback showing what would be torn off in a drag"

        | aMorph |
        aMorph := RectangleMorph new
                bounds: self bounds;
                beTransparent;
                borderWidth: 2;
                borderColor: ScriptingSystem commandFeedback;
                lock;
                yourself.
        self currentWorld addHighlightMorph: aMorph for: self outmostScriptEditor.! !

!CompoundTileMorph methodsFor: '*Etoys-Squeakland-miscellaneous' stamp: 'ct 9/11/2020 19:44'!
removeHighlightFeedback
        "Remove any existing highlight feedback"

        self world removeHighlightFeedback.
! !


!DialogWindow methodsFor: 'initialization' stamp: 'ct 9/11/2020 19:44'!
initialize

        super initialize.
       
        self
                changeTableLayout;
                listDirection: #topToBottom;
                hResizing: #shrinkWrap;
                vResizing: #shrinkWrap;
                rubberBandCells: true;
                setProperty: #indicateKeyboardFocus toValue: #never.
       
        self createTitle: 'Dialog'.
        self createBody.
       
        self setDefaultParameters.
       
        keyMap := Dictionary new.
        exclusive := true.
        autoCancel := false.
        preferredPosition := self currentWorld center.! !


!DockingBarMorph methodsFor: 'submorphs-add/remove' stamp: 'ct 9/12/2020 14:40'!
delete

        self currentHand removeKeyboardListener: self.
        activeSubMenu ifNotNil: [
                activeSubMenu delete].
        ^ super delete! !


!EtoyDAVLoginMorph methodsFor: 'private' stamp: 'ct 9/11/2020 19:45'!
loginAndDo: aBlock ifCanceled: cb
        "EtoyDAVLoginMorph loginAndDo:[:n :p | true] ifCanceled:[]"
        self name: '' actionBlock: aBlock cancelBlock: cb;
                fullBounds;
                position: Display extent - self extent // 2.
        self position: self position + (0@40).
        self currentWorld addMorphInLayer: self.! !

!EtoyDAVLoginMorph methodsFor: 'actions' stamp: 'ct 9/11/2020 19:45'!
launchBrowser

        self currentWorld addMorph: self buildPanel centeredNear: Sensor cursorPoint.
        (Smalltalk classNamed: #ScratchPlugin) ifNotNil: [:sp | sp primOpenURL: self url].! !


!EventMorph methodsFor: 'drag and drop' stamp: 'ct 9/11/2020 19:45'!
brownDragConcluded
        "After the user has manually repositioned the receiver via brown-halo-drag, this is invoked."

        self currentWorld abandonAllHalos.
        self eventRoll ifNotNil:
                [:evtRoll | evtRoll pushChangesBackToEventTheatre]! !


!EventRecordingSpace methodsFor: 'commands' stamp: 'ct 9/11/2020 19:45'!
abandonReplayHandsAndHalos
        "Cleanup after playback."

        self currentWorld abandonReplayHandsAndHalosFor: eventRecorder! !

!EventRecordingSpace methodsFor: 'commands' stamp: 'ct 9/11/2020 19:45'!
dismantlePaintBoxArtifacts
        "Cleanup after playback -- if a paint-box has been left up, take it down."

        (self currentWorld findA: SketchEditorMorph) ifNotNil: [:skEd |
                skEd cancelOutOfPainting].! !

!EventRecordingSpace methodsFor: 'commands' stamp: 'ct 9/12/2020 14:28'!
makeHorizontalRoll
        "Create a horizontal roll viewer for this recording space"

        state = #readyToRecord ifTrue: [
                ^ self inform: 'Nothing recorded yet' translated].
       
        "self convertToCanonicalForm." "Would prefer to do this but there are still issues."
       
        eventRoll ifNil: [
                eventRoll := EventRollMorph new.
                eventRoll eventTheatre: self].
       
        eventRoll formulate.
       
        eventRoll isInWorld
                ifFalse: [eventRoll
                                openInWorld;
                                setExtentFromHalo: (self currentWorld width - 10) @ eventRoll height;
                                top: self bottom;
                                bottom: (eventRoll bottom min: self currentWorld bottom);
                                left: self currentWorld left + 2] "presumably zero"
                ifTrue: [eventRoll comeToFront].! !

!EventRecordingSpace methodsFor: 'commands' stamp: 'ct 9/11/2020 19:46'!
pausePlayback
         "Pause the playback.  Sender responsible for setting state to #suspendedPlayback"

        eventRecorder pausePlayback.
        (self currentWorld findA: SketchEditorMorph) ifNotNil:
                [:skEd | skEd cancelOutOfPainting.
                ^ self rewind].
        self borderColor: Color orange.
        self setProperty: #suspendedContentArea toValue: contentArea veryDeepCopy.
        self populateControlsPanel! !

!EventRecordingSpace methodsFor: 'commands' stamp: 'ct 9/11/2020 19:46'!
record
        "Commence event recording..."

        self currentWorld abandonAllHalos.
        self comeToFront.
       
        initialContentArea := contentArea veryDeepCopy.
        self forgetPriorPaintBoxSettings.
        initialPicture := contentArea imageForm.
        self state: #recording.
        self borderColor: Color red.
        self populateControlsPanel.
        self currentWorld doOneCycleNow.

        eventRecorder record! !

!EventRecordingSpace methodsFor: 'processing' stamp: 'ct 9/11/2020 19:45'!
assureContentAreaStaysAt: aPoint
        "selbst-verst??ndlich"

        self currentWorld doOneCycleNow.
        self topLeft: ((self topLeft - contentArea topLeft ) + aPoint)! !

!EventRecordingSpace methodsFor: 'initialization' stamp: 'ct 9/11/2020 19:46'!
initializeFromPlaybackButton: anEventPlaybackButton
        "Initialize my content area, caption, and tape from a playback button."

        | soundEvent |
        initialContentArea := anEventPlaybackButton contentArea veryDeepCopy.
        eventRecorder tape: anEventPlaybackButton tape veryDeepCopy.
        eventRecorder caption: anEventPlaybackButton  caption.
        soundEvent := eventRecorder tape  detect: [:evt | evt
type = #startSound] ifNone: [nil].
        soundEvent ifNotNil:  "For benefit of possible re-record of voiceover"
                [eventRecorder startSoundEvent: soundEvent].
        initialPicture := anEventPlaybackButton initialPicture veryDeepCopy ifNil:
                [self inform: 'caution - old playback; button lacks vital data.' translated.
                ^ nil].
        finalPicture := anEventPlaybackButton finalPicture veryDeepCopy.
        eventRecorder saved: true.

        self rewind.
        self center: self currentWorld center.! !


!EventPlaybackSpace methodsFor: 'initialization' stamp: 'ct 9/11/2020 19:45'!
launchFrom: aButton
        "Initialize the receiver from an invoker button, and launch it."
       
        | where |
        self setProperty: #originatingButton toValue: aButton.
        self contentArea: aButton contentArea veryDeepCopy tape: aButton tape veryDeepCopy.
        self captionString: aButton caption.
        self rewind.
        autoStart := aButton autoStart.
        autoDismiss := aButton autoDismiss.

        "showChrome  := aButton showChrome."
        where := aButton whereToAppear.

        self openInWorld.
        where = #screenCenter ifTrue: [self center: self currentWorld center].
        where = #buttonPosition ifTrue: [self position: aButton position].
        where = #containerOrigin ifTrue: [self position: aButton owner position].
        self goHome.
        self addStopper.

        autoStart ifTrue: [self play]! !


!FlapTab methodsFor: 'globalness' stamp: 'ct 9/11/2020 19:47'!
toggleIsGlobalFlap
        "Toggle whether the receiver is currently a global flap or not"

        | oldWorld |
        self hideFlap.
        oldWorld := self currentWorld.
        self isGlobalFlap
                ifTrue:
                        [Flaps removeFromGlobalFlapTabList: self.
                        oldWorld addMorphFront: self]
                ifFalse:
                        [self delete.
                        Flaps addGlobalFlap: self.
                        self currentWorld addGlobalFlaps].
        self currentWorld reformulateUpdatingMenus.! !


!GoldBoxMenu methodsFor: 'initialization' stamp: 'ct 9/12/2020 14:41'!
initializeFor: aScriptor
        "Answer a graphical menu to be put up in conjunction with the Gold Box"

        | aButton goldBox aReceiver boxBounds example toScale |
        scriptor := aScriptor.
        lastItemMousedOver := nil.
        self removeAllMorphs.
        self setProperty: #goldBox toValue: true.
        self listDirection: #topToBottom;
                hResizing: #spaceFill; extent: 1@1; vResizing: #spaceFill. "standard #newColumn stuff"

        self setNameTo: 'Gold Box' translated.
        self useRoundedCorners.
        self color: Color white.
        self borderColor:  (Color r: 1.0 g: 0.839 b: 0.065).
        self hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 4.
        {
        {ScriptingSystem. #yesNoComplexOfTiles.  'test' translated. 'Test/Yes/No panes for testing a condition.'  translated}.
        {ScriptingSystem. #timesRepeatComplexOfTiles. 'repeat'  translated.  'TimesRepeat panes for running a section of code repeatedly.'  translated}.
        { ScriptingSystem.      #randomNumberTile.       'random'  translated.           'A tile that will produce a random number in a given range.'  translated}.
        { ScriptingSystem.      #seminalFunctionTile.    'function'  translated.         'A tile representing a function call.  Click on the function name or the arrows to change functions.'  translated}.
        {ScriptingSystem.       #buttonUpTile.   'button up?'  translated.               'Reports whether the mouse button is up'  translated}.
        {ScriptingSystem.       #buttonDownTile.         'button down?'  translated.             'Reports whether the mouse button is down'  translated}.
        {ScriptingSystem.       #randomColorTile.        'random color'  translated.             'A tile returning a random color'  translated}.
        {scriptor playerScripted. #tileToRefer.  'tile for me'  translated. 'A tile representing the object being scripted'  translated}.
        {self.  #numericConstantTile.  'number'  translated.   'A tile holding a plain number'  translated}.
} do:
                [:tuple |
                        aReceiver := tuple first.
                        example := aReceiver perform: tuple second.
                       
                        aButton := IconicButton new target: aReceiver.
                        aButton borderWidth: 0;
                                color: Color transparent.
                        toScale := tuple size >= 5
                                ifTrue:
                                        [tuple first perform: tuple fifth]  "bail-out for intractable images."
                                ifFalse:
                                        [example imageForm].
                        aButton labelGraphic: (toScale copy scaledToHeight: 40).

                        aButton actionSelector: #launchPartOffsetVia:label:.
                        aButton arguments: {tuple second.  tuple third}.
                        (tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue:
                                [aButton setBalloonText: tuple fourth].
                        aButton actWhen: #buttonDown.
                        aButton on: #mouseEnter send: #mousedOverEvent:button:  to: self.
                        aButton on: #click send: #delete to: self.
                         self addMorphBack: aButton].
        goldBox := aScriptor submorphs first submorphThat: [:m | (m isKindOf: SimpleButtonMorph) and: [m actionSelector == #offerGoldBoxMenu]] ifNone: [nil].
        goldBox
                ifNil:
                        [self position: self currentHand position]
                ifNotNil:
                        [boxBounds := goldBox boundsInWorld.
                        self center: boxBounds center.
                        self left: (boxBounds center x - (self width // 2)).
                        self top: boxBounds bottom].
        lastItemMousedOver := nil.
        self on: #mouseLeave send: #mouseLeftMenuWithEvent: to: self.
        self on: #mouseLeaveDragging send: #delete to: self.! !


!GrabPatchMorph methodsFor: '*Etoys-Squeakland-initialization' stamp: 'ct 9/12/2020 14:41'!
justTornOffFromPartsBin

        super justTornOffFromPartsBin.
        self image: (Form extent: 0 @ 0).       "hide the icon"
        self currentHand showTemporaryCursor: Cursor crossHair.! !


!HaloMorph methodsFor: 'private' stamp: 'ct 9/12/2020 14:41'!
doDirection: anEvent with: directionHandle
        "The mouse went down on the forward-direction halo handle; respond appropriately."

        anEvent hand obtainHalo: self.
        anEvent shiftPressed
                ifTrue:
                        [directionArrowAnchor := (target point: target referencePosition in: self world) rounded.
                        self positionDirectionShaft: directionHandle.
                        self removeAllHandlesBut: directionHandle.
                        directionHandle setProperty: #trackDirectionArrow toValue: true]
                 ifFalse:
                        [self currentHand spawnBalloonFor: directionHandle]! !

!HaloMorph methodsFor: 'private' stamp: 'ct 9/11/2020 20:10'!
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:
                                [(UIManager default chooseFrom: {
                                        'Yes' translated.
                                        'Um, no, let me reconsider' translated.
                                } title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]].
                        evt hand removeHalo.
                        self delete.
                        target dismissViaHalo.
                        self currentWorld presenter flushPlayerListCache].! !

!HaloMorph methodsFor: 'private' stamp: 'ct 9/12/2020 14:41'!
prepareToTrackCenterOfRotation: evt with: rotationHandle
        "The mouse went down on the center of rotation."

        evt hand obtainHalo: self.
        evt shiftPressed
                ifTrue:
                        [self removeAllHandlesBut: rotationHandle.
                        rotationHandle setProperty: #trackCenterOfRotation toValue: true.
                        evt hand showTemporaryCursor: Cursor blank]
                ifFalse:
                        [self currentHand spawnBalloonFor: rotationHandle]! !


!HandMorph methodsFor: 'event handling' stamp: 'ct 9/12/2020 14:30'!
cursorPoint
        "Implemented for allowing embedded worlds in an event cycle to query a hand's position and get it in its coordinates. The same can be achieved by #point:from: but this is simply much more convenient since it will look as if the hand is in the lower world."

        | pos world |
        pos := self position.
        world := self activeWorld.
        (world isNil or: [world == owner]) ifTrue: [^pos].
        ^world point: pos from: owner! !

!HandMorph methodsFor: 'event handling' stamp: 'ct 9/12/2020 14:59'!
processEvents
        "Process user input events from the local input devices."

        | evt evtBuf type hadAny |
        self activeEvent ifNotNil: [
                "Meaning that we were invoked from within an event response.
                Make sure z-order is up to date."
                self mouseOverHandler processMouseOver: lastMouseEvent].
       
        hadAny := false.
        [(evtBuf := Sensor nextEvent) isNil] whileFalse:
                        [evt := nil.    "for unknown event types"
                        type := evtBuf first.
                        type = EventTypeMouse
                                ifTrue: [evt := self generateMouseEvent: evtBuf].
                        type = EventTypeMouseWheel
                                ifTrue: [evt := self generateMouseWheelEvent: evtBuf].
                        type = EventTypeKeyboard
                                ifTrue: [evt := self generateKeyboardEvent: evtBuf].
                        type = EventTypeDragDropFiles
                                ifTrue: [evt := self generateDropFilesEvent: evtBuf].
                        type = EventTypeWindow
                                ifTrue:[evt := self generateWindowEvent: evtBuf].
                        "All other events are ignored"
                        (type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self].
                        evt ifNotNil: ["Finally, handle it."
                                        self handleEvent: evt.
                                        hadAny := true.
                                       
                                        "For better user feedback, return immediately after a mouse event has been processed."
                                        evt isMouse ifTrue: [^ self]]].
       
        "note: if we come here we didn't have any mouse events"
        mouseClickState ifNotNil: [
                "No mouse events during this cycle. Make sure click states time out accordingly"
                mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
        hadAny ifFalse: [
                "No pending events. Make sure z-order is up to date"
                self mouseOverHandler processMouseOver: lastMouseEvent].! !

!HandMorph methodsFor: 'initialization' stamp: 'ct 9/12/2020 15:33'!
becomeActiveDuring: aBlock
        "Make the receiver the activeHand during the evaluation of aBlock."

        | priorHand |
        priorHand := self activeHand.
        self activeHand: self.
        ^ aBlock ensure: [
                "check to support project switching."
                self activeHand == self ifTrue: [self activeHand: priorHand]].! !


!HandMorphForReplay methodsFor: 'event handling' stamp: 'ct 9/12/2020 14:30'!
processEvents
        "Play back the next event"

        | evt hadMouse hadAny tracker  |
        suspended == true ifTrue: [^ self].
        hadMouse := hadAny := false.
        tracker := recorder objectTrackingEvents.
        [(evt := recorder nextEventToPlay) isNil] whileFalse:
                        [
                        ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
                        tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
                        evt type == #EOF
                                ifTrue:
                                        [recorder pauseIn: self currentWorld.
                                        ^ self].
                        evt type == #startSound
                                ifTrue:
                                        [recorder perhapsPlaySound: evt argument.
                                        recorder synchronize.
                                        ^ self].
                        evt type == #startEventPlayback
                                ifTrue:
                                        [evt argument launchPlayback.
                                        recorder synchronize.
                                        ^ self].

                        evt type == #noteTheatreBounds
                                ifTrue:
                                        ["The argument holds the content rect --for now we don't make any use of that info in this form."
                                        ^ self].

                        evt isMouse ifTrue: [hadMouse := true].
                        (evt isMouse or: [evt isKeyboard])
                                ifTrue:
                                        [self handleEvent: (evt setHand: self) resetHandlerFields.
                                        hadAny := true]].
        (mouseClickState notNil and: [hadMouse not])
                ifTrue:
                        ["No mouse events during this cycle. Make sure click states time out accordingly"

                        mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
        hadAny
                ifFalse:
                        ["No pending events. Make sure z-order is up to date"

                        self mouseOverHandler processMouseOver: lastMouseEvent]! !


!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'ct 9/11/2020 20:12'!
destroyThread
        "Manually destroy the thread"

        (self confirm: ('Destroy thread <{1}> ?' translated format:{threadName})) ifFalse: [^ self].
        self class knownThreads removeKey: threadName ifAbsent: [].
        self setProperty: #moribund toValue: true.  "In case pointed to in some other project"
        self currentWorld keyboardNavigationHandler == self ifTrue:
                [self stopKeyboardNavigation].
        self delete.! !

!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'ct 9/11/2020 20:13'!
moreCommands
        "Put up a menu of options"

        | allThreads aMenu others target |
        allThreads := self class knownThreads.
        aMenu := MenuMorph new defaultTarget: self.
        aMenu addTitle: 'navigation' translated.

        Preferences noviceMode ifFalse:[
                self flag: #deferred.  "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled"
                aMenu addStayUpItem
        ].
       
        others := (allThreads keys reject: [ :each | each = threadName]) asArray sort.
        others do: [ :each |
                aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each
        ].

        aMenu addList: {
                {'switch to recent projects' translated.  #getRecentThread}.
                #-.
                {'create a new thread' translated.  #threadOfNoProjects}.
                {'edit this thread' translated.  #editThisThread}.
                {'create thread of all projects' translated.  #threadOfAllProjects}.
                #-.
                {'First project in thread' translated.  #firstPage}.
                {'Last project in thread' translated.  #lastPage}
        }.

        (target := self currentIndex + 2) > listOfPages size ifFalse: [
                aMenu
                        add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first})
                        action: #skipOverNext
        ].

        aMenu addList: {
                {'jump within this thread' translated.  #jumpWithinThread}.
                {'insert new project' translated.  #insertNewProject}.
                #-.
                {'simply close this navigator' translated.  #delete}.
                {'destroy this thread' translated. #destroyThread}.
                #-
        }.

        (self currentWorld keyboardNavigationHandler == self) ifFalse:[
                aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation
        ]
        ifTrue: [
                aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation
        ].

        aMenu popUpInWorld.! !

!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'ct 9/11/2020 20:14'!
positionAppropriately

        | others world otherRects overlaps bottomRight |
        (self ownerThatIsA: HandMorph) ifNotNil: [^self].
        others := (world := Project currentWorld) submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
        otherRects := others collect: [ :each | each bounds].
        bottomRight := (world hasProperty: #threadNavigatorPosition)
                ifTrue: [world valueOfProperty: #threadNavigatorPosition]
                ifFalse: [world bottomRight].
        self align: self fullBounds bottomRight with: bottomRight.
        self setProperty: #previousWorldBounds toValue: self world bounds.

        [
                overlaps := false.
                otherRects do: [ :r |
                        (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
                ].
                self top < self world top ifTrue: [
                        self bottom: bottomRight y.
                        self right: self left - 1.
                ].
                overlaps
        ] whileTrue.! !

!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'ct 9/11/2020 20:14'!
startKeyboardNavigation
        "Tell the active world to starting navigating via desktop keyboard navigation via me"

        self currentWorld keyboardNavigationHandler: self! !

!InternalThreadNavigationMorph methodsFor: 'navigation' stamp: 'ct 9/11/2020 20:15'!
stopKeyboardNavigation
        "Cease navigating via the receiver in response to desktop keystrokes"

        self currentWorld removeProperty: #keyboardNavigationHandler! !

!InternalThreadNavigationMorph methodsFor: 'private' stamp: 'ct 9/11/2020 20:13'!
loadPageWithProgress
        "Load the desired page, showing a progress indicator as we go"
       
        | projectInfo projectName beSpaceHandler |
        projectInfo := listOfPages at: currentIndex.
        projectName := projectInfo first.
        loadedProject := Project named: projectName.
        self class know: listOfPages as: threadName.
        beSpaceHandler := (Project current world keyboardNavigationHandler == self).
        self currentWorld addDeferredUIMessage:
                [InternalThreadNavigationMorph openThreadNamed: threadName atIndex: currentIndex beKeyboardHandler: beSpaceHandler].

        loadedProject ifNil: [
                ComplexProgressIndicator new
                        targetMorph: self;
                        historyCategory: 'project loading' translated;
                        withProgressDo: [
                                [
                                        loadedProject := Project current
                                                        fromMyServerLoad: projectName
                                ]
                                        on: ProjectViewOpenNotification
                                        do: [ :ex | ex resume: false]          
                                                "we probably don't want a project view morph in this case"
                        ].
        ].
        loadedProject ifNil: [
                ^self inform: 'I cannot find that project' translated
        ].
        self delete.

        loadedProject enter.! !

!InternalThreadNavigationMorph methodsFor: '*Etoys-Squeakland-menu' stamp: 'ct 9/11/2020 20:14'!
resetBottomRightPosition

        self currentWorld removeProperty: #threadNavigatorPosition.
! !

!InternalThreadNavigationMorph methodsFor: '*Etoys-Squeakland-menu' stamp: 'ct 9/11/2020 20:14'!
setBottomRightPosition

        self currentWorld setProperty: #threadNavigatorPosition toValue: self bottomRight.
! !


!LassoPatchMorph methodsFor: '*Etoys-Squeakland-initialization' stamp: 'ct 9/12/2020 14:42'!
justTornOffFromPartsBin

        super justTornOffFromPartsBin.
        self image: (Form extent: 0 @ 0).       "hide the icon"
        self currentHand showTemporaryCursor: Cursor crossHair! !


!MentoringEventRecorder methodsFor: 'commands' stamp: 'ct 9/11/2020 20:18'!
play
        "Play the movie, as it were."

        tape ifNil: [^ self].
        tapeStream := ReadStream on: tape.
        self resumePlayIn: self currentWorld.
! !

!MentoringEventRecorder methodsFor: 'commands' stamp: 'ct 9/11/2020 20:18'!
record
        "Commence recording or re-recording."

        tapeStream := WriteStream on: (Array new: 10000).
        self resumeRecordIn: self currentWorld.
! !

!MentoringEventRecorder methodsFor: 'commands' stamp: 'ct 9/11/2020 20:18'!
resumePlayingWithoutPassingStop
        "Like play, but avoids the stop step that does more than we'd like."

        tapeStream := ReadStream on: tape.
        self resumePlayIn: self currentWorld.
! !

!MentoringEventRecorder methodsFor: 'commands' stamp: 'ct 9/12/2020 14:24'!
stop
        "Stop recording or playing."

        tapeStream ifNotNil:
                [(#(recording recordingWithSound) includes: self state) ifTrue:
                        [tape := tapeStream contents.
                        saved := false]].
        self terminateVoiceRecording.  "In case doing"
        journalFile ifNotNil:
                [journalFile close].
        self pauseIn: self currentWorld.
        tapeStream := nil.
        self state: #atEndOfPlayback.
        recordingSpace abandonReplayHandsAndHalos.
        recordMeter ifNotNil: [recordMeter width: 1].! !


!MenuMorph methodsFor: 'control' stamp: 'ct 9/12/2020 14:43'!
popUpEvent: evt in: aWorld
        "Present this menu in response to the given event."

        | aHand aPosition |
        aHand := evt ifNotNil: [evt hand] ifNil: [self currentHand].
        aPosition := aHand position truncated.
        ^ self popUpAt: aPosition forHand: aHand in: aWorld! !

!MenuMorph methodsFor: 'control' stamp: 'ct 9/12/2020 14:23'!
popUpNoKeyboard
        "Present this menu in the current World, *not* allowing keyboard input into the menu"

        ^ self
                popUpAt: self currentHand position
                forHand: self currentHand
                in: self currentWorld
                allowKeyboard: false! !

!MenuMorph methodsFor: 'modal control' stamp: 'ct 9/12/2020 14:24'!
informUserAt: aPoint during: aBlock
        "Add this menu to the Morphic world during the execution of the given block."

        | title world |
        title := self allMorphs detect: [ :ea | ea hasProperty: #titleString ].
        title := title submorphs first.
        self visible: false.
        world := self currentWorld.
        aBlock value: [:string|
                self visible ifFalse:[
                        world addMorph: self centeredNear: aPoint.
                        self visible: true].
                title contents: string.
                self setConstrainedPosition: self currentHand cursorPoint hangOut: false.
                self changed.
                world displayWorld "show myself"].
        self delete.
        world displayWorld.! !

!MenuMorph methodsFor: 'modal control' stamp: 'ct 9/12/2020 14:24'!
invokeModal: allowKeyboardControl
        "Invoke this menu and don't return until the user has chosen a value.  If the allowKeyboarControl boolean is true, permit keyboard control of the menu"

        ^ self
                invokeModalAt: self currentHand position
                in: self currentWorld
                allowKeyboard: allowKeyboardControl! !

!MenuMorph methodsFor: 'private' stamp: 'ct 9/12/2020 14:43'!
positionAt: aPoint relativeTo: aMenuItem inWorld: aWorld
        "Note: items may not be laid out yet (I found them all to be at 0@0), 
        so we have to add up heights of items above the selected item."

        | i yOffset sub delta |
        self fullBounds. "force layout"
        i := 0.
        yOffset := 0.
        [(sub := self submorphs at: (i := i + 1)) == aMenuItem]
                whileFalse: [yOffset := yOffset + sub height].

        self position: aPoint - (2 @ (yOffset + 8)).

        "If it doesn't fit, show it to the left, not to the right of the hand."
        self right > aWorld worldBounds right
                ifTrue:
                        [self right: aPoint x + 1].

        "Make sure that the menu fits in the world."
        delta := self bounds amountToTranslateWithin:
                (aWorld worldBounds withHeight: ((aWorld worldBounds height - 18) max: (self currentHand position y) + 1)).
        delta isZero ifFalse: [self position: self position + delta].! !


!MVCMenuMorph methodsFor: 'invoking' stamp: 'ct 9/11/2020 20:17'!
displayAt: aPoint during: aBlock
        "Add this menu to the Morphic world during the execution of the given block."

        Smalltalk isMorphic ifFalse: [^ self].

        [self currentWorld addMorph: self centeredNear: aPoint.
        self world displayWorld.  "show myself"
        aBlock value]
                ensure: [self delete]! !

!MVCMenuMorph methodsFor: 'invoking' stamp: 'ct 9/11/2020 20:18'!
informUserAt: aPoint during: aBlock
        "Add this menu to the Morphic world during the execution of the given block."

        | title w |
        Smalltalk isMorphic ifFalse: [^ self].
       
        title := self allMorphs detect: [:ea | ea hasProperty: #titleString].
        title := title submorphs first.
        self visible: false.
        w := self currentWorld.
        aBlock value: [:string|
                self visible ifFalse: [
                        w addMorph: self centeredNear: aPoint.
                        self visible: true].
                title contents: string.
                self setConstrainedPosition: Sensor cursorPoint hangOut: false.
                self changed.
                w displayWorld           "show myself"
        ].
        self delete.
        w displayWorld.! !


!Morph class methodsFor: 'fileIn/Out' stamp: 'ct 9/12/2020 14:18'!
fromFileName: fullName
        "Reconstitute a Morph from the file, presumed to be represent a Morph saved
        via the SmartRefStream mechanism, and open it in an appropriate Morphic world"

         | aFileStream morphOrList |
        aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset.
        morphOrList := aFileStream fileInObjectAndCode.
        (morphOrList isKindOf: SqueakPage) ifTrue: [morphOrList := morphOrList contentsMorph].
        Smalltalk isMorphic
                ifTrue: [Project current world addMorphsAndModel: morphOrList]
                ifFalse:
                        [morphOrList isMorph ifFalse: [self inform: 'Can only load a single morph
into an mvc project via this mechanism.' translated].
                        morphOrList openInWorld]! !


!AllPlayersTool class methodsFor: '*Etoys-Squeakland-parts bin' stamp: 'ct 9/12/2020 14:26'!
allPlayersToolForActiveWorld
        "Launch an AllPlayersTool to view the scripted objects of the active world"

        | aTool |
        aTool := self newStandAlone.
        aTool center: self currentWorld center.
        ^ aTool

"
AllPlayersTool allPlayersToolForActiveWorld
"! !


!AllScriptsTool class methodsFor: 'instance creation' stamp: 'ct 9/12/2020 14:26'!
allScriptsToolForActiveWorld
        "Launch an AllScriptsTool to view scripts of the active world"

        | aTool |
        aTool := self newColumn.
        aTool initializeFor: self currentWorld presenter.
        ^ aTool! !


!AnonymousSoundMorph class methodsFor: 'fileIn/Out' stamp: 'ct 9/12/2020 14:26'!
fromFileName: fullName
        "Create an instance of the receiver from the given file path."
       
        | newPlayer aSound ext aName |
        newPlayer := self new initialize.
        ('*aif*' match: fullName)
                ifTrue: [aSound := SampledSound fromAIFFfileNamed: fullName].
        ('*wav' match: fullName)
                ifTrue: [aSound := SampledSound fromWaveFileNamed: fullName].
        newPlayer := self new.

        ext := FileDirectory extensionFor: fullName.
        aName :=  (FileDirectory on: fullName) pathParts last.
        ext size > 0 ifTrue:
                [aName := aName copyFrom: 1 to: (aName size - (ext size + 1))].
       
        newPlayer sound: aSound interimName: aName.

        newPlayer openInWorld; position: self currentWorld center.! !


!BookMorph class methodsFor: 'fileIn/Out' stamp: 'ct 9/12/2020 14:27'!
openFromFile: fullName
        "Reconstitute a Morph from the selected file, presumed to be represent
        a Morph saved via the SmartRefStream mechanism, and open it in an
        appropriate Morphic world"

        | book aFileStream |
        Smalltalk verifyMorphicAvailability ifFalse: [^ self].

        aFileStream := FileStream readOnlyFileNamed: fullName.
        book := BookMorph new.
        book setProperty: #url toValue: aFileStream url.
        book fromRemoteStream: aFileStream.
        aFileStream close.

        Smalltalk isMorphic
                ifTrue: [self currentWorld addMorphsAndModel: book]
                ifFalse: [book isMorph ifFalse: [^self inform: 'Can only load a single morph\into an mvc project via this mechanism.' withCRs translated].
                        book openInWorld].
        book goToPage: 1! !


!EventRecordingSpace class methodsFor: 'instance creation' stamp: 'ct 9/11/2020 19:46'!
openFromPlaybackButton: aButton
        "Open an EventRecordingSpace derived from a playback button.  The primary reason for doing this would be to re-record voiceover."

        | aSpace |
        aSpace := EventRecordingSpace new.
        aSpace initializeFromPlaybackButton: aButton.
        aSpace center: self currentWorld center.
        aSpace openInWorld! !


!FillInTheBlankMorph class methodsFor: 'instance creation' stamp: 'ct 9/12/2020 14:41'!
request: queryString
        "Create an instance of me whose question is queryString. Invoke it centered at the cursor, and answer the string the user accepts. Answer the empty string if the user cancels."
        "FillInTheBlankMorph request: 'What is your favorite color?'"

        ^ self
                request: queryString
                initialAnswer: ''
                centerAt: (self currentHand ifNil: [Sensor]) cursorPoint! !

!FillInTheBlankMorph class methodsFor: 'instance creation' stamp: 'ct 9/12/2020 14:41'!
request: queryString initialAnswer: defaultAnswer
        "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."
        "FillInTheBlankMorph
                request: 'What is your favorite color?'
                initialAnswer: 'red, no blue. Ahhh!!'"

        ^ self
                request: queryString
                initialAnswer: defaultAnswer
                centerAt: (self currentHand ifNil: [Sensor]) cursorPoint! !

!FillInTheBlankMorph class methodsFor: 'instance creation' stamp: 'ct 9/11/2020 19:47'!
request: queryString initialAnswer: defaultAnswer centerAt: aPoint
        "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels.
        This variant is only for calling from within a Morphic project."
        "FillInTheBlankMorph
                request: 'Type something, then type CR.'
                initialAnswer: 'yo ho ho!!'
                centerAt: Display center"

         ^ self
                request: queryString
                initialAnswer: defaultAnswer
                centerAt: aPoint
                inWorld: self currentWorld! !

!FillInTheBlankMorph class methodsFor: '*Etoys-Squeakland-instance creation' stamp: 'ct 9/11/2020 19:47'!
request: queryString initialAnswer: defaultAnswer onCancelReturn: cancelResponse
        "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."
        "FillInTheBlankMorph
                request: 'What is your favorite color?'
                initialAnswer: 'red, no blue. Ahhh!!'"

        ^ self
                request: queryString
                initialAnswer: defaultAnswer
                centerAt: self currentHand cursorPoint
                inWorld: self currentWorld
                onCancelReturn: cancelResponse! !


!HandMorph class methodsFor: 'utilities' stamp: 'ct 9/11/2020 20:11'!
showEvents: aBool
        "HandMorph showEvents: true"
        "HandMorph showEvents: false"

        ShowEvents := aBool.
        aBool ifFalse: [
                Project current world invalidRect: (0@0 extent: 250@120)].! !


!InternalThreadNavigationMorph class methodsFor: 'known threads' stamp: 'ct 9/11/2020 20:15'!
openThreadNamed: nameOfThread atIndex: anInteger beKeyboardHandler: aBoolean
        "Activate the thread of the given name, from the given index; set it up to be navigated via desktop keys if indicated"

        | coll nav |

        coll := self knownThreads at: nameOfThread ifAbsent: [^self].
        nav := Project current world
                submorphThat: [ :each | (each isKindOf: self) and: [each threadName = nameOfThread]]
                ifNone:
                        [nav := self basicNew.
                        nav
                                listOfPages: coll;
                                threadName: nameOfThread index: anInteger;
                                initialize;
                                openInWorld;
                                positionAppropriately.
                        aBoolean ifTrue: [Project current world keyboardNavigationHandler: nav].
                        ^ self].
        nav
                listOfPages: coll;
                threadName: nameOfThread index: anInteger;
                removeAllMorphs;
                addButtons.
        aBoolean ifTrue: [Project current world keyboardNavigationHandler: nav].! !


!MenuMorph class methodsFor: 'utilities' stamp: 'ct 9/12/2020 14:23'!
chooseFrom: aList lines: linesArray title: queryString
        "Choose an item from the given list. Answer the index of the selected item."

        | menu aBlock result |
        aBlock := [:v | result := v].
        menu := self new.
        menu addTitle: queryString.
        1 to: aList size do: [:i|
                menu add: (aList at: i) asString target: aBlock selector: #value: argument: i.
                (linesArray includes: i) ifTrue:[menu addLine]].
        MenuIcons decorateMenu: menu.
        result := 0.
        menu
                invokeAt: self currentHand position
                in: self currentWorld
                allowKeyboard: true.
        ^ result! !

!MenuMorph class methodsFor: 'utilities' stamp: 'ct 9/12/2020 14:23'!
confirm: queryString trueChoice: trueChoice falseChoice: falseChoice
        "Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice,  false if it's the false-choice. This is a modal question -- the user must respond one way or the other."
        "MenuMorph
                confirm: 'Are you hungry?' 
                trueChoice: 'yes, I''m famished' 
                falseChoice: 'no, I just ate'"

        | menu aBlock result |
        aBlock := [:v | result := v].
        menu := self new.
        menu addTitle: queryString icon: MenuIcons confirmIcon.
        menu add: trueChoice target: aBlock selector: #value: argument: true.
        menu add: falseChoice target: aBlock selector: #value: argument: false.
        MenuIcons decorateMenu: menu.
        [menu
                invokeAt: self currentHand position
                in: self currentWorld
                allowKeyboard: true.
        result == nil] whileTrue.
        ^ result! !

!MenuMorph class methodsFor: 'utilities' stamp: 'ct 9/12/2020 14:22'!
inform: queryString
        "MenuMorph inform: 'I like Squeak'"

        | menu |
        menu := self new.
        menu addTitle: queryString icon: MenuIcons confirmIcon.
        menu add: 'OK' translated target: self selector: #yourself.
        MenuIcons decorateMenu: menu.
        menu
                invokeAt: self currentHand position
                in: self currentWorld
                allowKeyboard: true.! !


!MorphHierarchy class methodsFor: 'opening' stamp: 'ct 9/12/2020 14:45'!
openOrDelete
        | oldMorph |
        oldMorph := Project current world submorphs
                                detect: [:each | each hasProperty: #morphHierarchy]
                                ifNone: [| newMorph |
                                        newMorph := self new asMorph.
                                        newMorph bottomLeft: self currentHand position.
                                        newMorph openInWorld.
                                        newMorph isFullOnScreen
                                                ifFalse: [newMorph goHome].
                                        ^ self].
        ""
        oldMorph delete! !


!MorphWorldController methodsFor: 'basic control sequence' stamp: 'ct 9/12/2020 15:15'!
controlTerminate
        "This window is becoming inactive; restore the normal cursor."

        Cursor normal show.
        self
                activeWorld: nil;
                activeHand: nil;
                activeEvent: nil.! !


!MorphicEvent methodsFor: 'initialize' stamp: 'ct 9/12/2020 15:22'!
becomeActiveDuring: aBlock
        "Make the receiver the activeEvent during the evaluation of aBlock."

        | priorEvent |
        priorEvent := self activeEvent.
        self activeEvent: self.
        ^ aBlock ensure: [
                "check to support project switching."
                self activeEvent == self ifTrue: [self activeEvent: priorEvent]]! !


!MultiWindowLabelButtonMorph methodsFor: 'accessing' stamp: 'ct 9/12/2020 14:16'!
performAction
        "Override to interpret the actionSelector as a menu accessor and to activate that menu."

        actionSelector ifNil: [^ self]-
        (model perform: actionSelector) ifNotNil: [:menu |
                menu
                        invokeModalAt: self position - (0@5)
                        in: self currentWorld
                        allowKeyboard: Preferences menuKeyboardControl].! !


!NativeImageSegment methodsFor: 'read/write segment' stamp: 'ct 9/12/2020 14:15'!
smartFillRoots: dummy
        | refs known ours ww blockers |
        "Put all traced objects into my arrayOfRoots.  Remove some
that want to be in outPointers.  Return blockers, an
IdentityDictionary of objects to replace in outPointers."

        blockers := dummy blockers.
        known := (refs := dummy references) size.
        refs keys do: [:obj | "copy keys to be OK with removing items"
                (obj isSymbol) ifTrue: [refs removeKey: obj.  known := known-1].
                (obj class == PasteUpMorph) ifTrue: [
                        obj isWorldMorph & (obj owner == nil) ifTrue: [
                                (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [
                                        refs removeKey: obj.  known := known-1.
                                        blockers at: obj put:
                                                (StringMorph contents: 'The worldMorph of a different world')]]].
                                        "Make a ProjectViewMorph here"
                "obj class == Project ifTrue: [Transcript show: obj; cr]."
                (blockers includesKey: obj) ifTrue: [
                        refs removeKey: obj ifAbsent: [known := known+1].  known := known-1].
                ].
        ours := (dummy project ifNil: [Project current]) world.
        refs keysDo: [:obj |
                        obj isMorph ifTrue: [
                                ww := obj world.
                                (ww == ours) | (ww == nil) ifFalse: [
                                        refs removeKey: obj.  known := known-1.
                                        blockers at: obj put: (StringMorph contents:
                                                                obj printString, ' from another world')]]].
        "keep original roots on the front of the list"
        dummy rootObject do: [:rr | refs removeKey: rr ifAbsent: []].
        (self respondsTo: #classOrganizersBeRoots:) ifTrue: "an EToys extension"
                [self classOrganizersBeRoots: dummy].
        ^dummy rootObject, refs keys asArray! !


!NebraskaSenderMorph methodsFor: 'parts bin' stamp: 'ct 9/12/2020 14:14'!
initializeToStandAlone

        super initializeToStandAlone.
        self installModelIn: Project current world.! !


!NebraskaServerMorph class methodsFor: 'as yet unclassified' stamp: 'ct 9/12/2020 14:14'!
serveWorld

        ^ self serveWorld: self currentWorld
! !


!NewVariableDialogMorph methodsFor: 'build' stamp: 'ct 9/12/2020 14:14'!
rebuild
        | buttonColor itsName enableDecimalPlaces |
        self removeAllMorphs.
        self addAColumn: {
                self lockedString: self title.
        }.
        self addSeparator.

        self addARow: {
                self inAColumn: {
                        (self addARow: {
                                self lockedString: 'Name:' translated.
                                self spacer.
                                varNameText := self newTextMorph
                                                                                contentsWrapped: self varName;
                                                                                selectAll;
                                                                                crAction: (MessageSend
                                                                                        receiver: self
                                                                                        selector: #doAccept);
                                                                                yourself
                        }) cellPositioning: #center.
                        self inAColumn: {
                                                                (self addARow: {
                                                                        self lockedString: 'Type:' translated.
                                                                        self spacer.
                                                                        varTypeButton := self buildVarTypeButton
                                                                }) cellPositioning: #center.
                                                                } named: #varType.
                }
        }.
        self currentHand newKeyboardFocus: varNameText.
        self addSeparator.
        self addDecimalPlaces.
        enableDecimalPlaces := false.
        (#(#Number #Point) includes: self varType)
                ifTrue: [ enableDecimalPlaces := true].
        self allMorphsDo: [ :each |
                                itsName := each knownName.
                                (#(decimalPlaces) includes: itsName) ifTrue:
                                                        [self enable: each when: enableDecimalPlaces]].

       


        buttonColor := self color lighter.
        self addARow: {
                self inAColumn: {
                        (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.
                        }) listCentering: #center
                }
        }! !


!ObjectExplorer methodsFor: 'monitoring' stamp: 'ct 9/12/2020 14:12'!
step
        "Let all views know that some of my objects need to be updated."

        self monitorList do: [ :object |
                object ifNotNil: [self changed: #objectChanged with: object]].
        self monitorList ifEmpty: [
                self world stopStepping: self selector: #step ].! !

!ObjectExplorer methodsFor: 'monitoring' stamp: 'ct 9/12/2020 14:12'!
world

        ^ Project current world! !

!ObjectExplorer methodsFor: 'accessing - view' stamp: 'ct 9/12/2020 14:12'!
views

        ^ self findDeepSubmorphsIn: self world that: [:morph |
                morph modelOrNil = self]! !


!ObjectsTool methodsFor: 'search' stamp: 'ct 9/12/2020 14:45'!
showSearchPane
        "Set the receiver up so that it shows the search pane"

        | tabsPane aPane |
        modeSymbol == #search ifTrue: [ ^self ].

        self partsBin removeAllMorphs.

        tabsPane := self tabsPane.
        aPane := self newSearchPane.
        self replaceSubmorph: tabsPane by: aPane.

        self modeSymbol: #search.
        self showMorphsMatchingSearchString.
        self currentHand newKeyboardFocus: aPane! !


!ParagraphEditor methodsFor: 'nonediting/nontyping keys' stamp: 'ct 9/12/2020 14:12'!
escapeToDesktop: characterStream
        "Pop up a morph to field keyboard input in the context of the desktop"

        Smalltalk isMorphic ifTrue: [
                Project current world putUpWorldMenuFromEscapeKey].
        ^ true! !

!ParagraphEditor methodsFor: '*Etoys-Squeakland-editing keys' stamp: 'ct 9/12/2020 14:07'!
shiftEnclose: characterStream
        "Insert or remove bracket characters around the current selection.
         Flushes typeahead."

        | char left right startIndex stopIndex oldSelection which text |
        char := sensor keyboard.
        char = $9 ifTrue: [ char := $( ].
        char = $, ifTrue:     "[ char := $< ]"
                [self closeTypeIn.
                Project current world showSourceKeyHit.
                ^ true].
        char = $[ ifTrue: [ char := ${ ].
        char = $' ifTrue: [ char := $" ].
        char asciiValue = 27 ifTrue: [ char := ${ ].    "ctrl-["

        self closeTypeIn.
        startIndex := self startIndex.
        stopIndex := self stopIndex.
        oldSelection := self selection.
        which := '([<{"''' indexOf: char ifAbsent: [1].
        left := '([<{"''' at: which.
        right := ')]>}"''' at: which.
        text := paragraph text.
        ((startIndex > 1 and: [stopIndex <= text size])
                and:
                [(text at: startIndex-1) = left and: [(text at: stopIndex) = right]])
                ifTrue:
                        ["already enclosed; strip off brackets"
                        self selectFrom: startIndex-1 to: stopIndex.
                        self replaceSelectionWith: oldSelection]
                ifFalse:
                        ["not enclosed; enclose by matching brackets"
                        self replaceSelectionWith:
                                (Text string: (String with: left), oldSelection string ,(String with: right)
                                        emphasis: emphasisHere).
                        self selectFrom: startIndex+1 to: stopIndex].
        ^true! !


!PasteUpMorph methodsFor: 'accessing' stamp: 'ct 9/12/2020 14:10'!
flapTab
        "Answer the tab affilitated with the receiver.  Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'"

        | ww |
        self isFlap ifFalse: [^ nil].
        ww := self presenter associatedMorph ifNil: [self].
        ^ ww flapTabs
                detect: [:any| any referent == self]
                ifNone: [nil]! !

!PasteUpMorph methodsFor: 'events-processing' stamp: 'ct 9/12/2020 15:11'!
processEvent: anEvent using: defaultDispatcher
        "Reimplemented to install the receiver as the new ActiveWorld if it is one"

        self isWorldMorph ifFalse: [
                ^ super processEvent: anEvent using: defaultDispatcher].
       
        ^ self activateWorld: self during: [
                super processEvent: anEvent using: defaultDispatcher]! !

!PasteUpMorph methodsFor: 'flaps' stamp: 'ct 9/12/2020 14:11'!
correspondingFlapTab
        "If there is a flap tab whose referent is me, return it, else return nil.  Will also work for flaps on the edge of embedded subareas such as within scripting-areas, but more slowly."

        self currentWorld flapTabs do:
                [:aTab | aTab referent == self ifTrue: [^ aTab]].

        "Catch guys in embedded worldlets"
        self currentWorld allMorphs do:
                [:aTab | ((aTab isKindOf: FlapTab) and: [aTab referent == self]) ifTrue: [^ aTab]].

        ^ nil! !

!PasteUpMorph methodsFor: 'initialization' stamp: 'ct 9/12/2020 15:33'!
becomeActiveDuring: aBlock
        "Make the receiver the activeWorld during the evaluation of aBlock."

        | priorWorld |
        priorWorld := self activeWorld.
        self activeWorld: self.
        ^ aBlock ensure: [
                "check to support project switching."
                self activeWorld == self ifTrue: [self activeWorld: priorWorld]]! !

!PasteUpMorph methodsFor: 'menu & halo' stamp: 'ct 9/12/2020 14:07'!
putUpPenTrailsSubmenu
        "Put up the pen trails menu"

        | aMenu |
        aMenu := MenuMorph new defaultTarget: self.
        aMenu title: 'pen trails' translated.
        aMenu addStayUpItem.
        self addPenTrailsMenuItemsTo: aMenu.
        ^ aMenu popUpInWorld: self! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'ct 9/12/2020 14:45'!
extractScreenRegion: poly andPutSketchInHand: hand
        "The user has specified a polygonal area of the Display.
        Now capture the pixels from that region, and put in the hand as a Sketch."
        | screenForm outline topLeft innerForm exterior |
        outline := poly shadowForm.
        topLeft := outline offset.
        exterior := (outline offset: 0@0) anyShapeFill reverse.
        screenForm := Form fromDisplay: (topLeft extent: outline extent).
        screenForm eraseShape: exterior.
        innerForm := screenForm trimBordersOfColor: Color transparent.
        self currentHand showTemporaryCursor: nil.
        innerForm isAllWhite ifFalse:
                [hand attachMorph: (self drawingClass withForm: innerForm)]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'ct 9/11/2020 20:07'!
initializeDesktopCommandKeySelectors
        "Provide the starting settings for desktop command key selectors.  Answer the dictionary."

        "ActiveWorld initializeDesktopCommandKeySelectors"
        | dict |
        dict := IdentityDictionary new.
        self defaultDesktopCommandKeyTriplets do: [:trip |
                | messageSend |
                messageSend := MessageSend receiver: trip second selector: trip third.
                dict at: trip first put: messageSend].
        self setProperty: #commandKeySelectors toValue: dict.
        ^ dict! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'ct 9/11/2020 18:00'!
putUpWorldMenuFromEscapeKey
        Preferences noviceMode
                ifFalse: [self putUpWorldMenu: self currentEvent]! !

!PasteUpMorph methodsFor: 'world state' stamp: 'ct 9/12/2020 15:11'!
install

        owner := nil.   "since we may have been inside another world previously"
        self activeWorld: self.
        self activeHand: self hands first. "default"
        self activeEvent: nil.
       
        submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]].
        "Transcript that was in outPointers and then got deleted."
        self viewBox: Display boundingBox.
        EventSensor default flushEvents.
        worldState handsDo: [:h | h initForEvents].
        self installFlaps.
        self borderWidth: 0.    "default"
        (Preferences showSecurityStatus
                and: [SecurityManager default isInRestrictedMode])
                        ifTrue:
                                [self
                                        borderWidth: 2;
                                        borderColor: Color red].
        self presenter allExtantPlayers do: [:player | player prepareToBeRunning].
        SystemWindow noteTopWindowIn: self.! !

!PasteUpMorph methodsFor: 'world state' stamp: 'ct 9/12/2020 14:06'!
repositionFlapsAfterScreenSizeChange
        "Reposition flaps after screen size change"

        (Flaps globalFlapTabsIfAny, self localFlapTabs) do:
                [:aFlapTab |
                        aFlapTab applyEdgeFractionWithin: self bounds].
        Flaps doAutomaticLayoutOfFlapsIfAppropriate! !

!PasteUpMorph methodsFor: '*Tools' stamp: 'ct 9/11/2020 20:07'!
defaultDesktopCommandKeyTriplets
        "Answer a list of triplets of the form
                <key> <receiver> <selector>   [+ optional fourth element, a <description> for use in desktop-command-key-help]
        that will provide the default desktop command key handlers.  If the selector takes an argument, that argument will be the command-key event"
        "World initializeDesktopCommandKeySelectors"

        | noviceKeys expertKeys |

        noviceKeys := {
                {$o. self. #activateObjectsTool. 'Activate the "Objects Tool"' translated}.
                {$r. self. #restoreMorphicDisplay. 'Redraw the screen' translated}.
                {$z. self. #undoOrRedoCommand. 'Undo or redo the last undoable command' translated}.
                {$F. Project current. #toggleFlapsSuppressed. 'Toggle the display of flaps' translated}.
                {$N. self. #toggleClassicNavigatorIfAppropriate. 'Show/Hide the classic Navigator, if appropriate' translated}.
                {$M. self. #toggleShowWorldMainDockingBar. 'Show/Hide the Main Docking Bar' translated}.
                {$]. Smalltalk. #saveSession. 'Save the image.' translated}.
        }.
       
        Preferences noviceMode ifTrue: [^ noviceKeys].
       
        expertKeys := {
                {$b. SystemBrowser. #defaultOpenBrowser. 'Open a new System Browser' translated}.
                {$k. Workspace. #open. 'Open a new Workspace' translated}.
                {$m. self. #putUpNewMorphMenu. 'Put up the "New Morph" menu' translated}.
                {$O. self. #findAMonticelloBrowser. 'Bring a Monticello window into focus.' translated}.
                {$t. self. #findATranscript:. 'Make a System Transcript visible' translated}.
                {$w. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}.
                {Character escape. SystemWindow. #closeTopWindow. 'Close the topmost window' translated}.
               
                {$C. self. #findAChangeSorter:. 'Make a Change Sorter visible' translated}.
               
                {$L. self. #findAFileList:. 'Make a File List visible' translated}.
                {$P. self. #findAPreferencesPanel:. 'Activate the Preferences tool' translated}.
                {$R. Utilities. #browseRecentSubmissions. 'Make a Recent Submissions browser visible' translated}.
               
                {$W. self. #findAMessageNamesWindow:. 'Make a MessageNames tool visible' translated}.
                {$Z. ChangeList. #browseRecentLog. 'Browse recently-logged changes' translated}.
               
                {$\. SystemWindow. #sendTopWindowToBack. 'Send the top window to the back' translated}.
                {$_. Smalltalk. #quitPrimitive. 'Quit the image immediately.' translated}.
               
                {$-. Preferences. #decreaseFontSize. 'Decrease all font sizes' translated}.
                {$+. Preferences. #increaseFontSize. 'Increase all font sizes' translated}.
        }.
       
        ^ noviceKeys, expertKeys! !

!PasteUpMorph methodsFor: '*Etoys-playfield' stamp: 'ct 9/12/2020 14:10'!
galleryOfPlayers
        "Put up a tool showing all the players in the project"
       
        (Project current world findA: AllPlayersTool) ifNotNil: [:aTool | ^ aTool comeToFront].
        AllPlayersTool newStandAlone openInHand

"ActiveWorld galleryOfPlayers"! !

!PasteUpMorph methodsFor: '*Etoys-world menu' stamp: 'ct 9/12/2020 14:36'!
attemptCleanupReporting: whetherToReport
        "Try to fix up some bad things that are known to occur in some etoy projects we've seen. If the whetherToReport parameter is true, an informer is presented after the cleanups"

        | fixes faultyStatusControls |
        fixes := 0.
        self world ifNotNil: [:world | world submorphs
                select: [:m | (m isKindOf: ScriptEditorMorph) and: [m submorphs isEmpty]]
                thenDo: [:m | m delete. fixes := fixes + 1]].
       
        TransformationMorph allSubInstancesDo:
                [:m | (m player notNil and: [m renderedMorph ~~ m])
                        ifTrue:
                                [m renderedMorph visible ifFalse:
                                        [m renderedMorph visible: true.  fixes := fixes + 1]]].

        (Player class allSubInstances select: [:cl | cl isUniClass and: [cl instanceCount > 0]]) do:
                [:aUniclass |
                        fixes := fixes + aUniclass cleanseScripts].

        self presenter flushPlayerListCache; allExtantPlayers.

        faultyStatusControls := ScriptStatusControl allInstances select: [:m |m  fixUpScriptInstantiation].
        fixes := fixes + faultyStatusControls size.

        ScriptNameTile allInstancesDo:
                [:aTile | aTile submorphs isEmpty ifTrue:
                        [aTile setLiteral: aTile literal.
                        fixes := fixes + 1]].

        whetherToReport
                ifTrue:
                        [self inform: ('{1} [or more] repair(s) made' translated format: {fixes printString})]
                ifFalse:
                        [fixes > 0 ifTrue: [Transcript cr; show: fixes printString, ' repairs made to existing content.']]
       
"
ActiveWorld attemptCleanupReporting: true.
ActiveWorld attemptCleanupReporting: false.
"! !

!PasteUpMorph methodsFor: '*Etoys-world menu' stamp: 'ct 9/12/2020 14:09'!
hideAllPlayers
        "Remove all Viewers belonging to scripted players associated with the receiver or any of its subjects from the screen."

        | a |
        a := OrderedCollection new.
        self allMorphsDo: [ :x |
                (self presenter currentlyViewing: x player) ifTrue:
                        [a add: x player viewerFlapTab]].
       
        a do: [ :each | each dismissViaHalo].! !

!PasteUpMorph methodsFor: '*Etoys-support' stamp: 'ct 9/12/2020 14:08'!
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"

        self flag: #deprecate "ct: No senders".
       
        ScriptEditorMorph allInstancesDo:
                [:m | m userScriptObject].
        Flaps enableOnlyGlobalFlapsWithIDs: {'Supplies' translated}.
        self abandonOldReferenceScheme.
        self relaunchAllViewers.! !

!PasteUpMorph methodsFor: '*Etoys-Squeakland-menu' stamp: 'ct 9/12/2020 14:11'!
abandonUnsituatedPlayers
        "If any objects in the project have references, in player-valued variables, to other objects otherwise not present in the project, abandon them and replace former references to them by references to Dot"

        | aList dot slotInfo varName ref allPlayers count |
        count := 0.
        allPlayers := self presenter reallyAllExtantPlayersNoSort.
        aList := allPlayers select: [:m | m belongsToUniClass].
        dot := self presenter standardPlayer.
        aList do:
                [:p |
                        p class slotInfo associationsDo:
                                [:assoc |
                                        slotInfo := assoc value.
                                        varName := assoc key.
                                        (slotInfo type = #Player) ifTrue:
                                                [ref := p instVarNamed: varName.
                                                (allPlayers includes: ref) ifFalse:
                                                        [p instVarNamed: varName put: dot.
                                                        count := count + 1.
                                                        Transcript cr; show: ('Variable named "{1}" in player named "{2}" changed to point to Dot' translated format: {varName. ref externalName})]]]].
        aList := nil.  "Increases chance of the next line having desired effect."
        self inform: ('{1} item(s) fixed up' translated format: {count}).

        WorldState addDeferredUIMessage: [Smalltalk garbageCollect]! !

!PasteUpMorph methodsFor: '*Etoys-Squeakland-world menu' stamp: 'ct 9/12/2020 14:07'!
putUpShowSourceMenu: evt title: aTitle
        "Put up a menu in response to the show-source button being hit"

        | menu |
        self bringTopmostsToFront.
        "put up the show-source menu"
        menu := (TheWorldMenu new adaptToWorld: self) buildShowSourceMenu.
        menu addTitle: aTitle.
        menu popUpEvent: evt in: self.
        ^ menu! !

!PasteUpMorph methodsFor: '*Etoys-Squeakland-world menu' stamp: 'ct 9/11/2020 18:01'!
showSourceKeyHit
        "The user hit the 'show source' key on the XO.  Our current take on this is simply to put up the world menu..."

        ^ self putUpShowSourceMenu: self currentEvent title: 'etoys source' translated! !

!PasteUpMorph methodsFor: '*Etoys-Squeakland-menus' stamp: 'ct 9/12/2020 14:46'!
presentDesktopColorMenu
        "Present the menu that governs the fill style of the squeak desktop."

        | aMenu |
        aMenu := MenuMorph new defaultTarget: self.
        aMenu title: 'desktop color' translated.
        self fillStyle addFillStyleMenuItems: aMenu hand: self currentHand from: self.
        aMenu addLine.
        aMenu add: 'solid fill' translated action: #useSolidFill.
        aMenu add: 'gradient fill' translated action: #useGradientFill.
        aMenu add: 'bitmap fill' translated action: #useBitmapFill.
        aMenu add: 'default fill' translated action: #useDefaultFill.
        ^ aMenu popUpInWorld! !


!EventTimeline methodsFor: 'dropping/grabbing' stamp: 'ct 9/11/2020 19:47'!
acceptDroppingMorph: aMorph event: evt
        "Accept the drop of a morph."

        | aRect anEventRoll itsDuration itsWidthAfterDrop |
        self flag: #deferred.  "This is a possible place for discovering whether the drop would have damaging effects on the mouse track..."

        (aMorph isKindOf: MouseEventSequenceMorph)
                ifTrue:
                        [itsDuration := aMorph durationInMilliseconds.
                        itsWidthAfterDrop := itsDuration // self eventRoll millisecondsPerPixel.
                        super acceptDroppingMorph: aMorph event: evt.
                        aMorph bounds: ((aMorph left @ 6) extent: (itsWidthAfterDrop @ aMorph height)).
                        submorphs do:
                                [:m |
                                        ((m ~~ aMorph) and: [m isKindOf: MouseEventSequenceMorph])
                                                ifTrue:
                                                        [(m bounds intersects: aMorph bounds)
                                                                ifTrue:
                                                                        ["Eureka"
                                                                        aMorph delete.
                                                                        aMorph position: 100@100.
                                                                        aMorph openInWorld.
                                                                        aMorph flash.
                                                                        ^ self]]]]
                ifFalse:
                        [super acceptDroppingMorph: aMorph event: evt]
.
        aRect := (((aMorph left + 10) max: 10) @ 0) extent: 100@ 10.

        (anEventRoll  := self eventRoll) pushChangesBackToEventTheatre.  "Note that will ultimately result in replacement of the receiver by a new timeline"
        aMorph delete.
        self currentWorld abandonAllHalos.
        anEventRoll scrollPaneForRoll scrollHorizontallyToShow: aRect! !


!PasteUpMorph class methodsFor: '*Etoys-Squeakland-eToys-scripting' stamp: 'ct 9/12/2020 14:09'!
putativeAdditionsToViewerCategoryPlayfieldOptions
        "Answer playfield options additions.  Some of these are not yet underpinned by code in the current image; these will follow in due course."

        self flag: #deprecate. "ct: No senders"
       
        ^ #(#'playfield options' (
                (command roundUpStrays '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.')
                (command makeFitContents 'Adjust my bounds so that I fit precisely around all the objects within me')
                (command showAllPlayers 'Make visible the viewers for all players which have user-written scripts in this playfield.')
                (command hideAllPlayers 'Make invisible the viewers for all players in this playfield. This will save space before you publish this project')
                (command shuffleSubmorphs 'Rearranges my contents in random order')
                (command showAllObjectNames 'show names beneath all the objects currently in my interior, except for those for which showing such names is inappropriate.')
                (command hideAllObjectNames 'stop showing names beneath all the objects of my interior,  If any of them is marked to "always show name", remove that designation')))! !


!PartsBin class methodsFor: '*Etoys-Squeakland-thumbnail cache' stamp: 'ct 9/12/2020 14:11'!
rebuildIconsWithProgress
        "Put up an eye-catching progress morph while doing a complete rebuild of all the parts icons in the system."

        | fixBlock |
        fixBlock := Project current displayProgressWithJump: 'Building icons' translated.
        self clearThumbnailCache.
        self cacheAllThumbnails.
        fixBlock value.
        Project current world fullRepaintNeeded.! !


!PhraseTileMorph methodsFor: '*Etoys-Squeakland-hilighting' stamp: 'ct 9/11/2020 20:47'!
addCommandFeedback: evt
        "Add screen feedback showing what would be torn off in a drag"

        | aMorph |
        (self owner owner isMemberOf: PhraseTileMorph)
                ifTrue: [self owner owner addCommandFeedback: evt. ^ self].
        aMorph := RectangleMorph new bounds: ((self topLeft - (2@1)) corner: ((submorphs at: (2 max: submorphs size)) bottomRight + (2@1))).
        "inHotZone := evt ifNil: [true] ifNotNil: [rect containsPoint: evt cursorPoint]."
        aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
        Project current world addHighlightMorph: aMorph for: self outmostScriptEditor! !

!PhraseTileMorph methodsFor: '*Etoys-Squeakland-hilighting' stamp: 'ct 9/11/2020 20:47'!
removeHighlightFeedback
        "Remove any existing highlight feedback"

        ^ Project current world removeHighlightFeedback
! !

!PhraseTileMorph methodsFor: '*Etoys-Squeakland-mouse' stamp: 'ct 9/11/2020 20:47'!
createMultipleTestScripts: aCount
        "Simulate the action of dropping a copy of the receiver to launch a new script -- for performance testing.  To use:  Open an Inspector on some tile command in a Viewer, e.g. on 'Car forward 5'.  In the trash pane of that Inspector, then, evaluate expressions like:
         [self createMultipleTestScripts: 10] timeToRun.
        and
                MessageTally spyOn:  [self createMultipleTestScripts: 4]
"

        | aPosition |
        aPosition := 10@10.
        1 to: aCount do:
                [:i | self forceScriptCreationAt: aPosition.
                aPosition := aPosition + (0 @ 50). "avoid dropping into existing scriptor"
                Project current world doOneCycle]  "refresh viewer"! !

!PhraseTileMorph methodsFor: '*Etoys-Squeakland-mouse' stamp: 'ct 9/12/2020 14:47'!
forceScriptCreationAt: aPosition
        "For performance testing."

         | dup |
        dup := self duplicate.
        dup eventHandler: nil.   "Remove viewer-related evt mouseover feedback"
        dup formerPosition: self currentHand position.
        self currentHand
                attachMorph: dup;
                simulateMorphDropAt: aPosition.! !


!PhraseTileForTest methodsFor: 'as yet unclassified' stamp: 'ct 9/11/2020 20:47'!
addCommandFeedback: evt
        "Add screen feedback showing what would be torn off in a drag"

        | aMorph |
        (self owner owner isMemberOf: PhraseTileMorph) ifTrue: [self owner owner addCommandFeedback: evt. ^ self].
        aMorph := RectangleMorph new bounds: ((self topLeft - (2@1)) corner: (self bottomRight) + (2@1)).
        aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
        Project current world addHighlightMorph: aMorph for: self outmostScriptEditor! !

!PhraseTileForTest methodsFor: 'mouse' stamp: 'ct 9/12/2020 14:46'!
mouseDown: evt
        "Handle a mouse-down on the receiver"

        | guyToTake catViewer |
        guyToTake := CompoundTileMorph new.
        guyToTake setNamePropertyTo: 'TestTile' translated.
        guyToTake position: evt position + (-25@8).

        guyToTake formerPosition: evt hand position.
        "self startSteppingSelector: #trackDropZones."
        (catViewer := self ownerThatIsA: CategoryViewer) ifNotNil:
                [guyToTake setProperty: #newPermanentPlayer toValue: catViewer scriptedPlayer.
                guyToTake setProperty: #newPermanentScript toValue: true].
        guyToTake justGrabbedFromViewer: true.

        ^ evt hand grabMorph: guyToTake! !


!PhraseTileForTimesRepeat methodsFor: 'hilighting' stamp: 'ct 9/11/2020 20:47'!
addCommandFeedback: evt
        "Add screen feedback showing what would be torn off in a drag"

        | aMorph |
       
        (self owner owner isMemberOf: PhraseTileMorph) ifTrue: [self owner owner addCommandFeedback: evt. ^ self].
        aMorph := RectangleMorph new bounds: ((self topLeft - (2@1)) corner: (self bottomRight) + (2@1)).
        aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
        Project current world addHighlightMorph: aMorph for: self outmostScriptEditor! !

!PhraseTileForTimesRepeat methodsFor: 'mouse' stamp: 'ct 9/12/2020 14:46'!
mouseDown: evt
        "Handle a mouse-down on the receiver"

        | guyToTake catViewer |
        guyToTake := TimesRepeatTile new.
        guyToTake setNamePropertyTo: 'Repeat Tile' translated.
        guyToTake position: evt position + (-25@8).
       
        guyToTake formerPosition: evt hand position.
        "self startSteppingSelector: #trackDropZones."
        (catViewer := self ownerThatIsA: CategoryViewer) ifNotNil:
                [guyToTake setProperty: #newPermanentPlayer toValue: catViewer scriptedPlayer.
                guyToTake setProperty: #newPermanentScript toValue: true].
        guyToTake justGrabbedFromViewer: true.
       
        ^ evt hand grabMorph: guyToTake! !


!Player methodsFor: 'misc' stamp: 'ct 9/11/2020 20:46'!
adoptScriptsFrom
        "Let the user click on another object form which the receiver should obtain scripts and code"

        | aMorph |
        Sensor waitNoButton.
        aMorph := Project current world chooseClickTarget.
        aMorph ifNil: [^ Beeper beep].

        (aMorph renderedMorph isSketchMorph
                and: [aMorph player belongsToUniClass]
                and: [self belongsToUniClass not])
                        ifTrue: [costume acquirePlayerSimilarTo: aMorph player]
                        ifFalse: [Beeper beep].! !

!Player methodsFor: 'misc' stamp: 'ct 9/11/2020 20:46'!
beRevealedInActiveWorld
        "Reveal my corresponding morph in the active world"

        self revealPlayerIn: Project current world! !

!Player methodsFor: 'misc' stamp: 'ct 9/11/2020 20:45'!
grabPlayerInActiveWorld
        "Invoked from a Viewer: rip my morph out of its container, wherever that may be, and place it in the hand, being careful to set things up so that if the subsequent drop is rejected, the morph will end up in a visible location on the screen"

        ^ self grabPlayerIn: Project current world! !

!Player methodsFor: 'misc' stamp: 'ct 9/12/2020 14:47'!
grabPlayerIn: aWorld
        "Invoked from a Viewer: rip my morph out of its container, wherever that may be, and place it in the hand, being careful to set things up so that if the subsequent drop is rejected, the morph will end up in a visible location on the screen"

        | aMorph newPosition |
        self costume == aWorld ifTrue: [^ self].
        self currentHand releaseMouseFocus.
        (aMorph := self costume) visible: true.
        newPosition := self currentHand position - (aMorph extent // 2).
        aMorph isInWorld
                ifTrue:
                        [aMorph goHome.
                        aMorph formerPosition: aMorph positionInWorld]
                ifFalse:
                        [aMorph formerPosition: aWorld center].
        aMorph formerOwner: Project current world.
        aMorph position: newPosition.
       
        self currentHand
                targetOffset: aMorph position - self currentHand position;
                addMorphBack: aMorph.! !

!Player methodsFor: 'misc' stamp: 'ct 9/11/2020 20:45'!
impartSketchScripts
        "Let the user designate another object to which my scripts and code should be imparted"

        | aMorph |
        Sensor waitNoButton.
        aMorph := Project current world chooseClickTarget.
        aMorph ifNil: [^ self].
        (aMorph renderedMorph isSketchMorph) ifTrue: [
                aMorph acquirePlayerSimilarTo: self].! !

!Player methodsFor: 'misc' stamp: 'ct 9/11/2020 20:44'!
offerAlternateViewerMenuFor: aViewer event: evt
        "Put up an alternate Viewer menu on behalf of the receiver."

        | menu world  |
        world := aViewer world.
        menu := MenuMorph new defaultTarget: self.
        (costumes notNil and: [
                (costumes size > 1 or: [costumes size == 1 and: [costumes first ~~ costume renderedMorph]])]) ifTrue:
                                [menu add: 'forget other costumes' translated target: self selector: #forgetOtherCostumes].
       
        menu add: 'expunge empty scripts' translated target: self action: #expungeEmptyScripts.
        menu addLine.
        menu
                add: 'choose vocabulary...' translated target: aViewer action: #chooseVocabulary;
                balloonTextForLastItem: 'Choose a different vocabulary for this Viewer.' translated.
        menu
                add: 'choose limit class...' translated target: aViewer action: #chooseLimitClass;
                balloonTextForLastItem: 'Specify what the limitClass should be for this Viewer -- i.e., the most generic class whose methods and categories should be considered here.' translated.
       
        menu
                add: 'open standard lexicon' translated target: aViewer action: #openLexicon;
                balloonTextForLastItem: 'open a window that shows the code for this object in traditional programmer format' translated.
       
        menu
                add: 'open lexicon with search pane' translated target: aViewer action: #openSearchingProtocolBrowser;
                balloonTextForLastItem: 'open a lexicon that has a type-in pane for search (not recommended!!)' translated.
       
       
        menu addLine.
        menu add: 'inspect morph' translated target: costume selector: #inspect.
        menu add: 'inspect player' translated target: self selector: #inspect.
        self belongsToUniClass ifTrue: [
                menu add: 'browse class' translated target: self action: #browsePlayerClass.
                menu add: 'inspect class' translated target: self class action: #inspect].
        menu add: 'inspect this Viewer' translated target: aViewer selector: #inspect.
        menu add: 'inspect this Vocabulary' translated target: aViewer currentVocabulary selector: #inspect.
       
        menu addLine.
        menu add: 'relaunch this Viewer' translated target: aViewer action: #relaunchViewer.
        menu add: 'attempt repairs' translated target: Project current world action: #attemptCleanup.
        menu add: 'destroy all this object''s scripts' translated target: self action: #destroyAllScripts.
        menu add: 'view morph directly' translated target: aViewer action: #viewMorphDirectly.
        menu balloonTextForLastItem: 'opens a Viewer directly on the rendered morph.' translated.
        costume renderedMorph isSketchMorph ifTrue: [
                menu addLine.
                menu add: 'impart scripts to...' translated target: self action: #impartSketchScripts].
       
        ^ menu popUpEvent: evt in: world! !

!Player methodsFor: 'scripts-standard' stamp: 'ct 9/12/2020 14:48'!
hide
        "Make the object be hidden, as opposed to visible"

        self currentHand ifNotNil: [:hand |
                (hand keyboardFocus == self costume renderedMorph) ifTrue: [
                        hand releaseKeyboardFocus]].
        self costume hide.! !

!Player methodsFor: 'slot getters/setters' stamp: 'ct 9/11/2020 20:45'!
getLastKeystroke
        "Answer the last keystroke fielded"

        ^ Project current world lastKeystroke! !

!Player methodsFor: 'slot getters/setters' stamp: 'ct 9/11/2020 20:41'!
setLastKeystroke: aString
        "Set the last keystroke fielded"

        ^ self currentWorld lastKeystroke: aString! !

!Player methodsFor: 'slot getters/setters' stamp: 'ct 9/12/2020 14:49'!
setSecondColor: aColor
        "Setter for costume's second color, if it's using gradient fill; if not, does nothing"

        | morph fillStyle colorToUse |
        morph := costume renderedMorph.
        fillStyle := morph fillStyle.
        fillStyle isGradientFill ifFalse: [^ self].
       
        colorToUse := (costume isWorldMorph and: [aColor isColor])
                ifTrue: [aColor alpha: 1.0]  "reject any translucency"
                ifFalse: [aColor].
        fillStyle lastColor: colorToUse forMorph: morph hand: self currentHand.! !

!Player methodsFor: 'slots-user' stamp: 'ct 9/11/2020 20:47'!
addInstanceVariable
        "Offer the user the opportunity to add an instance variable, and if he goes through with it, actually add it."

        Project current world
                addMorphInLayer: (NewVariableDialogMorph on: self costume)
                centeredNear: (self currentHand ifNil:[Sensor]) cursorPoint! !

!Player methodsFor: 'slots-user' stamp: 'ct 9/11/2020 20:46'!
allPossibleWatchersFromWorld
        "Answer a list of all UpdatingStringMorphs, PlayerReferenceReadouts, ThumbnailMorphs, and  UpdatingReferenceMorphs in the Active world and its hidden book pages, etc., which have me or any of my siblings as targets"

        | a |
        a := IdentitySet new: 400.
        Project current world allMorphsAndBookPagesInto: a.
        ^ a select: [:e | e isEtoyReadout and: [e target class == self class]]! !

!Player methodsFor: 'slots-user' stamp: 'ct 9/12/2020 14:48'!
offerGetterTiles: slotName
        "For a player-type slot, offer to build convenient compound tiles that otherwise would be hard to get"

        | typeChoices typeChosen thePlayerThereNow slotChoices slotChosen getterTiles aCategoryViewer playerGetter |
        typeChoices := Vocabulary typeChoices.
        typeChosen := UIManager default
                chooseFrom: (typeChoices collect: [:t | t translated])
                values: typeChoices
                title: ('Choose the TYPE
of data to get from
{1}''s {2}' translated format: {self externalName. slotName translated}).
        typeChosen isEmptyOrNil ifTrue: [^self].
        thePlayerThereNow := self perform: slotName asGetterSelector.
        thePlayerThereNow
                ifNil: [thePlayerThereNow := self presenter standardPlayer].
        slotChoices := thePlayerThereNow slotNamesOfType: typeChosen.
        slotChoices isEmpty
                ifTrue: [^self inform: 'sorry -- no slots of that type' translated].
        slotChoices sort.
        slotChosen := UIManager default
                chooseFrom: (slotChoices collect: [:t | t translated])
                values: slotChoices
                title: ('Choose the datum
you want to extract from {1}''s {2}' translated format: {self externalName. slotName translated}).
        slotChosen isEmptyOrNil ifTrue: [^self].
        "Now we want to tear off tiles of the form
                holder's valueAtCursor's foo"
        getterTiles := nil.
        aCategoryViewer := CategoryViewer new initializeFor: thePlayerThereNow
                                categoryChoice: 'basic'.
        getterTiles := aCategoryViewer
                                getterTilesFor: slotChosen asGetterSelector
                                type: typeChosen.
        aCategoryViewer := CategoryViewer new initializeFor: self
                                categoryChoice: 'basic'.
        playerGetter := aCategoryViewer
                                getterTilesFor: slotName asGetterSelector
                                type: #Player.
        getterTiles submorphs first acceptDroppingMorph: playerGetter event: nil.       "the pad"       "simulate a drop"
        getterTiles makeAllTilesGreen.
        getterTiles justGrabbedFromViewer: false.
        (getterTiles firstSubmorph)
                changeTableLayout;
                hResizing: #shrinkWrap;
                vResizing: #spaceFill.
        self currentHand attachMorph: getterTiles.! !

!Player methodsFor: 'slot-kedama' stamp: 'ct 9/11/2020 20:46'!
addPatchVarNamed: nameSymbol

        | f |
        f := KedamaPatchMorph newExtent: self costume dimensions.
        f assuredPlayer assureUniClass.
        f setNameTo: (Project current world unusedMorphNameLike: f innocuousName).
        self addInstanceVariable2Named: nameSymbol type: #Patch value: f player.
        ^ f! !

!Player methodsFor: 'slot-kedama' stamp: 'ct 9/11/2020 20:44'!
newPatch

        | f usedNames newName |
        f := KedamaPatchMorph newExtent: self costume renderedMorph dimensions.
        f assuredPlayer assureUniClass.
        f kedamaWorld: self costume renderedMorph.
        usedNames := Project current world allKnownNames, self class instVarNames.
        newName := Utilities keyLike: f innocuousName satisfying:
                [:aName | (usedNames includes: aName) not].
        f setNameTo: newName.
        self createSlotForPatch: f.
        self addToPatchDisplayList: f assuredPlayer.
        self costume world primaryHand attachMorph: f.
        ^ f! !

!Player methodsFor: 'slot-kedama' stamp: 'ct 9/11/2020 20:44'!
newTurtle

        | m |
        m := KedamaTurtleMorph new openInWorld.
        self costume renderedMorph hasNoTurtleBreed ifTrue: [m color: Color red].
        self useTurtle: m player.
        m setNameTo: (Project current world unusedMorphNameLike: m innocuousName).
        self costume world primaryHand attachMorph: m.
        ^ m! !

!Player methodsFor: 'slot-kedama' stamp: 'ct 9/11/2020 20:44'!
newTurtleSilently

        | m |
        m := KedamaTurtleMorph new openInWorld.
        self useTurtle: m player.
        m turtleCount: 0.
        m setNameTo: (Project current world unusedMorphNameLike: m innocuousName).
        ^ m! !

!Player methodsFor: '*Etoys-Squeakland-scripts-standard' stamp: 'ct 9/11/2020 20:41'!
printInTranscript
        "Print a line representing the receiver in the Transcript"

        Project current world findATranscript: nil.
        Transcript cr;
                show: (Time now printString copyWithoutAll: '()');
                space;
                show: self costume printString.! !

!Player methodsFor: '*Etoys-Squeakland-slots-user' stamp: 'ct 9/12/2020 14:47'!
changeSlotInfo: aSymbol

        Project current world
                addMorphInLayer: (ModifyVariableDialogMorph on: self costume slot: aSymbol)
                centeredNear: (self currentHand ifNil: [Sensor]) cursorPoint.! !

!Player methodsFor: '*Etoys-Squeakland-slot getters/setters' stamp: 'ct 9/12/2020 14:47'!
handUserPictureOfPenTrail
        "Called from the user-interface: hand the user a picture of the pen trail"

        self getHasPenTrails ifFalse: [
                ^ self inform: 'no pen trails present' translated].
       
        self currentHand attachMorph: (SketchMorph new form: self getPenTrailGraphic).! !

!Player methodsFor: '*Etoys-Squeakland-slot-kedama' stamp: 'ct 9/11/2020 20:44'!
kedamaWorld

        ^ Project current world findDeeplyA: KedamaMorph
        ! !

!Player methodsFor: '*Etoys-Squeakland-slot-kedama' stamp: 'ct 9/11/2020 20:44'!
newPatchForSet

        | f |
        f := KedamaPatchMorph newExtent: self costume renderedMorph dimensions.
        f assuredPlayer assureUniClass.
        f setNameTo: (Project current world unusedMorphNameLike: f innocuousName).
        f kedamaWorld: self costume renderedMorph.
        self createSlotForPatch: f.
        ^ f! !

!Player methodsFor: '*Etoys-Squeakland-slot-kedama' stamp: 'ct 9/11/2020 20:44'!
newTurtleForSet

        | m |
        m := KedamaTurtleMorph new openInWorld.
        self costume renderedMorph hasNoTurtleBreed ifTrue: [m color: Color red].
        self useTurtle: m player.
        m setNameTo: (Project current world unusedMorphNameLike: m innocuousName).
        ^ m! !


!PlayerSurrogate methodsFor: 'menu' stamp: 'ct 9/11/2020 20:37'!
revealThisObject
        "Reveal the object I represent"

        playerRepresented revealPlayerIn: Project current world! !

!PlayerSurrogate methodsFor: '*Etoys-Squeakland-as yet unclassified' stamp: 'ct 9/11/2020 20:40'!
forciblyRenamePlayer
        "Allow the receiver to seize a name already nominally in use in the project."

        | current reply currentlyBearingName newNameForHim binding |
        current := playerRepresented knownName.
        reply := FillInTheBlank request: 'Type the name you insist upon' translated initialAnswer: current.
        reply isEmptyOrNil ifTrue: [^ self].
        Preferences uniquePlayerNames ifFalse: [^ self costume renameTo: reply].
        reply := (reply asIdentifier: true) asSymbol.
        reply = current ifTrue: [^ self inform: 'no change' translated].
       
        binding := Project current world referencePool hasBindingOf: reply.
        binding ifNotNil: [
                currentlyBearingName := binding value.
                newNameForHim := Utilities keyLike: reply satisfying: [:name |
                                (Project current world referencePool includesKey: name) not].
                currentlyBearingName renameTo: newNameForHim].
        playerRepresented renameTo: reply.
        self inform: (binding
                ifNil: [('There was no conflict; this object is now named {1}' translated format: {reply})]
                ifNotNil: ['Okay, this object is now named\{1}\and the object formerly known by this name is now called\{2}' translated format: {reply. newNameForHim}]).! !


!PlayerType methodsFor: 'tiles' stamp: 'ct 9/11/2020 20:37'!
defaultArgumentTile
        "Answer a tile to represent the type"

        ^ Project current world presenter standardPlayer tileToRefer! !


!KedamaPatchType methodsFor: 'tile protocol' stamp: 'ct 9/11/2020 20:15'!
defaultArgumentTile
        "Answer a tile to represent the type"
        | patch ks k p |
        patch := KedamaPatchTile new typeColor: self typeColor.
        ks := self world allMorphs select: [:e | e isKindOf: KedamaMorph].
        ks isEmpty ifFalse: [
                k := ks first.
                p := k player getPatch.
        ] ifTrue: [
                k := KedamaPatchMorph new.
                k assuredPlayer.
                p := k player.
        ].
        patch usePatch: p.
        ^ patch! !


!PluggableFileList methodsFor: 'StandardFileMenu' stamp: 'ct 9/12/2020 14:50'!
startUpWithCaption: captionOrNil
        "Display the menu, slightly offset from the cursor, so that a slight tweak is required to confirm any action."

        ^ self
                startUpWithCaption: captionOrNil
                at: (self currentHand ifNil: [Sensor]) cursorPoint! !


!PluggableListMorph methodsFor: 'model access - keystroke' stamp: 'ct 9/11/2020 18:01'!
specialKeyPressed: asciiValue
        "A special key with the given ascii-value was pressed; dispatch it"
        | oldSelection nextSelection max howManyItemsShowing |
        (#(8 13) includes: asciiValue) ifTrue:
                [ "backspace key - clear the filter, restore the list with the selection"
                model okToChange ifFalse: [^ self].
                self removeFilter.
                priorSelection ifNotNil:
                        [ | prior |
                        prior := priorSelection.
                        priorSelection := self getCurrentSelectionIndex.
                        asciiValue = 8 ifTrue: [ self changeModelSelection: prior ] ].
                ^ self ].
        asciiValue = 27 ifTrue:
                [" escape key"
                ^ self currentEvent shiftPressed
                        ifTrue:
                                [self currentEvent putUpWorldMenuFromEscapeKey]
                        ifFalse:
                                [self yellowButtonActivity: false]].

        max := self maximumSelection.
        max > 0 ifFalse: [^ self].
        nextSelection := oldSelection := self selectionIndex.
        asciiValue = 31 ifTrue:
                [" down arrow"
                nextSelection := oldSelection + 1.
                nextSelection > max ifTrue: [nextSelection := 1]].
        asciiValue = 30 ifTrue:
                [" up arrow"
                nextSelection := oldSelection - 1.
                nextSelection < 1 ifTrue: [nextSelection := max]].
        asciiValue = 1 ifTrue:
                [" home"
                nextSelection := 1].
        asciiValue = 4 ifTrue:
                [" end"
                nextSelection := max].
        howManyItemsShowing := self numSelectionsInView.
        asciiValue = 11 ifTrue:
                [" page up"
                nextSelection := 1 max: oldSelection - howManyItemsShowing].
        asciiValue = 12 ifTrue:
                [" page down"
                nextSelection := oldSelection + howManyItemsShowing min: max].
        model okToChange ifFalse: [^ self].
        "No change if model is locked"
        oldSelection = nextSelection ifTrue: [^ self flash].
        ^ self changeModelSelection: (self modelIndexFor: nextSelection)! !


!PopUpMenu methodsFor: 'basic control sequence' stamp: 'ct 9/12/2020 14:50'!
startUpCenteredWithCaption: captionOrNil
        "Differs from startUpWithCaption: by appearing with cursor in the menu, and thus ready to act on mouseUp, without requiring user tweak to confirm"

        ^ self
                startUpWithCaption: captionOrNil
                at: (self currentHand ifNil: [Sensor]) cursorPoint - (20 @ 0)! !

!PopUpMenu methodsFor: 'basic control sequence' stamp: 'ct 9/12/2020 14:51'!
startUpWithCaption: captionOrNil
        "Display the menu, slightly offset from the cursor,
        so that a slight tweak is required to confirm any action."
        self flag: #fix. "mt: Could we manage to open pop-up menus in Morphic without accessing self currentHand?"

        ^ self
                startUpWithCaption: captionOrNil
                at: (self currentHand ifNil: [Sensor]) cursorPoint! !

!PopUpMenu methodsFor: 'basic control sequence' stamp: 'ct 9/12/2020 14:51'!
startUpWithCaption: captionOrNil icon: aForm
        "Display the menu, slightly offset from the cursor, so that a slight tweak is required to confirm any action."

        ^ self
                        startUpWithCaption: captionOrNil
                        icon: aForm
                        at: (self currentHand ifNil: [Sensor]) cursorPoint! !

!PopUpMenu methodsFor: 'basic control sequence' stamp: 'ct 9/12/2020 14:51'!
startUpWithoutKeyboard
        "Display and make a selection from the receiver as long as the button  is pressed. Answer the current selection.  Do not allow keyboard input into the menu"
       
        ^ self
                startUpWithCaption: nil
                at: ((self currentHand ifNil: [Sensor]) cursorPoint)
                allowKeyboard: false! !

!PopUpMenu methodsFor: '*Morphic-Menus' stamp: 'ct 9/11/2020 20:37'!
morphicStartUpWithCaption: captionOrNil icon: aForm at: location allowKeyboard: aBoolean
        "Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released,
        Answer the index of the current selection, or zero if the mouse is not released over  any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard."

        selection := Cursor normal
                                showWhile: [| menuMorph |
                                        menuMorph := MVCMenuMorph from: self title: nil.
                                        (captionOrNil notNil
                                                        or: [aForm notNil])
                                                ifTrue: [menuMorph addTitle: captionOrNil icon: aForm].
                                        MenuIcons decorateMenu: menuMorph.
                                        menuMorph
                                                invokeAt: location
                                                in: self currentWorld
                                                allowKeyboard: aBoolean].
        ^ selection! !

!PopUpMenu methodsFor: '*Etoys-Squeakland-basic control sequence' stamp: 'ct 9/11/2020 20:37'!
startUpWithCaption: captionOrNil at: location allowKeyboard: allowKeyboard centered: centered
        "Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released,
        Answer the index of the current selection, or zero if the mouse is not released over  any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard
        If centered is true, the menu items are displayed centered.."

        | maxHeight aMenu |
        (ProvideAnswerNotification signal: captionOrNil) ifNotNil:
                [:answer | ^ selection := answer ifTrue: [1] ifFalse: [2]].
                
        maxHeight := Display height*3//4.
        self frameHeight > maxHeight ifTrue:
                [^ self
                        startUpSegmented: maxHeight
                        withCaption: captionOrNil
                        at: location
                        allowKeyboard: allowKeyboard].

        Smalltalk isMorphic
                ifTrue:[
                        selection := Cursor normal showWhile:
                                [aMenu := MVCMenuMorph from: self title: captionOrNil.
                                centered ifTrue:
                                        [aMenu submorphs allButFirst do:
                                                [:m | m setProperty: #centered toValue: true]].
                                aMenu
                                        invokeAt: location
                                        in: self currentWorld
                                        allowKeyboard: allowKeyboard].
                        ^ selection].
       
        frame ifNil: [self computeForm].
        Cursor normal showWhile:
                [self
                        displayAt: location
                        withCaption: captionOrNil
                        during: [self controlActivity]].
        ^ selection! !


!PopUpMenu class methodsFor: '*Etoys-Squeakland-dialogs' stamp: 'ct 9/12/2020 14:52'!
informCenteredAboveCursor: aString
        "Put up an informer showing the given string in a box, with the OK button for dismissing the informer having the cursor at its center."

        "PopUpMenu informCenteredAboveCursor: 'I like Squeak\how about you?' withCRs"

        | lines maxWid xCoor |
        lines := Array streamContents: [:aStream |
                aString linesDo: [:l | aStream nextPut: l]].
        maxWid := (lines collect: [:l |  Preferences standardMenuFont widthOfString: l]) max.
        xCoor := self currentHand cursorPoint x - (maxWid // 2).
        ((xCoor + maxWid) > self currentWorld right) ifTrue:
                [xCoor := self currentWorld right].  "Caters to problematic PopUpMenu boundary behavior"

        (PopUpMenu labels: 'OK' translated) startUpWithCaption: aString
                at: (xCoor  @ self currentHand cursorPoint y)
                allowKeyboard: true centered: true.! !


!PreferenceWizardMorph methodsFor: 'initialization' stamp: 'ct 9/11/2020 20:35'!
initializePreviewWorld

        | w1 w2 w3 |

        previewWorld := PasteUpMorph new
                hResizing: #spaceFill;
                vResizing: #spaceFill;
                viewBox: (0@0 corner: 500@500);
                layoutFrame: (LayoutFrame fractions: (0.3 @ 0 corner: 1.0 @ 1.0) offsets: (0@ titleMorph height corner: 0 @ buttonRowMorph height negated));
                fillStyle: Project current world fillStyle;
                borderWidth: 2;
                borderColor: Color white;
                cornerStyle: (self hasLowPerformance ifTrue: [#square] ifFalse: [#rounded]);
                yourself.
       
        w1 := (ToolSet browse: Morph selector: #drawOn:) dependents detect: [:ea | ea isSystemWindow].
        w2 := ToolSet browseMessageSet: (SystemNavigation default allCallsOn: #negated) name: 'Senders' translated autoSelect: 'negated'.
        w3 := (Workspace new contents: '3+4 "Select and hit [CMD]+[P]."') openLabel: 'Workspace'.
       
        {w1. w2. w3} do: [:ea |
                ea makeUnclosable.
                previewWorld addMorph: ea].
       
        self updateWindowBounds.! !

!PreferenceWizardMorph methodsFor: 'support' stamp: 'ct 9/12/2020 14:36'!
adjustSettingsForLowPerformance

        self updateLowPerformanceLabel: 'Please wait, optimizing performance...' translated.
        self refreshWorld.
       
        self stateGradients "flat look" ifFalse: [self toggleGradients].
        self stateBlinkingCursor ifTrue: [self toggleBlinkingCursor].
        self stateFastDrag ifFalse: [self toggleFastDrag].
       
        self stateSoftShadows ifTrue: [self toggleSoftShadows].
        self stateHardShadows ifTrue: [self toggleHardShadows].
       
        self stateRoundedWindowLook ifTrue: [self toggleRoundedWindowLook].
        self stateRoundedButtonLook ifTrue: [self toggleRoundedButtonLook].
       
        self stateAttachToolsToMouse ifTrue: [self toggleAttachToolsToMouse].
        self stateToolAndMenuIcons ifTrue: [self toggleToolAndMenuIcons].
       
        self stateSmartHorizontalSplitters ifTrue: [self toggleSmartHorizontalSplitters].
        self stateSmartVerticalSplitters ifTrue: [self toggleSmartVerticalSplitters].
       
        PluggableListMorph
                highlightHoveredRow: false;
                filterableLists: false;
                highlightPreSelection: true; "Feedback is important!!"
                flashOnErrors: false.
        TheWorldMainDockingBar showSecondsInClock: false.
        Preferences disable: #balloonHelpInMessageLists.
       
       
        "Set simple background."
        Project current world setAsBackground: MorphicProject defaultFill.
        previewWorld fillStyle: Project current world fillStyle.
       
        "Done."
        self updateLowPerformanceLabel: 'Settings were adjusted for optimal performance.' translated.! !


!Preferences class methodsFor: 'updating - system' stamp: 'ct 9/11/2020 20:35'!
roundedWindowCornersChanged
        "The user changed the value of the roundedWindowCorners preference.  React"

        Project current world fullRepaintNeeded.! !

!Preferences class methodsFor: 'updating - system' stamp: 'ct 9/11/2020 20:35'!
vectorVocabularySettingChanged
        "The current value of the useVectorVocabulary flag has changed; now react.  No senders, but invoked by the Preference object associated with the #useVectorVocabulary preference."

        Smalltalk isMorphic ifFalse: [^ self].
        Project current world makeVectorUseConformToPreference.! !


!Project methodsFor: '*Etoys-Squeakland-file in/out' stamp: 'ct 9/12/2020 15:10'!
storeOnServerWithNoInteractionInnards
        "Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."

        | newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber myDepth |
        self assureIntegerVersion.

        "Find out what version"
        primaryServerDirectory := self defaultFolderForAutoSaving ifNil: [^self].

        localDirectory := self squeakletDirectory.
        serverVersionPair := self class mostRecent: self name onServer: primaryServerDirectory.
        localVersionPair := self class mostRecent: self name onServer: localDirectory.
        maxNumber := myVersionNumber := self currentVersionNumber.

        ProgressNotification signal: '2:versionsDetected'.

        warning := ''.
        myVersionNumber < serverVersionPair second ifTrue: [
                warning := warning,'\There are newer version(s) on the server' translated.
                maxNumber := maxNumber max: serverVersionPair second.
        ].
        myVersionNumber < localVersionPair second ifTrue: [
                warning := warning,'\There are newer version(s) in the local directory' translated.
                maxNumber := maxNumber max: localVersionPair second.
        ].
        version := self bumpVersion: maxNumber.

        "write locally - now zipped automatically"
        Display isVirtualScreen ifTrue: [
                myDepth := displayDepth.
                displayDepth := OLPCVirtualScreen preferredScreenDepth..
        ].
        newName := self versionedFileName.
        lastSavedAtSeconds := Time totalSeconds.
        self activateWorld: self activeWorld during: [
                self flag: #suspicious. "ct: Are there any world side effects in the export logic?"
                self exportSegmentFileName: newName directory: localDirectory withoutInteraction: true].
        (localDirectory readOnlyFileNamed: newName) setFileTypeToObject; close.
        Display isVirtualScreen ifTrue: [
                displayDepth := myDepth.
        ].
       
        ProgressNotification signal: '4:localSaveComplete'.     "3 is deep in export logic"

        primaryServerDirectory ifNotNil: [
                [
                primaryServerDirectory
                        writeProject: self
                        inFileNamed: newName asFileName
                        fromDirectory: localDirectory.
                ] on: ProjectPasswordNotification do: [ :ex |
                        ex resume: ''
                ].
        ].
        ProgressNotification signal: '9999 save complete'.! !

!Project methodsFor: '*Etoys-Squeakland-language' stamp: 'ct 9/11/2020 20:34'!
updateLocaleDependentsWithPreviousSupplies: aCollection gently: gentlyFlag
        "Set the project's natural language as indicated"

        | morphs scriptEditors |
        gentlyFlag ifTrue: [
                LanguageEnvironment localeChangedGently.
        ] ifFalse: [
                LanguageEnvironment localeChanged.
        ].

        morphs := IdentitySet new: 400.
        Project current world allMorphsAndBookPagesInto: morphs.
        scriptEditors := morphs select: [:m | (m isKindOf: ScriptEditorMorph) and: [m topEditor == m]].
        (morphs copyWithoutAll: scriptEditors) do: [:morph | morph localeChanged].
        scriptEditors do: [:m | m localeChanged].

        Flaps disableGlobalFlaps: false.
        SugarNavigatorBar showSugarNavigator
                ifTrue:
                        [Flaps addAndEnableEToyFlapsWithPreviousEntries: aCollection.
                        Project current world addGlobalFlaps]
                ifFalse:
                        [Preferences eToyFriendly
                                ifTrue:
                                        [Flaps addAndEnableEToyFlaps.
                                        Project current world addGlobalFlaps]
                                ifFalse:
                                        [Flaps enableGlobalFlaps]].

        (Project current isFlapIDEnabled: 'Navigator' translated)
                ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated].

        ParagraphEditor initializeTextEditorMenus.
        MenuIcons initializeTranslations.

        #(PartsBin ParagraphEditor BitEditor FormEditor StandardSystemController)
                do: [ :key | Smalltalk at: key ifPresent: [ :class | class initialize ]].

        Project current world reformulateUpdatingMenus.
        "self setFlaps.
        self setPaletteFor: aLanguageSymbol."
! !


!MorphicProject methodsFor: 'utilities' stamp: 'ct 9/12/2020 15:13'!
createViewIfAppropriate
        "Create a project view for the receiver and place it appropriately on the screen."

        | aMorph requiredWidth existing proposedV proposedH despair |
        ProjectViewOpenNotification signal ifTrue:
                [Preferences projectViewsInWindows
                        ifTrue:
                                [(ProjectViewMorph newProjectViewInAWindowFor: self) openInWorld]
                        ifFalse:
                                [aMorph := ProjectViewMorph on: self.
                                requiredWidth := aMorph width + 10.
                                existing := self currentWorld submorphs
                                        select: [:m | m isKindOf: ProjectViewMorph]
                                        thenCollect: [:m | m fullBoundsInWorld].
                                proposedV := 85.
                                proposedH := 10.
                                despair := false.
                                [despair not and: [((proposedH @ proposedV) extent: requiredWidth) intersectsAny: existing]] whileTrue:
                                        [proposedH := proposedH + requiredWidth.
                                        proposedH + requiredWidth > self currentWorld right ifTrue:
                                                [proposedH := 10.
                                                proposedV := proposedV + 90.
                                                proposedV > (self currentWorld bottom - 90)
                                                        ifTrue:
                                                                [proposedH := self currentWorld center x - 45.
                                                                proposedV := self currentWorld center y - 30.
                                                                despair := true]]].
                                aMorph position: (proposedH @ proposedV).
                                aMorph openInWorld]]! !

!MorphicProject methodsFor: 'flaps support' stamp: 'ct 9/12/2020 14:34'!
setFlaps

        | flapTabs flapIDs sharedFlapTabs navigationMorph |
        self flag: #toRemove. "check if this method still used by Etoys"

        flapTabs := self world flapTabs.
        flapIDs := flapTabs collect: [:tab | tab knownName].
        flapTabs
                do: [:tab | (tab isMemberOf: ViewerFlapTab)
                                ifFalse: [tab isGlobalFlap
                                                ifTrue: [Flaps removeFlapTab: tab keepInList: false.
                                                        tab currentWorld reformulateUpdatingMenus]
                                                ifFalse: [| referent |
                                                        referent := tab referent.
                                                        referent isInWorld
                                                                ifTrue: [referent delete].
                                                        tab delete]]].
        sharedFlapTabs := Flaps classPool at: #SharedFlapTabs.
        flapIDs
                do: [:id |
                        id = 'Navigator' translated
                                ifTrue: [sharedFlapTabs add: Flaps newNavigatorFlap].
                        id = 'Widgets' translated
                                ifTrue: [sharedFlapTabs add: Flaps newWidgetsFlap].
                        id = 'Tools' translated
                                ifTrue: [sharedFlapTabs add: Flaps newToolsFlap].
                        id = 'Squeak' translated
                                ifTrue: [sharedFlapTabs add: Flaps newSqueakFlap].
                        id = 'Supplies' translated
                                ifTrue: [sharedFlapTabs add: Flaps newSuppliesFlap].
                        id = 'Stack Tools' translated
                                ifTrue: [sharedFlapTabs add: Flaps newStackToolsFlap].
                        id = 'Painting' translated
                                ifTrue: [sharedFlapTabs add: Flaps newPaintingFlap].
                        id = 'Objects' translated
                                ifTrue: [sharedFlapTabs add: Flaps newObjectsFlap ]].
        2 timesRepeat: [flapIDs do: [:id | Flaps enableDisableGlobalFlapWithID: id]].
        self world flapTabs
                do: [:flapTab | flapTab isCurrentlyTextual
                                ifTrue: [flapTab changeTabText: flapTab knownName]].
        Flaps positionNavigatorAndOtherFlapsAccordingToPreference.
        navigationMorph := self currentWorld findDeeplyA: ProjectNavigationMorph preferredNavigator.
        navigationMorph isNil
                ifTrue: [^ self].
        navigationMorph allMorphs
                do: [:morph | morph class == SimpleButtonDelayedMenuMorph
                                ifTrue: [(morph findA: ImageMorph) isNil
                                                ifTrue: [| label |
                                                        label := morph label.
                                                        label isNil
                                                                ifFalse: [| name |
                                                                        name := morph knownName.
                                                                        name isNil
                                                                                ifTrue: [morph name: label.
                                                                                        name := label].
                                                                        morph label: name translated]]]]! !

!MorphicProject methodsFor: 'enter' stamp: 'ct 9/12/2020 15:15'!
clearGlobalState
        "Clean up global state. The global variables World, ActiveWorld, ActiveHand
        and ActiveEvent provide convenient access to the state of the active project
        in Morphic. Clear their prior values when leaving an active project. This
        method may be removed if the use of global state variables is eliminated."

        "If global World is defined, clear it now. The value is expected to be set
        again as a new project is entered."
        Smalltalk globals at: #World ifPresent: [:w |
                Smalltalk globals at: #World put: nil].
        self
                activeWorld: nil;
                activeHand: nil;
                activeEvent: nil.! !

!MorphicProject methodsFor: 'enter' stamp: 'ct 9/12/2020 14:45'!
wakeUpTopWindow
        "Image has been restarted, and the startUp list has been processed. Perform
        any additional actions needed to restart the user interface."

        SystemWindow wakeUpTopWindowUponStartup.
        Preferences mouseOverForKeyboardFocus ifTrue:
                [ "Allow global command keys to work upon re-entry without having to cause a focus change first."
                self currentHand releaseKeyboardFocus ]! !

!MorphicProject methodsFor: 'language' stamp: 'ct 9/12/2020 14:17'!
updateLocaleDependents
        "Set the project's natural language as indicated"

        (self world respondsTo: #isTileScriptingElement) ifTrue: "Etoys present" [
                self world allTileScriptingElements do: [:viewerOrScriptor |
                        viewerOrScriptor localeChanged]].
       
        Flaps disableGlobalFlaps: false.
        (Preferences eToyFriendly or: [
                (Smalltalk classNamed: #SugarNavigatorBar) ifNotNil: [:c | c showSugarNavigator] ifNil: [false]])
                ifTrue: [
                        Flaps addAndEnableEToyFlaps.
                        self world addGlobalFlaps]
                ifFalse: [Flaps enableGlobalFlaps].

        (self isFlapIDEnabled: 'Navigator' translated)
                ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated].
       
        ScrapBook default emptyScrapBook.
        MenuIcons initializeTranslations.
       
        super updateLocaleDependents.
       
        "self setFlaps.
        self setPaletteFor: aLanguageSymbol."! !

!MorphicProject methodsFor: 'protocols' stamp: 'ct 9/12/2020 14:18'!
currentVocabulary

        ^ self world currentVocabulary! !

!MorphicProject methodsFor: 'scheduling & debugging' stamp: 'ct 9/12/2020 15:13'!
interruptCleanUpFor: interruptedProcess
        "Clean up things in case of a process interrupt."

        super interruptCleanUpFor: interruptedProcess.

        self uiProcess == interruptedProcess ifTrue: [
                self activeHand ifNotNil: [:hand | hand interrupted].
                self activeWorld: world. "reinstall active globals"
                self activeHand: world primaryHand.
                self activeHand interrupted. "make sure this one's interrupted too"
                self activeEvent: nil.
               
                Preferences eToyFriendly ifTrue: [
                        Project current world stopRunningAll]].! !


!MorphicProject class methodsFor: 'shrinking' stamp: 'ct 9/12/2020 15:45'!
unloadMorphic
        "MorphicProject unloadMorphic"

        Project current isMorphic ifTrue: [
                ^ Error signal: 'You can only unload Morphic from within another kind of project.' translated].
       
        MorphicProject removeProjectsFromSystem.
       
        #(ActiveEvent ActiveHand ActiveWorld World) do: [:ea |
                Smalltalk globals removeKey: ea].
        Processor allInstancesDo: [:process |
                #(ActiveHand ActiveEvent ActiveWorld) do: [:ea |
                        process environmentRemoveKey: ea ifAbsent: []]].
       
        { 'ToolBuilder-Morphic' . 'MorphicTests' . 'MorphicExtras' . 'Morphic' }
                do: [ :package | (MCPackage named: package) unload ].! !


!ProjectNavigationMorph methodsFor: 'stepping and presenter' stamp: 'ct 9/11/2020 20:34'!
undoButtonWording
        "Answer the wording for the Undo button."

        | wdng |
        wdng := Project current world commandHistory undoOrRedoMenuWording.
        (wdng endsWith: ' (z)') ifTrue: [
                wdng := wdng copyFrom: 1to: wdng size - 4].
        ^ wdng! !

!ProjectNavigationMorph methodsFor: 'the actions' stamp: 'ct 9/11/2020 20:34'!
undoOrRedoLastCommand
        "Undo or redo the last command, as approrpiate."

        ^ Project current world commandHistory undoOrRedoCommand! !


!EventRecordingSpaceNavigator methodsFor: 'the actions' stamp: 'ct 9/11/2020 19:47'!
doNewPainting
        "Make a new painting"

        | worldlet |
        self currentWorld assureNotPaintingElse: [^ self].
        worldlet := self ownerThatIsA: Worldlet.
        worldlet closeNavigatorFlap.
        worldlet makeNewDrawing: (self currentEvent copy setPosition: worldlet center).! !


!RealEstateAgent class methodsFor: 'accessing' stamp: 'ct 9/11/2020 20:34'!
maximumUsableArea

        ^ self maximumUsableAreaInWorld: Project current world! !


!RecordingControls methodsFor: 'private' stamp: 'ct 9/12/2020 14:52'!
makeSoundMorph
        "Hand the user an anonymous-sound object  representing the receiver's sound."

        | m aName |
        recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
        recorder pause.
        recordingSaved := true.
        m := AnonymousSoundMorph new.

        m sound: recorder recordedSound interimName: (aName :=  'Unnamed Sound').

        m setNameTo: aName.
        self currentHand attachMorph: m.! !


!ReleaseBuilder class methodsFor: 'scripts - support' stamp: 'ct 9/11/2020 20:33'!
setProjectBackground: aFormOrColorOrFillStyle

        | world |
        world := Project current world.
        world fillStyle: aFormOrColorOrFillStyle.
        MorphicProject defaultFill: world fillStyle.
        world removeProperty: #hasCustomBackground.! !


!SARInstaller methodsFor: 'client services' stamp: 'ct 9/11/2020 20:33'!
fileInMorphsNamed: memberName addToWorld: aBoolean
        "This will load the Morph (or Morphs) from the given member.
        Answers a Morph, or a list of Morphs, or nil if no such member or error.
        If aBoolean is true, also adds them and their models to the World."

        | member morphOrList |
        member := self memberNamed: memberName.
        member ifNil: [^ self errorNoSuchMember: memberName].
        self installed: member.
       
        morphOrList := member contentStream fileInObjectAndCode.
        morphOrList ifNil: [^ nil].
        aBoolean ifTrue: [Project current world addMorphsAndModel: morphOrList].
       
        ^ morphOrList! !


!ScriptEditorMorph methodsFor: 'buttons' stamp: 'ct 9/12/2020 14:52'!
addYesNoToHand
        "Place a test/yes/no complex in the hand of the beloved user"

        | ms messageNodeMorph aMorph |
        Preferences universalTiles
                ifTrue:
                        [ms := MessageSend receiver: true selector: #ifTrue:ifFalse:
                                                arguments: {['do nothing']. ['do nothing']}.
                        messageNodeMorph := ms asTilesIn: playerScripted class globalNames: true.
                        self primaryHand attachMorph: messageNodeMorph]
                ifFalse:
                        [aMorph := CompoundTileMorph new.
                        self currentHand attachMorph: aMorph.
                        aMorph setNamePropertyTo: 'TestTile' translated.
                        aMorph position: self currentHand position.
                        aMorph formerPosition: self currentHand position.
                        self startSteppingSelector: #trackDropZones].! !

!ScriptEditorMorph methodsFor: 'buttons' stamp: 'ct 9/11/2020 20:32'!
dismiss
        "Dismiss the scriptor, usually nondestructively.  Possibly animate the dismissal."

        | endPoint aForm startPoint topRend |
        owner ifNil: [^ self].
        scriptName ifNil: [^ self delete].  "ad hoc fixup for bkwrd compat"

        endPoint := self viewerTile ifNotNilDo: [:tile | tile topLeft] ifNil: [owner topRight].
        aForm := (topRend := self topRendererOrSelf) imageForm  offset: (0@0).
        handWithTile := nil.
        startPoint := topRend topLeft.
        topRend topRendererOrSelf delete.
        (playerScripted isExpendableScript: scriptName) ifTrue: [
                ^ playerScripted removeScript: scriptName fromWorld: Project current world].
       
        Project current world displayWorld.
        aForm slideFrom: startPoint to: endPoint nSteps: 4 delay: 30.
        "The OLPC Virtual Screen wouldn't notice the last update here."
        Display forceToScreen: (endPoint extent: aForm extent).! !

!ScriptEditorMorph methodsFor: 'other' stamp: 'ct 9/12/2020 14:52'!
offerScriptorMenu
        "Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer"

        | aMenu count |

        self modernize.
        self currentHand showTemporaryCursor: nil.

        Preferences eToyFriendly ifTrue: [^ self offerSimplerScriptorMenu].

        aMenu := MenuMorph new defaultTarget: self.
        aMenu addTitle: scriptName asString.
        aMenu addStayUpItem.  "NB:  the kids version in #offerSimplerScriptorMenu does not deploy the stay-up item"

        aMenu addList: (self hasParameter
                ifTrue: [{
                        {'remove parameter' translated.                                 #ceaseHavingAParameter}}]
                ifFalse: [{
                        {'add parameter' translated.                                            #addParameter}}]).

        self hasParameter ifFalse:
                [aMenu addTranslatedList: {
                        {'button to fire this script' translatedNoop. #tearOfButtonToFireScript}.
                        {'fires per tick...' translatedNoop. #chooseFrequency}.
                        #-
                }].

        aMenu addUpdating: #showingCaretsString  target: self action: #toggleShowingCarets.
        aMenu addLine.
        aMenu addList: {
                {'edit balloon help for this script' translated.                #editMethodDescription}.
                {'explain status alternatives' translated.                       #explainStatusAlternatives}.
                {'button to show/hide this script' translated.                  #buttonToOpenOrCloseThisScript}.
                #-
        }.


        Preferences universalTiles ifFalse:
                [count := self savedTileVersionsCount.
                self showingMethodPane
                        ifFalse:                                "currently showing tiles"
                                [aMenu add: 'show code textually' translated action: #toggleWhetherShowingTiles.
                                count > 0 ifTrue:
                                        [aMenu add: 'revert to tile version...' translated action:       #revertScriptVersion].
                                aMenu add: 'save this version' translated       action: #saveScriptVersion]

                        ifTrue:                         "current showing textual source"
                                [count >= 1 ifTrue:
                                        [aMenu add: 'revert to tile version' translated action: #toggleWhetherShowingTiles]]].

        "aMenu addLine.
        self addGoldBoxItemsTo: aMenu."

        aMenu addLine.
       
        aMenu add: 'grab this object' translated target: playerScripted selector: #grabPlayerIn: argument: self currentWorld.
        aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.

        aMenu add: 'reveal this object' translated target: playerScripted selector: #revealPlayerIn: argument: self currentWorld.
        aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.

        aMenu add: 'tile representing this object' translated target: playerScripted action: #tearOffTileForSelf.
        aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.

        aMenu addTranslatedList: {
                #-.
                {'open viewer' translatedNoop. #openObjectsViewer.  'open the viewer of the object to which this script belongs' translatedNoop}.
                {'detached method pane' translatedNoop. #makeIsolatedCodePane. 'open a little window that shows the Smalltalk code underlying this script.' translatedNoop}.
                #-.
                {'destroy this script' translatedNoop. #destroyScript}
        }.


        ^ aMenu popUpInWorld: self currentWorld! !

!ScriptEditorMorph methodsFor: '*Etoys-Squeakland-menu commands' stamp: 'ct 9/11/2020 20:32'!
findObject
        "Reveal the object bearing the code "

        playerScripted revealPlayerIn: Project current world.! !

!ScriptEditorMorph methodsFor: '*Etoys-Squeakland-other' stamp: 'ct 9/12/2020 14:52'!
handUserTimesRepeatTile
        "Hand the user a times-repeat tile, presumably to drop in the script"
       
        | aMorph |
        aMorph := TimesRepeatTile new.
        self currentHand attachMorph: aMorph.
        aMorph position: self currentHand position.! !

!ScriptEditorMorph methodsFor: '*Etoys-Squeakland-other' stamp: 'ct 9/12/2020 14:53'!
offerSimplerScriptorMenu
        "Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer.  This variant is used when eToyFriendly preference is true."

        | aMenu count |
        self currentHand showTemporaryCursor: nil.

        aMenu := MenuMorph new defaultTarget: self.
        aMenu addTitle: scriptName asString.

        aMenu addList: (self hasParameter
                ifTrue: [{
                        {'remove parameter' translated.                                 #ceaseHavingAParameter}}]
                ifFalse: [{
                        {'add parameter' translated.                                            #addParameter}}]).

        self hasParameter ifFalse:
                [aMenu addTranslatedList: #(
                        ('button to fire this script' tearOfButtonToFireScript)
                        -) translatedNoop].

        aMenu addUpdating: #showingCaretsString  target: self action: #toggleShowingCarets.
        aMenu addLine.
        aMenu addList: {
                {'edit balloon help for this script' translated.                #editMethodDescription}.
                {'explain status alternatives' translated.                       #explainStatusAlternatives}.
                {'button to show/hide this script' translated.                  #buttonToOpenOrCloseThisScript}.
                #-
        }.


        Preferences universalTiles ifFalse:
                [count := self savedTileVersionsCount.
                self showingMethodPane
                        ifFalse:                                "currently showing tiles"
                                [aMenu add: 'show code textually' translated action: #toggleWhetherShowingTiles.
                                count > 0 ifTrue:
                                        [aMenu add: 'revert to tile version...' translated action:       #revertScriptVersion].
                                aMenu add: 'save this version' translated       action: #saveScriptVersion]

                        ifTrue:                         "current showing textual source"
                                [count >= 1 ifTrue:
                                        [aMenu add: 'revert to tile version' translated action: #toggleWhetherShowingTiles]]].

        aMenu addLine.
       
        aMenu add: 'grab this object' translated target: playerScripted selector: #grabPlayerIn: argument: self currentWorld.
        aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.

        aMenu add: 'reveal this object' translated target: playerScripted selector: #revealPlayerIn: argument: self currentWorld.
        aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.

        aMenu add: 'tile representing this object' translated target: playerScripted action: #tearOffTileForSelf.
        aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.

        aMenu addLine.

        aMenu addTranslatedList: #(
                -
                ('open viewer'          openObjectsViewer  'open the viewer of the object to which this script belongs')
                -
                ('destroy this script' destroyScript)) translatedNoop.


        ^ aMenu popUpInWorld: self currentWorld! !

!ScriptEditorMorph methodsFor: '*Etoys-Squeakland-gold box' stamp: 'ct 9/11/2020 20:32'!
goldBoxMenu
        "Answer a graphical menu to be put up in conjunction with the Gold Box"
       
        | aBox |
        aBox := Project current world findA: GoldBoxMenu.
        aBox ifNil: [aBox := GoldBoxMenu new].
        aBox initializeFor: self.
        ^ aBox! !


!ScriptEncoder methodsFor: 'as yet unclassified' stamp: 'ct 9/11/2020 20:31'!
init: class notifying: parser

        super init: class notifying: parser.
        self referenceObject: Project current world referenceWorld.! !


!ScriptInstantiation methodsFor: 'misc' stamp: 'ct 9/12/2020 14:53'!
offerMenuIn: aStatusViewer
        "Put up a menu."

        | aMenu |
        self currentHand showTemporaryCursor: nil.
        aMenu := MenuMorph new defaultTarget: self.
        aMenu title: player knownName, ' ', selector.
        aMenu addStayUpItem.
        (player class instanceCount > 1) ifTrue:
                [aMenu add: 'propagate status to siblings' translated selector: #assignStatusToAllSiblingsIn: argument: aStatusViewer.
                aMenu balloonTextForLastItem: 'Make the status of this script in all of my sibling instances be the same as the status you see here' translated].
        aMenu addLine.
       
        aMenu add: 'grab this object' translated target: player selector: #grabPlayerIn: argument: self currentWorld.
        aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.
       
        aMenu add: 'reveal this object' translated target: player selector: #revealPlayerIn: argument: self currentWorld.
        aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.
       
        aMenu add: 'tile representing this object' translated target: player selector: #tearOffTileForSelf.
        aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.
       
        aMenu addLine.
       
        aMenu add: 'open this script''s Scriptor' translated target: player selector: #grabScriptorForSelector:in: argumentList: {selector. aStatusViewer world}.
        aMenu balloonTextForLastItem: 'Open up the Scriptor for this script' translated.
        aMenu add: 'open this object''s Viewer' translated target: player selector: #beViewed.
        aMenu balloonTextForLastItem: 'Open up a Viewer for this object' translated.
        aMenu addLine.
        aMenu add: 'more...' translated target: self selector: #offerShiftedMenuIn: argument: aStatusViewer.
        aMenu balloonTextForLastItem: 'The "more..." branch offers you menu items that are less frequently used.' translated.
        ^ aMenu popUpInWorld: self currentWorld! !

!ScriptInstantiation methodsFor: 'misc' stamp: 'ct 9/11/2020 20:30'!
offerShiftedMenuIn: aStatusViewer
        "Put up the shifted menu"

        ^ (MenuMorph new defaultTarget: self)
                title: player knownName, ' ', selector;
                add: 'grab this object' translated target: player selector: #grabPlayerIn: argument: self currentWorld;
                balloonTextForLastItem: 'Wherever this object currently is, the "grab" command will rip it out, and place it in your "hand".  This is a very drastic step, that can disassemble things that may be very hard to put back together!!' translated;
                add: 'destroy this script' translated target: player selector: #removeScriptWithSelector: argument: selector;
                balloonTextForLastItem: 'Caution!!  This is irreversibly destructive -- it removes the script from the system.' translated;
               
                addLine;
               
                add: 'inspect morph' translated target: player costume selector: #inspect;
                add: 'inspect player' translated target: player selector: #inspect;
               
                popUpInWorld: self currentWorld! !


!ScriptNameType methodsFor: 'queries' stamp: 'ct 9/11/2020 20:29'!
choices
        "Answer an alphabetized list of known script selectors in the current project"

        ^ Project current world presenter allKnownUnaryScriptSelectors
! !


!ScriptParser methodsFor: 'as yet unclassified' stamp: 'ct 9/11/2020 20:29'!
parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock
        "Answer a MethodNode for the argument, sourceStream, that is the root of
        a parse tree. Parsing is done with respect to the argument, class, to find
        instance, class, and pool variables; and with respect to the argument,
        ctxt, to find temporary variables. Errors in parsing are reported to the
        argument, req, if not nil; otherwise aBlock is evaluated. The argument
        noPattern is a Boolean that is true if the the sourceStream does not
        contain a method header (i.e., for DoIts)."

        "Copied from superclass, use ScriptEncoder and give it a referenceWorld. This assumes worldLoading has been set to the right world this player belongs to. --bf 5/4/2010"

         | methNode repeatNeeded myStream parser s p |
        (req notNil and: [RequestAlternateSyntaxSetting signal and: [(sourceStream isKindOf: FileStream) not]])
                ifTrue: [parser := self as: DialectParser]
                ifFalse: [parser := self].
        myStream := sourceStream.
        [repeatNeeded := false.
           p := myStream position.
           s := myStream upToEnd.
           myStream position: p.
        parser init: myStream notifying: req failBlock: [^ aBlock value].
        doitFlag := noPattern.
        failBlock := aBlock.
        [methNode := parser method: noPattern context: ctxt
                                encoder: (ScriptEncoder new init: class context: ctxt notifying: parser;
                                                                referenceObject: Project current world referenceWorld )]
                on: ParserRemovedUnusedTemps
                do:
                        [ :ex | repeatNeeded := (requestor isKindOf: TextEditor) not.
                        myStream := ReadStream on: requestor text string.
                        ex resume].
        repeatNeeded] whileTrue.
        encoder := failBlock := requestor := parseNode := nil. "break cycles & mitigate refct overflow"
           methNode sourceText: s.
        ^ methNode! !

!ScriptParser methodsFor: 'as yet unclassified' stamp: 'ct 9/11/2020 20:28'!
parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock for: anInstance

         | methNode repeatNeeded myStream parser s p |
        (req notNil and: [RequestAlternateSyntaxSetting signal and: [(sourceStream isKindOf: FileStream) not]])
                ifTrue: [parser := self as: DialectParser]
                ifFalse: [parser := self].
        myStream := sourceStream.
        [repeatNeeded := false.
           p := myStream position.
           s := myStream upToEnd.
           myStream position: p.
        parser init: myStream notifying: req failBlock: [^ aBlock value].
        doitFlag := noPattern.
        failBlock := aBlock.
        [methNode := parser method: noPattern context: ctxt
                                encoder: (ScriptEncoder new init: class context: ctxt notifying: parser;  referenceObject: (anInstance costume ifNotNil: [anInstance costume referenceWorld] ifNil: [Project current world]))]
                on: ParserRemovedUnusedTemps
                do:
                        [ :ex | repeatNeeded := (requestor isKindOf: TextEditor) not.
                        myStream := ReadStream on: requestor text string.
                        ex resume].
        repeatNeeded] whileTrue.
        encoder := failBlock := requestor := parseNode := nil. "break cycles & mitigate refct overflow"
           methNode sourceText: s.
        ^ methNode! !


!SearchTopic methodsFor: 'private' stamp: 'ct 9/11/2020 20:28'!
triggerUpdateContents

        self mutex critical: [
                updatePending == true ifFalse: [
                        updatePending := true.
                        Project current addDeferredUIMessage: [Project current world
                                addAlarm: #updateContents withArguments: #()
                                for: self
                                at: Time millisecondClockValue + 250]]].! !


!SelectionMorph methodsFor: 'halo commands' stamp: 'ct 9/11/2020 20:28'!
duplicate
        "Make a duplicate of the receiver and havbe the hand grab it"

        selectedItems := self duplicateMorphCollection: selectedItems.
        selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m].
        dupLoc := self position.
        self currentHand grabMorph: self.
        self currentWorld presenter flushPlayerListCache.! !


!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'ct 9/11/2020 20:28'!
specialKeyPressed: asciiValue

        (self arrowKey: asciiValue)
                ifTrue: [^ true].
               
        asciiValue = 27 "escape"
                ifTrue: [
                        self currentEvent shiftPressed
                                ifTrue: [self currentWorld putUpWorldMenuFromEscapeKey]
                                ifFalse: [self yellowButtonActivity: false].
                        ^ true].
       
        ^ false! !


!SimpleSelectionMorph methodsFor: 'extending' stamp: 'ct 9/11/2020 20:27'!
extendByHand: aHand
        "Assumes selection has just been created and added to some pasteUp or world"

        | startPoint handle m inner |
        startPoint := Sensor cursorPoint.
       
        handle := NewHandleMorph new followHand: aHand
                forEachPointDo: [:newPoint |
                                        | localPt |
                                        Cursor crossHair show.
                                        localPt := (self transformFrom: self world) globalPointToLocal: newPoint.
                                        self bounds: (startPoint rect: localPt)]
                lastPointDo:
                         [:newPoint |
                        inner := self bounds insetBy: 2@2.
                        inner area >= 16
                                ifTrue:
                                        [m := SketchMorph new form: (Form fromDisplay: inner).
                                        aHand attachMorph: m.
                                        self currentWorld fullRepaintNeeded]  "selection tracking can leave unwanted artifacts"
                                ifFalse:
                                        [Beeper beep].  "throw minnows back"
                        self delete].
       
        handle visible: false.
        aHand attachMorph: handle.
        handle startStepping! !


!SketchEditorMorph methodsFor: 'start & finish' stamp: 'ct 9/11/2020 20:27'!
cancelOutOfPainting
        "The user requested to back out of a painting session without saving"

        self deleteSelfAndSubordinates.
        emptyPicBlock ifNotNil: [emptyPicBlock value].  "note no args to block!!"
        hostView ifNotNil: [hostView changed].
        Project current world resumeScriptsPausedByPainting.
        ^ nil! !

!SketchEditorMorph methodsFor: 'start & finish' stamp: 'ct 9/11/2020 20:27'!
deliverPainting: result evt: evt
        "Done painting.  May come from resume, or from original call.  Execute user's post painting instructions in the block.  Always use this standard one.  4/21/97 tk"

        | newBox newForm ans |
        palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt].  "Get out of odd modes"
        "rot := palette getRotations."  "rotate with heading, or turn to and fro"
        "palette setRotation: #normal."
        result == #cancel ifTrue: [
                ans := UIManager default chooseFrom: {
                         'throw it away' translated.
                        'keep painting it' translated.
                } title: 'Do you really want to throw away
what you just painted?' translated.
                ^ ans = 1 ifTrue: [self cancelOutOfPainting]
                                ifFalse: [nil]].        "cancelled out of cancelling."

        "hostView rotationStyle: rot."          "rotate with heading, or turn to and fro"
        newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent.
        registrationPoint ifNotNil:
                [registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin"
        newForm :=       Form extent: newBox extent depth: paintingForm depth.
        newForm copyBits: newBox from: paintingForm at: 0@0
                clippingBox: newForm boundingBox rule: Form over fillColor: nil.
        newForm isAllWhite ifTrue: [
                (self valueOfProperty: #background) == true
                        ifFalse: [^ self cancelOutOfPainting]].

        newForm fixAlpha. "so alpha channel stays intact for 32bpp"

        self delete.    "so won't find me again"
        dimForm ifNotNil: [dimForm delete].
        newPicBlock value: newForm value: (newBox copy translateBy: bounds origin).
        Project current world resumeScriptsPausedByPainting.! !


!SketchMorph methodsFor: 'menus' stamp: 'ct 9/11/2020 20:27'!
collapse
        "Replace the receiver with a collapsed rendition of itself."

        | w collapsedVersion a ht |
       
        (w := self world) ifNil: [^ self].
        collapsedVersion := (self imageForm scaledToSize: 50@50) asMorph.
        collapsedVersion setProperty: #uncollapsedMorph toValue: self.
        collapsedVersion on: #mouseUp send: #uncollapseSketch to: collapsedVersion.
       
        collapsedVersion setBalloonText: ('A collapsed version of {1}.  Click to open it back up.' translated format: {self externalName}).
       
        self delete.
        w addMorphFront: (
                a := AlignmentMorph newRow
                        hResizing: #shrinkWrap;
                        vResizing: #shrinkWrap;
                        borderWidth: 4;
                        borderColor: Color white;
                        addMorph: collapsedVersion;
                        yourself).
        a setNameTo: self externalName.
        ht := (Smalltalk at: #SugarNavTab ifPresent: [:c | Project current world findA: c])
                ifNotNil: [:tab | tab height]
                ifNil: [80].
        a position: 0@ht.

        collapsedVersion setProperty: #collapsedMorphCarrier toValue: a.

        (self valueOfProperty: #collapsedPosition) ifNotNil: [:priorPosition |
                a position: priorPosition].! !


!ColorPickerMorph methodsFor: '*Etoys-Squeakland-event handling' stamp: 'ct 9/12/2020 14:39'!
deleteBoxHit
        "The delete box was hit..."

        self currentHand showTemporaryCursor: nil.
        self delete.! !

!ColorPickerMorph methodsFor: '*Etoys-Squeakland-e-toy support' stamp: 'ct 9/12/2020 14:39'!
openPropertySheet
        "Delete the receiver and open a property sheet on my target instead."

        self currentHand showTemporaryCursor: nil.
        target openAppropriatePropertySheet.
        self delete.! !


!StackMorph methodsFor: 'menu' stamp: 'ct 9/12/2020 14:53'!
findText: keys inStrings: rawStrings startAt: startIndex container: oldContainer cardNum: cardNum
        "Call once to search a card of the stack.  Return true if found and highlight the text.  oldContainer should be NIL. 
        (oldContainer is only non-nil when (1) doing a 'search again' and (2) the page is in memory and (3) keys has just one element.  oldContainer is a TextMorph.)"

        | container strings old good insideOf place start |
        good := true.
        start := startIndex.
        strings := oldContainer ifNil:
                                        ["normal case"

                                        rawStrings]
                                ifNotNil: [self currentPage allStringsAfter: oldContainer text].
        keys do:
                        [:searchString | | thisWord |
                        "each key"

                        good
                                ifTrue:
                                        [thisWord := false.
                                        strings do:
                                                        [:longString | | index |
                                                        (index := longString findWordStart: searchString startingAt: start) > 0
                                                                ifTrue:
                                                                        [thisWord not & (searchString == keys first)
                                                                                ifTrue:
                                                                                        [insideOf := longString.
                                                                                        place := index].
                                                                        thisWord := true].
                                                        start := 1].    "only first key on first container"
                                        good := thisWord]].
        good
                ifTrue:
                        ["all are on this page"

                        "wasIn := (pages at: pageNum) isInMemory."

                        self goToCardNumber: cardNum
                        "wasIn ifFalse: ['search again, on the real current text.  Know page is in.'.
                        ^ self findText: keys
                                inStrings: ((pages at: pageNum) allStringsAfter: nil)         recompute it     
                                startAt: startIndex container: oldContainer
                                pageNum: pageNum]"].
        (old := self valueOfProperty: #searchContainer) ifNotNil:
                        [(old respondsTo: #editor)
                                ifTrue:
                                        [old editor selectFrom: 1 to: 0.        "trying to remove the previous selection!!"
                                        old changed]].
        good
                ifTrue:
                        ["have the exact string object"

                        (container := oldContainer) ifNil:
                                        [container := self
                                                                highlightText: keys first
                                                                at: place
                                                                in: insideOf]
                                ifNotNil:
                                        [container userString == insideOf
                                                ifFalse:
                                                        [container := self
                                                                                highlightText: keys first
                                                                                at: place
                                                                                in: insideOf]
                                                ifTrue:
                                                        [(container isTextMorph)
                                                                ifTrue:
                                                                        [container editor selectFrom: place to: keys first size - 1 + place.
                                                                        container changed]]].
                        self setProperty: #searchContainer toValue: container.
                        self setProperty: #searchOffset toValue: place.
                        self setProperty: #searchKey toValue: keys.     "override later"
                        self currentHand newKeyboardFocus: container.
                        ^true].
        ^false! !

!StackMorph methodsFor: 'menu' stamp: 'ct 9/12/2020 14:53'!
findViaTemplate
        | list pl cardInst |
        "Current card is the template.  Only search cards in this background. Look at cards directly (not allText). Key must be found in the same field as in the template.  HyperCard style (multiple starts of words). 
        Put results in a list, outside the stack."

        list := self templateMatches.
        list isEmpty ifTrue: [^ self inform: 'No matches were found.
Be sure the current card is mostly blank
and only has text you want to match.' translated].
        "put up a PluggableListMorph"
        cardInst := self currentCard.
        cardInst matchIndex: 0. "establish entries"
        cardInst results at: 1 put: list.
        self currentPage setProperty: #myStack toValue: self.   "way to get back"

        pl := PluggableListMorph new
                        on: cardInst list: #matchNames
                        selected: #matchIndex changeSelected: #matchIndex:
                        menu: nil "#matchMenu:shifted:" keystroke: nil.
        self currentHand attachMorph: (self formatList: pl).
! !


!StandardScriptingSystem methodsFor: '*Etoys-Squeakland-help in a flap' stamp: 'ct 9/11/2020 20:26'!
assureFlapOfLabel: aTitle withContents: aString
        "Answer an info flap with the given title and contents.  If one exists in the project, use that, else create one & insert it in the world.  Answer the flap tab."

        | allFlapTabs aTab |
        allFlapTabs :=  Project current world localFlapTabs, Project current world extantGlobalFlapTabs.
        aTab := allFlapTabs detect:
                [:ft | ft flapID = aTitle] ifNone: [nil].
        aTab ifNotNil: [^ aTab].  "already present"

        aTab := self openInfoFlapWithLabel: aTitle helpContents: aString edge: #left.
        aTab bottom: Project current world bottom.
        self cleanUpFlapTabsOnLeft.
        aTab hideFlap.
        aTab referent show.
        aTab show.
        ^ aTab

"
ScriptingSystem assureFlapOfLabel: 'Egg Sample' withContents: EventRollMorph basicNew helpString
"! !

!StandardScriptingSystem methodsFor: '*Etoys-Squeakland-help in a flap' stamp: 'ct 9/11/2020 20:26'!
cleanUpFlapTabsOnLeft
        "Make sure the flap tabs on the left of the screen line up nicely, making best use of realestate."

        | tabsOnLeft current |
        tabsOnLeft :=  ((Project current world localFlapTabs, Project current world extantGlobalFlapTabs) select: [:f | f edgeToAdhereTo = #left])
                sort: [:a :b | a top <= b top].
        current := SugarNavigatorBar showSugarNavigator
                ifTrue: [75]
                ifFalse: [0].
        tabsOnLeft do:
                [:aTab |
                        aTab top: (current min: Project current world height - aTab height).
                        current := aTab bottom + 2].
"
ScriptingSystem cleanUpFlapTabsOnLeft
"! !

!StandardScriptingSystem methodsFor: '*Etoys-Squeakland-help in a flap' stamp: 'ct 9/11/2020 20:25'!
openInfoFlapWithLabel: aTitle helpContents: aString edge: anEdge
        "Open an info flap with the given label, contents, and edge"

        | aPlug outer leftStrip rightStrip titleRow aDismissButton aFlapTab |
        Preferences enable: #scrollBarsOnRight.
        Preferences enable: #inboardScrollbars.

        aFlapTab := FlapTab new.
        aFlapTab assureExtension visible: false.
        aFlapTab referentMargin: 0 @ Project current world sugarAllowance.
       
        outer := HelpFlap newRow.
        outer assureExtension visible: false.
        outer clipSubmorphs: true.
        outer beTransparent.
        outer vResizing: #spaceFill; hResizing: #spaceFill.
        outer layoutInset: 0; cellInset: 0; borderWidth: 0.
        outer setProperty: #morphicLayerNumber toValue: 26.
       
        leftStrip := Morph new beTransparent.
        leftStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
        leftStrip width:  20.
        leftStrip hResizing: #rigid; vResizing: #spaceFill.
        outer addMorphBack: leftStrip.
       
        rightStrip := AlignmentMorph newColumn.
        rightStrip beTransparent.
        rightStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
        outer addMorphBack: rightStrip.
        outer clipSubmorphs: true.
       
        titleRow := AlignmentMorph newRow.
        titleRow borderColor: Color veryVeryLightGray; borderWidth: 1.
        titleRow hResizing: #spaceFill; vResizing: #shrinkWrap.
        titleRow beTransparent.
        aDismissButton := aFlapTab tanOButton.
        aDismissButton actionSelector: #dismissViaHalo.
        titleRow addMorphFront: aDismissButton.
        titleRow addTransparentSpacerOfSize: 8 @ 0.
        titleRow
                addMorphBack: (StringMorph contents: aTitle font:  Preferences standardEToysTitleFont).
        rightStrip addMorph: titleRow.
       
        aPlug := PluggableTextMorph new.
        aPlug width: 540.
        aPlug setText: aString.
        aPlug textMorph beAllFont: Preferences standardEToysFont.
        aPlug retractable: false; scrollBarOnLeft: false.
        aPlug hScrollBarPolicy: #never.
        aPlug borderColor: ScriptingSystem borderColor.
        aPlug setNameTo: aTitle.
        aPlug hResizing: #spaceFill.
        aPlug vResizing: #spaceFill.
        rightStrip addMorphBack: aPlug.
        aFlapTab referent ifNotNil: [aFlapTab referent delete].
        aFlapTab referent: outer.
        aFlapTab setName: aTitle edge: anEdge color: (Color r: 0.677 g: 0.935 b: 0.484).
        aFlapTab submorphs first beAllFont: Preferences standardEToysFont.
        Project current world addMorphFront: aFlapTab.
        aFlapTab adaptToWorld: Project current world.
        aFlapTab computeEdgeFraction.
       
        anEdge == #left ifTrue:
                [aFlapTab position: (outer left @ outer top).
                outer extent: (540 @ Project current world height)].
        anEdge == #right ifTrue:
                [aFlapTab position: ((Project current world right - aFlapTab width) @ Project current world top).
                outer extent: (540 @ Project current world height)].
       
        outer beFlap: true.
        outer color: Color green veryMuchLighter.
       
        aPlug textMorph lock.
        aFlapTab referent hide.
        aFlapTab openFully.
       
        outer beSticky.
        leftStrip beSticky.
        rightStrip beSticky.
       
        Project current world doOneCycle.
        aPlug width: 540.
        aPlug setText: aString. "hmm, again"
       
        aPlug color: outer color.
       
        aPlug borderWidth: 0.
       
        aPlug textMorph contents: aString wrappedTo: 520.
        aFlapTab applyThickness: 560.
        aFlapTab fitOnScreen.
        aFlapTab referent show.
        ^ aFlapTab! !

!StandardScriptingSystem methodsFor: '*Etoys-Squeakland-gold box' stamp: 'ct 9/11/2020 20:24'!
systemQueryPhraseWithActionString: aString labelled: anotherString
        "Answer a system-query-phrase with the give action-string and label."

        ^ Project current world presenter
                systemQueryPhraseWithActionString: aString labelled: anotherString! !


!StandardViewer methodsFor: 'macpal' stamp: 'ct 9/11/2020 20:24'!
currentVocabulary
        "Answer the vocabulary currently associated with the receiver"

        | aSym aVocab |
        aSym := self valueOfProperty: #currentVocabularySymbol ifAbsent: [nil].
        aSym ifNil:
                [aVocab := self valueOfProperty: #currentVocabulary ifAbsent: [nil].
                aVocab ifNotNil:
                        [aSym := aVocab vocabularyName.
                        self removeProperty: #currentVocabulary.
                        self setProperty: #currentVocabularySymbol toValue: aSym]].
        ^ aSym
                ifNotNil:
                        [Vocabulary vocabularyNamed: aSym]
                ifNil:
                        [(self world ifNil: [Project current world]) currentVocabularyFor: scriptedPlayer]! !


!SugarLauncher methodsFor: 'commands' stamp: 'ct 9/12/2020 14:07'!
viewSource

        Project current world addDeferredUIMessage: [
                Project current world showSourceKeyHit].! !


!SugarNavTab methodsFor: 'positioning' stamp: 'ct 9/11/2020 20:24'!
occupyTopRightCorner
        "Make the receiver be the correct size, and occupy the top-right corner of the screen."

        | worldBounds toUse |
        worldBounds := Project current world bounds.
"       toUse := Preferences useArtificialSweetenerBar
                ifFalse:
                        [75]
                ifTrue:
                        [(ActiveWorld  extent >= (1200 @ 900))
                                ifTrue:
                                        [75]
                                ifFalse:
                                        [40]]."
        toUse := 40.  "Trying for the moment to use the smaller icon always when in this mode."

        referent height: toUse; resizeButtonsAndTabTo: toUse.
        self extent: toUse @ toUse.
        self topRight: worldBounds topRight! !


!SugarNavigatorBar methodsFor: 'initialization' stamp: 'ct 9/12/2020 14:53'!
putUpInitialBalloonHelp
"
        SugarNavigatorBar putUpInitialBalloonHelp
"

        | suppliesButton b1 b2 p b |
        suppliesButton := paintButton owner submorphs detect: [:e | e isButton and: [e actionSelector = #toggleSupplies]].

        b1 := BalloonMorph string: self paintButtonInitialExplanation for: paintButton corner: #topRight force: false.
        b2 := BalloonMorph string: self suppliesButtonInitialExplanation for: suppliesButton corner: #topLeft force: true.

        p := PasteUpMorph new.
        p clipSubmorphs: false.
        p color: Color transparent.
        p borderWidth: 0.
        p addMorph: b1.
        p addMorph: b2.
        b := BalloonMorph string: p for: self world corner: #bottomLeft.
        b color: Color transparent.
        b borderWidth: 0.
        [(Delay forSeconds: 1) wait. b popUp] fork.! !

!SugarNavigatorBar methodsFor: 'initialization' stamp: 'ct 9/12/2020 14:53'!
putUpInitialBalloonHelpFor: quads
        "Given a list of quads of the form <selector> <help-msg> <corner> <force-boolean> (see senders for examples), put up initial balloon help for them."
"
        SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((doNewPainting 'make a new painting' topRight false) (toggleSupplies 'open the supplies bin' topLeft true))
        SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((showNavBar 'show the tool bar' bottomLeft false) (hideNavBar 'hide the tool bar' bottomLeft false))

"
        |  b1 p b |

        p := PasteUpMorph new.
        p clipSubmorphs: false.
        p color: Color transparent.
        p borderWidth: 0.

        quads do: [:aQuad |
                (submorphs first submorphs detect: [:e | e isButton and: [e actionSelector = aQuad first]] ifNone: [nil]) ifNotNil:
                        [:aButton |
                                b1 := BalloonMorph string: aQuad second for: aButton corner: aQuad third force: aQuad fourth.
                                p addMorph: b1]].

        b := BalloonMorph string: p for: self world corner: #bottomLeft.
        b color: Color transparent.
        b borderWidth: 0.
        [(Delay forSeconds: 1) wait. b popUp] fork.! !

!SugarNavigatorBar methodsFor: 'help flap' stamp: 'ct 9/12/2020 14:37'!
buildAndOpenHelpFlap
        "Called only when flaps are being created afresh."

        | aFlapTab outer leftStrip rightStrip aGuide |
        aFlapTab := FlapTab new.
        aFlapTab assureExtension visible: false.
        aFlapTab setProperty: #rigidThickness toValue: true.

        outer := AlignmentMorph newRow.
        outer assureExtension visible: false.
        outer clipSubmorphs: true.
        outer beTransparent.
        outer vResizing: #spaceFill; hResizing: #spaceFill.
        outer layoutInset: 0; cellInset: 0; borderWidth: 0.
        outer setProperty: #wantsHaloFromClick toValue: false.

        leftStrip := Morph new beTransparent.  "This provides space for tabs to be seen."
        leftStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
        leftStrip width:  20.
        leftStrip hResizing: #rigid; vResizing: #spaceFill.
        outer addMorphBack: leftStrip.  

        rightStrip := AlignmentMorph newColumn.
        rightStrip color: (Color green veryMuchLighter alpha:  0.2).
        rightStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
        rightStrip setProperty: #wantsHaloFromClick toValue: false.
        outer addMorphBack: rightStrip.
        outer clipSubmorphs: true.
       
        aGuide := QuickGuideMorph new.
        aGuide initializeIndexPage.
"       aGuide order: QuickGuideMorph defaultOrder.     "
        QuickGuideMorph loadIndexAndPeekOnDisk.
        aGuide loadPages.
        rightStrip addMorphBack: aGuide.
        aGuide beSticky.

        aFlapTab referent ifNotNil: [aFlapTab referent delete].
        aFlapTab referent: outer.
        aFlapTab setName: 'Help' translated edge: #left color: (Color r: 0.677 g: 0.935 b: 0.484).
        Project current world addMorphFront: aFlapTab.
        aFlapTab adaptToWorld: Project current world.
        aFlapTab computeEdgeFraction.

        aFlapTab position: outer left @ outer top.
        outer extent: 462 @ Project current world height.

        outer beFlap: true.
        outer beTransparent.

        aFlapTab referent hide.
        aFlapTab referentMargin: 0@self height.
        aFlapTab openFully.

        outer beSticky.
        leftStrip beSticky.
        rightStrip beSticky.

        aFlapTab applyThickness: 462.
        aFlapTab fitOnScreen.
        aFlapTab referent show.
        aFlapTab show.
        aFlapTab makeFlapCompact: true.
        aFlapTab setToPopOutOnDragOver:  false.
        Flaps addGlobalFlap: aFlapTab.
        Project current world addGlobalFlaps.
        ScriptingSystem cleanUpFlapTabsOnLeft! !

!SugarNavigatorBar methodsFor: 'the actions' stamp: 'ct 9/12/2020 14:53'!
gotoAnother

        EToyProjectHistoryMorph new
                position: self currentHand position;
                openInWorld
! !

!SugarNavigatorBar methodsFor: 'the actions' stamp: 'ct 9/11/2020 20:23'!
makeProjectNameLabel

        | t |
        projectNameField := SugarRoundedField new.
        t := UpdatingStringMorph new.
        t setProperty: #okToTextEdit toValue: true.
        t putSelector: #projectNameChanged:.
        t getSelector: #projectName.
        projectNameField backgroundColor: self color.
        t target: self.
        t useStringFormat.
        t beSticky.
        t label: Project current name font: (StrikeFont familyName: 'BitstreamVeraSans' size: 24).
        t color: Color black.
        t width: projectNameField width - 10.
        projectNameField label: t.
        projectNameField setBalloonText: self projectNameFieldBalloonHelp.
        projectNameField on: #mouseDown send: #mouseDown: to: t.
        projectNameField on: #mouseUp send: #mouseUp: to: t.
        self resizeProjectNameField.
        ^projectNameField.! !

!SugarNavigatorBar methodsFor: 'the actions' stamp: 'ct 9/11/2020 20:23'!
projectName

        ^ Project current name
! !

!SugarNavigatorBar methodsFor: 'the actions' stamp: 'ct 9/11/2020 20:23'!
projectNameChanged: aString

        Project current renameTo: aString.
! !

!SugarNavigatorBar methodsFor: 'the actions' stamp: 'ct 9/11/2020 20:23'!
shareMenu

        | menu item ext |
        menu := MenuMorph new.
        ext := 200@50.
        #((stopSharing makePrivateLabelIn:) (startSharing makeMyNeighborhoodLabelIn:) "(shareThisWorld makeBadgeLabelIn:)") do: [:pair |
               
                item := MenuItemMorph new
                        contents: '';
                        target: self;
                        selector: pair first;
                        arguments: #().
                item color: Color black.
                item addMorph: (self perform: pair second with: ext).
                item setProperty: #minHeight toValue: ext y.
                item fitContents.
                item extent: ext.
                item setProperty: #selectionFillStyle toValue: (Color gray alpha: 0.5).
                menu addMorphBack: item.
        ].
        menu color: Color black.
        menu borderColor: Color white.
        ^ menu invokeModalAt: shareButton position + (10@20) in: Project current world allowKeyboard: false.! !

!SugarNavigatorBar methodsFor: 'sharing' stamp: 'ct 9/12/2020 14:37'!
startNebraska

        | nebraska |
        Project current world remoteServer: nil.
        Project current world submorphs do: [:e | (e isMemberOf: NebraskaServerMorph) ifTrue: [e delete]].
        nebraska := NebraskaServerMorph serveWorld.
        SugarLauncher current
                offerStreamTube: 'sqk-nebraska'
                inBackgroundOnPort: [nebraska listeningPort].
! !

!SugarNavigatorBar methodsFor: 'sharing' stamp: 'ct 9/11/2020 20:22'!
startP2P
        listener ifNotNil: [listener stopListening].
        listener ifNil: [listener := SugarListenerMorph new].
        listener position: -200@ -200.
        Project current world addMorphBack: listener.
        listener startListening.
        SugarLauncher current
                offerStreamTube: 'sqk-etoy-p2p'
                inBackgroundOnPort: [listener listeningPort].! !

!SugarNavigatorBar methodsFor: 'sharing' stamp: 'ct 9/11/2020 20:22'!
stopSharing
        SugarLauncher current leaveSharedActivity.
        listener ifNotNil: [listener stopListening. listener := nil].
        Project current world remoteServer: nil.
        Project current world submorphs do: [:ea |
                (ea isMemberOf: NebraskaServerMorph) ifTrue: [ea delete]].
        self sharingChanged.! !

!SugarNavigatorBar methodsFor: 'event handling' stamp: 'ct 9/11/2020 20:22'!
undoButtonAppearance

        | wording |
        undoButton ifNotNil: [
                Project current world commandHistory undoEnabled
                        ifTrue: [undoButton enabled]
                        ifFalse: [undoButton disabled].
                wording := self undoButtonWording.
                undoButton setBalloonText: wording.
        ].

! !


!InteriorSugarNavBar methodsFor: 'buttons' stamp: 'ct 9/11/2020 20:12'!
doNewPainting
        "Make a new painting"

        | worldlet aRect |
        self currentWorld assureNotPaintingElse: [^ self].
        worldlet := self ownerThatIsA: Worldlet.
        aRect := (worldlet topLeft + (0 @ self height)) corner: worldlet bottomRight.
        worldlet makeNewDrawing: (self currentEvent copy setPosition: aRect center).! !


!SugarNavigatorBar class methodsFor: 'utilitity' stamp: 'ct 9/11/2020 20:22'!
findAnythingMorph

        ^ FileList2 morphicViewProjectLoader2InWorld: Project current world
                title: 'Find...' translated
                reallyLoad: true
                dirFilterType: #initialDirectoryList
                isGeneral: true.! !


!SugarRoundedField methodsFor: 'as yet unclassified' stamp: 'ct 9/11/2020 20:22'!
resizeLabel

        | small |
        (label notNil and: [label hasFocus not]) ifTrue: [
                label width: self width - 10.
                small :=self height < 45.
                label label: Project current world project name font: (StrikeFont familyName: 'BitstreamVeraSans' size: (small ifTrue: [15] ifFalse: [24])).
                label center: self center.
                label left: self left + 10.
                self addMorph: label.
        ].
! !


!SyntaxMorph methodsFor: 'menus' stamp: 'ct 9/12/2020 14:55'!
offerTilesMenuFor: aReceiver in: aLexiconModel
        "Offer a menu of tiles for assignment and constants"

        | menu |
        menu := MenuMorph new addTitle: 'Hand me a tile for...'.
        menu addLine.
        menu add: '(accept method now)' target: aLexiconModel selector: #acceptTiles.
        menu submorphs last color: Color red darker.
        menu addLine.

        menu add: 'me, by name' target: self  selector: #attachTileForCode:nodeType:
                                argumentList: {'<me by name>'. aReceiver}.
        menu add: 'self' target: self  selector: #attachTileForCode:nodeType:
                                argumentList: {'self'. VariableNode}.
        menu add: '_   (assignment)' target: self  selector: #attachTileForCode:nodeType:
                                argumentList: {'<assignment>'. nil}.
        menu add: '"a Comment"' target: self  selector: #attachTileForCode:nodeType:
                                argumentList: {'"a comment"\' withCRs. CommentNode}.
        menu submorphs last color: Color blue.
        menu add: 'a Number' target: self  selector: #attachTileForCode:nodeType:
                                argumentList: {'5'. LiteralNode}.
        menu add: 'a Character' target: self  selector: #attachTileForCode:nodeType:
                                argumentList: {'$z'. LiteralNode}.
        menu add: '''abc''' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'''abc'''. LiteralNode}.
        menu add: 'a Symbol constant' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'#next'. LiteralNode}.
        menu add: 'true' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'true'. VariableNode}.
        menu add: 'a Test' target: self  selector: #attachTileForCode:nodeType:
                                argumentList: {'true ifTrue: [self] ifFalse: [self]'. MessageNode}.
        menu add: 'a Loop' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'1 to: 10 do: [:index | self]'. MessageNode}.
        menu add: 'a Block' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'[self]'. BlockNode}.
        menu add: 'a Class or Global' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'Character'. LiteralVariableNode}.
        menu add: 'a Reply' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'| temp | temp'. ReturnNode}.
        menu popUpInWorld: self world.! !

!SyntaxMorph methodsFor: 'menus' stamp: 'ct 9/12/2020 14:55'!
offerVarsMenuFor: aReceiver in: aLexiconModel
        "Offer a menu of tiles for assignment and constants"

        | menu instVarList cls |
        menu := MenuMorph new addTitle: 'Hand me a tile for...'.
        menu addLine.
        menu add: '(accept method now)' target: aLexiconModel selector: #acceptTiles.
        menu submorphs last color: Color red darker.
        menu addLine.
        menu add: 'new temp variable' target: self selector: #attachTileForCode:nodeType:
                                argumentList: {'| temp | temp'. TempVariableNode}.

        instVarList := OrderedCollection new.
        cls := aReceiver class.
        [instVarList addAllFirst: cls instVarNames.
         cls == aLexiconModel limitClass] whileFalse: [cls := cls superclass].
        instVarList do: [:nn |
                menu add: nn target: self selector: #instVarTile: argument: nn].
        menu popUpInWorld: self world.! !

!SyntaxMorph methodsFor: 'new tiles' stamp: 'ct 9/12/2020 14:54'!
attachToHand
        "Adjust my look and attach me to the hand"

        self roundedCorners.
        self currentHand attachMorph: self.
        Preferences tileTranslucentDrag
                ifTrue: [self lookTranslucent.
                        self align: self center with: self currentHand position "+ self cursorBaseOffset"]
                ifFalse: [
                        self align: self topLeft with: self currentHand position + self cursorBaseOffset].! !

!SyntaxMorph methodsFor: 'new tiles' stamp: 'ct 9/12/2020 14:54'!
instVarTile: aName
        "Make and put into hand a tile for an instance variable"

        | sm |
        sm := ((VariableNode new
                                        name: aName
                                        index: 1
                                        type: 1 "LdInstType") asMorphicSyntaxIn: SyntaxMorph new).
        sm roundedCorners.
        self currentHand attachMorph: sm.
        Preferences tileTranslucentDrag
                ifTrue: [sm lookTranslucent.
                        sm align: sm center with: self currentHand position "+ self cursorBaseOffset"]
                ifFalse: [
                        sm align: sm topLeft with: self currentHand position + self cursorBaseOffset]! !

!SyntaxMorph methodsFor: 'scripting' stamp: 'ct 9/12/2020 14:55'!
tearOffTile
        "For a SyntaxMorph, this means give a copy of me"

        | dup |
        dup := self duplicate.
        self currentHand attachMorph: dup.
        ^ Preferences tileTranslucentDrag
                ifTrue: [dup lookTranslucent]
                ifFalse: [dup align: dup topLeft with: self currentHand position + self cursorBaseOffset]! !


!SystemWindow methodsFor: 'events' stamp: 'ct 9/11/2020 20:22'!
doFastFrameDrag: grabPoint
        "Do fast frame dragging from the given point"

        | offset newBounds outerWorldBounds clearArea |
        outerWorldBounds := self boundsIn: nil.
        offset := outerWorldBounds origin - grabPoint.
        clearArea := Project current world clearArea.
        newBounds := outerWorldBounds newRectFrom: [:f |
                | p selector |
                p := Sensor cursorPoint.
                (self class dragToEdges and: [(selector := self dragToEdgesSelectorFor: p in: clearArea) notNil])
                        ifTrue: [clearArea perform: selector]
                        ifFalse: [p + offset extent: outerWorldBounds extent]].
        self bounds: newBounds; comeToFront! !


!CollapsedMorph methodsFor: 'collapse/expand' stamp: 'ct 9/12/2020 14:39'!
uncollapseToHand
        "Hand the uncollapsedMorph to the user, placing it in her hand, after remembering appropriate state for possible future use"

        | nakedMorph |
        nakedMorph := uncollapsedMorph.
        uncollapsedMorph := nil.
        nakedMorph setProperty: #collapsedPosition toValue: self position.
        mustNotClose := false.  "so the delete will succeed"
        self delete.
        self currentHand attachMorph: nakedMorph.! !


!SystemWindow class methodsFor: '*Etoys-Squeakland-top window' stamp: 'ct 9/11/2020 18:01'!
rotateWindows
        "Rotate the z-ordering of the windows."

        self currentEvent shiftPressed
                ifTrue: [self sendTopWindowBackOne]
                ifFalse: [self sendTopWindowToBack].! !

!SystemWindow class methodsFor: '*Etoys-Squeakland-top window' stamp: 'ct 9/11/2020 20:21'!
sendTopWindowBackOne
        "Rotate the window-list one downward, i.e., make the bottommost one be the active one, pushing the receiver to next-to-topmost."

        | dows |
        dows := Project current world submorphs select: [:m | m isSystemWindow].
        dows ifNotEmpty: [dows last expand;  comeToFront]! !


!TextEditor methodsFor: 'menu commands' stamp: 'ct 9/11/2020 18:02'!
offerMenuFromEsc: aKeyboardEvent
        "The escape key was hit while the receiver has the keyboard focus; take action."

        self currentEvent shiftPressed ifFalse: [
                self raiseContextMenu: aKeyboardEvent].
        ^ true! !


!ThreePhaseButtonMorph methodsFor: 'button' stamp: 'ct 9/11/2020 18:02'!
doButtonAction
        "Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments."

        | args |
        (target notNil and: [actionSelector notNil]) ifTrue: [
                args := actionSelector numArgs > arguments size
                        ifTrue: [arguments copyWith: self currentEvent]
                        ifFalse: [arguments].
                Cursor normal showWhile: [
                        target perform: actionSelector withArguments: args].
                target isMorph ifTrue: [target changed]].! !


!TileMorph methodsFor: 'arrows' stamp: 'ct 9/11/2020 18:02'!
showSuffixChoices
        "The suffix arrow has been hit, so respond appropriately"

        | plusPhrase phrase pad outer num |
        self currentEvent shiftPressed ifTrue: [^ self wrapPhraseInFunction].

        (phrase := self ownerThatIsA: PhraseTileMorph orA: FunctionTile) ifNil: [nil].

        (type == #literal) & (literal isNumber) ifTrue: ["Tile is a constant number"
                (phrase isNil or: [phrase finalTilePadSubmorph == owner]) "pad"
                        ifTrue: ["we are adding the first time (at end of our phrase)"
                                plusPhrase := self phraseForOp: #+ arg: 1 resultType: #Number.
                                plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
                                owner acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
                                num := plusPhrase firstSubmorph firstSubmorph.
                                num deleteSuffixArrow]].

        (#(function expression parameter) includes: type) ifTrue:
                        [pad := self ownerThatIsA: TilePadMorph.
                        plusPhrase := self presenter phraseForReceiver: 1  op: #+ arg: 1 resultType: #Number.
                        plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
                        pad acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
                        plusPhrase firstSubmorph removeAllMorphs; addMorph: self.
                        pad topEditor scriptEdited "recompile"].

        type = #operator ifTrue: ["Tile is accessor of an expression"
                phrase resultType == #Number ifTrue:
                        [outer := phrase ownerThatIsA: PhraseTileMorph orA: TimesRepeatTile.
                        pad := self ownerThatIsA: TilePadMorph.
                        outer ifNotNil:
                                [(outer lastSubmorph == pad or: [true]) ifTrue: [ "first time"
                                        plusPhrase := self presenter phraseForReceiver: 1
                                                        op: #+ arg: 1 resultType: #Number.
                                        plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
                                        pad acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
                                        plusPhrase firstSubmorph removeAllMorphs; addMorph: phrase.     "car's heading"
                                        pad topEditor scriptEdited "recompile & deal with carets"]]]].

        (self topEditor ifNil: [phrase ifNil: [^ self]]) enforceTileColorPolicy! !

!TileMorph methodsFor: 'code generation' stamp: 'ct 9/11/2020 20:21'!
acceptNewLiteral
        "Tell the scriptEditor who I belong to that I have a new literal value."

        | topScript |
        topScript := self outermostMorphThat:
                [:m | m isKindOf: ScriptEditorMorph].
        topScript ifNotNil: [topScript installWithNewLiteral].
        (self ownerThatIsA: ViewerLine) ifNotNil:
                [:aLine |
                        (self ownerThatIsA: PhraseTileMorph) ifNotNil:
                                [aLine removeHighlightFeedback.
                                self layoutChanged.
                                Project current world doOneSubCycle.
                                aLine addCommandFeedback: nil]]! !

!TileMorph methodsFor: 'misc' stamp: 'ct 9/12/2020 14:56'!
handReferentMorph
        "Hand the user the actual morph referred to"

        | aMorph surrogate |
        ((aMorph := actualObject costume) isMorph
                and: [aMorph isWorldMorph not])
                        ifTrue: [
                                surrogate := CollapsedMorph collapsedMorphOrNilFor: aMorph.
                                surrogate
                                        ifNotNil: [surrogate uncollapseToHand]
                                        ifNil: [self currentHand attachMorph: aMorph]].! !


!SymbolListTile methodsFor: 'user interface' stamp: 'ct 9/11/2020 20:22'!
choices
        "Answer the list of current choices for the receiver's symbol"

        dataType == #ScriptName ifTrue: "Backward compatibility with old tiles"
                [^ Project current world presenter allKnownUnaryScriptSelectors].
        ^ choices! !


!ScriptNameTile methodsFor: 'initialization' stamp: 'ct 9/11/2020 20:29'!
choices
        "Answer the current list of choices"

        ^ Project current world presenter allKnownUnaryScriptSelectors! !


!TileMorph class methodsFor: '*Etoys-Squeakland-utilities' stamp: 'ct 9/11/2020 20:21'!
implicitSelfInTilesChanged
        "The implicitSelfInTiles preference changed.  Caution:  although this may appear to have no senders in the image, it is in fact invoked when the implicitSelfInTiles preference is toggled... so please do not delete it."

        Smalltalk isMorphic ifFalse: [^ self].
        Project current world allScriptEditorsInProject do: [:scriptEditor | scriptEditor install].
        Project current world allViewersInProject do: [:viewer | viewer enforceImplicitSelf].

"
(Preferences buttonForPreference: #implicitSelfInTiles) openInHand.
"! !


!TileMorphTest methodsFor: 'testing' stamp: 'ct 9/12/2020 14:56'!
testAssignmentTile
        "self debug: #testAssignmentTile"

        | player viewer tile phrase |
        player := Morph new assuredPlayer.
        viewer := CategoryViewer new invisiblySetPlayer: player.
        viewer  makeSetter: #(#getX #Number) event: nil from: player costume.
        phrase := self currentHand firstSubmorph.
        self currentHand removeAllMorphs.
        tile := phrase submorphs second.

        self assert: tile codeString = 'setX: '.
        tile arrowAction: 1.
        self assert: tile codeString = 'setX: self getX + '.! !


!TypeListTile methodsFor: 'mouse handling' stamp: 'ct 9/12/2020 14:56'!
showOptions
        | topScript |
        suffixArrow
                ifNotNil: [(suffixArrow bounds containsPoint: self currentHand cursorPoint)
                                ifTrue: [^ super showOptions]].
        topScript := self
                                outermostMorphThat: [:m | m isKindOf: ScriptEditorMorph].
        topScript
                ifNotNil: [topScript handUserParameterTile]! !


!UserDialogBoxMorph class methodsFor: 'utilities' stamp: 'ct 9/11/2020 20:20'!
confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice at: aPointOrNil
        "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?' trueChoice: 'Oh yessir!!' falseChoice: 'Not so much...'"
        ^self new
                title: titleString;
                message: aString;
                createButton: trueChoice translated value: true;
                createButton: falseChoice translated value: false;
                createCancelButton: 'Cancel' translated translated value: nil;
                selectedButtonIndex: 1;
                registerKeyboardShortcuts;
                preferredPosition: (aPointOrNil ifNil: [Project current world center]);
                getUserResponse! !

!UserDialogBoxMorph class methodsFor: 'utilities' stamp: 'ct 9/11/2020 20:20'!
confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice default: default triggerAfter: seconds at: aPointOrNil
        "UserDialogBoxMorph confirm: 'I like hot java' title: 'What do you say?' trueChoice: 'You bet!!' falseChoice: 'Nope' default: false triggerAfter: 12 at: 121@212"
        ^self new
                title: titleString;
                message: aString;
                createButton: trueChoice translated value: true;
                createButton: falseChoice translated value: false;
                createCancelButton: 'Cancel' translated translated value: nil;
                selectedButtonIndex: (default ifTrue: [1] ifFalse: [2]);
                registerKeyboardShortcuts;
                preferredPosition: (aPointOrNil ifNil: [Project current world center]);
                getUserResponseAfter: seconds! !


!UserText methodsFor: 'event handling' stamp: 'ct 9/12/2020 14:56'!
keyStroke: evt
        "Handle a keystroke event."

        | newSel |
        super keyStroke: evt.
        evt hand keyboardFocus == self ifFalse: [self releaseEditor. ^ self].
        newSel := self editor selectionInterval.        "restore editor state"
        self refreshParagraph.
        self editor selectFrom: newSel first to: newSel last.
       
        wrapFlag ifFalse:
                [self fullBounds right > owner right ifTrue:
                        [self wrapFlag: true.
                        self right: owner right.
                        self refreshParagraph.
                        self editor selectFrom: text string size + 1 to: text string size]].! !


!ViewerLine methodsFor: 'slot' stamp: 'ct 9/11/2020 20:20'!
addCommandFeedback
        "Add screen feedback showing what would be torn off in a drag"

        | aMorph |
        aMorph := RectangleMorph new bounds: ((submorphs fourth topLeft - (2@1)) corner: (submorphs last bottomRight) + (2@0)).
        aMorph useRoundedCorners; beTransparent; borderWidth: 2; borderColor: (Color r: 1.0 g: 0.548 b: 0.452); lock.
        aMorph setProperty: #highlight toValue: true.
        ^ Project current world addMorphFront: aMorph! !

!ViewerLine methodsFor: 'slot' stamp: 'ct 9/11/2020 20:20'!
addGetterFeedback
        "Add feedback during mouseover of a getter"

        | aMorph |
        aMorph := RectangleMorph new
                bounds: (self firstTileMorph topLeft corner:
                                                (self firstAlignmentMorph ifNil: [self submorphs last bottomRight] ifNotNil: [:m | m bottomLeft])).
        aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem getterFeedback; lock.
        ^ Project current world addHighlightMorph: aMorph for: nil.

"
Color fromUser (Color r: 1.0 g: 0.355 b: 0.839)
"! !

!ViewerLine methodsFor: 'slot' stamp: 'ct 9/11/2020 20:20'!
addSetterFeedback
        "Add screen feedback showing what would be torn off to make a setter"

        | aMorph |
        aMorph := RectangleMorph new bounds: (self firstTileMorph topLeft corner: self bounds bottomRight).
        aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem setterFeedback; lock.
        ^ Project current world addHighlightMorph: aMorph for: nil! !

!ViewerLine methodsFor: 'slot' stamp: 'ct 9/11/2020 20:20'!
removeHighlightFeedback
        "Remove any existing highlight feedback"

        ^ Project current world removeHighlightFeedback
! !

!ViewerLine methodsFor: '*Etoys-Squeakland-slot' stamp: 'ct 9/11/2020 20:20'!
addCommandFeedback: evt
        "Add screen feedback showing what would be torn off in a drag"

        | aMorph |
        aMorph := RectangleMorph new bounds: ((submorphs third topLeft - (2@1)) corner: (submorphs last bottomRight) + (2@1)).
        aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
        ^ Project current world addHighlightMorph: aMorph for: nil! !


!Vocabulary class methodsFor: '*Etoys-Squeakland-type vocabularies' stamp: 'ct 9/11/2020 20:19'!
typeChoicesForUserVariables
        "Answer a list of all user-choosable value types for variables."

        | aList |
        aList := #(Boolean Color CustomEvents Graphic  Number Patch Player Point ScriptName Sound String) copy.
        self currentWorld isKedamaPresent ifFalse: [
                ^ aList copyWithout: #Patch].
        ^ aList

"
Vocabulary typeChoicesForUserVariables
"! !


!WorldState methodsFor: 'hands' stamp: 'ct 9/12/2020 15:21'!
removeHand: aHandMorph
        "Remove the given hand from the list of hands for this world."

        (hands includes: aHandMorph) ifFalse: [^self].
        hands := hands copyWithout: aHandMorph.
        self activeHand == aHandMorph ifTrue: [self activeHand: nil].! !

!WorldState methodsFor: 'stepping' stamp: 'ct 9/12/2020 15:08'!
runLocalStepMethodsIn: aWorld
        "Run morph 'step' methods (LOCAL TO THIS WORLD) whose time has come. Purge any morphs that are no longer in this world.
        ar 3/13/1999: Remove buggy morphs from the step list so that they don't raise repeated errors."

        | now morphToStep stepTime |
        now := Time millisecondClockValue.
       
        self activateWorld: aWorld during: [
                self triggerAlarmsBefore: now.
               
                stepList ifEmpty: [^ self].
               
                (now < lastStepTime or: [now - lastStepTime > 5000]) ifTrue: [
                        self adjustWakeupTimes: now].   "clock slipped"
               
                [stepList notEmpty and: [stepList first scheduledTime < now]] whileTrue: [
                        lastStepMessage := stepList removeFirst.
                        morphToStep := lastStepMessage receiver.
                        (morphToStep shouldGetStepsFrom: aWorld) ifTrue: [
                                lastStepMessage value: now.
                                lastStepMessage ifNotNil: [
                                        stepTime := lastStepMessage stepTime ifNil: [morphToStep stepTime].
                                        lastStepMessage scheduledTime: now + (stepTime max: 1).
                                        stepList add: lastStepMessage]].
                        lastStepMessage := nil].
               
                lastStepTime := now].! !

!WorldState methodsFor: 'update cycle' stamp: 'ct 9/12/2020 15:20'!
doOneCycleNowFor: aWorld
        "Immediately do one cycle of the interaction loop.
        This should not be called directly, but only via doOneCycleFor:"

        | capturingGesture |
        DisplayScreen checkForNewScreenSize.
        capturingGesture := false.
        "self flag: #bob.       "       "need to consider remote hands in lower worlds"
       
        "process user input events"
        LastCycleTime := Time millisecondClockValue.
        self handsDo: [:hand |
                hand becomeActiveDuring: [
                        hand processEvents.
                        capturingGesture := capturingGesture or: [hand isCapturingGesturePoints]]].
       
        "the default is the primary hand"
        self activeHand: self hands first.
       
        "The gesture recognizer needs enough points to be accurate.
        Therefore morph stepping is disabled while capturing points for the recognizer"
        capturingGesture ifFalse: [
                aWorld runStepMethods.          "there are currently some variations here"
                self displayWorldSafely: aWorld].! !

!WorldState methodsFor: 'update cycle' stamp: 'ct 9/12/2020 15:21'!
doOneSubCycleFor: aWorld
        "Like #doOneCycle, but preserves activeHand."

        ^ self activateHand: self activeHand during: [
                self doOneCycleFor: aWorld]! !

!WorldState methodsFor: '*MorphicExtras-update cycle' stamp: 'ct 9/12/2020 15:18'!
doOneCycleInBackground
        "Do one cycle of the interactive loop. This method is called repeatedly when this world is not the active window but is running in the background."

        self halt.              "not ready for prime time"
       
        "process user input events, but only for remote hands"
        self handsDo: [:hand |
                (hand isKindOf: RemoteHandMorph) ifTrue: [
                        hand becomeActiveDuring: [
                                hand processEvents]]].
       
        self runStepMethods.
        self displayWorldSafely.! !


!ZASMCameraMarkMorph methodsFor: 'menu' stamp: 'ct 9/11/2020 18:02'!
setTransition
        "Set the transition"

        ^ self setTransition: self currentEvent! !

WorldState removeSelector: #activeHand!
WorldState removeSelector: #activeHand:!
Flaps class removeSelector: #addLocalFlapTitled:onEdge:!

!Browser reorganize!
('*46Deprecated')
('*60Deprecated-multi-window support' classHierarchy)
('*Etoys-Squeakland-class functions' buildClassBrowser)
('*Etoys-Squeakland-drag and drop' overwriteDialogHierarchyChange:higher:sourceClassName:destinationClassName:methodSelector:)
('*Etoys-Squeakland-initialize-release' browserWindowActivated)
('*Etoys-Squeakland-message functions' buildMessageBrowser)
('*SUnitTools-class list functions' testRunTests)
('*SUnitTools-menus' testsClassListMenu: testsSystemCategoryMenu:)
('*SUnitTools-system category functions' hasSystemCategoryWithTestsSelected testRunTestsCategory)
('*services-base' browseReference: classCategoryMenuServices: classListMenuServices: messageCategoryMenuServices: methodReference optionalButtonRow selectReference:)
('accessing' contents contents:notifying: contentsSelection couldBrowseAnyClass doItReceiver editSelection editSelection: environment newClassContents noteSelectionIndex:for: request:initialAnswer: selectEnvironment: spawn: suggestCategoryToSpawnedBrowser:)
('annotation' annotation annotation:)
('class comment pane' annotationForClassCommentFor: annotationForClassDefinitionFor: noCommentNagString stripNaggingAttributeFromComment:)
('class functions' addAllMethodsToCurrentChangeSet classCommentText classDefinitionText classListMenu: classListMenu:shifted: classListMenuMore: copyClass createInstVarAccessors defineClass:notifying: editClass editComment explainSpecial: fileOutClass findMethod hierarchy makeNewSubclass plusButtonHit printOutClass removeClass renameClass shiftedClassListMenu: shiftedClassListMenuMore:)
('class list' classIconAt: classList classListIndex classListIndex: classListIndexOf: classListSingleton createHierarchyTreeOf: defaultClassList flattenHierarchyTree:on:indent: flattenHierarchyTree:on:indent:by: flattenHierarchyTree:on:indent:by:format: hasClassSelected hierarchicalClassList recent selectClass: selectClassNamed: selectedClass selectedClassName)
('code pane' aboutToStyle: compileMessage:notifying: showBytecodes)
('controls' decorateButtons)
('copying' veryDeepInner:)
('drag and drop' dragFromClassList: dragFromMessageList: dropOnMessageCategories:at: dropOnSystemCategories:at: wantsMessageCategoriesDrop: wantsSystemCategoriesDrop:)
('initialize-release' classListFrame: classListFrame:fromLeft:width: classListFrame:fromTop:fromLeft:width: defaultBrowserTitle frameOffsetFromTop:fromLeft:width:bottomFraction: labelString methodCategoryChanged setClass: setClass:selector: setSelector: switchesFrame: switchesFrame:fromLeft:width: systemCatSingletonKey:from: systemOrganizer: topConstantHeightFrame:fromLeft:width:)
('message category functions' addCategory alphabetizeMessageCategories buildMessageCategoryBrowser buildMessageCategoryBrowserEditString: canShowMultipleMessageCategories categoryOfCurrentMethod changeMessageCategories: editMessageCategories fileOutMessageCategories highlightMessageList:with: mainMessageCategoryMenu: messageCategoryMenu: printOutMessageCategories removeEmptyCategories removeMessageCategory renameCategory showHomeCategory)
('message category list' categorizeAllUncategorizedMethods hasMessageCategorySelected messageCatListSingleton messageCategoryList messageCategoryListIndex messageCategoryListIndex: messageCategoryListKey:from: messageCategoryListSelection rawMessageCategoryList recategorizeMethodSelector: selectMessageCategoryNamed: selectedMessageCategoryName setOriginalCategoryIndexForCurrentMethod toggleCategorySelectionForCurrentMethod)
('message functions' browseAllCommentsForClass defineMessageFrom:notifying: inspectInstances inspectSubInstances mainMessageListMenu: removeMessage removeMessageFromBrowser)
('message list' addExtraShiftedItemsTo: hasMessageSelected lastMessageName messageHelpAt: messageIconAt: messageIconFor: messageIconHelpFor: messageList messageListIndex messageListIndex: messageListIndexOf: messageListMenu:shifted: reformulateList selectMessageNamed: selectedMessage selectedMessageName selectedMessageName: shiftedMessageListMenu:)
('metaclass' classCommentIndicated classDefinitionIndicated classMessagesIndicated classOrMetaClassOrganizer indicateClassMessages indicateInstanceMessages instanceMessagesIndicated metaClassIndicated metaClassIndicated: selectedClassOrMetaClass selectedClassOrMetaClassName setClassDefinition setClassOrganizer)
('multi-window support' arrowKey:from: browseClassHierarchy isHierarchy isPackage multiWindowName multiWindowNameForState: okToClose restoreMultiWindowState: restoreToCategory:className:protocol:selector:mode:meta: saveMultiWindowState)
('pluggable menus - hooks' classListMenuHook:shifted: messageCategoryMenuHook:shifted: messageListMenuHook:shifted: systemCategoryMenuHook:shifted:)
('self-updating' didCodeChangeElsewhere)
('system category functions' addSystemCategory alphabetizeSystemCategories browseAllClasses buildSystemCategoryBrowser buildSystemCategoryBrowserEditString: changeSystemCategories: classNotFound editSystemCategories fileOutSystemCategory findClass mainSystemCategoryMenu: printOutSystemCategory removeSystemCategory renameSystemCategory systemCatSingletonMenu: systemCategoryMenu: updateSystemCategories)
('system category list' hasSystemCategorySelected indexIsOne indexIsOne: selectCategoryForClass: selectSystemCategory: selectedEnvironment selectedSystemCategory selectedSystemCategoryName systemCatListKey:from: systemCategoryList systemCategoryListIndex systemCategoryListIndex: systemCategorySingleton)
('toolbuilder' buildAndOpenCategoryBrowser buildAndOpenCategoryBrowserLabel: buildAndOpenClassBrowserLabel: buildAndOpenFullBrowser buildAndOpenMessageCategoryBrowserLabel: buildCategoryBrowserWith: buildClassListSingletonWith: buildClassListWith: buildDefaultBrowserWith: buildMessageCategoryListWith: buildMessageListCatSingletonWith: buildMessageListWith: buildSwitchesWith: buildSystemCatListSingletonWith: buildSystemCategoryListWith: buildWith: setMultiWindowFor:)
('traits' addSpecialMenu: addTrait defineTrait:notifying: newClass newTrait)
('user interface' addModelItemsToWindowMenu: defaultWindowColor)
('private' spawnOrNavigateTo:)
!

Object removeSelector: #setActiveWorld:during:!
Smalltalk removeClassNamed: #FileContentsBrowserTestTestObject!
>

On Sat, Sep 12, 2020 at 06:38:38PM +0000, Thiede, Christoph wrote:
> Glad you like it, David! :-)
>
> <http://www.hpi.de/>
>
> > In the case of the global World variable, we were able to make it an instance variable in Project.
>
> I heard of this, but where can you see the difference? If I evaluate "World" in my fresh trunk image, I get a PasteUpMorph instance ... #World is still listed in my Smalltalk bindings.


I just put System-dtl.1170 in the inbox to make it go away. For a long
time, the World variable was shared all over the place, even in MVC if
you can believe that. From a modularity perspective it was a real mess.
Basically, the solution was to make it an instance variable in Project.
The current project always has a world, and when transitioning from one
project to another, you can do the handoff between those two worlds
without referencing a global.

All that got done about two years ago, but I intentionally left the #World
binding in place on the theory that there might be external packages (or
Etoys projects) that expect to have access to global World.

The way it works now (see MorphicProject>>setWorld:) is that the global
World will be updated as before, but this happens if and only if the
global binding exists. If you remove the binding, the World no longer
exists. If you load a package or project that does have references to
World, then restoring the #World binding in the current environment should
make it work again.

I don't really know if it's a good idea to remove the #World binding now
(that's why it's in the inbox). But leaving it in the image is confusing
because it gives the wrong impression that it is still being used.

Dave

> On 2020-09-12, at 4:50 PM, David T. Lewis <[hidden email]> wrote:
>
> Last but not least, by the time all this is done we probably understand
> WorldState well enough to go back and add those long overdue comments.

Sheesh, you and your being all reasonable and sensible...

tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
Strange OpCodes: CPP: Crush Plotter Pen

> On 14.09.2020, at 13:28, Thiede, Christoph <[hidden email]> wrote:
>
> Hi David,
>
> I cannot load CarAndPen.014.pr in a fresh trunk image, it gives me an error from the SmartRefStream:
>
> Key not found: a PasteUpMorph(1723393) [world]
>
> So I could not test how it behaves without the #World binding.

Yea, that's the problem. It's trying to look up the world and does not find it, right? :D

Best regards
        -Tobias

>
> Best,
> Christoph
>
> Von: Squeak-dev <[hidden email]> im Auftrag von David T. Lewis <[hidden email]>
> Gesendet: Sonntag, 13. September 2020 22:34:22
> An: The general-purpose Squeak developers list
> Betreff: [squeak-dev] Etoys help needed loading e.g. CarAndPen.014.pr (was: Changeset: Eliminating global state from Morphic)
> 
> Is anyone is a position to try loading old Etoys projects such as CarAndPen.014.pr
> into an up to date trunk image? I have not tried this in a while, and I get errors
> on loading the project. I don't know how to easily fix that so I am asking for
> help from anyone who may be more up to date on the topic.
>
> The reason I am asking is that I would like to know if removing the global
> variable #World from trunk would cause any new or unusual problems with respect
> to Etoys project loading.
>
> To be specific, if you have a trunk image and are able to load any Etoys
> project, then I would like to know what sort of errors you encounter if
> you first do this before loading that same Etoys project:
>
>    Smalltalk globals unbind: #World
>
> I would expect that this will lead to some kind of error condition, and
> what I would like to know is whether that failure or error message gives
> a good clue as to the problem, such that you might be able to figure out
> that you would need to fix it by doing this:
>
>    Smalltalk at: #World put: Project current world
>
>
> Thanks!
> Dave
>
>
>
> On Sat, Sep 12, 2020 at 07:32:17PM +0000, Thiede, Christoph wrote:
> > Hi David,
> >
> >
> > I think I understand the dilemma: If we keep #World in the bindings, it will keep being used (I have to admit that, for personal scripts, I'm doing so, too). If we remove it, we don't provide backward compatibility for older projects. This would be really a pity because even if you write in your inbox version: "If a package is loaded that does need World, then 'Smalltalk at: #World put: Project current world' will restore prior behavior.", how many people will know that when they attempt to refloat an ancient piece of Squeak code?
> >
> > As far as we only have these two options, I'm tending to vote for the first one. Unless we use it in the Trunk, it does no harm, and actual bugs should occur rather seldom because some third-party package is still using #World. If there should be a bug somewhere, it can be easily fixed.
> >
> >
> > But hypothetically, there would be a third option, which would be my favorite: Handle accesses to #World like calls on a deprecated method, i.e. by signaling a DeprecationWarning. That way we could even make sure that novices do not learn to use a deprecated variable.
> >
> > This could be realized by wrapping the value of #World into an ObjectTracer or a similar class that raises a DeprecationWarning on every call that is made to it.
> >
> > But I fear this could be a piece of overengineering, what do you think? Also, this would not protect the global variable from being reassigned ...
> >
> > The very last solution could be to make a (global) list of deprecated bindings and raise a Warning from the Compiler when an attempt is made to access one of them. Unfortunately, this would also be the most invasive change.
> >
> >
> > @Levente: It seemed kind of overengineering to me to create three subclasses of ProcessLocalVariable for this purpose. Or am I misunderstand their concept? Maybe we could also need something like a PluggableProcessLocalVariable that can be instantiated with two accessor blocks?
> >
> >
> > Best,
> >
> > Christoph
> >
> > ________________________________
> > Von: Squeak-dev <[hidden email]> im Auftrag von David T. Lewis <[hidden email]>
> > Gesendet: Samstag, 12. September 2020 21:10:59
> > An: The general-purpose Squeak developers list
> > Betreff: Re: [squeak-dev] Changeset: Eliminating global state from Morphic
> >
> > On Sat, Sep 12, 2020 at 06:38:38PM +0000, Thiede, Christoph wrote:
> > > Glad you like it, David! :-)
> > >
> > > <http://www.hpi.de/>
> > >
> > > > In the case of the global World variable, we were able to make it an instance variable in Project.
> > >
> > > I heard of this, but where can you see the difference? If I evaluate "World" in my fresh trunk image, I get a PasteUpMorph instance ... #World is still listed in my Smalltalk bindings.
> >
> >
> > I just put System-dtl.1170 in the inbox to make it go away. For a long
> > time, the World variable was shared all over the place, even in MVC if
> > you can believe that. From a modularity perspective it was a real mess.
> > Basically, the solution was to make it an instance variable in Project.
> > The current project always has a world, and when transitioning from one
> > project to another, you can do the handoff between those two worlds
> > without referencing a global.
> >
> > All that got done about two years ago, but I intentionally left the #World
> > binding in place on the theory that there might be external packages (or
> > Etoys projects) that expect to have access to global World.
> >
> > The way it works now (see MorphicProject>>setWorld:) is that the global
> > World will be updated as before, but this happens if and only if the
> > global binding exists. If you remove the binding, the World no longer
> > exists. If you load a package or project that does have references to
> > World, then restoring the #World binding in the current environment should
> > make it work again.
> >
> > I don't really know if it's a good idea to remove the #World binding now
> > (that's why it's in the inbox). But leaving it in the image is confusing
> > because it gives the wrong impression that it is still being used.
> >
> > Dave
> >
> >
>
> >