2d Fractal Mountain

[kevin]

  DB/DBPRO source code   go here for the PlayBasic version

Code Select Expand



sync on
Sync rate 0

  gosub Make_ground


Do
cls 0
if spacekey()=1
  gosub Make_ground
endif
Draw_Ground()

Sync
loop



Make_ground:

   Dim Terrain_Size#(1)
   Dim Terrain_Height#(1)
  Create_ground(5+rnd(5))

return



`; *================================================*
`; *================================================*
`;            >>  CREATE GROUND <<
`; *================================================*
`; *================================================*
   

Function Create_ground(SubDivides)   

    HeightRange#=250+rnd(100)

   Dim Terrain_height#(2)
   Terrain_height#(0)=0
   Terrain_height#(1)=heightrange#
   Terrain_height#(2)=0


Terrain_Size#(1)=2

   HeightRange#=HeightRange#/2

 
   For levels=1 to subdivides

      Size=Terrain_Size#(1)
      Dim Terrain_height2#(size*2)
           
      LastY#=Terrain_height#(0)

      Xlp2=0
      For xlp=1 to size
         Y#=Terrain_Height#(xlP)
         Terrain_Height2#(xlP2)=lasty#
         inc xlp2
         Terrain_Height2#(xlP2)=((LastY#+y#)/2)+rnd(heightrange#)
         inc xlp2
         lasty#=y#     
      next xlp

   
`    ; ==================================================================================
`    ; MOve the Temp Buffer back to the core array,  Damn i love those array commands :)
  `   ; ==================================================================================
     
`;      move_Array Terrain_heights2#(),Terrain_heights#()
   
  Dim Terrain_height#(Xlp2)
  for lp =0 to Xlp2
      Terrain_height#(lp)=Terrain_height2#(lp)
  next lp
  Terrain_Size#(1)=size*2

      HeightRange#=HeightRange#/1.9
   
   next levels
   
EndFunction



Function Draw_Ground()
 
  size#=Terrain_Size#(1)

      XStep#=640.0/size#
      Xpos1#=0
      Xpos2#=Xstep#
      sc#=480.0/3.5
      LastY#=sc#-Terrain_height#(0)

      For Xlp=1 to size#-1
         y#=sc#+Terrain_height#(Xlp)
         line xpos1#,LastY#,Xpos2#,y#
         lasty#=y#
         xpos1#=xpos1#+Xstep#
         xpos2#=xpos2#+Xstep#
      next Xlp 
EndFunction   
   


[ATLUS]

Hm cool function for DBPro