Code archives/3D Graphics - Misc/Displacement Mapping
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| Here is a displacement mapping function and some routines to show it off. Function displace(mesh,texture,texsize#=256,amp#=1,wrap=false) Mesh = the entity you wish to modify The texture needs to be square ie 256=256x256,512=512x512 amp = The heightmap. The wrap command is my attempt at handling spheres, etc. You need lots of vertices in a object for this to look good. So it not for the polygon shy! In the example code press the space bar to bumpmap and create simple random landscapes. The bumpmap function also needs the numcolor and gettetxcol functions if you with to use it in your own code. Have fun! | |||||
; Vetex displacment mapping function and example code
; ADAmor Ziltch 2002
Graphics3D 800,600
SetBuffer BackBuffer()
light=CreateLight(2)
PositionEntity light,-1000,50,-10
LightColor light,255,255,40
light2=CreateLight(2)
PositionEntity light2,1000,50,-10
LightColor light,55,55,255
light3=CreateLight(2)
PositionEntity light2,0,50,1000
LightColor light,220,210,55
AmbientLight 125,125,7
Global you = CreatePivot()
PositionEntity you,0,00,-300
cam = CreateCamera(you)
camerarange cam,1,5000
.createscene
;--cube grid
Global cubegrid = createsquare(51)
PositionEntity cubegrid,0,300,1000
ScaleEntity cubegrid,2000,200,2000
entitycolor cubegrid,50,50,150
rotateEntity cubegrid ,180,0,0
cubegridtex = gridtex(256,32,12, 70,230,10, 120,50,250)
EntityTexture cubegrid,cubegridtex,0,1
;--bump plane
Global bumpplane = createsquare(100)
PositionEntity bumpplane ,0,-500,1000
ScaleEntity bumpplane ,2000,200,2000
entitycolor bumpplane ,150,50,150
bumptex=CreateTexture(256,256)
spot(bumptex,256,25)
EntityTexture bumpplane,bumptex,0,0
;--bump ball
Global bumpball = createsphere(30)
PositionEntity bumpball ,0,0,1000
ScaleEntity bumpball ,90,90,90
entitycolor bumpball ,150,50,150
entityTexture bumpball,cubegridtex,0,0
PointEntity you,cubegrid
rotateentity you,15,0,0
setfont LoadFont("Arial",14,False,False,False)
BumpAlready = false
While Not KeyHit(1)
spd = MouseZ()+2 ; mousewheel is speed
moveyou(spd)
If KeyHit(57)then
if (not BumpAlready) Then ;space for bumpmap
displace(cubegrid,cubegridtex,256,20)
displace(bumpplane,bumptex,256,20)
displace(bumpball,cubegridtex,256,5)
BumpAlready = true
else
freeentity cubegrid
freeentity bumpplane
freeentity bumpball
goto createscene
end if
end if
TurnEntity cubegrid,0,.1,0
TurnEntity bumpball,-.1,.1,.1
UpdateNormals cubegrid
RenderWorld
color 250,250,100
text 10,10," Hit the SPACEBAR for displacment. Arrows,home,end,endpgup,pgdwn with ctrl for movement. Mouse wheel for speed. W for Wireframe. Look in code for more keys"
Flip
Wend
Function displace(mesh,texture,texsize#=256,amp#=1,wrap=false)
For sc = 1 To CountSurfaces(mesh)
surf = GetSurface(mesh,sc)
If surf = 0 Then
RuntimeError "Cant find surface to displace with"
End
End If
maxvert = CountVertices(surf)
For vc = 0 To maxvert-1
bx# = VertexX(surf,vc)
by# = VertexY(surf,vc)
bz# = VertexZ(surf,vc)
bnx# = VertexNX(surf,vc)
bny# = VertexNY(surf,vc)
bnz# = VertexNZ(surf,vc)
bu# = VertexU(surf,vc)
bv# = VertexV(surf,vc)
If wrap Then
If (bu = 1) Then bu = 0
If (bv =0) Then bu = 0 : bv = 0
If (bv =1) Then bu = 0 : bv = 1
End If
tx# = bu*texsize
ty# = bv*texsize
gettexcol(Texture,tx,ty)
Cr#=numcolR ; based off red channel as this seems to look best
If (cr > 0) Then
bxx# = bx + bnx * (Cr/255) * (amp/10)
byy# = by + bny * (Cr/255) * (amp/10)
bzz# = bz + bnz * (Cr/255) * (amp/10)
VertexCoords surf,vc,bxx,byy,bzz
End If
Next
Next
UpdateNormals mesh
End Function
Global numcolR#,numcolG,numcolB
Function numcolor(num#)
;convert number to r g b values
numcolR=num Shr 16 And %11111111
numcolG=num Shr 8 And %11111111
numcolB=num And %11111111
End Function
Function gettexcol(tex,x,y)
; get results from numcolR, numcolG, numcolB
SetBuffer TextureBuffer(tex)
LockBuffer TextureBuffer(tex)
numcolor(ReadPixelFast(x,y))
UnlockBuffer TextureBuffer(tex)
SetBuffer BackBuffer()
End Function
;------ VVVV these functions are just to create an example bdisplacement map VVVV
Function createsquare(segs#=5,parent=0)
mesh=CreateMesh( parent )
surf=CreateSurface( mesh )
l# =-.5
b# = -.5
tvc= 0
;create all the vertices first
Repeat
u# = l + .5
v# = b + .5
AddVertex surf,l,0,b,u,v
tvc=tvc + 1
l = l + 1/segs
If l > .5 Then
l = -.5
b = b + 1/segs
End If
Until b > .5
vc# =0
;create polys
vc# =0
Repeat
AddTriangle (surf,vc,vc+segs+1,vc+segs+2)
AddTriangle (surf,vc,vc+segs+2,vc+1)
vc = vc + 1
tst# = ((vc+1) /(segs+1)) -Int ((vc+1) /(segs+1))
If (vc > 0) And (tst=0) Then
vc = vc + 1
End If
Until vc=>tvc-segs-1
UpdateNormals mesh
Return mesh
End Function
Function moveyou(spd=1)
If KeyDown( 205 ) Then
If KeyDown(157) Then
MoveEntity you,spd,0,0 ; ctrl -> straff right
Else
TurnEntity you,0,-2,0 ; -> turn right
End If
End If
If KeyDown( 203 ) Then
If KeyDown(157) Then
MoveEntity you,-spd,0,0 ; ctrl <- straff left
Else
TurnEntity you,0,2,0 ; <- turn left
End If
End If
If KeyDown( 199 ) Then
If KeyDown(157) Then
TurnEntity you,0,0,2 ; ctrl home roll left
Else
TurnEntity you,-2,0,0 ; home pitch left
End If
End If
If KeyDown( 207 ) Then
If KeyDown(157) Then
TurnEntity you,0,0,-2 ; ctrl end roll right
Else
TurnEntity you,2,0,0 ; end roll right
End If
End If
If MouseDown(1) Or KeyDown( 200 ) Then MoveEntity you,0,0,spd ; up arrow forward
If MouseDown(2) Or KeyDown( 208 ) Then MoveEntity you,0,0,-spd ; down arrow back
If KeyDown(201) Then MoveEntity you,0,spd,0 ; pgup raise
If KeyDown(209) Then MoveEntity you,0,-spd,0 ; pgdown lower
If KeyHit( 17) Then wf = Not wf : WireFrame wf ;w for wireframe
If KeyHit(68) Then ; F10 for snapshot
If sscnt = 0 Then sscnt = 1000
sscnt = sscnt + 1
SaveBuffer(FrontBuffer(),"snapshot"+Right(Str(sscnt),3)+".bmp")
End If
If KeyHit(36) Then joy = Not joy ; j key for joystick
If joy Then
jyaw#=-JoyXDir()
jpitch#=-JoyYDir()
TurnEntity you,jpitch,jyaw,0
If JoyDown(7) Then MoveEntity you,0,0,spd
If JoyDown(8) Then MoveEntity you,0,0,-spd
End If
End Function
Global WF,joy
Function spot(tex,texsize,numspots,clstrue=true)
SetBuffer TextureBuffer(tex)
if clstrue then
color 0,0,0
Rect 0,0,texsize,texsize,1
end if
lockbuffer TextureBuffer(tex)
for sc = 1 to numspots
spotsize=Rand(25,64): if spotsize >60 then spotsize=spotsize*2
rx=Rand(spotsize+1,texsize-spotsize)
ry=Rand(spotsize+1,texsize-spotsize)
For a# = 1 To spotsize-1 step 1
i# = 0
while i < 360
sx=sin(i)*a+rx
sy=cos(i)*a+ry
i = i + .5
rc=readpixel(sx,sy,texturebuffer(tex))
numcolor(rc)
nr#=(abs (sin((a-1)/4))*(spotsize-a)*2+numcolR*.9)mod 255
nc=Colornum(nr,numcolG+1,numcolB+1)
writepixelfast sx,sy,nc
wend
Next
next
unlockbuffer TextureBuffer(tex)
SetBuffer BackBuffer()
End Function
Function colornum(r,g,b)
return ((r Shl 16) + (g Shl 8) + b)
End Function
Function gridtex(s=256,st=128,width=16,colr=0,colg=0,colb=0,backcolr=0,backcolg=0,backcolb=0)
tex=CreateTexture(s,s)
SetBuffer TextureBuffer(tex)
Color backcolr,backcolg,backcolb
Rect 0,0,s,s,1
a = 0
i#=s/260
Repeat
Color colr,colg,colb
For w= 0 To width-1
Line a+w,0,a+w,s
Line 0,a+w,s,a+w
Next
a = a + st
Until a => s
SetBuffer BackBuffer()
Return tex
End Function |
Comments
None.
Code Archives Forum
   |