Graphics 320,240,32,1
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Global max_size=128
Dim pixel%(max_size,max_size)

t = MilliSecs()
heightmap = createHeightmap(64,17,5)
t2 = MilliSecs()-t

ClsColor 255,0,255
While Not KeyHit(1)
 Cls

 DrawBlock heightmap,160-32,120-32
 Color 0,0,0
 Text 0,0,t2/1000+" Sekunden gebraucht"

 Flip
Wend
FreeImage heightmap
End



Function CreateHeightmap(size%=64,detail%=3,smear%=0)

   img = CreateImage(size%,size%)
   
   LockBuffer ImageBuffer(img)
   For y = 0 To detail%+1
    For x = 0 To detail%+1
     col = Rand(0,255)
     rgb=255*$1000000+col*$10000+col*$100+col
     WritePixelFast Float(x)*(Float(size-1)/(Float(detail)+1.0)),Float(y)*(Float(size-1)/(Float(detail)+1.0)),rgb,ImageBuffer(img)
    Next
   Next
   
   For y = 0 To detail%+1
    For x = 0 To detail%
     x1% = Float(x)*(Float(size-1)/(Float(detail)+1.0))
     y1% = Float(y)*(Float(size-1)/(Float(detail)+1.0))
     x2% = Float(x+1)*(Float(size-1)/(Float(detail)+1.0))
     rgb1 = ReadPixelFast(x1%,y1%,ImageBuffer(img))
     rgb2 = ReadPixelFast(x2%,y1%,ImageBuffer(img))
   
     col1=rgb1 And $FF
     col2=rgb2 And $FF
   
     col_new# = col1
     diff = col2-col1
     dist = x2%-x1%
     plus# = Float(diff)/Float(dist)
     For I = x1%+1 To x2%-1
      col_new# = col_new + plus#
      col% = col_new
      rgb_new=255*$1000000+col*$10000+col*$100+col
      WritePixelFast I,y1,rgb_new,ImageBuffer(img)
     Next
   
    Next
   Next
   
   For y = 0 To detail%
    For x = 0 To detail%+1
     x1% = Float(x)*(Float(size-1)/(Float(detail)+1.0))
     y1% = Float(y)*(Float(size-1)/(Float(detail)+1.0))
     y2% = Float(y+1)*(Float(size-1)/(Float(detail)+1.0))
     rgb1 = ReadPixelFast(x1%,y1%,ImageBuffer(img))
     rgb2 = ReadPixelFast(x1%,y2%,ImageBuffer(img))
   
     col1=rgb1 And $FF
     col2=rgb2 And $FF
   
     col_new# = col1
     diff = col2-col1
     dist = y2%-y1%
     plus# = Float(diff)/Float(dist)
     For I = y1%+1 To y2%-1
      col_new# = col_new + plus#
      col% = col_new
      rgb_new=255*$1000000+col*$10000+col*$100+col
      WritePixelFast x1,I,rgb_new,ImageBuffer(img)
     Next
   
    Next
   Next
   
   For y = 0 To detail
    For x = 0 To detail
   
     x1% = Float(x)*(Float(size-1)/(Float(detail)+1.0))
     y1% = Float(y)*(Float(size-1)/(Float(detail)+1.0))
     x2% = Float(x+1)*(Float(size-1)/(Float(detail)+1.0))
     y2% = Float(y+1)*(Float(size-1)/(Float(detail)+1.0))
   
     For posy = y1+1 To y2-1
      For posx = x1+1 To x2-1
      
       rgb1 = ReadPixelFast(posx,y1,ImageBuffer(img))
       rgb2 = ReadPixelFast(posx,y2,ImageBuffer(img))
       rgb3 = ReadPixelFast(x1,posy,ImageBuffer(img))
       rgb4 = ReadPixelFast(x2,posy,ImageBuffer(img))
       col1 = rgb1 And $FF
       col2 = rgb2 And $FF
       col3 = rgb3 And $FF
       col4 = rgb4 And $FF
   
       col_new1# = col3
       diff = col4-col3
       dist = x2%-x1%
       plus# = Float(diff)/Float(dist)
      col_new1 = col_new1 + (plus#*(posx-x1))
      
       col_new2# = col1
       diff = col2-col1
       dist = y2%-y1%
       plus# = Float(diff)/Float(dist)
      col_new2 = col_new2 + (plus#*(posy-y1))
      
      col = (col_new1+col_new2)/2
      rgb = 255*$1000000+col*$10000+col*$100+col
   
       WritePixelFast posx,posy,rgb,ImageBuffer(img)
   
      Next
     Next
   
    Next
   Next
   
   If smear% Then
    For y = 0 To size-1
     For x = 0 To size-1
      rgb = ReadPixelFast(x,y,ImageBuffer(img))
      pixel(x,y) = rgb And $FF
     Next
    Next
   
    For y = 0 To size-1
     For x = 0 To size-1
      
      count = 0
      col = 0
      For posy = 0 To size-1
       For posx = 0 To size-1
        
        If Sqr( (posx-x)^2 + (posy-y)^2 ) =< smear% Then
         count = count + 1
         col = col + pixel(posx,posy)
        EndIf
   
       Next
      Next
   
      col = Float(col) / Float(count)
      rgb = 255*$1000000+col*$10000+col*$100+col
      WritePixelFast x,y,rgb,ImageBuffer(img)
   
     Next
    Next
   EndIf
   
   UnlockBuffer ImageBuffer(img)
   
   Return img

End Function