Sorry your browser is not supported!

` Green Gandalf's Perlin style noise function - Version 6
` Created 25 June 2007, modified 21 February 2008.

`   Uses suggestions from following website
`      http://www.mandelbrot-dazibao.com/Perlin/Perlin1.htm
`   and especially
`      http://mrl.nyu.edu/~perlin/ (and browse to his 2002 paper)

` This version restricts the gradients to +/- 1 as suggested
` by Ken Perlin (in fact there's no need for the rnd() function at all
` - could probably just use a simple method of haphazardly swapping the signs
` of the gradients).

` All four methods work well - but simple linear filtering shows slight seams on final image.

` Attempt at an another optimized version.

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

time0 = timer()

randomize 1234567890 ` arbitrary fixed number for reproducibility

autocam off
position camera 0, 50, -300
point camera 0, 0, 0

create bitmap 1, 512, 512

global nOct = 8
global twoPiInv as float
twoPiInv = 0.159154943

dim weight#(nOct)

dim rawNoise(511, 511) as float

dim a(512, 512, nOct) as float ` somewhat wasteful in space
dim b(512, 512, nOct) as float
dim interp(511) as float
dim offset(nOct, 512)
dim invSize(nOct) as float
dim tile(nOct)
dim invTile(nOct)

increment = 512
p# = 2.0
for oct = 0 to nOct
  for i = 0 to 512 step increment
    for j = 0 to 512 step increment
      a(i, j, oct) = rnd(1) * 2 - 1  ` random value +/- 1
      b(i, j, oct) = rnd(1) * 2 - 1  ` random value +/- 1
                                             ` not seamless yet
    next j
  next i
  for i = 0 to 512
    offset(oct, i) = i MOD increment
  next i
  weight#(oct) = 1.0/(p#^oct)
  invSize(oct) = 1.0/increment
  tile(oct) = increment
  invTile(oct) = 512/increment
  increment = increment/2
next oct

for i = 0 to 511
  x# = i/512.0
`  interp(i) = x#                                 ` simple bilinear weight
`  interp(i) = x# * x# * (3.0 - 2.0 * x#)         ` original Perlin weight
`  interp(i) = x# * x# * x# * (6.0 * x# * x# - 15.0 * x# + 10.0) ` revised Perlin weight
  interp(i) = x# - sin(360.0 * x#) * twoPiInv    ` sine weight
next i

time1 = timer()

` calculate raw noise and find scale factors for
` rescaling noise values to byte range
minNoise# = 10000  ` arbitrary large number out of range
maxNoise# = -10000 ` arbitrary small number out of range
for x = 0 to 511
  for y = 0 to 511
    rawNoise(x, y) = noise(x, y)
    if minNoise# > rawNoise(x, y)
      minNoise# = rawNoise(x, y)
    else
      if maxNoise# < rawNoise(x, y) then maxNoise# = rawNoise(x, y)
    endif
  next y
next x

time2 = timer()

f# = 255.0/(maxNoise# - minNoise#)

lock pixels
  for x = 0 to 511
    for y = 0 to 511
      ` convert raw noise to byte range 0 - 255
      c = (rawNoise(x, y) - minNoise#) * f#
      ` just in case
      if c<0 then c=0
      if c>255 then c=255
      
      
      radius = 256
      
      centerToX# = x - radius
      centerToY# = y - radius
distanceToCenter# = Sqrt(centerToX# * centerToX# + centerToY# * centerToY#) 
      //c =100
//c = c * (1- abs( (x/512*2)-1) ) * (1-abs((y/512*2)-1))      
      
      n = 255*(distanceToCenter# / radius )
      if n < 0 then n = 0
      if n > 255 then n = 255
      
      c = c-n
     // c = c + 10
     
    
    //this line of code controls the amount of contrast 
     c = (( (c - 1) * max(2, 0)) + 1)*2
     
      if c < 0 then c = 0
      
      if c > 255 then c = 255
     //c = n
      

tint# = c/255.0
ret# = 0


Shadow# =  0.0
Midtone# = 0.5
Highlight# = 0.8



//midtone is 30% - 70% or < 0.3 and > 0.7

ret# = tint#

if tint# < 0.68
if tint# > 0.3

ret# = tint# * Midtone#

endif
endif

//adjust highlight
if tint# > 0.68
	
ret# = ret# * Highlight#	
endif	

    
    
ret# = ret# * 255

      
      
      if ret# < 0 then ret# = 0
      
      if ret# > 255 then ret# = 255
      
      dot x, y, rgb(ret#, ret#, ret#) 
     // if c < 10 
    //  b =100
     // dot x, y, rgb(0, 0, b) ` a nice green colour :)
    //  endif
      
      
      
      
    next y
  next x
  
  
unlock pixels

time3 = timer()


blur bitmap 1, 6
blur bitmap 1, 6
copy bitmap 1, 0, 0, 511, 511,  0, 144, 44, 655, 555


set current bitmap 0

time = timer()

repeat
  text 20, 20, "All done in "+str$(time-time0)+" ms"
  text 20, 40, "Table set-up = "+str$(time1-time0)+" ms"
  text 20, 60, "Raw noise set-up = "+str$(time2-time1)+" ms"
  text 20, 80, "Noise rescale and image creation = "+str$(time3-time2)+" ms"
  sync
until spacekey()


 
set current bitmap 1
get image 1, 0, 0, 512, 512
save image "l:\test v3.jpg", 1
end

function max( a,b)

if a > b then result# = a
if b > a then result# = b



endfunction result#



function noiseBase(oct, x, y)
  ` x and y both in range 0 to 511
  ` find x and y offsets within tile
  xd = offset(oct, x)
  yd = offset(oct, y)
  w = tile(oct)
  x# = xd * invSize(oct)  ` number in range 0 to 1
  y# = yd * invSize(oct)
  ` look-up interpolation weights
  ix# = interp(xd*invTile(oct))
  iy# = interp(yd*invTile(oct))
  ` calculate tangents at four corners of tile
  i = x - xd
  j = y - yd
  t0# = a(i, j, oct) * x# + b(i, j, oct) * y#
  t1# = a(i, j + w, oct) * x# + b(i, j + w, oct) * (y# - 1.0)
  t2# = a(i + w , j, oct) * (x# - 1.0) + b(i + w, j, oct) * y#
  t3# = a(i + w, j + w, oct) * (x# - 1.0) + b(i + w, j + w, oct) * (y# - 1.0)
  ` calculate interpolated noise value in two stages
  tA# = t0# + (t2# - t0#) * ix#
  tB# = t1# + (t3# - t1#) * ix#
  result# = tA# + (tb# - tA#) * iy#
endfunction result#

function noise(x, y)
  result# = 0.0
`  result# = noiseBase(2, x, y) ` used for testing single octave instead of next 3 lines
  for oct = 0 to nOct
    result# = noiseBase(oct, x, y) * weight#(oct) + result#
  next oct
endfunction result#