Posts: 215
Threads: 32
Joined: Apr 2022
Reputation:
68
06-14-2025, 11:45 AM
(This post was last modified: 06-14-2025, 11:49 AM by MasterGy.)
Hi !
Autostereogram, or Magic Eye, these are the names by which such images are known.
If you look closely, you should see a mountain.
I would like to try to make a simple 3D maze crawling game that you can only see if you look closely. Here is a short program to get you started, try it out!
I wonder how many people will see the mountain!
Code: (Select All)
'screen settings
monx = _DesktopWidth * .5
mony = _DesktopHeight * .5
mon = _NewImage(monx, mony, 32)
Screen mon
_FullScreen _SquarePixels
sWIDTH = monx * .6
sHEIGHT = sWIDTH / monx * mony
xstart = (monx - sWIDTH) / 2
ystart = (mony - sHEIGHT) / 2
PERIOD = Int(sWIDTH / 6)
Dim mapdeep_start(sWIDTH - 1, sHEIGHT - 1)
Dim mapdeep(sWIDTH - 1, sHEIGHT - 1) As Integer
Dim image(sWIDTH - 1, sHEIGHT - 1) As Long
'rand texture
For y = 0 To sHEIGHT - 1: For x = 0 To PERIOD - 1
c = 30 + Rnd * 220
image(x, y) = _RGB32(c, c, c)
PSet (xstart + x, ystart + y), image(x, y)
Next
Next
'stand norm
For x = 0 To sWIDTH - 1: For y = 0 To sHEIGHT - 1
mapdeep_start(x, y) = 1 - (_Min(Sqr((x - sWIDTH / 2) ^ 2 + (y - sHEIGHT / 2) ^ 2) / (sWIDTH / 2), 1)) ^ 2
Next: Next
Do
uni_depth = 255
If _KeyDown(32) Then
uni_depth = Abs(Sin(Timer * .2)) * 255
Else
timerstart = Timer
End If
'calc deep
For x = PERIOD To sWIDTH - 1: For y = 0 To sHEIGHT - 1
mapdeep(x, y) = mapdeep_start(x, y) * uni_depth ' középen világos, kívül sötétebb
Next: Next
' stereogram draw
temp = PERIOD / 2 / 255
For y = 0 To sHEIGHT - 1: For x = PERIOD To sWIDTH - 1
image(x, y) = image(_Max(x - PERIOD + Int(mapdeep(x, y) * temp), 0), y)
PSet (xstart + x, ystart + y), image(x, y)
Next: Next
_Display
Loop
Posts: 16
Threads: 1
Joined: Apr 2022
Reputation:
6
Sup MasterGy, you have been missed! This program absolutely works (i see the pit) and I appreciate your breaking new ground (as far as things go here). Great stuff!
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation:
322
I was surprised it being animated by key press. It must work for those drinkers of wine 
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 215
Threads: 32
Joined: Apr 2022
Reputation:
68
Hi !
Thanks for trying it out !
I'm 'here' regularly, but I haven't made anything lately.
To create an autostereogram, you need 3d data. The first example is simple, because it calculates the depth proportionally from the center of the screen, it's just a function. That's why we see a hill. But what about shapes? In order to put arbitrary shapes in the image, I needed to write a 3d renderer. Just like a 3d renderer draws pixels. But here you don't need to draw textures, you just need to fill the depth memory correctly, based on the given spatial triangles. The next program will be part of the autostereogram. Since it's interesting enough in itself, I'll show it separately. It renders a pyramid and displays the depth memory on the screen. The furthest points are black, the closest points are white. You can rotate the pyramid with the mouse.
Code: (Select All)
'screen settings
monx = _DesktopWidth * .8
mony = _DesktopHeight * .8
mon = _NewImage(monx, mony, 32)
Screen mon
_FullScreen _SquarePixels
Dim Shared sWIDTH, SHEIGHT
sWIDTH = monx * .4
SHEIGHT = sWIDTH / monx * mony
xstart = (monx - sWIDTH) / 2
ystart = (mony - SHEIGHT) / 2
PERIOD = Int(sWIDTH / 6)
Dim Shared mapdeep(sWIDTH - 1, SHEIGHT - 1)
Dim Shared mapdeep_work(sWIDTH - 1, SHEIGHT - 1)
Dim Shared image(sWIDTH - 1, SHEIGHT - 1) As Long
'rendering settings
Dim Shared focus
focus = 400
Dim Shared depth_dat(3)
depth_dat(0) = 2.1 'cut near
depth_dat(1) = 3.5 'cut far
depth_dat(2) = 1 / (depth_dat(1) - depth_dat(0))
Dim Shared p(4, 10)
Do
While _MouseInput: Wend
depthbuffer_clear
drawgula _MouseX * .01, -_MouseY * .01
'draw depthbuffer
For x = 0 To sWIDTH - 1
For y = 0 To SHEIGHT - 1
c = Abs(1 - mapdeep(x, y)) * 255
PSet (xstart + x, ystart + y), _RGB32(c, c, c)
Next
Next
_Display
Loop
Sub drawgula (angle1, angle2)
Dim gp(5, 3)
size = .5
gp(0, 0) = -size: gp(0, 1) = -size: gp(0, 2) = 0
gp(1, 0) = size: gp(1, 1) = -size: gp(1, 2) = 0
gp(2, 0) = size: gp(2, 1) = size: gp(2, 2) = 0
gp(3, 0) = -size: gp(3, 1) = size: gp(3, 2) = 0
gp(4, 0) = 0: gp(4, 1) = 0: gp(4, 2) = size * 2 'roof
For t = 0 To 4 'rotating
gp(t, 2) = gp(t, 2) - gp(4, 2) / 2 'Z center
Rot1 = gp(t, 0) * Cos(angle1) - gp(t, 1) * Sin(angle1)
Rot2 = gp(t, 0) * Sin(angle1) + gp(t, 1) * Cos(angle1)
gp(t, 0) = Rot1: gp(t, 1) = Rot2
Rot1 = gp(t, 2) * Cos(angle2) - gp(t, 1) * Sin(angle2)
Rot2 = gp(t, 2) * Sin(angle2) + gp(t, 1) * Cos(angle2)
gp(t, 2) = Rot1: gp(t, 1) = Rot2
Next
posZ = 3
' Stand
DrawTriangle3D gp(0, 0), gp(0, 1), gp(0, 2) + posZ, gp(1, 0), gp(1, 1), gp(1, 2) + posZ, gp(2, 0), gp(2, 1), gp(2, 2) + posZ
DrawTriangle3D gp(2, 0), gp(2, 1), gp(2, 2) + posZ, gp(3, 0), gp(3, 1), gp(3, 2) + posZ, gp(0, 0), gp(0, 1), gp(0, 2) + posZ
' Sides
DrawTriangle3D gp(0, 0), gp(0, 1), gp(0, 2) + posZ, gp(1, 0), gp(1, 1), gp(1, 2) + posZ, gp(4, 0), gp(4, 1), gp(4, 2) + posZ
DrawTriangle3D gp(1, 0), gp(1, 1), gp(1, 2) + posZ, gp(2, 0), gp(2, 1), gp(2, 2) + posZ, gp(4, 0), gp(4, 1), gp(4, 2) + posZ
DrawTriangle3D gp(2, 0), gp(2, 1), gp(2, 2) + posZ, gp(3, 0), gp(3, 1), gp(3, 2) + posZ, gp(4, 0), gp(4, 1), gp(4, 2) + posZ
DrawTriangle3D gp(3, 0), gp(3, 1), gp(3, 2) + posZ, gp(0, 0), gp(0, 1), gp(0, 2) + posZ, gp(4, 0), gp(4, 1), gp(4, 2) + posZ
End Sub
'3d rendering to depthbuffer -----------------------------------------------------
Sub Swap_Points (a, b)
For t = 0 To 9
temp = p(a, t)
p(a, t) = p(b, t)
p(b, t) = temp
Next
End Sub
Sub depthbuffer_clear
For x = 0 To sWIDTH - 1
For y = 0 To SHEIGHT - 1
mapdeep(x, y) = 1
Next
Next
End Sub
Sub DrawTriangle3D (x0, y0, z0, x1, y1, z1, x2, y2, z2)
p(0, 0) = x0: p(0, 1) = y0: p(0, 2) = z0
p(1, 0) = x1: p(1, 1) = y1: p(1, 2) = z1
p(2, 0) = x2: p(2, 1) = y2: p(2, 2) = z2
'convert 3d to 2d
For t = 0 To 2
p(t, 5) = sWIDTH / 2 + (focus * p(t, 0)) / p(t, 2)
p(t, 6) = SHEIGHT / 2 + (focus * p(t, 1)) / p(t, 2)
Next
'Y ordering
If p(1, 6) < p(0, 6) Then Swap_Points 0, 1
If p(2, 6) < p(0, 6) Then Swap_Points 0, 2
If p(2, 6) < p(1, 6) Then Swap_Points 1, 2
'Draw 2 triangle
DrawTriangle 0, 1
DrawTriangle 1, 2
End Sub
Sub DrawTriangle (Y1, Y2)
If Abs(p(Y1, 6) - p(Y2, 6)) < 2 Then Exit Sub
For i = 0 To 2
p(i, 9) = 1 / p(i, 2) ' 1/z
Next
For y = _Ceil(p(Y1, 6)) To Int(p(Y2, 6))
If y < 0 Or y > SHEIGHT - 1 Then _Continue
multi = denom_multi(y, Y1, Y2)
xa = Interpolate(p(Y1, 5), p(Y2, 5), multi)
oza = Interpolate(p(Y1, 9), p(Y2, 9), multi)
multi = denom_multi(y, 0, 2)
xb = Interpolate(p(0, 5), p(2, 5), multi)
ozb = Interpolate(p(0, 9), p(2, 9), multi)
DrawScanline y, xa, xb, oza, ozb
Next
End Sub
Function denom_multi (y, Y1, Y2)
t = (y - p(Y1, 6)) / (p(Y2, 6) - p(Y1, 6))
x = Interpolate(p(Y1, 5), p(Y2, 5), t)
denom = p(Y2, 5) - p(Y1, 5)
If denom <> 0 Then
If x < 0 Then t = -p(Y1, 5) / denom
If x > sWIDTH Then t = (sWIDTH - p(Y1, 5)) / denom
End If
denom_multi = _Max(_Min(t, 1), 0)
End Function
Sub DrawScanline (y, xStart, xEnd, zStart, zEnd)
If xStart > xEnd Then
temp = xStart: xStart = xEnd: xEnd = temp
temp = zStart: zStart = zEnd: zEnd = temp
End If
dx = xEnd - xStart
If dx = 0 Then Exit Sub
dxInv = 1 / dx
For x = xStart To xEnd
If x >= 0 And x < sWIDTH And y >= 0 And y < SHEIGHT Then
t = (x - xStart) * dxInv
oz = zStart + (zEnd - zStart) * t: If oz = 0 Then _Continue
depth_z = 1 / oz
depth_norm = depth_dat(2) * (depth_z - depth_dat(0))
If depth_norm < 0 Or depth_norm > 1 Then _Continue
If depth_norm < mapdeep(x, y) Then mapdeep(x, y) = depth_norm
End If
Next
End Sub
Function Interpolate (a, b, t): Interpolate = a + t * (b - a): End Function
Posts: 215
Threads: 32
Joined: Apr 2022
Reputation:
68
Hi !
I'm done. Unfortunately this won't be a game. It's a lot of calculations and it's slow. Even these few triangles are a lot (let alone a maze).
Good for curiosity. 4 shapes (triangle-based pyramid, square-based pyramid, hemisphere and cube), and 4 types of textures (blackwhite, greyscale, color, and patterned texture)
Try to see the shapes in the noise !
Code: (Select All)
Dim Shared helppoints As Integer '0/1 red point to help to you
helppoints = 1
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'screen settings
Dim Shared monx, mony
monx = _DesktopWidth * 1
mony = _DesktopHeight * 1
mon = _NewImage(monx, mony, 32)
Screen mon
_MouseHide
_FullScreen _SquarePixels , _Smooth
Dim Shared sWIDTH, sHEIGHT, workmonx, workmony
workmonx = monx * .7
workmony = mony * .7
sWIDTH = 450
sHEIGHT = Int(sWIDTH / 16 * 9)
workbitmap = _NewImage(sWIDTH, sHEIGHT, 32)
Dim Shared texture, texture_c As Integer '0-blackwhite 1-greyscale 2-color 3-texture
texture = 1
texture_c = 4
Dim Shared object, object_c As Integer
object_c = 4
Dim Shared separation_c
separation_c = 1000
Dim Shared separation(separation_c)
Dim Shared mapdeep(sWIDTH - 1, sHEIGHT - 1)
Dim Shared mapdeep_start(sWIDTH - 1, sHEIGHT - 1)
Dim Shared transf(10)
transf(2) = .5 'zoom
'rendering settings
Dim Shared focus
focus = 400 * 1 / 460 * sWIDTH
Dim Shared posZ, depth_dat(3)
depth_dat(0) = 2.1 'cut near
depth_dat(1) = 3.6 'cut far 3.6
depth_dat(2) = 1 / (depth_dat(1) - depth_dat(0))
posZ = 3
Dim Shared p(4, 10)
'rendering set
Dim Shared DPI, EYE_SEP, MU
DPI = sWIDTH / 12 '72
EYE_SEP = (2.5 * DPI + 0.5) ' Szemek közti távolság
MU = .35 '1 / 3 'terhatas eltolas minel nagyobb annal nagyobb a tereltolas
Dim Shared PIX(sWIDTH - 1) As Long
Dim Shared SAME(sWIDTH - 1) As Integer
For t = 0 To separation_c - 1: z = 1 / (separation_c - 1) * t: separation(t) = Int((1 - MU * z) * EYE_SEP / (2 - MU * z) + 0.5): Next 'separation install
For x = 0 To sWIDTH - 1: For y = 0 To sHEIGHT - 1: mapdeep_start(x, y) = (1 - (_Min(Sqr((x - sWIDTH / 2) ^ 2 + (y - sHEIGHT / 2) ^ 2) / (sWIDTH / 2), 1)) ^ 6 / 1): Next: Next 'stand norm
'texture make
Dim Shared image_origi(sWIDTH - 1, sHEIGHT - 1) As Long
maketexture
_Dest mon
Do
Color _RGB32(150, 150, 150)
control_refresh
depthbuffer_clear
Select Case object 'add object to depthbuffer
Case 0: object_hemisphere .5, 2, 4, 1.5 'gula/pyramid
Case 1: object_hemisphere .5, 2, 5, 1.5 'gula/pyramid
Case 2: object_hemisphere .5, 8, 16, 1 'hemisphere
Case 3: object_cube .7 'cube
End Select
For y = 0 To sHEIGHT - 1: For x = 0 To sWIDTH - 1: mapdeep(x, y) = 1 - mapdeep(x, y): Next: Next
_Dest mon
Locate 1, 1: Print "object type change: mousebutton_left Texture change: SPACE Rotating: mousemoving"
Locate 2, 1: Print "view grayscale : mousebutton-right Zoom OBJECT ("; transf(3); "X) mousewheel"
_Dest workbitmap
If _KeyDown(100306) Or _MouseButton(2) Then
Locate 2, 1: Print ""
For x = 0 To sWIDTH - 1: For y = 0 To sHEIGHT - 1 'draw depthbuffer in greyscale
c = mapdeep(x, y) * 255: PSet (x, y), _RGB32(c, c, c)
Next: Next
Else
drawAutoStereogram
End If
_Source workbitmap
_Dest mon
xstart = (monx - workmonx) / 2
ystart = (mony - workmony) / 2
_PutImage (xstart, ystart)-(xstart + workmonx, ystart + workmony), , , , _Smooth
_Display: Cls
Loop
Sub drawAutoStereogram
temp1 = 1 / (MU * EYE_SEP)
For y = 0 To sHEIGHT - 1
For x = 0 To sWIDTH - 1: SAME(x) = x: Next
For x = 0 To sWIDTH - 1
s = separation(Int(mapdeep(x, y) * separation_c))
left = x - s \ 2
right = left + s
If left >= 0 And right < sWIDTH Then
visible = -1
t = 1
temp2 = 2 * (2 - MU * mapdeep(x, y)) * temp1
Do
zt = mapdeep(x, y) + temp2 * t
If x - t < 0 Or x + t >= sWIDTH Then Exit Do
visible = mapdeep(x - t, y) < zt And mapdeep(x + t, y) < zt
t = t + 1
Loop While visible And zt < 1
If visible Then
l = SAME(left)
Do While l <> left And l <> right
If l < right Then
left = l
l = SAME(left)
Else
SAME(left) = right
left = right
l = SAME(left)
right = l
End If
Loop
SAME(left) = right
End If
End If
Next
' Képsor kirajzolása
For x = sWIDTH - 1 To 0 Step -1
If SAME(x) = x Then
PIX(x) = image_origi(x, y)
Else
PIX(x) = PIX(SAME(x))
End If
PSet (x, y), PIX(x)
Next
Next
If helppoints Then
farSep = separation(0)
r = 2
Dim col As _Integer64 'Long
col = _RGB32(255, 0, 0)
py = sHEIGHT * 18 / 20
For t = 0 To 1
px = sWIDTH / 2 + farSep / 2 * (t * 2 - 1)
Circle (px, py), r, col
Paint (px, py), col, col
Next
End If
End Sub
Sub object_hemisphere (size, rows, cols, zsize)
Dim gp(rows * cols, 2)
For theta = 0 To rows - 1: For phi = 0 To cols - 1
t = _Pi / 2 / (rows - 1) * theta
p = _Pi * 2 / (cols - 1) * phi
index = theta * cols + phi
gp(index, 0) = size * Sin(t) * Cos(p)
gp(index, 1) = size * Sin(t) * Sin(p)
gp(index, 2) = zsize * size * Cos(t) - size / 2
transformation gp(index, 0), gp(index, 1), gp(index, 2)
Next: Next
For t = 0 To rows - 2: For p = 0 To cols - 2
i1 = t * cols + p
i2 = i1 + 1
i3 = (t + 1) * cols + p
i4 = i3 + 1
DrawTriangle3D gp(i1, 0), gp(i1, 1), gp(i1, 2), gp(i3, 0), gp(i3, 1), gp(i3, 2), gp(i4, 0), gp(i4, 1), gp(i4, 2)
DrawTriangle3D gp(i1, 0), gp(i1, 1), gp(i1, 2), gp(i4, 0), gp(i4, 1), gp(i4, 2), gp(i2, 0), gp(i2, 1), gp(i2, 2)
Next: Next
End Sub
Sub object_cube (size)
size = size / 2
Dim cp(3, 2), pc(7, 2)
For t = 0 To 7
For t2 = 0 To 2: pc(t, t2) = size * (Sgn(t And 2 ^ t2) * 2 - 1): Next t2
transformation pc(t, 0), pc(t, 1), pc(t, 2)
Next t
For t = 0 To 4
For t2 = 0 To 3: side = Val(Mid$("-0246-2367-3175-1054-4567", 2 + t * 5 + t2, 1))
For t3 = 0 To 2: cp(t2, t3) = pc(side, t3): Next t3, t2
DrawTriangle3D cp(0, 0), cp(0, 1), cp(0, 2), cp(1, 0), cp(1, 1), cp(1, 2), cp(2, 0), cp(2, 1), cp(2, 2)
DrawTriangle3D cp(2, 0), cp(2, 1), cp(2, 2), cp(3, 0), cp(3, 1), cp(3, 2), cp(1, 0), cp(1, 1), cp(1, 2)
Next t
End Sub
Sub control_refresh
Do
k$ = InKey$
If k$ = " " Then
texture = (texture + 1) Mod texture_c
maketexture
End If
Loop While InKey$ <> ""
While _MouseInput
transf(0) = transf(0) + _MouseMovementX
transf(1) = transf(1) + _MouseMovementY
transf(2) = transf(2) - _MouseWheel * .08
If _MouseButton(1) And transf(4) = 0 Then object = (object + 1) Mod object_c
transf(4) = _MouseButton(1)
Wend
transf(2) = _Max(_Min(transf(2), 1), 0)
transf(3) = Interpolate(.4, 1.6, transf(2)) 'mousewheel-size
End Sub
Sub transformation (x, y, z)
angle1 = -transf(0) * .003
angle2 = transf(1) * .003
RotX = x * Cos(angle1) - y * Sin(angle1)
RotY = x * Sin(angle1) + y * Cos(angle1)
x = RotX * transf(3): y = RotY
RotY = y * Cos(angle2) - z * Sin(angle2)
RotZ = y * Sin(angle2) + z * Cos(angle2)
y = RotY * transf(3): z = RotZ * transf(3) + posZ
End Sub
Sub maketexture
If texture = 3 Then
Dim col As Long
text = _NewImage(sWIDTH, sHEIGHT, 32)
_Dest text
For t = 0 To 25000
px = sWIDTH * Rnd: py = sHEIGHT * Rnd: pr = Interpolate(1, 6, Rnd)
col = _RGB32(55 + 160 * Rnd, 55 + 160 * Rnd, 55 + 160 * Rnd)
Circle (px, py), pr, col: Paint (px, py), col, col
Next
_Source text
For y = 0 To sHEIGHT - 1: For x = 0 To sWIDTH - 1: image_origi(x, y) = Point(x, y): Next x, y
_Source mon: _FreeImage text
Else
Dim c(2) As Integer
For y = 0 To sHEIGHT - 1: For x = 0 To sWIDTH - 1
Select Case texture
Case 0: c = 255 * Int(Rnd * 2): c(0) = c: c(1) = c: c(2) = c 'blackwhite
Case 1: c = 255 * Rnd: c(0) = c: c(1) = c: c(2) = c 'greyscale
Case 2: For t = 0 To 2: c(t) = 255 * Rnd: Next t 'color
End Select
image_origi(x, y) = _RGB32(c(0), c(1), c(2))
Next: Next
End If
End Sub
'------------------------------------------------------------------------------------------3d rendering to depthbuffer -----------------------------------------------------------------------------------------------------
Sub Swap_Points (a, b): For t = 0 To 9: Swap p(a, t), p(b, t): Next: End Sub
Sub depthbuffer_clear
For x = 0 To sWIDTH - 1: For y = 0 To sHEIGHT - 1: mapdeep(x, y) = mapdeep_start(x, y) '1 if play
Next: Next
End Sub
Sub DrawTriangle3D (x0, y0, z0, x1, y1, z1, x2, y2, z2)
p(0, 0) = x0: p(0, 1) = y0: p(0, 2) = z0
p(1, 0) = x1: p(1, 1) = y1: p(1, 2) = z1
p(2, 0) = x2: p(2, 1) = y2: p(2, 2) = z2
'convert 3d to 2d
For t = 0 To 2
p(t, 5) = sWIDTH / 2 + (focus * p(t, 0)) / p(t, 2)
p(t, 6) = sHEIGHT / 2 + (focus * p(t, 1)) / p(t, 2)
Next
'Y ordering
If p(1, 6) < p(0, 6) Then Swap_Points 0, 1
If p(2, 6) < p(0, 6) Then Swap_Points 0, 2
If p(2, 6) < p(1, 6) Then Swap_Points 1, 2
'Draw 2 triangle
DrawTriangle 0, 1
DrawTriangle 1, 2
End Sub
Sub DrawTriangle (Y1, Y2)
If Abs(p(Y1, 6) - p(Y2, 6)) < 2 Then Exit Sub
For i = 0 To 2: p(i, 9) = 1 / p(i, 2): Next ' 1/z
For y = _Ceil(p(Y1, 6)) To Int(p(Y2, 6))
If y < 0 Or y > sHEIGHT - 1 Then _Continue
multi = denom_multi(y, Y1, Y2)
xa = Interpolate(p(Y1, 5), p(Y2, 5), multi)
oza = Interpolate(p(Y1, 9), p(Y2, 9), multi)
multi = denom_multi(y, 0, 2)
xb = Interpolate(p(0, 5), p(2, 5), multi)
ozb = Interpolate(p(0, 9), p(2, 9), multi)
DrawScanline y, xa, xb, oza, ozb
Next
End Sub
Function denom_multi (y, Y1, Y2)
t = (y - p(Y1, 6)) / (p(Y2, 6) - p(Y1, 6))
x = Interpolate(p(Y1, 5), p(Y2, 5), t)
denom = p(Y2, 5) - p(Y1, 5)
If denom <> 0 Then
If x < 0 Then t = -p(Y1, 5) / denom
If x > sWIDTH Then t = (sWIDTH - p(Y1, 5)) / denom
End If
denom_multi = _Max(_Min(t, 1), 0)
End Function
Sub DrawScanline (y, xStart, xEnd, zStart, zEnd)
If xStart > xEnd Then Swap xStart, xEnd: Swap zStart, zEnd
dx = xEnd - xStart
If dx = 0 Then Exit Sub
dxInv = 1 / dx
For x = xStart To xEnd
If x >= 0 And x < sWIDTH And y >= 0 And y < sHEIGHT Then
t = (x - xStart) * dxInv
oz = Interpolate(zStart, zEnd, t): If oz = 0 Then _Continue
depth_norm = (depth_dat(2) * (1 / oz - depth_dat(0)))
If depth_norm < 0 Or depth_norm > 1 Then _Continue
If depth_norm < mapdeep(x, y) Then mapdeep(x, y) = depth_norm 'FINISH !!! write to depthbuffer !
End If
Next
End Sub
Function Interpolate (a, b, t): Interpolate = a + t * (b - a): End Function
|
