'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6662] on 10 May 2005 at 4:28:30 pm'!
"Change Set:		CMagnifier-3
Date:			10 May 2005
Author:			Takashi Yamamiya

CMagnifier is a similar object as etoys' magnifier in Tweak.
See PartsBin,"!

CPlayer subclass: #CMagnifier
	instanceVariableNames: '<?xml  version="1.0" ?>
<fields>
	<field virtual="true" serializable="false" toGet="trackPointer" toSet="trackPointer:">trackPointer</field>
	<field toGet="showPointer" toSet="showPointer:" changeEvent="showPointerChanged">showPointer</field>
	<field toGet="sourcePlayer" toSet="sourcePlayer:" changeEvent="sourcePlayerChanged">sourcePlayer</field>
</fields>'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tweak-EToys'!

!CMagnifier commentStamp: '<historical>' prior: 0!
CMagnifierPlayer instances are magnifying lenses that magnify the player below them (if grabbed or if trackPointer is false) or the area around the mouse pointer.
Each parameter is controlled by a slot in viewer.

Instance variables:

magnification	<Number> The magnification to use. If non-integer, smooths the magnified form.

sourcePlayer	<CPlayer> indicates the position of the source area.

trackPointer		<Boolean> If set, magnifies the area around the Hand. If not, magnfies the area underneath the magnifier center.

showPointer		<Boolean> If set, display a small reversed rectangle in the center of the lens. Also enables the display of Morphs in the Hand itself.

CMagnifierPlayer new openInHand!

TestCase subclass: #CMagnifierTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tweak-EToys'!
CPlayer subclass: #CScreeningCostume
	instanceVariableNames: '<?xml  version="1.0" ?>
<fields>
	<field toGet="screen" toSet="screen:" changeEvent="screenChanged">screen</field>
	<field toGet="passingColor" toSet="passingColor:" changeEvent="passingColorChanged">passingColor</field>
</fields>'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tweak-EToys'!

!CScreeningCostume commentStamp: '<historical>' prior: 0!
I am a costume like ScreeningMorph. screen is used as 1-bit mask, the passing color is decided from the center pixel of screen.

Structure:
	screen		CPlayer -- a player used as mask.
	passingColor Color -- a passing color of screen player.!


!CMagnifier methodsFor: 'initialize' stamp: 'tak 5/9/2005 15:57'!
initialize
	super initialize
	showPointer := false.
! !

!CMagnifier methodsFor: 'initialize' stamp: 'tak 5/9/2005 16:08'!
setupCostume
	super setupCostume.
	self graphicEnabled: true.
	self scale := 2.
	self color := Color transparent.
	self extent := 128 @ 128.
	self graphicFit := #rigid.

	self borderWidth := 1.
	self borderColor := Color black.
	self borderStyle := #simple.

	sourcePlayer := self hand.
! !

!CMagnifier methodsFor: 'accessing' stamp: 'tak 4/30/2005 20:05'!
showPointer
	"Answer the showPointer of the receiver"
	<bewareOf: #showPointerChanged>
	^self propertyValueAt: #showPointer! !

!CMagnifier methodsFor: 'accessing' stamp: 'tak 4/30/2005 20:05'!
showPointer: aValue
	"Modify the receiver's showPointer"
	^self propertyValueAt: #showPointer put: aValue with: #showPointerChanged! !

!CMagnifier methodsFor: 'accessing' stamp: 'tak 5/5/2005 17:08'!
sourcePlayer
	"Answer the sourcePlayer of the receiver"
	<bewareOf: #sourcePlayerChanged>
	^self propertyValueAt: #sourcePlayer! !

!CMagnifier methodsFor: 'accessing' stamp: 'tak 5/5/2005 17:08'!
sourcePlayer: aValue
	"Modify the receiver's sourcePlayer"
	^self propertyValueAt: #sourcePlayer put: aValue with: #sourcePlayerChanged! !

!CMagnifier methodsFor: 'accessing' stamp: 'tak 5/5/2005 17:38'!
trackPointer
	"Answer the trackPointer of the receiver"
	^ sourcePlayer = self hand! !

!CMagnifier methodsFor: 'accessing' stamp: 'tak 5/9/2005 15:55'!
trackPointer: aValue
	"It provides same protocol of MagnifierMorph"
	aValue
		ifTrue: [sourcePlayer := self hand]
		ifFalse: [sourcePlayer := self]
! !

!CMagnifier methodsFor: 'updating' stamp: 'tak 5/9/2005 12:20'!
updateGraphics
	self root
		ifNotNil: [self graphic: self sourceForm]! !

!CMagnifier methodsFor: 'updating' stamp: 'tak 5/5/2005 17:42'!
updatePosition
	<on: frameChanged in: sourcePlayer>
	self updateGraphics! !

!CMagnifier methodsFor: 'updating' stamp: 'tak 5/9/2005 09:16'!
updateTick
	<ticking: 10>
	self updateGraphics.
	self invalidate! !

!CMagnifier methodsFor: 'magnifying' stamp: 'tak 5/9/2005 16:12'!
sourceForm
	"Answer the source form"
	| srcRect srcForm |
	srcRect _ self sourceRectFrom: sourcePlayer center.
	srcForm _ (srcRect intersects: self globalBounds)
				ifTrue: [self root asPrimCostume
						patchAt: srcRect
						without: self
						andNothingAbove: false]
				ifFalse: ["optimization"
					self root display copy: srcRect].
	showPointer
		ifTrue: [srcForm
				reverse: (srcForm center - (1 @ 1) extent: 2 @ 2)
				fillColor: Color white].
	^ srcForm! !

!CMagnifier methodsFor: 'magnifying' stamp: 'tak 5/9/2005 16:06'!
sourceRectFrom: aPoint 
	| srcExtent |
	srcExtent _ self localBounds extent - (2 * borderWidth).
	^ (aPoint extent: srcExtent)
		translateBy: srcExtent // -2! !


!CMagnifier class methodsFor: 'class initialization' stamp: 'tak 5/2/2005 16:22'!
initialize
	"self initialize"
	self registerWithPartsBin.
! !

!CMagnifier class methodsFor: 'class initialization' stamp: 'tak 5/9/2005 14:06'!
newbornPartToDropIn: player
	^ super newbornPartToDropIn: player! !

!CMagnifier class methodsFor: 'class initialization' stamp: 'tak 5/10/2005 15:57'!
registerWithPartsBin
	"Register the receiver in the basic category"
	CPartsBin
		registerPartDescription: (CPartDescription
				partDescriptionWithLabel: 'Magnifier'
				balloonHelp: 'A magnifying glass'
				category: 'miscellaneous'
				creator: self
				selector: #newbornPartToDropIn:
				customForm: nil).
	CPartsBin
		registerPartDescription: (CPartDescription
				partDescriptionWithLabel: 'RoundGlass'
				balloonHelp: 'A round magnifying glass'
				category: 'miscellaneous'
				creator: self
				selector: #newRound
				customForm: nil)! !

!CMagnifier class methodsFor: 'instance creation' stamp: 'tak 5/9/2005 17:01'!
newRound
	"CMagnifierPlayer newRound openInHand"
	| aMagnifier costume screen |
	aMagnifier _ self new.
	costume := CScreeningCostume new.
	screen := CEllipsePlayer new.
	screen bounds := aMagnifier bounds.
	screen color := Color gray.
	aMagnifier costume: costume.
	costume screen: screen.
	aMagnifier setupCostume.
	aMagnifier name: 'Round glass'.
	^ aMagnifier! !


!CMagnifierTest methodsFor: 'testing' stamp: 'tak 5/9/2005 16:25'!
testNewRound
	"self debug: #testNewRound"
	| mag |
	mag _ CMagnifier newRound.
	self assert: mag costume screen class == CEllipsePlayer.! !

!CMagnifierTest methodsFor: 'testing' stamp: 'tak 5/6/2005 15:02'!
testScreen
	"self debug: #testScreen"
	| c screen |
	c _ CScreeningCostume new.
	c screen: (screen _ CEllipsePlayer new color: Color red; yourself).
	self assert: c passingColor = Color red.
! !

!CMagnifierTest methodsFor: 'testing' stamp: 'tak 5/9/2005 16:25'!
testSourceRect
	"self debug: #testSourceRect"
	| p |
	p _ CMagnifier new.
	p scale: 1.
	p extent: 10 @ 10.
	p borderWidth: 2.
	self assert: (p sourceRectFrom: 0@0) = (-3@-3 extent: 6@6).

	p scale: 2.
	p extent: 10 @ 10.
	p borderWidth: 2. "actually 4"
	self assert: (p sourceRectFrom: 0@0) = (-1@-1 extent: 1@1).
! !


!CPartPrecursor methodsFor: 'events' stamp: 'tak 5/9/2005 16:23'!
onDropped
	"Invoked when the receiver has been dropped in a container.  Create the actual object and transform the receiver into that objec.t"

	| theNewInstance |
	<on: dropAccept>
	(container == nil or: [partDescription == nil]) ifTrue: [^ self].  "Both have been seen..."
	theNewInstance _ partDescription newInstanceIn: container.
	container elements replace: self with: theNewInstance.
	theNewInstance position: self position. "keep scale"
	self destroy "is necessary for terminating scripts etc?  probably not"! !


!CPartsBin class methodsFor: 'standard default parts bin' stamp: 'tak 5/9/2005 16:25'!
addDescriptionsForMiscellaneous
	"Add part descriptions for miscellaneous category"

	self addDescriptionsFor: #miscellaneous from: #(
		(CEToyHolder		'Holder'			'A container for other objects')
		(CTrashCan			'TrashCan'		'A place for discarding things')
		(CStopStepGoControls 'Script Controls'	'Controls for the scripts in this project')).

	CStickyPad registerWithPartsBin.  "on account of custom form"
	CMagnifier registerWithPartsBin.

! !


!CScreeningCostume methodsFor: 'accessing' stamp: 'tak 5/6/2005 10:02'!
mergeWith: aForm 
	| mergeForm |
	mergeForm _ aForm copy.
	(BitBlt current toForm: mergeForm)
		copyForm: self screenForm
		to: 0 @ 0
		rule: Form and
		colorMap: (Bitmap with: 0 with: 4294967295).
	^ mergeForm! !

!CScreeningCostume methodsFor: 'accessing' stamp: 'tak 5/5/2005 20:22'!
passingColor
	"Answer the passingColor of the receiver"
	<bewareOf: #passingColorChanged>
	^self propertyValueAt: #passingColor! !

!CScreeningCostume methodsFor: 'accessing' stamp: 'tak 5/5/2005 20:22'!
passingColor: aValue
	"Modify the receiver's passingColor"
	^self propertyValueAt: #passingColor put: aValue with: #passingColorChanged! !

!CScreeningCostume methodsFor: 'accessing' stamp: 'tak 5/5/2005 20:22'!
screen
	"Answer the screen of the receiver"
	<bewareOf: #screenChanged>
	^self propertyValueAt: #screen! !

!CScreeningCostume methodsFor: 'accessing' stamp: 'tak 5/6/2005 15:19'!
screen: aValue
	"Modify the receiver's screen"
	passingColor := aValue asForm colorAt: aValue center.
	self border _ aValue border copy.
	^self propertyValueAt: #screen put: aValue with: #screenChanged! !

!CScreeningCostume methodsFor: 'initialize' stamp: 'tak 5/6/2005 14:15'!
initialize
	super initialize.
	self userDraw := true.
	screen := CEllipsePlayer new color: Color gray; yourself.
! !

!CScreeningCostume methodsFor: 'drawing' stamp: 'tak 5/6/2005 11:35'!
drawOn: aCanvas in: drawingBounds 
	screen drawOn: aCanvas in: drawingBounds.
	aCanvas
		paintImage: (self mergeWith: self sourceForm)
		at: drawingBounds origin! !

!CScreeningCostume methodsFor: 'drawing' stamp: 'tak 5/6/2005 07:52'!
screenForm
	| screenForm screenImage colorMap pickValue elseValue |
	passingColor ifNil: [passingColor := Color black].
	pickValue := 4294967295.
	elseValue := 0.
	screenImage := screen costume asFormOfDepth: Display depth.
	colorMap := screenImage newColorMap atAllPut: elseValue.
	colorMap
		at: (passingColor indexInMap: colorMap)
		put: pickValue.
	screenForm := Form extent: screenImage extent.
	screenForm
		copyBits: screenForm boundingBox
		from: screenImage
		at: 0 @ 0
		colorMap: colorMap.
	^ screenForm! !

!CScreeningCostume methodsFor: 'drawing' stamp: 'tak 5/9/2005 16:17'!
sourceForm
	| box aCanvas |
	box _ self localBounds.
	aCanvas _ CTransformCanvas extent: box extent depth: Display depth.
	aCanvas
		translateBy: box origin negated
		during: [:cc | costume drawOn: cc in: box].
	^ aCanvas form! !

!CScreeningCostume methodsFor: 'events' stamp: 'tak 5/6/2005 15:19'!
onBorderChanged
	<on: borderChanged>
	screen border := border copy! !

!CScreeningCostume methodsFor: 'events' stamp: 'tak 5/6/2005 12:03'!
onExtentChanged
	<on: extentChanged>
	screen extent := extent! !


!CScreeningCostume class methodsFor: 'examples' stamp: 'tak 5/6/2005 14:59'!
example1
	"self example1"
	| player |
	player _ CTrashCan new.
	player costume: self new.
	player costume screen: (CPolygonPlayer new color: Color gray; yourself).
	player openInHand.! !

!CScreeningCostume class methodsFor: 'examples' stamp: 'tak 5/6/2005 15:24'!
example2
	"self example2"
	| player |
	player _ CTrashCan new.
	player costume: self new.
	player costume screen: (CEllipsePlayer new color: Color gray; yourself).
	player costume costume: self new.
	player costume costume screen: (CPolygonPlayer new color: Color gray; borderWidth: 0; yourself).
	player openInHand.! !


!CTileDefinition class methodsFor: 'reading' stamp: 'tak 5/9/2005 16:27'!
defaultViewerSpec
	"CTileDefinition readXmlFrom: self defaultViewerSpec readStream"
^'
<viewer type="CPlayer">

	<category name="basic">
		<message selector="makeSound:" name="make sound:" help="Make the specified sound">
			<argument name="aSound" type="CSoundNameType" default="croak"/>
		</message>
		<message selector="forwardBy:" name="forward by:" help="">
			<argument name="delta" type="CNumberType" default="5"/>
		</message>
		<message selector="turnBy:" name="turn by:" help="">
			<argument name="delta" type="CNumberType" default="5"/>
		</message>
		<slot selector="x" name="x" type="CNumberType" help="The x coordinate"/>
		<slot selector="y" name="y" type="CNumberType" help="The y coordinate"/>
		<slot selector="angle" name="heading" type="CNumberType" help="The heading"/>
	</category>


	<category id="scripts" name="scripts">
		<message selector="emptyScript" name="emptyScript" help="The empty script"/>
	</category>

	<category name="variables">
	</category>

	<category name="and or not" type="CBooleanType">
		<operator selector="=" name="=" type="CBooleanType" 
				help="True if the values are equal">
			<receiver name="A" type="CBooleanType" default="true"/>
			<argument name="B" type="CBooleanType" default="true"/>
		</operator>
		<operator selector="&amp;" name="and" type="CBooleanType" 
				help="True if the values are both true">
			<receiver name="A" type="CBooleanType" default="true"/>
			<argument name="B" type="CBooleanType" default="true"/>
		</operator>
		<operator selector="|" name="or" type="CBooleanType" 
				help="True if at least one of the values is true">
			<receiver name="A" type="CBooleanType" default="true"/>
			<argument name="B" type="CBooleanType" default="false"/>
		</operator>
		<message selector="not" name="not" type="CBooleanType" 
				help="The opposite value">
			<receiver name="A" type="CBooleanType" default="true"/>
		</message>
	</category>

	<category name="button" type="CButton">
		<slot selector="label" type="CStringType" help="The button label"/>
		<slot selector="image" type="CImageResourceType" help="The button image"/>
		<slot selector="state" type="CButtonStateType" help="The button state"/>
		<slot selector="selected" type="CBooleanType" help="The selection state"/>
		<slot selector="value" type="CBooleanType" help="The button label"/>
		<message selector="select"/>
		<message selector="deselect"/>
		<message selector="fire" help="fire the button"/>
		<message selector="enable"/>
		<message selector="disable"/>
	</category>

	<category name="color and border">
		<message selector="color:sees:" name="color:sees:" type="CBooleanType">
			<argument name="myColor" type="CColorType" default="blue"/>
			<argument name="aColor" type="CColorType" default="red"/>
		</message>
		<slot selector="color" name="color" type="CColorType"/>
		<slot selector="fillStyle" name="fillStyle" type="CFillStyleType"/>
		<slot selector="borderWidth" name="borderWidth" type="CIntegerType"/>
		<slot selector="borderColor" name="borderColor" type="CColorType"/>
		<slot selector="borderStyle" name="borderStyle" type="CBorderStyleType"/>
		<slot selector="roundCorners" name="roundedCorners" type="CBooleanType"/>
		<slot selector="dropShadowEnabled" name="shadowEnabled" type="CBooleanType"/>
		<slot selector="dropShadowColor" name="shadowColor" type="CColorType"/>
	</category>
	

	<category name="comparison">
		<operator selector="=" name="=" type="CBooleanType" 
				help="True if the numbers are equal">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="1"/>
		</operator>
		<operator selector=">" name=">" type="CBooleanType" 
				help="True if the first number is greater">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="1"/>
		</operator>
		<operator selector="<" name="<" type="CBooleanType" 
				help="True if the first number is less">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="1"/>
		</operator>
	</category>

	<category name="control">
		<operator selector="ifTrue:" name="if" help="control structure">
			<receiver name="Condition" type="CBooleanType" default="false"/>
			<argument name="trueBlock" type="CBlockType"/>
		</operator>
		<message selector="forEach:do:until:" name="foreach" help="control structure">
			<argument name="event" type="CEventType" default="mouseMove"/>
			<argument name="block" type="CBlockType"/>
			<argument name="stopEvent" type="CEventType" default="mouseUp"/>
		</message>
		<operator selector="timesRepeat:" name="repeat" help="control structure">
			<receiver name="count" type="CNumberType" default="5"/>
			<argument name="block" type="CBlockType"/>
		</operator>
		<message selector="wait:" name="wait" help="wait for seconds">
			<argument name="duration" type="CNumberType" default="1.0"/>
		</message>
	</category>

	<category name="geometry">
		<slot selector="x" name="x" type="CNumberType" help="The x coordinate"/>
		<slot selector="y" name="y" type="CNumberType" help="The y coordinate"/>
		<slot selector="angle" name="heading" type="CNumberType" help="The heading"/>
		<slot selector="scale" name="scale" type="CNumberType"/>
		<slot selector="left" name="left" type="CNumberType"/>
		<slot selector="right" name="right" type="CNumberType"/>
		<slot selector="top" name="top" type="CNumberType"/>
		<slot selector="bottom" name="bottom" type="CNumberType"/>

		<slot selector="width" name="width" type="CNumberType"/>
		<slot selector="height" name="height" type="CNumberType"/>
	</category>

	<category name="images" type="CImageButton">
		<slot selector="normalImage" type="CImageResourceType"/>
		<slot selector="overImage" type="CImageResourceType"/>
		<slot selector="pressedImage" type="CImageResourceType"/>
		<slot selector="disabledImage" type="CImageResourceType"/>
		<slot selector="selectedImage" type="CImageResourceType"/>
	</category>

	<category name="text editor" type="CTextEditor">
		<slot selector="selectionStart" type="CIntegerType"/>
		<slot selector="selectionStop" type="CIntegerType"/>
		<slot selector="selection" type="CStringType"/>
		<slot selector="allowEditing" type="CBooleanType"/>
		<slot selector="hScrollable" type="CBooleanType"/>
		<slot selector="vScrollable" type="CBooleanType"/>
		<message selector="findText:" name="find text" help="find a portion of text">
			<argument name="aString" type="CStringType" default=""/>
		</message>
		<message selector="append:" name="append text" help="append the text">
			<argument name="aString" type="CStringType" default=""/>
		</message>
		<message selector="enter" name="enter" help="simulate the enter key"/>
		<message selector="undo" name="undo" help="undo last editing"/>
		<message selector="redo" name="redo" help="redo last editing"/>
	</category>

	<category name="label" type="CLabel">
		<slot selector="value" type="CStringType" help="The label text"/>
	</category>


	<category name="list" type="CList">
		<slot selector="cursor" type="CNumberType"/>
		<message selector="next"/>
		<message selector="prev"/>
	</category>

	<category name="math">
		<operator selector="+" name="+" type="CNumberType" help="Add two values">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="1"/>
		</operator>
		<operator selector="-" name="-" type="CNumberType" help="Subtract two values">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="1"/>
		</operator>
		<operator selector="*" name="*" type="CNumberType" help="Multiply two values">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="1"/>
		</operator>
		<operator selector="/" name="/" type="CNumberType" help="Divide two values">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="1"/>
		</operator>
		<operator selector="raisedTo:" name="raised to:" type="CNumberType" help="Power of two values">
			<receiver name="A" type="CNumberType" default="1"/>
			<argument name="B" type="CNumberType" default="2"/>
		</operator>
	</category>

	<category name="math2">
		<operator selector="abs" name="absolute" type="CNumberType" 
				help="Make into a positive number">
			<receiver name="A" type="CNumberType" default="-5"/>
		</operator>
		<operator selector="truncated" name="truncate" type="CNumberType" 
				help="The whole number part">
			<receiver name="A" type="CNumberType" default="3.2"/>
		</operator>
		<operator selector="atRandom" name="random" type="CNumberType" 
				help="The whole number part">
			<receiver name="A" type="CIntegerType" default="180"/>
		</operator>
	</category>

	<category name="slider" type="CSlider">
		<slot selector="value" type="CNumberType" help="The current value"/>
		<slot selector="min" type="CIntegerType" help="The minimum value"/>
		<slot selector="max" type="CIntegerType" help="The maximum value"/>
		<slot selector="step" type="CIntegerType" help="The step value"/>
		<message selector="next"/>
		<message selector="prev"/>
	</category>

	<category name="scripting">
		<message selector="startScript:" name="start script" help="Start this script">
			<argument name="aScript" type="CScriptNameType" default="emptyScript"/>
		</message>
		<message selector="stopScript:" name="stop script" help="Stop this script">
			<argument name="aScript" type="CScriptNameType" default="emptyScript"/>
		</message>
		<message selector="pauseScript:" name="pause script" help="Pause this script">
			<argument name="aScript" type="CScriptNameType" default="emptyScript"/>
		</message>
		<message selector="resumeScript:" name="resume script" help="Resume this script">
			<argument name="aScript" type="CScriptNameType" default="emptyScript"/>
		</message>
		<message selector="startTicking:at:" name="start ticking:at:" help="Start to tick this script">
			<argument name="aScript" type="CScriptNameType" default="emptyScript"/>
			<argument name="aFrequency" type="CNumberType" default="8"/>
		</message>
	</category>

	<category name="pen">
		<slot selector="penDown" name="pen down" type="CBooleanType" />
		<slot selector="penColor" name="pen color" type="CColorType" />
		<slot selector="penWidth" name="pen down" type="CIntegerType" />
		<message selector="clearPenTrails" />
	</category>

	<category name="magnifier" type="CMagnifier">
		<slot selector="scale" name="scale" type="CNumberType"/>
		<slot selector="trackPointer" type="CBooleanType" />
		<slot selector="showPointer" type="CBooleanType" />
	</category>

</viewer>
'! !

CMagnifier initialize!