Smalltalk › Squeak › Squeak - Dev

The Trunk: Morphic-mt.1698.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

The Trunk: Morphic-mt.1698.mcz

Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1698.mcz

==================== Summary ====================

Name: Morphic-mt.1698
Author: mt
Time: 11 October 2020, 1:35:46.971652 pm
UUID: 8a6f5c18-06a4-6748-a873-31147aae9578
Ancestors: Morphic-mt.1697

Refactoring 'Active' variables -- Step 2 of 2. Removes all uses of Active(World|Hand|Event) by replacing those with "self current(World|Hand|Event)" or "Project current world" when required to not add/cement Morphic dependency.

See http://forum.world.st/Changeset-Eliminating-global-state-from-Morphic-td5121690.html

=============== Diff against Morphic-mt.1697 ===============

Item was changed:
----- Method: CollapsedMorph>>uncollapseToHand (in category 'collapse/expand') -----
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.!
- ActiveHand attachMorph: nakedMorph!

Item was changed:
----- Method: DialogWindow>>initialize (in category 'initialization') -----
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.!
- preferredPosition := ActiveWorld center.!

Item was changed:
----- Method: DockingBarMorph>>delete (in category 'submorphs-add/remove') -----
delete

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

Item was changed:
----- Method: FillInTheBlankMorph class>>request: (in category 'instance creation') -----
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!
- centerAt: (ActiveHand ifNil:[Sensor]) cursorPoint!

Item was changed:
----- Method: FillInTheBlankMorph class>>request:initialAnswer: (in category 'instance creation') -----
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!
- centerAt: ActiveHand cursorPoint!

Item was changed:
----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt: (in category 'instance creation') -----
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!
- inWorld: ActiveWorld
- !

Item was changed:
----- Method: Form class>>exampleColorSees (in category '*Morphic-examples') -----
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 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.
+
- ActiveWorld 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]!
- top:= top + 60]
-
- !

Item was changed:
----- Method: Form class>>exampleTouchTest (in category '*Morphic-examples') -----
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.
- ActiveWorld 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]!
- top:= top + 60]
-
-
- !

Item was changed:
----- Method: Form class>>exampleTouchingColor (in category '*Morphic-examples') -----
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.
- ActiveWorld 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]!
- top:= top + 60]
- !

Item was changed:
----- Method: HaloMorph>>doDirection:with: (in category 'private') -----
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]!
- [ActiveHand spawnBalloonFor: directionHandle]!

Item was changed:
----- Method: HaloMorph>>maybeDismiss:with: (in category 'private') -----
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.
- ifFalse:
- [self delete.
target addHalo: evt]
+ ifTrue: [
+ target resistsRemoval ifTrue:
- ifTrue:
- [target resistsRemoval ifTrue:
[(UIManager default chooseFrom: {
'Yes' translated.
'Um, no, let me reconsider' translated.
+ } title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]].
- } title: 'Really throw this away' translated) = 1 ifFalse: [^ self]].
evt hand removeHalo.
self delete.
target dismissViaHalo.
+ self currentWorld presenter flushPlayerListCache].!
- ActiveWorld presenter flushPlayerListCache]!

Item was changed:
----- Method: HaloMorph>>prepareToTrackCenterOfRotation:with: (in category 'private') -----
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]!
- [ActiveHand spawnBalloonFor: rotationHandle]!

Item was changed:
----- Method: HandMorph class>>showEvents: (in category 'utilities') -----
showEvents: aBool
"HandMorph showEvents: true"
"HandMorph showEvents: false"
+
ShowEvents := aBool.
+ aBool ifFalse: [
+ Project current world invalidRect: (0@0 extent: 250@120)].!
- aBool ifFalse: [ ActiveWorld invalidRect: (0@0 extent: 250@120) ].!

Item was changed:
----- Method: HandMorph>>cursorPoint (in category 'event handling') -----
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."

+ ^ self currentWorld point: self position from: owner!
- | pos |
- pos := self position.
- (ActiveWorld isNil or: [ActiveWorld == owner]) ifTrue: [^pos].
- ^ActiveWorld point: pos from: owner!

Item was changed:
----- Method: MVCMenuMorph>>displayAt:during: (in category 'invoking') -----
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.
- [ActiveWorld addMorph: self centeredNear: aPoint.
self world displayWorld. "show myself"
aBlock value]
ensure: [self delete]!

Item was changed:
----- Method: MVCMenuMorph>>informUserAt:during: (in category 'invoking') -----
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 := self allMorphs detect: [ :ea | ea hasProperty: #titleString ].
title := title submorphs first.
self visible: false.
+ w := self currentWorld.
+ aBlock value: [:string|
+ self visible ifFalse: [
- w := ActiveWorld.
- 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.!
- w displayWorld!

Item was changed:
----- Method: MenuMorph class>>chooseFrom:lines:title: (in category 'utilities') -----
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].
- aBlock := [:v| result := v].
menu := self new.
menu addTitle: queryString.
+ 1 to: aList size do: [:i|
- 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!
- menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
- ^result!

Item was changed:
----- Method: MenuMorph class>>confirm:trueChoice:falseChoice: (in category 'utilities') -----
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].
- 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.
- [menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.
result == nil] whileTrue.
+ ^ result!
- ^result!

Item was changed:
----- Method: MenuMorph class>>inform: (in category 'utilities') -----
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.
- menu add: 'OK' target: self selector: #yourself.
MenuIcons decorateMenu: menu.
+ menu
+ invokeAt: self currentHand position
+ in: self currentWorld
+ allowKeyboard: true.!
- menu invokeAt: ActiveHand position in: ActiveWorld allowKeyboard: true.!

Item was changed:
----- Method: MenuMorph>>informUserAt:during: (in category 'modal control') -----
informUserAt: aPoint during: aBlock
"Add this menu to the Morphic world during the execution of the given block."
+
+ | title world |
- | title w |
title := self allMorphs detect: [ :ea | ea hasProperty: #titleString ].
title := title submorphs first.
self visible: false.
+ world := self currentWorld.
+ aBlock value: [:string|
- w := ActiveWorld.
- aBlock value:[:string|
self visible ifFalse:[
+ world addMorph: self centeredNear: aPoint.
- w addMorph: self centeredNear: aPoint.
self visible: true].
title contents: string.
+ self setConstrainedPosition: self currentHand cursorPoint hangOut: false.
- self setConstrainedPosition: Sensor cursorPoint hangOut: false.
self changed.
+ world displayWorld "show myself"].
- w displayWorld "show myself"
- ].
self delete.
+ world displayWorld.!
- w displayWorld!

Item was changed:
----- Method: MenuMorph>>invokeModal: (in category 'modal control') -----
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!
- ^ self invokeModalAt: ActiveHand position in: ActiveWorld allowKeyboard: allowKeyboardControl!

Item was changed:
----- Method: MenuMorph>>popUpEvent:in: (in category 'control') -----
popUpEvent: evt in: aWorld
"Present this menu in response to the given event."

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

Item was changed:
----- Method: MenuMorph>>popUpNoKeyboard (in category 'control') -----
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!
- ^ self popUpAt: ActiveHand position forHand: ActiveHand in: ActiveWorld allowKeyboard: false!

Item was changed:
----- Method: MenuMorph>>positionAt:relativeTo:inWorld: (in category 'private') -----
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].!
- (aWorld worldBounds withHeight: ((aWorld worldBounds height - 18) max: (ActiveHand position y) + 1)).
- delta = (0 @ 0) ifFalse: [self position: self position + delta]!

Item was changed:
----- Method: Morph class>>fromFileName: (in category 'fileIn/Out') -----
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]
- ifTrue: [ActiveWorld addMorphsAndModel: morphOrList]
ifFalse:
[morphOrList isMorph ifFalse: [self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
morphOrList openInWorld]!

Item was changed:
----- Method: Morph>>addMiscExtrasTo: (in category 'menus') -----
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.
+
-
- self addGestureMenuItems: subMenu hand: ActiveHand.
-
aMenu add: 'extras...' translated subMenu: subMenu!

Item was changed:
----- Method: Morph>>buildYellowButtonMenu: (in category 'menu') -----
buildYellowButtonMenu: aHand
+ "Build the morph menu for the yellow button."
+
- "build the morph menu for the yellow button"
| menu |
menu := MenuMorph new defaultTarget: self.
+ self addNestedYellowButtonItemsTo: menu event: self currentEvent.
- self addNestedYellowButtonItemsTo: menu event: ActiveEvent.
MenuIcons decorateMenu: menu.
^ menu!

Item was changed:
----- Method: Morph>>chooseNewGraphicCoexisting: (in category 'menus') -----
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:
- [aGraphicalMenu := ActiveWorld 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]!

Item was changed:
----- Method: Morph>>deleteUnlessHasFocus (in category 'submorphs-add/remove') -----
deleteUnlessHasFocus
"Runs on a step timer because we cannot be guaranteed to get focus change events."
+ (self currentHand keyboardFocus ~= self and: [ self isInWorld ]) ifTrue:
- (ActiveHand keyboardFocus ~= self and: [ self isInWorld ]) ifTrue:
[ self
stopSteppingSelector: #deleteUnlessHasFocus ;
delete ]!

Item was changed:
----- Method: Morph>>dismissViaHalo (in category 'submorphs-add/remove') -----
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.!
- cmd undoTarget: ActiveWorld selector: #reintroduceIntoWorld: argument: self.
- cmd redoTarget: ActiveWorld selector: #onceAgainDismiss: argument: self.
- ActiveWorld rememberCommand: cmd!

Item was changed:
----- Method: Morph>>duplicate (in category 'copying') -----
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].
- aPlayer ifNotNil: [ActiveWorld presenter flushPlayerListCache].
^ newMorph!

Item was changed:
----- Method: Morph>>indicateAllSiblings (in category 'meta-actions') -----
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]
- select: [:m | m costume world == ActiveWorld]
thenCollect: [:m | m costume boundsInWorld].

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

Item was changed:
----- Method: Morph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
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:
- [aMorph == ActiveWorld ifTrue:
[self goHome].
+ self removeProperty: #beFullyVisibleAfterDrop].!
- self removeProperty: #beFullyVisibleAfterDrop].
- !

Item was changed:
----- Method: Morph>>referencePlayfield (in category 'e-toy support') -----
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!
- ^ ActiveWorld!

Item was changed:
----- Method: Morph>>resizeFromMenu (in category 'meta-actions') -----
resizeFromMenu
"Commence an interaction that will resize the receiver"

+ ^ self resizeMorph: self currentEvent!
- self resizeMorph: ActiveEvent!

Item was changed:
----- Method: Morph>>slideToTrash: (in category 'dropping/grabbing') -----
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
- trash := ActiveWorld
findDeepSubmorphThat:
[:aMorph | (aMorph isKindOf: TrashCanMorph) and:
+ [aMorph topRendererOrSelf owner == self currentWorld]]
- [aMorph topRendererOrSelf owner == ActiveWorld]]
ifAbsent:
[trash := TrashCanMorph new.
+ trash position: self currentWorld bottomLeft - (0 @ (trash extent y + 26)).
- trash position: ActiveWorld 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.
- ActiveWorld displayWorld.
TrashCanMorph slideDismissalsToTrash ifTrue:
[aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15].
ScrapBook default addToTrash: self!

Item was changed:
----- Method: Morph>>yellowButtonActivity: (in category 'event handling') -----
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 := self buildYellowButtonMenu: ActiveHand.
menu
addTitle: self externalName
icon: (self iconOrThumbnailOfSize: (Preferences tinyDisplay ifTrue: [16] ifFalse: [28])).
menu popUpInWorld: self currentWorld!

Item was changed:
----- Method: MorphHierarchy class>>openOrDelete (in category 'opening') -----
openOrDelete
| oldMorph |
oldMorph := Project current world submorphs
detect: [:each | each hasProperty: #morphHierarchy]
ifNone: [| newMorph |
newMorph := self new asMorph.
+ newMorph bottomLeft: self currentHand position.
- newMorph bottomLeft: ActiveHand position.
newMorph openInWorld.
newMorph isFullOnScreen
ifFalse: [newMorph goHome].
^ self].
""
oldMorph delete!

Item was changed:
----- Method: MorphicProject>>clearGlobalState (in category 'enter') -----
clearGlobalState
+ "Clean up global state. This method may be removed if the use of global state variables is eliminated."
- "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].!
- "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 ].
- ActiveWorld := ActiveHand := ActiveEvent := nil.
- !

Item was changed:
----- Method: MorphicProject>>createViewIfAppropriate (in category 'utilities') -----
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
- existing := ActiveWorld 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 + requiredWidth > ActiveWorld right ifTrue:
[proposedH := 10.
proposedV := proposedV + 90.
+ proposedV > (self currentWorld bottom - 90)
- proposedV > (ActiveWorld bottom - 90)
ifTrue:
+ [proposedH := self currentWorld center x - 45.
+ proposedV := self currentWorld center y - 30.
- [proposedH := ActiveWorld center x - 45.
- proposedV := ActiveWorld center y - 30.
despair := true]]].
aMorph position: (proposedH @ proposedV).
aMorph openInWorld]]!

Item was changed:
----- Method: MorphicProject>>currentVocabulary (in category 'protocols') -----
currentVocabulary

+ ^ self world currentVocabulary!
- ^ActiveWorld currentVocabulary!

Item was changed:
----- Method: MorphicProject>>setFlaps (in category 'flaps support') -----
setFlaps

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

+ flapTabs := self world flapTabs.
- flapTabs := ActiveWorld 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
- ActiveWorld flapTabs
do: [:flapTab | flapTab isCurrentlyTextual
ifTrue: [flapTab changeTabText: flapTab knownName]].
Flaps positionNavigatorAndOtherFlapsAccordingToPreference.
+ navigationMorph := self currentWorld findDeeplyA: ProjectNavigationMorph preferredNavigator.
- navigationMorph := ActiveWorld 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]]]]!

Item was changed:
----- Method: MorphicProject>>updateLocaleDependents (in category 'language') -----
updateLocaleDependents
"Set the project's natural language as indicated"

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

+ (self isFlapIDEnabled: 'Navigator' translated)
- (Project current isFlapIDEnabled: 'Navigator' translated)
ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated].
+
-
ScrapBook default emptyScrapBook.
MenuIcons initializeTranslations.

super updateLocaleDependents.
+
-
"self setFlaps.
+ self setPaletteFor: aLanguageSymbol."!
- self setPaletteFor: aLanguageSymbol."
- !

Item was changed:
----- Method: MorphicProject>>wakeUpTopWindow (in category 'enter') -----
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 ]!
- ActiveHand releaseKeyboardFocus ]!

Item was changed:
----- Method: MultiWindowLabelButtonMorph>>performAction (in category 'accessing') -----
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].!
- actionSelector ifNotNil:
- [(model perform: actionSelector) ifNotNil:
- [:menu|
- menu
- invokeModalAt: self position - (0@5)
- in: ActiveWorld
- allowKeyboard: Preferences menuKeyboardControl]]!

Item was changed:
----- Method: PasteUpMorph>>correspondingFlapTab (in category 'flaps') -----
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:
- ActiveWorld allMorphs do:
[:aTab | ((aTab isKindOf: FlapTab) and: [aTab referent == self]) ifTrue: [^ aTab]].

^ nil!

Item was changed:
----- Method: PasteUpMorph>>extractScreenRegion:andPutSketchInHand: (in category 'world menu') -----
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.
- ActiveHand showTemporaryCursor: nil.
innerForm isAllWhite ifFalse:
[hand attachMorph: (self drawingClass withForm: innerForm)]!

Item was changed:
----- Method: PasteUpMorph>>flapTab (in category 'accessing') -----
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]!
- self isFlap ifFalse:[^nil].
- ww := self presenter associatedMorph ifNil: [ActiveWorld].
- ^ ww ifNotNil: [ww flapTabs detect:[:any| any referent == self] ifNone: [nil]]!

Item was changed:
----- Method: PasteUpMorph>>initializeDesktopCommandKeySelectors (in category 'world menu') -----
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 defaultDesktopCommandKeyTriplets do:
- [:trip | | messageSend |
- messageSend := MessageSend receiver: trip second selector: trip third.
- dict at: trip first put: messageSend].
self setProperty: #commandKeySelectors toValue: dict.
+ ^ dict!
- ^ dict
-
- !

Item was changed:
----- Method: PasteUpMorph>>putUpPenTrailsSubmenu (in category 'menu & halo') -----
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!
- aMenu popUpInWorld: ActiveWorld!

Item was changed:
----- Method: PasteUpMorph>>putUpWorldMenuFromEscapeKey (in category 'world menu') -----
putUpWorldMenuFromEscapeKey
Preferences noviceMode
+ ifFalse: [self putUpWorldMenu: self currentEvent]!
- ifFalse: [self putUpWorldMenu: ActiveEvent]!

Item was changed:
----- Method: PasteUpMorph>>repositionFlapsAfterScreenSizeChange (in category 'world state') -----
repositionFlapsAfterScreenSizeChange
"Reposition flaps after screen size change"

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

Item was changed:
----- Method: PluggableListMorph>>specialKeyPressed: (in category 'model access - keystroke') -----
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
- ^ ActiveEvent shiftPressed
ifTrue:
+ [self currentWorld putUpWorldMenuFromEscapeKey]
- [ActiveWorld 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)!

Item was changed:
----- Method: PopUpMenu>>morphicStartUpWithCaption:icon:at:allowKeyboard: (in category '*Morphic-Menus') -----
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
- in: ActiveWorld
allowKeyboard: aBoolean].
^ selection!

Item was changed:
----- Method: SelectionMorph>>duplicate (in category 'halo commands') -----
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].
- selectedItems reverseDo: [:m | (owner ifNil: [ActiveWorld]) addMorph: m].
dupLoc := self position.
+ self currentHand grabMorph: self.
+ self currentWorld presenter flushPlayerListCache.!
- ActiveHand grabMorph: self.
- ActiveWorld presenter flushPlayerListCache!

Item was changed:
----- Method: SimpleHierarchicalListMorph>>specialKeyPressed: (in category 'event handling') -----
specialKeyPressed: asciiValue

(self arrowKey: asciiValue)
ifTrue: [^ true].

asciiValue = 27 "escape"
ifTrue: [
+ self currentEvent shiftPressed
+ ifTrue: [self currentWorld putUpWorldMenuFromEscapeKey]
- ActiveEvent shiftPressed
- ifTrue: [ActiveWorld putUpWorldMenuFromEscapeKey]
ifFalse: [self yellowButtonActivity: false].
^ true].

^ false!

Item was changed:
----- Method: SketchMorph>>collapse (in category 'menus') -----
collapse
"Replace the receiver with a collapsed rendition of itself."

+ | w collapsedVersion a ht |
+
+ (w := self world) ifNil: [^ self].
- | w collapsedVersion a ht tab |
-
- (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].
- ht := (tab := Smalltalk at: #SugarNavTab ifPresent: [:c | ActiveWorld findA: c])
- ifNotNil:
- [tab height]
- ifNil:
- [80].
a position: 0@ht.

collapsedVersion setProperty: #collapsedMorphCarrier toValue: a.

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

Item was changed:
----- Method: SystemWindow>>doFastFrameDrag: (in category 'events') -----
doFastFrameDrag: grabPoint
"Do fast frame dragging from the given point"

| offset newBounds outerWorldBounds clearArea |
outerWorldBounds := self boundsIn: nil.
offset := outerWorldBounds origin - grabPoint.
+ clearArea := self currentWorld clearArea.
- clearArea := ActiveWorld 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!

Item was changed:
----- Method: TextEditor>>offerMenuFromEsc: (in category 'menu commands') -----
offerMenuFromEsc: aKeyboardEvent
+ "The escape key was hit while the receiver has the keyboard focus; take action."
- "The escape key was hit while the receiver has the keyboard focus; take action"

+ aKeyboardEvent shiftPressed ifFalse: [
+ self raiseContextMenu: aKeyboardEvent].
+ ^ true!
- ActiveEvent shiftPressed ifFalse: [
- self raiseContextMenu: aKeyboardEvent ].
- ^true!

Item was changed:
----- Method: ThreePhaseButtonMorph>>doButtonAction (in category 'button') -----
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]].!
- (target notNil and: [actionSelector notNil])
- ifTrue:
- [args := actionSelector numArgs > arguments size
- ifTrue:
- [arguments copyWith: ActiveEvent]
- ifFalse:
- [arguments].
- Cursor normal
- showWhile: [target perform: actionSelector withArguments: args].
- target isMorph ifTrue: [target changed]]!

Item was changed:
----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:at: (in category 'utilities') -----
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]);
- preferredPosition: (aPointOrNil ifNil: [ActiveWorld center]);
getUserResponse!

Item was changed:
----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:default:triggerAfter:at: (in category 'utilities') -----
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]);
- preferredPosition: (aPointOrNil ifNil: [ActiveWorld center]);
getUserResponseAfter: seconds!