The Trunk: Morphic-mt.1029.mcz

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

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

Name: Morphic-mt.1029
Author: mt
Time: 5 November 2015, 10:36:01.14 am
UUID: e3c2c951-9b94-4dd6-af36-316dd0426b1d
Ancestors: Morphic-mt.1028

Extracts the essentials from HaloMorph into SimpleHaloMorph to make extension points more obvious. HaloMorph inherits from SimpleHaloMorph and extends this basic/simple halo mechanism.

=============== Diff against Morphic-mt.1028 ===============

Item was changed:
+ SimpleHaloMorph subclass: #HaloMorph
+ instanceVariableNames: 'innerTarget angleOffset minExtent growingOrRotating directionArrowAnchor haloBox simpleMode originalExtent'
- Morph subclass: #HaloMorph
- instanceVariableNames: 'target innerTarget positionOffset angleOffset minExtent growingOrRotating directionArrowAnchor haloBox simpleMode originalExtent'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Morphic-Widgets'!
 
  !HaloMorph commentStamp: '<historical>' prior: 0!
  This morph provides a halo of handles for its target morph. Dragging, duplicating, rotating, and resizing to be done by mousing down on the appropriate handle. There are also handles for help and for a menu of infrequently used operations.!

Item was changed:
+ ----- Method: HaloMorph>>blueButtonDown: (in category 'events') -----
- ----- Method: HaloMorph>>blueButtonDown: (in category 'meta-actions') -----
  blueButtonDown: event
+
+ self isMagicHalo
+ ifFalse: [super blueButtonDown: event]
+ ifTrue: [
+ self isMagicHalo: false.
+ self magicAlpha: 1.0].!
- "Transfer the halo to the next likely recipient"
- target ifNil:[^self delete].
- event hand obtainHalo: self.
- positionOffset := event position - (target point: target position in: owner).
- self isMagicHalo ifTrue:[
- self isMagicHalo: false.
- ^self magicAlpha: 1.0].
- "wait for drags or transfer"
- event hand
- waitForClicksOrDrag: self
- event: event
- selectors: { #transferHalo:. nil. nil. #dragTarget:. }
- threshold: HandMorph dragThreshold!

Item was changed:
+ ----- Method: HaloMorph>>containsPoint:event: (in category 'events') -----
- ----- Method: HaloMorph>>containsPoint:event: (in category 'events-processing') -----
  containsPoint: aPoint event: anEvent
  "Blue buttons are handled by the halo"
  (anEvent isMouse and:[anEvent isMouseDown and:[anEvent blueButtonPressed]])
  ifFalse:[^super containsPoint: aPoint event: anEvent].
  ^bounds containsPoint: anEvent position!

Item was changed:
  ----- 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"
 
- target ifNotNil:
- [target hasHalo: false].
  self acceptNameEdit.
  self isMagicHalo: false.
+
  Preferences haloTransitions
+ ifFalse: [super delete]
+ ifTrue: [
+ self
+ stopStepping;
+ startStepping;
+ startSteppingSelector: #fadeOutFinally].
+ !
- ifTrue:
- [self stopStepping; startStepping.
- self startSteppingSelector: #fadeOutFinally]
- ifFalse:
- [super delete]!

Item was added:
+ ----- Method: HaloMorph>>doResizeTarget: (in category 'dragging or resizing') -----
+ doResizeTarget: evt
+
+ | oldExtent newExtent newPosition |
+ newExtent := originalExtent + (evt position - positionOffset * 2).
+
+ (newExtent x > 1 and: [newExtent y > 1])
+ ifTrue: [
+ oldExtent := target extent.
+ target setExtentFromHalo: (newExtent min: owner extent).
+ newPosition := target position - (target extent - oldExtent // 2).
+ newPosition := (newPosition x min: owner extent x - newExtent x max: 0) @ (newPosition y min: owner extent y - newExtent y max: 0).
+ target setConstrainedPosition: newPosition hangOut: true].
+
+ self bounds: self target worldBoundsForHalo.!

Item was removed:
- ----- Method: HaloMorph>>dragTarget: (in category 'events') -----
- dragTarget: event
- "Begin dragging the target"
- | thePoint |
- event controlKeyPressed ifTrue: [^self growTarget: event].
- growingOrRotating := false.
- thePoint := target point: event position - positionOffset from: owner.
- target setConstrainedPosition: thePoint hangOut: true.
- event hand newMouseFocus: self.!

Item was removed:
- ----- Method: HaloMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw this morph only if it has no target."
- target isNil
- ifTrue: [^ super drawOn: aCanvas].
- (Preferences showBoundsInHalo
- and: [target isWorldMorph not])
- ifTrue: [| boundsColor |
- boundsColor := MenuMorph menuSelectionColor
- ifNil: [Color blue].
- aCanvas
- frameAndFillRectangle: self bounds
- fillColor: Color transparent
- borderWidth: 2
- borderColor:
- (boundsColor isTranslucent
- ifTrue: [boundsColor]
- ifFalse: [boundsColor alpha: 0.8])]!

Item was removed:
- ----- Method: HaloMorph>>growTarget: (in category 'events') -----
- growTarget: event
- "Begin resizing the target"
- growingOrRotating := true.
- positionOffset := event position.
- originalExtent := target extent.
- self removeAllHandlesBut: nil.
- event hand newMouseFocus: self.
- event hand addMouseListener: self. "add handles back on mouse-up"!

Item was changed:
+ ----- Method: HaloMorph>>handleListenEvent: (in category 'events') -----
- ----- Method: HaloMorph>>handleListenEvent: (in category 'events-processing') -----
  handleListenEvent: anEvent
  "We listen for possible drop events here to add back those handles after a dup/grab operation"
 
  (anEvent isMouse and:[anEvent isMove not]) ifFalse:[^ self]. "not interested"
  anEvent hand removeMouseListener: self. "done listening"
  (self world ifNil: [target world]) ifNil: [^ self].
  self addHandles  "and get those handles back"!

Item was removed:
- ----- Method: HaloMorph>>handlerForBlueButtonDown: (in category 'meta-actions') -----
- handlerForBlueButtonDown: anEvent
- "Blue button was clicked within the receiver"
- ^self!

Item was changed:
+ ----- Method: HaloMorph>>mouseMove: (in category 'events') -----
- ----- Method: HaloMorph>>mouseMove: (in category 'event handling') -----
  mouseMove: evt
+
- "Drag our target around or resize it"
  growingOrRotating
+ ifTrue: [self doResizeTarget: evt]
+ ifFalse: [self doDragTarget: evt].!
- ifTrue: [
- | oldExtent newExtent newPosition |
- newExtent := originalExtent + (evt position - positionOffset * 2).
- (newExtent x > 1 and: [newExtent y > 1])
- ifTrue: [
- oldExtent := target extent.
- target setExtentFromHalo: (newExtent min: owner extent).
- newPosition := target position - (target extent - oldExtent // 2).
- newPosition := (newPosition x min: owner extent x - newExtent x max: 0) @ (newPosition y min: owner extent y - newExtent y max: 0).
- target setConstrainedPosition: newPosition hangOut: true]]
- ifFalse: [
- | thePoint |
- thePoint := target point: (evt position - positionOffset) from: owner.
- target setConstrainedPosition: thePoint hangOut: true.
- ]!

Item was added:
+ ----- Method: HaloMorph>>popUpFor:at:hand: (in category 'pop up') -----
+ popUpFor: morph at: position hand: hand
+  
+ super popUpFor: morph at: position hand: hand.
+
+ self startStepping.
+ (Preferences haloTransitions or: [self isMagicHalo])
+ ifTrue: [
+ self magicAlpha: 0.0.
+ self startSteppingSelector: #fadeInInitially].!

Item was removed:
- ----- Method: HaloMorph>>popUpFor:event: (in category 'events') -----
- popUpFor: aMorph event: evt
- "This message is sent by morphs that explicitly request the halo on a button click. Note: anEvent is in aMorphs coordinate frame."
-
- | hand anEvent |
- self flag: #workAround. "We should really have some event/hand here..."
- anEvent := evt isNil
- ifTrue:
- [hand := aMorph world activeHand.
- hand ifNil: [hand := aMorph world primaryHand].
- hand lastEvent transformedBy: (aMorph transformedFrom: nil)]
- ifFalse:
- [hand := evt hand.
- evt].
- self target: aMorph.
- hand halo: self.
- hand world addMorphFront: self.
- positionOffset := anEvent position
- - (aMorph point: aMorph position in: owner).
- self startStepping.
- (Preferences haloTransitions or: [self isMagicHalo])
- ifTrue:
- [self magicAlpha: 0.0.
- self startSteppingSelector: #fadeInInitially]!

Item was changed:
+ ----- Method: HaloMorph>>popUpMagicallyFor:hand: (in category 'pop up') -----
- ----- Method: HaloMorph>>popUpMagicallyFor:hand: (in category 'events') -----
  popUpMagicallyFor: aMorph hand: aHand
  "Programatically pop up a halo for a given hand."
+
+ super
+ popUpMagicallyFor: aMorph
+ hand: aHand.
+
+ Preferences magicHalos
+ ifTrue: [self isMagicHalo: true].
+ (Preferences haloTransitions not and: [self isMagicHalo])
+ ifTrue: [self magicAlpha: 0.2].
+ !
- Preferences magicHalos ifTrue:[
- self isMagicHalo: true.
- self magicAlpha: 0.2].
- self target: aMorph.
- aHand halo: self.
- aHand world addMorphFront: self.
- Preferences haloTransitions ifTrue:[
- self magicAlpha: 0.0.
- self startSteppingSelector: #fadeInInitially.
- ].
- positionOffset := aHand position - (aMorph point: aMorph position in: owner).
- self startStepping.!

Item was removed:
- ----- Method: HaloMorph>>rejectsEvent: (in category 'events-processing') -----
- rejectsEvent: anEvent
- "Return true to reject the given event. Rejecting an event means neither the receiver nor any of it's submorphs will be given any chance to handle it."
- (super rejectsEvent: anEvent) ifTrue:[^true].
- anEvent isDropEvent ifTrue:[^true]. "never attempt to drop on halos"
- ^false!

Item was changed:
+ ----- Method: HaloMorph>>startDrag:with: (in category 'private') -----
- ----- Method: HaloMorph>>startDrag:with: (in category 'dropping/grabbing') -----
  startDrag: evt with: dragHandle
  "Drag my target without removing it from its owner."
 
  | itsOwner |
  self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle.
  positionOffset := dragHandle center - (target point: target position in: owner).
 
  ((itsOwner := target topRendererOrSelf owner) notNil and:
  [itsOwner automaticViewing]) ifTrue:
  [target openViewerForArgument]!

Item was added:
+ ----- Method: HaloMorph>>startDragTarget: (in category 'dragging or resizing') -----
+ startDragTarget: event
+
+ event controlKeyPressed
+ ifTrue: [self startResizeTarget: event]
+ ifFalse: [
+ growingOrRotating := false.
+ super startDragTarget: event].!

Item was added:
+ ----- Method: HaloMorph>>startResizeTarget: (in category 'dragging or resizing') -----
+ startResizeTarget: event
+ "Begin resizing the target"
+ growingOrRotating := true.
+ positionOffset := event position.
+ originalExtent := target extent.
+ self removeAllHandlesBut: nil.
+ event hand newMouseFocus: self.
+ event hand addMouseListener: self. "add handles back on mouse-up"!

Item was removed:
- ----- Method: HaloMorph>>staysUpWhenMouseIsDownIn: (in category 'events') -----
- staysUpWhenMouseIsDownIn: aMorph
- ^ ((aMorph == target) or: [aMorph hasOwner: self])!

Item was changed:
+ ----- Method: HaloMorph>>stepTime (in category 'stepping') -----
- ----- Method: HaloMorph>>stepTime (in category 'testing') -----
  stepTime
 
  ^ 0  "every cycle"
  !

Item was removed:
- ----- Method: HaloMorph>>target (in category 'accessing') -----
- target
-
- ^ target
- !

Item was removed:
- ----- Method: HaloMorph>>transferHalo: (in category 'events') -----
- transferHalo: event
- "Transfer the halo to the next likely recipient"
- target ifNil:[^self delete].
- target transferHalo: (event transformedBy: (target transformedFrom: self)) from: target.!

Item was changed:
+ ----- Method: HaloMorph>>wantsKeyboardFocusFor: (in category 'events') -----
- ----- Method: HaloMorph>>wantsKeyboardFocusFor: (in category 'event handling') -----
  wantsKeyboardFocusFor: aSubmorph
  "to allow the name to be edited in the halo in the old tty way; when we morphic-text-ize the name editing, presumably this method should be removed"
  ^ true!

Item was changed:
  ----- Method: Morph>>addHalo (in category 'halos and balloon help') -----
  addHalo
  "Invoke a halo programatically (e.g., not from a meta gesture)"
+
+ ^ self createHalo
+ popUpFor: self;
+ yourself!
- ^self addHalo: nil!

Item was changed:
  ----- Method: Morph>>addHalo: (in category 'halos and balloon help') -----
  addHalo: evt
+
+ ^ self createHalo
+ popUpFor: self event: evt;
+ yourself!
- | halo prospectiveHaloClass |
- prospectiveHaloClass := Smalltalk at: self haloClass ifAbsent: [HaloMorph].
- halo := prospectiveHaloClass new bounds: self worldBoundsForHalo.
- halo popUpFor: self event: evt.
- ^halo!

Item was changed:
  ----- Method: Morph>>addMagicHaloFor: (in category 'halos and balloon help') -----
  addMagicHaloFor: aHand
+
+ aHand halo ifNotNil: [:halo |
+ halo target == self ifTrue:[^self].
+ halo isMagicHalo ifFalse:[^self]].
+
+ self createHalo
+ popUpMagicallyFor: self hand: aHand!
- | halo prospectiveHaloClass |
- aHand halo ifNotNil:[
- aHand halo target == self ifTrue:[^self].
- aHand halo isMagicHalo ifFalse:[^self]].
- prospectiveHaloClass := Smalltalk at: self haloClass ifAbsent: [HaloMorph].
- halo := prospectiveHaloClass new bounds: self worldBoundsForHalo.
- halo popUpMagicallyFor: self hand: aHand.!

Item was changed:
  ----- Method: Morph>>blueButtonDown: (in category 'meta-actions') -----
  blueButtonDown: anEvent
  "Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
  | h tfm doNotDrag |
  h := anEvent hand halo.
  "Prevent wrap around halo transfers originating from throwing the event back in"
  doNotDrag := false.
  h ifNotNil:[
  (h innerTarget == self) ifTrue:[doNotDrag := true].
  (h innerTarget hasOwner: self) ifTrue:[doNotDrag := true].
  (self hasOwner: h target) ifTrue:[doNotDrag := true]].
 
  tfm := (self transformedFrom: nil) inverseTransformation.
 
  "cmd-drag on flexed morphs works better this way"
  h := self addHalo: (anEvent transformedBy: tfm).
  h ifNil: [^ self].
  doNotDrag ifTrue:[^self].
  "Initiate drag transition if requested"
  anEvent hand
  waitForClicksOrDrag: h
  event: (anEvent transformedBy: tfm)
+ selectors: { nil. nil. nil. #startDragTarget:. }
- selectors: { nil. nil. nil. #dragTarget:. }
  threshold: HandMorph dragThreshold.
  "Pass focus explicitly here"
  anEvent hand newMouseFocus: h.!

Item was added:
+ ----- Method: Morph>>createHalo (in category 'halos and balloon help') -----
+ createHalo
+
+ ^ (Smalltalk at: self haloClass ifAbsent: [HaloMorph]) new
+ bounds: self worldBoundsForHalo
+ yourself!

Item was added:
+ Morph subclass: #SimpleHaloMorph
+ instanceVariableNames: 'target positionOffset'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Morphic-Widgets'!
+
+ !SimpleHaloMorph commentStamp: 'mt 11/5/2015 09:52' prior: 0!
+ This is a simple base class for halos in the system. It represents the minimal interface used to implement custom halo morphs.!

Item was added:
+ ----- Method: SimpleHaloMorph>>addHandles (in category 'construction') -----
+ addHandles
+ "This is an example for handles."
+
+ self addMorphFront: (IconicButton new
+ color: Color red muchLighter;
+ borderColor: Color red;
+ labelGraphic: MenuIcons smallCancelIcon;
+ target: self target;
+ actionSelector: #delete;
+ bottomRight: self topLeft;
+ yourself).!

Item was added:
+ ----- Method: SimpleHaloMorph>>blueButtonDown: (in category 'events') -----
+ blueButtonDown: event
+ "Transfer the halo to the next likely recipient"
+
+ self target ifNil: [^self delete].
+ event hand obtainHalo: self.
+
+ self positionOffset: (event position - (self target point: self target position in: self owner)).
+
+ "wait for drags or transfer"
+ event hand
+ waitForClicksOrDrag: self
+ event: event
+ selectors: { #transferHalo:. nil. nil. #startDragTarget:. }
+ threshold: HandMorph dragThreshold.!

Item was added:
+ ----- Method: SimpleHaloMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+
+ self target hasHalo: false.
+ super delete.!

Item was added:
+ ----- Method: SimpleHaloMorph>>doDragTarget: (in category 'dragging') -----
+ doDragTarget: event
+
+ self target
+ setConstrainedPosition: (self target point: (event position - self positionOffset) from: self owner)
+ hangOut: true.
+
+ self bounds: self target worldBoundsForHalo.!

Item was added:
+ ----- Method: SimpleHaloMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ "Draw this morph only if it has no target."
+
+ (Preferences showBoundsInHalo and: [self target isWorldMorph not])
+ ifTrue: [
+ | boundsColor |
+ boundsColor := MenuMorph menuSelectionColor
+ ifNil: [Color blue].
+ aCanvas
+ frameAndFillRectangle: self bounds
+ fillColor: Color transparent
+ borderWidth: 2
+ borderColor:
+ (boundsColor isTranslucent
+ ifTrue: [boundsColor]
+ ifFalse: [boundsColor alpha: 0.8])]!

Item was added:
+ ----- Method: SimpleHaloMorph>>handlerForBlueButtonDown: (in category 'events') -----
+ handlerForBlueButtonDown: anEvent
+ "Blue button was clicked within the receiver"
+ ^self!

Item was added:
+ ----- Method: SimpleHaloMorph>>innerTarget (in category 'accessing') -----
+ innerTarget
+ "If the target is merely a decorator for another morph, the inner target can be distiguished. Scroll panes, for example, could have their scrolled content as an inner target."
+
+ ^ self target!

Item was added:
+ ----- Method: SimpleHaloMorph>>isMagicHalo (in category 'testing') -----
+ isMagicHalo
+
+ ^ false!

Item was added:
+ ----- Method: SimpleHaloMorph>>mouseMove: (in category 'events') -----
+ mouseMove: event
+
+ self doDragTarget: event.!

Item was added:
+ ----- Method: SimpleHaloMorph>>popUpFor: (in category 'pop up') -----
+ popUpFor: morph
+
+ self
+ popUpFor: morph
+ hand: (morph world activeHand ifNil: [morph world primaryHand]).!

Item was added:
+ ----- Method: SimpleHaloMorph>>popUpFor:at:hand: (in category 'pop up') -----
+ popUpFor: morph at: position hand: hand
+
+ self target: morph.
+
+ hand halo: self.
+ hand world addMorphFront: self.
+
+ self positionOffset: position - (morph point: morph position in: self owner).!

Item was added:
+ ----- Method: SimpleHaloMorph>>popUpFor:event: (in category 'pop up') -----
+ popUpFor: morph event: event
+
+ self
+ popUpFor: morph
+ at: event position
+ hand: event hand.!

Item was added:
+ ----- Method: SimpleHaloMorph>>popUpFor:hand: (in category 'pop up') -----
+ popUpFor: morph hand: hand
+
+ self
+ popUpFor: morph
+ at: (hand lastEvent transformedBy: (morph transformedFrom: nil))
+ hand: hand!

Item was added:
+ ----- Method: SimpleHaloMorph>>popUpMagicallyFor:hand: (in category 'pop up') -----
+ popUpMagicallyFor: morph hand: hand
+
+ self
+ popUpFor: morph
+ hand: hand.!

Item was added:
+ ----- Method: SimpleHaloMorph>>positionOffset (in category 'accessing') -----
+ positionOffset
+
+ ^ positionOffset!

Item was added:
+ ----- Method: SimpleHaloMorph>>positionOffset: (in category 'accessing') -----
+ positionOffset: aPoint
+
+ positionOffset := aPoint.!

Item was added:
+ ----- Method: SimpleHaloMorph>>rejectsEvent: (in category 'events') -----
+ rejectsEvent: anEvent
+ "Return true to reject the given event. Rejecting an event means neither the receiver nor any of it's submorphs will be given any chance to handle it."
+ (super rejectsEvent: anEvent) ifTrue:[^true].
+ anEvent isDropEvent ifTrue:[^true]. "never attempt to drop on halos"
+ ^false!

Item was added:
+ ----- Method: SimpleHaloMorph>>startDragTarget: (in category 'dragging') -----
+ startDragTarget: event
+
+ self positionOffset: (event position - (self target point: self target position in: self owner)).
+ event hand newMouseFocus: self.!

Item was added:
+ ----- Method: SimpleHaloMorph>>staysUpWhenMouseIsDownIn: (in category 'testing') -----
+ staysUpWhenMouseIsDownIn: aMorph
+ ^ ((aMorph == self target) or: [aMorph hasOwner: self])!

Item was added:
+ ----- Method: SimpleHaloMorph>>target (in category 'accessing') -----
+ target
+
+ ^ target ifNil: [target := Morph new]!

Item was added:
+ ----- Method: SimpleHaloMorph>>target: (in category 'accessing') -----
+ target: morph
+
+ target := morph.
+ morph hasHalo: true.
+ self addHandles.!

Item was added:
+ ----- Method: SimpleHaloMorph>>transferHalo: (in category 'pop up') -----
+ transferHalo: event
+ "Transfer the halo to the next likely recipient"
+
+ self target
+ transferHalo: (event transformedBy: (self target transformedFrom: self))
+ from: self target.!

Every morph can have its own kind of halo with custom functionality.



Best,
Marcel

> On 05-11-2015, at 1:30 AM, marcel.taeumel <[hidden email]> wrote:
>
> Every morph can have its own kind of halo with custom functionality.
>
> <http://forum.world.st/file/n4859328/simple-halo-morph.png>

Nice tweak. Now we just need documentation to make it practical to make our own halos; remember the Goldberg Dictum - “if it isn’t documented, it doesn’t exist”.




tim
--
tim Rowledge; [hidden email]; http://www.rowledge.org/tim
granary - old folks home

We could provide more halo classes as means of documentation. :-)

Best,
Marcel