Does _MapTriangle work in a user defined Window?

[bplus]

i am using some old 3D rendering code from Stax who insists on Cartesian style coordinate system and build all vector routines around that so to use them I have to use Window call. Works fine for points and lines but I am having big problems with _MapTriangle ie nothing is getting drawn but no errors either.

[MasterGy]

i am using some old 3D rendering code from Stax who insists on Cartesian style coordinate system and build all vector routines around that so to use them I have to use Window call. Works fine for points and lines but I am having big problems with _MapTriangle ie nothing is getting drawn but no errors either.

if I can take a look to see if we can find the error

[bplus]

OK I will try to simplify code and comment down to what is exactly needed and remove all the swearing from my frustration yesterday I tried 3 different routines for Triangle fills Andy Amaya's actually drew a dot and a line but no triangle, _MapTriangle versions of fill triangle did not draw anything!

[bplus]

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.

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 Sub

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:

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 Sub

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.

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

[bplus]

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

[bplus]

So the simple answer is NO _Maptriangle does not work in a Windowed Screen.

[James D Jarvis]

It'll map to it, it just totally ignores the updated window coordinates. (unless I'm doing something really wrong here)

Code: (Select All)

Dim tex As Long

Dim ms As Long

ms = _NewImage(500, 400, 32)

tex = _NewImage(20, 20, 32)

Randomize Timer

Screen ms

_Dest tex

For y = 0 To 19: For x = 0 To 19

        PSet (x, y), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))

Next: Next

_Dest ms

Window Screen(-100, -100)-(100, 100)

For py = 0 To 400 Step 20: For px = 0 To 300 Step 20:

        _MapTriangle (0, 0)-(19, 0)-(19, 19), tex To(px, py)-(px + 19, py)-(px + 19, py + 19), ms

        _MapTriangle (0, 0)-(0, 19)-(19, 19), tex To(px, py)-(px, py + 19)-(px + 19, py + 19), ms

Next: Next



Line (-40, -40)-(40, 40), _RGB32(100, 100, 0), BF 'making sure the window instruxctions worked

PSet (0, 0), _RGB32(200, 200, 200)

[bplus]

Thanks James, I think you proved what I said.

It works, but wrongly!
So honestly it, _MapTriangle, doesn't work with Window points as we need it to work like it does with lines and points.

[bplus]

Oh wait! Never say never...

Just create a function or two for converting x, y of to the Window system coordinates like QB64 does automatically for Pset and Line, in fact Pmap does it for mouse x, y.

I have an experiment for tonight.

Update: Nope! man I thought it should do the trick.

[MasterGy]

unfortunately, I cannot adapt to the above program. I don't use '_mem'. I don't understand why it is so. I can't help you on that thread

If you want to display a cube/brick simply, I have put together a quick solution for you. you can use the size (width, length, height), position and rotation of the blocks.

Code: (Select All)

'creating hardware images of different colors (you can also use loadimage(...,33) . These will be the sides of the brick

temp = _NewImage(1, 1, 32): _Dest temp: PSet (0, 0), _RGB32(255, 0, 0): t1 = _CopyImage(temp, 33): _FreeImage temp

temp = _NewImage(1, 1, 32): _Dest temp: PSet (0, 0), _RGB32(0, 255, 0): t2 = _CopyImage(temp, 33): _FreeImage temp

temp = _NewImage(1, 1, 32): _Dest temp: PSet (0, 0), _RGB32(0, 0, 255): t3 = _CopyImage(temp, 33): _FreeImage temp

temp = _NewImage(1, 1, 32): _Dest temp: PSet (0, 0), _RGB32(255, 0, 255): t4 = _CopyImage(temp, 33): _FreeImage temp

temp = _NewImage(1, 1, 32): _Dest temp: PSet (0, 0), _RGB32(255, 255, 0): t5 = _CopyImage(temp, 33): _FreeImage temp

temp = _NewImage(1, 1, 32): _Dest temp: PSet (0, 0), _RGB32(0, 255, 255): t6 = _CopyImage(temp, 33): _FreeImage temp





sc = _NewImage(800, 800, 32): Screen sc: _Dest sc



'draw_cube params

'values 1,2,3 are the coordinate points

'values 4,5,6 are the dimensions of the brick (width, length, height)

'values 7-12 you will draw these harweres textures on the side of the brick

'13 angle, rotating XY plane

'14 angle, rotating XZ plane







Do: _Limit 30



    draw_brick 10, 10, -50, 5, 5, 5, t1, t2, t3, t4, t5, t6, 0, 0

    draw_brick -10, 10, -50, 5, 5, 5, t1, t2, t3, t4, t5, t6, 0, 0

    draw_brick 10, -10, -50, 5, 5, 5, t1, t2, t3, t4, t5, t6, rotating, 0

    draw_brick -10, -10, -50, 5, 5, 10, t1, t2, t3, t4, t5, t6, 0, rotating

    rotating = rotating + .1

    _Display



Loop













Sub draw_brick (x, y, z, sizex, sizey, sizez, t0, t1, t2, t3, t4, t5, rota, rotb)

    Dim c(2): c(0) = x: c(1) = y: c(2) = z

    Dim size(2): size(0) = sizex: size(1) = sizey: size(2) = sizez

    Dim t(5): t(0) = t0: t(1) = t1: t(2) = t2: t(3) = t3: t(4) = t4: t(5) = t5

    Dim p(3, 2), pc(7, 2), sq(3) As _Unsigned _Byte



    For t = 0 To 7

        For c = 0 To 2: pc(t, c) = size(c) * (Sgn(t And 2 ^ c) * 2 - 1): Next c

        rotate_2d pc(t, 0), pc(t, 1), rota

        rotate_2d pc(t, 0), pc(t, 2), rotb

        For c = 0 To 2: pc(t, c) = pc(t, c) + c(c): Next c

    Next t



    For t = 0 To 5

        For q = 0 To 3: s = Val(Mid$("-0246-1357-0145-2367-0123-4567", 2 + t * 5 + q, 1))

        For b = 0 To 2: p(q, b) = pc(s, b): Next b, q

        wtext = _Width(t(t)) - 1: htext = _Height(t(t)) - 1

        _MapTriangle (0, 0)-(wtext, 0)-(0, htext), t(t) To(p(0, 0), p(0, 1), p(0, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth

        _MapTriangle (wtext, htext)-(wtext, 0)-(0, htext), t(t) To(p(3, 0), p(3, 1), p(3, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth

    Next t

End Sub



Sub rotate_2d (x, y, ang): x1 = x * Cos(ang) - y * Sin(ang): y1 = x * Sin(ang) + y * Cos(ang): x = x1: y = y1: End Sub