Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1726.mcz
==================== Summary ====================
Name: Morphic-mt.1726 Author: mt Time: 26 February 2021, 3:43:41.835955 pm UUID: cea183c6-2e39-c846-8c17-7b49f0fa0958 Ancestors: Morphic-mt.1725
Extracts, cleans up, and fixes Morphic layers from Worlds-in-Worlds to be available in any morph structure.
- Protocol "submorphs" in Morph re-organized to highlight the basic add/remove protocol and "layers" - Existing layers can be found under "layer names" in Morph class. See MorphTest >> #test11NamedLayers to understand the current layer design. We should refine this if we stumble upon better concerns. - See the "tests - submorphs - layers" protocol in MorphTest for more examples. - A new effect is that you can change #morphicLayerNumber(:) while the morph is already in a structure (i.e. has an owner), which will then update submorph order in the owner automatically. - Another new effect is that the docking bar's sub menus are *behind* the docking bar, which makes them look more integrated into the bar.
=============== Diff against Morphic-mt.1725 ===============
Item was changed: ----- Method: BalloonMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. self disableLayout: true. + self morphicLayerNumber: self class balloonLayer. "" self beSmoothCurve.
offsetFromTarget := 0 @ 0. self setDefaultParameters.!
Item was removed: - ----- Method: BalloonMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - - "helpful for insuring some morphs always appear in front of or behind others. - smaller numbers are in front" - - ^5 "Balloons are very front-like things"!
Item was changed: ----- Method: BalloonMorph>>prepareToOpen (in category 'private') ----- prepareToOpen "Override the color if not already set." self userInterfaceTheme color ifNotNil: [ : col | self color: col]. self lock ; + fullBounds! - fullBounds ; - setProperty: #morphicLayerNumber - toValue: self morphicLayerNumber!
Item was changed: + ----- Method: ColorPickerMorph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: ColorPickerMorph>>delete (in category 'submorphs-add/remove') ----- delete "The moment of departure has come. If the receiver has an affiliated command, finalize it and have the system remember it. In any case, delete the receiver"
(selector isNil or: [ target isNil ]) ifFalse: [ self rememberCommand: (Command new cmdWording: 'color change' translated; undoTarget: target selector: selector arguments: (self argumentsWith: originalColor); redoTarget: target selector: selector arguments: (self argumentsWith: selectedColor)). ]. super delete!
Item was changed: ----- Method: ColorPickerMorph>>putUpFor:near: (in category 'other') ----- putUpFor: aMorph near: aRectangle "Put the receiver up on the screen. Note highly variant behavior depending on the setting of the #modalColorPickers preference" | layerNumber | aMorph isMorph ifTrue: [ layerNumber := aMorph morphicLayerNumber. aMorph allOwnersDo:[:m| layerNumber := layerNumber min: m morphicLayerNumber]. + self morphicLayerNumber: layerNumber - 0.1 - self setProperty: #morphicLayerNumber toValue: layerNumber - 0.1 ].
isModal == true "backward compatibility" ifTrue: [self pickUpColorFor: aMorph] ifFalse: [self addToWorld: ((aMorph notNil and: [aMorph world notNil]) ifTrue: [aMorph world] ifFalse: [self currentWorld]) near: (aRectangle ifNil: [aMorph ifNil: [100@100 extent: 1@1] ifNotNil: [aMorph fullBoundsInWorld]])]!
Item was changed: ----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'as yet unclassified') ----- withProgressDo: aBlock
| safetyFactor totals trialRect delta |
Smalltalk isMorphic ifFalse: [^aBlock value]. formerProject := Project current. formerWorld := formerProject world. formerProcess := Processor activeProcess. targetMorph ifNil: [targetMorph := ProgressTargetRequestNotification signal]. targetMorph ifNil: [ trialRect := Rectangle center: Sensor cursorPoint extent: 80@80. delta := trialRect amountToTranslateWithin: formerWorld bounds. trialRect := trialRect translateBy: delta. translucentMorph := TranslucentProgessMorph new opaqueBackgroundColor: Color white; bounds: trialRect; openInWorld: formerWorld. ] ifNotNil: [ translucentMorph := TranslucentProgessMorph new + morphicLayerNumber: targetMorph morphicLayerNumber - 0.1; - setProperty: #morphicLayerNumber toValue: targetMorph morphicLayerNumber - 0.1; bounds: targetMorph boundsInWorld; openInWorld: targetMorph world. ]. stageCompleted := 0. safetyFactor := 1.1. "better to guess high than low" translucentMorph setProperty: #progressStageNumber toValue: 1. translucentMorph hide. totals := self loadingHistoryDataForKey: 'total'. newRatio := 1.0. estimate := totals size < 2 ifTrue: [ 15000 "be a pessimist" ] ifFalse: [ (totals sum - totals max) / (totals size - 1 max: 1) * safetyFactor. ]. start := Time millisecondClockValue. self forkProgressWatcher.
[ aBlock on: ProgressInitiationException do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | "ignore this as it is inaccurate" ]. ]. ] on: ProgressNotification do: [ :note | | stageCompletedString | translucentMorph show. note extraParam ifNotNil:[self addProgressDecoration: note extraParam]. stageCompletedString := (note messageText findTokens: ' ') first. stageCompleted := (stageCompletedString copyUpTo: $:) asNumber. cumulativeStageTime := Time millisecondClockValue - start max: 1. prevData := self loadingHistoryDataForKey: stageCompletedString. prevData isEmpty ifFalse: [ newRatio := (cumulativeStageTime / (prevData average max: 1)) asFloat. ]. self loadingHistoryAt: stageCompletedString add: cumulativeStageTime. translucentMorph setProperty: #progressStageNumber toValue: stageCompleted + 1. note resume. ].
stageCompleted := 999. "we may or may not get here"
!
Item was changed: ----- Method: DialogWindow>>getUserResponse (in category 'running') ----- getUserResponse
| hand world | self message ifEmpty: [messageMorph delete]. "Do not waste space." self paneMorph submorphs ifEmpty: ["Do not waste space and avoid strange button-row wraps." self paneMorph delete. self buttonRowMorph wrapDirection: #none]. hand := self currentHand. world := self currentWorld.
self fullBounds. + self morphicLayerNumber: self class dialogLayer. self moveToPreferredPosition. self openInWorld: world. hand showTemporaryCursor: nil. "Since we are out of context, reset the cursor." hand keyboardFocus in: [:priorKeyboardFocus | hand mouseFocus in: [:priorMouseFocus | self exclusive ifTrue: [hand newMouseFocus: self]. hand newKeyboardFocus: self.
[[self isInWorld] whileTrue: [world doOneSubCycle]] ifCurtailed: [self cancelDialog].
hand newKeyboardFocus: priorKeyboardFocus. self flag: #discuss. "Since 2016 we are having this *ping pong* between (a) restoring the prior mouse focus and (b) just clearing it globally. The former solution makes more sense while the latter fixes issues with some modal dialogs. We have to investigate this further." hand releaseMouseFocus. "hand newMouseFocus: priorMouseFocus."]].
^ result!
Item was changed: ----- Method: DockingBarMorph>>add:icon:help:subMenu: (in category 'construction') ----- add: wordingString icon: aForm help: helpString subMenu: aMenuMorph "Append the given submenu with the given label." | item | item := DockingBarItemMorph new. item contents: wordingString. item subMenu: aMenuMorph. item icon: aForm. helpString isNil ifFalse: [item setBalloonText: helpString]. + aMenuMorph ifNotNil: [ + aMenuMorph morphicLayerNumber: self morphicLayerNumber + 1]. self addMorphBack: item!
Item was changed: ----- Method: DockingBarMorph>>add:icon:selectedIcon:help:subMenu: (in category 'construction') ----- add: wordingString icon: aForm selectedIcon: anotherForm help: helpString subMenu: aMenuMorph "Append the given submenu with the given label." | item | item := DockingBarItemMorph new contents: wordingString; subMenu: aMenuMorph; icon: aForm; selectedIcon: anotherForm. + helpString ifNotNil: [ - helpString isNil ifFalse: [ item setBalloonText: helpString ]. + aMenuMorph ifNotNil: [ + aMenuMorph morphicLayerNumber: self morphicLayerNumber + 1 ]. self addMorphBack: item!
Item was changed: ----- Method: DockingBarMorph>>addItem: (in category 'construction') ----- addItem: aBlock | item | item := DockingBarItemMorph new. aBlock value: item. + item subMenu ifNotNil: [:menu | + "Docking bar and protruding menu should appear visually merged." + menu morphicLayerNumber: self morphicLayerNumber + 1]. self addMorphBack: item!
Item was changed: + ----- Method: DockingBarMorph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: DockingBarMorph>>delete (in category 'submorphs-add/remove') ----- delete
self currentHand removeKeyboardListener: self. activeSubMenu ifNotNil: [ activeSubMenu delete]. ^ super delete!
Item was changed: + ----- Method: DockingBarMorph>>morphicLayerNumber (in category 'submorphs - layers') ----- - ----- Method: DockingBarMorph>>morphicLayerNumber (in category 'WiW support') ----- morphicLayerNumber + + ^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer]! - "helpful for insuring some morphs always appear in front of or - behind others. smaller numbers are in front" - ^ 11!
Item was changed: ----- Method: HaloMorph>>addGraphicalHandleFrom:at: (in category 'private') ----- addGraphicalHandleFrom: formKey at: aPoint "Add the supplied form as a graphical handle centered at the given point. Return the handle." | handle aForm | aForm := (ScriptingSystem formAtKey: formKey) ifNil: [ScriptingSystem formAtKey: #SolidMenu]. handle := ImageMorph new image: aForm; bounds: (Rectangle center: aPoint extent: aForm extent). + handle borderColor: Color black; borderWidth: 2. handle wantsYellowButtonMenu: false. self addMorph: handle. handle on: #mouseUp send: #endInteraction: to: self. ^ handle !
Item was changed: + ----- Method: HaloMorph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: HaloMorph>>delete (in category 'submorphs-add/remove') ----- delete "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then either actually delete myself or start to fade out"
self acceptNameEdit. self isMagicHalo: false. Preferences haloTransitions ifFalse: [super delete] ifTrue: [ self stopStepping; startStepping; startSteppingSelector: #fadeOutFinally]. !
Item was removed: - ----- Method: HaloMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - - "helpful for insuring some morphs always appear in front of or behind others. - smaller numbers are in front" - - ^7 "Halos are very front-like things"!
Item was changed: ----- Method: HandleMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self extent: 16 @ 16. + self disableLayout: true. + self morphicLayerNumber: self class frontmostLayer.! - self disableLayout: true.!
Item was removed: - ----- Method: MVCMenuMorph>>initialize (in category 'initializing') ----- - initialize - super initialize. - self setProperty: #morphicLayerNumber toValue: self morphicLayerNumber - !
Item was removed: - ----- Method: MVCMenuMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - ^self valueOfProperty: #morphicLayerNumber ifAbsent: [10]. - !
Item was changed: ----- Method: MenuMorph>>initialize (in category 'initialization') ----- initialize super initialize.
self setDefaultParameters.
self changeTableLayout. self listDirection: #topToBottom. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. self disableLayout: true. + self morphicLayerNumber: self class menuLayer. defaultTarget := nil. selectedItem := nil. stayUp := false. popUpOwner := nil.!
Item was removed: - ----- Method: MenuMorph>>morphicLayerNumber (in category 'private') ----- - morphicLayerNumber - - "helpful for insuring some morphs always appear in front of or behind others. - smaller numbers are in front" - ^self valueOfProperty: #morphicLayerNumber ifAbsent: [ - stayUp ifTrue:[100] ifFalse:[10] - ]!
Item was changed: ----- Method: MenuMorph>>stayUp: (in category 'accessing') ----- stayUp: aBoolean
stayUp := aBoolean. aBoolean ifTrue: [ self removeStayUpBox ]. + self morphicLayerNumber: (aBoolean ifTrue: [ self class windowLayer ] ifFalse: [ self class menuLayer ]). originalFocusHolder := nil. "Not needed anymore."!
Item was added: + ----- Method: Morph class>>backmostLayer (in category 'layer names') ----- + backmostLayer + + ^ 999!
Item was added: + ----- Method: Morph class>>balloonLayer (in category 'layer names') ----- + balloonLayer + "Balloons and other tooltip-like morphs." + + ^ 5!
Item was added: + ----- Method: Morph class>>defaultLayer (in category 'layer names') ----- + defaultLayer + + ^ 100!
Item was added: + ----- Method: Morph class>>dialogLayer (in category 'layer names') ----- + dialogLayer + "For morphs that request user input." + + ^ self windowLayer + self menuLayer // 2!
Item was added: + ----- Method: Morph class>>frontmostLayer (in category 'layer names') ----- + frontmostLayer + + ^ -999!
Item was added: + ----- Method: Morph class>>haloLayer (in category 'layer names') ----- + haloLayer + "A morph's halo is like a meta menu with a tooltip-like information overlay." + + ^ self menuLayer + self balloonLayer // 2!
Item was added: + ----- Method: Morph class>>menuLayer (in category 'layer names') ----- + menuLayer + "Pop-up menu-like morphs." + + ^ 10!
Item was added: + ----- Method: Morph class>>navigatorLayer (in category 'layer names') ----- + navigatorLayer + "For morphs that float above all (tool) windows and provide quick access to other tools. Examples include docking bars and flaps." + + ^ self dialogLayer + self windowLayer // 2!
Item was added: + ----- Method: Morph class>>progressLayer (in category 'layer names') ----- + progressLayer + "For morphs that help the user understand why a certain operation has not finished yet." + + ^ self dialogLayer + (2 * self menuLayer) // 3!
Item was added: + ----- Method: Morph class>>windowLayer (in category 'layer names') ----- + windowLayer + "For morphs that represent windows and other tool-like containers." + + ^ 100!
Item was changed: + ----- Method: Morph>>abandon (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>abandon (in category 'submorphs-add/remove') ----- abandon "Like delete, but we really intend not to use this morph again. Clean up a few things."
self delete!
Item was changed: + ----- Method: Morph>>actWhen (in category 'submorphs - misc') ----- - ----- Method: Morph>>actWhen (in category 'submorphs-add/remove') ----- actWhen "Answer when the receiver, probably being used as a button, should have its action triggered"
^ self valueOfProperty: #actWhen ifAbsentPut: [#buttonDown]!
Item was changed: + ----- Method: Morph>>actWhen: (in category 'submorphs - misc') ----- - ----- Method: Morph>>actWhen: (in category 'submorphs-add/remove') ----- actWhen: aButtonPhase "Set the receiver's actWhen trait"
self setProperty: #actWhen toValue: aButtonPhase!
Item was changed: + ----- Method: Morph>>addAllMorphs: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addAllMorphs: (in category 'submorphs-add/remove') ----- addAllMorphs: aCollection ^self addAllMorphsBack: aCollection!
Item was changed: + ----- Method: Morph>>addAllMorphs:after: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addAllMorphs:after: (in category 'submorphs-add/remove') ----- addAllMorphs: aCollection after: anotherMorph ^self addAllMorphs: aCollection behind: anotherMorph!
Item was changed: + ----- Method: Morph>>addAllMorphs:behind: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addAllMorphs:behind: (in category 'submorphs-add/remove') ----- addAllMorphs: aCollection behind: anotherMorph ^self privateAddAllMorphs: aCollection atIndex: (submorphs indexOf: anotherMorph) + 1!
Item was changed: + ----- Method: Morph>>addAllMorphs:inFrontOf: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addAllMorphs:inFrontOf: (in category 'submorphs-add/remove') ----- addAllMorphs: aCollection inFrontOf: anotherMorph ^self privateAddAllMorphs: aCollection atIndex: ((submorphs indexOf: anotherMorph) max: 1)!
Item was changed: + ----- Method: Morph>>addAllMorphsBack: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addAllMorphsBack: (in category 'submorphs-add/remove') ----- addAllMorphsBack: aCollection ^self privateAddAllMorphs: aCollection atIndex: submorphs size + 1!
Item was added: + ----- Method: Morph>>addAllMorphsBackInLayers: (in category 'submorphs - layers') ----- + addAllMorphsBackInLayers: morphs + + morphs do: [:morph | self addMorphBackInLayer: morph].!
Item was changed: + ----- Method: Morph>>addAllMorphsFront: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addAllMorphsFront: (in category 'submorphs-add/remove') ----- addAllMorphsFront: aCollection ^self privateAddAllMorphs: aCollection atIndex: 1!
Item was added: + ----- Method: Morph>>addAllMorphsFrontInLayers: (in category 'submorphs - layers') ----- + addAllMorphsFrontInLayers: morphs + + morphs do: [:morph | self addMorphFrontInLayer: morph].!
Item was added: + ----- Method: Morph>>addAllMorphsInLayers: (in category 'submorphs - layers') ----- + addAllMorphsInLayers: morphs + + ^self addAllMorphsBackInLayers: morphs!
Item was changed: + ----- Method: Morph>>addMorph: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addMorph: (in category 'submorphs-add/remove') ----- addMorph: aMorph
self addMorphFront: aMorph.!
Item was changed: + ----- Method: Morph>>addMorph:after: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addMorph:after: (in category 'submorphs-add/remove') ----- addMorph: newMorph after: aMorph ^self addMorph: newMorph behind: aMorph!
Item was changed: + ----- Method: Morph>>addMorph:asElementNumber: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addMorph:asElementNumber: (in category 'submorphs-add/remove') ----- addMorph: aMorph asElementNumber: aNumber - "Add the given morph so that it becomes the aNumber'th element of my submorph list. If aMorph is already one of my submorphs, reposition it"
+ self flag: #deprecated. + ^ self addMorph: aMorph atIndex: aNumber! - (submorphs includes: aMorph) ifTrue: - [aMorph privateDelete]. - (aNumber <= submorphs size) - ifTrue: - [self addMorph: aMorph inFrontOf: (submorphs at: aNumber)] - ifFalse: - [self addMorphBack: aMorph] - !
Item was added: + ----- Method: Morph>>addMorph:atIndex: (in category 'submorphs - add/remove') ----- + addMorph: aMorph atIndex: aNumber + "Add the given morph so that it becomes the aNumber'th element of my submorph list. If aMorph is already one of my submorphs, reposition it." + + (submorphs includes: aMorph) ifTrue: + [aMorph privateDelete]. + (aNumber <= submorphs size) + ifTrue: + [self addMorph: aMorph inFrontOf: (submorphs at: aNumber)] + ifFalse: + [self addMorphBack: aMorph].!
Item was changed: + ----- Method: Morph>>addMorph:behind: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addMorph:behind: (in category 'submorphs-add/remove') ----- addMorph: newMorph behind: aMorph "Add a morph to the list of submorphs behind the specified morph" ^self privateAddMorph: newMorph atIndex: (submorphs indexOf: aMorph) + 1. !
Item was changed: + ----- Method: Morph>>addMorph:fullFrame: (in category 'submorphs - misc') ----- - ----- Method: Morph>>addMorph:fullFrame: (in category 'submorphs-add/remove') ----- addMorph: aMorph fullFrame: aLayoutFrame
aMorph layoutFrame: aLayoutFrame. aMorph hResizing: #spaceFill; vResizing: #spaceFill. self addMorph: aMorph.
!
Item was changed: + ----- Method: Morph>>addMorph:inFrontOf: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addMorph:inFrontOf: (in category 'submorphs-add/remove') ----- addMorph: newMorph inFrontOf: aMorph "Add a morph to the list of submorphs in front of the specified morph" ^self privateAddMorph: newMorph atIndex: ((submorphs indexOf: aMorph) max: 1).!
Item was changed: + ----- Method: Morph>>addMorphBack: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addMorphBack: (in category 'submorphs-add/remove') ----- addMorphBack: aMorph ^self privateAddMorph: aMorph atIndex: submorphs size+1!
Item was added: + ----- Method: Morph>>addMorphBackInLayer: (in category 'submorphs - layers') ----- + addMorphBackInLayer: aMorph + "Note that we do not use #addMorph:, #addMorphBack:, #addMorphFront:, or any non-layer derivatives so that subclasses can safely overwrite those protocols and delegate to here." + + | targetLayer layerHere | + targetLayer := aMorph morphicLayerNumber. + + submorphs "frontmost to backmost" withIndexDo: [ :each :index | + layerHere := each morphicLayerNumber. + "An indirect match (<) indicates the back of the target layer." + targetLayer < layerHere ifTrue: [ + ^ self privateAddMorph: aMorph atIndex: index]]. + + ^ self privateAddMorph: aMorph atIndex: submorphs size + 1 + !
Item was changed: + ----- Method: Morph>>addMorphCentered: (in category 'submorphs - misc') ----- - ----- Method: Morph>>addMorphCentered: (in category 'submorphs-add/remove') ----- addMorphCentered: aMorph
aMorph position: bounds center - (aMorph extent // 2). self addMorphFront: aMorph. !
Item was changed: + ----- Method: Morph>>addMorphFront: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>addMorphFront: (in category 'submorphs-add/remove') ----- addMorphFront: aMorph ^self privateAddMorph: aMorph atIndex: 1!
Item was changed: + ----- Method: Morph>>addMorphFront:fromWorldPosition: (in category 'submorphs - misc') ----- - ----- Method: Morph>>addMorphFront:fromWorldPosition: (in category 'submorphs-add/remove') ----- addMorphFront: aMorph fromWorldPosition: wp
self addMorphFront: aMorph. aMorph position: (self transformFromWorld globalPointToLocal: wp)!
Item was changed: + ----- Method: Morph>>addMorphFrontFromWorldPosition: (in category 'submorphs - misc') ----- - ----- Method: Morph>>addMorphFrontFromWorldPosition: (in category 'submorphs-add/remove') ----- addMorphFrontFromWorldPosition: aMorph ^self addMorphFront: aMorph fromWorldPosition: aMorph positionInWorld.!
Item was added: + ----- Method: Morph>>addMorphFrontInLayer: (in category 'submorphs - layers') ----- + addMorphFrontInLayer: aMorph + "Note that we do not use #addMorph:, #addMorphBack:, #addMorphFront:, or any non-layer derivatives so that subclasses can safely overwrite those protocols and delegate to here." + + | targetLayer layerHere | + targetLayer := aMorph morphicLayerNumber. + + submorphs "frontmost to backmost" withIndexDo: [:each :index | + layerHere := each morphicLayerNumber. + "A direct match (=) indicates the front of the target layer." + targetLayer <= layerHere ifTrue: [ + ^ self privateAddMorph: aMorph atIndex: index]]. + + ^ self privateAddMorph: aMorph atIndex: submorphs size + 1!
Item was removed: - ----- Method: Morph>>addMorphInFrontOfLayer: (in category 'WiW support') ----- - addMorphInFrontOfLayer: aMorph - - | targetLayer | - - targetLayer := aMorph morphicLayerNumberWithin: self. - submorphs do: [ :each | | layerHere | - each == aMorph ifTrue: [^self]. - layerHere := each morphicLayerNumberWithin: self. - "the <= is the difference - it insures we go to the front of our layer" - targetLayer <= layerHere ifTrue: [ - ^self addMorph: aMorph inFrontOf: each - ]. - ]. - self addMorphBack: aMorph. - !
Item was changed: + ----- Method: Morph>>addMorphInLayer: (in category 'submorphs - layers') ----- - ----- Method: Morph>>addMorphInLayer: (in category 'WiW support') ----- addMorphInLayer: aMorph
+ ^ self addMorphBackInLayer: aMorph! - submorphs do: [ :each | - each == aMorph ifTrue: [^self]. - aMorph morphicLayerNumber < each morphicLayerNumber ifTrue: [ - ^self addMorph: aMorph inFrontOf: each - ]. - ]. - self addMorphBack: aMorph - !
Item was changed: + ----- Method: Morph>>addMorphNearBack: (in category 'submorphs - misc') ----- - ----- Method: Morph>>addMorphNearBack: (in category 'submorphs-add/remove') ----- addMorphNearBack: aMorph | bg | (submorphs notEmpty and: [submorphs last mustBeBackmost]) ifTrue: [bg := submorphs last. bg privateDelete]. self addMorphBack: aMorph. bg ifNotNil: [self addMorphBack: bg]!
Item was changed: + ----- Method: Morph>>allKnownNames (in category 'submorphs - accessing') ----- - ----- Method: Morph>>allKnownNames (in category 'submorphs-accessing') ----- allKnownNames "Return a list of all known names based on the scope of the receiver. Does not include the name of the receiver itself. Items in parts bins are excluded. Reimplementors (q.v.) can extend the list"
^ Array streamContents: [:s | self allSubmorphNamesDo: [:n | s nextPut: n]] !
Item was changed: + ----- Method: Morph>>allMorphs (in category 'submorphs - accessing') ----- - ----- Method: Morph>>allMorphs (in category 'submorphs-accessing') ----- allMorphs "Return a collection containing all morphs in this composite morph (including the receiver)."
| all | all := OrderedCollection new: 100. self allMorphsDo: [: m | all add: m]. ^ all!
Item was changed: + ----- Method: Morph>>allMorphsDo: (in category 'submorphs - enumerating') ----- - ----- Method: Morph>>allMorphsDo: (in category 'submorphs-accessing') ----- allMorphsDo: aBlock "Evaluate the given block for all morphs in this composite morph (including the receiver)."
submorphs do: [:m | m allMorphsDo: aBlock]. aBlock value: self!
Item was changed: + ----- Method: Morph>>allMorphsWithPlayersDo: (in category 'submorphs - misc') ----- - ----- Method: Morph>>allMorphsWithPlayersDo: (in category 'submorphs-add/remove') ----- allMorphsWithPlayersDo: aTwoArgumentBlock "Evaluate the given block for all morphs in this composite morph that have non-nil players. Also evaluate the block for the receiver if it has a player."
submorphs do: [:m | m allMorphsWithPlayersDo: aTwoArgumentBlock ]. self playerRepresented ifNotNil: [ :p | aTwoArgumentBlock value: self value: p ]. !
Item was changed: + ----- Method: Morph>>allNonSubmorphMorphs (in category 'submorphs - misc') ----- - ----- Method: Morph>>allNonSubmorphMorphs (in category 'submorphs-accessing') ----- allNonSubmorphMorphs "Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy (put in primarily for bookmorphs)"
^ OrderedCollection new!
Item was changed: + ----- Method: Morph>>allSubmorphNamesDo: (in category 'submorphs - enumerating') ----- - ----- Method: Morph>>allSubmorphNamesDo: (in category 'submorphs-accessing') ----- allSubmorphNamesDo: nameBlock "Return a list of all known names of submorphs and nested submorphs of the receiver, based on the scope of the receiver. Items in parts bins are excluded"
self isPartsBin ifTrue: [^ self]. "Don't report names from parts bins" self submorphsDo: [:m | m knownName ifNotNil: [:n | nameBlock value: n]. m allSubmorphNamesDo: nameBlock]. !
Item was changed: ----- Method: Morph>>beFlap: (in category 'accessing') ----- beFlap: aBool "Mark the receiver with the #flap property, or unmark it"
aBool ifTrue: [self setProperty: #flap toValue: true. self disableLayout: true. self hResizing: #rigid. + self vResizing: #rigid. + self morphicLayerNumber: self class navigatorLayer] - self vResizing: #rigid] ifFalse: [self removeProperty: #flap. + self disableLayout: false. + self morphicLayerNumber: nil]! - self disableLayout: false]!
Item was changed: + ----- Method: Morph>>comeToFront (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>comeToFront (in category 'submorphs-add/remove') ----- comeToFront | outerMorph | outerMorph := self topRendererOrSelf. (outerMorph owner isNil or: [outerMorph owner hasSubmorphs not]) ifTrue: [^self]. outerMorph owner firstSubmorph == outerMorph ifFalse: [outerMorph owner addMorphFront: outerMorph]!
Item was changed: + ----- Method: Morph>>copyWithoutSubmorph: (in category 'submorphs - misc') ----- - ----- Method: Morph>>copyWithoutSubmorph: (in category 'submorphs-add/remove') ----- copyWithoutSubmorph: sub "Needed to get a morph to draw without one of its submorphs. NOTE: This must be thrown away immediately after use." ^ self shallowCopy privateSubmorphs: (submorphs copyWithout: sub)!
Item was changed: + ----- Method: Morph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>delete (in category 'submorphs-add/remove') ----- delete "Remove the receiver as a submorph of its owner and make its new owner be nil." | oldWorld | self removeHalo. (oldWorld := self world) ifNotNil: [ self disableSubmorphFocusForHand: self activeHand. self activeHand releaseKeyboardFocus: self; releaseMouseFocus: self]. owner ifNotNil: [ self privateDelete. "remove from world" self player ifNotNil: [:player | oldWorld ifNotNil: [ player noteDeletionOf: self fromWorld: oldWorld]]].!
Item was changed: + ----- Method: Morph>>deleteDockingBars (in category 'submorphs - misc') ----- - ----- Method: Morph>>deleteDockingBars (in category 'submorphs-add/remove') ----- deleteDockingBars "Delete the receiver's docking bars" self dockingBars do: [:each | each delete]!
Item was changed: + ----- Method: Morph>>deleteSubmorphsWithProperty: (in category 'submorphs - misc') ----- - ----- Method: Morph>>deleteSubmorphsWithProperty: (in category 'submorphs-add/remove') ----- deleteSubmorphsWithProperty: aSymbol submorphs copy do: [:m | (m hasProperty: aSymbol) ifTrue: [m delete]]!
Item was changed: + ----- Method: Morph>>deleteUnlessHasFocus (in category 'submorphs - misc') ----- - ----- 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: [ self stopSteppingSelector: #deleteUnlessHasFocus ; delete ]!
Item was changed: + ----- Method: Morph>>dismissViaHalo (in category 'submorphs - misc') ----- - ----- 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.!
Item was changed: + ----- Method: Morph>>dockingBars (in category 'submorphs - misc') ----- - ----- Method: Morph>>dockingBars (in category 'submorphs-accessing') ----- dockingBars "Answer the receiver's dockingBars" ^ self submorphs select: [:each | each isDockingBar] !
Item was changed: + ----- Method: Morph>>findA: (in category 'submorphs - misc') ----- - ----- Method: Morph>>findA: (in category 'submorphs-accessing') ----- findA: aClass "Return the first submorph of the receiver that is descended from the given class. Return nil if there is no such submorph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."
^self submorphs detect: [:p | p isKindOf: aClass] ifNone: [nil]!
Item was changed: + ----- Method: Morph>>findDeepSubmorphThat:ifAbsent: (in category 'submorphs - misc') ----- - ----- Method: Morph>>findDeepSubmorphThat:ifAbsent: (in category 'submorphs-accessing') ----- findDeepSubmorphThat: block1 ifAbsent: block2 self allMorphsDo: [:m | (block1 value: m) == true ifTrue: [^ m]]. ^ block2 value!
Item was changed: + ----- Method: Morph>>findDeeplyA: (in category 'submorphs - misc') ----- - ----- Method: Morph>>findDeeplyA: (in category 'submorphs-accessing') ----- findDeeplyA: aClass "Return a morph in the submorph tree of the receiver that is descended from the given class. Return nil if there is no such morph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."
^ (self allMorphs copyWithout: self) detect: [:p | p isKindOf: aClass] ifNone: [nil]!
Item was changed: + ----- Method: Morph>>findSubmorphBinary: (in category 'submorphs - misc') ----- - ----- Method: Morph>>findSubmorphBinary: (in category 'submorphs-accessing') ----- findSubmorphBinary: aBlock "Use binary search for finding a specific submorph of the receiver. Caller must be certain that the ordering holds for the submorphs." ^submorphs findBinary: aBlock ifNone:[nil].!
Item was changed: + ----- Method: Morph>>firstSubmorph (in category 'submorphs - accessing') ----- - ----- Method: Morph>>firstSubmorph (in category 'submorphs-accessing') ----- firstSubmorph ^submorphs first!
Item was changed: + ----- Method: Morph>>goBehind (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>goBehind (in category 'submorphs-add/remove') ----- goBehind "Move the receiver to bottom z-order."
| topRend | topRend := self topRendererOrSelf. topRend owner ifNotNil: [:own | own addMorphNearBack: topRend] !
Item was changed: + ----- Method: Morph>>hasSubmorphWithProperty: (in category 'submorphs - misc') ----- - ----- Method: Morph>>hasSubmorphWithProperty: (in category 'submorphs-accessing') ----- hasSubmorphWithProperty: aSymbol ^submorphs anySatisfy: [:m | m hasProperty: aSymbol]!
Item was changed: + ----- Method: Morph>>hasSubmorphs (in category 'submorphs - testing') ----- - ----- Method: Morph>>hasSubmorphs (in category 'submorphs-accessing') ----- hasSubmorphs ^submorphs notEmpty!
Item was changed: + ----- Method: Morph>>indexOfMorphAbove: (in category 'submorphs - misc') ----- - ----- Method: Morph>>indexOfMorphAbove: (in category 'submorphs-accessing') ----- indexOfMorphAbove: aPoint "Return index of lowest morph whose bottom is above aPoint. Will return 0 if the first morph is not above aPoint."
submorphs withIndexDo: [:mm :ii | mm fullBounds bottom >= aPoint y ifTrue: [^ ii - 1]]. ^ submorphs size!
Item was changed: + ----- Method: Morph>>intoWorld: (in category 'submorphs - callbacks') ----- - ----- Method: Morph>>intoWorld: (in category 'initialization') ----- intoWorld: aWorld "The receiver has just appeared in a new world. Note: * aWorld can be nil (due to optimizations in other places) * owner is already set * owner's submorphs may not include receiver yet. Important: Keep this method fast - it is run whenever morphs are added." aWorld ifNil:[^self]. self wantsSteps ifTrue:[aWorld startStepping: self]. self submorphsDo:[:m| m intoWorld: aWorld]. !
Item was changed: + ----- Method: Morph>>lastSubmorph (in category 'submorphs - accessing') ----- - ----- Method: Morph>>lastSubmorph (in category 'submorphs-accessing') ----- lastSubmorph ^submorphs last!
Item was changed: + ----- Method: Morph>>mainDockingBars (in category 'submorphs - misc') ----- - ----- Method: Morph>>mainDockingBars (in category 'submorphs-accessing') ----- mainDockingBars "Answer the receiver's main dockingBars" ^ self dockingBars select: [:each | each hasProperty: #mainDockingBarTimeStamp]!
Item was changed: + ----- Method: Morph>>morphicLayerNumber (in category 'submorphs - layers') ----- - ----- Method: Morph>>morphicLayerNumber (in category 'WiW support') ----- morphicLayerNumber + "Hint the preferred position in the owner's list of submorphs. Smaller layer numbers are in front of larger ones. If not specified, go up the owner chain if possible." + + ^ self + valueOfProperty: #morphicLayerNumber + ifAbsent: [self topRendererOrSelf owner + ifNil: [self class defaultLayer] + ifNotNil: [:m | m morphicLayerNumber]]! - - "helpful for insuring some morphs always appear in front of or behind others. - smaller numbers are in front" - - ^(owner isNil or: [owner isWorldMorph]) ifTrue: [ - self valueOfProperty: #morphicLayerNumber ifAbsent: [100] - ] ifFalse: [ - owner morphicLayerNumber - ]. - - "leave lots of room for special things"!
Item was added: + ----- Method: Morph>>morphicLayerNumber: (in category 'submorphs - layers') ----- + morphicLayerNumber: aNumber + "Changes the receiver's layer. If it is already part of a hierarchy, make sure that the owner's submorphs are in layer order. This can happen if you mix the use of, for example, #addMorph: and #addMorphInLayer:." + + self setProperty: #morphicLayerNumber toValue: aNumber. + self owner ifNotNil: [:o | o reorderSubmorphsInLayers].!
Item was removed: - ----- Method: Morph>>morphicLayerNumberWithin: (in category 'WiW support') ----- - morphicLayerNumberWithin: anOwner - - "helpful for insuring some morphs always appear in front of or behind others. - smaller numbers are in front" - - ^(owner isNil or: [owner isWorldMorph or: [anOwner == owner]]) ifTrue: [ - self valueOfProperty: #morphicLayerNumber ifAbsent: [100] - ] ifFalse: [ - owner morphicLayerNumber - ]. - - "leave lots of room for special things"!
Item was changed: + ----- Method: Morph>>morphsAt: (in category 'submorphs - accessing') ----- - ----- Method: Morph>>morphsAt: (in category 'submorphs-accessing') ----- morphsAt: aPoint "Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself. The order is deepest embedding first." ^self morphsAt: aPoint unlocked: false!
Item was changed: + ----- Method: Morph>>morphsAt:behind:unlocked: (in category 'submorphs - misc') ----- - ----- Method: Morph>>morphsAt:behind:unlocked: (in category 'submorphs-accessing') ----- morphsAt: aPoint behind: aMorph unlocked: aBool "Return all morphs at aPoint that are behind frontMorph; if aBool is true return only unlocked, visible morphs."
| isBack all tfm | all := (aMorph isNil or: [owner isNil]) ifTrue: ["Traverse down"
(self fullBounds containsPoint: aPoint) ifFalse: [^#()]. (aBool and: [self isLocked or: [self visible not]]) ifTrue: [^#()]. nil] ifFalse: ["Traverse up"
tfm := self transformedFrom: owner. all := owner morphsAt: (tfm localPointToGlobal: aPoint) behind: self unlocked: aBool. WriteStream with: all]. isBack := aMorph isNil. self submorphsDo: [:m | | found | isBack ifTrue: [tfm := m transformedFrom: self. found := m morphsAt: (tfm globalPointToLocal: aPoint) behind: nil unlocked: aBool. found notEmpty ifTrue: [all ifNil: [all := WriteStream on: #()]. all nextPutAll: found]]. m == aMorph ifTrue: [isBack := true]]. (isBack and: [self containsPoint: aPoint]) ifTrue: [all ifNil: [^Array with: self]. all nextPut: self]. ^all ifNil: [#()] ifNotNil: [all contents]!
Item was changed: + ----- Method: Morph>>morphsAt:unlocked: (in category 'submorphs - accessing') ----- - ----- Method: Morph>>morphsAt:unlocked: (in category 'submorphs-accessing') ----- morphsAt: aPoint unlocked: aBool "Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself. The order is deepest embedding first." | mList | mList := WriteStream on: #(). self morphsAt: aPoint unlocked: aBool do:[:m| mList nextPut: m]. ^mList contents!
Item was changed: + ----- Method: Morph>>morphsAt:unlocked:do: (in category 'submorphs - enumerating') ----- - ----- Method: Morph>>morphsAt:unlocked:do: (in category 'submorphs-accessing') ----- morphsAt: aPoint unlocked: aBool do: aBlock "Evaluate aBlock with all the morphs starting at the receiver which appear at aPoint. If aBool is true take only visible, unlocked morphs into account." (self fullBounds containsPoint: aPoint) ifFalse:[^self]. (aBool and:[self isLocked or:[self visible not]]) ifTrue:[^self]. self submorphsDo:[:m| | tfm | tfm := m transformedFrom: self. m morphsAt: (tfm globalPointToLocal: aPoint) unlocked: aBool do: aBlock]. (self containsPoint: aPoint) ifTrue:[aBlock value: self].!
Item was changed: + ----- Method: Morph>>morphsInFrontOf:overlapping:do: (in category 'submorphs - misc') ----- - ----- Method: Morph>>morphsInFrontOf:overlapping:do: (in category 'submorphs-accessing') ----- morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock "Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle. someMorph is either an immediate child of the receiver or nil (in which case all submorphs of the receiver are enumerated)." self submorphsDo:[:m| m == someMorph ifTrue:["Try getting out quickly" owner ifNil:[^self]. ^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock]. (m fullBoundsInWorld intersects: aRectangle) ifTrue:[aBlock value: m]]. owner ifNil:[^self]. ^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock.!
Item was changed: + ----- Method: Morph>>morphsInFrontOverlapping: (in category 'submorphs - misc') ----- - ----- Method: Morph>>morphsInFrontOverlapping: (in category 'submorphs-accessing') ----- morphsInFrontOverlapping: aRectangle "Return all top-level morphs in front of someMorph that overlap with the given rectangle." | morphList | morphList := WriteStream on: Array new. self morphsInFrontOf: nil overlapping: aRectangle do:[:m | morphList nextPut: m]. ^morphList contents!
Item was changed: + ----- Method: Morph>>morphsInFrontOverlapping:do: (in category 'submorphs - misc') ----- - ----- Method: Morph>>morphsInFrontOverlapping:do: (in category 'submorphs-accessing') ----- morphsInFrontOverlapping: aRectangle do: aBlock "Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle." ^self morphsInFrontOf: nil overlapping: aRectangle do: aBlock!
Item was changed: + ----- Method: Morph>>noteNewOwner: (in category 'submorphs - callbacks') ----- - ----- Method: Morph>>noteNewOwner: (in category 'submorphs-accessing') ----- noteNewOwner: aMorph "I have just been added as a submorph of aMorph"!
Item was changed: + ----- Method: Morph>>outOfWorld: (in category 'submorphs - callbacks') ----- - ----- Method: Morph>>outOfWorld: (in category 'initialization') ----- outOfWorld: aWorld "The receiver has just appeared in a new world. Notes: * aWorld can be nil (due to optimizations in other places) * owner is still valid Important: Keep this method fast - it is run whenever morphs are removed." aWorld ifNil:[^self]. "ar 1/31/2001: We could explicitly stop stepping the receiver here but for the sake of speed I'm for now relying on the lazy machinery in the world itself." "aWorld stopStepping: self." self submorphsDo:[:m| m outOfWorld: aWorld]. !
Item was changed: + ----- Method: Morph>>privateDelete (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>privateDelete (in category 'submorphs-add/remove') ----- privateDelete "Remove the receiver as a submorph of its owner" owner ifNotNil:[owner removeMorph: self].!
Item was changed: + ----- Method: Morph>>removeAllMorphs (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>removeAllMorphs (in category 'submorphs-add/remove') ----- removeAllMorphs | oldMorphs myWorld | myWorld := self world. (fullBounds notNil or: [ myWorld notNil ]) ifTrue: [ self invalidRect: self fullBounds ]. submorphs do: [ : m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil ]. oldMorphs := submorphs. submorphs := Array empty. oldMorphs do: [ : m | self removedMorph: m ]. self layoutChanged!
Item was changed: + ----- Method: Morph>>removeAllMorphsIn: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>removeAllMorphsIn: (in category 'submorphs-add/remove') ----- removeAllMorphsIn: aCollection "greatly speeds up the removal of *lots* of submorphs" | set myWorld | set := IdentitySet new: aCollection size * 4 // 3. aCollection do: [:each | each owner == self ifTrue: [ set add: each]]. myWorld := self world. (fullBounds notNil or:[myWorld notNil]) ifTrue:[self invalidRect: self fullBounds]. set do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil]. submorphs := submorphs reject: [ :each | set includes: each]. set do: [ :m | self removedMorph: m ]. self layoutChanged. !
Item was changed: ----- Method: Morph>>removeHalo (in category 'halos and balloon help') ----- removeHalo "remove the surrounding halo (if any)"
+ self halo ifNotNil: [ self currentHand removeHalo ]! - self halo ifNotNil: [ self primaryHand removeHalo ]!
Item was changed: + ----- Method: Morph>>removeMorph: (in category 'submorphs - add/remove') ----- - ----- Method: Morph>>removeMorph: (in category 'submorphs-add/remove') ----- removeMorph: aMorph "Remove the given morph from my submorphs" | aWorld | aMorph owner == self ifFalse:[^self]. aWorld := self world. aWorld ifNotNil:[ aMorph outOfWorld: aWorld. self privateInvalidateMorph: aMorph. ]. self privateRemove: aMorph. aMorph privateOwner: nil. self removedMorph: aMorph. !
Item was changed: + ----- Method: Morph>>removedMorph: (in category 'submorphs - callbacks') ----- - ----- Method: Morph>>removedMorph: (in category 'submorphs-add/remove') ----- removedMorph: aMorph "Notify the receiver that aMorph was just removed from its children" !
Item was added: + ----- Method: Morph>>reorderSubmorphsInLayers (in category 'submorphs - layers') ----- + reorderSubmorphsInLayers + "Update submorph order to match their respective layer numbers." + + ((1 to: submorphs size - 1) allSatisfy: [:index | + (submorphs at: index) morphicLayerNumber + <= (submorphs at: index + 1) morphicLayerNumber]) + ifTrue: [^ self "No reordering needed"]. + + self changed. + submorphs := submorphs sorted: [:m1 :m2 | + m1 morphicLayerNumber <= m2 morphicLayerNumber]. + self layoutChanged; changed.!
Item was changed: + ----- Method: Morph>>replaceSubmorph:by: (in category 'submorphs - misc') ----- - ----- Method: Morph>>replaceSubmorph:by: (in category 'submorphs-add/remove') ----- replaceSubmorph: oldMorph by: newMorph | index itsPosition w | oldMorph stopStepping. itsPosition := oldMorph referencePositionInWorld. index := submorphs indexOf: oldMorph. oldMorph privateDelete. self privateAddMorph: newMorph atIndex: index. newMorph referencePositionInWorld: itsPosition. (w := newMorph world) ifNotNil: [w startSteppingSubmorphsOf: newMorph]!
Item was changed: + ----- Method: Morph>>rootMorphsAt: (in category 'submorphs - misc') ----- - ----- Method: Morph>>rootMorphsAt: (in category 'submorphs-accessing') ----- rootMorphsAt: aPoint "Return the list of root morphs containing the given point, excluding the receiver. ar 11/8/1999: Moved into morph for an incredibly ugly hack in 3D worlds" self flag: #arNote. "check this at some point" ^ self submorphs select: [:m | (m fullContainsPoint: aPoint) and: [m isLocked not]]!
Item was changed: + ----- Method: Morph>>rootMorphsAtGlobal: (in category 'submorphs - misc') ----- - ----- Method: Morph>>rootMorphsAtGlobal: (in category 'submorphs-accessing') ----- rootMorphsAtGlobal: aPoint "Return the list of root morphs containing the given point, excluding the receiver. ar 11/8/1999: Moved into morph for an incredibly ugly hack in 3D worlds"
^ self rootMorphsAt: (self pointFromWorld: aPoint)!
Item was changed: + ----- Method: Morph>>shuffleSubmorphs (in category 'submorphs - misc') ----- - ----- Method: Morph>>shuffleSubmorphs (in category 'submorphs-accessing') ----- shuffleSubmorphs "Randomly shuffle the order of my submorphs. Don't call this method lightly!!"
| bg | self invalidRect: self fullBounds. (submorphs notEmpty and: [submorphs last mustBeBackmost]) ifTrue: [bg := submorphs last. bg privateDelete]. submorphs := submorphs shuffled. bg ifNotNil: [self addMorphBack: bg]. self layoutChanged!
Item was changed: + ----- Method: Morph>>submorphAfter (in category 'submorphs - misc') ----- - ----- Method: Morph>>submorphAfter (in category 'submorphs-accessing') ----- submorphAfter "Return the submorph after (behind) me, or nil" | ii | owner ifNil: [^ nil]. ^ (ii := owner submorphIndexOf: self) = owner submorphs size ifTrue: [nil] ifFalse: [owner submorphs at: ii+1]. !
Item was changed: + ----- Method: Morph>>submorphBefore (in category 'submorphs - misc') ----- - ----- Method: Morph>>submorphBefore (in category 'submorphs-accessing') ----- submorphBefore "Return the submorph after (behind) me, or nil" | ii | owner ifNil: [^ nil]. ^ (ii := owner submorphIndexOf: self) = 1 ifTrue: [nil] ifFalse: [owner submorphs at: ii-1]. !
Item was changed: + ----- Method: Morph>>submorphCount (in category 'submorphs - accessing') ----- - ----- Method: Morph>>submorphCount (in category 'submorphs-accessing') ----- submorphCount
^ submorphs size!
Item was changed: + ----- Method: Morph>>submorphIndexOf: (in category 'submorphs - accessing') ----- - ----- Method: Morph>>submorphIndexOf: (in category 'submorphs-add/remove') ----- submorphIndexOf: aMorph "Assuming aMorph to be one of my submorphs, answer where it occurs in my submorph list"
^ submorphs indexOf: aMorph ifAbsent: [nil]!
Item was changed: + ----- Method: Morph>>submorphNamed: (in category 'submorphs - accessing') ----- - ----- Method: Morph>>submorphNamed: (in category 'submorphs-accessing') ----- submorphNamed: aName ^ self submorphNamed: aName ifNone: [nil]!
Item was changed: + ----- Method: Morph>>submorphNamed:ifNone: (in category 'submorphs - accessing') ----- - ----- Method: Morph>>submorphNamed:ifNone: (in category 'submorphs-accessing') ----- submorphNamed: aName ifNone: aBlock "Find the first submorph with this name, or a button with an action selector of that name"
self submorphs do: [:p | p knownName = aName ifTrue: [^p]]. self submorphs do: [:button | | sub args | (button respondsTo: #actionSelector) ifTrue: [button actionSelector == aName ifTrue: [^button]]. ((button respondsTo: #arguments) and: [(args := button arguments) notNil]) ifTrue: [(args at: 2 ifAbsent: [nil]) == aName ifTrue: [^button]]. (button isAlignmentMorph) ifTrue: [(sub := button submorphNamed: aName ifNone: [nil]) ifNotNil: [^sub]]]. ^aBlock value!
Item was changed: + ----- Method: Morph>>submorphOfClass: (in category 'submorphs - misc') ----- - ----- Method: Morph>>submorphOfClass: (in category 'submorphs-accessing') ----- submorphOfClass: aClass
^self findA: aClass!
Item was changed: + ----- Method: Morph>>submorphThat:ifNone: (in category 'submorphs - accessing') ----- - ----- Method: Morph>>submorphThat:ifNone: (in category 'submorphs-accessing') ----- submorphThat: block1 ifNone: block2
^submorphs detect: block1 ifNone: block2 !
Item was changed: + ----- Method: Morph>>submorphWithProperty: (in category 'submorphs - misc') ----- - ----- Method: Morph>>submorphWithProperty: (in category 'submorphs-accessing') ----- submorphWithProperty: aSymbol ^ submorphs detect: [:aMorph | aMorph hasProperty: aSymbol] ifNone: [nil]!
Item was changed: + ----- Method: Morph>>submorphs (in category 'submorphs - accessing') ----- - ----- Method: Morph>>submorphs (in category 'submorphs-accessing') ----- submorphs "This method returns my actual submorphs collection. Modifying the collection directly could be dangerous; make a copy if you need to alter it." ^ submorphs !
Item was changed: + ----- Method: Morph>>submorphsBehind:do: (in category 'submorphs - enumerating') ----- - ----- Method: Morph>>submorphsBehind:do: (in category 'submorphs-accessing') ----- submorphsBehind: aMorph do: aBlock | behind | behind := false. submorphs do: [:m | m == aMorph ifTrue: [behind := true] ifFalse: [behind ifTrue: [aBlock value: m]]]. !
Item was changed: + ----- Method: Morph>>submorphsDo: (in category 'submorphs - enumerating') ----- - ----- Method: Morph>>submorphsDo: (in category 'submorphs-accessing') ----- submorphsDo: aBlock submorphs do: aBlock!
Item was changed: + ----- Method: Morph>>submorphsInFrontOf:do: (in category 'submorphs - enumerating') ----- - ----- Method: Morph>>submorphsInFrontOf:do: (in category 'submorphs-accessing') ----- submorphsInFrontOf: aMorph do: aBlock | behind | behind := false. submorphs do: [:m | m == aMorph ifTrue: [behind := true] ifFalse: [behind ifFalse: [aBlock value: m]]]. !
Item was changed: + ----- Method: Morph>>submorphsReverseDo: (in category 'submorphs - enumerating') ----- - ----- Method: Morph>>submorphsReverseDo: (in category 'submorphs-accessing') ----- submorphsReverseDo: aBlock
submorphs reverseDo: aBlock.!
Item was changed: + ----- Method: Morph>>submorphsSatisfying: (in category 'submorphs - accessing') ----- - ----- Method: Morph>>submorphsSatisfying: (in category 'submorphs-accessing') ----- submorphsSatisfying: aBlock ^ submorphs select: [:m | (aBlock value: m) == true]!
Item was changed: + ----- Method: Morph>>wantsToBeTopmost (in category 'e-toy support') ----- - ----- Method: Morph>>wantsToBeTopmost (in category 'accessing') ----- wantsToBeTopmost "Answer if the receiver want to be one of the topmost objects in its owner" ^ self isFlapOrTab!
Item was changed: + ----- Method: MorphicModel>>allKnownNames (in category 'submorphs - accessing') ----- - ----- Method: MorphicModel>>allKnownNames (in category 'submorphs-accessing') ----- allKnownNames "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables."
| superNames | superNames := super allKnownNames. "gather them from submorph tree" ^self belongsToUniClass ifTrue: [superNames , (self instanceVariableValues select: [:e | e notNil and: [e knownName notNil]] thenCollect: [:e | e knownName])] ifFalse: [superNames]!
Item was changed: + ----- Method: MorphicModel>>delete (in category 'submorphs - add/remove') ----- - ----- Method: MorphicModel>>delete (in category 'submorphs-add/remove') ----- delete (model isMorphicModel) ifFalse: [^super delete]. slotName ifNotNil: [(UIManager default confirm: 'Shall I remove the slot ' , slotName , ' along with all associated methods?') ifTrue: [(model class selectors select: [:s | s beginsWith: slotName]) do: [:s | model class removeSelector: s]. (model class instVarNames includes: slotName) ifTrue: [model class removeInstVarName: slotName]] ifFalse: [(UIManager default confirm: '...but should I at least dismiss this morph? [choose no to leave everything unchanged]') ifFalse: [^self]]]. super delete!
Item was changed: ----- Method: NewBalloonMorph>>initialize (in category 'initialization') ----- initialize
super initialize. self disableLayout: true. + self morphicLayerNumber: self class balloonLayer. self setDefaultParameters. textMorph := TextMorph new wrapFlag: false; lock; yourself. self addMorph: textMorph.!
Item was removed: - ----- Method: NewBalloonMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - - "helpful for insuring some morphs always appear in front of or behind others. - smaller numbers are in front" - - ^5 "Balloons are very front-like things"!
Item was changed: + ----- Method: NewHandleMorph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: NewHandleMorph>>delete (in category 'submorphs-add/remove') ----- delete hand ifNotNil:[ hand showTemporaryCursor: nil. ]. super delete.!
Item was removed: - ----- Method: NewHandleMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - - ^1 "handles are very front-like - e.g. the spawn reframe logic actually asks if the first submorph of the world is one of us before deciding to create one"!
Item was changed: + ----- Method: PasteUpMorph>>addAllMorphs: (in category 'submorphs - add/remove') ----- - ----- Method: PasteUpMorph>>addAllMorphs: (in category 'submorphs-add/remove') ----- addAllMorphs: array
super addAllMorphs: array. self isWorldMorph ifTrue: [array do: [:m | self startSteppingSubmorphsOf: m]]. !
Item was changed: + ----- Method: PasteUpMorph>>addMorphFront: (in category 'submorphs - add/remove') ----- - ----- Method: PasteUpMorph>>addMorphFront: (in category 'submorphs-add/remove') ----- addMorphFront: aMorph + "Overwritten to arrange submorphs in layers by default."
+ ^ self addMorphFrontInLayer: aMorph! - ^self addMorphInFrontOfLayer: aMorph - !
Item was changed: + ----- Method: PasteUpMorph>>allMorphsDo: (in category 'submorphs - accessing') ----- - ----- Method: PasteUpMorph>>allMorphsDo: (in category 'submorphs-accessing') ----- allMorphsDo: aBlock "Enumerate all morphs in the world, including those held in hands."
super allMorphsDo: aBlock. self isWorldMorph ifTrue: [worldState handsReverseDo: [:h | h allMorphsDo: aBlock]]. !
Item was removed: - ----- Method: PasteUpMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - - self isFlap ifTrue:[^26]. "As navigators" - ^super morphicLayerNumber.!
Item was changed: + ----- Method: PasteUpMorph>>morphsInFrontOf:overlapping:do: (in category 'submorphs - accessing') ----- - ----- Method: PasteUpMorph>>morphsInFrontOf:overlapping:do: (in category 'submorphs-accessing') ----- morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock "Include hands if the receiver is the World" self handsDo:[:m| m == someMorph ifTrue:["Try getting out quickly" owner ifNil:[^self]. ^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock]. "The hand only overlaps if it's not the hardware cursor" m needsToBeDrawn ifTrue:[ (m fullBoundsInWorld intersects: aRectangle) ifTrue:[aBlock value: m]]]. ^super morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock!
Item was changed: + ----- Method: PluggableListMorph>>allSubmorphNamesDo: (in category 'submorphs - accessing') ----- - ----- Method: PluggableListMorph>>allSubmorphNamesDo: (in category 'submorphs-accessing') ----- allSubmorphNamesDo: nameBlock "Assume list morphs do not have named parts -- saves MUCH time"
^ self!
Item was changed: + ----- Method: PluggableTextMorphWithModel>>delete (in category 'submorphs - add/remove') ----- - ----- Method: PluggableTextMorphWithModel>>delete (in category 'submorphs-add/remove') ----- delete "Delete the receiver. Since I have myself as a dependent, I need to remove it. which is odd in itself. Also, the release of dependents will seemingly not be done if the *container* of the receiver is deleted rather than the receiver itself, a further problem"
self removeDependent: self. super delete!
Item was changed: + ----- Method: ProjectViewMorph>>abandon (in category 'submorphs - add/remove') ----- - ----- Method: ProjectViewMorph>>abandon (in category 'submorphs-add/remove') ----- abandon "Home ViewMorph of project is going away."
project := nil. super abandon.
!
Item was changed: + ----- Method: SelectionMorph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: SelectionMorph>>delete (in category 'submorphs-add/remove') ----- delete self setProperty: #deleting toValue: true. super delete. !
Item was changed: + ----- Method: SelectionMorph>>dismissViaHalo (in category 'submorphs - add/remove') ----- - ----- Method: SelectionMorph>>dismissViaHalo (in category 'submorphs-add/remove') ----- dismissViaHalo selectedItems do: [:m | m dismissViaHalo]. super dismissViaHalo. !
Item was changed: ----- Method: SelectionMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" + self disableLayout: true. + self morphicLayerNumber: self class haloLayer + 1. - selectedItems := OrderedCollection new. itemsAlreadySelected := OrderedCollection new.!
Item was removed: - ----- Method: SelectionMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - "helpful for insuring some morphs always appear in front of or - behind others. smaller numbers are in front" - ^ 8!
Item was changed: + ----- Method: SimpleButtonMorph>>actWhen (in category 'submorphs - add/remove') ----- - ----- Method: SimpleButtonMorph>>actWhen (in category 'submorphs-add/remove') ----- actWhen "acceptable symbols: #buttonDown, #buttonUp, and #whilePressed"
^ actWhen!
Item was changed: + ----- Method: SimpleButtonMorph>>actWhen: (in category 'submorphs - add/remove') ----- - ----- Method: SimpleButtonMorph>>actWhen: (in category 'submorphs-add/remove') ----- actWhen: condition "Accepts symbols: #buttonDown, #buttonUp, and #whilePressed, #startDrag" actWhen := condition. actWhen == #startDrag ifFalse: [self on: #startDrag send: nil to: nil ] ifTrue:[self on: #startDrag send: #doButtonAction to: self].!
Item was changed: + ----- Method: SimpleHaloMorph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: SimpleHaloMorph>>delete (in category 'submorphs-add/remove') ----- delete
self target hasHalo: false. super delete.!
Item was changed: ----- Method: SimpleHaloMorph>>initialize (in category 'initialization') ----- initialize
super initialize. + self morphicLayerNumber: self class haloLayer. "Each halo is a (kind of global) overlay that should not be bothered with the world's current layout policy. For example, a halo must match the target's bounds, which can be any inner part of the graphical hierarchy." self disableLayout: true.!
Item was changed: + ----- Method: SystemProgressMorph>>dismissViaHalo (in category 'submorphs - add/remove') ----- - ----- Method: SystemProgressMorph>>dismissViaHalo (in category 'submorphs-add/remove') ----- dismissViaHalo self class reset!
Item was changed: ----- Method: SystemProgressMorph>>initialize (in category 'initialization') ----- initialize super initialize. activeSlots := 0. bars := Array new: 10. labels := Array new: 10. lock := Semaphore forMutualExclusion. self setDefaultParameters; + morphicLayerNumber: self class progressLayer; - setProperty: #morphicLayerNumber toValue: self morphicLayerNumber; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #topCenter; cellGap: 5; listCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: Inset; minWidth: 150!
Item was removed: - ----- Method: SystemProgressMorph>>morphicLayerNumber (in category 'initialization') ----- - morphicLayerNumber - "progress morphs are behind menus and balloons, but in front of most other stuff" - ^self valueOfProperty: #morphicLayerNumber ifAbsent: [12]. - !
Item was changed: + ----- Method: TextMorph>>addMorphFront:fromWorldPosition: (in category 'submorphs - add/remove') ----- - ----- Method: TextMorph>>addMorphFront:fromWorldPosition: (in category 'submorphs-add/remove') ----- addMorphFront: aMorph fromWorldPosition: wp "Overridden for more specific re-layout and positioning" aMorph textAnchorProperties anchorLayout == #document ifFalse:[^ self anchorMorph: aMorph at: wp type: aMorph textAnchorProperties anchorLayout]. self addMorphFront: aMorph. !
Item was changed: + ----- Method: TextMorph>>delete (in category 'submorphs - add/remove') ----- - ----- Method: TextMorph>>delete (in category 'submorphs-add/remove') ----- delete predecessor ifNotNil: [predecessor setSuccessor: successor]. successor ifNotNil: [successor setPredecessor: predecessor. successor recomposeChain]. super delete!
Item was changed: + ----- Method: TextMorph>>goBehind (in category 'submorphs - add/remove') ----- - ----- Method: TextMorph>>goBehind (in category 'submorphs-add/remove') ----- goBehind "We need to save the container, as it knows about fill and run-around" | cont | container ifNil: [^ super goBehind]. self releaseParagraph. "Cause recomposition" cont := container. "Save the container" super goBehind. "This will change owner, nilling the container" container := cont. "Restore the container" self changed!
Item was changed: + ----- Method: ThreePhaseButtonMorph>>actWhen: (in category 'submorphs - add/remove') ----- - ----- Method: ThreePhaseButtonMorph>>actWhen: (in category 'submorphs-add/remove') ----- actWhen: condition "Accepts symbols: #buttonDown, #buttonUp, and #whilePressed" actWhen := condition!
Item was added: + ----- Method: TransformMorph>>morphicLayerNumber (in category 'submorphs - layers') ----- + morphicLayerNumber + + ^ self hasSubmorphs + ifFalse: [super morphicLayerNumber] + ifTrue: [self firstSubmorph morphicLayerNumber]!
Item was added: + ----- Method: TransformMorph>>morphicLayerNumber: (in category 'submorphs - layers') ----- + morphicLayerNumber: aNumber + + ^ self hasSubmorphs + ifFalse: [super morphicLayerNumber: aNumber] + ifTrue: [self firstSubmorph morphicLayerNumber: aNumber]!
Item was changed: + ----- Method: TransformationMorph>>replaceSubmorph:by: (in category 'submorphs - add/remove') ----- - ----- Method: TransformationMorph>>replaceSubmorph:by: (in category 'submorphs-add/remove') ----- replaceSubmorph: oldMorph by: newMorph | t b | t := transform. b := bounds. super replaceSubmorph: oldMorph by: newMorph. transform := t. bounds := b. self layoutChanged!
Item was added: + ----- Method: TranslucentProgessMorph>>initialize (in category 'initialization') ----- + initialize + + super initialize. + self morphicLayerNumber: self class progressLayer. !
Item was removed: - ----- Method: TranslucentProgessMorph>>morphicLayerNumber (in category 'WiW support') ----- - morphicLayerNumber - - "helpful for insuring some morphs always appear in front of or behind others. - smaller numbers are in front" - - ^self valueOfProperty: #morphicLayerNumber ifAbsent: [12]. - - "progress morphs are behind menus and balloons, but in front of most other stuff"!
Item was changed: + (PackageInfo named: 'Morphic') postscript: 'PasteUpMorph allInstances do: [:m | m isFlap ifTrue: [m morphicLayerNumber: Morph navigatorLayer]]. + TheWorldMainDockingBar updateInstances. + SystemProgressMorph reset. + self currentWorld reorderSubmorphsInLayers.'! - (PackageInfo named: 'Morphic') postscript: '"Turn on Morphic drawing again." - Project current world removeProperty: #shouldDisplayWorld.'!