02-16-2024, 02:50 AM
OK I took a shot at 3D Rendering of Game of Life from a slightly diferent angle:
Code: (Select All)
Option _Explicit
_Title "3D Render: Game of Life 2, hold enter key to reset and change color" ' B+
' this all started 2019-10-20 (as Vector Math)
' Based on notes provided to QB64 forum by William F Barnes, on 2019-10-19
' https://www.qb64.org/forum/index.php?topic=1782.0
' A vector's dimension is the number of components it has.
' Here is code for processing 2 and 3 dimension vectors.
'2019-11-20 add STxAxTIC's conversion code for new sub screenXY
' Nice cube corners maker and nice wireframe cube
'2019-11-22 3D render 2, Upon STxAxTIC's advice crank up the FOVD,
' I did and found a nice range of cube like cubes, I also have a check
' for xyz to see if it is viewable, which we will test with FOVD.
' Oddly I had to make FOVD negative in order to get the numbers in the
' correct quadrants. When the cube center crosses into positive,
' the quadrants will flip-flop, but still a nice cube is drawn.
' When the cube center is at z=0 you will see a big X across screen!
'2021-12-19 3D Render 3: Cube of Cubes for Graphics Test #3
'2024-02-11 try 3d Game of Life ? successful proof of concept!!!
' 2024-02-12 try clothing wireframe cubes with walls with new DrawCube routine
' 2024-02-15 add new draw cube and needed routines for it
' remove the rest of the stuff!
Const sxmax = 700, symax = 700
Const tlx = -20, tly = 20, brx = 20, bry = -20 ' Cartesian Coordinate System corners for WINDOW command
' to convert mouse coordinates to WINDOW after call look up PMAP
Type xyType
x As Single
y As Single
End Type
Type xyzType
x As Single
y As Single
z As Single
End Type
'Basis Vectors, isolate components e sub x Dot V w/arrowHat = V sub x
Dim Shared v3e(1 To 3) As xyzType ' dotProduct
v3e(1).x = 1: v3e(1).y = 0: v3e(1).z = 0
v3e(2).x = 0: v3e(2).y = 1: v3e(2).z = 0
v3e(3).x = 0: v3e(3).y = 0: v3e(3).z = 1
Dim Shared fovd As Double 'for screenXY of (x, y, z) point in real space
fovd = -80 '???
Dim Shared zmin, zmax, xmin, xmax, ymin, ymax
zmin = -32: zmax = -21
xmin = -6: xmax = 6
ymin = -6: ymax = 6
Screen _NewImage(sxmax, symax, 32) 'square screen
_ScreenMove 300, 40
Randomize Timer
Window (tlx, tly)-(brx, bry) ' <<<<<<<<<<<<<<<<<<<< get a Cartesian Coordinate System started
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> to convert mouse coordinates to WINDOW after call look up PMAP
' ==================================== end of 3D Render setup ?
' setup for Game of Life
Dim As Integer U(xmin To xmax, ymin To ymax, zmin To zmax), U2(xmin To xmax, ymin To ymax, zmin To zmax)
Dim As Integer x, y, z, r, g, b, mm, xx, yy, zz, rr, gg, bb
restart:
For z = zmin + 1 To zmax - 1
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
If Rnd > .9 Then U(x, y, z) = 1
Next y, x, z
rr = Rnd * 50 + 50: gg = Rnd * 50 + 50: bb = Rnd * 50 + 50
Do
Cls
r = rr: g = gg: b = bb
For z = zmin + 1 To zmax - 1
r = r + 15: g = g + 15: b = b + 15
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
If U(x, y, z) = 1 Then
drawCube x, y, z, .7, _RGB32(r, g, b)
End If
Next y, x
_Display
_Limit 25
Next z
_Delay .45
If _KeyDown(13) Then Cls: _Delay .5: GoTo restart
For z = zmin + 1 To zmax - 1
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
mm = 0
For xx = x - 1 To x + 1
For yy = y - 1 To y + 1
For zz = z - 1 To z + 1
If x = xx And y = yy And z = zz Then
Else
If U(xx, yy, zz) = 1 Then mm = mm + 1
End If
Next zz, yy, xx
If (mm > 4) And (mm < 8) Then ' 5, 6, 7 neighbors for birth
U2(x, y, z) = 1
ElseIf U(x, y, z) = 1 And mm = 4 Then
U2(x, y, z) = 1
Else
U2(x, y, z) = 0
End If
Next y, x
Next z
For z = zmin + 1 To zmax - 1
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
U(x, y, z) = U2(x, y, z)
Next y, x, z
Loop Until _KeyDown(27)
' new 2024-02-15 testing with above code
Sub drawCube (cx, cy, cz, side, colr~&) 'draw a cube on screen from an xyz() 3D array
Dim As Integer i, r, g, b
Dim sd2, lx, rx, ty, by, fz, bz
Dim c2 As _Unsigned Long
r = _Red32(colr~&): g = _Green32(colr~&): b = _Blue32(colr~&)
ReDim corners(0 To 7) As xyzType
sd2 = side / 2
rx = cx + sd2: lx = cx - sd2
ty = cy + sd2: by = cy - sd2
fz = cz + sd2: bz = cz - sd2
corners(0).x = lx: corners(0).y = ty: corners(0).z = fz
corners(1).x = rx: corners(1).y = ty: corners(1).z = fz
corners(2).x = rx: corners(2).y = by: corners(2).z = fz
corners(3).x = lx: corners(3).y = by: corners(3).z = fz
corners(4).x = lx: corners(4).y = ty: corners(4).z = bz
corners(5).x = rx: corners(5).y = ty: corners(5).z = bz
corners(6).x = rx: corners(6).y = by: corners(6).z = bz
corners(7).x = lx: corners(7).y = by: corners(7).z = bz
ReDim xy(0 To 7) As xyType
For i = 0 To 7
screenXY corners(i), xy(i) ' take a corner x,y,z and convert to screen coordinates x,y
Next
' left side of face
If xy(0).x > 0 Then
c2 = _RGB32(r - 70, g - 60, b - 70)
FillTriangle PMap(xy(0).x, 0), PMap(xy(0).y, 1), PMap(xy(3).x, 0), PMap(xy(3).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), c2
FillTriangle PMap(xy(4).x, 0), PMap(xy(4).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), PMap(xy(0).x, 0), PMap(xy(0).y, 1), c2
End If
' top face
If xy(0).y < 0 Then
c2 = _RGB32(r - 40, g - 40, b - 40)
FillTriangle PMap(xy(0).x, 0), PMap(xy(0).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(4).x, 0), PMap(xy(4).y, 1), c2
FillTriangle PMap(xy(4).x, 0), PMap(xy(4).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), c2
End If
' right face
If xy(1).x < 0 Then
c2 = _RGB32(r - 70, g - 70, b - 70)
FillTriangle PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), c2
FillTriangle PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), c2
End If
' bottom face
If xy(0).y > 0 Then
c2 = _RGB32(r - 110, g - 110, b - 110)
FillTriangle PMap(xy(3).x, 0), PMap(xy(3).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), c2
FillTriangle PMap(xy(7).x, 0), PMap(xy(7).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), c2
End If
' front face
FillTriangle PMap(xy(0).x, 0), PMap(xy(0).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), colr~&
FillTriangle PMap(xy(2).x, 0), PMap(xy(2).y, 1), PMap(xy(3).x, 0), PMap(xy(3).y, 1), PMap(xy(0).x, 0), PMap(xy(0).y, 1), colr~&
End Sub
' steves latest version to check out, seems to be working OK
Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
$Checking:Off
Static a&, m As _MEM
If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
_MemPut m, m.OFFSET, K
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
$Checking:On
End Sub
' project (x, y, z) point in real space to screenXY of user's eye-line
Sub screenXY (xyzReal As xyzType, xyScreen As xyType)
Dim vec3Ddotnhat
vec3Ddotnhat = v3DotProduct(xyzReal, v3e(3))
xyScreen.x = v3DotProduct(xyzReal, v3e(1)) * fovd / vec3Ddotnhat
xyScreen.y = v3DotProduct(xyzReal, v3e(2)) * fovd / vec3Ddotnhat
End Sub
Function v3DotProduct (A As xyzType, B As xyzType) 'shadow or projection if A Dot B = 0 then A , B are perpendicular
v3DotProduct = A.x * B.x + A.y * B.y + A.z * B.z
End Function
b = b + ...