'From Squeak3.6beta of ''4 July 2003'' [latest update: #5331] on 5 July 2003 at 11:09:54 pm'! "Change Set: WindowPositioningFix-nk Date: 5 July 2003 Author: Ned Konz When running the new 3.6b image at exactly 800@600, the debugger appears partly offscreen. This change set makes the RealEstateAgent try first to translate a window to keep it inside the Display bounds, then squash it. "! !RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'nk 7/5/2003 08:32'! initialFrameFor: aView initialExtent: initialExtent world: aWorld "Find a plausible initial screen area for the supplied view, which should be a StandardSystemView, taking into account the 'reverseWindowStagger' Preference, the size needed, and other windows currently on the screen." | allOrigins screenRight screenBottom putativeOrigin putativeFrame allowedArea staggerOrigin otherFrames | Preferences reverseWindowStagger ifTrue: [^ self strictlyStaggeredInitialFrameFor: aView initialExtent: initialExtent world: aWorld]. allowedArea _ self maximumUsableAreaInWorld: aWorld. screenRight _ allowedArea right. screenBottom _ allowedArea bottom. 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]]]. allOrigins _ otherFrames collect: [:f | f origin]. (self standardPositionsInWorld: aWorld) do: "First see if one of the standard positions is free" [:aPosition | (allOrigins includes: aPosition) ifFalse: [^ (aPosition extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]]. staggerOrigin _ (self standardPositionsInWorld: aWorld) first. "Fallback: try offsetting from top left" putativeOrigin _ staggerOrigin. [putativeOrigin _ putativeOrigin + StaggerOffset. putativeFrame _ putativeOrigin extent: initialExtent. (putativeFrame bottom < screenBottom) and: [putativeFrame right < screenRight]] whileTrue: [(allOrigins includes: putativeOrigin) ifFalse: [^ (putativeOrigin extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea]]. ^ (self scrollBarSetback @ self screenTopSetback extent: initialExtent) translatedAndSquishedToBeWithin: allowedArea! ! !RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'nk 7/5/2003 08:32'! 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). (Smalltalk isMorphic and: [Flaps sharedFlapsAllowed]) ifTrue: [allowedArea _ self reduceByFlaps: allowedArea]. "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! ! !Rectangle methodsFor: 'transforming' stamp: 'nk 7/5/2003 08:31'! translatedAndSquishedToBeWithin: aRectangle "Return an adjustment of the receiver that fits within aRectangle by - translating it to be within aRectangle if necessary, then - reducing its size, if necessary" ^ (self translatedToBeWithin: aRectangle) squishedWithin: aRectangle! !