[GOODIE] Magnifier

Bert Freudenberg bert at isgnw.CS.Uni-Magdeburg.De
Mon Sep 27 08:26:47 UTC 1999


A magnifying glass morph. If you drag it around it magnifies the stuff
below. It can track the pointer's position, too. 

Bug: Since it redraws only if the pointer's position changes (to reduce
cpu time), you have to move the mouse constantly when magnifying an
animation. 

  /bert

Content-Type: TEXT/PLAIN; CHARSET=US-ASCII; NAME="Magnifier-bf.22Sep359pm.cs"
Content-ID: <Pine.LNX.3.96.990927101907.31728M at balloon.cs.uni-magdeburg.de>
Content-Description: 

'From Squeak 2.5 of August 6, 1999 on 22 September 1999 at 3:59:38 pm'!
"Change Set:		magnifier-bf
Date:			16 September 1999
Author:			Bert Freudenberg

Provides a magnifying glass."!

BorderedMorph subclass: #MagnifierMorph
	instanceVariableNames: 'magnification trackPointer lastPos srcExtent '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Demo'!

!MagnifierMorph commentStamp: 'bf 9/20/1999 16:17' prior: 0!
Provides a magnifying glass. Magnifies the morphs below (if grabbed) or the area around the mouse pointer.!

!MagnifierMorph methodsFor: 'initialization' stamp: 'bf 9/20/1999 15:54'!
initialize
	super initialize.
	trackPointer _ true.
	magnification _ 2.
	color _ Color black.
	borderWidth _ 1.
	lastPos _ self sourcePoint.
	self extent: 128 at 128.

! !

!MagnifierMorph methodsFor: 'geometry' stamp: 'bf 9/21/1999 09:31'!
borderWidth: anInteger
	"Grow outwards preserving innerBounds"
	| c |  
	c _ self center.
	super borderWidth: anInteger.
	super extent: self defaultExtent.
	self center: c.! !

!MagnifierMorph methodsFor: 'geometry' stamp: 'bf 9/21/1999 09:22'!
defaultExtent
	^(srcExtent * magnification) truncated + (2 * borderWidth)! !

!MagnifierMorph methodsFor: 'geometry' stamp: 'bf 9/21/1999 09:23'!
extent: aPoint
	"Round to multiples of magnification"
	srcExtent _ (aPoint - (2 * borderWidth)) // magnification.
	^super extent: self defaultExtent! !

!MagnifierMorph methodsFor: 'drawing' stamp: 'bf 9/20/1999 15:56'!
drawOn: aCanvas
	super drawOn: aCanvas.		"border and fill"
	aCanvas isShadowDrawing ifFalse: [
		"Optimize because #magnifiedForm is expensive"
		aCanvas image: self magnifiedForm at: self innerBounds origin]! !

!MagnifierMorph methodsFor: 'drawing' stamp: 'bf 9/21/1999 08:51'!
hasTranslucentColor
	"I may show what's behind me, so tell the hand to don't cache"
	^self sourceRect intersects: self bounds! !

!MagnifierMorph methodsFor: 'stepping' stamp: 'bf 9/20/1999 15:34'!
step
	lastPos = self sourcePoint
		ifFalse: [self changed]! !

!MagnifierMorph methodsFor: 'stepping' stamp: 'bf 9/18/1999 19:25'!
stepTime
	^50! !

!MagnifierMorph methodsFor: 'events' stamp: 'bf 9/18/1999 20:42'!
handlesMouseDown: evt
	^evt yellowButtonPressed
		or: [super handlesMouseDown: evt]! !

!MagnifierMorph methodsFor: 'events' stamp: 'bf 9/21/1999 10:45'!
mouseDown: evt
	evt yellowButtonPressed
		ifTrue: [self chooseMagnification: evt]
		ifFalse: [super mouseDown: evt]! !

!MagnifierMorph methodsFor: 'menu' stamp: 'bf 9/20/1999 15:53'!
addCustomMenuItems: aCustomMenu hand: aHandMorph
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu
		addLine;
		add: 'magnification...' action: #chooseMagnification;
		addUpdating: #trackingPointerString action: #toggleTrackingPointer.! !

!MagnifierMorph methodsFor: 'menu' stamp: 'bf 9/20/1999 13:54'!
chooseMagnification
	| result |
	result _ (SelectionMenu selections: #(1.5 2 4 8))
		startUpWithCaption: 'Choose magnification
(currently ', magnification printString, ')'.
	(result isNil and: [magnification ~= result]) ifFalse: [
		magnification _ result.
		self extent: self extent. "round to new magnification"
		self changed].! !

!MagnifierMorph methodsFor: 'menu' stamp: 'bf 9/21/1999 12:09'!
chooseMagnification: evt
	| handle origin aHand currentMag |
	currentMag _ magnification.
	aHand _ evt ifNil: [self currentHand] ifNotNil: [evt hand].
	origin _ aHand gridPointRaw y.
	handle _ HandleMorph new forEachPointDo:
		[:newPoint | self magnification: (newPoint y - origin) / 8.0 + currentMag].
	aHand attachMorph: handle.
	handle startStepping.
	self changed. "Magnify handle"! !

!MagnifierMorph methodsFor: 'menu' stamp: 'bf 9/20/1999 15:48'!
toggleTrackingPointer
	trackPointer _ trackPointer not! !

!MagnifierMorph methodsFor: 'menu' stamp: 'bf 9/20/1999 15:49'!
trackingPointerString
	^trackPointer
		ifTrue: ['stop tracking pointer']
		ifFalse: ['start tracking pointer']! !

!MagnifierMorph methodsFor: 'magnifying' stamp: 'bf 9/21/1999 12:27'!
magnification: aNumber
	| c |  
	magnification _ aNumber min: 8 max: 0.5.
	magnification _ magnification roundTo:
		(magnification < 3 ifTrue: [0.5] ifFalse: [1]).
	srcExtent _ srcExtent min: (512 at 512) // magnification. "to prevent accidents"
	c _ self center.
	super extent: self defaultExtent.
	self center: c.! !

!MagnifierMorph methodsFor: 'magnifying' stamp: 'bf 9/21/1999 08:46'!
magnifiedForm
	| srcRect form |
	lastPos _ self sourcePoint.
	srcRect _ self sourceRectFrom: lastPos.
	"cheaper method if the source is not occluded"
	form _ (srcRect intersects: self bounds)
		ifTrue: [self world patchAt: srcRect without: self andNothingAbove: false]
		ifFalse: [Display copy: srcRect].
	"smooth if non-integer scale"
	^form magnify: form boundingBox
		by: magnification
		smoothing: (magnification isInteger ifTrue: [1] ifFalse: [2]).
! !

!MagnifierMorph methodsFor: 'magnifying' stamp: 'bf 9/20/1999 15:38'!
sourcePoint
	"If we are being dragged use our center, otherwise use pointer position"
	^(trackPointer not or: [owner isKindOf: HandMorph])
		ifTrue: [self center]
		ifFalse: [self currentHand lastEvent cursorPoint]! !

!MagnifierMorph methodsFor: 'magnifying' stamp: 'bf 9/21/1999 08:47'!
sourceRect
	^self sourceRectFrom: self sourcePoint
! !

!MagnifierMorph methodsFor: 'magnifying' stamp: 'bf 9/21/1999 09:16'!
sourceRectFrom: aPoint
	^(aPoint extent: srcExtent) translateBy: (srcExtent // -2).
! !





More information about the Squeak-dev mailing list