Rotated Column This is a little effect that renders a perspective /rotating column with camera push in/out.
Video Source Code[pbcode]
; limit the rate to 100fps or less
setfps 100
constant ProjectionX=400
constant ProjectionY=400
Radius#=1500
Depth#=3000
Height#=1600
Type tVerts
px#
py1#
py2#
Colour
EndTYpe
Dim Verts(1000) as tVerts
RotationRate# =30.0/1000
ZoomRate# =45/1000.0 ; 45 degrees per second
StartTime=Timer()
BackDropCOlour =Rgb(22,33,44)
do
cls BackDropCOlour
cx=GetScreenWidth()/2
cy=GetScreenHeight()/2
TimePast=Timer()-STartTIme
Baseangle#=TimePast*RotationRate#
BaseAngle#=wrapangle(Baseangle#)
ZoomAngle#=TimePast*ZoomRate#
ZoomAngle#=wrapangle(Zoomangle#)
CurrentDEpth#=Depth#+(Cos(zoomAngle#)*500)
VertCount=0
for lp=0 to 360 step 4
angle#=wrapangle(baseAngle#+lp)
x#=cos(angle#)*RAdius#
z#=CurrentDepth#+sin(angle#)*RAdius#
y_Top# =-Height#
y_Bottom#=Height#
px# =(X#*ProjectionX)/z#
py1# =(Y_Top#*ProjectionY)/z#
py2# =(Y_Bottom#*ProjectionY)/z#
px#+=cx
py1#+=cy
py2#+=cy
verts(VertCount).px#=px#
verts(VertCount).py1#=py1#
verts(VertCount).py2#=py2#
if VertCount&1
c=$112288
else
c=$3388ff
endif
c=rgbdepthcue(c,BackDropCOlour,z#,10,2500)
verts(VertCount).colour=c
VertCount++
next
lockbuffer
for lp=0 to VertCount-2
px1 =verts(lp).px#
px2 =verts(lp+1).px#
if px2>=Px1
py1top =verts(lp).py1#
py1bot =verts(lp).py2#
c1 =verts(lp).colour
lp2=lp+1
py2top =verts(lp2).py1#
py2bot =verts(lp2).py2#
c2 =verts(lp2).colour
gouraudquad px1,py1top,c1,px2,py2top,c2,px2,py2bot,c2,px1,py1bot,c1
endif
next
unlockbuffer
sync
loop
[/pbcode]
very nice effect!
Here's a textured version. It's two pass effect, first we draw the texture quads, then we draw the alpha additive gouraud quads on top.
[pbcode]
LoadFont "Verdana",1,128
Texture=MakeTexture(1024,200)
; limit the rate to 100fps or less
; setfps 100
constant ProjectionX=400
constant ProjectionY=400
Radius# =1500
Depth# =2500
Height# =1400
Type tVerts
px#
py1#
py2#
U#
Colour
EndTYpe
Dim Verts(1000) as tVerts
Screen=NewIMage(800,600,2)
RotationRate# =30.0/1000
ZoomRate# =40/1000.0 ; 45 degrees per second
StartTime=Timer()
BackDropCOlour =Rgb(22,33,44)
do
cx=GetScreenWidth()/2
cy=GetScreenHeight()/2
TimePast=Timer()-STartTIme
Baseangle#=TimePast*RotationRate#
BaseAngle#=wrapangle(Baseangle#)
ZoomAngle#=TimePast*ZoomRate#
ZoomAngle#=wrapangle(Zoomangle#)
CurrentDEpth#=Depth#+(Cos(zoomAngle#)*500)
VertCount=0
SegStep=10
Segs=(360/SegStep)
UStep#=GetIMageWidth(Texture)/float(Segs)
for SegLP=0 to Segs
lp=SegLP*SegStep
angle#=wrapangle(baseAngle#+lp)
x#=cosRadius(angle#,Radius#)
z#=CurrentDepth#+sinRadius(angle#,RAdius#)
y_Top# =-Height#
y_Bottom#=Height#
px# =(X#*ProjectionX)/z#
py1# =(Y_Top#*ProjectionY)/z#
py2# =(Y_Bottom#*ProjectionY)/z#
px#+=cx
py1#+=cy
py2#+=cy
verts(VertCount).px#=px#
verts(VertCount).py1#=py1#
verts(VertCount).py2#=py2#
if VertCount &1
c=$112233
else
c=$884422
endif
c=rgbdepthcue(c,BackDropCOlour,z#,10,3500)
verts(VertCount).colour=c
verts(vertCount).u=Seglp*UStep#
VertCount++
next
VTop=0
VBot=GetIMageWidth(Texture)
rendertoimage Screen
cls BackDropColour
lockbuffer
for lp=0 to VertCount-2
px1 =verts(lp).px#
px2 =verts(lp+1).px#
if px2>=Px1
py1top =verts(lp).py1#
py1bot =verts(lp).py2#
c1 =verts(lp).colour
u1 =verts(lp).u
lp2=lp+1
py2top =verts(lp2).py1#
py2bot =verts(lp2).py2#
c2 =verts(lp2).colour
u2 =verts(lp2).u
inkmode 1
texturequad texture, px1,py1top,u1,vtop, px2,py2top,u2,vtop, px2,py2bot,u2,vbot, px1,py1bot,u1,vbot,0+8
inkmode 1+64
gouraudquad px1,py1top,c1,px2,py2top,c2,px2,py2bot,c2,px1,py1bot,c1
endif
next
unlockbuffer
inkmode 1
rendertoscreen
drawimage Screen,0,0,false
sync
loop
Function MakeTexture(Width,Height)
ThisImage=NewImage(Width,Height,2)
rendertoimage ThisIMage
cx=width/2
cy=height/2
Radius=getdistance2d(0,0,Width,Height)*1.25
Rgb1=$aa33ff
RGb2=$ccaabb
Rgb1=$dd8855
RGb2=$dddddd
Rgb1=$dd8855
RGb2=$dddddd
RGb3=$444444
c2=rgb3
Segs=36
For lp=0 to Segs-1
Angle1#=lp*(360.0/Segs)
Angle2#=(lp+1)*(360.0/Segs)
x1#=cx+Cosradius(angle1#,RAdius)
y1#=cy+sinradius(angle1#,RAdius)
x2#=cx+Cosradius(angle2#,RAdius)
y2#=cy+sinradius(angle2#,RAdius)
if lp &1
c1=RGb1
c2=Rgb2
else
c1=RGb2
c2=Rgb1
endif
gouraudtri x1#,y1#,c1,x2#,y2#,c1,cx,cy,c3
next
ink $30ffffff
Xpos=Width/2
Fh=GetFontHeight(1)
Ypos=Height/2 -(Fh/2)
centertext Xpos,Ypos,"Texture Map"
Xpos+=2
Ypos-=2
ink $ffa0a0a0
centertext Xpos,Ypos,"Texture Map"
rendertoscreen
ink -1
endFunction ThisIMage
[/pbcode]
Kevin you are the Best programmer!