'From etoys4.0 of 9 October 2008 [latest update: #2237] on 3 August 2009 at 10:38:19 pm'!
"Change Set:		grabPatch-kfr
Date:			3 August 2009
Author:			Karl Ramberg (& Scott Wallace)

Improved grab-patch tool -- see SQ-99 on tracker.squeakland.org.  Allows grab action to proceed in any direction."!

Morph subclass: #SimpleSelectionMorph
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Support'!

!SimpleSelectionMorph commentStamp: 'sw 8/3/2009 22:00' prior: 0!
A morph used in the implementaiton of Karl Ramberg's omnidirectional grab-patch tool!


!GrabPatchMorph methodsFor: 'initialization' stamp: 'sw 8/3/2009 22:34'!
initialize
	"Initialize the receiver.  Emblazon the GrabPatch icon on its face"

	super initialize.
	self image: (ScriptingSystem formAtKey: 'GrabPatch').
	self setProperty: #ignorePartsBinDrop toValue: true! !

!GrabPatchMorph methodsFor: 'dropping' stamp: 'sw 8/3/2009 21:55'!
justDroppedInto: aPasteUpMorph event: anEvent
	"The user clicked, to indicate one corner of the patch to be grabbed..."

	self delete.
	ActiveWorld displayWorldSafely; runStepMethods.  "But the HW cursor stays up still ???"
	^ ActiveWorld grabDrawingFromScreen: anEvent! !


!LassoPatchMorph methodsFor: 'dropping' stamp: 'sw 8/3/2009 21:50'!
justDroppedInto: aPasteUpMorph event: anEvent
	"The user clicked indicating the beginning of the lassoing sequence."

	self delete.
	ActiveWorld displayWorldSafely; runStepMethods.
	^ ActiveWorld grabLassoFromScreen: anEvent! !

!LassoPatchMorph methodsFor: 'dropping' stamp: 'kfr 5/23/2009 14:51'!
wantsToBeDroppedInto: aMorph
	"Only wanted by the world"

	^ aMorph isWorldMorph! !


!PasteUpMorph methodsFor: '*connectors-world menu' stamp: 'kfr 5/23/2009 14:58'!
grabDrawingFromScreen: evt
	"Allow the user to designate a rectangular area of the screen to 'grab' as a drawing."

	| selection |
	selection _SimpleSelectionMorph newBounds: (evt cursorPoint extent: 0@0).
	
	Cursor crossHair showWhile:
		[[Sensor anyButtonPressed] whileFalse:
			[self currentWorld displayWorldSafely; runStepMethods].
		self addMorph: selection. ^selection extendByHand:evt hand ]! !


!PartsBin methodsFor: 'dropping/grabbing' stamp: 'sw 8/3/2009 18:18'!
acceptDroppingMorph: dropped event: evt
	"Accept a dropped morph; intercepted here for a couple of special cases."

	(dropped hasProperty: #ignorePartsBinDrop) ifTrue: [^ self].
	(dropped hasProperty: #beFullyVisibleAfterDrop) ifTrue:
		[dropped vanishAfterSlidingTo: dropped formerPosition event: evt.
		^ self].
	^ super acceptDroppingMorph: dropped event: evt! !


!SimpleSelectionMorph methodsFor: 'extending' stamp: 'sw 8/3/2009 22:32'!
extendByHand: aHand
	"Assumes selection has just been created and added to some pasteUp or world"

	| startPoint handle m inner |
	startPoint := Sensor cursorPoint.

	handle := NewHandleMorph new followHand: aHand
		forEachPointDo: [:newPoint |
					| localPt |
					localPt := (self transformFrom: self world) globalPointToLocal: newPoint.
					self bounds: (startPoint rect: localPt)]
		lastPointDo:
			 [:newPoint |
			inner := self bounds insetBy: 2@2.
			inner area >= 16
				ifTrue:
					[m := SketchMorph new form: (Form fromDisplay: inner).
					aHand attachMorph: m]
				ifFalse:
					[Beeper beep].  "throw minnows back"
			self delete].
			
	handle visible: false.
	aHand attachMorph: handle.
	handle startStepping! !

!SimpleSelectionMorph methodsFor: 'initialization' stamp: 'sw 8/3/2009 21:49'!
initialize
	"initialize the state of the receiver"

	super initialize.
	self color: Color transparent.
        self borderColor: Color black.
	self borderWidth: 2.
	self setProperty: #ignorePartsBinDrop toValue: true! !