02-13-2024, 06:55 PM
Before I post my attempted update to "cloth" the bare wire frame cubes, this is what I had for Game of Life in a 3D rendering or 10 X 10 X 10 cube space.
It started by translating a bunch of notes Stax posted about 3D rendering. I tried a few experiments with a wireframe cube, adding NewCube and DrawWireCube and then dropped project for couple years until we started talking about 3D version of Game of Life. I came up with following changing original Window coordinates and setting up x, y, z limits to the U(x, y, z) Universe array.
So with that successful proof of concept of 3D "Game" I set out to clothe the wire frame cubes with walls.
I don't think I tried _MapTriangle directly because I think you need another image source to transfer to _MapTriangle destination or output. I was testing with several Triangle Fill routines that use _MapTriangle:
Tried 1st 2 and Andy Amaya's last. BUT I also rewrote a section of main code that draws the wire cube after running x,y,z of array calc the 8 corners and then convert the xyz corners to screenXY coordinates for poits to draw lines from:
It was from that subroutine I starte to convert the wireframe lines to solid walls with 2 triangles each for the 4 point face/wall.
It started by translating a bunch of notes Stax posted about 3D rendering. I tried a few experiments with a wireframe cube, adding NewCube and DrawWireCube and then dropped project for couple years until we started talking about 3D version of Game of Life. I came up with following changing original Window coordinates and setting up x, y, z limits to the U(x, y, z) Universe array.
Code: (Select All)
Option _Explicit
_Title "3D Render: Game of Life Cubed, hold enter key to reset" ' B+ 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 ?
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
' notation 0 w/arrowHat (no way of telling if 2, 3 or more dimensions)
Dim Shared v2zero As xyType, v3zero As xyzType
v2zero.x = 0: v2zero.y = 0
v3zero.x = 0: v3zero.y = 0: v3zero.z = 0
'Basis Vectors, isolate components e sub x Dot V w/arrowHat = V sub x
Dim Shared v2e(1 To 2) As xyType, v3e(1 To 3) As xyzType
v2e(1).x = 1: v2e(1).y = 0
v2e(2).x = 0: v2e(2).y = 1
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 = -60 '???
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 ?
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, i, r, g, b, mm, xx, yy, zz, rr, gg, bb
ReDim testCube(0) As xyzType
restart:
For z = zmin + 1 To zmax - 1
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
If Rnd > .8 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
Color _RGB32(r, g, b, 200)
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
If U(x, y, z) = 1 Then
newCube x, y, z, 1, testCube() ' finds 8 xyz point corners given x,y,z center and side
ReDim screenTest(0 To 7) As xyType
For i = 0 To 7
screenXY testCube(i), screenTest(i) ' take a corner x,y,z and convert to screen coordinates x,y
'PRINT screenTest(i).x, screenTest(i).y
Next
drawWireCube screenTest() ' draw cube from screen coodinates
End If
Next y, x, z
_Display
_Limit 2
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 > 5) And (mm < 12) Then
U2(x, y, z) = 1
ElseIf U(x, y, z) = 1 And mm < 10 And mm > 5 Then
U2(x, y, z) = 1
Else
U2(x, y, z) = 0
End If
Next y, x, 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)
'this code decides if x,y,z on real map is in square cone of vision
'DIM SHARED zmin, zmax, xmin, xmax, ymin, ymax 'move to top
'zmin = -50: zmax = -1
'xmin = -50: xmax = 50
'ymin = -50: ymax = 50
Function xyzInView (test As xyzType)
If test.z >= zmin And test.z <= zmax Then
If Abs(test.x) <= .5 * Abs(test.z) Then
If Abs(test.y) <= .5 * Abs(test.z) Then xyzInView = -1
End If
End If
End Function
'bring this in for testing xyzInView
Function irnd% (n1, n2) 'return an integer between 2 numbers
Dim l%, h%
If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
irnd% = Int(Rnd * (h% - l% + 1)) + l%
End Function
' ========================================================================= 2019-11-20 code
Sub drawWireCube (corners() As xyType)
'front face
Line (corners(0).x, corners(0).y)-(corners(1).x, corners(1).y)
Line -(corners(2).x, corners(2).y)
Line -(corners(3).x, corners(3).y)
Line -(corners(0).x, corners(0).y)
'back face
Line (corners(4).x, corners(4).y)-(corners(5).x, corners(5).y), _DefaultColor - _RGB32(50, 50, 0)
Line -(corners(6).x, corners(6).y), _DefaultColor - _RGB32(50, 50, 0)
Line -(corners(7).x, corners(7).y), _DefaultColor - _RGB32(50, 50, 0)
Line -(corners(4).x, corners(4).y), _DefaultColor - _RGB32(50, 50, 0)
'connect front to back
Line (corners(0).x, corners(0).y)-(corners(4).x, corners(4).y), _DefaultColor - _RGB32(25, 25, 0)
Line (corners(1).x, corners(1).y)-(corners(5).x, corners(5).y), _DefaultColor - _RGB32(25, 25, 0)
Line (corners(2).x, corners(2).y)-(corners(6).x, corners(6).y), _DefaultColor - _RGB32(25, 25, 0)
Line (corners(3).x, corners(3).y)-(corners(7).x, corners(7).y), _DefaultColor - _RGB32(25, 25, 0)
End Sub
Sub newCube (cx, cy, cz, side, cubeCorners() As xyzType)
Dim sd2, lx, rx, ty, by, fz, bz
ReDim cubeCorners(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
cubeCorners(0).x = lx: cubeCorners(0).y = ty: cubeCorners(0).z = fz
cubeCorners(1).x = rx: cubeCorners(1).y = ty: cubeCorners(1).z = fz
cubeCorners(2).x = rx: cubeCorners(2).y = by: cubeCorners(2).z = fz
cubeCorners(3).x = lx: cubeCorners(3).y = by: cubeCorners(3).z = fz
cubeCorners(4).x = lx: cubeCorners(4).y = ty: cubeCorners(4).z = bz
cubeCorners(5).x = rx: cubeCorners(5).y = ty: cubeCorners(5).z = bz
cubeCorners(6).x = rx: cubeCorners(6).y = by: cubeCorners(6).z = bz
cubeCorners(7).x = lx: cubeCorners(7).y = by: cubeCorners(7).z = bz
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)
'convert STxAxTIC's code to my code here
' https://www.qb64.org/forum/index.php?topic=1904.msg111304#msg111304
' vec3Ddotnhat = vec(i, 1) * nhat(1) + vec(i, 2) * nhat(2) + vec(i, 3) * nhat(3)
' vec2D(i, 1) = (vec(i, 1) * uhat(1) + vec(i, 2) * uhat(2) + vec(i, 3) * uhat(3)) * fovd / vec3Ddotnhat
' vec2D(i, 2) = (vec(i, 1) * vhat(1) + vec(i, 2) * vhat(2) + vec(i, 3) * vhat(3)) * fovd / vec3Ddotnhat
'my comments and conversion
'fovd seems like a variable that should be globally shared, maybe constant?
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
'================================================= subs and fuctions from Vector Math.bas 2019-10-20
Sub setV3 (x, y, z, setMe As xyzType)
setMe.x = x: setMe.y = y: setMe.z = z
End Sub
Function v3$ (showMeInnards As xyzType)
v3$ = "[" + ts$(showMeInnards.x) + ", " + ts$(showMeInnards.y) + ", " + ts$(showMeInnards.z) + "]"
End Function
Function ts$ (number)
ts$ = _Trim$(Str$(number))
End Function
'notation UppercaseLetter w/arrowhat + uppercase Letter w/arrowHat
Sub v2Add (A As xyType, B As xyType, Sum As xyType)
Sum.x = A.x + B.x
Sum.y = A.y + B.y
End Sub
Sub v3Add (A As xyzType, B As xyzType, Sum As xyzType)
Sum.x = A.x + B.x
Sum.y = A.y + B.y
Sum.z = A.z + B.z
End Sub
'notation UppercaseLetter w/arrowHat - UppercaseLetter w/arrowHat
Sub v2Subtr (A As xyType, B As xyType, Sum As xyType)
Sum.x = A.x - B.x
Sum.y = A.y - B.y
End Sub
Sub v3Subtr (A As xyzType, B As xyzType, Sum As xyzType)
Sum.x = A.x - B.x
Sum.y = A.y - B.y
Sum.z = A.z - B.z
End Sub
'notation lowercaseletter (for a number next to (times)) UppercaseLetter w/arrowHat
Sub v2Scale (mult As Single, A As xyType, Scale As xyType) 'parallels
Scale.x = mult * A.x
Scale.y = mult * A.y
End Sub
Sub v3Scale (mult As Single, A As xyzType, Scale As xyzType) 'parallels
Scale.x = mult * A.x
Scale.y = mult * A.y
Scale.z = mult * A.z
End Sub
'notation the inverse of A w/arrowHat is -A w/arrowHat
Sub v2Inverse (A As xyType, Inverse As xyType) ' A + InverseOfA = 0
Inverse.x = -A.x
Inverse.y = -A.y
End Sub
Sub v3Inverse (A As xyzType, Inverse As xyzType) ' A + InverseOfA = 0
Inverse.x = -A.x
Inverse.y = -A.y
Inverse.z = -A.z
End Sub
'notation: A w/arrowHat Dot B w/arrowHat v2 Dot Product is a number, v3 Dot Product is a vector
Function v2DotProduct (A As xyType, B As xyType) 'shadow or projection if A Dot B = 0 then A , B are perpendicular
v2DotProduct = A.x * B.x + A.y * B.y
End Function
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
'notation absolute value bars about A w/arrowHat OR just an UppercaseLetter (with no hat), its just a number
Function v2Magnitude (A As xyType) 'hypotenuse of right triangle
v2Magnitude = Sqr(v2DotProduct(A, A))
End Function
Function v3Magnitude (A As xyzType) 'hypotenuse of cube
v3Magnitude = Sqr(v3DotProduct(A, A))
End Function
'notation: A w/arrowHat X B w/arrowHat, X is a Cross get it?
Function v2CrossProduct (A As xyType, B As xyType) ' a vector perpendicular to both A and B, v2 is a magnitude
v2CrossProduct = A.x * B.y - A.y * B.x
End Function
Sub v3CrossProduct (A As xyzType, B As xyzType, Cross As xyzType) ' v3 cross product is a 3d vector perpendicular to A and B
'notice x has no x components, y no y componets, z no z components
Cross.x = A.y * B.z - A.z * B.y
Cross.y = A.z * B.x - A.x * B.z
Cross.z = A.x * B.y - A.y * B.x
End Sub
'notation: A w/caratHat = A w/arrowHat divided by A (UppercaseLetter) or scaled by 1/A magnitude (no hats)
Sub v2Unit (A As xyType, Unit As xyType)
Dim m As Single
m = v2Magnitude(A)
v2Scale 1 / m, A, Unit
End Sub
Sub v3Unit (A As xyzType, Unit As xyzType)
Dim m As Single
m = v3Magnitude(A)
v3Scale 1 / m, A, Unit
End SubSo with that successful proof of concept of 3D "Game" I set out to clothe the wire frame cubes with walls.
I don't think I tried _MapTriangle directly because I think you need another image source to transfer to _MapTriangle destination or output. I was testing with several Triangle Fill routines that use _MapTriangle:
Code: (Select All)
'' BEST saves dest and optimized with Static a& and alpha colors work better
'2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
' steves latest version to check out
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
' my original fTri that never had a problem with
' found at QB64.net: http://www.qb64.net/forum/index.php?topic=14425.0
Sub ftri0 (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long, a&
D = _Dest
a& = _NewImage(1, 1, 32)
_Dest a&
PSet (0, 0), K
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage a& '<<< this is important!
End Sub
'Andy Amaya's triangle fill modified for QB64, use if color already set
Sub filltri (xx1, yy1, xx2, yy2, xx3, yy3)
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single
Dim slope1 As Single, slope2 As Single, length As Single, x As Single, lastx%, y As Single
Dim slope3 As Single
'make copies before swapping
x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
'triangle coordinates must be ordered: where x1 < x2 < x3
If x2 < x1 Then Swap x1, x2: Swap y1, y2
If x3 < x1 Then Swap x1, x3: Swap y1, y3
If x3 < x2 Then Swap x2, x3: Swap y2, y3
If x1 <> x3 Then slope1 = (y3 - y1) / (x3 - x1)
'draw the first half of the triangle
length = x2 - x1
If length <> 0 Then
slope2 = (y2 - y1) / length
For x = 0 To length
Line (Int(x + x1), Int(x * slope1 + y1))-(Int(x + x1), Int(x * slope2 + y1))
lastx% = Int(x + x1)
Next
End If
'draw the second half of the triangle
y = length * slope1 + y1: length = x3 - x2
If length <> 0 Then
slope3 = (y3 - y2) / length
For x = 0 To length
If Int(x + x2) <> lastx% Then
Line (Int(x + x2), Int(x * slope1 + y))-(Int(x + x2), Int(x * slope3 + y2))
End If
Next
End If
End SubTried 1st 2 and Andy Amaya's last. BUT I also rewrote a section of main code that draws the wire cube after running x,y,z of array calc the 8 corners and then convert the xyz corners to screenXY coordinates for poits to draw lines from:
It was from that subroutine I starte to convert the wireframe lines to solid walls with 2 triangles each for the 4 point face/wall.
Code: (Select All)
Sub drawCube (cx, cy, cz, side, colr~&)
Dim As Integer i
Dim sd2, lx, rx, ty, by, fz, bz
Dim c2~&
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
'Print corners(i).x, corners(i).y, xy(i).x, xy(i).y
Next
'back face
'Line (corners(4).x, corners(4).y)-(corners(5).x, corners(5).y), _DefaultColor - _RGB32(50, 50, 0)
'Line -(corners(6).x, corners(6).y), _DefaultColor - _RGB32(50, 50, 0)
'Line -(corners(7).x, corners(7).y), _DefaultColor - _RGB32(50, 50, 0)
'Line -(corners(4).x, corners(4).y), _DefaultColor - _RGB32(50, 50, 0)
'connect front to back
Line (xy(0).x, xy(0).y)-(xy(4).x, xy(4).y), colr~& ' - _RGB32(25, 25, 0)
Line (xy(1).x, xy(1).y)-(xy(5).x, xy(5).y), colr~& ' - _RGB32(25, 25, 0)
Line (xy(2).x, xy(2).y)-(xy(6).x, xy(6).y), colr~& '- _RGB32(25, 25, 0)
Line (xy(3).x, xy(3).y)-(xy(7).x, xy(7).y), colr~& '- _RGB32(25, 25, 0)
Color colr~&
' Triangles not working!!!
filltri xy(0).x, xy(0).y, xy(3).x, xy(3).y, xy(7).x, xy(7).y
filltri xy(4).x, xy(4).y, xy(7).x, xy(7).y, xy(0).x, xy(0).y
filltri -2, 2, -1, 2, -2, 0
'front face
Line (xy(0).x, xy(0).y)-(xy(1).x, xy(1).y), colr~&
Line -(xy(2).x, xy(2).y), colr~&
Line -(xy(3).x, xy(3).y), colr~&
Line -(xy(0).x, xy(0).y), colr~&
End Sub
b = b + ...