The Trunk: Morphic-bp.1316.mcz

Bernhard Pieber uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-bp.1316.mcz

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

Name: Morphic-bp.1316
Author: bp
Time: 8 December 2016, 4:51:49.905664 pm
UUID: 0bc98a49-1277-44f5-a127-3c3320c198a9
Ancestors: Morphic-ul.1315, Morphic-bp.1065

merged feature to snap and resize SystemWindows to halves and quadrants of the display when dragged to its edges, only works once the "Drag To Edges" preference is set and fastDragWindowForMorphic is turned off

=============== Diff against Morphic-ul.1315 ===============

Item was changed:
  MorphicModel subclass: #SystemWindow
  instanceVariableNames: 'labelString stripes label closeBox collapseBox paneMorphs paneRects collapsedFrame fullFrame isCollapsed isActive isLookingFocused menuBox mustNotClose labelWidgetAllowance updatablePanes allowReframeHandles labelArea expandBox'
+ classVariableNames: 'ClickOnLabelToEdit CloseBoxFrame CloseBoxImageFlat CloseBoxImageGradient CollapseBoxImageFlat CollapseBoxImageGradient DoubleClickOnLabelToExpand DragToEdges ExpandBoxFrame ExpandBoxImageFlat ExpandBoxImageGradient FocusFollowsMouse GradientWindow HideExpandButton MenuBoxFrame MenuBoxImageFlat MenuBoxImageGradient ResizeAlongEdges ReuseWindows RoundedWindowCorners TopWindow WindowTitleActiveOnFirstClick WindowsRaiseOnClick'
- classVariableNames: 'ClickOnLabelToEdit CloseBoxFrame CloseBoxImageFlat CloseBoxImageGradient CollapseBoxImageFlat CollapseBoxImageGradient DoubleClickOnLabelToExpand ExpandBoxFrame ExpandBoxImageFlat ExpandBoxImageGradient FocusFollowsMouse GradientWindow HideExpandButton MenuBoxFrame MenuBoxImageFlat MenuBoxImageGradient ResizeAlongEdges ReuseWindows RoundedWindowCorners TopWindow WindowTitleActiveOnFirstClick WindowsRaiseOnClick'
  poolDictionaries: ''
  category: 'Morphic-Windows'!
 
  !SystemWindow commentStamp: '<historical>' prior: 0!
  SystemWindow is the Morphic equivalent of StandardSystemView -- a labelled container for rectangular views, with iconic facilities for close, collapse/expand, and resizing.
 
  The attribute onlyActiveOnTop, if set to true (and any call to activate will set this), determines that only the top member of a collection of such windows on the screen shall be active.  To be not active means that a mouse click in any region will only result in bringing the window to the top and then making it active.!

Item was added:
+ ----- Method: SystemWindow class>>dragToEdges (in category 'preferences') -----
+ dragToEdges
+ <preference: 'Drag To Edges'
+ category: 'windows'
+ description: 'When true, windows snap and resize to corners and edges of the Display.'
+ type: #Boolean>
+ ^DragToEdges ifNil: [false]!

Item was added:
+ ----- Method: SystemWindow class>>dragToEdges: (in category 'preferences') -----
+ dragToEdges: aBoolean
+ DragToEdges := aBoolean!

Item was changed:
  ----- Method: SystemWindow>>doFastFrameDrag: (in category 'events') -----
  doFastFrameDrag: grabPoint
  "Do fast frame dragging from the given point"
 
+ | offset newBounds outerWorldBounds clearArea |
- | offset newBounds outerWorldBounds |
  outerWorldBounds := self boundsIn: nil.
  offset := outerWorldBounds origin - grabPoint.
+ clearArea := ActiveWorld clearArea.
+ newBounds := outerWorldBounds newRectFrom: [:f |
+ | p selector |
+ p := Sensor cursorPoint.
+ (self class dragToEdges and: [(selector := self dragToEdgesSelectorFor: p in: clearArea) notNil])
+ ifTrue: [clearArea perform: selector]
+ ifFalse: [p + offset extent: outerWorldBounds extent]].
+ self bounds: newBounds; comeToFront!
- newBounds := outerWorldBounds newRectFrom: [:f |
- Sensor cursorPoint + offset extent: outerWorldBounds extent].
- self position: (self globalPointToLocal: newBounds topLeft); comeToFront!

Item was added:
+ ----- Method: SystemWindow>>dragToEdgeDistance (in category 'resize/collapse') -----
+ dragToEdgeDistance
+ ^10!

Item was added:
+ ----- Method: SystemWindow>>dragToEdgesSelectorFor:in: (in category 'resize/collapse') -----
+ dragToEdgesSelectorFor: p in: a
+ "answer first matching drag resize selector, if none is found, answer nil"
+ #(isPoint:nearTopLeftOf: isPoint:nearTopRightOf: isPoint:nearBottomLeftOf: isPoint:nearBottomRightOf: isPoint:nearTopOf: isPoint:nearBottomOf: isPoint:nearLeftOf: isPoint:nearRightOf:)
+ with: #(topLeftQuadrant topRightQuadrant bottomLeftQuadrant bottomRightQuadrant topHalf bottomHalf leftHalf rightHalf)
+ do: [:predicate :selector |
+ (self perform: predicate with: p with: a) ifTrue: [^selector]].
+ ^nil!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearBottomLeftOf: (in category 'resize/collapse') -----
+ isPoint: p nearBottomLeftOf: a
+ ^(self isPoint: p nearBottomOf: a) and: [self isPoint: p nearLeftOf: a]!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearBottomOf: (in category 'resize/collapse') -----
+ isPoint: p nearBottomOf: a
+ ^p y > (a bottom - self dragToEdgeDistance)!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearBottomRightOf: (in category 'resize/collapse') -----
+ isPoint: p nearBottomRightOf: a
+ ^(self isPoint: p nearBottomOf: a) and: [self isPoint: p nearRightOf: a]!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearLeftOf: (in category 'resize/collapse') -----
+ isPoint: p nearLeftOf: a
+ ^p x < (a left + self dragToEdgeDistance)!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearRightOf: (in category 'resize/collapse') -----
+ isPoint: p nearRightOf: a
+ ^p x > (a right - self dragToEdgeDistance)!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearTopLeftOf: (in category 'resize/collapse') -----
+ isPoint: p nearTopLeftOf: a
+ ^(self isPoint: p nearTopOf: a) and: [self isPoint: p nearLeftOf: a]!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearTopOf: (in category 'resize/collapse') -----
+ isPoint: p nearTopOf: a
+ ^p y < (a top + self dragToEdgeDistance)!

Item was added:
+ ----- Method: SystemWindow>>isPoint:nearTopRightOf: (in category 'resize/collapse') -----
+ isPoint: p nearTopRightOf: a
+ ^(self isPoint: p nearTopOf: a) and: [self isPoint: p nearRightOf: a]!