magnifying glass

Framework BRL.D3D7Max2D
Import BRL.Math
Import BRL.Pixmap
Import BRL.PNGLoader

' modules which may be required:
' Import BRL.BMPLoader
' Import BRL.TGALoader
' Import BRL.JPGLoader


SetGraphicsDriver D3D7Max2DDriver()

'**************************************
'*            LENS EFFECT             *
'*              OS 2000               *
'*     Credits To : maLi/FiNESSE      *
'*    For the lens effect routine     *
'*                                    *
'*  I don't know HOW this routine     *
'*  works but it works ! '-)          *
'*                                    *
'**************************************

Global mx,my
Global d=300 'Change this value To increase/decrease size of lens (Max 100 on my P300 !)
Global r=Int(d/2)
Global m=20 'Change this value To increase/decrease magnification factor
Global s#=Sqr(r*r-m*m)
Global sphere:TPixmap 
Global tfm[d*d*2]
Global org[d*d*2]
Global mouseon% = True

Graphics 1024,768,32

Lense()

Global backpicture:TPixmap = LoadPixmap("forlense.png")
Global pixformat% = PixmapFormat(backpicture)
sphere = CreatePixmap(d,d,pixformat)

Global nx% = 1
Global ny% = 1
HideMouse()
Repeat
	Cls
	DrawPixmap backpicture,0,0
	If mouseon
		mx = MouseX()
		my = MouseY()
		If mx => 1024-d Then mx = 1024-d 
		If my >=  768-d Then my = 768-d 
	Else
		mx:+nx*8 
		my:+ny*8 
		If mx => 1024-(d+8) And nx = 1 Then nx = -nx 
		If mx =< 0 And nx = -1 Then nx=-nx
		If my >= 768-(d+8) And ny = 1 Then ny = -ny 
		If my =< 0 And ny = -1 Then ny=-ny
	EndIf
	CopyOrg()
	draw()
	Flip(0)
Until KeyHit(key_escape)
End



'***************************************
'*       Precalculate lens           *
'***************************************

Function Lense()
Local x,y,a,b,z
For y=-r To -r+(d-1)
	For x=-r To r+(d-1)
		If (x*x+y*y)>=(s*s)
			a=x
			b=y
		Else
			z=Sqr(r*r-x*x-y*y)
			a=Int(x*m/z+.8)
			b=Int(y*m/z+.8)
		EndIf
		tfm(1+(y+r)*d+(x+r))=(b+r)*d+(a+r)
	Next
Next
End Function


'***************************************
'* Copy original pixel color To array  *
'***************************************

Function CopyOrg()
Local x=0,i,j 
For i=MX To (MX+d)-1
	For j=MY To (MY+d)-1
		org[x] = ReadPixel(backpicture,i,j)
		x=x+1
	Next
Next
End Function

'***************************************
'*      magnify to screen              *
'***************************************

Function draw()
	x=1
	For i=0 To d-1
		For j=0 To d-1
			WritePixel(sphere,i,j,org[tfm[x]])
			x=x+1
		Next
	Next
	DrawPixmap(sphere,mx,my)
End Function