The Trunk: MorphicExtras-mt.270.mcz

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

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

Name: MorphicExtras-mt.270
Author: mt
Time: 14 February 2020, 6:04:34.384586 pm
UUID: 22028282-82e8-a142-9a8a-ac907536aa13
Ancestors: MorphicExtras-mt.269

For Etoys. Fixes scaling, positioning, and closing of sketch editor (and paint box).

=============== Diff against MorphicExtras-mt.269 ===============

Item was changed:
  ----- Method: PaintBoxMorph>>addTextualLabels (in category 'initialization') -----
  addTextualLabels
+ "Translate button labels. Use unscaled font because of #beSupersized."
- "translate button labels"
 
  #('keep:' 'undo:' 'clear:' 'toss:') with: #('KEEP' 'UNDO' 'CLEAR' 'TOSS') do: [:extName :label |
  | button |
  button := submorphs detect: [:m | m externalName = extName] ifNone: [nil].
  button ifNotNil: [
  button removeAllMorphs.
  button addMorph: (TextMorph new
  contentsWrapped: (Text string: label translated
  attributes: {
  TextAlignment centered.
  TextEmphasis bold.
+ TextFontReference toFont: (StrikeFont familyName: 'Bitmap DejaVu Sans' size: 12)
+ });
- TextFontReference toFont:
- (Preferences standardPaintBoxButtonFont)});
  bounds: (button bounds translateBy: 0@3);
  lock)]]!

Item was added:
+ ----- Method: PaintBoxMorph>>delete (in category 'actions') -----
+ delete
+
+ ^ self isSupersized
+ ifTrue: [self owner delete]
+ ifFalse: [super delete]!

Item was added:
+ ----- Method: PaintBoxMorph>>isSupersized (in category 'initialization') -----
+ isSupersized
+
+ ^ self isFlexed!

Item was changed:
  ----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
  initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
  "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
 
+ | paintBoxBounds worldBounds |
+ self world paintingFlapTab ifNotNil: [:tab |
+ tab showFlap.
+ ^ self
+ initializeFor: aSketchMorph
+ inBounds: boundsToUse
+ pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: nil].
- | aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
- (aTab := self world paintingFlapTab) ifNotNil:
- [aTab showFlap.
- ^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
 
  self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+
+ paintBoxBounds := self world paintBox bounds.
- aPaintBox := self world paintBox.
  worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
 
+ aPasteUpMorph standardPalette ifNotNil: [:palette | palette showNoPalette].
- aPosition := (aPal := aPasteUpMorph standardPalette)
- ifNotNil:
- [aPal showNoPalette.
- aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
- ifNil:
- [boundsToUse topRight].
 
- newOrigin := ((aPosition x  + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- ifTrue:  "will fit to right of aPasteUpMorph"
- [aPosition]
- ifFalse:  "won't fit to right, try left"
- [boundsToUse topLeft - (requiredWidth @ 0)].
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds extent.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
-
-
  self initializeFor: aSketchMorph inBounds: boundsToUse
  pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent)
+ translatedToBeWithin: worldBounds) topLeft.
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
  !

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.
  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)].
- palette beSupersized].
  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@0 extent: paintingForm extent)
  rule: Form over
  fillColor: nil.  "assume they are the same depth".
  undoBuffer := paintingForm deepCopy.
  rotationCenter := aSketchMorph rotationCenter]!