Main Menu

Sunny 2d Fractal Mountain

Started by kevin, February 19, 2008, 11:23:09 AM

Previous topic - Next topic

kevin

 This is the PlayBASIC version of this 2d Fractal Mountain (login required)

The main change is that this one draws sunny (for want of a better word) backdrop so the mountains appears to be  back lit in the scene.


PlayBASIC Code: [Select]
  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(8)

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 :)
` ; ==================================================================================

moveArray Terrain_height2#(),Terrain_height#()

Terrain_Size#(1)=size*2

HeightRange#=HeightRange#/1.9

next levels

EndFunction



Function Draw_Ground()

c1=$ff008f
c2=c1
c3=$ffff80
size#=Terrain_Size#(1)

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


lockbuffer
For Xlp=1 to size#
y#=sc#+Terrain_height#(Xlp)

fadeLevell#=lasty#/GetScreenHeight()*100
fadeLevelr#=y#/GetScreenHeight()*100


gouraudquad xpos1#,LastY#,rgbfade(c1,fadelevell#),Xpos2#,y#,rgbfade(c2,fadelevelr#),_
xpos2#,0,c3,Xpos1#,0,c3


lasty#=y#
xpos1#=xpos1#+Xstep#
xpos2#=xpos2#+Xstep#
next Xlp
unlockbuffer

EndFunction








Adaz

Here is a little Game Over sequence with some Beast 2 feeling :)

Ádáz

Hungary