GameMaker - Perlin Noise

GameMaker solution for Perlin Noise
Author: Nathan Hunter, badwronggames@gmail.com

//////////////////////////////////////////////

MIT License

Copyright (c) 2023 Nathan Hunter

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

//////////////////////////////////////////////

SETUP: Create the shader below as instructed, and copy the rest of the code after into a GML script file
USE: Call the perlin_noise(_offset, _rate) or perlin_noise_2d(_x, _y) functions


// Create a GLSL ES shader in GameMaker and name it: shd_perlin_noise_glsl_es
// Copy and paste the following vertex and fragement code into the shader

// *********  Vertex Shader ********* //
precision highp float;

#if __VERSION__ >= 130
    #define attribute in
    #define varying out
#endif

attribute vec3 in_Position;
attribute vec4 in_Colour;
attribute vec2 in_TextureCoord;

varying vec2 tex_coord;

void main()
{
    gl_Position = gm_Matrices[MATRIX_WORLD_VIEW_PROJECTION] * vec4(in_Position.xyz, 1.0);
    tex_coord = in_TextureCoord;
}
// ********* END Vertex Shader ********* //

// ********* Fragment Shader ********* //
// Reference - https://adrianb.io/2014/08/09/perlinnoise.html
precision highp float;

#if __VERSION__ >= 130
    out vec4 frag_color;
    #define varying in
    #define texture2D texture
#else
    #define frag_color gl_FragColor
#endif

#define M_PI   3.1415926535897932384626433832795

float fade(float t)
{
    return t * t * t * (t * (t * 6.0 - 15.0) + 10.0);
}

float grad(int hash, float x, float y, float z)
{
    float h = mod(float(hash), 16.0);
    float u = h < 8.0 ? x : y;

    float v;

    if(h < 4.0)
        v = y;
    else if(h == 12.0 || h == 14.0)
        v = x;
    else
        v = z;

    return (mod(h, 2.0) == 0.0 ? u : -u) + (mod(h, 3.0) < 2.0 ? v : -v);
}

float perlin(vec3 pos, int[256] table)
{
    int xi = int(mod(pos.x, 256.0));
    int yi = int(mod(pos.y, 256.0));
    int zi = int(mod(pos.z, 256.0));

    int xj = int(mod(pos.x + 1.0, 256.0));
    int yj = int(mod(pos.y + 1.0, 256.0));
    int zj = int(mod(pos.z + 1.0, 256.0));

    int aaa = table[table[table[xi] + yi]+ zi];
    int aba = table[table[table[xi] + yj]+ zi];
    int aab = table[table[table[xi] + yi]+ zj];
    int abb = table[table[table[xi] + yj]+ zj];
    int baa = table[table[table[xj] + yi]+ zi];
    int bba = table[table[table[xj] + yj]+ zi];
    int bab = table[table[table[xj] + yi]+ zj];
    int bbb = table[table[table[xj] + yj]+ zj];

    float xf = fract(pos.x);
    float yf = fract(pos.y);
    float zf = fract(pos.z);

    float u = fade(xf);
    float v = fade(yf);
    float w = fade(zf);

    float x1 = mix(grad(aaa, xf, yf,       zf), grad(baa, xf - 1.0, yf,       zf), u);
    float y1 = mix(grad(aba, xf, yf - 1.0, zf), grad(bba, xf - 1.0, yf - 1.0, zf), u);
    float z1 = mix(x1, y1, v);

    float x2 = mix(grad(aab, xf, yf,       zf - 1.0), grad(bab, xf - 1.0, yf,       zf - 1.0), u);
    float y2 = mix(grad(abb, xf, yf - 1.0, zf - 1.0), grad(bbb, xf - 1.0, yf - 1.0, zf - 1.0), u);
    float z2 = mix (x2, y2, v);

    return (mix(z1, z2, w) + 1.0) * 0.5;
}

varying vec2 tex_coord;

uniform float u_seed;
uniform int u_table[256]; // permutation table of values 0 - 255

void main()
{
    float value = perlin(vec3(sin(abs(tex_coord - 0.5) * M_PI * 0.5) * u_seed, fract(u_seed) * 1.387), u_table);
    frag_color = vec4(vec3(value), 1.0);
}
// ********* END Fragment Shader ********* //

// ************** COPY AND PASTE ALL CODE BELOW HERE INTO A GML SCRIPT FILE ***************** //

/// feather ignore all

#macro C_PERLIN_NOISE_SIZE 1024
#macro C_PERLIN_NOISE_SIZE_MASK 1023
#macro C_PERLIN_NOISE_BUFFER_SIZE 1048576
#macro C_PERLIN_NOISE_BUFFER_MASK 1048575

/// @function                   perlin_noise(_offset, _rate)
/// @param {integer} _offset    A fixed positive offset into the buffer (use a constant)
/// @param {real} _rate         Rate of sample over time (used with current_time)
/// @description                Returns perlin noise value from -1 to 1 using premade buffer using offset and rate
function perlin_noise(_offset, _rate)
{
    // This is a solid way to sample from perlin noise.  It uses time and an offset value which
    // makes each next sample close the previous based on how small the _rate argument is.
    // The _offset argument should be a constant which does not change, and it's purpose is
    // so that different objects, animations, or whatever sample from different places (but still over time)

    static _perlin_noise_buffer = get_perlin_noise_buffer();
    var _value = buffer_peek(_perlin_noise_buffer, (floor(_offset + current_time * _rate) & C_PERLIN_NOISE_BUFFER_MASK) << 2, buffer_f32);
    return (_value - 0.5) * 2.0;
}

/// @function                   perlin_noise_irange(_value1, _value2, _offset, _rate)
/// @param {integer} _value1    The first value
/// @param {integer} _value2    The second value
/// @param {integer} _offset    A fixed positive offset into the buffer (use a constant)
/// @param {real} _rate         Rate of sample over time (used with current_time)
/// @description                Returns an integer value between the two values using perlin noise
function perlin_noise_irange(_value1, _value2, _offset, _rate)
{
    static _perlin_noise_buffer = get_perlin_noise_buffer();
    var _pos = buffer_peek(_perlin_noise_buffer, (floor(_offset + current_time * _rate) & C_PERLIN_NOISE_BUFFER_MASK) << 2, buffer_f32);
    return round(lerp(_value1, _value2, _pos));
}

/// @function                   perlin_noise_range(_value1, _value2, _offset, _rate)
/// @param {real} _value1       The first value
/// @param {real} _value2       The second value
/// @param {integer} _offset    A fixed positive offset into the buffer (use a constant)
/// @param {real} _rate         Rate of sample over time (used with current_time)
/// @description                Returns a real value between the two values using perlin noise
function perlin_noise_range(_value1, _value2, _offset, _rate)
{
    static _perlin_noise_buffer = get_perlin_noise_buffer();
    var _pos = buffer_peek(_perlin_noise_buffer, (floor(_offset + current_time * _rate) & C_PERLIN_NOISE_BUFFER_MASK) << 2, buffer_f32);
    return lerp(_value1, _value2, _pos);
}

/// @function           perlin_noise_2d(_x, _y)
/// @param {real} _x    The x coordinate to sample from (should be positive value)
/// @param {real} _y    The y coordinate to sample from (should be positive value)
/// @description        Samples perlin noise value from -1 to 1 using premade buffer using 2D coordinates
function perlin_noise_2d(_x, _y)
{
    // This function is when you want to really specify where to sample from the buffer,
    // and is rarely used over the normal perlin_noise() function

    static _perlin_noise_buffer = get_perlin_noise_buffer();
    _x = floor(_x) & C_PERLIN_NOISE_SIZE_MASK;
    _y = floor(_y) & C_PERLIN_NOISE_SIZE_MASK;
    var _value = buffer_peek(_perlin_noise_buffer, (_x + _y * C_PERLIN_NOISE_SIZE) << 2, buffer_f32);
    return (_value - 0.5) * 2.0;
}

function draw_perlin_noise_buffer(_x, _y)
{
    // *** DEBUG ONLY ***
    // Extremely slow function used to visualize the perlin noise buffer
    // Draw it to a surface once or frame rate will die

    var _buff = get_perlin_noise_buffer(),
        _dx = _x,
        _dy = _y,
        _val = 0,
        _col = 0;

    for (var _c = 0; _c < C_PERLIN_NOISE_SIZE; _c++)
    {
        _dy = _y;

        for (var _r = 0; _r < C_PERLIN_NOISE_SIZE; _r++)
        {
            _val = buffer_peek(_buff, (_c + _r * C_PERLIN_NOISE_SIZE) << 2, buffer_f32) * 255;
            _col = make_color_rgb(_val, _val, _val);
            draw_rectangle_color(_dx, _dy, _dx + 1, _dy + 1, _col, _col, _col, _col, false);

            _dy++;
        }
        _dx++;
    }
}

function shader_set_perlin_noise(_seed_value = 0)
{
    // Draws anything with a perlin noise texture
    // Will repeat if the UVs are the full 0 - 1 on the quad
    // Mainly just used for the private functions which create the buffer

    static _u_seed  = shader_get_uniform(shd_perlin_noise_glsl_es, "u_seed");
    static _u_table = shader_get_uniform(shd_perlin_noise_glsl_es, "u_table");
    static _table   = create_perlin_hash_table();
    static _seed    = random_range(25.11111, 29.99999);

    if (_seed_value != 0)
        _seed = _seed_value + random_range(0.11111, 0.99999);

    shader_set(shd_perlin_noise_glsl_es);
    shader_set_uniform_f(_u_seed, _seed);
    shader_set_uniform_i_array(_u_table, _table);
}

#region Private Functions

    function get_perlin_noise_buffer()
    {
        static _perlin_noise_buffer = create_perlin_noise_buffer();
        return _perlin_noise_buffer;
    }

    function create_perlin_noise_buffer()
    {
        var _surf  = surface_create(C_PERLIN_NOISE_SIZE, C_PERLIN_NOISE_SIZE),
            _size  = C_PERLIN_NOISE_BUFFER_SIZE,
            _buff  = buffer_create(_size << 2, buffer_fast, 1),  // Uses unsigned8 to store RGBA
            _buff2 = buffer_create(_size << 2, buffer_fixed, 4), // Uses float32 to store single value
            _peek  = 0;

        // Draw perlin noise to a surface
        shader_set_perlin_noise();
        surface_set_target(_surf)

            draw_clear_alpha(c_black, 0);
            draw_primitive_begin_texture(pr_trianglestrip, -1);
            draw_vertex_texture(0, 0, 0, 0);
            draw_vertex_texture(C_PERLIN_NOISE_SIZE, 0, 1, 0);
            draw_vertex_texture(0, C_PERLIN_NOISE_SIZE, 0, 1);
            draw_vertex_texture(C_PERLIN_NOISE_SIZE, C_PERLIN_NOISE_SIZE, 1, 1);
            draw_primitive_end();

        shader_reset();
        surface_reset_target();

        // Convert surface to normal buffer
        buffer_get_surface(_buff, _surf, 0);
        surface_free(_surf);

        // Remove 3 channels from RGBA since we only need 1
        buffer_seek(_buff2, buffer_seek_start, 0);
        for (var _b = 0; _b < _size; _b++)
        {
            buffer_write(_buff2, buffer_f32, buffer_peek(_buff, _peek, buffer_u8)/255.0);
            _peek += 4;
        }

        buffer_delete(_buff);

        return _buff2;
    }

    function create_perlin_hash_table()
    {
        // Creates a permutation hash table used for perlin noise shader

        var _size    = 256,
            _values  = ds_list_create(),
            _table   = array_create(256),
            _index   = 0,
            _num     = 0,

        // Populate values
        while (_index < 256)
        {
            _values[| _index] = _index++;
        }

        // Creates random permutation of values from 0 - 255
        _index = 0;
        while (_index < 256)
        {
            _num = irandom(--_size);
            _table[_index++] = _values[| _num];
            ds_list_delete(_values, _num);
        }

        ds_list_destroy(_values);

        return _table;
    }

#endregion