Sorry your browser is not supported!

` Green Gandalf's cloudy sky/heightmap maker

` Produces a fractal terrain based on ideas in following website
`          http://www.gameprogrammer.com/fractal.html

` Can also be used to make clouds, cloudy skies or smoke
` or even a changing sky (with quite a bit more work!).

` Use cloud=1 for a blue sky with clouds or cloud=0 for a heightmap
` which can be used in Advanced Terrain.

` n=8 gives a 256x256 bitmap

set display mode 800,600,32
sync on: sync rate 60: sync

set cursor 20,20
input "Enter name for new heightmap:",file$

n=8: dispersion#=512: mean#=64: k=0: f=0: e=1: cloud=1: minBlue=200: minGrey=85
npixels=4000

` data for initial fixed peaks (excluding edges)
data 97,129,255,  97,161,255,  193,65,255

g=2^n: maxgrid=g
dim y(g+1,g+1)
dim a(g+1,g+1)
dim ilist(f)
dim jlist(f)
dim yval(f)

for r=1 to f
  read ilist(r)
  read jlist(r)
  read yval(r)
next r

gosub fractal_terrain

gosub make_bitmap

gosub move_clouds

end

fractal_terrain:

  ` creates a "fractal terrain" loosely based on the "diamond-square algorithm"

  ` initialisation
  cls
  randomize timer()
  d#=dispersion#: m#=mean#
  for i=1 to maxgrid+1
    for j=1 to maxgrid+1
      a(i,j)=0
      y(i,j)=k
    next j
  next i

  ` initialise fixed points
  if e=1 ` fix edges
    for i=1 to maxgrid+1
      a(i,1)=1
      a(i,maxgrid)=1
      a(i,maxgrid+1)=1
      a(1,i)=1
      a(maxgrid,i)=1
      a(maxgrid+1,i)=1
    next i
  endif

  ` initialise interior fixed points
  for r=1 to f
    y(ilist(r),jlist(r))=yval(r)
    a(ilist(r),jlist(r))=1
  next r

  ` main loop
  while g>1
    mid=g/2

    ` diamond step - calculates new diamond corners from squares
    i=mid+1: i1=i-mid: i2=i+mid
    while i<maxgrid+1
      j=mid+1: j1=j-mid: j2=j+mid
      while j<maxgrid+1
        if a(i,j)=0 ` check whether height is pre-fixed
          av=(y(i1,j1)+y(i1,j2)+...
               y(i2,j1)+y(i2,j2))/4
          ` calculate random value between -1 and 1
          u#=rnd(16384)/8192.0-1.0
          y(i,j)=av+u#*d#+m#
          ` check y is in valid range for single byte
          if y(i,j)>255 then y(i,j)=255
          if y(i,j)< 0  then y(i,j)=0
          a(i,j)=1 ` just in case!
        endif
        inc j,g: inc j1,g: inc j2,g
      endwhile
      inc i,g: inc i1,g: inc i2,g
    endwhile

    ` square step - calculates new square corners from diamonds
    i=1: i1=i-mid: i2=i+mid: js=0
    while i<maxgrid+1
      js=mid-js ` toggle start values of j loop
      j=js+1: j1=j-mid: j2=j+mid
      while j<maxgrid+1
        if a(i,j)=0 ` check whether height is pre-fixed
          av=0
          if i1<1  ` check for need to wrap around i value
            inc av,y(i1+maxgrid,j)+y(i2,j)
          else
            if i2>maxgrid+1
              inc av,y(i1,j)+y(i2-maxgrid,j)
            else
              inc av,y(i1,j)+y(i2,j)
            endif
          endif
          if j1<1  ` check for need to wrap around j value
            inc av,y(i,j1+maxgrid)+y(i,j2)
          else
            if j2>maxgrid+1
              inc av,y(i,j1)+y(i,j2-maxgrid)
            else
              inc av,y(i,j1)+y(i,j2)
            endif
          endif
          av=av/4
          ` calculate random value between -1 and 1
          u#=rnd(16384)/8192.0-1.0
          y(i,j)=av+u#*d#+m#
          ` check y is in valid range for single byte
          if y(i,j)>255 then y(i,j)=255
          if y(i,j)< 0  then y(i,j)=0
          a(i,j)=1 ` just in case!
        endif
        if i=1 ` check need to copy opposite edge
          y(maxgrid+1,j)=y(1,j)
        endif
        inc j,g: inc j1,g: inc j2,g
      endwhile
      if js=0 ` check need to copy opposite edge
        y(i,maxgrid+1)=y(i,1)
      endif
      inc i,mid: inc i1,mid: inc i2,mid
    endwhile
    d#=d#/2.0: m#=m#/2.0: g=g/2
  endwhile
return

make_bitmap:
  create bitmap 1,maxgrid,maxgrid
  lock pixels
    for i=0 to maxgrid-1
      for j=0 to maxgrid-1
        grey=y(i+1,j+1)
        if cloud=1 and grey<minBlue
          if grey<minGrey then grey=minGrey
          dot i,j,rgb(grey,grey,minBlue)
        else
          dot i,j,rgb(grey,grey,grey)
        endif
      next j
    next i
  unlock pixels
  get image 1,0,0,maxgrid,maxgrid
  if file exist(file$) then delete file file$
  save image file$,1
  set current bitmap 0
  cls
  copy bitmap 1,0
  center text screen width()/2,screen height()/2,"Press any key to continue"
  sync
  wait key
return

move_clouds:
  while inkey$()<>"" ` wait for inkey to clear
  endwhile
  cls
  set current bitmap 0
  while inkey$()=""
    copy bitmap 1,0,0,maxgrid-1,maxgrid,0,1,0,maxgrid,maxgrid
    copy bitmap 1,maxgrid-1,0,maxgrid,maxgrid,0,0,0,1,maxgrid
    copy bitmap 0,1
    center text screen width()/2,screen height()/2,"Press any key to finish"
    sync
  endwhile
return

` Green Gandalf's scrolling cloudy sky maker

` Produces a fractal sky based on ideas in following website
`          http://www.gameprogrammer.com/fractal.html

` Use cloud=1 for a blue sky with clouds or cloud=0 for clouds only

` n=8 gives a 256x256 bitmap

set display mode 640,480,32
set text opaque
sync on: sync rate 60: sync

set cursor 20,20

n=8: dispersion#=128: mean#=64: k=0: f=0: e=0: cloud=1: minBlue=200: minGrey=85

first=0

g=2^n: maxgrid=g
dim y(g+1,g+1)
dim y2(g+1,g+1)

im=1: gosub fractal_sky ` prepare initial random sky and view it

gosub copy_array ` prepare second copy of initial sky data

im=2: gosub fractal_sky ` prepare second random sky and view it

gosub copy_array

set current bitmap 0

cls: copy bitmap 1,0 ` reinstate view of initial sky

gosub scroll_and_change_clouds

end

fractal_sky:

  ` creates a "fractal sky" loosely based on the "diamond-square algorithm"

  ` initialisation
  cls
  randomize timer()
  g=maxgrid
  d#=dispersion#: m#=mean#
  for i=1 to maxgrid+1
    for j=1 to maxgrid+1
      y(i,j)=k
    next j
  next i
  ` main loop
  while g>1
    mid=g/2

    ` diamond step - calculates new diamond corners from squares
    gosub diamond_step

    ` square step - calculates new square corners from diamonds
    gosub square_step

    d#=d#/2.0: m#=m#/2.0: g=g/2
  endwhile

  gosub make_bitmap

return

make_bitmap:
  create bitmap im,maxgrid,maxgrid
  lock pixels
    for i=0 to maxgrid-1
      for j=0 to maxgrid-1
        iw=i: jw=j: gosub dotij
      next j
    next i
  unlock pixels
  set current bitmap 0
  cls
  copy bitmap im,0
  center text screen width()/2,screen height()/2,"Press any key to continue"
  sync
  wait key
return

scroll_and_change_clouds:
  ` use same code as before - but build up a bit each sync
  while inkey$()<>"" ` wait for inkey to clear
  endwhile

  g=maxgrid: counter=maxgrid-1
  d#=dispersion#: m#=mean#

  while inkey$()=""

    set current bitmap 0
    center text screen width()/2,screen height()/2," Press any key to finish "
    center text screen width()/2,screen height()/2+60,"fps = "+str$(screen fps())

    ` first scroll existing image one pixel to the right
    copy bitmap 0,0,0,maxgrid-1,maxgrid,  0,1,0,maxgrid,maxgrid
    copy bitmap 2,counter,0,counter+1,maxgrid,  0,0,0,1,maxgrid


    ` now create new image in background - a little bit each sync
    if g>1
      mid=g/2

      ` diamond step - calculates new diamond corners from squares
      gosub diamond_step

      ` square step - calculates new square corners from diamonds
      gosub square_step

      d#=d#/2.0: m#=m#/2.0: g=g/2
    endif
    dec counter
    if counter<0 ` re-initalise variables and replace second image with new image
      inc im
      g=maxgrid: counter=maxgrid-1
      d#=dispersion#: m#=mean#
      set current bitmap 2
      lock pixels
        for i=0 to maxgrid-1
          for j=0 to maxgrid-1
            iw=i: jw=j: gosub dotij
          next j
        next i
      unlock pixels
      gosub copy_array
    endif
    sync
  endwhile
return

copy_array:
  for i=1 to maxgrid+1
    for j=1 to maxgrid+1
      y2(i,j)=y(i,j)
    next j
  next i
return

dotij:
        grey=y(iw+1,jw+1)
        if cloud=1 and grey<minBlue
          if grey<minGrey then grey=minGrey
          dot iw,jw,rgb(grey,grey,minBlue)
        else
          dot iw,jw,rgb(grey,grey,grey)
        endif
return

diamond_step:
  i=mid+1: i1=i-mid: i2=i+mid
  while i<maxgrid+1
    j=mid+1: j1=j-mid: j2=j+mid
    while j<maxgrid+1
      av=(y(i1,j1)+y(i1,j2)+y(i2,j1)+y(i2,j2))/4
      ` calculate random value between -1 and 1
      u#=rnd(16384)/8192.0-1.0
      y(i,j)=av+u#*d#+m#
      ` check y is in valid range for single byte
      if y(i,j)>255 then y(i,j)=255
      if y(i,j)< 0  then y(i,j)=0
      inc j,g: inc j1,g: inc j2,g
    endwhile
    inc i,g: inc i1,g: inc i2,g
  endwhile
return

square_step:
  i=1: i1=i-mid: i2=i+mid: js=0
  while i<maxgrid+1
    js=mid-js ` toggle start values of j loop
    j=js+1: j1=j-mid: j2=j+mid
    while j<maxgrid+2
      av=0
      if i1<1  ` check for need to wrap around i value
        inc av,y(i2,j)+y(i2,j)
      else
        if i2>maxgrid+1
          if im=1
            inc av,y(i1,j)+y(i1,j)
          else
            inc av,y(i1,j)+y2(i2-maxgrid,j) ` use adjacent image
          endif
        else
          inc av,y(i1,j)+y(i2,j)
        endif
      endif
      if j1<1  ` check for need to wrap around j value
        inc av,y(i,j2)+y(i,j2)
      else
        if j2>maxgrid+1
          inc av,y(i,j1)+y(i,j1)
        else
          inc av,y(i,j1)+y(i,j2)
        endif
      endif
      av=av/4
      ` calculate random value between -1 and 1
      u#=rnd(16384)/8192.0-1.0
      y(i,j)=av+u#*d#+m#
      ` check y is in valid range for single byte
      if y(i,j)>255 then y(i,j)=255
      if y(i,j)< 0  then y(i,j)=0
      if i=1 ` check need to copy opposite edge
        if im=1
          y(maxgrid+1,j)=y(1,j) ` copy opposite edge
        else
          y(maxgrid+1,j)=y2(1,j)` copy edge from adjacent image
        endif
      endif
      inc j,g: inc j1,g: inc j2,g
    endwhile
    inc i,mid: inc i1,mid: inc i2,mid
  endwhile
return