'From Squeak 2.4c of May 10, 1999 on 28 June 1999 at 10:49:58 pm'!
"Change Set:		WindowSelection
Date:			21 June 1999
Author:			Joshua Gargus

Provides a facility akin to Windows use of ALT-TAB to switch between windows.  Use ALT-` to bring up a window selection list.  By default, a thumbnail of and an outline around the selected window are shown.  These can be toggled by the WindowListMorph class methods outlineDisplay: and thumbnailDisplay:.  

When the list has the keyboard focus (as it will initially), use the up and down arrow keys to traverse the list, and hit return to choose the selected window."!

MorphicModel subclass: #SystemWindow
	instanceVariableNames: 'labelString stripes label closeBox collapseBox activeOnlyOnTop paneMorphs paneRects collapsedFrame fullFrame isCollapsed focusMorph '
	classVariableNames: 'TopWindow '
	poolDictionaries: ''
	category: 'Morphic-Windows'!
Object subclass: #WindowListItem
	instanceVariableNames: 'window thumbnail '
	classVariableNames: 'ThumbnailHeight ThumbnailWidth '
	poolDictionaries: ''
	category: 'Josh-WindowSelection'!
StringHolder subclass: #WindowListModel
	instanceVariableNames: 'windowList stringList thumbnailList thumbnailHeight index defaultBackgroundColor '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Josh-WindowSelection'!
MorphicModel subclass: #WindowListMorph
	instanceVariableNames: 'thumbnail transform outline list '
	classVariableNames: 'OutlinesOn ThumbnailsOn '
	poolDictionaries: ''
	category: 'Josh-WindowSelection'!
MorphThumbnail subclass: #WindowListThumbnail
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Josh-WindowSelection'!

!HandMorph methodsFor: 'event handling' stamp: 'jcg 5/14/1999 00:02'!
handleAsSpecialEvent: evt
	
	"Tries to do something special with the event.  If we can't find anything to do with it, we answer nil and let the regular event handling take over."

	(evt anyButtonPressed and:
	 [evt controlKeyPressed and:
	 [lastEvent anyButtonPressed not]]) ifTrue:
		[eventTransform _ MorphicTransform identity.
		lastEvent _ evt.
		^ self invokeMetaMenu: evt].

	evt blueButtonPressed ifTrue:
		[lastEvent blueButtonPressed 
			ifTrue: [^ self specialDrag: evt]
			ifFalse: [eventTransform _ MorphicTransform identity.
					lastEvent _ evt.
					^ self specialGesture: evt]].

	"check if the character '`' and the commandKey are pressed.  If so, bring up a window menu"
	((evt isKeystroke 
		and: [evt commandKeyPressed])
		and: [evt keyValue = 96])  
			ifTrue: [^ WindowListModel popupPluggableList]. 



	^ nil		"event is not special after all."! !

!HandMorph methodsFor: 'event handling' stamp: 'jcg 5/3/1999 00:15'!
handleEvent: evt
	
	| special |

	eventSubscribers do: [:m | m handleEvent: evt].
"--"
	"allows us to designate and handle certain events that will be handled here, and not passed on to a submorph"
	special _ self handleAsSpecialEvent: evt.
	special ifNotNil: [^ special].

"--"
	lastEvent _ evt.
	self position ~= evt cursorPoint
		ifTrue: [self position: evt cursorPoint].

	evt isMouse ifTrue: [
		evt isMouseMove ifTrue: [^ self handleMouseMove: evt].
		evt isMouseDown ifTrue: [ ^ self handleMouseDown: evt].
		evt isMouseUp ifTrue: [^ self handleMouseUp: evt]].

	evt isKeystroke ifTrue: [
		keyboardFocus ifNotNil: [keyboardFocus keyStroke: evt].
		^ self].
! !


!SystemWindow methodsFor: 'label' stamp: 'RAA 5/31/1999 16:39'!
labelForWindowList

	"RAA: answer a presentable name for the window selection list"

	^ labelString ifNil: [self class printString,' (unlabeled)']! !

!SystemWindow methodsFor: 'panes' stamp: 'jcg 6/22/1999 04:50'!
focusMorph
	"Answer the morph that should be given the keyboard focus if someone wants to give it to us."

	^ focusMorph
! !

!SystemWindow methodsFor: 'panes' stamp: 'jcg 6/22/1999 04:55'!
focusMorph: aSubmorph
	"Set the morph that should be given the keyboard to the given submorph."
	
	(submorphs contains: [:m | m = aSubmorph]) 
		ifTrue: [focusMorph _ aSubmorph]
		ifFalse: [focusMorph _ nil].
! !


!WindowListItem methodsFor: 'accessing' stamp: 'jcg 6/10/1999 00:21'!
bounds
	"Return the bounds of the SystemWindow (not the thumbnail)"
	
	^ window bounds.
! !

!WindowListItem methodsFor: 'accessing' stamp: 'jcg 6/9/1999 23:56'!
name
	
	^ window labelForWindowList.
! !

!WindowListItem methodsFor: 'accessing' stamp: 'jcg 6/10/1999 00:24'!
thumbnail
	"RAA: Use a subclass of the normal thumbnail that avoids some unnecessary recalculation. These changes could well be included in the regular MorphThumbnail."

	thumbnail ifNil: [thumbnail _ (WindowListThumbnail new
										morphRepresented: window
										width: ThumbnailWidth
										height: ThumbnailHeight)].
	^ thumbnail.
! !

!WindowListItem methodsFor: 'accessing' stamp: 'jcg 6/9/1999 23:55'!
window
	
	^ window.
! !

!WindowListItem methodsFor: 'accessing' stamp: 'jcg 6/9/1999 23:55'!
window: aSystemWindow

	window _ aSystemWindow.
	thumbnail _ nil.! !

!WindowListItem methodsFor: 'events' stamp: 'jcg 6/22/1999 05:05'!
activate
	"Bring current window to the top, and give the keyboard focus to it if it wants it."

	window activate.
	window focusMorph ifNotNil: [
		self currentHand newKeyboardFocus: window focusMorph.
		"self currentHand newMouseFocus: window focusMorph"].
! !


!WindowListItem class reorganize!
('accessing' thumbnailHeight thumbnailWidth)
('initialize' thumbnailHeight: thumbnailWidth:)
('instance creation' window:)
!


!WindowListItem class methodsFor: 'accessing' stamp: 'jcg 6/10/1999 01:21'!
thumbnailHeight

	^ ThumbnailHeight! !

!WindowListItem class methodsFor: 'accessing' stamp: 'jcg 6/10/1999 01:21'!
thumbnailWidth

	^ ThumbnailWidth! !

!WindowListItem class methodsFor: 'initialize' stamp: 'jcg 6/10/1999 00:01'!
thumbnailHeight: height

	ThumbnailHeight _ height.! !

!WindowListItem class methodsFor: 'initialize' stamp: 'jcg 6/10/1999 00:02'!
thumbnailWidth: width

	ThumbnailWidth _ width.! !

!WindowListItem class methodsFor: 'instance creation' stamp: 'jcg 6/9/1999 23:52'!
window: aSystemWindow
	
	^ super new window: aSystemWindow
! !


!WindowListModel commentStamp: '<historical>' prior: 0!
An instance of this class is serves as the model for a WindowListMorph.!

!WindowListModel reorganize!
('window switching test')
('events' dealWithKeystroke:from: updateList windowChosenFrom:)
('accessing' defaultBackgroundColor defaultBackgroundColor: index index: outline stringList thumbnail)
('initialize' initialize)
('private' getWindows)
!


!WindowListModel methodsFor: 'events' stamp: 'jcg 5/12/1999 00:36'!
dealWithKeystroke: aChar from: view
	"If it is a return, do something.  Otherwise, check if it is an arrow key"

	(aChar = Character cr) ifTrue: [^ self windowChosenFrom: view ].
	^ self arrowKey: aChar from: view.! !

!WindowListModel methodsFor: 'events' stamp: 'jcg 6/10/1999 23:15'!
updateList

	| currentWindows remainingWindows newWindows currentlyIndexed |

	(index = 0) ifFalse: [currentlyIndexed _ windowList at: index].

	currentWindows _ self getWindows.

	"In the following blocks, 'sw' stands for SystemWindow, and 'wli' stands for WindowListItem".
	remainingWindows _ 
		windowList select: 
			[:wli | currentWindows contains: [:sw | wli window == sw]].

	newWindows _
		currentWindows select:
			 [:sw | (windowList contains: [:wli | wli window == sw]) not].

	"Add new windows to those remaining (those that weren't deleted)."
	newWindows do: [:sw | remainingWindows add: (WindowListItem window: sw)].
	windowList _ remainingWindows.

	index _ windowList indexOf: currentlyIndexed.
	self changed: #updateList.
	self changed: #index.
"	(index == 0) ifTrue: [self changed: #index]."


! !

!WindowListModel methodsFor: 'events' stamp: 'jcg 5/12/1999 15:01'!
windowChosenFrom: aView
	"Activate the chosen window".
	
	(windowList at: index) activate.
	aView owner delete.
! !

!WindowListModel methodsFor: 'accessing' stamp: 'jcg 5/12/1999 15:08'!
defaultBackgroundColor

	^ defaultBackgroundColor! !

!WindowListModel methodsFor: 'accessing' stamp: 'jcg 5/12/1999 15:08'!
defaultBackgroundColor: aColor

	defaultBackgroundColor _ aColor.
! !

!WindowListModel methodsFor: 'accessing' stamp: 'jcg 5/7/1999 00:59'!
index
	
	^ index	! !

!WindowListModel methodsFor: 'accessing' stamp: 'jcg 5/19/1999 01:39'!
index: anInteger

	index _ anInteger.
	self changed: #index.
! !

!WindowListModel methodsFor: 'accessing' stamp: 'jcg 6/6/1999 17:05'!
outline
	"jcg: if index is zero, there is no applicable outline"
	(index == 0) ifTrue: [^ nil].

	^ (windowList at: index) bounds
! !

!WindowListModel methodsFor: 'accessing' stamp: 'jcg 6/10/1999 01:20'!
stringList
	
	^ windowList collect: [:w | w window labelForWindowList].	! !

!WindowListModel methodsFor: 'accessing' stamp: 'jcg 6/10/1999 00:24'!
thumbnail

	"jcg: if index is zero, there is no applicable thumbnail"
	(index == 0) ifTrue: [^ nil].

	^ (windowList at: index) thumbnail.! !

!WindowListModel methodsFor: 'initialize' stamp: 'jcg 6/10/1999 01:15'!
initialize

	windowList _ OrderedCollection new.
	index _ 0.
	self updateList.

	self index: 1.! !

!WindowListModel methodsFor: 'private' stamp: 'jcg 6/9/1999 22:23'!
getWindows
	"answers an Array of SystemWindow in world"

	^ SystemWindow windowsIn: self currentWorld satisfying: [:dummy | true].! !


!WindowListModel class reorganize!
('instance creation' new)
('choose windows' popupPluggableList)
('private')
!


!WindowListModel class methodsFor: 'instance creation' stamp: 'jcg 5/12/1999 16:09'!
new
	^ super new initialize.

! !

!WindowListModel class methodsFor: 'choose windows' stamp: 'jcg 6/14/1999 11:39'!
popupPluggableList
	"pop up a PluggableList to choose the desired SystemWindow from."
	"RAA: keep the list on the screen"

	| list model win |
	model _ WindowListModel new.

	"create a list"
	list _ PluggableListMorph
			on: model
			list: #stringList
			selected: #index
			changeSelected: #index:
			menu: nil
			keystroke: #dealWithKeystroke:from:.

	win _ WindowListMorph 
		newBounds: (
			(Rectangle origin: Sensor mousePoint - (20@30) extent: 300@400)
				translatedToBeWithin: Display boundingBox
		)
		model: model
		slotName: 'Window Chooser'
		list: list.

	win color: Color lightBlue.

	"create a list"
"	list _ PluggableListMorph
			on: model
			list: #stringList
			selected: #index
			changeSelected: #index:
			menu: nil
			keystroke: #dealWithKeystroke:from:.
	list position: (win bounds topLeft + (10@10)).
	list extent: (win extent - (20@110)).

	win addMorph: list."


	win startStepping.
	win openInWorld.
! !


!WindowListMorph methodsFor: 'updating' stamp: 'jcg 6/10/1999 23:19'!
update: aSymbol
	"Refer to the comment in View|update:."

	"RAA: just some debugging code (now commented out)"

	| t |
	aSymbol == #index ifTrue: [
		t _ Time millisecondsToRun: [
			"MessageTally spyOn: ["
			ThumbnailsOn ifTrue: [self thumbnail: model thumbnail].
			OutlinesOn ifTrue: [self outline: model outline]
			"]."
		].
		"Bob add: {'updating'. t}."
		^ self.
	].

	aSymbol == #updateList ifTrue: [self resizeListAndSelf].
! !

!WindowListMorph methodsFor: 'private' stamp: 'jcg 6/6/1999 17:07'!
outline: aRectangle
	
	(aRectangle isNil)
		ifTrue: [outline hide]
		ifFalse: [outline bounds: (aRectangle expandBy: 10); show].

! !

!WindowListMorph methodsFor: 'private' stamp: 'jcg 6/10/1999 22:59'!
positionList: aListMorph

	"RAA: make the scrollbar non-retractable. just a preference, but flopping scrollbars don't seem needed here"

	aListMorph width: (self width - 20).
	"aListMorph height: (self height - 20 - WindowListItem thumbnailHeight)."
	aListMorph position: (self topLeft + (10@10)).
	aListMorph retractable: false.
! !

!WindowListMorph methodsFor: 'private' stamp: 'jcg 5/14/1999 18:43'!
positionThumbnail: aThumbnail
	| x y |

	x _ self left + (self width - thumbnail width / 2) rounded.
	y _ self bottom - thumbnail height - 10.
	thumbnail position: x@y.
! !

!WindowListMorph methodsFor: 'private' stamp: 'jcg 6/10/1999 23:31'!
resizeListAndSelf

	| stringList |
	stringList _ model stringList.
	list list: stringList.
	list height: (15 min: stringList size) * (list listItemHeight + 4) + 5.  "kluge"

	ThumbnailsOn 
		ifTrue: [self height: (list height + WindowListItem thumbnailHeight + 30)]
		ifFalse: [self height: (list height + 20)].
! !

!WindowListMorph methodsFor: 'private' stamp: 'jcg 6/6/1999 17:02'!
thumbnail: aThumb

	thumbnail ifNotNil: [thumbnail delete].
	(thumbnail _ aThumb) ifNotNil:
		[self addMorph: thumbnail].! !

!WindowListMorph methodsFor: 'initilization' stamp: 'jcg 6/6/1999 20:09'!
initialize
	super initialize.

	"Create an inital SystemWindow outline rectangle"
	outline _ RectangleMorph new color: Color transparent.
	outline 
		extent: 0@0;
		borderColor: Color blue;
		borderWidth: 10.
	outline openInWorld.

! !

!WindowListMorph methodsFor: 'initilization' stamp: 'jcg 6/10/1999 01:51'!
list: aListMorph

	(list isNil) 
		ifTrue: [self addMorph: aListMorph]
		ifFalse: [self replaceSubmorph: list by: aListMorph].
	list _ aListMorph.
! !

!WindowListMorph methodsFor: 'change reporting' stamp: 'RAA 5/31/1999 16:35'!
layoutChanged

	"RAA: changed reference to class of new thumbnail"

	submorphs do: [:m | (m class = PluggableListMorph) 
		ifTrue: [ self positionList: m ] 
		ifFalse: [ (m class = WindowListThumbnail)
			ifTrue: [ self positionThumbnail: m ]]].
	super layoutChanged.
! !

!WindowListMorph methodsFor: 'submorphs-add/remove' stamp: 'jcg 6/6/1999 20:06'!
delete
	outline delete.
	super delete.! !

!WindowListMorph methodsFor: 'stepping and presenter' stamp: 'jcg 6/10/1999 01:23'!
step
	model updateList.
	! !

!WindowListMorph methodsFor: 'stepping and presenter' stamp: 'jcg 6/10/1999 01:56'!
stepTime
	^ 1000	! !


!WindowListMorph class reorganize!
('instance creation' newBounds:model:slotName:list:)
('display properties' outlineDisplay outlineDisplay: thumbnailDisplay thumbnailDisplay:)
!


!WindowListMorph class methodsFor: 'instance creation' stamp: 'jcg 6/10/1999 01:51'!
newBounds: aRectangle model: aModel slotName: aString list: aListMorph
	
	| newguy |
	newguy _ super 
		newBounds: aRectangle
		model: aModel
		slotName: aString.
		
	newguy list: aListMorph.

	"hack.  shouldn't be necessary if MorphicModel uses 'model:' instead of assignment"
	self flag: #joshG.
	aModel addDependent: newguy.	

	^ newguy! !

!WindowListMorph class methodsFor: 'display properties' stamp: 'jcg 6/28/1999 22:48'!
outlineDisplay
	
	^ OutlinesOn ! !

!WindowListMorph class methodsFor: 'display properties' stamp: 'jcg 6/28/1999 22:47'!
outlineDisplay: aBool
	
	OutlinesOn _ aBool.! !

!WindowListMorph class methodsFor: 'display properties' stamp: 'jcg 6/28/1999 22:48'!
thumbnailDisplay
	
	^ ThumbnailsOn! !

!WindowListMorph class methodsFor: 'display properties' stamp: 'jcg 6/28/1999 22:47'!
thumbnailDisplay: aBool
	
	ThumbnailsOn _ aBool.! !


!WindowListThumbnail methodsFor: 'as yet unclassified' stamp: 'RAA 5/31/1999 16:38'!
generateRotatedForm
	"Compute my rotatedForm and offsetWhenRotated."

	"RAA: testing scalePoint for 1@1 rather than 0@0 seems to speed things up"

	| adjustedAngle smoothPix pair t |
	(rotationStyle = #normal)
		ifTrue: [adjustedAngle _ 0.0 - self setupAngle]
			"let TransformationMorph do directional image turn, we subtract green arrow angle"
		ifFalse: [adjustedAngle _ 0.0].	"leftRight, upDown, none"

	t _ Time millisecondsToRun: [
	((adjustedAngle = 0.0) and: [1.0@1.0 = scalePoint])
		ifTrue: [
			rotatedForm _ originalForm.
			offsetWhenRotated _ 0@0]
		ifFalse: ["do the actual rotation!!"
			((scalePoint x < 1.0) or: [scalePoint y < 1.0])
				ifTrue: [smoothPix _ 2]
				ifFalse: [smoothPix _ 1].
			pair _ WarpBlt
				rotate: originalForm
				degrees: adjustedAngle negated
				center: rotationCenter
				scaleBy: self scalePoint
				smoothing: smoothPix.
			rotatedForm _ pair first.
			offsetWhenRotated _ pair last].
	].
	"Bob add: {adjustedAngle. scalePoint. t. thisContext shortStack}."

	((rotationStyle = #leftRight) and: [rotationDegrees < 0.0]) ifTrue: [
		"headed left; use flipped"
		rotatedForm _ rotatedForm flipBy: #horizontal centerAt: 0@0.
		offsetWhenRotated _ offsetWhenRotated + 
			(((2 * (rotationCenter x - (originalForm width // 2)))@0) * scalePoint).
		^ self].

	((rotationStyle = #upDown) and: [(rotationDegrees > 90.0) or: 
		[rotationDegrees < -90.0]]) ifTrue: [
			"headed down; use flipped"
			rotatedForm _ rotatedForm flipBy: #vertical centerAt: 0@0.
			offsetWhenRotated _ offsetWhenRotated + 
				((0@(2 * (rotationCenter y - (originalForm height // 2)))) * scalePoint).
			^ self].
! !

!WindowListThumbnail methodsFor: 'as yet unclassified' stamp: 'RAA 5/31/1999 16:39'!
morphRepresented: aMorph width: argWidth height: argHeight

	"RAA: combined a couple of methods so that some recalculation was not done. Also changed not to scale windows UP for the thumbnail - collapsed windows looked a bit odd otherwise"

	| f scaleX scaleY |

	morphRepresented _ aMorph.
	f _ morphRepresented imageForm.
	morphRepresented fullReleaseCachedState.
	scaleY _ argHeight / f height min: 1.0.  "no need to scale UP"
	scaleX _ ((morphRepresented width * scaleY) <= argWidth)
		ifTrue:
			[scaleY]  "the usual case; same scale factor, to preserve aspect ratio"
		ifFalse:
			[argWidth / f width].
	originalForm _ f magnify: f boundingBox by: (scaleX @ scaleY) smoothing: 2.
	rotationCenter _ originalForm extent // 2.
	rotationDegrees _ 0.0.
	self extent: originalForm extent.
	self setNameTo: aMorph externalName
! !


WindowListModel removeSelector: #windowList!
WindowListModel removeSelector: #thumbnailHeight!
WindowListModel class removeSelector: #getWindowsAsStrings!
WindowListModel class removeSelector: #getWindows!
WindowListMorph class removeSelector: #setThumbnailDisplay:!
WindowListMorph class removeSelector: #setOutlineDisplay:!
WindowListMorph class removeSelector: #thumbnailDisplayl!
WindowListMorph class removeSelector: #newBounds:model:slotName:!
"Postscript:
By default, we want to enable both the outline and thumbnail display options."
WindowListMorph setOutlineDisplay: true.
WindowListMorph setThumbnailDisplay: true.

"default size for thumbnails."
WindowListItem thumbnailHeight: 90.
WindowListItem thumbnailWidth: 1200.
!