The Trunk: System-nice.645.mcz

Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.645.mcz

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

Name: System-nice.645
Author: nice
Time: 15 December 2013, 10:50:27.921 pm
UUID: ea3ee480-795b-447a-921d-869e1c77704e
Ancestors: System-cmm.644

Take presence of Flaps (if any) directly into account in RealEstateAgent maximumUsableArea, rather than using 2 steps.

The reasons why it's better to centralize handling of Flaps' consumed space are:
- for having less code to maintain
  (a lot of logic was duplicated and that ain't good)
- for having a uniform handling of available Screen space
  (some methods did not take this consumed space into account and that ain't good)
- for handling absence of Flaps class and possibly unload MorphicExtras
  (a lot of protection would have been required, and that ain't good)
- for re-integrating methods for strictlyStaggered policy in the System
  (those were moved to MorphicExtras just because they used Flaps, and that ain't good)

=============== Diff against System-cmm.644 ===============

Item was changed:
  ----- Method: RealEstateAgent class>>assignCollapseFrameFor: (in category 'utilities') -----
  assignCollapseFrameFor: aSSView
  "Offer up a location along the left edge of the screen for a collapsed SSView. Make sure it doesn't overlap any other collapsed frames."
 
  | grid otherFrames topLeft viewBox collapsedFrame extent newFrame verticalBorderDistance top |
  grid := 8.
  verticalBorderDistance := 8.
  aSSView isMorph
  ifTrue: [otherFrames := (SystemWindow windowsIn: aSSView world satisfying: [:w | w ~= aSSView])
  collect: [:w | w collapsedFrame]
  thenSelect: [:rect | rect notNil].
+ viewBox := self maximumUsableAreaInWorld: aSSView world]
- viewBox := self reduceByFlaps: aSSView world viewBox]
  ifFalse: [otherFrames := ScheduledControllers scheduledWindowControllers
  collect: [:aController | aController view ~= aSSView ifTrue: [aController view collapsedFrame]]
  thenSelect: [:rect | rect notNil].
  viewBox := Display boundingBox].
  collapsedFrame := aSSView collapsedFrame.
  extent := collapsedFrame notNil
  ifTrue: [collapsedFrame extent]
  ifFalse: [aSSView isMorph
  ifTrue: [aSSView getRawLabel width + aSSView labelWidgetAllowance @ (aSSView labelHeight + 2)]
  ifFalse: [(aSSView labelText extent x + 70) @ aSSView labelHeight
  min: aSSView labelDisplayBox extent]].
  collapsedFrame notNil
  ifTrue: [(otherFrames anySatisfy: [:f | collapsedFrame intersects: f])
  ifFalse: ["non overlapping"
  ^ collapsedFrame]].
  top := viewBox top + verticalBorderDistance.
  [topLeft := viewBox left @ top.
  newFrame := topLeft extent: extent.
  newFrame bottom <= (viewBox height - verticalBorderDistance)]
  whileTrue:
  [(otherFrames anySatisfy: [:w | newFrame intersects: w])
  ifFalse: ["no overlap"
  ^ newFrame].
  top := top + grid].
  "If all else fails... (really to many wins here)"
  ^ 0 @ 0 extent: extent!

Item was changed:
  ----- Method: RealEstateAgent class>>assignCollapsePointFor: (in category 'utilities') -----
  assignCollapsePointFor: aSSView
  "Offer up a location along the left edge of the screen for a collapsed SSView.
  Make sure it doesn't overlap any other collapsed frames."
 
  | grid otherFrames y free topLeft viewBox |
  grid := 24.  "should be mult of 8, since manual move is gridded by 8"
  aSSView isMorph
  ifTrue: [otherFrames := (SystemWindow windowsIn: aSSView world satisfying: [:w | true])
  collect: [:w | w collapsedFrame]
  thenSelect: [:rect | rect notNil].
+ viewBox := self maximumUsableAreaInWorld: aSSView world]
- viewBox := self reduceByFlaps: aSSView world viewBox]
  ifFalse: [otherFrames := ScheduledControllers scheduledWindowControllers
  collect: [:aController | aController view collapsedFrame]
  thenSelect: [:rect | rect notNil].
  viewBox := Display boundingBox].
  y := viewBox top.
  [(y := y + grid) <= (viewBox height - grid)]
  whileTrue:
  [topLeft := viewBox left@y.
  free := true.
  otherFrames do: [:w | free := free & (topLeft ~= w topLeft)].
  free ifTrue: [^ topLeft]].
  "If all else fails..."
  ^ 0 @ 0!

Item was changed:
  ----- Method: RealEstateAgent class>>maximumUsableArea (in category 'accessing') -----
  maximumUsableArea
+ ^self maximumUsableAreaInWorld: ActiveWorld!
-
- | allowedArea |
- allowedArea := Display usableArea.
- Smalltalk isMorphic ifTrue: [
- allowedArea := allowedArea intersect: ActiveWorld visibleClearArea.
- ].
- ^allowedArea!

Item was changed:
  ----- Method: RealEstateAgent class>>maximumUsableAreaInWorld: (in category 'accessing') -----
  maximumUsableAreaInWorld: aWorldOrNil
 
  | allowedArea |
  allowedArea := Display usableArea.
  aWorldOrNil ifNotNil: [
  allowedArea := allowedArea intersect: aWorldOrNil visibleClearArea.
  ].
+ (Smalltalk isMorphic and: [self respondsTo: #reduceByFlaps:]) ifTrue:
+ [allowedArea := self reduceByFlaps: allowedArea].
  ^allowedArea!

Item was added:
+ ----- Method: RealEstateAgent class>>strictlyStaggeredInitialFrameFor:initialExtent: (in category 'framing') -----
+ strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent
+
+ self error: 'please use #strictlyStaggeredInitialFrameFor:initialExtent:world:'!

Item was added:
+ ----- Method: RealEstateAgent class>>strictlyStaggeredInitialFrameFor:initialExtent:world: (in category 'framing') -----
+ strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorld
+ "This method implements a staggered window placement policy that I (di) like.
+ Basically it provides for up to 4 windows, staggered from each of the 4 corners.
+ The windows are staggered so that there will always be a corner visible."
+
+ | allowedArea grid initialFrame otherFrames cornerSel corner delta putativeCorner free maxLevel |
+
+ allowedArea :=(self maximumUsableAreaInWorld: aWorld)
+ insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0@0).
+ "Number to be staggered at each corner (less on small screens)"
+ maxLevel := allowedArea area > 300000 ifTrue: [3] ifFalse: [2].
+ "Amount by which to stagger (less on small screens)"
+ grid := allowedArea area > 500000 ifTrue: [40] ifFalse: [20].
+ initialFrame := 0@0 extent: ((initialExtent
+ "min: (allowedArea extent - (grid*(maxLevel+1*2) + (grid//2))))
+ min: 600@400")).
+ otherFrames := Smalltalk isMorphic
+ ifTrue: [(SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not])
+ collect: [:w | w bounds]]
+ ifFalse: [ScheduledControllers scheduledWindowControllers
+ select: [:aController | aController view ~~ nil]
+ thenCollect: [:aController | aController view isCollapsed
+ ifTrue: [aController view expandedFrame]
+ ifFalse: [aController view displayBox]]].
+ 0 to: maxLevel do:
+ [:level |
+ 1 to: 4 do:
+ [:ci | cornerSel := #(topLeft topRight bottomRight bottomLeft) at: ci.
+ corner := allowedArea perform: cornerSel.
+ "The extra grid//2 in delta helps to keep title tabs distinct"
+ delta := (maxLevel-level*grid+(grid//2)) @ (level*grid).
+ 1 to: ci-1 do: [:i | delta := delta rotateBy: #right centerAt: 0@0]. "slow way"
+ putativeCorner := corner + delta.
+ free := true.
+ otherFrames do:
+ [:w |
+ free := free & ((w perform: cornerSel) ~= putativeCorner)].
+ free ifTrue:
+ [^ (initialFrame align: (initialFrame perform: cornerSel)
+ with: putativeCorner)
+ translatedAndSquishedToBeWithin: allowedArea]]].
+ "If all else fails..."
+ ^ (self scrollBarSetback @ self screenTopSetback extent: initialFrame extent)
+ translatedAndSquishedToBeWithin: allowedArea!