Shape Star Field

[kevin]

 Shape Star Field

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



2d Version

PlayBASIC Code: [Select]

   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

 3D Version

PlayBASIC Code: [Select]

   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



 
 

    Related Examples:

         * 8Way Layered Star Field / Asteroids Style