05-08-2026, 06:32 PM
It takes a while to generate the images and the meshes.
Code:
include "s3d.n7"
#win32
#mem256000000
' Display settings.
constant RES = 360
constant SCALE = 1
constant FULLSCREEN = 1
constant DISPLAY_FPS = 1
constant FOV = 65
constant MOUSE_SENS = 0.5
' Fog color.
constant FOG_R = 48, FOG_G = 56, FOG_B = 80
visible vLastTick = 0
randomize 139
aspect = screenw()/screenh()
set window "Heightmap", RES*screenw()/screenh(), RES, FULLSCREEN, SCALE
set redraw off
S3D_SetView(primary, rad(FOV), 0.1, 32)
water1Image = NoiseImage(128, 128, 3, 3, 1)
ApplyTint(water1Image, 128, 0, 0, 1, 1, 1)
water2Image = NoiseImage(128, 128, 2, 2, 1)
ApplyTint(water2Image, 255, 255, 0, 1, 1, 1)
ApplyTint(water2Image, 255, 32, 0, 1, 0.25, 0)
ApplyContrast(water2Image, 2, 2, 2)
waterTexture = createimage(128, 128)
watera = 0
' Create three different textures for three height levels.
w = 64
h = 64
diffs = [
NoiseImage(w, h, 4, 4, 2),
NoiseImage(w, h, 4, 4, 2),
NoiseImage(w, h, 4, 4, 2)]
tmp = NoiseImage(w, h, 2, 2, 4)
bm = Bumpmap(tmp, 0.05)
bm2 = Bumpmap(tmp, 0.25)
free image tmp
ApplyTint(diffs[0], 128, 16, 0, 1, 1, 1)
ApplyTint(diffs[1], 64, 48, 32, 1, 1, 1)
ApplyTint(diffs[2], 128, 96, 64, 1, 1, 1)
ApplyBumpmap(diffs[0], bm, 1, 1, 1)
ApplyBumpmap(diffs[1], bm2, 1, 1, 1)
ApplyBumpmap(diffs[2], bm2, 1, 1, 1)
free image bm
free image bm2
' Eh ... create all possible combinations of these three textures blended from the four corners.
combos = dim(3, 3, 3, 3)
for tl = 0 to 2 for tr = 0 to 2 for bl = 0 to 2 for br = 0 to 2
tlimg = diffs[tl]; trimg = diffs[tr]; blimg = diffs[bl]; brimg = diffs[br]
img = createimage(w, h)
combos[tl][tr][bl][br] = img
set image img
for y = 0 to h - 1
ny = y/h
for x = 0 to w - 1
nx = x/w
set color BilerpV(pixel(tlimg, x, y), pixel(trimg, x, y),
pixel(blimg, x, y), pixel(brimg, x, y),
nx, ny)
set pixel x, y
next
next
set image primary
next
' Create heightmap image.
'heightmapImg = NoiseImage(512, 512, 32, 32, 4)
heightmapImg = NoiseImage(256, 256, 16, 16, 4)
' Create heightmap.
waterLevel = 6
hm = CreateHeightmap(heightmapImg, 16, combos, [0, 7.5, 10], waterTexture, waterLevel)
' Camera position.
camX = width(heightmapImg)/2 + 0.5
camY = 0
camZ = height(heightmapImg)/2 + 0.5
' Yaw and pitch for camera rotation.
camYaw = 0
camPitch = 0
' The camera bobs up and down when the user moves.
camBobAngle = 0
camBobEffect = 0
set mouse off
set mouse width(primary)/2, height(primary)/2
while not keydown(KEY_ESCAPE, true)
dt = DeltaTime()
mdx = mouserelx()
mdy = mouserely()
set mouse width(primary)/2, height(primary)/2
camYaw = camYaw + mdx*MOUSE_SENS
camPitch = min(max(camPitch - mdy*MOUSE_SENS, -60), 60)
dx = 0; dz = 0
if keydown(KEY_W)
dx = dx + sin(rad(camYaw))
dz = dz + cos(rad(camYaw))
endif
if keydown(KEY_S)
dx = dx - sin(rad(camYaw))
dz = dz - cos(rad(camYaw))
endif
if keydown(KEY_A)
dx = dx + sin(rad(camYaw - 90))
dz = dz + cos(rad(camYaw - 90))
endif
if keydown(KEY_D)
dx = dx + sin(rad(camYaw + 90))
dz = dz + cos(rad(camYaw + 90))
endif
if dx or dz
camBobAngle = camBobAngle + 500*dt
k = 2*dt/sqr(dx*dx + dz*dz)
camX = camX + k*dx
camZ = camZ + k*dz
camBobEffect = min(camBobEffect + 4*dt, 1)
else
camBobEffect = max(camBobEffect - 4*dt, 0)
endif
camY = min(hm.GetY(camX, camZ), -waterLevel + 0.25) - 0.75
watera = watera + 0.5*dt
set image waterTexture, false
w = width(water1Image); h = height(water1Image)
set color 255, 255, 255
for y = -1 to 1 for x = -1 to 1 draw image water1Image, floor(x*w + cos(watera)*0.5*w), floor(y*h + sin(watera)*0.5*h)
set color 255, 255, 255, 192
set additive true
for y = -1 to 1 for x = -1 to 1 draw image water2Image, floor(x*w - cos(watera)*0.5*w), floor(y*h - sin(watera)*0.5*h)
set additive false
set image primary
set color FOG_R, FOG_G, FOG_B
cls
S3D_Clear()
S3D_SetDepthBuffer(S3D_Z_BUFFER)
S3D_RotateX(rad(-camPitch))
S3D_RotateY(rad(-camYaw))
S3D_Translate(-camX, -camY + 0.04*camBobEffect*sin(rad(camBobAngle)), -camZ)
viewDX = sin(rad(camYaw))
viewDY = cos(rad(camYaw))
chunkSize = 8
ix = floor(camX/chunkSize); iy = floor(camZ/chunkSize)
dist = 4
fovc = cos(rad(FOV*aspect)*0.5)
for gy = iy - dist to iy + dist for gx = ix - dist to ix + dist
if gx = ix and gy = iy
inside = true
else
inside = false
for gdy = 0 to 1 for gdx = 0 to 1
dx = (gx + gdx)*chunkSize - camX; dy = (gy + gdy)*chunkSize - camZ
d = sqr(dx*dx + dy*dy)
if d > 0
dx = dx/d; dy = dy/d
dp = dx*viewDX + dy*viewDY
if dp >= fovc
inside = true
break
endif
endif
next
endif
if inside
if gx >= 0 and gx < sizeof(hm.meshes) - 1 and gy >= 0 and gy < sizeof(hm.meshes[0])
S3D_Mesh(hm.meshes[gx][gy], 0)
endif
endif
next
S3D_RenderFog(FOG_R, FOG_G, FOG_B, false)
set color 255, 255, 255
set caret 0, 0
wln "Position: (" + str(camX, 0, 2) + ", " + str(camY, 0, 2) + ", " + str(camZ, 0, 2) + ")"
wln
wln "Move with WASD keys"
wln "Look around with the mouse"
wln
wln "Press Esc to quit"
DisplayFps(dt)
redraw
fwait 60
wend
' CreateHeightmap
' ---------------
' Create heightmap mesh and data from image.
function CreateHeightmap(img, maxHeight, levelTextures, levels, waterTexture, waterLevel)
assert image(img), "CreateHeightmap: invalid image"
mapw = width(img); maph = height(img)
' For heights and normals.
data = fill([], mapw, maph)
' Calculate height for each tile in the xz plane based on the color of the pixels in img.
set image img
for z = 0 to maph - 1
for x = 0 to mapw - 1 data[x][z].h = -maxHeight*pixel(x, z)[0]/255
next
set image primary
' A tile is represented by two triangles. Calculate the normals of these triangles, as they're
' needed for calculating the y coordinate at any position within a tile.
a = dim(3); b = dim(3); c = dim(3); n = dim(3)
for z = 0 to maph - 2 for x = 0 to mapw - 2
a[0] = 0; a[1] = data[x][z + 1].h - data[x][z].h; a[2] = 1
b[0] = 1; b[1] = data[x + 1][z + 1].h - data[x][z].h; b[2] = 1
c[0] = 1; c[1] = data[x + 1][z].h - data[x][z].h; c[2] = 0
CrossProduct(n, a, b)
Normalize(n)
data[x][z].nLx = n[0]
data[x][z].nLy = n[1]
data[x][z].nLz = n[2]
CrossProduct(n, b, c)
Normalize(n)
data[x][z].nRx = n[0]
data[x][z].nRy = n[1]
data[x][z].nRz = n[2]
next
' Build the meshes.
chunkSize = 8
meshes = dim(ceil(mapw/chunkSize), ceil(maph/chunkSize))
'meshes = []
waterY = -waterLevel
z = 0; zi = 0
while z <= maph - 2
x = 0
xi = 0
while x <= mapw - 2
meshes[xi][zi] = S3D_BeginMesh()
S3D_Color3(255, 255, 255)
S3D_Begin(S3D_TRIANGLES)
for chunkz = z to min(z + chunkSize - 1, maph - 2)
voffs = (chunkz%2)*0.5
for chunkx = x to min(x + chunkSize - 1, mapw - 2)
uoffs = (chunkx%2)*0.5
htl = data[chunkx][chunkz].h
htr = data[chunkx + 1][chunkz].h
hbl = data[chunkx][chunkz + 1].h
hbr = data[chunkx + 1][chunkz + 1].h
for i = sizeof(levels) - 1 to 0 if |htl| > levels[i] break; ttl = max(i, 0)
for i = sizeof(levels) - 1 to 0 if |htr| > levels[i] break; ttr = max(i, 0)
for i = sizeof(levels) - 1 to 0 if |hbl| > levels[i] break; tbl = max(i, 0)
for i = sizeof(levels) - 1 to 0 if |hbr| > levels[i] break; tbr = max(i, 0)
tex = levelTextures[ttl][ttr][tbl][tbr]
if htl < waterY or htr < waterY or hbl < waterY or hbr < waterY
S3D_Texture(tex)
S3D_Vertex5(chunkx, data[chunkx][chunkz].h, chunkz, 0, 0)
S3D_Vertex5(chunkx + 1, data[chunkx + 1][chunkz + 1].h, chunkz + 1, 1, 1)
S3D_Vertex5(chunkx + 1, data[chunkx + 1][chunkz].h, chunkz, 1, 0)
S3D_Vertex5(chunkx, data[chunkx][chunkz].h, chunkz, 0, 0)
S3D_Vertex5(chunkx, data[chunkx][chunkz + 1].h, chunkz + 1, 0, 1)
S3D_Vertex5(chunkx + 1, data[chunkx + 1][chunkz + 1].h, chunkz + 1, 1, 1)
endif
if htl > waterY or htr > waterY or hbl > waterY or hbr > waterY
S3D_Texture(waterTexture)
S3D_Vertex5(chunkx, waterY, chunkz, uoffs, voffs)
S3D_Vertex5(chunkx + 1, waterY, chunkz + 1, uoffs + 0.5, voffs + 0.5)
S3D_Vertex5(chunkx + 1, waterY, chunkz, uoffs + 0.5, voffs)
S3D_Vertex5(chunkx, waterY, chunkz, uoffs, voffs)
S3D_Vertex5(chunkx, waterY, chunkz + 1, uoffs, voffs + 0.5)
S3D_Vertex5(chunkx + 1, waterY, chunkz + 1, uoffs + 0.5, voffs + 0.5)
endif
next
next
S3D_End()
S3D_EndMesh()
x = x + chunkSize
xi = xi + 1
wend
z = z + chunkSize
zi = zi + 1
wend
hm = []
hm.meshes = meshes
hm.data = data
' GetY
' ----
hm.GetY = function(x, z)
' Tile.
ix = min(max(floor(x), 0), sizeof(.data) - 2)
iz = min(max(floor(z), 0), sizeof(.data[0]) - 2)
' Coordinates within tile.
x = x - float(ix)
z = z - float(iz)
' Which triangle?
if x < z
y = .data[ix][iz].h -
(.data[ix][iz].nLx*x + .data[ix][iz].nLz*z)/.data[ix][iz].nLy
else
x = x - 1
z = z - 1
y = .data[ix + 1][iz + 1].h -
(.data[ix][iz].nRx*x + .data[ix][iz].nRz*z)/.data[ix][iz].nRy
endif
return y
endfunc
return hm
endfunc
' CrossProduct
' ------------
' Set dst to a x b.
function CrossProduct(dst, a, b)
dst[0] = a[1]*b[2] - a[2]*b[1]
dst[1] = a[2]*b[0] - a[0]*b[2]
dst[2] = a[0]*b[1] - a[1]*b[0]
endfunc
' Normalize
' ---------
' Normalize vector a.
function Normalize(a)
k = 1/sqr(a[0]*a[0] + a[1]*a[1] + a[2]*a[2])
a[0] = k*a[0]; a[1] = k*a[1]; a[2] = k*a[2]
endfunc
' DeltaTime
' ---------
' Return delta time in seconds since last call.
function DeltaTime()
t = clock()
dt = (min(t - vLastTick, 100))/1000
vLastTick = t
return dt
endfunc
' DisplayFps
' ----------
' Display number of frames per second in bottom right corner based on delta time in seconds.
function DisplayFps(dt)
if DISPLAY_FPS
set caret width(primary) - fwidth(" "), height(primary) - fheight()
set justification right
set color 0, 255, 0
write "FPS: " + str(round(1/dt))
set justification left
endif
endfunc
' 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 + 12345)%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