another lens demo with source [BMax]

[JumpMan]

here is a demo of a lense effect I downloaded years back from a blitzbasic website. I converted it to blitzmax. and modified from plotting to the screen to drawing  to a pixmap which made it a lot faster. hope somebody likes it.

Code: [Select]

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


[Shockwave]

That looks really really good!! 

[JumpMan]

Thank you shockwave.

[benny!]

Works like a charme here. Well done and thanks for sharing code.

Karma up !!!

[JumpMan]

Thanks Benny.

[DrFreak339]

omg.. whats wrong with blitz (3d)? i dont have bmax but i found this interesting (nice effect , so i converted it to blitz3d and its sloooooow.... its like 2 fps or something and the bmax version runs really fluidly..

[Shockwave]

BB3D is pretty slow for pixel bashing stuff like this, DrFreak. BB2D and even Blitz plus would be too. The only way you'd get away with it would be to run it in a very low resolution, maybe you'd get away with 320 X 240 if your code was keen enough.

[DrFreak339]

well, i worked it out a bit, but ive still got only ~15-20fps at 1024x768, whereas my direct translation from bmax to bb3d brought me about 2fps or something...

[Shockwave]

Forgetting the much slower results of BB3d, I think that your 20fps at 1025 X 768 is a decent rate for the type of effect, of course that is without knowing what sort of system you have running there.

[DrFreak339]

ahem.... *crappy x600se*..., 512 mb ram, athlon64 3200+

yep, the "se" IS slow... really...

[va!n]

@DrFreak339:
Have you disabled the debugger in Blitz3D?

[DrFreak339]

of course.. my debugger is always disabled
i know the stuff with debugger and speeddown and memory checks of blitz...

[va!n]

okay... it was just an idea ^^

[Jim]

I get 15fps when I port it to my ancient copy of Blitz2D

Code: [Select]

;**************************************
;*            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)
Dim tfm%(d*d*2)
Dim org%(d*d*2)
Global mouseon% = True

Graphics 1024,768,0,2

Lense()

Global backpicture% = LoadImage("forlense.png")
Global sphere% = CreateImage(d,d)

Global nx% = 1
Global ny% = 1

HidePointer()

t%=MilliSecs()
Repeat
Cls
DrawImage(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=mx+nx*8
my=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()

dt% = MilliSecs()
If dt-t > 0 Then
fps% = 1000 / (dt-t)
Text 0,0,fps+" fps"
End If
t = dt

Flip
Until KeyHit(1)
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%

Local sx%,ex%,sy%,ey%

If mx<0 sx = 0 Else sx = mx
If mx+d-1>=1024 ex = 1024-1 Else ex = mx+d-1
If my<0 sy = 0 Else sy = my
If my+d-1>=768 ey = 768-1 Else ey = my+d-1

LockBuffer ImageBuffer(backpicture)
SetBuffer ImageBuffer(backpicture)
For j=sy To ey
For i=sx To ex
org(x) = ReadPixelFast(i,j)
x=x+1
Next
Next
UnlockBuffer ImageBuffer(backpicture)
End Function

;***************************************
;*      magnify to screen              *
;***************************************

Function draw()
Local x%,i%,j%
LockBuffer ImageBuffer(sphere)
SetBuffer ImageBuffer(sphere)
x=1
For j=0 To d-1
For i=0 To d-1
WritePixel(i,j,org(tfm(x)))
x=x+1
Next
Next
UnlockBuffer ImageBuffer(sphere)
SetBuffer BackBuffer()
DrawImage(sphere,mx,my)
End Function

Jim

[DrFreak339]

my version (only 1 buffer manipulated  ) :

Code: [Select]

Global MX,MY
Global d=200,r=Int(d/2),m=50
Global s#=Sqr(r*r-m*m)
Dim tfm(d*d*2)
Dim org(d*d*2)

Graphics 1024,768,32,2
HidePointer
SetBuffer BackBuffer()

Lens()
Global bg=LoadImage("forlense.png")

Repeat
Cls
DrawImage bg,0,0

MX=MouseX():MY=MouseY()
If MX=>GraphicsWidth()-d Then MX=GraphicsWidth()-d
If MY>=GraphicsHeight()-d Then MY=GraphicsHeight()-d

LockBuffer BackBuffer()
CopyOrg()
Draw()
UnlockBuffer BackBuffer()

Flip
Until KeyHit(1)
End

Function Lens()
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+0.8):b=Int(y*m/z+0.8)
  EndIf
  tfm(1+(y+r)*d+(x+r))=(b+r)*d+(a+r)
 Next
Next
End Function

Function CopyOrg()
Local x=0,i,j
For i=MX To (MX+d)-1
 For j=MY To (MY+d)-1
  org(x)=ReadPixelFast(i,j,BackBuffer())
  x=x+1
 Next
Next
End Function

Function Draw()
x=1
For i=0 To d-1
 For j=0 To d-1
  WritePixelFast(i+MX,j+MY,org(tfm(x)))
  x=x+1
 Next
Next
End Function

[Shockwave]

That one runs at 11fps here Radeon X1650 1gb, P4 3.0 Ghz.

[Sledge]

I thought to try something similar in B3D some time ago. I got some speed by rendering a texture from the lens' point of view, but the effect is less pronounced as-is. Still, if we're covering all the bases...

Code: [Select]

Graphics3D 800,600,0,0
SetBuffer BackBuffer()

cam=CreateCamera()
PositionEntity cam,0,0,-8

light=CreateLight(2)
PositionEntity light,15,40,-28
LightRange light,240

room=CreateCube()
ScaleEntity room,10,10,10
PositionEntity room,0,5,0
FlipMesh room
EntityFX room,1

fixture=CreateCube(room)
ScaleEntity fixture,.1,.1,.1
PositionEntity fixture,.5,-.5,-.2
EntityColor fixture,100,100,200

fixture2=CreateCube(room)
ScaleEntity fixture2,.1,.1,.1
PositionEntity fixture2,0,-.5,.5
EntityColor fixture2,100,200,100

fixture3=CreateCube(room)
ScaleEntity fixture3,.1,.1,.1
PositionEntity fixture3,-.5,-.5,-.2
EntityColor fixture3,200,100,100

roomTex=CreateTexture(32,32,256)
SetBuffer TextureBuffer(roomTex)
Color 200,100,100 : Rect 0,0,32,32,True
Color 100,200,100 : Rect 0,0,16,16,True : Rect 16,16,16,16,True
SetBuffer BackBuffer()
ScaleTexture roomTex,.1,.1
EntityTexture room,roomTex

sphere=CreateSphere(32)
sphereTex=CreateTexture(256,256,256+64)
EntityTexture sphere,sphereTex
EntityShininess sphere,.1

sineBase#=0.0

While Not KeyDown(1)
;movement
PositionEntity sphere,0+Sin(sineBase),0,0
sineBase=sineBase+1.0
If sineBase>360 Then sineBase=sineBase-360

TurnEntity room,0,.1,0

;render sphere texture
PositionEntity cam,EntityX(sphere),EntityY(sphere),EntityZ(sphere)
CameraViewport cam,0,0,256,256
CameraZoom cam,4
RenderWorld
CopyRect 0,0,256,256,0,0,BackBuffer(),TextureBuffer(sphereTex)

;render scene
PositionEntity cam,0,0,-8
CameraViewport cam,0,0,800,600
CameraZoom cam,1.4
RenderWorld

Flip
Wend


[mike_g]

Nice effects

[DrFreak339]

ok, ive tested it now.. i got 11fps, sometimes 12...

[Shockwave]

Hey Sledge, that looks really good! I bet that would look lovely with some nice textures