Rotated Column

[kevin]

 Rotated Column

   This is a little effect that renders a perspective /rotating column with camera push in/out.      


Video

 

Source Code

PlayBASIC Code: [Select]

     ; 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

[ATLUS]

very nice effect!

[kevin]

  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.  

PlayBASIC Code: [Select]

   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

Login required to view complete source code

[ATLUS]

Kevin you are the Best programmer!