'From Squeak3.9alpha of 4 July 2005 [latest update: #6690] on 15 September 2005 at 7:40:03 pm'!
"Change Set:		PopupThumbnails-wiz
Date:			15 September 2005
Author:			(wiz) Jerome Peace

This is a wiz reworking of Lex Spoons CDScreenShotMorph from his ChuckDemo image.

PopupThumbnailMorph shows a scaled version of a morph. Pressing the thumbnail popups a full size (snapshot, not live) image of the morph.

ThumbnailImageMorph is similar but w/o the pop up action.

The thumbnails can be scaled somewhat idiocyncaarticly with the yellow halo handle. The idiocycracy is that the thumb image tries to retain its aspect ratio until a certain limit is reached.

Instead of Lex's drag and drop method for obtaining new images I use a menu item 'sight target' that I borrowed from my slider fixes. This allows selecting any morph as the target as long as it is embedded in the same ubermorph.  This means one can select submorphs of system windows as well as the windows themselves for example."

!

Form subclass: #Cursor
	instanceVariableNames: ''
	classVariableNames: 'BlankCursor BottomLeftCursor BottomRightCursor CornerCursor CrossHairCursor CurrentCursor DownCursor MarkerCursor MenuCursor MoveCursor NormalCursor OriginCursor ReadCursor ResizeLeftCursor ResizeTopCursor ResizeTopLeftCursor ResizeTopRightCursor RightArrowCursor SquareCursor TopLeftCursor TopRightCursor UpCursor WaitCursor WebLinkCursor WriteCursor XeqCursor TargetCursor '
	poolDictionaries: ''
	category: 'Graphics-Display Objects'!
ImageMorph subclass: #ThumbnailImageMorph
	instanceVariableNames: 'imagePopupMorph desiredExtent'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Basic'!

!ThumbnailImageMorph commentStamp: 'wiz 9/15/2005 00:34' prior: 0!
A PopupThumbnailMorph is variant of Lex Spoon's CDScreenShotMorph. It displays a thumbnail and when the thumbnail is pressed the larger image pops up until the mouse button is released.

A menu item allows for "photographing" any morph on the screen to become the subject of our images.

Instance Variables
	imagePopupMorph:		<anImageMorph>
	image: 					<aForm>
	desiredExtent			<aPoint>
imagePopupMorph
	- an ImageMorph containing the full sized image.
	- it can be set from a morph image via the sight target menu item.
image
	- holds the scaled thumbnail form of our imagePopupMorph image.
desiredExtent
	- holds the desired extent that the thumbnail is expected to fit within.
	- it is guarded to be positive and non-zero.
	- it can be set by extent: so that the yellow halo handle works.
	
That said setting the size of the thumbnail works somewhat excentrically because the extent of the thumbnail depends both on the desiredExtent and the aspect ratio of the current popup image.  !

ThumbnailImageMorph subclass: #PopupThumbnailMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Basic'!

!Collection methodsFor: '*objectMenu' stamp: 'wiz 7/20/2004 13:06'!
asKnownNameMenu
	"Return a menu to select an element of the collection.  
	Menu uses the knownName or class name as only description of  
	element."
	| menu |
	menu := CustomMenu new.
	self
		do: [:m | menu
				add: (m knownName
						ifNil: [m class name asString])
				action: m].
	^ menu! !


!Cursor class methodsFor: 'class initialization' stamp: 'wiz 8/21/2004 22:51'!
initTarget
	TargetCursor := Cursor
				extent: 16 @ 16
				fromArray:  #(1984 6448 8456 16644 17284 33026 35106 65278 35106 33026 17284 16644 8456 6448 1984 0)
				offset: -7 @ -7! !

!Cursor class methodsFor: 'class initialization' stamp: 'wiz 7/19/2004 22:59'!
initialize
	"Create all the standard cursors..."
	self initOrigin.
	self initRightArrow.
	self initMenu.
	self initCorner.
	self initRead.
	self initWrite.
	self initWait.
	BlankCursor := Cursor new.
	self initXeq.
	self initSquare.
	self initNormalWithMask.
	self initCrossHair.
	self initMarker.
	self initUp.
	self initDown.
	self initMove.
	self initBottomLeft.
	self initBottomRight.
	self initResizeLeft.
	self initResizeTop.
	self initResizeTopLeft.
	self initResizeTopRight.
	self initTopLeft.
	self initTopRight.
	self initTarget.
	self makeCursorsWithMask! !

!Cursor class methodsFor: 'constants' stamp: 'wiz 7/19/2004 23:34'!
target
	"Answer the instance of me that is the shape of a gunsight."
	"Cursor target show"
	^ TargetCursor! !


!CustomMenu methodsFor: 'invocation' stamp: 'wiz 7/20/2004 12:20'!
startUpWithCaption: caption at: aPoint 
	"Build and invoke this menu with no initial selection. Answer the  
	selection associated with the menu item chosen by the user or nil if  
	none is chosen; use the provided caption"
	^ self startUp: nil withCaption: caption at: aPoint! !

!CustomMenu methodsFor: 'invocation' stamp: 'wiz 7/20/2004 12:18'!
startUp: initialSelection withCaption: caption at: aPoint 
	"Build and invoke this menu with the given initial selection and caption. 
	Answer the selection associated with the menu item chosen by the user 
	or nil if none is chosen."
	self build.
	initialSelection notNil
		ifTrue: [self preSelect: initialSelection].
	^ super startUpWithCaption: caption at: aPoint! !


!Morph methodsFor: 'meta-actions' stamp: 'wiz 7/17/2004 22:17'!
potentialTargets
	"Return the potential targets for the receiver.
	This is derived from Morph>>potentialEmbeddingTargets."
	owner ifNil:[^#()].
	^owner morphsAt: self referencePosition behind: self unlocked: true not! !

!Morph methodsFor: 'meta-actions' stamp: 'wiz 7/20/2004 02:46'!
potentialTargetsAt: aPoint 
	"Return the potential targets for the receiver.  
	This is derived from Morph>>potentialEmbeddingTargets."
	owner
		ifNil: [^ #()].
	^ owner
		morphsAt: aPoint
		! !

!Morph methodsFor: 'meta-actions' stamp: 'wiz 7/20/2004 13:06'!
sightTargets: event 
	"Return the potential targets for the receiver.  
	This is derived from Morph>>potentialEmbeddingTargets."
	| bullseye |
	owner
		ifNil: [^ #()].
	bullseye := Point fromUserWithCursor: Cursor target.
	self targetFromMenu: (self potentialTargetsAt: bullseye) asKnownNameMenu popupAt: bullseye! !

!Morph methodsFor: 'meta-actions' stamp: 'wiz 7/20/2004 01:25'!
targetFromMenu: aMenu 
	"Some other morph become target of the receiver"
	| newTarget |
	
	newTarget := aMenu startUpWithCaption: self externalName , ' targets...'.
	newTarget
		ifNil: [^ self].
	self target: newTarget! !

!Morph methodsFor: 'meta-actions' stamp: 'wiz 7/20/2004 12:22'!
targetFromMenu: aMenu popupAt: aPoint 
	"Some other morph become target of the receiver"
	| newTarget |
	newTarget := aMenu startUpWithCaption: self externalName , ' targets... '
	at: aPoint .
	"self halt ."
	newTarget
		ifNil: [^ self].
	self target: newTarget! !

!Morph methodsFor: 'meta-actions' stamp: 'wiz 7/17/2004 23:27'!
targetWith: evt
	"Some other morph become target of the receiver"
	|  menu newTarget |
	menu _ CustomMenu new.
	self potentialTargets  do: [:m | 
		menu add: (m knownName ifNil:[m class name asString]) action: m].
	newTarget _ menu startUpWithCaption: ( self externalName, ' targets...').
	newTarget ifNil:[^self].
	self target: newTarget.! !


!Point methodsFor: 'extent funtions' stamp: 'wiz 8/9/2005 02:44'!
guarded
"Return a positive nonzero extent."
self max: 1@1 .! !

!Point methodsFor: 'extent funtions' stamp: 'wiz 9/14/2005 22:41'!
scaleTo: anExtent
"Return a Point scalefactor for shrinking a thumbnail of the receiver's extent to fit within anExtent"
" self and anExtent are expected to have positive nonZero x and y. "
|  factor  sX sY | 
factor :=  3.0  reciprocal . "EccentricityThreshhold reciprical"
sX := anExtent x / self  x asFloat  .
sY :=  anExtent y / self  y asFloat  .
sX = sY ifTrue: [ ^ sX @ sY ] . "Same aspect ratio"
^ sX < sY ifTrue: [   sX @ (sX max: sY * factor) ] 
	ifFalse: [  (sY max: sX * factor ) @ sY  ] ! !


!Point class methodsFor: 'instance creation' stamp: 'wiz 7/20/2004 02:25'!
fromUserWithCursor: aCursor
	Sensor waitNoButton.
	 aCursor show.
	Sensor waitButton.
	Cursor normal show.
	^ Sensor cursorPoint"Point fromUser"! !


!ThumbnailImageMorph methodsFor: 'initialization' stamp: 'wiz 9/15/2005 17:38'!
initialize
super initialize .
desiredExtent := 90 asPoint.
self newImage: DefaultForm! !

!ThumbnailImageMorph methodsFor: 'accessing' stamp: 'wiz 9/14/2005 23:53'!
extent: anExtentPoint
"Set the desired extetnt for the thumbnail. It is guarenteed to fit within the desired extent.
The desitedExtent is guarded to prevent deviant forms from being attempted."

self changed . "We might be bigger before we change."
desiredExtent := anExtentPoint guarded.
self newThumbnail: imagePopupMorph image .
! !

!ThumbnailImageMorph methodsFor: 'accessing' stamp: 'wiz 9/14/2005 23:55'!
newImage: aForm
	"Use aForm as the new popupImage and update the thumbnail image."
	
	imagePopupMorph 
		ifNil: [ imagePopupMorph :=   aForm asMorph]
		ifNotNil: [ imagePopupMorph image: aForm ] .
		
		self newThumbnail: aForm
		
		! !

!ThumbnailImageMorph methodsFor: 'accessing' stamp: 'wiz 9/15/2005 18:37'!
newThumbnail: aForm
	"Use aForm as the new popupImage and update the thumbnail image."
	| scale  thumbForm |

		scale := aForm extent scaleTo: desiredExtent .
		
		thumbForm := aForm magnify: aForm boundingBox by: scale smoothing: 1 .
		
		self image: thumbForm . "heres where we put in a thumbnail"
		
		"We have changed clear the old and show the new"
		self invalidRect: self bounds . ! !

!ThumbnailImageMorph methodsFor: 'accessing' stamp: 'wiz 9/14/2005 22:07'!
target: aMorph
	"Snap aMorphs current image and show its thumbnail"
	
	self newImage: aMorph imageForm .
		! !

!ThumbnailImageMorph methodsFor: 'menu commands' stamp: 'wiz 9/14/2005 22:08'!
addCustomMenuItems: aCustomMenu hand: aHandMorph 
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu addLine.
	
	aCustomMenu add: 'sight target' translated action: #sightTargets:.
	! !


!PopupThumbnailMorph methodsFor: 'event handling' stamp: 'wiz 9/15/2005 18:45'!
handlesMouseDown: evt
	^true! !

!PopupThumbnailMorph methodsFor: 'event handling' stamp: 'wiz 9/15/2005 18:46'!
mouseDown: evt
	
	
	imagePopupMorph center: (self localPointToGlobal: evt position).
	imagePopupMorph bounds: (imagePopupMorph bounds translatedAndSquishedToBeWithin: World bounds).
	imagePopupMorph openInWorld
! !

!PopupThumbnailMorph methodsFor: 'event handling' stamp: 'wiz 9/15/2005 18:46'!
mouseUp: evt
	imagePopupMorph ifNotNil: [
		imagePopupMorph delete	.
		 ]! !

Cursor initialize!
Form subclass: #Cursor
	instanceVariableNames: ''
	classVariableNames: 'BlankCursor BottomLeftCursor BottomRightCursor CornerCursor CrossHairCursor CurrentCursor DownCursor MarkerCursor MenuCursor MoveCursor NormalCursor OriginCursor ReadCursor ResizeLeftCursor ResizeTopCursor ResizeTopLeftCursor ResizeTopRightCursor RightArrowCursor SquareCursor TargetCursor TopLeftCursor TopRightCursor UpCursor WaitCursor WebLinkCursor WriteCursor XeqCursor'
	poolDictionaries: ''
	category: 'Graphics-Display Objects'!

!Collection reorganize!
('accessing' anyOne atRandom capacity size)
('adapting' adaptToCollection:andSend: adaptToComplex:andSend: adaptToNumber:andSend: adaptToPoint:andSend: adaptToString:andSend:)
('adding' addAll: addIfNotPresent: add: add:withOccurrences:)
('arithmetic' raisedTo: * + - / // \\)
('comparing' hash)
('converting' asArray asBag asByteArray asCharacterSet asIdentitySet asIdentitySkipList asOrderedCollection asSet asSkipList asSkipList: asSortedArray asSortedCollection asSortedCollection: topologicallySortedUsing:)
('copying' copyWithDependent: copyWithoutAll: copyWithout: copyWith: ,)
('enumerating' allSatisfy: anySatisfy: associationsDo: collect: collect:thenDo: collect:thenSelect: count: detectMax: detectMin: detectSum: detect: detect:ifNone: difference: do: do:displayingProgress: do:separatedBy: do:without: groupBy:having: inject:into: intersection: noneSatisfy: reject: reject:thenDo: select: select:thenCollect: select:thenDo: union:)
('filter streaming' contents flattenOnStream: write:)
('math functions' abs arcCos arcSin arcTan average ceiling cos degreeCos degreeSin exp floor ln log max median min negated range reciprocal rounded sign sin sqrt squared sum tan truncated)
('printing' asCommaString asCommaStringAnd asStringOn:delimiter: asStringOn:delimiter:last: printElementsOn: printNameOn: printOn: printOn:delimiter: printOn:delimiter:last: storeOn:)
('private' emptyCheck errorEmptyCollection errorNoMatch errorNotFound: errorNotKeyed toBraceStack:)
('removing' removeAllFoundIn: removeAllSuchThat: removeAll: remove: remove:ifAbsent:)
('testing' contains: identityIncludes: ifEmpty: ifEmpty:ifNotEmptyDo: ifEmpty:ifNotEmpty: ifNotEmptyDo: ifNotEmptyDo:ifEmpty: ifNotEmpty: ifNotEmpty:ifEmpty: includesAllOf: includesAnyOf: includesSubstringAnywhere: includes: isCollection isEmpty isEmptyOrNil isSequenceable isZero notEmpty occurrencesOf:)
('*packageinfo-base' gather:)
('*objectMenu' asKnownNameMenu)
('*connectors-truncation and round-off' roundTo:)
!