UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: kevin on December 09, 2010, 05:21:32 PM

Title: Shape Star Field
Post by: kevin on December 09, 2010, 05:21:32 PM
 Shape Star Field

  This examples create an infinite scrolling depth cued star field using the shapes.



2d Version

[pbcode]

   SceneWidth=GetScreenWidth()*2

   NumberOfLayers=10
   MaxScroll#=2
   Type tStarLayer
         Shape
         Xpos#
         Xspeed#
         Colour
   EndType
   
   Dim Layer as tStarLayer list


   For lp=1 to NumberOfLayers
      
      Shape=NewShape(500,500)
   
      For vert=0 to getshapeverts(shape)-1
            x=rnd(1600)
            y=rnd(600)
            setshapevertex Shape,vert,x,y
            setshapeedge Shape,vert,vert,vert
      next

      Layer=new tStarLayer
      Layer.Shape=shape
      Layer.Xpos=0
      S#=(NumberOfLayers-lp)*(100.0/NumberOfLayers)
      Layer.Colour=rgbfade($a0B0c0,s#)

      Layer.xspeed=MaxScroll#*(1-(float(lp)/NumberOfLayers))
   next

   x=0

   Do
      Cls $202010

      lp=0
      lockbuffer
      For Each Layer()
         Layer.xpos+=Layer.xspeed
         Layer.xpos=mod(Layer.xpos,SceneWIdth)
         Shape=layer.shape
         ink layer.colour
         DrawShape Shape,layer.xpos,0,0      
         DrawShape Shape,layer.xpos-SceneWidth,0,0      
         inc lp
      next
      unlockbuffer
      ink $ffffff   
      Sync
   loop



[/pbcode]



 3D Version



[pbcode]

   SceneDEpth=3000
   Projection=500
   
   NumberOfLayers=25
   MaxScroll#=2
   
   Type tStarLayer
         Shape
         Zpos#
         Width
         Height
   EndType
   
   Dim Layer as tStarLayer list

   For lp=1 to NumberOfLayers
      
      Verts=Rndrange(400,800)
      Shape=NewShape(Verts,Verts)

      Layer=new tStarLayer
      Layer.Shape=shape
      Layer.Zpos=(float(Scenedepth)/NumberOfLayers)*lp
      Layer.Width=1600
      Layer.height=1600
   
      For vert=0 to getshapeverts(shape)-1
            x=rnd(Layer.Width)
            y=rnd(Layer.Height)
            setshapevertex Shape,vert,x,y
            setshapeedge Shape,vert,vert,vert
      next

   next

   x=0

   SpaceColour=$404070
   
   Do
      Cls SpaceCOlour
      lockbuffer
      For Each Layer()
         Shape=layer.shape
         depth#=Layer.Zpos-10
         if Depth#<0 then Depth#+=SceneDEpth
         Layer.Zpos=Depth#
                  
         ProjectedWidth#=(Projection*Layer.Width)/Depth#
         ProjectedHeight#=(Projection*Layer.Height)/Depth#

         ScalerX#=ProjectedWidth#/Layer.Width
         ScalerY#=ProjectedHeight#/Layer.Height

         RotateShapeXY Shape,0,ScalerX#,ScalerY#
         Colour=RgbDepthCue($ffffff,spacecolour,Depth#,100,SceneDEpth)
         ink Colour
         DrawShape Shape,400,300,0      
         DrawShape Shape,400-ProjectedWidth#,300,0      
         DrawShape Shape,400,300-ProjectedHeight#,0      
         DrawShape Shape,400-ProjectedWidth#,300-ProjectedHeight#,0      

      next
      unlockbuffer
      ink $ffffff   
      Sync
   loop




[/pbcode]


    Related Examples:

         * 8Way Layered Star Field / Asteroids Style (http://www.underwaredesign.com/forums/index.php?topic=3837.0)