02-10-2026, 01:25 AM
Inspired by a Youtube video i watched on the krieger engine (made in 2004 and compacted a full on FPS game into <96kb!) I got to work and figured that Perlin noise would be how I went about doing the procedural texture generation basics in a similar fashion.
Proc_Image.bi
And now two demos, the first creates 5 basic textures, the second use them to create a (crappy visulisation) of them as a island in a slime swamp with a steel monolith...
I love this field of coding so will continue to add more functions and effects but i hope you guys find it midly pleasing too.
Unseen
![[Image: Prec-Text-Gen01.png]](https://i.ibb.co/C5S6gm23/Prec-Text-Gen01.png)
![[Image: Near-perfection.png]](https://i.ibb.co/JFxzwB4k/Near-perfection.png)
Proc_Image.bi
Code: (Select All)
' MaterialEngine.bi - Header for Procedural Material Library
TYPE TexConfig
Scale AS SINGLE
Octaves AS INTEGER
Swirl AS SINGLE
Color1 AS LONG
Color2 AS LONG
Color3 AS LONG
BumpDepth AS SINGLE
SpecPower AS SINGLE
UseWorley AS INTEGER
END TYPE
' Shared arrays for the Noise Core
DIM SHARED g_p(511) AS INTEGER
DIM SHARED gx(7) AS SINGLE
DIM SHARED gy(7) AS SINGLE
DIM SHARED HeightMap!(256, 256)
DIM SHARED C AS TexConfig
Code: (Select All)
' MaterialEngine.bm - Implementation for Procedural Material Library
SUB InitMaterialEngine
DIM i%
' Set up the Gradient Vectors
gx(0) = 1
gy(0) = 1
gx(1) = -1
gy(1) = 1
gx(2) = 1
gy(2) = -1
gx(3) = -1
gy(3) = -1
gx(4) = 1
gy(4) = 0
gx(5) = -1
gy(5) = 0
gx(6) = 0
gy(6) = 1
gx(7) = 0
gy(7) = -1
' Initialize the Permutation Table
FOR i% = 0 TO 255
g_p(i%) = i%
NEXT
FOR i% = 0 TO 255
SWAP g_p(i%), g_p(INT(RND * 256))
NEXT
FOR i% = 0 TO 255
g_p(i% + 256) = g_p(i%)
NEXT
END SUB
SUB SetMaterial (c1&, c2&, c3&)
C.Color1 = c1&
C.Color2 = c2&
C.Color3 = c3&
END SUB
SUB SetNoise (s!, o%, sw!, b!, spec!, worley%)
C.Scale = s!
C.Octaves = o%
C.Swirl = sw!
C.BumpDepth = b!
C.SpecPower = spec!
C.UseWorley = worley%
END SUB
FUNCTION CreateAdvancedMaterial& (W%, H%)
DIM newTex&, x%, y%, n!, clr&, shade!, spec!, nx!, ny!, nz!, lx!, ly!, lz!, dot!
DIM sx!, sy!, mag!
newTex& = _NEWIMAGE(W%, H%, 32)
lx! = 0.57
ly! = -0.57
lz! = 0.57
' Height Generation
FOR y% = 0 TO H%
FOR x% = 0 TO W%
sx! = Perlin!(x% * .02, y% * .02) * C.Swirl
sy! = Perlin!(y% * .02, x% * .02) * C.Swirl
IF C.UseWorley THEN
HeightMap!(x% AND 255, y% AND 255) = GetWorley!((x% + sx!) * C.Scale, (y% + sy!) * C.Scale)
ELSE
HeightMap!(x% AND 255, y% AND 255) = GetFBM!(x% + sx!, y% + sy!, C.Scale, C.Octaves)
END IF
NEXT
NEXT
' Rendering
_DEST newTex&
FOR y% = 0 TO H% - 1
FOR x% = 0 TO W% - 1
n! = HeightMap!(x%, y%)
nx! = (HeightMap!((x% - 1) AND 255, y%) - HeightMap!((x% + 1) AND 255, y%)) * C.BumpDepth
ny! = (HeightMap!(x%, (y% - 1) AND 255) - HeightMap!(x%, (y% + 1) AND 255)) * C.BumpDepth
nz! = 1.0
mag! = SQR(nx! * nx! + ny! * ny! + nz! * nz!)
nx! = nx! / mag!
ny! = ny! / mag!
nz! = nz! / mag!
dot! = (nx! * lx! + ny! * ly! + nz! * lz!)
IF dot! < 0 THEN dot! = 0
spec! = dot! ^ C.SpecPower
shade! = 0.4 + (dot! * 1.2) + spec!
IF n! < 0.4 THEN
clr& = Interpolate&(C.Color1, C.Color2, n! * 2.5)
ELSE
clr& = Interpolate&(C.Color2, C.Color3, (n! - 0.4) * 1.666667)
END IF
PSET (x%, y%), MultiplyColor&(clr&, shade!)
NEXT
NEXT
_DEST 0
CreateAdvancedMaterial& = newTex&
END FUNCTION
' Internal Math Functions (Private to the BM)
FUNCTION GetWorley! (x!, y!)
DIM xi%, yi%, minD!, dx!, dy!, d!, i%, j%
xi% = INT(x!)
yi% = INT(y!)
minD! = 1.0
FOR j% = -1 TO 1
FOR i% = -1 TO 1
dx! = (xi% + i%) - x! + (g_p((xi% + i%) AND 255) / 256)
dy! = (yi% + j%) - y! + (g_p((yi% + j% + 10) AND 255) / 256)
d! = SQR(dx! * dx! + dy! * dy!)
IF d! < minD! THEN minD! = d!
NEXT
NEXT
GetWorley! = minD!
END FUNCTION
FUNCTION GetFBM! (x!, y!, s!, o%)
DIM gval!, amp!, f!, i%
gval! = 0
amp! = 1
f! = s!
FOR i% = 1 TO o%
gval! = gval! + Perlin!(x! * f!, y! * f!) * amp!
f! = f! * 2
amp! = amp! * 0.5
NEXT
GetFBM = (gval! + 1) * 0.5
END FUNCTION
FUNCTION Perlin! (x!, y!)
DIM xi%, yi%, xf!, yf!, u!, v!
xi% = INT(x!) AND 255
yi% = INT(y!) AND 255
xf! = x! - INT(x!)
yf! = y! - INT(y!)
u! = xf! * xf! * xf! * (xf! * (xf! * 6 - 15) + 10)
v! = yf! * yf! * yf! * (yf! * (yf! * 6 - 15) + 10)
DIM a%, b%, aa%, ab%, ba%, bb%
a% = g_p(xi%) + yi%
aa% = g_p(a%)
ab% = g_p(a% + 1)
b% = g_p(xi% + 1) + yi%
ba% = g_p(b%)
bb% = g_p(b% + 1)
DIM n1!, n2!, n3!, n4!, l1!, l2!
n1! = GradFast!(g_p(aa%), xf!, yf!)
n2! = GradFast!(g_p(ba%), xf! - 1, yf!)
n3! = GradFast!(g_p(ab%), xf!, yf! - 1)
n4! = GradFast!(g_p(bb%), xf! - 1, yf! - 1)
l1! = n1! + u! * (n2! - n1!)
l2! = n3! + u! * (n4! - n3!)
Perlin! = l1! + v! * (l2! - l1!)
END FUNCTION
FUNCTION GradFast! (h%, x!, y!)
DIM i%
i% = h% AND 7
GradFast! = x! * gx(i%) + y! * gy(i%)
END FUNCTION
FUNCTION Interpolate& (c1&, c2&, t!)
DIM r%, g%, b%
r% = _RED32(c1&) + (_RED32(c2&) - _RED32(c1&)) * t!
g% = _GREEN32(c1&) + (_GREEN32(c2&) - _GREEN32(c1&)) * t!
b% = _BLUE32(c1&) + (_BLUE32(c2&) - _BLUE32(c1&)) * t!
Interpolate& = _RGB32(r%, g%, b%)
END FUNCTION
FUNCTION MultiplyColor& (c&, f!)
DIM r&, g&, b&
r& = _RED32(c&) * f!
g& = _GREEN32(c&) * f!
b& = _BLUE32(c&) * f!
IF r& > 255 THEN
r& = 255
ELSEIF r& < 0 THEN
r& = 0
END IF
IF g& > 255 THEN
g& = 255
ELSEIF g& < 0 THEN
g& = 0
END IF
IF b& > 255 THEN
b& = 255
ELSEIF b& < 0 THEN
b& = 0
END IF
MultiplyColor& = _RGB32(r&, g&, b&)
END FUNCTION
And now two demos, the first creates 5 basic textures, the second use them to create a (crappy visulisation) of them as a island in a slime swamp with a steel monolith...
Code: (Select All)
' kkrieger-Style Procedural Material Engine - Library Demo
' Uses Proc_Image.bi and Proc_Image.bm for the heavy lifting
'$INCLUDE: 'Proc_Image.bi'
InitMaterialEngine
SCREEN _NEWIMAGE(900, 600, 32)
_TITLE "kkrieger-Style Procedural Material Engine (Library Mode)"
' 1. BRUSHED STEEL
SetNoise .008, 8, 12, 15, 64, 0
SetMaterial _RGB32(20, 20, 30), _RGB32(70, 80, 110), _RGB32(210, 220, 255)
_PUTIMAGE (10, 10), CreateAdvancedMaterial&(255, 255)
' 2. CRAGGY STONE
SetNoise .03, 6, 0, 25, 4, 0
SetMaterial _RGB32(10, 10, 10), _RGB32(60, 60, 60), _RGB32(110, 110, 110)
_PUTIMAGE (310, 10), CreateAdvancedMaterial&(255, 255)
' 3. TOXIC SLIME
SetNoise .015, 3, 140, 8, 32, 0
SetMaterial _RGB32(0, 40, 0), _RGB32(50, 255, 50), _RGB32(200, 255, 200)
_PUTIMAGE (610, 10), CreateAdvancedMaterial&(255, 255)
' 4. POLISHED MAHOGANY
SetNoise .002, 4, 180, 5, 24, 0
SetMaterial _RGB32(30, 10, 5), _RGB32(90, 40, 15), _RGB32(140, 80, 30)
_PUTIMAGE (10, 310), CreateAdvancedMaterial&(255, 255)
' 5. FROSTED GLASS
SetNoise .06, 2, 5, 5, 16, 0
SetMaterial _RGB32(180, 200, 210), _RGB32(230, 240, 250), _RGB32(255, 255, 255)
_PUTIMAGE (310, 310), CreateAdvancedMaterial&(255, 255)
SLEEP
END
'$INCLUDE: 'Proc_Image.bm'Code: (Select All)
' kkrieger-Style 3D Terrain Engine: Island of the Monolith
' Uses Proc_Image Library for all surface textures
'$INCLUDE: 'Proc_Image.bi'
' --- Setup 3D Scene ---
InitMaterialEngine
SCREEN _NEWIMAGE(1024, 768, 32)
_TITLE "The Island of the Monolith: Procedural 3D"
' --- Build the Texture Bank ---
' 1. Toxic Slime (The Sea)
SetNoise .015, 3, 140, 8, 32, 0
SetMaterial _RGB32(0, 40, 0), _RGB32(0, 255, 0), _RGB32(180, 255, 180)
DIM SHARED TexSlime&
TexSlime& = CreateAdvancedMaterial&(128, 128)
' 2. Sandy Shore (Lightened Wood Mod)
SetNoise .01, 2, 20, 2, 8, 0
SetMaterial _RGB32(160, 140, 80), _RGB32(230, 210, 140), _RGB32(255, 240, 200)
DIM SHARED TexSand&
TexSand& = CreateAdvancedMaterial&(128, 128)
' 3. Craggy Rock
SetNoise .03, 5, 0, 15, 4, 0
SetMaterial _RGB32(20, 20, 20), _RGB32(80, 80, 80), _RGB32(120, 120, 120)
DIM SHARED TexRock&
TexRock& = CreateAdvancedMaterial&(128, 128)
' 4. Monolith Steel
SetNoise .008, 8, 12, 10, 128, 0
SetMaterial _RGB32(20, 20, 30), _RGB32(100, 110, 130), _RGB32(220, 230, 255)
DIM SHARED TexSteel&
TexSteel& = CreateAdvancedMaterial&(128, 128)
' --- Generate 3D Heightmap Data ---
DIM SHARED HGrid!(40, 40)
FOR z% = 0 TO 40
FOR x% = 0 TO 40
' Use FBM for height, masked by a circle to make it an island
dist! = SQR((x% - 20) ^ 2 + (z% - 20) ^ 2)
' Math to sink the edges into the slime
mask! = (1.0 - (dist! / 22))
IF mask! < 0 THEN mask! = 0
' Get height from FBM math in our shared buffer
hRaw! = GetFBM!(x% * 3.5, z% * 3.5, .04, 5)
HGrid!(x%, z%) = (hRaw! * 180) * mask!
NEXT
NEXT
' --- Main Render Loop ---
DO
_LIMIT 60
CLS
t! = TIMER * 0.4 ' Rotation speed
' Draw Terrain Grid
FOR z% = 0 TO 39
FOR x% = 0 TO 39
' Biome logic: Pick texture based on average height of cell
hAvg! = (HGrid!(x%, z%) + HGrid!(x% + 1, z%) + HGrid!(x%, z% + 1) + HGrid!(x% + 1, z% + 1)) / 4
IF hAvg! < 12 THEN
tex& = TexSlime&
ELSEIF hAvg! < 35 THEN
tex& = TexSand&
ELSE
tex& = TexRock&
END IF
' Render the two triangles for this grid square
DrawPoly x%, z%, HGrid!(x%, z%), x% + 1, z%, HGrid!(x% + 1, z%), x%, z% + 1, HGrid!(x%, z% + 1), tex&, t!
DrawPoly x% + 1, z%, HGrid!(x% + 1, z%), x% + 1, z% + 1, HGrid!(x% + 1, z% + 1), x%, z% + 1, HGrid!(x%, z% + 1), tex&, t!
NEXT
NEXT
' Draw the Steel Monolith (Central Pillar)
DrawMonolith t!
_DISPLAY
LOOP UNTIL _KEYDOWN(27)
SUB DrawPoly (x1!, z1!, y1!, x2!, z2!, y2!, x3!, z3!, y3!, tex&, rot!)
' Rotate and Project 3D points
DIM px!(3), py!(3)
Project 512 + (x1! - 20) * 18, y1!, (z1! - 20) * 18, rot!, px!(1), py!(1)
Project 512 + (x2! - 20) * 18, y2!, (z2! - 20) * 18, rot!, px!(2), py!(2)
Project 512 + (x3! - 20) * 18, y3!, (z3! - 20) * 18, rot!, px!(3), py!(3)
' Only draw if in front of camera
_MAPTRIANGLE (0, 0)-(127, 0)-(0, 127), tex& TO(px!(1), py!(1))-(px!(2), py!(2))-(px!(3), py!(3))
END SUB
SUB Project (ax!, ay!, az!, r!, outX!, outY!)
' Standard Y-axis rotation
cx! = ax! - 512
cz! = az!
rx! = cx! * COS(r!) - cz! * SIN(r!)
rz! = cx! * SIN(r!) + cz! * COS(r!) + 800 ' Z-depth offset
' Perspective Divide
outX! = 512 + (rx! * 900 / rz!)
outY! = 450 - (ay! * 900 / rz!)
END SUB
SUB DrawMonolith (r!)
' A 4-sided steel pillar in the center
DIM mx!(4), mz!(4)
mx!(1) = -15: mz!(1) = -15
mx!(2) = 15: mz!(2) = -15
mx!(3) = 15: mz!(3) = 15
mx!(4) = -15: mz!(4) = 15
FOR i = 1 TO 4
iNext = (i MOD 4) + 1
' Draw pillar face (Two triangles)
DrawPoly 20 + mx!(i) / 18, 20 + mz!(i) / 18, 400, 20 + mx!(iNext) / 18, 20 + mz!(iNext) / 18, 400, 20 + mx!(i) / 18, 20 + mz!(i) / 18, 50, TexSteel&, r!
DrawPoly 20 + mx!(iNext) / 18, 20 + mz!(iNext) / 18, 400, 20 + mx!(iNext) / 18, 20 + mz!(iNext) / 18, 50, 20 + mx!(i) / 18, 20 + mz!(i) / 18, 50, TexSteel&, r!
NEXT
END SUB
'$INCLUDE: 'Proc_Image.bm'I love this field of coding so will continue to add more functions and effects but i hope you guys find it midly pleasing too.
Unseen