Code archives/Algorithms/Create 2D Terrain EDIT
This code has been declared by its author to be Public Domain code.
Download source code
| This is an edited version of skn3[ac]'s code at http://www.blitzbasic.com/codearcs/codearcs.php?code=356 Creates a 2D landscape with green color. Landscape info is stored in a Array wich can be useful if you wanna blow bits of the terrain away or something. |
[code] ;This is A edited version of skn3[ac]'s code at http://www.blitzbasic.com/codearcs/codearcs.php?code=356 ;Author: Alexander Sällström aka Berserker[swe] ;Info: Creates a 2D landscape with green color. Landscape info is stored in a Array ; wich can be useful if you wanna blow bits of the terrain away or something. ; ;Feel free to use and alter as much as you like but i would appreciate if you write my name ;in some Credits or code or whatever =) ;And please email me if you need help or think you can improve this futher! ;My Email is: berserker@sverige.nu Const ScreenWidth = 1024 Const ScreenHeight = 0768 Const ScreenDepth = 0032 Graphics ScreenWidth,ScreenHeight,ScreenDepth,1 SetBuffer BackBuffer() Dim Landskap(ScreenWidth,ScreenHeight) Dim LandColor(ScreenWidth,ScreenHeight,3) Global GameTimer# = CreateTimer(60) Function CreateMap(width,height) Local y1,y2,y3,y4,x ; This little part of code was made by skn3[ac] ; Everything in this .bb is mine. ; See skn3[ac]'s original here: http://www.blitzbasic.com/codearcs/codearcs.php?code=356 ;--------------------------------------------------------------------------------------- y2 = height y1 = ((height-100)/2+Rand(50,300)) For x = 0 To width SeedRnd MilliSecs() y1 = (y1+Cos(x)*Rand(-(Sin(x)*Rand(5)),(Sin(x)*Rand(5)))) If y1 > y2 Then y1 = y2 EndIf If y1 < ((height-150)/3) Then y1 = ((height-150)/3) EndIf ;--------------------------------------------------------------------------------------- ;My Edit ;Fills the Array Lanskap(x,y) with the value 1 ;1=something 0=nothing For y3 = y1 To height Landskap(x,y3) = 1 Next Next ;-------------------------------------------------------- ;My Edit ;Sets Color To The Landscape ;--------------------------------------------------- For x = 0 To ScreenWidth For y4 = 0 To ScreenHeight If Landskap(x,y4) <> 0 Then LandColor(x,y4,1) = 0 LandColor(x,y4,2) = Int((245 + Rnd(-30,10))) LandColor(x,y4,3) = Int((26 + Rnd(-5,30))) EndIf Next Next ;--------------------------------------------------- End Function ;Renders Lanscape Function Render_Landscape() Local X,Y For X = 0 To ScreenWidth For Y = 0 To ScreenHeight If Landskap(X,Y) <> 0 Then Color LandColor(X,Y,1),LandColor(X,Y,2),LandColor(X,Y,3):Plot X,Y EndIf Next Next End Function Function Game() CreateMap(ScreenWidth,ScreenHeight) Repeat Cls Render_Landscape() Flip WaitTimer(GameTimer#) Until KeyHit(1) End Function Game [/code] |