Posted: 13th Jun 2007 23:03
Here is my source so far, any tips for improving the realism?

Try varying sizex + sizey (but keep them the same ) and spacing

+ Code Snippet
REM Project: Map Generator
REM Created: 13/06/2007 11:09:11
REM
REM ***** Main Source File *****
REM
Set Display Mode 1280,1024,32
Randomize Timer()
Sizex = 1000
Sizey = 1000
Spacing = 200

Dim Grid(Sizex,Sizey)

For x = 0 to Sizex/Spacing
   For y = 0 to Sizey/Spacing
      If x > 0 and y > 0 and x < Sizex/Spacing and y < Sizey/Spacing
        Height = Rnd(255)
        Ink rgb(Height,Height,Height),0
        Dot x*Spacing,y*Spacing
        Grid(x*Spacing,y*Spacing) = Height
      Else
        Height = 127
        Ink rgb(Height,Height,Height),0
        Dot x*Spacing,y*Spacing
        Grid(x*Spacing,y*Spacing) = Height
      Endif
   Next y
Next x
wait key

For y = 0 to Sizey/Spacing
   For x = 0 to (Sizex/Spacing)-1
      HorizontalSinWave(x*Spacing,(x+1)*Spacing,y*Spacing,Grid(x*Spacing,y*Spacing),Grid((x+1)*Spacing,y*Spacing))
   Next x
Next y


For x = 0 to Sizex
   For y = 0 to (Sizey/Spacing)-1
      VerticalSinWave(y*Spacing,(y+1)*Spacing,x,Grid(x,y*Spacing),Grid(x,(y+1)*Spacing))
   Next y
Next x
wait key

Get Image 1,0,0,Sizex,Sizey
Save Image "Image.bmp",1
Make Terrain 1,"Image.bmp"
Load Image "Grass.bmp",2
Texture Terrain 1,2

do
Control Camera Using Arrowkeys 0,3,3
Position Camera Camera Position X(),Get Matrix Height(1,Camera Position X(),Camera Position Z())+5,Camera Position Z()

sync
loop

Function HorizontalSinWave(X1,X2,Y,A,B)
D = b-a
Dis = X2-X1
   For x = X1 to X2
       sx = (x-x1)/(Dis/180.0)
       Height = a+(Sin(sx-90)+1)*d/2
       if height >255 then print "error" : wait key : end
       if height <0 then print "error" : wait key : end
       Ink Rgb(Height,Height,Height),0
       Grid(x,y) = Height
       Dot x,y
   Next x
Endfunction

Function VerticalSinWave(Y1,Y2,X,A,B)
D = b-a
Dis = Y2-Y1
   For Y = Y1 to Y2
       sy = (y-y1)/(Dis/180.0)
       Height = a+(Sin(sy-90)+1)*d/2
       if height >255 then print "error" : wait key : end
       if height <0 then print "error" : wait key : end
       Ink Rgb(Height,Height,Height),0
       Grid(x,y) = Height
       Dot x,y
   Next x
Endfunction
Posted: 14th Jun 2007 15:51
Yea, just 14 if you want sync'd FPS rates, controlled fog & controlled Ambient Light, otherwise, 10 with sync'd FPS rates as well! Also, you might want to use Timer-Based Movement =) I've added this in for you in both versions, too! =)

Add a white fog color to it during the day, followed by a black fog color during the night, and a set ambient light 100 for day, and a set ambient light 25 , for night! =)

Also, remember to: Call Tbm_init() with the desired sync rate to start the system. Call Tbm_update() at the beginning of your game loop and after unpausing. If you want your screen fps, they can be found in Tbm.realfps, more accurate than using screen fps()

Credit for Timer-Based Movement system, goes to:

Code Dragon

Here is an example WITH Timer-Based Movement, Better FPS, key controlled fog, & key controlled ambient light:

+ Code Snippet
REM Project: Map Generator
REM Created: 13/06/2007 11:09:11
REM
REM ***** Main Source File *****
REM

Set Display Mode 800, 600, 32

type Tbm
  targetfps as float  `this is the target fps of the system, if it is not running at this all movment values will be corrected
  realfps as float    `true fps the system is running at, more accurate than screen fps()
  boot as dword       `value of timer() when the system starts
  factor as float     `this is what all movment values need to be multiplied by to achive timer based movement
  lastcheck as dword  `value of timer() the last time the system was updated
endtype

Global FPS#

FPS# = 60.0

Sync on : Sync rate FPS#

Tbm_init(FPS#)

Global Fog_Dist# = 10.0 `Fog Distance variable - DO NOT CHANGE UNLESS YOU KNOW WHAT YOU ARE DOING!

Global Ambient_Light# = 100.0 `Ambient Light variable - DO NOT CHANGE UNLESS YOU KNOW WHAT YOU ARE DOING!

Fog on `Turn on fog

Fog color rgb(255, 255, 255) `Set Fog's color (In this case, it's white) (Switch to rgb(0, 0, 0) , for a midnight effect)

Randomize Timer()

Sizex = 1000
Sizey = 1000
Spacing = 200

Dim Grid(Sizex,Sizey)

For x = 0 to Sizex/Spacing
   For y = 0 to Sizey/Spacing
      If x > 0 and y > 0 and x < Sizex/Spacing and y < Sizey/Spacing
        Height = Rnd(255)
        Ink rgb(Height,Height,Height),0
        Dot x*Spacing,y*Spacing
        Grid(x*Spacing,y*Spacing) = Height
      Else
        Height = 127
        Ink rgb(Height,Height,Height),0
        Dot x*Spacing,y*Spacing
        Grid(x*Spacing,y*Spacing) = Height
      Endif
   Next y
Next x
wait key

For y = 0 to Sizey/Spacing
   For x = 0 to (Sizex/Spacing)-1
      HorizontalSinWave(x*Spacing,(x+1)*Spacing,y*Spacing,Grid(x*Spacing,y*Spacing),Grid((x+1)*Spacing,y*Spacing))
   Next x
Next y


For x = 0 to Sizex
   For y = 0 to (Sizey/Spacing)-1
      VerticalSinWave(y*Spacing,(y+1)*Spacing,x,Grid(x,y*Spacing),Grid(x,(y+1)*Spacing))
   Next y
Next x
wait key

Get Image 1,0,0,Sizex,Sizey
Save Image "Image.bmp",1
Make Terrain 1,"Image.bmp"
Load Image "Grass.bmp",2
Texture Terrain 1,2

Tbm_update()

do

Fog distance Fog_Dist# `DO NOT CHANGE THIS, AS THIS IS WHAT CONTROLS THE FOG'S DISTANCE ONCE A KEY IS PRESSED!

set ambient light Ambient_Light#

If ControlKey()=1 then Fog_Dist# = Fog_Dist#+1.0*.05*Tbm.factor
If ShiftKey()=1 then Fog_Dist# = Fog_Dist#-1.0*.05*Tbm.factor

If KeyState(44)=1 then Ambient_Light# = Ambient_Light#+1.0*.05*Tbm.factor `SAME THING WITH THE AMBIENT LIGHT VALUE, IT IS RECOMMENDED TO KEEP IT AT THIS VALUE FOR SMALLER TERRAINS, OTHERWISE, USE THIS IN PLACE OF IT: Ambient_Light# = Ambient_Light#+1.0*Tbm.factor

If KeyState(45)=1 then Ambient_Light# = Ambient_Light#-1.0*.05*Tbm.factor `SAME THING WITH THE AMBIENT LIGHT VALUE, IT IS RECOMMENDED TO KEEP IT AT THIS VALUE FOR SMALLER TERRAINS, OTHERWISE, USE THIS IN PLACE OF IT: Ambient_Light# = Ambient_Light#-1.0*Tbm.factor

`CHANGE "Fog_Dist# = Fog_Dist#+1.0*.05*Tbm.factor OR Fog_Dist# = Fog_Dist#-1.0*.05*Tbm.factor IF NEEDED! IF YOU HAVE A HUGE TERRAIN, IT IS SUGGESTED THAT YOU USE Fog_Dist# = Fog_Dist#+1.0*Tbm.factor OR Fog_Dist# = Fog_Dist#-1.0*Tbm.factor instead, as this can cause the Fog to move VERY, VERY slowly because of the huge Terrain!

Control Camera Using Arrowkeys 0,3*Tbm.factor,3*Tbm.factor
Position Camera Camera Position X(),Get Matrix Height(1,Camera Position X(),Camera Position Z())+5,Camera Position Z()

sync
loop

Tbm_update()

Function HorizontalSinWave(X1,X2,Y,A,B)
D = b-a
Dis = X2-X1
   For x = X1 to X2
       sx = (x-x1)/(Dis/180.0)
       Height = a+(Sin(sx-90)+1)*d/2
       if height >255 then print "error" : wait key : end
       if height <0 then print "error" : wait key : end
       Ink Rgb(Height,Height,Height),0
       Grid(x,y) = Height
       Dot x,y
   Next x
Endfunction

Function VerticalSinWave(Y1,Y2,X,A,B)
D = b-a
Dis = Y2-Y1
   For Y = Y1 to Y2
       sy = (y-y1)/(Dis/180.0)
       Height = a+(Sin(sy-90)+1)*d/2
       if height >255 then print "error" : wait key : end
       if height <0 then print "error" : wait key : end
       Ink Rgb(Height,Height,Height),0
       Grid(x,y) = Height
       Dot x,y
   Next x
Endfunction

function Tbm_init(fps as float)

  global Tbm as Tbm

  Tbm.boot = timer()
  Tbm.lastcheck = Tbm.boot
  Tbm.targetfps = fps

endfunction

function Tbm_update()

  local now as dword
  local took as dword
  local factor as float

  now = timer()
  took = now - Tbm.lastcheck

  Tbm.lastcheck = now
  Tbm.realfps = 1000.0/took
  Tbm.factor = Tbm.targetfps/Tbm.realfps

endfunction


Here is an example WITH Timer-Based Movement, Better FPS, WITHOUT key controlled fog, & WITHOUT key controlled ambient light:

+ Code Snippet
REM Project: Map Generator
REM Created: 13/06/2007 11:09:11
REM
REM ***** Main Source File *****
REM
Set Display Mode 1280,1024,32
Randomize Timer()

type Tbm
  targetfps as float  `this is the target fps of the system, if it is not running at this all movment values will be corrected
  realfps as float    `true fps the system is running at, more accurate than screen fps()
  boot as dword       `value of timer() when the system starts
  factor as float     `this is what all movment values need to be multiplied by to achive timer based movement
  lastcheck as dword  `value of timer() the last time the system was updated
endtype

Global FPS#

FPS# = 60.0

Sync on : Sync rate FPS#

Tbm_init(FPS#)

Fog on `Turn on fog

Fog color rgb(255, 255, 255) Set Fog's color (In this case, it's white) (Switch to rgb(0, 0, 0) , for a midnight effect)

Fog distance 1450 `CHANGE THIS IF NEEDED, THIS SETS THE FOG'S DISTANCE! THIS IS ONLY NEEDED THIS HIGH WHEN THE TERRAIN IS HUGE!

set ambient light 100 OR set ambient light 25 `Depends on if you want all day or all night in your game, really

Sizex = 1000
Sizey = 1000
Spacing = 200

Dim Grid(Sizex,Sizey)

For x = 0 to Sizex/Spacing
   For y = 0 to Sizey/Spacing
      If x > 0 and y > 0 and x < Sizex/Spacing and y < Sizey/Spacing
        Height = Rnd(255)
        Ink rgb(Height,Height,Height),0
        Dot x*Spacing,y*Spacing
        Grid(x*Spacing,y*Spacing) = Height
      Else
        Height = 127
        Ink rgb(Height,Height,Height),0
        Dot x*Spacing,y*Spacing
        Grid(x*Spacing,y*Spacing) = Height
      Endif
   Next y
Next x
wait key

For y = 0 to Sizey/Spacing
   For x = 0 to (Sizex/Spacing)-1
      HorizontalSinWave(x*Spacing,(x+1)*Spacing,y*Spacing,Grid(x*Spacing,y*Spacing),Grid((x+1)*Spacing,y*Spacing))
   Next x
Next y


For x = 0 to Sizex
   For y = 0 to (Sizey/Spacing)-1
      VerticalSinWave(y*Spacing,(y+1)*Spacing,x,Grid(x,y*Spacing),Grid(x,(y+1)*Spacing))
   Next y
Next x
wait key

Get Image 1,0,0,Sizex,Sizey
Save Image "Image.bmp",1
Make Terrain 1,"Image.bmp"
Load Image "Grass.bmp",2
Texture Terrain 1,2

Tbm_update()

do
Control Camera Using Arrowkeys 0,3*Tbm.factor,3*Tbm.factor
Position Camera Camera Position X(),Get Matrix Height(1,Camera Position X(),Camera Position Z())+5,Camera Position Z()

sync
loop

Tbm_update()

Function HorizontalSinWave(X1,X2,Y,A,B)
D = b-a
Dis = X2-X1
   For x = X1 to X2
       sx = (x-x1)/(Dis/180.0)
       Height = a+(Sin(sx-90)+1)*d/2
       if height >255 then print "error" : wait key : end
       if height <0 then print "error" : wait key : end
       Ink Rgb(Height,Height,Height),0
       Grid(x,y) = Height
       Dot x,y
   Next x
Endfunction

Function VerticalSinWave(Y1,Y2,X,A,B)
D = b-a
Dis = Y2-Y1
   For Y = Y1 to Y2
       sy = (y-y1)/(Dis/180.0)
       Height = a+(Sin(sy-90)+1)*d/2
       if height >255 then print "error" : wait key : end
       if height <0 then print "error" : wait key : end
       Ink Rgb(Height,Height,Height),0
       Grid(x,y) = Height
       Dot x,y
   Next x
Endfunction

function Tbm_init(fps as float)

  global Tbm as Tbm
  
  Tbm.boot = timer()
  Tbm.lastcheck = Tbm.boot
  Tbm.targetfps = fps
  
endfunction

function Tbm_update()

  local now as dword
  local took as dword 
  local factor as float
  
  now = timer()
  took = now - Tbm.lastcheck
  
  Tbm.lastcheck = now
  Tbm.realfps = 1000.0/took
  Tbm.factor = Tbm.targetfps/Tbm.realfps

endfunction


I hope this helps! =)

Good Luck with your game, mate! ^_^

~M.W~
Posted: 14th Jun 2007 18:12
Your algorithm need really much time.. you should use memblock instead, I think, or at least lock/unlock pixels.
The next thing you could do, for realism, would be to generate a next heightmap, with halfed distance between your central points, and add the heights (if they are higher then 128, else substract them.. but you should also add the half heightvalue or something.. so that the main-heightmap is not erased completely). Sorry if you don't understand anything, hard to describe what I mean ^^ I made a similar algorithm some days ago...

Here:

+ Code Snippet
set display mode 1280,1024,32
randomize timer()

remstart
repeat
   mi_Generator_Heightmap(1024,1024,256,256,8,0.6,2)
   SaveImg(1)
   mi_Generator_Heightmap( 512, 512,128,128,8,0.6,3)
   SaveImg(2)
until escapekey()
remend


mi_Generator_Heightmap(512,512,128,128,8,0.6,1)
get image 1, 0,0,512,512, 1

do
   cls
   paste image 1,0,0
   print "Press returnkey!"
   if mousex()<=512 and mousey()<=512 then print mi_tempheight(mousex(),mousey())
   if returnkey()
      fr = 2^(4+rnd(2))
      mi_Generator_Heightmap(1024,1024,256,256,8,0.65,0)
      sync
      delete image 1
      get image 1, 0,0,1024,1024, 1
   endif
loop

function mi_Generator_Heightmap(sx,sy,freqx,freqy,iterations,reduce#,Blur)
   rem Create arrays
   dim mi_tempheight(sx,sy) as byte

   AddF# = 1/reduce#

   rem Create heightmap
   for i = 1 to iterations
      rem Define used variables
      frx = freqx/(2^(i-1))
      fry = freqy/(2^(i-1))
      if frx = 0 then frx = 1
      if fry = 0 then fry = 1
      AddF# = AddF#*reduce#
      HillsX = sx/frx
      HillsY = sy/fry
      dim mi_temphill(HillsX,HillsY) as byte
      rem Calculate Hills
      for x = 1 to HillsX
         for y = 1 to HillsY
            mi_temphill(x,y) = 25+rnd(205)
         next y
      next x

      rem Create interpolated Heightmap
         for x = 1 to sx
      lock pixels
            for y = 1 to sy
               xp# = (x/(1.0*frx))
               yp# = (y/(1.0*fry))
               cx = ceil(xp#) : fx = floor(xp#) : if fx < 1 then fx2 = 4 else fx2 = fx
               cy = ceil(yp#) : fy = floor(yp#) : if fy < 1 then fy2 = 4 else fy2 = fy
               xdis# = xp#-fx : ydis# = yp#-fy
               rem This two lines should smooth the whole thing.. but don't really do :/
               if xdis# > 0.5 then xdis# = (((1-((1-((xdis#*2)-1))^2))+1)/2) else xdis# = ((xdis#*2)^2)*0.5
               if ydis# > 0.5 then ydis# = (((1-((1-((ydis#*2)-1))^2))+1)/2) else ydis# = ((ydis#*2)^2)*0.5
               Col_F = (1-xdis#)*mi_temphill(fx2,fy2)+(xdis#)*mi_temphill(cx,fy2)
               Col_C = (1-xdis#)*mi_temphill(fx2, cy)+(xdis#)*mi_temphill(cx, cy)
               if i=1
                  mi_tempheight(x,y)=0
               endif
               add# = ((1-ydis#)*Col_F+(ydis#)*Col_C-((i>1)*128))*AddF#
               H = mi_tempheight(x,y)+add#
               if H > 255 : H = 255 : endif : if H < 0 : H = 0 : endif
               mi_tempheight(x,y)=H
      dot x,y,rgb(H,H,H)
            next y
      unlock pixels
      if controlkey()=0
         sync
      else
         if escapekey() then end
      endif
         next x
      `repeat : sync : until spacekey()=1 : repeat : until spacekey()=0
   next i

   rem Blur Image?
   for b = 1 to Blur
lock pixels
      for x = 1 to sx
         for y = 1 to sy
            c1 = temp_getcol(x-1,y  ,sx,sy)
            c2 = temp_getcol(x+1,y  ,sx,sy)
            c3 = temp_getcol(x  ,y-1,sx,sy)
            c4 = temp_getcol(x  ,y+1,sx,sy)
            c5 = mi_tempheight(x,y)
            c = (c1+c2+c3+c4+c5)/5
            mi_tempheight(x,y)=c
dot x,y, rgb(c,c,c)
         next y
unlock pixels
dot x,sy+b, rgb(((255.0*b)/Blur),0,0)
if controlkey()=0 then sync
if escapekey() then end
      next x
   next B
endfunction

function temp_getCol(x,y,sx,sy)
   if x < 1 then x = sx-x
   if y < 1 then y = sy-y
   if x > sx then x = x-sx
   if y > sy then y = y-sy
   h = mi_tempheight(x,y)
endfunction h

function SaveImg(v)
   sync
   if v = 1 `1024x1024
      get image 1, 0,0,1024,1024, 1
      file$ = "HM 1024Heightmap"
      x = 0
      repeat
         inc x
         file2$ = file$+str$(x)+".jpg"
      until file exist(file2$) = 0
      save image file2$, 1
   else `512x512
      get image 1, 0,0,512,512, 1
      file$ = "HM 512Heightmap"
      x = 0
      repeat
         inc x
         file2$ = file$+str$(x)+".jpg"
      until file exist(file2$) = 0
      save image file2$, 1
   endif
endfunction


They look more natural, I think, but although not really realistic, because they are not smooth enough... But after 2 minutes of smoothing they look really good.

Edit: You can see a smoothed heightmap as Terrain with lightmap here: http://img113.imageshack.us/img113/8373/heightmapanzeige3dl7.png
Posted: 14th Jun 2007 18:43
Hey, thanks alot, Mr Kohlenstoff ! =)

I've been looking for one of these, FOREVER! =)

~M.W~