'From etoys3.0 of 24 February 2008 [latest update: #2081] on 21 August 2008 at 10:21:12 pm'!
"Change Set:		centerOfRot-sw
Date:			21 August 2008
Author:			Scott Wallace

Always show center-of-rotation and forward-direction handles on halos of Sketches -- no more requiring slight rotation for these to be shown.

If user tries to operate the center-of-rotation halo handle or the green forward-direction handle *without* the shift key down, put up an Informer explaining things to her.  

Continue to require shift for operating the center-of-rotation handle, and additionally now require the same for operating the forward-direction handle.

Fix up corresponding balloon help.

Also adds support for popping up an informer right above the cursor, so that a simple click in the ok button, not requiring mouse repositioning, will dismiss the informer."!


!Morph methodsFor: 'halos and balloon help' stamp: 'sw 8/6/2008 13:50'!
balloonHelpTextForHandle: aHandle
	"Answer a string providing balloon help for the given halo handle"

	|  itsSelector |
	itsSelector _ aHandle eventHandler firstMouseSelector.
	#(	(addFullHandles							'More halo handles'		translatedNoop)
		(addSimpleHandles						'Fewer halo handles'	translatedNoop)
		(chooseEmphasisOrAlignment				'Emphasis & alignment'	translatedNoop)
		(chooseFont								'Change font'			translatedNoop)
		(chooseNewGraphicFromHalo				'Choose a new graphic'	translatedNoop)
		(chooseStyle								'Change style'			translatedNoop)
		(dismiss									'Remove'				translatedNoop)
		(doDebug:with:							'Debug (press shift to inspect morph)'		translatedNoop)
		(doDirection:with:						'Forward direction (hold down shift key and drag to change it)'					translatedNoop)
		(doDup:with:							'Duplicate'				translatedNoop)
		(doDupOrMakeSibling:with: 				'Duplicate (press shift to make a sibling)'	translatedNoop)
		(doMakeSiblingOrDup:with: 				'Make a sibling (press shift to make simple duplicate)'		translatedNoop)
		(doMakeSibling:with: 					'Make a sibling'			translatedNoop)
		(doMenu:with:							'Menu'					translatedNoop)
		(doGrab:with:							'Pick up'				translatedNoop)
		(editButtonsScript						'See the script for this button'				translatedNoop)
		(editDrawing							'Repaint'				translatedNoop)
		(maybeDoDup:with:						'Duplicate'				translatedNoop)
		(makeNascentScript						'Make a scratch script'	translatedNoop)
		(makeNewDrawingWithin				'Paint new object'		translatedNoop)
		(mouseDownInCollapseHandle:with:		'Collapse'				translatedNoop)
		(mouseDownOnHelpHandle:				'Help'					translatedNoop)
		(openViewerForArgument				'Open a Viewer for me'	translatedNoop)
		(openViewerForTarget:with:				'Open a Viewer for me')
		(paintBackground						'Paint background'		translatedNoop)
		(prepareToTrackCenterOfRotation:with:	'Center of rotation (hold down shift key and drag to change it)'		translatedNoop)
		(presentViewMenu						'Present the Viewing menu'					translatedNoop)
		(startDrag:with:							'Move'					translatedNoop)
		(startGrow:with:							'Change size (press shift to preserve aspect)'	translatedNoop) 
		(startRot:with:							'Rotate'					translatedNoop)
		(startScale:with:							'Change scale'			translatedNoop) 
		(tearOffTile								'Make a tile representing this object'			translatedNoop)
		(tearOffTileForTarget:with:				'Make a tile representing this object')
		(trackCenterOfRotation:with:				'Set center of rotation'	translatedNoop)) 


	do:
		[:pair | itsSelector == pair first ifTrue: [^ pair second]].

	(itsSelector == #mouseDownInDimissHandle:with:) ifTrue:
		[^ Preferences preserveTrash
			ifTrue:
				['Move to trash' translatedNoop]
			ifFalse:
				['Remove from screen' translatedNoop]].

	(itsSelector == #doRecolor:with:) ifTrue: [
		^ Preferences propertySheetFromHalo
			ifTrue: ['Property Sheet (press shift for simple recolor)' translatedNoop]
			ifFalse: ['Change color (press shift for more properties)' translatedNoop]].

	^ 'unknown halo handle'! !


!HaloMorph methodsFor: 'private' stamp: 'sw 8/21/2008 22:20'!
addDirectionHandles
	"If appropriate, add center-of-rotation and forward-direction handles to the halo."

	| centerHandle d w directionShaft patch patchColor crossHairColor |
	self showingDirectionHandles ifFalse: [^ self].

	directionArrowAnchor _ (target point: target referencePosition in: self world) rounded.
	patch _ target imageFormForRectangle: (Rectangle center: directionArrowAnchor extent: 3@3).
	patchColor _ patch colorAt: 1@1.

	(directionShaft _ LineMorph newSticky makeForwardArrow)
		borderWidth: 2; borderColor: (Color green orColorUnlike: patchColor).
	self positionDirectionShaft: directionShaft.
	self addMorphFront: directionShaft.
	directionShaft setCenteredBalloonText: 'Forward direction (hold down shift key and drag to change it)' translated;
		on: #mouseDown send: #doDirection:with: to: self;
		on: #mouseMove send: #trackDirectionArrow:with: to: self;
		on: #mouseUp send: #setDirection:with: to: self.
	directionShaft setProperty: #activateOnShift toValue: true.

	d _ 15.  "diameter"  w _ 3.  "borderWidth"
	crossHairColor _ Color red orColorUnlike: patchColor.
	(centerHandle _ EllipseMorph newBounds: (0@0 extent: d@d) color: Color transparent)
			borderWidth: w; borderColor: (Color blue orColorUnlike: patchColor);
			addMorph: (LineMorph from: (d//2)@w to: (d//2)@(d-w-1) color: crossHairColor width: 1) lock;
			addMorph: (LineMorph from: w@(d//2) to: (d-w-1)@(d//2) color: crossHairColor width: 1) lock;
			align: centerHandle bounds center with: directionArrowAnchor.
	self addMorph: centerHandle.
	centerHandle setCenteredBalloonText: 'Rotation center (hold down the shift key and drag to change it)' translated;
			on: #mouseDown send: #prepareToTrackCenterOfRotation:with: to: self;
			on: #mouseMove send: #trackCenterOfRotation:with: to: self;
			on: #mouseUp send: #setCenterOfRotation:with: to: self
! !

!HaloMorph methodsFor: 'private' stamp: 'sw 8/13/2008 21:28'!
doDirection: anEvent with: directionHandle
	"The mouse went down on the forward-direction halo handle; respond appropriately."

	anEvent hand obtainHalo: self.
	anEvent shiftPressed 
		ifTrue:
			[self removeAllHandlesBut: directionHandle]
		 ifFalse:
			[PopUpMenu informCenteredAboveCursor:
'To change the forward-direction, hold down the shift
key as you drag from the green arrowhead.' translated.
			^ self]! !

!HaloMorph methodsFor: 'private' stamp: 'sw 8/21/2008 10:58'!
prepareToTrackCenterOfRotation: evt with: rotationHandle
	"The mouse went down on the center of rotation."

	evt hand obtainHalo: self.
	evt shiftPressed
		ifTrue:
			[self removeAllHandlesBut: rotationHandle]
		ifFalse:
			[PopUpMenu informCenteredAboveCursor: 'to change the center of rotation, hold down
the shift key as you drag from the crosshairs icon' translated.
			^ self.
			"rotationHandle setProperty: #dragByCenterOfRotation toValue: true.
			self startDrag: evt with: rotationHandle"].
	evt hand showTemporaryCursor: Cursor blank! !


!MenuItemMorph methodsFor: 'drawing' stamp: 'sw 8/21/2008 13:23'!
drawOn: aCanvas
	"Draw the menu item, including icons, markers; apply appropriate color and centering."

	| stringColor stringBounds leftEdge outerBounds stringWidth |
	isSelected & isEnabled
		ifTrue: [
			aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle.
			stringColor := color negated]
		ifFalse: [stringColor := color].

	leftEdge := 0.
	self hasIcon
		ifTrue: [| iconForm | 
			iconForm := isEnabled ifTrue:[self icon] ifFalse:[self icon asGrayScale].
			aCanvas paintImage: iconForm at: self left @ (self top + (self height - iconForm height // 2)).
			leftEdge := iconForm width + 2].

	self hasMarker
		ifTrue: [ leftEdge := leftEdge + self submorphBounds width + 8 ].

	outerBounds := bounds left: bounds left + leftEdge.

	stringWidth := Preferences standardMenuFont widthOfString: contents.
	stringBounds := (self hasProperty: #centered)
		ifFalse:
			[outerBounds]
		ifTrue:
			[outerBounds insetBy: (((outerBounds  width - stringWidth) max: 0) // 2) @ 0].
		
	aCanvas
		drawString: contents
		in: stringBounds
		font: self fontToUse
		color: stringColor.

	stringBounds := stringBounds origin extent: (stringWidth+ 3) @ stringBounds height.
	self drawExtraIconOn: aCanvas forStringBounds: stringBounds.
	subMenu
		ifNotNil: [aCanvas paintImage: SubMenuMarker at: self right - 8 @ (self top + self bottom - SubMenuMarker height // 2)]! !


!PolygonMorph methodsFor: 'event handling' stamp: 'sw 8/21/2008 22:21'!
mouseDown: evt
	"Handle a mouse-down event."

	^ (evt shiftPressed and: [(self hasProperty: #activateOnShift) not])
		ifTrue: [((owner isKindOf: PolygonMorph) and: [owner includesHandle: self])
					ifTrue: ["Prevent insertion handles from getting edited"
							^ super mouseDown: evt].
				self toggleHandles.
				handles ifNil: [^ self].
				vertices withIndexDo:  "Check for click-to-drag at handle site"
					[:vertPt :vertIndex |
					((handles at: vertIndex*2-1 ifAbsent: [ ^self ]) containsPoint: evt cursorPoint) ifTrue:
						["If clicked near a vertex, jump into drag-vertex action"
						evt hand newMouseFocus: (handles at: vertIndex*2-1)]]]
		ifFalse: [super mouseDown: evt]! !


!PopUpMenu methodsFor: 'basic control sequence' stamp: 'sw 8/13/2008 22:21'!
startUpWithCaption: captionOrNil at: location allowKeyboard: allowKeyboard centered: centered
	"Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released,
	Answer the index of the current selection, or zero if the mouse is not released over  any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard
	If centered is true, the menu items are displayed centered.."

	| maxHeight aMenu |
	(ProvideAnswerNotification signal: captionOrNil) ifNotNilDo:
		[:answer | ^ selection _ answer ifTrue: [1] ifFalse: [2]].
		 
	maxHeight _ Display height*3//4.
	self frameHeight > maxHeight ifTrue:
		[^ self
			startUpSegmented: maxHeight
			withCaption: captionOrNil
			at: location
			allowKeyboard: allowKeyboard].

	Smalltalk isMorphic
		ifTrue:[
			selection _ Cursor normal showWhile:
				[aMenu := MVCMenuMorph from: self title: captionOrNil.
				centered ifTrue:
					[aMenu submorphs allButFirst do:
						[:m | m setProperty: #centered toValue: true]].
				aMenu
					invokeAt: location 
					in: ActiveWorld
					allowKeyboard: allowKeyboard].
			^ selection].

	frame ifNil: [self computeForm].
	Cursor normal showWhile:
		[self
			displayAt: location
			withCaption: captionOrNil
			during: [self controlActivity]].
	^ selection! !


!PopUpMenu class methodsFor: 'dialogs' stamp: 'sw 8/13/2008 22:35'!
informCenteredAboveCursor: aString
	"Put up an informer showing the given string in a box, with the OK button for dismissing the informer having the cursor at its center."

	"PopUpMenu informCenteredAboveCursor: 'I like Squeak
how about you?'"

	| lines maxWid xCoor |
	lines := Array streamContents: [:aStream |
		aString linesDo: [:l | aStream nextPut: l]].
	maxWid := (lines collect: [:l |  Preferences standardMenuFont widthOfString: l]) max.
	xCoor := ActiveHand cursorPoint x - (maxWid // 2).
	((xCoor + maxWid) > ActiveWorld right) ifTrue:
		[xCoor := ActiveWorld right].  "Caters to problematic PopUpMenu boundary behavior"

	(PopUpMenu labels: 'OK' translated) startUpWithCaption: aString
			at: (xCoor  @ ActiveHand cursorPoint y)
			allowKeyboard: true centered: true

! !

!PopUpMenu class methodsFor: 'dialogs' stamp: 'sw 8/13/2008 22:27'!
inform: aString
	"Pop up a box on the screen showing the given string; provide an OK button beneath the box."

	"PopUpMenu inform: 'I like Squeak'"

	(PopUpMenu labels: 'OK' translated)
		startUpWithCaption: aString at: (ActiveHand ifNil:[Sensor]) cursorPoint allowKeyboard: Preferences menuKeyboardControl centered: true! !

"Postscript:"
Preferences enable: #showDirectionForSketches.
!