Sorry your browser is not supported!

`set bitmap format 21
`set display mode 640, 480, 32
autocam off
sync on
sync rate 60
sync

set ambient light 10

` setup some global vars for the matrix position and rotation

type MAT_DAT
    angr as float
    radr as float
    addr as float
    addy as float
    angy as float
    rady as float
    size as integer
endtype

global mat as MAT_DAT

mat.angr = 0
mat.radr = 50
mat.addr = 0.45
mat.addy = 1.23
mat.angy = 0
mat.rady = 127
mat.size = 127

` setup a blank matrix

make matrix 1, 1024, 1024, mat.size, mat.size
position matrix 1, -512, 0, -512

` setup the camera movement globals

type CAM_DAT
    angx as float
    angy as float
    addx as float
    addy as float
    radx as float
    rady as float
    y    as float
endtype

global cam as CAM_DAT

cam.angx = 0
cam.angy = 0
cam.addx = 0.09
cam.addy = 1.06
cam.radx = 180
cam.rady = 40
cam.y    = 300

make light 1 : position light 1, 0, 300, 0 : set light range 1, 200

init_matrix_texture()

do
    cam_movement()
    mat_movement()
    text 0,0,str$(screen fps())
    paste image 1,0,12
    sync
LOOP

end

function cam_movement()
    x# = cam.radx * cos( cam.angx )
    y# = cam.rady * cos( cam.angy ) + cam.y
    z# = cam.radx * sin( cam.angx )
    
    position camera x#, y#, z#
    
    cam.angx = wrapvalue( cam.angx + cam.addx )
    cam.angy = wrapvalue( cam.angy + cam.addy )
    
    point camera 0,0,0
    
    `position light 1, x#, y#, z#
ENDFUNCTION

function mat_movement()
    xpos# = mat.radr * cos( mat.angr )
    ypos# = mat.radr * sin( mat.angr )
    
    `hgt# = mat.rady * cos( mat.angy )
    hgt# = 128.0 + ( cos(mat.angy) * 126.0 )
    
    for x=0 to mat.size
        for y=0 to mat.size
            mh# = simplex scaled 2d( 5, 0.5, 0.05, 0, hgt#, xpos# + x, ypos# + y )
            if mh# < 0 then mh# = 0
            if mh# > 255 then mh# = 255
            set matrix height 1, x, y, mh#
            iMh = mh#
            iMh = iMh >> 3
            if x < mat.size
                if y < mat.size
                    set matrix tile 1, x, y, iMh + 1
                endif
            endif
        next
    NEXT
    
    WL MATRIX NORMALISE 1
    
    update matrix 1
    
    mat.angr = wrapvalue( mat.angr + mat.addr )
    mat.angy = wrapvalue( mat.angy + mat.addy )
ENDFUNCTION

function init_matrix_texture()
    size = 32
    range = 64
    half = range / 2
    lock pixels
    for cx = 0 to 31
        for cy = 0 to 1
//             select cx
//             case 0 : r = 64  : g = 192 : endcase
//             case 1 : r = 128 : g = 128 : endcase
//             case 2 : r = 192 : g = 64  : endcase
//             case 3 : r = 255 : g = 0   : endcase
//             endselect
//             select cy
//             case 0 : b = 64  : endcase
//             case 1 : b = 128 : endcase
//             case 2 : b = 192 : endcase
//             case 3 : b = 255 : endcase
//             endselect

            r = cx << 4
            g = 255 - ( cx << 4 )
            b = cy << 4
            
            for x = 0 to size-1
                for y = 0 to size-1
                    newr = r + rnd(range) - half
                    newg = g + rnd(range) - half
                    newb = b + rnd(range) - half
                    if newr < 0 then newr = 0
                    if newr > 255 then newr = 255
                    if newg < 0 then newg = 0
                    if newg > 255 then newg = 255
                    if newb < 0 then newb = 0
                    if newb > 255 then newb = 255
                    dot ( cx * size ) + x, ( cy * size ) + y, rgb( newr, newg, newb )
                next
            next
        next
    NEXT
    unlock pixels
    get image 1, 0, 0, size * 16, size * 2
    prepare matrix texture 1, 1, 32, 2
    set matrix trim 1, 0.01, 0.01
ENDFUNCTION

sync on : sync rate 60 : sync
w=640 : h=480 : set display mode w, h, 32

FN NOISE SEED 0
FN SETFPO 0.01, 0.75, 5

lock pixels

for x=0 to w-1
    for y=0 to h-1
        `col = int( ( FN PNOISE 2D(x, y) + 1.0 ) * 120 )
        `col = int( SIMPLEX SCALED 2D(5, 0.75, 0.005, 0.0, 255.0, x, y ) )
        col = int( ( FN PNOISE RIDGE(x, y, 0, 5, 0.05, 1.5, 0.75) + 1.0 ) * 120 )
        dot x,y,rgb(col,col,col)
    next
NEXT

unlock pixels

sync

wait key

~~~~~~~~~~~~~~~~~~~~~~~
SIMPLEX NOISE FUNCTIONS
~~~~~~~~~~~~~~~~~~~~~~~

value# = SIMPLEX NOISE 2D(octaves,persistence#,scale#,x#,y#)
value# = SIMPLEX NOISE 3D(octaves,persistence#,scale#,x#,y#,z#)
value# = SIMPLEX NOISE 4D(octaves,persistence#,scale#,x#,y#,z#,w#)

Return values between set bounds:

value# = SIMPLEX SCALED 2D(octaves,persistence#,scale#,lobound#,hibound#,x#,y#)
value# = SIMPLEX SCALED 3D(octaves,persistence#,scale#,lobound#,hibound#,x#,y#,z#)
value# = SIMPLEX SCALED 4D(octaves,persistence#,scale#,lobound#,hibound#,x#,y#,z#,w#)

~~~~~~~~~~~~~~~
BONUS FUNCTIONS
~~~~~~~~~~~~~~~

WL MATRIX NORMALISE matrixID
value# = WL FSQRT(num#)

~~~~~~~~~~~~~~~~~~~~~~
PERLIN NOISE FUNCTIONS
~~~~~~~~~~~~~~~~~~~~~~

Set up the permutation tables:

FN NOISE SEED seed

Standard noise functions for customising your own stuff:

value# = FN NOISE 1D(x#)
value# = FN NOISE 2D(x#,y#)
value# = FN NOISE 3D(x#,y#,z#)

Set up the Frequency, Persistence and octaves:

FN SETFPO frequency#,persistence#,octaves

Perlin noise functions:

value# = FN PNOISE 1D(x#)
value# = FN PNOISE 2D(x#,y#)
value# = FN PNOISE 3D(x#,y#,z#)

Ridged perlin noise effect (not tried yet):

value# = FN PNOISE RIDGE(x#,y#,z#,octaves,lacunarity#,gain#,offset#)

Rem ***** Included Source File *****
REMSTART

#### WLGfx's commands for PERLIN NOISE
    NOISE GET HEIGHT               ==(pn,x,y)
    NOISE GET HEIGHT TILED         ==(pn,x,y,width,height)
    NOISE SET PARAMS               ==pn,pers,freq,ampl,oct,seed
    NOISE GET PERSISTANCE          ==(pn)
    NOISE GET FREQUENCY            ==(pn)
    NOISE GET AMPLITUDE            ==(pn)
    NOISE GET OCTAVES              ==(pn)
    NOISE GET RANDOMSEED           ==(pn)
    NOISE SET PERSISTANCE          ==pn,pers
    NOISE SET FREQUENCY            ==pn,freq
    NOISE SET AMPLITUDE            ==pn,ampl
    NOISE SET OCTAVES              ==pn,oct
    NOISE SET RANDOMSEED           ==pn,seed
    NOISE GET HEIGHT BYTE          ==(pn,x,y)
    NOISE GET HEIGHT BYTE ABS      ==(pn,x,y)
    NOISE GET HEIGHT BYTE TOP      ==(pn,x,y)
    NOISE GET HEIGHT TILED BYTE    ==(pn,x,y,width,height)
    NOISE GET HEIGHT TILED BYTE ABS==(pn,x,y,width,height)
    NOISE GET HEIGHT TILED BYTE TOP==(pn,x,y,width,height)

#### WLGfx's commands for SIMPLEX NOISE
    float val = SIMPLEX NOISE 2D(octaves,persistence,scale,x,y)
    float val = SIMPLEX NOISE 3D(octaves,persistence,scale,x,y,z)
    float val = SIMPLEX NOISE 4D(octaves,persistence,scale,x,y,z,w)
    
    float val = SIMPLEX SCALED 2D(octaves,persistence,scale,lo,hi,x,y)
    float val = SIMPLEX SCALED 3D(octaves,persistence,scale,lo,hi,x,y,z)
    float val = SIMPLEX SCALED 4D(octaves,persistence,scale,lo,hi,x,y,z,w)

    float val = WL FSQRT(val)
    WL MATRIX NORMALISE matrixID
    REMEND

RANDOMIZE TIMER()
Set Display Mode 800 , 600 , 32
sync on : sync rate 120 : color backdrop 0
autocam off

rpn = 0 : rpers# = 0 : rfreq# = 0 : rampl# = 0 : roct# = 1.0 : rseed = 0 :  rscale# = 0

iSeg = 128      `Number of segment points to take height
iLength = 256   `The overall length of each axis of the matrix

`#### MAKE CAMERA
MAKE CAMERA 1
POSITION CAMERA 1,(iLength)/2,300,((iLength)/2)-200
XROTATE CAMERA 1,60
SET CAMERA RANGE 1,1,10000
`#### MAKE CAMERA 

MAKE MATRIX 1,(iLength),(iLength),iSeg,iSeg
POSITION MATRIX 1,0,0,0

inoise = 0

DO
    IF inoise = 0 : snoise$ = "Perlin " : ELSE : snoise$ = "Simplex " : ENDIF    
    SET CURSOR 0,0
    ink RGB(255,0,0), RGB(0,0,0)
    print "FPS:";screen fps()
    print "You are currently viewing " + snoise$ + "noise. Press F1 to change."

    SELECT inoise
        CASE 0:
            print "PN: " + str$(rpn)
            print "PERS: " + str$(rpers#)
            print "FREQ: " + str$(rfreq#)
            print "AMPL: " + str$(rampl#)
            print "OCT: " + str$(roct#)
            print "SEED: " + str$(rseed)
        
            IF KEYSTATE(59) = 1 : WAIT 500 : inoise = WRAP(inoise+1,0,1) : ENDIF
            
            `Q key increases / A key decreases PN value by 1
            IF KEYSTATE(16) = 1 THEN WAIT 500 : rpn = WRAP(rpn+1,0,7) : keydown = 1
            IF KEYSTATE(30) = 1 THEN WAIT 500 : rpn = WRAP(rpn-1,0,7) : keydown = 1
        
            `W key increases / S key decreases PERS value
            IF KEYSTATE(17) = 1 THEN rpers# = rpers# + 0.01 : keydown = 1
            IF KEYSTATE(31) = 1 THEN rpers# = rpers# - 0.01 : keydown = 1
            
            `E key increases / D key decreases FREQ value
            IF KEYSTATE(18) = 1 THEN rfreq# = rfreq# + 0.01 : keydown = 1
            IF KEYSTATE(32) = 1 THEN rfreq# = rfreq# - 0.01 : keydown = 1
            
            `R key increases / F key decreases AMPL value
            IF KEYSTATE(19) = 1 THEN rampl# = rampl# + 0.01 : keydown = 1
            IF KEYSTATE(33) = 1 THEN rampl# = rampl# - 0.01 : keydown = 1
            
            `T key increases / G key decreases OCT value
            IF KEYSTATE(20) = 1 THEN WAIT 500 : roct# = roct# + 1.0 : keydown = 1
            IF KEYSTATE(34) = 1 THEN WAIT 500 : roct# = roct# - 1.0 : keydown = 1
        
            `Y key increases / H key decreases SEED value
            IF KEYSTATE(21) = 1 THEN WAIT 500 : rseed = rseed + 1 : keydown = 1
            IF KEYSTATE(35) = 1 THEN WAIT 500 : rseed = rseed - 1 : keydown = 1
            
            IF keydown = 1 
                NOISE SET PARAMS rpn, rpers#, rfreq#, rampl#, roct#, rseed
                print "keydown"
                FOR x = 0 TO iSeg
                    FOR z = 0 TO iSeg
                        hgt# = abs(NOISE GET HEIGHT TILED(rpn,x,z,iSeg,iSeg)) * 255
                        set matrix height 1,x,z,hgt#
                    NEXT z
                 NEXT x
                UPDATE MATRIX 1
                keydown = 0
            ENDIF
        
        ENDCASE `ENDCASE for Perlin section
        
        `Simplex noise
        CASE 1:
            SET MATRIX WIREFRAME OFF 1 
            UPDATE MATRIX 1
            print "SCALE: " + str$(rscale#) + " -- Keep this small... maybe .004?"
            print "PERS: " + str$(rpers#) + " -- Manipulate this a bit to get your details "
            print "OCT: " + str$(roct#) + " -- Around 5 octaves works really well!"
            `E key increases / D key decreases FREQ value
            IF KEYSTATE(18) = 1 THEN WAIT 100 : rscale# = rscale# + 0.0001 : keydown = 1
            IF KEYSTATE(32) = 1 THEN WAIT 100 : rscale# = rscale# - 0.0001 : keydown = 1
        
            `W key increases / S key decreases PERS value
            IF KEYSTATE(17) = 1 THEN rpers# = rpers# + 0.001 : keydown = 1
            IF KEYSTATE(31) = 1 THEN rpers# = rpers# - 0.001 : keydown = 1
            
            `T key increases / G key decreases OCT value
            IF KEYSTATE(20) = 1 THEN WAIT 500 : roct# = roct# + 1.0 : keydown = 1
            IF KEYSTATE(34) = 1 THEN WAIT 500 : roct# = roct# - 1.0 : keydown = 1
        
            IF keydown = 1 
                print "keydown"
                FOR x = 0 TO iSeg
                    FOR z = 0 TO iSeg
                        hgt# = simplex scaled 2d(roct#, rpers#, rscale#, 0, 255, x, z )
                        if hgt# < 0 then hgt# = 0
                        if hgt# > 255 then hgt# = 255
                        set matrix height 1,x,z,hgt#
                    NEXT z
                 NEXT x
                WL MATRIX NORMALISE 1
                UPDATE MATRIX 1
                keydown = 0
            ENDIF
        ENDCASE `ENDCASE for Simplex section
    ENDSELECT   `SELECT inoise
    
    SYNC
LOOP

// ----------------------------------------------------------------------
//
// DBP Matrix Extras
//
// ----------------------------------------------------------------------

struct WL_VNORM {
	float	x, y, z;
	float	nx, ny, nz;
};

// Forward declare this function
void add_norms( WL_VNORM *v1, WL_VNORM *v2, WL_VNORM *v3 );

EXPORTC void WL_Calc_Matrix_Normals(int matrixID)
{
	if ( DBPro::MatrixExist( matrixID ) )
	{
		int		iMatXSeg = DBPro::GetMatrixXSegments( matrixID );
		int		iMatZSeg = DBPro::GetMatrixZSegments( matrixID );
		int		iZStride = iMatXSeg + 1;

		// number of faces in the matrix
		int		iFaces = ( ( iMatXSeg - 1 ) * ( iMatZSeg - 1 ) ) * 2;

		// temp buffer to store the vertex normals and coords
		WL_VNORM        *vnorms = new WL_VNORM[ (iMatXSeg+1) * (iMatZSeg+1) ];

		// set all normals to 0 and grab the coords of the matrix position
		WL_VNORM        *temp;
		int		loopx, loopz;
		float	        fWid = DBPro::GetMatrixWidth( matrixID ) / (float)iMatXSeg;
		float	        fDep = DBPro::GetMatrixDepth( matrixID ) / (float)iMatZSeg;

		for ( loopx = 0; loopx <= iMatXSeg; loopx++ )
		{
			for ( loopz = 0; loopz <= iMatZSeg; loopz++ )
			{
				temp = vnorms + ( loopz * iZStride + loopx );
				temp->nx = 0.0f;
				temp->ny = 0.0f;
				temp->nz = 0.0f;
				temp->x = fWid * (float)loopx;
				temp->y = DBPro::GetMatrixHeight( matrixID, loopx, loopz );
				temp->z = fDep * (float)loopz;
			}
		}

		// Calc each face normal
		for ( loopx = 0; loopx < iMatXSeg; loopx++ )
		{
			for ( loopz = 0; loopz < iMatZSeg; loopz++ )
			{
				add_norms( &vnorms[ loopz * iZStride + loopx ],
					   &vnorms[ loopz * iZStride + (loopx+1) ],
					   &vnorms[ (loopz+1) * iZStride + (loopx+1) ] );

				add_norms( &vnorms[ loopz * iZStride + loopx ],
					   &vnorms[ (loopz+1) * iZStride + (loopx+1) ],
					   &vnorms[ (loopz+1) * iZStride + loopx ] );

				// now see if I need to smooth the normal
				temp = &vnorms[ loopz * iZStride + loopx ];

				if ( loopx && loopz )
				{
					// inner verts are shared by 6 faces
					temp->nx /= 6.0f;
					temp->ny /= 6.0f;
					temp->nz /= 6.0f;
				}
				else
				{
					// edge verts are shared by 2 faces
					temp->nx /= 2.0f;
					temp->ny /= 2.0f;
					temp->nz /= 2.0f;
				}
				DBPro::SetMatrixNormal( matrixID, loopx, loopz, temp->nx, temp->ny, temp->nz );
			}
		}

		// Last thing to do is to finish off smoothing last two edges
		for ( loopx = 1; loopx <= iMatXSeg; loopx++ )
		{
			temp = &vnorms[ iMatZSeg * iZStride + loopx ];	// add 1 to iMatZSeg?
			temp->nx /= 2.0f;
			temp->ny /= 2.0f;
			temp->nz /= 2.0f;

			DBPro::SetMatrixNormal( matrixID, loopx, iMatZSeg, temp->nx, temp->ny, temp->nz );
		}
		for ( loopz = 1; loopz <= iMatZSeg; loopz++ )
		{
			temp = &vnorms[ loopz * iZStride + iMatXSeg ];	// add 1 to iMatXSeg?
			temp->nx /= 2.0f;
			temp->ny /= 2.0f;
			temp->nz /= 2.0f;

			DBPro::SetMatrixNormal( matrixID, iMatXSeg, loopz, temp->nx, temp->ny, temp->nz );
		}

		// remove the temp buffer
		delete[] vnorms;
	}
}

// fast square root function
inline float fastSqrt_Bab(const float x)  
{
	union
	{
		int i;
		float x;
	} u;
	u.x = x;
	u.i = (1<<29) + (u.i >> 1) - (1<<22); 

	// One Babylonian Step
	u.x = 0.5f * (u.x + x/u.x);

	return u.x;
}

void add_norms( WL_VNORM *v1, WL_VNORM *v3, WL_VNORM *v2 )
{
	float x1 = v1->x, y1 = v1->y, z1 = v1->z;
	float x2 = v2->x, y2 = v2->y, z2 = v2->z;
	float x3 = v3->x, y3 = v3->y, z3 = v3->z;

	float normx = (z1-z2)*(y3-y2)-(y1-y2)*(z3-z2);
	float normy = (x1-x2)*(z3-z2)-(z1-z2)*(x3-x2);
	float normz = (y1-y2)*(x3-x2)-(x1-x2)*(y3-y2);

	float normlength = fastSqrt_Bab((normx*normx)+(normy*normy)+(normz*normz));

	normx /= normlength;
	normy /= normlength;
	normz /= normlength;

	v1->nx += normx; v1->ny += normy; v1->nz += normz;
	v2->nx += normx; v2->ny += normy; v2->nz += normz;
	v3->nx += normx; v3->ny += normy; v3->nz += normz;
}

sync off : sync rate 0
set text opaque

NOISE SET PARAMS 0, 0.5, 0.1, 1.5, 8, 0

// testing the IK version
// baseWorldMap = Find Free Image() 
//  Ik Create Image baseWorldMap,0,0
//  Ik Resize Image baseWorldMap, 512,512, 1

do
    cls
    Noise Set Randomseed 0,seed
    for x=0 to 511
        for y=0 to 511
            v#=Noise Get Height tiled(0,x,y,512,512)
            if v#<0 then v#=0
            v#=v#*255
            c=v#
            if c<0 then c=0
            if c>255 then c=255
            //ik dot baseWorldMap,x,y,rgb(c,c,c)
            dot x,y,rgb(c,c,c)
           next y
        next x
    sync
        
    //paste image baseWorldMap,512,0
    //text 512,0,"IK version"  
    set cursor 0,550 : input "Enter seed: ", seed
        
loop