[squeak-dev] The Trunk: MorphicExtras-mt.285.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Feb 26 14:47:17 UTC 2021


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

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

Name: MorphicExtras-mt.285
Author: mt
Time: 26 February 2021, 3:47:14.471955 pm
UUID: a3e97393-d97b-684b-b584-abde4e302510
Ancestors: MorphicExtras-mt.284

Complements Morphic-mt.1726

=============== Diff against MorphicExtras-mt.284 ===============

Item was changed:
+ ----- Method: BookMorph>>abandon (in category 'submorphs - add/remove') -----
- ----- Method: BookMorph>>abandon (in category 'submorphs-add/remove') -----
  abandon
  	"Like delete, but we really intend not to use this morph again.  Make the page cache release the page object."
  
  	
  	self delete.
  	pages do: [:aPage | | pg |
  		(pg := aPage sqkPage) ifNotNil: [
  			pg contentsMorph == aPage ifTrue: [
  					pg contentsMorph: nil]]].!

Item was changed:
+ ----- Method: BookMorph>>allNonSubmorphMorphs (in category 'submorphs - accessing') -----
- ----- Method: BookMorph>>allNonSubmorphMorphs (in category 'submorphs-accessing') -----
  allNonSubmorphMorphs
  	"Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy.  Especially the non-showing pages in BookMorphs.    (As needed, make a variant of this that brings in all pages that are not in memory.)"
  
  	| coll |
  	coll := OrderedCollection new.
  	pages do: [:pg |
  		pg isInMemory ifTrue: [
  			pg == currentPage ifFalse: [coll add: pg]]].
  	^ coll!

Item was changed:
+ ----- Method: BouncingAtomsMorph>>addMorphFront: (in category 'submorphs - add/remove') -----
- ----- Method: BouncingAtomsMorph>>addMorphFront: (in category 'submorphs-add/remove') -----
  addMorphFront: aMorph
  	"Called by the 'embed' meta action. We want non-atoms to go to the back."
  	"Note: A user would not be expected to write this method. However, a sufficiently advanced user (e.g, an e-toy author) might do something equivalent by overridding the drag-n-drop messages when they are implemented."
  
  	(aMorph isMemberOf: AtomMorph)
  		ifTrue: [super addMorphFront: aMorph]
  		ifFalse: [super addMorphBack: aMorph].!

Item was changed:
+ ----- Method: EmbeddedWorldBorderMorph>>morphicLayerNumber (in category 'submorphs - layers') -----
- ----- Method: EmbeddedWorldBorderMorph>>morphicLayerNumber (in category 'WiW support') -----
  morphicLayerNumber
+ 	"Embedded worlds come in front of other worlds' Project navigation morphs"
  
+ 	^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer - 1]	
+ 	!
- 	"helpful for insuring some morphs always appear in front of or behind others.
- 	smaller numbers are in front"
- 
- 	^20		"Embedded worlds come in front of other worlds' Project navigation morphs"!

Item was changed:
+ ----- Method: FlapTab>>dismissViaHalo (in category 'submorphs - add/remove') -----
- ----- Method: FlapTab>>dismissViaHalo (in category 'submorphs-add/remove') -----
  dismissViaHalo
  	"Dismiss the receiver (and its referent), unless it resists"
  
  	self resistsRemoval ifTrue:
  		[(UIManager default chooseFrom: #( 'Yes' 'Um, no, let me reconsider') 
  				title: 'Really throw this flap away?') = 2 ifFalse: [^ self]].
  
  	referent delete.
  	self delete!

Item was changed:
+ ----- Method: FlapTab>>morphicLayerNumber (in category 'submorphs - layers') -----
- ----- Method: FlapTab>>morphicLayerNumber (in category 'WiW support') -----
  morphicLayerNumber
+ 
+ 	^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer]!
- 	^self flapShowing ifTrue: [26] ifFalse: [25] 	"As navigators"!

Item was changed:
  ----- Method: Flaps class>>newPaintingFlap (in category 'predefined flaps') -----
  newPaintingFlap
  	"Add a flap with the paint palette in it"
  
  	| aFlap aFlapTab  |
  	"Flaps reinstateDefaultFlaps. Flaps addPaintingFlap"
  
  	aFlap := PasteUpMorph new borderWidth: 0.
  	aFlap color: Color transparent.
  	aFlap layoutPolicy: TableLayout new.
  	aFlap hResizing: #shrinkWrap.
  	aFlap vResizing: #shrinkWrap.
  	aFlap cellPositioning: #topLeft.
  	aFlap clipSubmorphs: false.
  
  	aFlap beSticky. "really?!!"
  	aFlap addMorphFront: PaintBoxMorph new.
+ 	aFlap beFlap: true.
- 	aFlap setProperty: #flap toValue: true.
  	aFlap fullBounds. "force layout"
  
  	aFlapTab := FlapTab new referent: aFlap.
  	aFlapTab setNameTo: 'Painting' translated.
  	aFlapTab setProperty: #priorWording toValue: 'Paint' translated.
  	aFlapTab useGraphicalTab.
  	aFlapTab removeAllMorphs.
  	aFlapTab setProperty: #paintingFlap toValue: true.
  	aFlapTab addMorphFront: 
  		"(SketchMorph withForm: (ScriptingSystem formAtKey: #PaintingFlapPic))"
  		self paintFlapButton.
  	aFlapTab cornerStyle: #rounded.
  	aFlapTab edgeToAdhereTo: #right.
  	aFlapTab setToPopOutOnDragOver: false.
  	aFlapTab setToPopOutOnMouseOver: false.
  	aFlapTab on: #mouseUp send: #startOrFinishDrawing: to: aFlapTab.
  	aFlapTab setBalloonText:'Click here to start or finish painting.' translated.
  
  	aFlapTab fullBounds. "force layout"
  	aFlapTab position: (0 at 6).
  	self currentWorld addMorphFront: aFlapTab.  
  	^ aFlapTab!

Item was changed:
+ ----- Method: FloatingBookControlsMorph>>morphicLayerNumber (in category 'submorphs - layers') -----
- ----- Method: FloatingBookControlsMorph>>morphicLayerNumber (in category 'WiW support') -----
  morphicLayerNumber
+ 	"page controls are behind menus and balloons, but in front of most other stuff"
+ 	
+ 	^ 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"
- 
- 	^23		"page controls are behind menus and balloons, but in front of most other stuff"!

Item was changed:
+ ----- Method: ProjectNavigationMorph>>morphicLayerNumber (in category 'submorphs - layers') -----
- ----- Method: ProjectNavigationMorph>>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"
- 
- 	^mouseInside == true ifTrue: [26] ifFalse: [25]
- 
- 		"Navigators are behind menus and balloons, but in front of most other stuff"!

Item was changed:
  ----- Method: ProjectNavigationMorph>>soundDownEvt:morph: (in category '*MorphicExtras-Sound') -----
  soundDownEvt: a morph: b
  
  	soundSlider ifNotNil: [soundSlider delete].
  	(soundSlider := RectangleMorph new)
+ 		morphicLayerNumber: self class frontmostLayer;
- 		setProperty: #morphicLayerNumber toValue: 1;
  		extent: b width @ (b width * 3);
  		color: self colorForButtons;
  		borderStyle: BorderStyle raised;
  		bottomLeft: b boundsInWorld origin.
  	soundSlider addMorph: (
  		RectangleMorph new
  			color: self colorForButtons;
  			borderColor: #raised;
  			extent: b width @ 8;
  			center: soundSlider center x @ 
  				(soundSlider bottom - (soundSlider height * self getSoundVolume) asInteger)
  	).
  	soundSlider openInWorld.!

Item was changed:
+ ----- Method: ReferenceMorph>>allNonSubmorphMorphs (in category 'submorphs - accessing') -----
- ----- Method: ReferenceMorph>>allNonSubmorphMorphs (in category 'submorphs-accessing') -----
  allNonSubmorphMorphs
  	"we hold extra morphs"
  
  	^ Array with: referent!

Item was changed:
+ ----- Method: ScreeningMorph>>addMorph: (in category 'submorphs - add/remove') -----
- ----- Method: ScreeningMorph>>addMorph: (in category 'submorphs-add/remove') -----
  addMorph: aMorph
  
  	| f |
  	super addMorph: aMorph.
  	submorphs size <= 2 ifTrue:
  		[self bounds: submorphs last bounds].
  	submorphs size = 2 ifTrue:
  		["The screenMorph has just been added.
  		Choose as the passingColor the center color of that morph"
  		f := self screenMorph imageForm.
  		passingColor := f colorAt: f boundingBox center.
  		passElseBlock := true]!

Item was added:
+ ----- Method: SketchEditorMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	forEachHand := Dictionary new.!

Item was changed:
  ----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph:paintBoxPosition: (in category 'initialization') -----
  initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: aPosition
  	"NB: if aPosition is nil, then it's assumed that the paintbox is obtained from a flap or some such, so do nothing special regarding a palette in this case.  The palette needs already to be in the world for this to work."
  	| w  |
  	(w := aPasteUpMorph world) addMorphInLayer: self.	"in back of palette"
  	enclosingPasteUpMorph := aPasteUpMorph.
  	hostView := aSketchMorph.  "may be ownerless"
  	self bounds: boundsToUse.
  	palette := w paintBox focusMorph: self.
  	palette beStatic.		"give Nebraska whatever help we can"
  	palette addWeakDependent: self.
+ 	self morphicLayerNumber: self class dialogLayer + 1.
+ 	palette morphicLayerNumber: self class dialogLayer.
  	aPosition ifNotNil:
  		[w addMorphFront: palette.  "bring to front"
  		palette position: aPosition.
  		palette beSupersized.
  		self flag: #hacky. "mt: That super-sizing with a flex shell is awkward. Need to fix."
  		palette owner bounds: (palette owner bounds translatedToBeWithin: self world bounds)].
  	paintingForm := Form extent: bounds extent depth: w assuredCanvas depth.
  	self dimTheWindow.
  	self addRotationScaleHandles.
  	aSketchMorph ifNotNil:
  		[
  		aSketchMorph form
  			displayOn: paintingForm
  			at: (hostView boundsInWorld origin - bounds origin - hostView form offset)
  			clippingBox: (0 at 0 extent: paintingForm extent)
  			rule: Form over
  			fillColor: nil.  "assume they are the same depth".
  			undoBuffer := paintingForm deepCopy.
  		rotationCenter := aSketchMorph rotationCenter]!

Item was removed:
- ----- Method: SketchEditorMorph>>morphicLayerNumber (in category 'WiW support') -----
- morphicLayerNumber
- 	"Place the painting behind the paint palette"
- 
- 	^ 28!

Item was changed:
+ ----- Method: StringButtonMorph>>actWhen: (in category 'submorphs - add/remove') -----
- ----- Method: StringButtonMorph>>actWhen: (in category 'submorphs-add/remove') -----
  actWhen: aSymbol
  	"Set the condition under which to invoke my action to one of: #buttonDown, #buttonUp, and #whilePressed."
  
  	actWhen := aSymbol.
  !

Item was changed:
+ ----- Method: TabbedPalette>>replaceSubmorph:by: (in category 'submorphs - add/remove') -----
- ----- Method: TabbedPalette>>replaceSubmorph:by: (in category 'submorphs-add/remove') -----
  replaceSubmorph: oldMorph by: newMorph
  	super replaceSubmorph: oldMorph by: newMorph.
  	oldMorph == currentPage ifTrue:
  		[currentPage := newMorph]!

Item was changed:
+ ----- Method: ThreadNavigationMorph>>morphicLayerNumber (in category 'submorphs - layers') -----
- ----- Method: ThreadNavigationMorph>>morphicLayerNumber (in category 'private') -----
  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"
- 
- 	^15		"Navigators are behind menus and balloons, but in front of most other stuff"!

Item was changed:
+ ----- Method: ViewerFlapTab>>allNonSubmorphMorphs (in category 'submorphs - accessing') -----
- ----- Method: ViewerFlapTab>>allNonSubmorphMorphs (in category 'submorphs-accessing') -----
  allNonSubmorphMorphs
  	"Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy.  Especially the non-showing pages in BookMorphs."
  
  	^ flapShowing 
  		ifTrue: [#()]
  		ifFalse: [Array with: referent]!



More information about the Squeak-dev mailing list