Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Does _MapTriangle work in a user defined Window?
#5
I was just trying to get some test cubes walled! 4 cubes in the cube space of U(x,y,z) array = Universe
Line points look right but no luck getting any solid fill triangles for wall, I was just trying the one wall on left face of cubes... BTW I commented out the back wall or face of cube because the other 5 walls are sure to block it out.

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


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 ?


' 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
drawCube -3, 3, -25, 2, _RGB32(255, 0, 255)
drawCube 3, 3, -25, 2, _RGB32(255, 0, 0)
drawCube -3, -3, -25, 2, _RGB32(0, 255, 0)
drawCube 3, -3, -25, 2, _RGB32(0, 0, 255)
Sleep
End



'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


'' ========================================================================= old 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

' new 2024-02-12 testing with above code
Sub drawCube (cx, cy, cz, side, colr~&)
    Dim As Integer i
    Dim sd2, lx, rx, ty, by, fz, bz

    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


        ' debug check corner coordinates look fine!!!
        ' 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)


    ' Triangles not working!!!

    ' andy amayas get line and dot
    'Color colr~&
    '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 ' line and dot but nothing from above

    ' nada here too!
    'ftri0 xy(0).x, xy(0).y, xy(3).x, xy(3).y, xy(7).x, xy(7).y, colr~&
    'ftri0 xy(4).x, xy(4).y, xy(7).x, xy(7).y, xy(0).x, xy(0).y, colr~&

    'nope!
    'ftri xy(0).x, xy(0).y, xy(3).x, xy(3).y, xy(7).x, xy(7).y, colr~&
    'ftri xy(4).x, xy(4).y, xy(7).x, xy(7).y, xy(0).x, xy(0).y, colr~&

    ' no again
    FillTriangle xy(0).x, xy(0).y, xy(3).x, xy(3).y, xy(7).x, xy(7).y, colr~&
    FillTriangle xy(4).x, xy(4).y, xy(7).x, xy(7).y, xy(0).x, xy(0).y, colr~&


    '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


'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 Sub

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

''   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

' 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

' 2019 Stax 3D rendering setup code routines  ======================================================
' goes with many lines at start of prgram

'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 Sub
b = b + ...
Reply


Messages In This Thread
RE: Does _MapTriangle work in a user defined Window? - by bplus - 02-13-2024, 07:25 PM



Users browsing this thread: 2 Guest(s)