Here is revised Pyramid 2 test, i went on and got Cubes working and came back and fixd code to be consistent with it.
Note: use square screen so WINDOW statement is easy. Otherwise you have to figure same ratio of screen sides in the Window corners.
And now here is Cube test 1:
Note: use square screen so WINDOW statement is easy. Otherwise you have to figure same ratio of screen sides in the Window corners.
Code: (Select All)
_Title "3D per Parallelism test 2 Pyramid" 'b+ 2024-02-20
' "parallelism suggests a connection of meaning through an echo of form"
' 2024-02-21 screw around with pyramid numbers, did cube 1 and came back
' and fixed this to match.
Dim Shared As Long SW, SH: SW = 600: SH = 600
Screen _NewImage(SW, SH, 32) ' note: square screen make it easier to set Window command
_ScreenMove 340, 60
Type XYZ
As Double x, y, z
End Type
Type XY
As Double x, y
End Type
Dim Shared As Double PC: PC = .35 ' or something PC = Parallel Constant
Window (-2, -2)-(2, 2)
' pyramid with square base and 4 iso-tri's to apex
Dim p3(1 To 5) As XYZ
Dim p2(1 To 5) As XY
' use all positive x, y, z in 3D Model
p3(1).x = 0: p3(1).y = 1: p3(1).z = 0 ' apex
p3(2).x = -1: p3(2).y = -1: p3(2).z = -1 ' back L
p3(3).x = 1: p3(3).y = -1: p3(3).z = -1 ' back R
p3(4).x = 1: p3(4).y = -1: p3(4).z = 1 ' front R
p3(5).x = -1: p3(5).y = -1: p3(5).z = 1 ' front L
' now draw the thing! and find ideal PC = Parallel Constant
While _KeyDown(27) = 0
kh& = _KeyHit
If kh& = 44 Then PC = PC - .001
If kh& = 46 Then PC = PC + .001
' recalc new array
For i = 1 To 5
Project p3(i), p2(i) ' that was easy now draw the thing!
Next
Cls
Locate 2: Print " Here, the 3D Model height at apex is same as a side at the base."
Locate 4: Print " Press <, = less, >. = more When does the base look square? PC ="; PC
Locate 6: Print " Oh! PC is the Parallel Constant for this very simple 3D system."
' base
Line (p2(2).x, p2(2).y)-(p2(3).x, p2(3).y), &HFFFF0000 ' back line base
Line (p2(3).x, p2(3).y)-(p2(4).x, p2(4).y), &HFFFFFFFF ' right side
Line (p2(4).x, p2(4).y)-(p2(5).x, p2(5).y), &HFFFFFFFF ' front front
Line (p2(5).x, p2(5).y)-(p2(2).x, p2(2).y), &HFFFF0000 ' left side
Line (p2(1).x, p2(1).y)-(p2(2).x, p2(2).y), &HFFFF0000 ' Back L
Line (p2(1).x, p2(1).y)-(p2(3).x, p2(3).y), &HFFFFFFFF ' Back R
Line (p2(1).x, p2(1).y)-(p2(4).x, p2(4).y), &HFFFFFFFF ' Front R
Line (p2(1).x, p2(1).y)-(p2(5).x, p2(5).y), &HFFFFFFFF ' Front L
_PrintString (PMap(p2(1).x, 0) - 4, PMap(p2(1).y, 1) - 17), "1" ' apex
_PrintString (PMap(p2(2).x, 0) - 10, PMap(p2(2).y, 1) + 4), "2" ' Front L
_PrintString (PMap(p2(3).x, 0) + 4, PMap(p2(3).y, 1) + 4), "3" ' Front R
_PrintString (PMap(p2(4).x, 0) - 4, PMap(p2(4).y, 1) + 8), "4" ' Back R
_PrintString (PMap(p2(5).x, 0) - 4, PMap(p2(5).y, 1) + 8), "5" ' Back L
Locate 35, 15
Print "Now the lower the z the farther back in the image."
_Display
Wend
' thankyou vince '2024-02 mod to always draw right side and upper face
Sub Project (pIN As XYZ, pOut As XY) 'M2SPP = Model (3D) 2 Screen Per Parallelism
pOut.x = pIN.x - PC * pIN.z
pOut.y = pIN.y - PC * pIN.z
End SubAnd now here is Cube test 1:
Code: (Select All)
_Title "3D per Parallelism test Cube 1" ' started Parallelism b+ 2024-02-20
' "parallelism suggests a connection of meaning through an echo of form"
' 2024-02-21 Pyramid 2 screw around with pyramid numbers fix projection formula
' 2024-02-21 now test cubes with DrawCube sub
' 2024-02-21 return to Pyramid 2 and fix that according to how this Project sub works.
Dim Shared As Long SW, SH: SW = 600: SH = 600
Screen _NewImage(SW, SH, 32)
_ScreenMove 340, 60
Type XYZ
As Single x, y, z
End Type
Type XY
As Single x, y
End Type
Dim Shared PC: PC = .35 ' or something PC = Parallel Constant
Window (-5, -5)-(5, 5) ' setup for 3D
drawCube 0, 0, -2, 2, _RGB32(0, 160, 0)
drawCube 0, -2, 0, 2, _RGB32(0, 0, 255)
drawCube -2, 0, 0, 2, _RGB32(255, 0, 0)
'drawCube 0, 0, 0, 2, _RGB32(255, 255, 255) ' dont need
drawCube 2, 0, 0, 2, _RGB32(255, 0, 0)
drawCube 0, 2, 0, 2, _RGB32(0, 0, 255)
drawCube 0, 0, 2, 2, _RGB32(0, 160, 0) ' front most
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 XYZ
sd2 = side / 2
rx = cx + sd2: lx = cx - sd2
ty = cy + sd2: by = cy - sd2
fz = cz + sd2: bz = cz - sd2
'bck face
corners(0).x = lx: corners(0).y = ty: corners(0).z = bz
corners(1).x = rx: corners(1).y = ty: corners(1).z = bz
corners(2).x = rx: corners(2).y = by: corners(2).z = bz
corners(3).x = lx: corners(3).y = by: corners(3).z = bz
'frt face
corners(4).x = lx: corners(4).y = ty: corners(4).z = fz
corners(5).x = rx: corners(5).y = ty: corners(5).z = fz
corners(6).x = rx: corners(6).y = by: corners(6).z = fz
corners(7).x = lx: corners(7).y = by: corners(7).z = fz
ReDim xy(0 To 7) As XY
For i = 0 To 7
Project corners(i), xy(i) ' take a corner x,y,z and convert to screen coordinates x,y
' Print i; corners(i).x; corners(i).y; corners(i).z; " >>> "; xy(i).x; xy(i).y
Next
'Sleep
'Cls
'back face
'Line (xy(0).x, xy(0).y)-(xy(1).x, xy(1).y), &HFFFF0000
'Line (xy(1).x, xy(1).y)-(xy(2).x, xy(2).y), colr~&
'Line (xy(2).x, xy(2).y)-(xy(3).x, xy(3).y), colr~&
'Line (xy(3).x, xy(3).y)-(xy(0).x, xy(0).y), colr~&
'front face
'Line (xy(4).x, xy(4).y)-(xy(5).x, xy(5).y), colr~&
'Line (xy(5).x, xy(5).y)-(xy(6).x, xy(6).y), colr~&
'Line (xy(6).x, xy(6).y)-(xy(7).x, xy(7).y), colr~&
'Line (xy(7).x, xy(7).y)-(xy(4).x, xy(4).y), colr~&
' left side of face
'If xy(0).x > 0 Then
' c2 = _RGB32(.6 * r, .6 * g, .6 * b)
' 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(.85 * r, .85 * g, .85 * b)
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(.6 * r, .6 * g, .6 * b)
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(45 * r, .45 * g, .45 * b)
' 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(4).x, 0), PMap(xy(4).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), colr~&
FillTriangle PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), PMap(xy(4).x, 0), PMap(xy(4).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
' here I am working with a Window so Screen obeys right hand rule so as z increases
' the image x, y plane is closer to the eye/camera so is bigger
' but should be distance squared
' thankyou vince '2024-02 the bigger the Z the closer it is to the eye the greater the image
Sub Project (pIN As XYZ, pOut As XY) 'M2SPP = Model (3D) 2 Screen Per Parallelism
pOut.x = pIN.x - PC * pIN.z
pOut.y = pIN.y - PC * pIN.z
End Sub
b = b + ...