The Trunk: Morphic-HenrikSperreJohansen.354.mcz

Andreas Raab uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-HenrikSperreJohansen.354.mcz

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

Name: Morphic-HenrikSperreJohansen.354
Author: HenrikSperreJohansen
Time: 25 February 2010, 2:26:50.877 am
UUID: 3d5845e2-9ef6-a842-9666-a775f49ed672
Ancestors: Morphic-kb.352

Added preferences for CornerGrip active/passive colors to window colors category.
Made color forms class vars instead of class instance vars, since few people probably used the ability to set separate colors for each corner grip, and 2 new preferences is better than 8.

Added categories to ProportionalSplitterMorph methods.

=============== Diff against Morphic-kb.352 ===============

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>isCursorOverHandle (in category 'displaying') -----
- ----- Method: ProportionalSplitterMorph>>isCursorOverHandle (in category 'as yet unclassified') -----
  isCursorOverHandle
  ^ self class showSplitterHandles not or: [self handleRect containsPoint: ActiveHand cursorPoint]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>siblingSplitters (in category 'adjacent splitters') -----
- ----- Method: ProportionalSplitterMorph>>siblingSplitters (in category 'as yet unclassified') -----
  siblingSplitters
 
  ^ self owner submorphsSatisfying: [:each | (each isKindOf: self class) and: [self splitsTopAndBottom = each splitsTopAndBottom and: [each ~= self]]]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>mouseDown: (in category 'events') -----
- ----- Method: ProportionalSplitterMorph>>mouseDown: (in category 'as yet unclassified') -----
  mouseDown: anEvent
  (self class showSplitterHandles not
  and: [self bounds containsPoint: anEvent cursorPoint])
  ifTrue: [oldColor := self color.
  self color: Color black].
  ^ super mouseDown: anEvent !

Item was changed:
  AbstractResizerMorph subclass: #CornerGripMorph
  instanceVariableNames: 'target'
+ classVariableNames: 'ActiveForm PassiveForm'
- classVariableNames: ''
  poolDictionaries: ''
  category: 'Morphic-Windows'!
- CornerGripMorph class
- instanceVariableNames: 'ActiveForm PassiveForm'!
 
  !CornerGripMorph commentStamp: 'jmv 1/29/2006 17:15' prior: 0!
  I am the superclass of a hierarchy of morph specialized in allowing the user to resize windows.!
- CornerGripMorph class
- instanceVariableNames: 'ActiveForm PassiveForm'!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>bottomBoundary (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>bottomBoundary (in category 'as yet unclassified') -----
  bottomBoundary
  "Answert the bottommost x position the receiver could be moved."
 
  | splitter morphs |
  splitter := self splitterBelow.
  morphs := self commonNeighbours: rightOrBottom with: splitter.
  ^ (splitter
  ifNil: [self containingWindow panelRect bottom]
  ifNotNil: [splitter top])
  - (self minimumHeightOf: morphs)!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>handleRect (in category 'displaying') -----
- ----- Method: ProportionalSplitterMorph>>handleRect (in category 'as yet unclassified') -----
  handleRect
 
  ^ Rectangle
  center: self bounds center
  extent: (self splitsTopAndBottom
  ifTrue: [self handleSize transposed]
  ifFalse: [self handleSize])!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>getOldColor (in category 'displaying') -----
- ----- Method: ProportionalSplitterMorph>>getOldColor (in category 'as yet unclassified') -----
  getOldColor
  ^ oldColor ifNil: [Color transparent]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>leftBoundary (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>leftBoundary (in category 'as yet unclassified') -----
  leftBoundary
  "Answer the leftmost y position the receiver could be moved."
 
  | splitter morphs |
  splitter := self splitterLeft.
  morphs := self commonNeighbours: leftOrTop with: splitter.
  ^ (splitter
  ifNil: [self containingWindow panelRect left]
  ifNotNil: [splitter right])
  + (self minimumWidthOf: morphs)!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>mouseMove: (in category 'events') -----
- ----- Method: ProportionalSplitterMorph>>mouseMove: (in category 'as yet unclassified') -----
  mouseMove: anEvent
  anEvent hand temporaryCursor
  ifNil: [^ self].
  self class fastSplitterResize
  ifFalse:  [self updateFromEvent: anEvent]
  ifTrue: [traceMorph
  ifNil: [traceMorph := Morph newBounds: self bounds.
  traceMorph borderColor: Color lightGray.
  traceMorph borderWidth: 1.
  self owner addMorph: traceMorph].
  splitsTopAndBottom
  ifTrue: [traceMorph position: traceMorph position x @ (self normalizedY: anEvent cursorPoint y)]
  ifFalse: [traceMorph position: (self normalizedX: anEvent cursorPoint x) @ traceMorph position y]]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>mouseUp: (in category 'events') -----
- ----- Method: ProportionalSplitterMorph>>mouseUp: (in category 'as yet unclassified') -----
  mouseUp: anEvent
  (self bounds containsPoint: anEvent cursorPoint)
  ifFalse: [anEvent hand showTemporaryCursor: nil].
  self class fastSplitterResize
  ifTrue: [self updateFromEvent: anEvent].
  traceMorph ifNotNil: [traceMorph delete. traceMorph := nil].
  self color: self getOldColor!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>bordersOn: (in category 'controlled morphs') -----
- ----- Method: ProportionalSplitterMorph>>bordersOn: (in category 'as yet unclassified') -----
  bordersOn: aMorph
  "Answer true if the aMorph is one of my neighbours."
 
  ^ (leftOrTop includes: aMorph) or: [rightOrBottom includes: aMorph]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>addRightOrBottom: (in category 'controlled morphs') -----
- ----- Method: ProportionalSplitterMorph>>addRightOrBottom: (in category 'as yet unclassified') -----
  addRightOrBottom: aMorph
 
  rightOrBottom add: aMorph.
 
  !

Item was changed:
  ----- Method: CornerGripMorph class>>activeColor: (in category 'handle settings') -----
  activeColor: aColor
  |canvas|
  canvas := self initializeActiveForm getCanvas.
  canvas
  privatePort fillPattern: aColor;
  combinationRule: Form rgbMul;
  fillRect: (self activeForm boundingBox) offset: 0@0.
+
- self subclassesDo: [:each | each activeColor: aColor]
  !

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>resizeCursor (in category 'displaying') -----
- ----- Method: ProportionalSplitterMorph>>resizeCursor (in category 'as yet unclassified') -----
  resizeCursor
 
  ^ Cursor resizeForEdge: (splitsTopAndBottom
  ifTrue: [#top]
  ifFalse: [#left])
  !

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>splitterLeft (in category 'adjacent splitters') -----
- ----- Method: ProportionalSplitterMorph>>splitterLeft (in category 'as yet unclassified') -----
  splitterLeft
 
  | splitters |
  splitters := ((self siblingSplitters select: [:each | each x < self x]) asSortedCollection: [:a :b | a x > b x]).
 
  ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>splitterBelow (in category 'adjacent splitters') -----
- ----- Method: ProportionalSplitterMorph>>splitterBelow (in category 'as yet unclassified') -----
  splitterBelow
 
  | splitters |
  splitters := ((self siblingSplitters select: [:each | each y < self y]) asSortedCollection: [:a :b | a y > b y]).
 
  ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>handleSize (in category 'displaying') -----
- ----- Method: ProportionalSplitterMorph>>handleSize (in category 'as yet unclassified') -----
  handleSize
 
  ^ self class splitterWidth @ 30!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>initialize (in category 'initialization') -----
- ----- Method: ProportionalSplitterMorph>>initialize (in category 'as yet unclassified') -----
  initialize
 
  super initialize.
 
  self hResizing: #spaceFill.
  self vResizing: #spaceFill.
  splitsTopAndBottom := false.
 
  leftOrTop := OrderedCollection new.
  rightOrBottom := OrderedCollection new!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>splitsTopAndBottom (in category 'direction') -----
- ----- Method: ProportionalSplitterMorph>>splitsTopAndBottom (in category 'as yet unclassified') -----
  splitsTopAndBottom
 
  ^ splitsTopAndBottom!

Item was changed:
  ----- Method: CornerGripMorph class>>passiveColor: (in category 'handle settings') -----
+ passiveColor: aColor
+ | canvas |
+ canvas := self initializePassiveForm getCanvas.
+ canvas privatePort fillPattern: aColor;
+ combinationRule: Form rgbMul;
+ fillRect: self passiveForm boundingBox offset: 0 @ 0.
+ self
+ allSubInstancesDo: [:each | each setDefaultColors; changed]!
- passiveColor: aColor
- |canvas|
- (canvas := self initializePassiveForm getCanvas).
- canvas
- privatePort fillPattern: aColor;
- combinationRule: Form rgbMul;
- fillRect: (self passiveForm boundingBox) offset: 0@0.
-
- self subclassesDo: [:each | each passiveColor: aColor]
- !

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>topBoundary (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>topBoundary (in category 'as yet unclassified') -----
  topBoundary
  "Answer the topmost x position the receiver could be moved to."
 
  | splitter morphs |
  splitter := self splitterAbove.
  morphs := self commonNeighbours: leftOrTop with: splitter.
  ^ (splitter
  ifNil: [self containingWindow panelRect top]
  ifNotNil: [splitter bottom])
  + (self minimumHeightOf: morphs)!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>splitterAbove (in category 'adjacent splitters') -----
- ----- Method: ProportionalSplitterMorph>>splitterAbove (in category 'as yet unclassified') -----
  splitterAbove
 
  | splitters |
  splitters := ((self siblingSplitters select: [:each | each y > self y]) asSortedCollection: [:a :b | a y < b y]).
 
  ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>addLeftOrTop: (in category 'controlled morphs') -----
- ----- Method: ProportionalSplitterMorph>>addLeftOrTop: (in category 'as yet unclassified') -----
  addLeftOrTop: aMorph
 
  leftOrTop add: aMorph!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>commonNeighbours:with: (in category 'controlled morphs') -----
- ----- Method: ProportionalSplitterMorph>>commonNeighbours:with: (in category 'as yet unclassified') -----
  commonNeighbours: morphs with: aProportionalSplitterMorphOrNil
  "Answer the subset of morphs which is also confined by aProportionalSplitterMorphOrNil."
 
  ^ aProportionalSplitterMorphOrNil isNil
  ifTrue: [morphs]
  ifFalse: [morphs select: [ :which |
  aProportionalSplitterMorphOrNil bordersOn: which]]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>splitterRight (in category 'adjacent splitters') -----
- ----- Method: ProportionalSplitterMorph>>splitterRight (in category 'as yet unclassified') -----
  splitterRight
 
  | splitters |
  splitters := ((self siblingSplitters select: [:each | each x > self x]) asSortedCollection: [:a :b | a x < b x]).
 
  ^ splitters ifEmpty: nil ifNotEmpty: [splitters first]!

Item was added:
+ ----- Method: CornerGripMorph class>>passiveColor (in category 'handle settings') -----
+ passiveColor
+ <preference: 'Corner Grip color'
+ category: 'window colors'
+ description: 'The default color of window corners'
+ type: #Color>
+ ^(self passiveForm colorAt: 24@24) alpha:  1!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>normalizedY: (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>normalizedY: (in category 'as yet unclassified') -----
  normalizedY: y
 
  ^ (y max: self topBoundary) min: self bottomBoundary!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>normalizedX: (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>normalizedX: (in category 'as yet unclassified') -----
  normalizedX: x
 
  ^ (x max: self leftBoundary) min: self rightBoundary!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>updateFromEvent: (in category 'events') -----
- ----- Method: ProportionalSplitterMorph>>updateFromEvent: (in category 'as yet unclassified') -----
  updateFromEvent: anEvent
  | delta selfTop selfBottom selfLeft selfRight |
  delta := splitsTopAndBottom
  ifTrue: [0 @ ((self normalizedY: anEvent cursorPoint y) - lastMouse y)]
  ifFalse: [(self normalizedX: anEvent cursorPoint x) - lastMouse x @ 0].
 
  splitsTopAndBottom
  ifTrue: [lastMouse := lastMouse x @ (self normalizedY: anEvent cursorPoint y)]
  ifFalse: [lastMouse := (self normalizedX: anEvent cursorPoint x) @ lastMouse y].
 
  leftOrTop
  do: [:each | | firstRight firstBottom |
  firstRight := each layoutFrame rightOffset
  ifNil: [0].
  firstBottom := each layoutFrame bottomOffset
  ifNil: [0].
  each layoutFrame rightOffset: firstRight + delta x.
  each layoutFrame bottomOffset: firstBottom + delta y].
  rightOrBottom
  do: [:each | | secondLeft secondTop |
  secondLeft := each layoutFrame leftOffset
  ifNil: [0].
  secondTop := each layoutFrame topOffset
  ifNil: [0].
  each layoutFrame leftOffset: secondLeft + delta x.
  each layoutFrame topOffset: secondTop + delta y].
  selfTop := self layoutFrame topOffset
  ifNil: [0].
  selfBottom := self layoutFrame bottomOffset
  ifNil: [0].
  selfLeft := self layoutFrame leftOffset
  ifNil: [0].
  selfRight := self layoutFrame rightOffset
  ifNil: [0].
  self layoutFrame topOffset: selfTop + delta y.
  self layoutFrame bottomOffset: selfBottom + delta y.
  self layoutFrame leftOffset: selfLeft + delta x.
  self layoutFrame rightOffset: selfRight + delta x.
  self owner layoutChanged!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>minimumHeightOf: (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>minimumHeightOf: (in category 'as yet unclassified') -----
  minimumHeightOf: aCollection
  "Answer the minimum height needed to display any of the morphs in aCollection."
 
  ^ aCollection inject: 0 into: [ :height :morph |
  (morph minHeight + self height) max: height]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>beSplitsTopAndBottom (in category 'direction') -----
- ----- Method: ProportionalSplitterMorph>>beSplitsTopAndBottom (in category 'as yet unclassified') -----
  beSplitsTopAndBottom
 
  splitsTopAndBottom := true.
  !

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>rightBoundary (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>rightBoundary (in category 'as yet unclassified') -----
  rightBoundary
  "Answer the rightmost x position the receiver could be moved to."
 
  | splitter morphs |
  splitter := self splitterRight.
  morphs := self commonNeighbours: rightOrBottom with: splitter.
  ^ (splitter
  ifNil: [self containingWindow panelRect right]
  ifNotNil: [splitter left])
  - (self minimumWidthOf: morphs)!

Item was added:
+ ----- Method: CornerGripMorph class>>activeColor (in category 'handle settings') -----
+ activeColor
+ <preference: 'Corner Grip highlight color'
+ category: 'window colors'
+ description: 'The highlight-color of window corners'
+ type: #Color>
+ ^(self activeForm colorAt: 24@24) alpha:  1!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>minimumWidthOf: (in category 'boundaries') -----
- ----- Method: ProportionalSplitterMorph>>minimumWidthOf: (in category 'as yet unclassified') -----
  minimumWidthOf: aCollection
  "Answer the minimum width needed to display any of the morphs in aCollection."
 
  ^ aCollection inject: 0 into: [ :width :morph |
  (morph minWidth + self width) max: width]!

Item was changed:
  ----- Method: CornerGripMorph class>>initialize (in category 'class initialization') -----
  initialize
  "CornerGripMorph initialize"
 
  super initialize.
  self initializeActiveForm.
  self initializePassiveForm.
  self activeColor: Color orange.!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>drawOn: (in category 'displaying') -----
- ----- Method: ProportionalSplitterMorph>>drawOn: (in category 'as yet unclassified') -----
  drawOn: aCanvas
  | dotBounds size alphaCanvas dotSize |
  super drawOn: aCanvas.
  self class showSplitterHandles ifTrue: [
  size := self splitsTopAndBottom
  ifTrue: [self handleSize transposed]
  ifFalse: [self handleSize].
  dotSize := self splitsTopAndBottom
  ifTrue: [6 @ self class splitterWidth]
  ifFalse: [self class splitterWidth @ 6].
  alphaCanvas := aCanvas asAlphaBlendingCanvas: 0.7.
  dotBounds := Rectangle center: self bounds center extent: size.
  alphaCanvas fillRectangle: dotBounds color: self handleColor.
  dotBounds := Rectangle center: self bounds center extent: dotSize.
  alphaCanvas fillRectangle: dotBounds color: self dotColor]!

Item was changed:
+ ----- Method: ProportionalSplitterMorph>>wantsEveryMouseMove (in category 'events') -----
- ----- Method: ProportionalSplitterMorph>>wantsEveryMouseMove (in category 'as yet unclassified') -----
  wantsEveryMouseMove
 
  ^ true!