Maybe Perlin Noise - Printable Version

Code:

' Maybe perlin noise ...

' ----------------------



set window "test", 512, 512 + 16

set redraw off



randomize 15



w = 256;  h = 256

img = createimage(w, h)



' Create a couple of clouds of different resolutions and put them in an array.

octaves = [CloudMap(4, 4), CloudMap(8, 8), CloudMap(16, 16), CloudMap(32, 32), CloudMap(64, 64)]

for i = 0 to sizeof(octaves) - 1

    set color 0, 0, 0

    cls

    set color 255, 255, 255

    set caret 0, 0

    wln "Generating cloud ..."

    redraw

    

    ' Draw to image img.

    set image img

    for y = 0 to h - 1  for x = 0 to w - 1

        ' The parameter ranges of a cloud is [0..1], so divide x and y by the width and height of

        ' image to get coordinates in that range. Note that the parameters you send to ValueAt are

        ' wrapped and that the cloud is seamless.

        nx = x/w;  ny = y/h

        ' Add values from the first i clouds to add more and more details.

        v = 0;  amp = 1

        for j = 0 to i

            v = v + octaves[j].ValueAt(nx, ny)*amp

            amp = amp*0.5

        next

        ' ValueAt returns values in the range [-1..1], so multiply with 0.5, add 0.5 and multiply 

        ' with 255 to get values [0..255].

        v = 255*(0.5 + 0.5*v)

        set color v, v, v

        set pixel x, y

    next

    set image primary

    ' Draw four images to confirm that they're seamless.

    set color 255, 255, 255

    draw image img, 0, 0

    draw image img, w, 0

    draw image img, 0, h

    draw image img, w, h

    set caret width(primary)/2, 512

    center "Press spacebar to continue ..."

    redraw

    while not keydown(KEY_SPACE, true)  fwait 60

next



' CloudMap

' --------

function CloudMap(resX, resY)

    map = []

    

    ' Create grid of random unit vectors.

    map.m = dim(resX, resY)

    for y = 0 to resY - 1  for x = 0 to resX - 1

        a = rnd()*PI*2

        map.m[x][y] = [x: cos(a), y: sin(a)]

    next

    

    ' ValueAt

    ' -------

    ' Return value, [-1..1] at coordinates (x, y), The size of the cloud is 1x1, but the coordinates

    ' are wrapped and the cloud is always seamless.

    map.ValueAt = function(x, y)

        m = this.m

        w = sizeof(m);  h = sizeof(m[0])

        x = (x*w)%w;  y = (y*h)%h

        x0 = floor(x);  y0 = floor(y)

        x1 = (x0 + 1)%w;  y1 = (y0 + 1)%h

        fx = x - x0;  fy = y - y0

        tl = -fx*m[x0][y0].x - fy*m[x0][y0].y

        tr = (1 - fx)*m[x1][y0].x - fy*m[x1][y0].y

        bl = -fx*m[x0][y1].x + (1 - fy)*m[x0][y1].y

        br = (1 - fx)*m[x1][y1].x + (1 - fy)*m[x1][y1].y

        return Bilinear(tl, tr, bl, br, Quad(0, 1, fx), Quad(0, 1, fy))

        

        ' Bilinear

        ' --------

        function Bilinear(tl, tr, bl, br, x, y)

            ix = 1 - x

            return (1 - y)*(ix*tl + x*tr) + y*(ix*bl + x*br)

        endfunc



        ' Quad

        ' ----

        function Quad(a, b, p)

            return a - 3*a*p^2 + 2*a*p^3 + 3*b*p^2 - 2*b*p^3

        endfunc

    endfunc

    

    return map

endfunc

Code:

' Some experiments, lots of code for god-knows-what here ...



set window "texgen", 256, 256, false, 2

set redraw off



' Create some interesting textures.

w = 128;  h = 128



' Rock.

randomize 16

' Create base image.

rockImage = NoiseImage(w, h, 2, 2, 3)

' Add structure with a noise bumpmap.

tmp = NoiseImage(w, h, 3, 3, 4)

bumpmap = Bumpmap(tmp, 0.075)

ApplyBumpmap(rockImage, bumpmap, 1, 1, 1)

' Don't need these images more.

free image tmp

free image bumpmap

' Modify colors a bit.

ApplyTint(rockImage, 255, 128, 32, 0, 0.75, 1)

ApplyTint(rockImage, 16, 64, 255, 1, 0, 0)



' Brick wall.

randomize 37

bricksImage = NoiseImage(w, h, 2, 2, 4)

' Add  structure with a noise bumpmap.

tmp = NoiseImage(w, h, 8, 8, 4)

bumpmap = Bumpmap(tmp, 0.15)

ApplyBumpmap(bricksImage, bumpmap, 1, 1, 1)

free image tmp

free image bumpmap

' Create and apply brick wall bumpmap.

tmp = createimage(w, h)

set image tmp, false

set color 0, 0, 0

cls

set color 255, 255, 255

tw = w/4;  th = h/8

for y = 0 to 7  for x = 0 to 4  draw rect x*tw - (y%2)*tw/2 + 2 , y*th + 2, tw - 4, th - 4, true

set image primary

Blur(tmp, 3)

bumpmap = Bumpmap(tmp, 0.35)

ApplyBumpmap(bricksImage, bumpmap, 1, 1, 1)

free image tmp

free image bumpmap

' Modify colors a bit.

ApplyTint(bricksImage, 255, 64, 64, 1, 0, 0)

ApplyTint(bricksImage, 255, 208, 128, 0, 1, 1)



' Display four rock images.

set color 255, 255, 255

draw image rockImage, 0, 0

draw image rockImage, w, 0

draw image rockImage, 0, h

draw image rockImage, w, h

set caret width(primary)/2, 4

center "Press spacebar to continue"

redraw

while not keydown(KEY_SPACE, true) fwait 60



' Display four bricks images.

draw image bricksImage, 0, 0

draw image bricksImage, w, 0

draw image bricksImage, 0, h

draw image bricksImage, w, h

set caret width(primary)/2, 4

center "Press spacebar to quit"

redraw

while not keydown(KEY_SPACE, true) fwait 60







' Bilerp

' ------

' Return bilinear interpolation of four values.

function Bilerp(tl, tr, bl, br, x, y)

    return (1 - y)*((1 - x)*tl + x*tr) + y*((1 - x)*bl + x*br)

endfunc



' BilerpV

' -------

' Return bilinear interpolation of four arrays.

function BilerpV(tl, tr, bl, br, x, y)

    c = sizeof(tl)

    v = dim(c)

    ix = 1 - x;  iy = 1 - y

    for i = 0 to c - 1  v[i] = iy*(ix*tl[i] + x*tr[i]) + y*(ix*bl[i] + x*br[i])

    return v

endfunc



' Bumpmap

' -------

' Treat the red color channel of image img as height data and create a bumpmap. normalZ determines

' the roughness of the surface. A low value creates a rougher looking surface, and probably you'll

' usually want to keep the value in the range [0.1 .. 1]. The function returns a new image, but

' this image is actually a normalmap, where a 3d normal is coded into the rgb data of each pixel.

function Bumpmap(img, normalZ)

    assert normalZ > 0, "CreateBumpmap: z must be larger than 0"

    w = width(img);  h = height(img)

    map = createimage(w, h)

    set image map, false

    for y = 0 to h - 1  for x = 0 to w - 1

        nx = (Red(pixeli(img, (x + 1)%w, y)) - Red(pixeli(img, (x - 1)%w, y)))/255

        ny = (Red(pixeli(img, x, (y + 1)%h)) - Red(pixeli(img, x, (y - 1)%h)))/255

        nz = normalZ

        k = 128/sqr(nx*nx + ny*ny + nz*nz)

        nx = 128 + nx*k;  ny = 128 + ny*k;  nz = 128 + nz*k

        set color nx, ny, nz

        set pixel x, y

    next

    set image primary

    return map

endfunc



' ApplyBumpmap

' ------------

' Apply bumpmap bmap, created with CreateBumpmap, to img using the light vector (lightDx lightDy

' lightDz).

function ApplyBumpmap(img, bmap, lightDx, lightDy, lightDz)

    w = width(img);  h = height(img);  wbmap = width(bmap);  hbmap = height(bmap)

    s = sqr(lightDx*lightDx + lightDy*lightDy + lightDz*lightDz)

    lightDx = lightDx/s;  lightDy = lightDy/s;  lightDz = lightDz/s

    set image img, false

    ' Same size?

    if wbmap = w and hbmap = h

        for y = 0 to h - 1  for x = 0 to w - 1

            c = pixeli(bmap, x, y)

            nx = (Red(c) - 128)/128

            ny = (Green(c) - 128)/128

            nz = (Blue(c) - 128)/128

            i = max(nx*lightDx + ny*lightDy + nz*lightDz, 0)

            c = pixeli(x, y)

            set color Red(c)*i, Green(c)*i, Blue(c)*i

            set pixel x, y

        next

    else

        ' Use bilinear interpolation of normals.

        sx = wbmap/w;  sy = hbmap/h

        for y = 0 to h - 1  for x = 0 to w - 1

            xl = sx*x;  xf = xl - floor(xl);  xr = (xl + 1)%wbmap

            yt = sy*y;  yf = yt - floor(yt);  yb = (yt + 1)%hbmap

            tl = pixel(bmap, xl, yt);  tr = pixel(bmap, xr, yt)

            bl = pixel(bmap, xl, yb);  br = pixel(bmap, xr, yb)

            n = BilerpV(tl, tr, bl, br, xf, yf)

            n[0] = (n[0] - 128)/128

            n[1] = (n[1] - 128)/128

            n[2] = (n[2] - 128)/128

            ' We SHOULD normalize n, but ... meh.

            'k = 1/sqr(n[0]*n[0] + n[1]*n[1] + n[2]*n[2])

            'n[0] = n[0]*k;  n[1] = n[1]*k;  n[2] = n[2]*k

            i = max(n[0]*lightDx + n[1]*lightDy + n[2]*lightDz, 0)

            c = pixeli(x, y)

            set color Red(c)*i, Green(c)*i, Blue(c)*i

            set pixel x, y

        next

    endif

    set image primary

endfunc



' ApplyContrast

' -------------

function ApplyContrast(img, r, g, b)

    set image img, false

    for y = 0 to height(img) - 1  for x = 0 to width(img) - 1

        c = pixel(x, y)

        set color 128 + (c[0] - 128)*r, 128 + (c[1] - 128)*g, 128 + (c[2] - 128)*b

        set pixel x, y

    next

    set image primary

endfunc



' ApplyTint

' ---------

function ApplyTint(img, r, g, b, shadows, midtones, highlights)

    r = r/255;  g = g/255;  b = b/255

    filter = []

    for i = 0 to 255

        filter[i] = max(128 - i, 0)*shadows/128 + max(i - 128, 0)*highlights/128 + 

                (128 - |128 - i|)*midtones/128

    next

    set image img, false

    for y = 0 to height(img) - 1  for x = 0 to width(img) - 1

        c = pixel(x, y)

        i = int(c[0] + c[1] + c[2])/3

        fi = filter[i];  ifi = 1 - fi

        set color fi*c[0]*r + ifi*c[0],

                fi*c[1]*g + ifi*c[1],

                fi*c[2]*b + ifi*c[2]

        set pixel x, y

    next

    set image primary

endfunc



' BoxBlur

' -------

' Box blur image.

function BoxBlur(img, rx, ry)

    rx = max(int(rx), 0); ry = max(int(ry), 0)

    set image img

    w = width(img); h = height(img)

    data = dim(w, h)



    ' Blur vertically

    for y = 0 to h - 1  for x = 0 to w - 1  data[x][y] = pixeli(img, x, y)

    count = ry*2 + 1

    for x = 0 to w - 1

        sr = 0; sg = 0; sb = 0; sa = 0

        for y = -ry to ry

            p = data[x][y%h];

            sr = sr + Red(p); sg = sg + Green(p); sb = sb + Blue(p); sa = sa + Alpha(p)

        next

        for y = 0 to h - 1

            set color sr/count, sg/count, sb/count, sa/count

            set pixel x, y

            p = data[x][(y - ry)%h]

            sr = sr - Red(p); sg = sg - Green(p); sb = sb - Blue(p); sa = sa - Alpha(p)

            p = data[x][(y + ry + 1)%h]

            sr = sr + Red(p); sg = sg + Green(p); sb = sb + Blue(p); sa = sa + Alpha(p)

        next

    next

    ' Blur horizontally.

    for y = 0 to h - 1  for x = 0 to w - 1  data[x][y] = pixeli(img, x, y)

    count = rx*2 + 1

    for y = 0 to h - 1

        sr = 0; sg = 0; sb = 0; sa = 0

        for x = -rx to rx

            p = data[x%w][y]

            sr = sr + Red(p); sg = sg + Green(p); sb = sb + Blue(p); sa = sa + Alpha(p)

        next

        for x = 0 to w - 1

            set color sr/count, sg/count, sb/count, sa/count

            set pixel x, y

            p = data[(x - rx)%w][y]

            sr = sr - Red(p); sg = sg - Green(p); sb = sb - Blue(p); sa = sa - Alpha(p)

            p = data[(x + rx + 1)%w][y]

            sr = sr + Red(p); sg = sg + Green(p); sb = sb + Blue(p); sa = sa + Alpha(p)

        next

    next

    set image primary

endfunc



' Blur

' ----

function Blur(img, r)

    if r <= 0  return

    for i = 1 to r  BoxBlur(img, 1, 1)

endfunc



' NoiseImage

' ----------

' Create noise image using something that is maybe perlin noise.

function NoiseImage(w, h, resX, resY, details)

    details = max(details, 1)

    octaves = []

    for i = 1 to details

        octaves[sizeof(octaves)] = CloudMap(resX, resY)

        resX = resX*2;  resY = resY*2

    next

    img = createimage(w, h)

    set image img

    for y = 0 to h - 1  for x = 0 to w - 1

        nx = x/w;  ny = y/h

        v = 0;  amp = 1

        for i = 0 to sizeof(octaves) - 1

            v = v + octaves[i].ValueAt(nx, ny)*amp

            amp = amp*0.5

        next

        v = 255*(0.5 + 0.5*v)

        set color v, v, v

        set pixel x, y

    next    

    set image primary

    return img

endfunc



' CloudMap

' --------

function CloudMap(resX, resY)

    map = []

  

    ' Create grid of random unit vectors.

    map.m = dim(resX, resY)

    for y = 0 to resY - 1  for x = 0 to resX - 1

        a = rnd()*PI*2

        map.m[x][y] = [x: cos(a), y: sin(a)]

    next

  

    ' ValueAt

    ' -------

    ' Return value, [-1..1] at coordinates (x, y), The size of the cloud is 1x1, but the coordinates

    ' are wrapped and the cloud is always seamless.

    map.ValueAt = function(x, y)

        m = this.m

        w = sizeof(m);  h = sizeof(m[0])

        x = (x*w)%w;  y = (y*h)%h

        x0 = floor(x);  y0 = floor(y)

        x1 = (x0 + 1)%w;  y1 = (y0 + 1)%h

        fx = x - x0;  fy = y - y0

        tl = -fx*m[x0][y0].x - fy*m[x0][y0].y

        tr = (1 - fx)*m[x1][y0].x - fy*m[x1][y0].y

        bl = -fx*m[x0][y1].x + (1 - fy)*m[x0][y1].y

        br = (1 - fx)*m[x1][y1].x + (1 - fy)*m[x1][y1].y

        return Bilinear(tl, tr, bl, br, Quad(0, 1, fx), Quad(0, 1, fy))

      

        ' Bilinear

        ' --------

        function Bilinear(tl, tr, bl, br, x, y)

            ix = 1 - x

            return (1 - y)*(ix*tl + x*tr) + y*(ix*bl + x*br)

        endfunc



        ' Quad

        ' ----

        function Quad(a, b, p)

            return a - 3*a*p^2 + 2*a*p^3 + 3*b*p^2 - 2*b*p^3

        endfunc

    endfunc

  

    return map

endfunc



' Pixeli helpers.

function Alpha(c);  return int(c/16777216);  endfunc

function Red(c);  return int((c/65536))%256;  endfunc

function Green(c);  return int((c/256))%256;  endfunc

function Blue(c);  return c%256;  endfunc

function ToRGB(r, g, b);  return 255*16777216 + r*65536 + g*256 + b;  endfunc

function ToRGBA(r, g, b, a);  return a*16777216 + r*65536 + g*256 + b;  endfunc



' RNG

' ---

' Return a random number generator. It can be useful if you need multiple independent series,

' especially if one or more of them needs to be fixed.

function RNG(seed)

    r = []

    

    ' SetSeet

    ' -------

    r.SetSeed = function(seed)

        this.s = max(int(seed), 1)

    endfunc

    

    ' Next

    ' ----

    ' Return next random number in the range [0..2147483646].

    r.Next = function()

        this.s = int((16807*this.s)%2147483647)

        return this.s

    endfunc

    

    ' Int

    ' ---

    ' Return a random int in the range [0..n - 1], negative if n is negative.

    r.Int = function(n)

        n = floor(n)

        if n > 0  return this.Next()%n

        elseif n < 0  return -this.Next()%(-n)

        else  return 0

    endfunc

    

    ' Float

    ' -----

    ' Return a random float in the range [0..1].

    r.Float = function()

        return this.Next()/2147483647

    endfunc

    

    ' Range

    ' -----

    ' Return a random int in the range [rmin..rmax], works like.

    r.Range = function(rmin, rmax)

        rmin = int(rmin);  rmax = int(rmax)

        if rmin > rmax

            tmp = rmin;  rmin = rmax;  rmax = tmp

        endif

        return floor((this.Next()/2147483647)*(rmax - rmin + 1) + rmin)

    endfunc

    

    r.SetSeed(seed)

    

    return r

endfunc