+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://qb64phoenix.com/forum/forumdisplay.php?fid=10)
+---- Thread: Does _MapTriangle work in a user defined Window? (/showthread.php?tid=2443)
Pages:
1
2
Does _MapTriangle work in a user defined Window? - bplus - 02-13-2024
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.
RE: Does _MapTriangle work in a user defined Window? - MasterGy - 02-13-2024
(02-13-2024, 03:30 PM)bplus Wrote: 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
RE: Does _MapTriangle work in a user defined Window? - bplus - 02-13-2024
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!
RE: Does _MapTriangle work in a user defined Window? - bplus - 02-13-2024
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 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 SubRE: Does _MapTriangle work in a user defined Window? - bplus - 02-13-2024
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 SubRE: Does _MapTriangle work in a user defined Window? - bplus - 02-15-2024
So the simple answer is NO _Maptriangle does not work in a Windowed Screen.
RE: Does _MapTriangle work in a user defined Window? - James D Jarvis - 02-15-2024
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)RE: Does _MapTriangle work in a user defined Window? - bplus - 02-15-2024
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.
RE: Does _MapTriangle work in a user defined Window? - bplus - 02-15-2024
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.
RE: Does _MapTriangle work in a user defined Window? - MasterGy - 02-15-2024
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