[squeak-dev] The Trunk: Morphic-mt.1698.mczcommits at source.squeak.org commits at source.squeak.orgSun Oct 11 11:35:53 UTC 2020
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 at 0. "vary this to check different states" left := 10. formA := (Form extent: 100 at 50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths". formB := Form extent: 100 at 50 depth: 32. "make a red square in the middle of the form" (FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: sensitiveColor. (FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent. (FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color yellow. "formA displayOn: Display at: left at top rule: Form paint. dCanvas frameRectangle: (left at 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 at 0 extent: 50 at 100) fillStyle: soughtColor. (FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach. "formB displayOn: Display at: left at top rule: Form paint. dCanvas frameRectangle: (left at 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 at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 0 colorMap: map. formB displayOn: Display at: left at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 0 clippingBox: formB boundingBox rule: Form and fillColor: nil map: map. formB displayOn: Display at: left at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 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 at 0. "vary this to check different states" left := 10. formA := Form extent: 100 at 50 depth: 32. formB := Form extent: 100 at 50 depth: 16. "make a red square in the middle of the form" (FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: Color yellow. (FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent. (FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color red. "formA displayOn: Display at: left at top rule: Form paint. dCanvas frameRectangle: (left at 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 at 0 extent: 50 at 100) fillStyle: Color blue. (FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach. "formB displayOn: Display at: left at top rule: Form paint. dCanvas frameRectangle: (left at 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 at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. maskB displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 0 colorMap: map. "maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. left := left + 150." maskB copyBits: maskB boundingBox from: maskB at: 0 at 0 colorMap: map. "maskB displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. left := left + 150." maskB displayOn: maskA at: 0 at 0 rule: Form and. maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 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 at 0. "vary this to check different states" left := 10. formA := (Form extent: 100 at 50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths". formB := Form extent: 100 at 50 depth: 32. "make a red square in the middle of the form" (FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: Color red. (FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent. (FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color yellow. "formA displayOn: Display at: left at top rule: Form paint. dCanvas frameRectangle: (left at 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 at 0 extent: 50 at 100) fillStyle: soughtColor. (FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach. "formB displayOn: Display at: left at top rule: Form paint. dCanvas frameRectangle: (left at 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 at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 0 colorMap: map. formB displayOn: Display at: left at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 0 clippingBox: formB boundingBox rule: Form and fillColor: nil map: map. formB displayOn: Display at: left at top rule: Form paint. formA displayOn: Display at: (left at top) + offset rule: Form paint. maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. dCanvas frameRectangle: (intersection translateBy: left at 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 at 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 at 0 extent: 250 at 120)].! - aBool ifFalse: [ ActiveWorld invalidRect: (0 at 0 extent: 250 at 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 at 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 at 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 at 5) + in: self currentWorld + allowKeyboard: Preferences menuKeyboardControl].! - actionSelector ifNotNil: - [(model perform: actionSelector) ifNotNil: - [:menu| - menu - invokeModalAt: self position - (0 at 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 at 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 at 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 at 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 at 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!
More information about the Squeak-dev mailing list |