02-16-2024, 01:40 AM
OK 3D rendered cubes in 4 quadrants at different z depths:
Code: (Select All)
Option _Explicit
_Title "3D Render: Game of Life 2" ' 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 ? successful proof of concept!!!
' 2024-02-12 try clothing wireframe cubes with walls with new DrawCube routine
' 2024-02-12 PMap didn't help converting x,y to _maptriangle in FTri
' 2024-02-15 I used wrong PMap functions convert to screen coordinates with _MapTriangle
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 '??? < play with until works for app
Dim Shared zmin, zmax, xmin, xmax, ymin, ymax
zmin = -32: zmax = -21
xmin = -3: xmax = 3
ymin = -3: ymax = 3
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 (code removed)
'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
' Just get some cubes frick'n walled!!!
'test draw cube at 4 different z depths
drawCube -3, 3, -15, 1, _RGB32(255, 0, 255)
drawCube 3, 3, -17, 1, _RGB32(255, 0, 0)
drawCube -3, -3, -19, 1, _RGB32(0, 255, 0)
drawCube 3, -3, -21, 1, _RGB32(0, 0, 255)
' 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 + ...