[edit] Last updated Feb 19 3:00 AM
Alright, I've banged together an early build of a terrain
generator I'm going to use for my game. Here are some very
early shots of what it does so far. Please note that
everything is done procedurally, including(especially) the
rock texture itself. It means changes are very hard to
implement, but it's also a source of infinite textures! You
can't go wrong with that!
I would appreciate if some of you guys could run my code and
maybe tell me what you think? Or what you'd change? Or what
you hate?
I think it's a good start, but the colours need tweaking and
it might be a little bit too rocky. But nothing's for sure yet.
Here's an Exe (887Kb) and here's the Bmax source:
My goal is to beat the awesomeness of my old map generator but it's proven to be surprisingly hard! Lol.
Alright, I've banged together an early build of a terrain
generator I'm going to use for my game. Here are some very
early shots of what it does so far. Please note that
everything is done procedurally, including(especially) the
rock texture itself. It means changes are very hard to
implement, but it's also a source of infinite textures! You
can't go wrong with that!
I would appreciate if some of you guys could run my code and
maybe tell me what you think? Or what you'd change? Or what
you hate?
I think it's a good start, but the colours need tweaking and
it might be a little bit too rocky. But nothing's for sure yet.
Here's an Exe (887Kb) and here's the Bmax source:
SuperStrict Graphics 800, 600,,-1 'Include "drawthings.bmx" SeedRnd MilliSecs() Type rgbType Field r:Float, g:Float, b:Float EndType Local y:Float, y1:Float Local averageY:Int, totalY:Int Local initialMap:Int[800,600] Local texture:Int[800, 600] Local palette:rgbType[600] For Local a:Int = 0 To 599 palette:rgbType[a] = New rgbType Next 'drawSky(initialMap, initialMap, Rand(5)) 'drawBGHills(averageY) paletteIndex(palette) wait("Initializing...") makeTexture(texture) HideMouse SetClsColor 20, 10, 40 Cls Repeat ' wait("Drawing...") For Local x:Int = 0 To 799 For Local y:Int = 0 To 599 initialMap[x,y]=0 Next Next y = Rand(500)+50 SetColor 20, 70, 10 For Local x:Int = 0 To 799 For Local yy:Int = y To 599 Plot x,yy initialMap[x,yy]=255 Next y:+y1 totalY:+y y1:+(RndFloat()-.5)*.1 If Rand(20)=1 Then y1:+ (RndFloat()-.5) If Abs(y1) > 2 Then y1=0 If y1<-2 Then End If y <90 Then y1:+RndFloat()*.1 If y< 45 Then y1 = RndFloat()*.3 EndIf If y >580 Then y1:-RndFloat()*.03 If y> 590 Then y1 = -RndFloat()*.3 EndIf Next averageY = totalY/800 If averageY >200 Then 'draw floating platform (horizontal) Local platforms:Int = Rand(3) If averageY > 400 Then platforms:+2 If averageY > 500 Then platforms:+4 For Local aa:Int = 1 To platforms Local middleY:Int Local thickness:Int = Rand(40)+10 Local xStart:Int = Rand(800)-100, xLength:Int = Rand(250)+20 Local yTop:Float = Rand(500 - averageY *.5)+120, yBottom:Float = yTop+Rand(10)+2 Local yTop1:Float= -RndFloat()*2, yBottom1:Float = RndFloat()*2 Local x:Int = xStart Repeat SetColor 20, 70, 10 For Local y:Int = yTop To yBottom Plot x,y If x> -1 And y>-1 And y< 600 initialMap[x,y] = 255 Next yTop:+yTop1 yBottom:+yBottom1 yBottom1:+(RndFloat()-.5)*.2 yTop1:+(RndFloat()-.5)*.2 If x > xStart+xLength Then yBottom1:-RndFloat(); yTop1:+RndFloat() If x = Int(xLength*.5+xStart) Then middleY = (yBottom+yTop)*.5 If x Mod 6 = 1 Then If yBottom-yTop < 20 Then yTop1:-(RndFloat())*.2 If yBottom-yTop > thickness Then yTop1:+(RndFloat())*.2 If Abs(yTop1) > 1 Then yTop1:*RndFloat() If Abs(yBottom1) > 1 Then yBottom1:*RndFloat() EndIf x:+1 Until yBottom<yTop Or x>799 x = xLength*.5+xStart Local xLeft:Float, xRight:Float, xLeft1:Float, xRight1:Float Next EndIf Local lowResMap:Int[20, 15] For Local y:Int = 0 To 14 For Local x:Int = 0 To 19 If initialMap[x*40, y*40] = 255 Then lowResMap[x,y] = 255 Else lowResMap[x,y] = 0 EndIf Next Next Local carvedMap:Int[800,600] For Local y:Int = 0 To 599 For Local x:Int = 0 To 799 carvedMap[x, y] = initialMap[x, y] Next Next Local xOffset:Int[14] 'this code tests the bottom of the screen to see if there's enough terrain to create a cave For Local xx:Int = 1 To 18 Local yy:Int = 14-Rand(4) SetColor 200, 200, 200 'if we hit earth, then try to draw a cave system. We'll start with the vertical shafts If lowResMap[xx,yy] = 255 Then For Local a:Int = 0 To 13 xOffset[a] = 0 Next Local xOffVar:Int For Local y:Int = 0 To 10 SetColor 100, 0, 0 xOffset[y] = xOffVar xOffVar:+Rand(3)-2 If xx+xOffset[y]< 1 Then xOffVar:+1 If xx+xOffset[y]> 18 Then xOffVar:-1 If y carve (carvedMap, (xx+xOffset[y])*40+20, (yy-y)*40+20, (xx+xOffset[y-1])*40+20, (yy-y+1)*30+20)', 40+Rand(30)) If lowResMap[xx+xOffset[y],yy-y] = 0 Or (y> 4 And Rand(5) = 1)Then Exit 'This endif contains the code that branches the tunnels out horizontally from the shafts If Rand(4) = 1 Then Local yOffset:Int= 0, length:Int = Rand(5)+1, direction:Int = 1 If Rand(2) = 1 Then direction = -1 Local a:Int =0, oldx:Int, oldy:Int Repeat oldx = xx+xOffset[y]+a*direction oldy = yy-y+yOffset If oldX < 1 Or oldX > 19 Or oldY > 14 Then Exit If lowResMap[oldX, oldY] = 0 Then Exit oldX:*40 oldY:*40 If Rand(3) = 1 yOffset:+Rand(3)-2 a:+1 carve (carvedMap, oldX, oldY, (xx+xOffset[y]+a*direction)*40, (yy-y+yOffset)*40)', 30+Rand(30)) Until a = length EndIf Next SetLineWidth 1 xx:+2+Rand(4) EndIf Next SetColor 200, 200, 170 DrawText "hit P to process this terrain, any other key to start over", 10, 10 For Local y:Int = 0 To 14 For Local x:Int = 0 To 19 If lowResMap[x,y] = 255 Then Plot x*40, y*40 Next Next Flip; WaitKey If KeyDown(key_p) Then wait("Cleaning...") Else wait("Drawing...") 'this smooths the landscape If KeyDown(key_p) Then Local col:Int For Local b:Int = 0 To 2 For Local y:Int = 1 To 598 For Local x:Int = 1 To 798 col:+ carvedMap[x-1,y] col:+ carvedMap[x+1,y] col:+ carvedMap[x,y-1] col:+ carvedMap[x,y+1] col:/4 carvedMap[x,y] = col Next col = 0 Next Next For Local y:Int = 0 To 599 For Local x:Int = 0 To 799 If carvedMap[x, y] < 100 Then carvedMap[x, y] = 0 If initialMap[x, y] = 255 Then SetColor 40+Rand(10), 30+Rand(10), 20 Plot x, y EndIf Else carvedMap[x, y] = 255 SetColor 20+Rand(10), 70+Rand(10), 10 Plot x, y EndIf Next Next DrawText "This is the finished texture mask. Hit any key to texture.", 10, 10 SetColor 120, 100, 30 'drawl 1, 1, 798, 598, 2, BOX Flip; WaitKey wait("Texturing...") texturize(carvedMap, initialMap, texture, palette) drawSky(carvedMap, initialMap, Rand(5)) drawBGHills(averageY, carvedMap, initialMap, texture, palette) SetColor 200, 200, 200 DrawText "Texturing technique - early version. Hit P to try random new colours", 10, 10 Flip;FlushKeys() Repeat WaitKey If KeyDown(key_p) Then wait("New colours...") paletteIndex(palette) texturize(carvedMap, initialMap, texture, palette) drawSky(carvedMap, initialMap, Rand(5)) drawBGHills(averageY, carvedMap, initialMap, texture, palette) SetColor 255, 255, 255 DrawText "Texturing technique - early version. Hit P to try random new colours", 10, 10 Flip;FlushKeys() Else Exit EndIf Forever Flip;Cls wait("Redrawing...") EndIf totalY=0 Until KeyDown(key_escape) Cls End Function wait(text:String) Local width:Int = TextWidth(text)* 3 Flip SetScale 3, 4 SetColor 50, 30, 30 DrawText text, 400-width*.5, 200 SetColor 200, 200, 200 DrawText text, 403-width*.5, 203 SetScale 1, 1 Flip;Cls EndFunction Function makeTexture(texture:Int[,] Var) SetClsColor 90, 90, 90 Cls Local y:Int, x:Int, xSize:Float, ySize:Float, size:Float Local shade:Int, baseShade:Int, xDraw:Int, yDraw:Int For y = 576 To 600 For x = 0 To 800 shade = Rand(30)+66 SetColor shade, shade, shade DrawOval x+Rand(5), y-Rand(Rand(40)+10), 2, 2 Next Next SetBlend ALPHABLEND For Local b:Int = 0 To 2700 x = Rand(800) y = Rand(470) If Rand(3) = 1 Then xSize = Rand(14)+10 ySize = Rand(14)+10 Else xSize = Rand(40)+20 ySize = Rand(40)+20 EndIf If b< 500 And Rand(2) = 1 Then xSize = Rand(90)+50 ySize = Rand(90)+50 EndIf baseShade:Int = 70+Rand(40) If b> 900 Then y = 599-Rand(Rand(60)+10) xSize = Rand(5)+2 ySize = Rand(5)+2 baseShade:Int = 60+Rand(20) EndIf size = (xSize+ySize)*.5 'get an average For Local scale:Float = 1.0 To (RndFloat()-.5)*.3+.2 Step -.06 'draw the stone shade = baseShade-(20*scale) SetColor shade, shade, shade xDraw = xSize*scale yDraw = ySize*scale DrawOval x-xDraw*.3, y-yDraw*.3, xDraw, yDraw Next Next SetAlpha .4 For y = 0 To 570 Step 6 'small rocks all over For x = 0 To 800 Step 6 shade = Rand(50)+60 SetColor shade, shade, shade DrawOval x+Rand(20)-10, y+Rand(20)-10, Rand(4)+3, Rand(4)+3 Next Next SetAlpha .4 For y = 0 To 570 Step 3 'more and smaller rocks For x = 0 To 800 Step 3 shade = Rand(50)+60 SetColor shade, shade, shade DrawOval x+Rand(20)-10, y+Rand(20)-10, Rand(3)+1, Rand(3)+1 Next Next SetAlpha 1.0 Local image:timage = CreateImage(800, 600, DYNAMICIMAGE) GrabImage image, 0, 0 Local sample:Int Local pixmap:TPixmap = LockImage(image) For Local x:Int = 0 To 799 For Local y:Int = 0 To 599 sample = ReadPixel (pixmap, x, y) sample = (sample Shl 8) Shr 24 'since source is B&W, I can use just the red channel to get the brightness value texture[x, y] = sample '+Rand(15)-8 ' SetColor sample, sample, sample ' Plot x, y Next Next Return 'rem for debug DrawImage image, 0, 0 Flip WaitKey End Cls EndFunction Function texturize(foreGround:Int[,] Var, backGround:Int[,] Var, texture:Int[,], set:rgbType[] Var) Local r:Int, g:Int, b:Int, fade:Float Local subSurface:Int = 0, subCaveFloor:Int = 0 ' the deeper under the surface we are, the higher subSurface will be For Local x:Int = 0 To 799 subSurface = 0 r = 0 g = 0 b = 0 Local setNum:Int For Local y:Int = 0 To 599 If foreGround[x, y] = 255 Or backGround[x, y] = 255 Then 'if I hit either BG or foreground, I'm gonna draw a pixel setNum = subSurface+texture[x,y]-75 If setNum>599 setNum = 599 - Rand(6) If setNum<0 setNum = Rand(6) r = set[setNum].r g = set[setNum].g b = set[setNum].b ' Local yy:Int ' yy = subSurface ' If yy > 599 Then Continue ' r:+ texture[x, yy] -Rand(5) ' g:+ texture[x, yy] -Rand(5) ' b:+ texture[x, yy] -Rand(5) If foreGround[x, y] = 0 Then 'but if there's no FG r:*.3 g:*.2 b:*.1 If backGround[x, y] Then If subCaveFloor< 20 subCaveFloor:+1 EndIf Else If subCaveFloor > 0 Then fade = subCaveFloor/20.0 'these 4 lines create a crossfade between two colours of pixel r = texture[x, 579+subCaveFloor]*fade + r*(1-fade) g = texture[x, 579+subCaveFloor]*fade + g*(1-fade) b = texture[x, 579+subCaveFloor]*fade + b*(1-fade) EndIf subCaveFloor:-1 If subCaveFloor< 0 Then subCaveFloor = 0 EndIf SetColor r, g, b Plot x, y subsurface:+1 Else subCaveFloor = 0 subsurface:-2 If subSurface < 0 Then subSurface = 0 EndIf Next Next EndFunction Function carve(collisionMap:Int[,] Var, xStart:Int, yStart:Int, xEnd:Int .. , yEnd:Int, size:Int = 45, variance:Int = 15, steps:Int = 8) Local yDist:Int = yEnd-yStart, xDist:Int = xEnd-xStart Local x:Float = xStart, y:Float = yStart, a:Int, xSize:Int, ySize:Int, xOffset:Int, yOffset:Int Repeat xSize = size+Rand(variance)-(variance*.5) ySize = size+Rand(variance)-(variance*.5) xOffset = Rand(variance)-(variance*.5) yOffset = Rand(variance)-(variance*.5) DrawOval x - xSize * .5 - xOffset, y - ySize * .5 - yOffset, xSize, ySize x:+xDist/steps y:+yDist/steps a:+1 Until a > steps Local yMin:Int, yMax:Int, xMin:Int, xMax:Int xMin = xStart-size xMax = xEnd+size If xStart>xEnd Then xMin = xEnd-size; xMax = xStart+size yMin = yStart-size yMax = yEnd+size If yStart>yEnd Then yMin = yEnd-size; yMax = yStart+size If yMax>599 yMax = 599 If xMax>799 xMax = 799 Local image:timage = CreateImage (Abs(xMax-xMin), Abs(yMax-yMin), DYNAMICIMAGE) GrabImage image, xMin, yMin Local pixmap:TPixmap = LockImage (image) Local argb:Int, r:Int, g:Int, b:Int For Local y:Int = 0 To pixmap.height-1 For Local x:Int = 0 To pixmap.width-1 argb = ReadPixel (pixmap, x, y) r = (argb Shl 8) Shr 24 g = (argb Shl 16) Shr 24 b = (argb Shl 24) Shr 24 If r > 80 And g < 20 And b < 20 Then If xMin+x > 799 Or xMin+x<0 Or yMin+y > 599 Or yMin+y<0 Then Continue If collisionMap[xMin+x, yMin+y] = 255 Then collisionMap[xMin+x, yMin+y] = 0 EndIf EndIf Next Next UnlockImage(image) image = Null EndFunction Function paletteIndex(set:rgbType[] Var) For Local a:Int = 0 To 599 set[a].r = 0; set[a].g = 0; set[a].b = 0 Next Local blah:Int = Rand (4) ' blah = 2 'debug Select blah Case 1 set[000].r = 40; set[000].g = 100; set[000].b = 20 set[020].r = 20; set[020].g = 50; set[020].b = 10 set[022].r = 50; set[022].g = 50; set[022].b = 30 set[080].r = 130; set[080].g = 120; set[080].b = 110 set[082].r = 160; set[082].g = 160; set[082].b = 160 set[089].r = 100; set[089].g = 100; set[089].b = 100 set[095].r = 140; set[095].g = 120; set[095].b = 100 set[150].r = 60; set[150].g = 50; set[150].b = 30 set[155].r = 100; set[155].g = 90; set[155].b = 90 set[180].r = 80; set[180].g = 90; set[180].b = 90 set[215].r = 150; set[215].g = 150; set[215].b = 150 set[225].r = 150; set[225].g = 150; set[225].b = 150 set[280].r = 30; set[280].g = 30; set[280].b = 20 set[290].r = 50; set[290].g = 50; set[290].b = 50 set[380].r = 20; set[380].g = 20; set[380].b = 20 set[580].r = 255; set[580].g = 190; set[580].b = 70 set[599].r = 255; set[599].g = 255; set[599].b = 255 Case 2 set[000].r = 200; set[000].g = 200; set[000].b = 220 set[010].r = 150; set[010].g = 150; set[010].b = 150 set[020].r = 60; set[020].g = 60; set[020].b = 60 set[026].r = 040; set[026].g = 020; set[026].b = 020 set[100].r = 060; set[100].g = 040; set[100].b = 040 set[190].r = 150; set[190].g = 150; set[190].b = 140 set[220].r = 60; set[220].g = 60; set[220].b = 60 set[229].r = 50; set[229].g = 25; set[229].b = 25 set[325].r = 40; set[325].g = 40; set[325].b = 40 set[355].r = 30; set[355].g = 16; set[355].b = 16 set[500].r = 190; set[500].g = 170; set[500].b = 150 set[510].r = 90; set[510].g = 90; set[510].b = 90 set[599].r = 2; set[599].g = 2; set[599].b = 2 Case 3 set[000].r = 220; set[000].g = 220; set[000].b = 220 set[020].r = 220; set[020].g = 210; set[020].b = 170 set[110].r = 90; set[110].g = 100; set[110].b = 100 If Rand(2) = 1 Then set[200].r = 40; set[200].g = 40; set[200].b = 40 set[210].r = 50; set[210].g = 45; set[210].b = 45 set[280].r = 80; set[280].g = 80; set[280].b = 70 set[290].r = 21; set[290].g = 21; set[290].b = 21 set[350].r = 50; set[350].g = 50; set[350].b = 50 Else set[220].r = 60; set[220].g = 60; set[220].b = 60 set[230].r = 160; set[230].g = 160; set[230].b = 160 set[240].r = 60; set[240].g = 60; set[240].b = 60 EndIf set[599].r = 20; set[599].g = 10; set[599].b = 7 Case 4 set[000].r = 235; set[000].g = 235; set[000].b = 255 set[002].r = 235; set[002].g = 235; set[002].b = 255 set[013].r = 120; set[013].g = 120; set[013].b = 140 set[031].r = 100; set[031].g = 100; set[031].b = 100 set[048].r = 60; set[048].g = 46; set[048].b = 46 set[142].r = 100; set[142].g = 100; set[142].b = 110 set[330].r = 50; set[330].g = 30; set[330].b = 30 set[340].r = 60; set[340].g = 50; set[340].b = 40 set[599].r = 05; set[599].g = 05; set[599].b = 05 EndSelect colourize(set) Cls;Return 'rem for debug For Local a:Int = 0 To 599 SetColor set[a].r, set[a].g, set[a].b DrawLine 50, a, 300, a Next Flip;WaitKey;End EndFunction Function colourize(set:rgbType[] Var) 'set is a 1 dimensional array of rgb objects. Used to hold indexed colour. Local start:Int = 0, stop:Int, a:Int = start Repeat a:+1 If set[a].r > 0 Or set[a].g > 0 Or set[a].b > 0 Then SetColor 70, 70, 100 DrawLine 0,a,800, a SetScale .9, .9 SetColor 170, 170, 100 DrawText a+" r"+Int(set[a].r)+" g"+Int(set[a].g)+" b"+Int(set[a].b), 300+Rand(400), a - 6 SetScale 1, 1 stop = a Local steps:Int = stop - start For Local b:Int = 0 To steps set[start+b].r = set[start].r + (set[stop].r-set[start].r)/steps*b set[start+b].g = set[start].g + (set[stop].g-set[start].g)/steps*b set[start+b].b = set[start].b + (set[stop].b-set[start].b)/steps*b Next start = stop EndIf If a>598 Then Return Forever EndFunction Function drawSky(carvedMap:Int[,] Var, initialMap:Int[,] Var, sky:Int) Local x:Int, y:Int, a:Int Local r:Float, g:Float, b:Float, r1:Int, r2:Int, g1:Int, g2:Int, b1:Int, b2:Int Local arc:Int, xOff:Int, yOff:Int, wavelength:Int ' Repeat 'debug ' sky = 5 Select sky Case 1 r1 = 040; g1 = 000; b1 = 000 r2 = 90; g2 = 90; b2 = 190 arc = 500- Rand(300); xOff = -Rand(160); yOff = 20+Rand(90) wavelength = 5 Case 2 r1 = 140; g1 = 140; b1 = 200 r2 = 20; g2 = 0; b2 = 0 arc = 500- Rand(300); xOff = -Rand(160); yOff = 20+Rand(90) wavelength = 5 Case 3 r1 = 100; g1 = 100; b1 = 220 r2 = 240; g2 = 180; b2 = 180 arc = 500- Rand(300); xOff = -Rand(160); yOff = 20+Rand(90) wavelength = 3 Case 4 r1 = 130; g1 = 100; b1 = 220 r2 = 200; g2 = 180; b2 = 100 arc = 200; xOff = -Rand(160); yOff = 140+Rand(30) wavelength = 3 Case 5 r1 = 100; g1 = 20; b1 = 20 r2 = 20; g2 = 20; b2 = 70 arc = 200- Rand(100); xOff = -Rand(160); yOff = 20+Rand(30) wavelength = 3 EndSelect For x = 0 To 799 Local yCurve:Int = Cos(x/wavelength-xOff)*arc For y = 0 To 599 If carvedMap[x,y] = 255 Or initialMap[x, y] Then Continue a = (y-yCurve)/6-yOff r = (y/599.0)*(r2-r1)+r1 g = (y/599.0)*(g2-g1)+g1 b = (y/599.0)*(b2-b1)+b1 r:+a - Rand(8) g:+a - Rand(8) b:+a - Rand(8) SetColor r, g, b Plot x, y Next ' SetColor 55, 55, 55 ' Plot x, 400-a*2 Next Return Flip;WaitKey If KeyDown(key_escape) End ' Forever 'debug End EndFunction Function drawBGHills(averageY:Int Var, carvedMap:Int[,] Var, initialMap:Int[,] Var, texture:Int[,] Var, set:rgbType[] Var) 'Local lastY:Int[800] ' averageY = 300 SetAlpha .3 If averageY < 200 Then averageY = 200 Local y:Float, y1:Float, currentY:Int, layers:Int, setNum:Int, r:Int, g:Int, b:Int, texOff:Int ' Repeat 'Cls currentY = averageY layers = 1 + Rand(4) For Local t:Int = 0 To layers y1 = 0 y = currentY + Rand(30)-15 texOff = Rand(200) For Local x:Int = 0 To 799 For Local yy:Int = y To 599 If carvedMap[x,yy] = 255 Or initialMap[x,yy] = 255 Then Continue setNum = texture[x,yy-y]+texOff If setNum>599 setNum = 599 - Rand(6) If setNum<0 setNum = Rand(6) r = set[setNum].r g = set[setNum].g b = set[setNum].b r = r *(0.4+t*.1) + 10 + (yy - currentY)*.4 g = g *(0.4+t*.1) + 10 + (yy - currentY)*.4 b = b *(0.4+t*.1) + 19 + (yy - currentY)*.4 SetColor r, g, b Plot x, yy Next 'lastY[x] = y y:+y1 y1:+(RndFloat()-.5)*.1 If y > currentY+ 90 Or y > 560 Then y1:-RndFloat()*.03 If y < currentY-90 Or y < 200 Then y1:+RndFloat()*.03 If Rand(40) = 1 Then y1:*.7 Next currentY:+ 40+Rand(40) Next SetAlpha 1 ' DrawText y, 10, 10 ' Flip;WaitKey ' Until KeyDown(key_escape) ' End EndFunction
My goal is to beat the awesomeness of my old map generator but it's proven to be surprisingly hard! Lol.
