'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 27 April 2003 at 6:13:07 pm'!
"Change Set:		CropMorphOrGrab
Date:			30 September 2002
Author:			Stephan B. Wessels
SM Name:		Crop SketchMorphs and Grab Screen Rect to JPG

Provides a menu option to allow crop operation on an existing SketchMorph.
Very handy for modifying a SketchMorph on your desktop.
Also provides basic change to how a rectangle is grabbed from the screen.
A new crop/grab UI design is used.  Here's how you use it:
	- Either select 'crop' from the menu (red) halo or use a
	  Utility method to grab part of the screen.
	- The entire desktop becomes a translucent white.
	- Click where you want to begin the crop/grab origin.
	- Drag until you have a corner of your new rect.  The
	  UI will show the cropped/grabbed rectangle in clear view.
	- When you release the mouse you can then perform either of
	  3 actions.

		If you click inside the rectangle you can drag the
		rectangle to a new position on the screen.

		If you click outside the rectangle you are telling Squeak
		you are done.

		If you grab an edge or corner you can resize the rectangle.

Two new Utility methods were added and one was re-grouped.  The new
Utilities grabScreenAndSaveOnDiskAsJpeg will save the grabbed rectangle
as a JPEG file.  It also prompts you for the output file name.  A default
file name is provided.

Date		Update
-------------	-----------------------------------------------------------------------
15-apr-2003	updated for Squeak 3.5

30-sep-2002	initial file release.
"
!


!Form class methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/8/2002 20:38'!
fromUserAllowChanges
	"Answer an instance of me with bitmap initialized from the area of the  
	display screen designated by the user. The grid for selecting an area is  
	1@1."
	^ self fromUserAllowChanges: 1 @ 1! !

!Form class methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/8/2002 20:38'!
fromUserAllowChanges: aPoint 
	"Answer an instance of me with bitmap initialized from the area of the  
	display screen designated by the user. The grid for selecting an area is  
	aPoint."
	^ self
		fromDisplay: (Rectangle fromUserAllowChanges: aPoint)! !


!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/20/2002 09:04'!
calculateHVRectsForCroppedRect: oldRect newRect: newRect 
	^newRect extent = oldRect extent
		ifTrue: [self calculateHVRectsForMovedCroppedRect: oldRect newRect: newRect]
		ifFalse: [self calculateHVRectsForResizedCroppedRect: oldRect newRect: newRect ].
! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/20/2002 09:01'!
calculateHVRectsForMovedCroppedRect: oldRect newRect: newRect 
	| horzRect vertRect array |
	array _ Array new: 2.
	newRect origin x >= oldRect origin x
				ifTrue: [newRect origin y >= oldRect origin y
						ifTrue: [horzRect _ oldRect origin corner: newRect corner x @ newRect origin y.
							vertRect _ oldRect origin x @ newRect origin y corner: newRect origin x @ newRect corner y]
						ifFalse: [horzRect _ oldRect origin x @ newRect corner y corner: newRect corner x @ oldRect corner y.
							vertRect _ oldRect origin x @ newRect origin y corner: newRect origin x @ newRect corner y]]
				ifFalse: [newRect origin y >= oldRect origin y
						ifTrue: [horzRect _ newRect origin x @ oldRect origin y corner: oldRect corner x @ newRect origin y.
							vertRect _ newRect corner x @ newRect origin y corner: oldRect corner x @ newRect corner y]
						ifFalse: [horzRect _ newRect origin x @ newRect corner y corner: oldRect corner.
							vertRect _ newRect corner x @ newRect origin y corner: oldRect corner x @ newRect corner y]].
	array at: 1 put: horzRect.
	array at: 2 put: vertRect.
	^ array! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/20/2002 09:20'!
calculateHVRectsForResizedCroppedRect: oldRect newRect: newRect 
	| horzRect vertRect array |
	array _ Array new: 2.
	(newRect extent x >= oldRect extent x
			and: [newRect extent y >= oldRect extent y])
		ifTrue: [^ array].
	newRect origin = oldRect origin
		ifTrue: ["same origin resize"
			newRect extent x < oldRect extent x
				ifTrue: [vertRect _ newRect corner x @ oldRect origin y corner: oldRect corner x @ newRect corner y.
					horzRect _ newRect extent y < oldRect extent y
								ifTrue: [oldRect origin x @ newRect corner y corner: oldRect corner]]
				ifFalse: [horzRect _ newRect origin corner: newRect corner x @ oldRect corner y.
					vertRect _ nil]].
	newRect topRight = oldRect topRight
		ifTrue: ["same top right resize"
			newRect origin x < oldRect origin x
				ifTrue: [vertRect _ nil.
					horzRect _ newRect origin x @ newRect corner y corner: oldRect corner]
				ifFalse: [newRect corner y = oldRect corner y
						ifTrue: [horzRect _ nil.
							vertRect _ oldRect origin corner: newRect origin x @ newRect corner y]
						ifFalse: [vertRect _ oldRect origin corner: newRect origin x @ newRect corner y.
							horzRect _ newRect corner y > oldRect corner y
										ifFalse: [oldRect origin x @ newRect corner y corner: oldRect corner]]]].
	newRect bottomRight = oldRect bottomRight
		ifTrue: ["same bottom right resize"
			newRect origin y > oldRect origin y
				ifTrue: [horzRect _ (oldRect origin x min: newRect origin x)
								@ (oldRect origin y min: newRect origin y) corner: oldRect corner x @ newRect origin y.
					vertRect _ oldRect origin x >= newRect origin x
								ifFalse: [oldRect origin x @ newRect origin y corner: newRect origin x @ oldRect corner y]]
				ifFalse: [horzRect _ nil.
					vertRect _ oldRect origin x @ newRect origin y corner: newRect origin x @ oldRect corner y]].
	newRect bottomLeft = oldRect bottomLeft
		ifTrue: ["same bottom left resize"
			newRect origin y > oldRect origin y
				ifTrue: [horzRect _ oldRect origin corner: oldRect corner x @ newRect origin y.
					vertRect _ newRect corner x > oldRect corner x
								ifTrue: [oldRect corner x @ oldRect origin y corner: newRect corner x @ newRect origin y]
								ifFalse: [newRect corner x @ newRect origin y corner: oldRect corner]]
				ifFalse: [horzRect _ nil.
					vertRect _ newRect corner x @ newRect origin y corner: oldRect corner]].
	array at: 1 put: horzRect.
	array at: 2 put: vertRect.
	^ array! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/12/2002 17:01'!
createCroppedRectFrom: tempRectBlock formUnderneath: formUnderneath 
	| rect buttonStart buttonNow newRect paintRect |
	rect _ self.
	self floodWorldRect: Display boundingBox fromForm: Display form.
	buttonStart _ buttonNow _ Sensor anyButtonPressed.
	[buttonNow == buttonStart]
		whileTrue: [Processor yield.
			buttonNow _ Sensor anyButtonPressed.
			newRect _ tempRectBlock value: rect.
			newRect = rect
				ifFalse: [formUnderneath
						displayOn: Display
						at: 0 @ 0
						clippingBox: newRect
						rule: Form over
						fillColor: nil.
					(newRect corner x < rect corner x
							or: [newRect corner y < rect corner y])
						ifTrue: [paintRect _ newRect corner x @ newRect origin y corner: rect corner.
							self
								floodWorldRect: paintRect
								fromForm: (formUnderneath copy: paintRect).
							paintRect _ newRect origin x @ newRect corner y corner: newRect corner x @ rect corner y.
							self
								floodWorldRect: paintRect
								fromForm: (formUnderneath copy: paintRect)].
					rect _ newRect]].
	^rect! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/20/2002 08:57'!
drawCroppedRect: oldRect formUnderneath: formUnderneath newRect: newRect 
	| horzRect vertRect array |
	(formUnderneath copy: newRect)
		displayOn: Display
		at: newRect origin
		clippingBox: newRect
		rule: Form over
		fillColor: nil.
	array _ self calculateHVRectsForCroppedRect: oldRect newRect: newRect.
	horzRect _ array first.
	vertRect _ array last.
	horzRect isNil
		ifFalse: [self
				floodWorldRect: horzRect
				fromForm: (formUnderneath copy: horzRect)].
	vertRect isNil
		ifFalse: [self
				floodWorldRect: vertRect
				fromForm: (formUnderneath copy: vertRect)]! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/17/2002 20:03'!
floodWorldRect: rect fromForm: sourceForm 
	| form |
	form _ sourceForm copy.
	form
		copyBits: ((Form extent: rect extent)
				fillColor: Color white)
		at: 0 @ 0
		translucent: 0.5.
	form displayAt: rect origin! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/19/2002 20:33'!
newRectFromAllowChanges: tempRectBlock 
	"This works in Morphic and MVC."
	| rect newRect aHand pt oldDisplay edgeName array |
	oldDisplay _ Display copy: Display boundingBox.
	rect _ self createCroppedRectFrom: tempRectBlock formUnderneath: oldDisplay.
	edgeName _ nil.
	[Sensor anyButtonPressed
		ifTrue: [pt _ Sensor cursorPoint.
			(rect containsPoint: pt)
				ifTrue: [Cursor move
						showWhile: [[Sensor anyButtonPressed]
								whileTrue: [Processor yield.
									newRect _ self
												trackCroppedRect: rect
												formUnderneath: oldDisplay
												startingPoint: pt.
									pt _ pt + (newRect origin - rect origin).
									rect _ newRect].
							false]]
				ifFalse: [edgeName isNil
						ifFalse: [[Sensor anyButtonPressed]
								whileTrue: [Processor yield.
									array _ self
												resizeCroppedRect: rect
												formUnderneath: oldDisplay
												startingPoint: pt
												edgeName: edgeName.
									pt _ pt + array last.
									rect _ array first]].
					edgeName isNil]]
		ifFalse: [pt _ Sensor cursorPoint.
			(rect containsPoint: pt)
				ifTrue: [Cursor move show]
				ifFalse: [edgeName _ rect
								forPoint: pt
								closestSideDistLen: [:side :dist :len | dist <= 2
										ifTrue: [side]].
					#(#topLeft #bottomRight #bottomLeft #topRight )
						do: [:cornerName | (pt
									dist: (rect perform: cornerName))
									< 10
								ifTrue: [edgeName _ cornerName]].
					edgeName isNil
						ifTrue: [Cursor menu show]
						ifFalse: [(Cursor resizeForEdge: edgeName) show]].
			false]] whileFalse.
	Smalltalk isMorphic
		ifTrue: [World restoreMorphicDisplay.
			aHand _ World activeHand.
			aHand newMouseFocus: nil;
				 showTemporaryCursor: nil;
				 flushEvents]
		ifFalse: [ScheduledControllers restore].
	^ rect! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/20/2002 06:32'!
resizeCroppedRect: rect formUnderneath: formUnderneath startingPoint: pt edgeName: edgeName 
	| delta newRect array |
	delta _ Sensor cursorPoint - pt.
	edgeName = #topLeft
		ifTrue: [newRect _ rect origin + delta corner: rect corner].
	edgeName = #bottomRight
		ifTrue: [newRect _ rect origin corner: rect corner + delta].
	edgeName = #bottomLeft
		ifTrue: [newRect _ rect origin x + delta x @ rect origin y corner: rect corner x @ (rect corner y + delta y)].
	edgeName = #topRight
		ifTrue: [newRect _ rect origin x @ (rect origin y + delta y) corner: rect corner x + delta x @ rect corner y].
	edgeName = #top
		ifTrue: [newRect _ rect origin x @ (rect origin y + delta y) corner: rect corner].
	edgeName = #bottom
		ifTrue: [newRect _ rect origin corner: rect corner x @ (rect corner y + delta y)].
	edgeName = #left
		ifTrue: [newRect _ rect origin x + delta x @ rect origin y corner: rect corner].
	edgeName = #right
		ifTrue: [newRect _ rect origin corner: rect corner x + delta x @ rect corner y].
	self
		drawCroppedRect: rect
		formUnderneath: formUnderneath
		newRect: newRect.
	array _ Array with: newRect with: delta.
	^ array! !

!Rectangle methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/19/2002 20:07'!
trackCroppedRect: rect formUnderneath: formUnderneath startingPoint: pt 
	| delta newRect |
	delta _ Sensor cursorPoint - pt.
	newRect _ rect translateBy: delta.
	self drawCroppedRect: rect formUnderneath: formUnderneath newRect: newRect.
	^ newRect! !


!Rectangle class methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/6/2002 18:50'!
fromUserAllowChanges
	"Answer an instance of me that is determined by having the user  
	designate the top left and bottom right corners. The gridding for user  
	selection is 1@1."
	^ self fromUserAllowChanges: 1 @ 1! !

!Rectangle class methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/9/2002 18:15'!
fromUserAllowChanges: gridPoint 
	"Answer a Rectangle that is determined by having the user  
	designate the top left and bottom right corners.  
	The cursor reamins linked with the sensor, but  
	the outline is kept gridded."
	| originRect result |
	originRect _ Cursor origin
				showWhile: [((Sensor cursorPoint grid: gridPoint)
						extent: 0 @ 0)
						newRectFrom: [:f | (Sensor cursorPoint grid: gridPoint)
								extent: 0 @ 0]].
	result _ originRect
						newRectFromAllowChanges: [:f | f origin
								corner: (Sensor cursorPoint grid: gridPoint)].
	^ result! !


!SketchMorph methodsFor: '*cropMorphOrGrab' stamp: 'sbw 9/28/2002 09:47'!
addCustomMenuItems: aCustomMenu hand: aHandMorph 
	"Add custom menu items"
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu
		add: 'restore base graphic'
		target: self
		action: #restoreBaseGraphicFromMenu.
	aCustomMenu
		add: 'call this my base graphic'
		target: self
		action: #callThisBaseGraphic.
	aCustomMenu
		add: 'choose new graphic...'
		target: self
		action: #chooseNewGraphic.
	aCustomMenu addLine.
	aCustomMenu
		add: 'set as background'
		target: rotatedForm
		action: #setAsBackground.
	self addPaintingItemsTo: aCustomMenu hand: aHandMorph.
	aCustomMenu
		add: 'crop'
		target: self
		action: #crop! !

!SketchMorph methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/12/2002 16:26'!
crop
	| newRect adjusted |
	self world
		assureNotPaintingElse: [^ self].
	newRect _ Rectangle fromUserAllowChanges.
	adjusted _ newRect translateBy: bounds origin negated.
	self
		newForm: (originalForm copy: adjusted).
	self extent: newRect extent! !


!Utilities class methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/8/2002 20:35'!
grabScreenAndAddNamedToImports
	"Utilities grabScreenAndAddNamedToImports"
	| form chosenName |
	form _ Form fromUserAllowChanges.
	form bits size = 0
		ifTrue: [^ self beep].
	chosenName _ FillInTheBlank request: 'ImageImports key?'.
	chosenName isEmpty
		ifFalse: [Smalltalk imageImports at: chosenName put: form]! !

!Utilities class methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/8/2002 20:35'!
grabScreenAndSaveOnDisk
	"Utilities grabScreenAndSaveOnDisk"
	| form fileName |
	form _ Form fromUserAllowChanges.
	form bits size = 0
		ifTrue: [^ self beep].
	fileName _ FileDirectory default nextNameFor: 'Squeak' extension: 'gif'.
	Utilities
		informUser: 'Writing ' , fileName
		during: [GIFReadWriter putForm: form onFileNamed: fileName]! !

!Utilities class methodsFor: '*cropMorphOrGrab' stamp: 'sbw 10/8/2002 20:35'!
grabScreenAndSaveOnDiskAsJpeg
	"Utilities grabScreenAndSaveOnDiskAsJpeg"
	| form fileName chosenName |
	form _ Form fromUserAllowChanges.
	form bits size = 0
		ifTrue: [^ self beep].
	fileName _ FileDirectory default nextNameFor: 'Squeak' extension: 'jpg'.
	chosenName _ FillInTheBlank request: 'Write image to (.jpg will be added if missing)...' initialAnswer: fileName.
	chosenName isEmpty
		ifFalse: [(chosenName endsWith: '.jpg')
				ifFalse: [chosenName _ chosenName , '.jpg'].
			Utilities
				informUser: 'Writing ' , chosenName
				during: [JPEGReadWriter2 putForm: form onFileNamed: chosenName]]! !