(11-16-2024, 08:18 PM)bplus Wrote: Ah the simplification of Parallelism was that all cubes are same size, front or back so they easy can sit adjacent to each other without major math calculations. The 3D effect was from shading cube sides and from drawing cubes in front after all the ones in back were drawn, drawn back to front (but you'd need to do that with regular 3D too I imagine).Yep. I'm not too great at the math you'd need to adjust the parallelism to skew the angles as the cubes get closer, maybe someone can look at this and help.
(My attempt at doing that is at line 187.)
I did do some tests and fixed the part that shifts the right eye images to the right as they get closer (it was totally wrong before).
Here is the latest version...
Code: (Select All)
_Title "3D per Parallelism test Game of Life - hold enter to reset" ' 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.
' 2024-02-22 test Game of Life code from thisversion of DrawCube
' Ah! apply some tips I learned with 3D Rendering of Game of Life
' 2024-12-15 Madscijr tried modifying it to draw everything in anaglyphic 3D
' per thread at https://qb64phoenix.com/forum/showthread.php?tid=3206
' 2024-12-15 Madscijr Fixed the logic that shifts the right eye image
' further to the right the closer to the viewer the cubes get.
' Still need to fix it to draw the perspective for the right eye
' to be from a little to the right as well (tried on line 187).
Const FALSE = 0
Const TRUE = Not FALSE
Const cMinZ = 1
Const cMaxZ = 30
' THESE ARE THE VALUES WE NEED TO FIND THE OPTIMAL VALUE FOR
' (MAY DEPEND ON HOW FAR AWAY FROM THE SCREEN YOU ARE SITTING?)
Const cMaxShift = 4 ' max pixels to shift right when closest to viewer
Const cAlpha = 54
Type XYZ
As Single x, y, z
End Type
Type XY
As Single x, y
End Type
Dim Shared As Long SW, SH
' setup for Game of Life
Dim As Integer xmin, xmax, ymin, ymax, zmin, zmax
Dim As Integer x, y, z, r, g, b, mm, xx, yy, zz
'Dim As Integer rr, gg, bb
Dim As Integer gen
ReDim As Integer U(-1 To -1, -1 To -1, -1 To -1), U2(-1 To -1, -1 To -1, -1 To -1)
SW = 720: SH = 720
xmin = 1: xmax = 30: ymin = 1: ymax = 30: zmin = cMinZ: zmax = cMaxZ
Screen _NewImage(SW, SH, 32)
_ScreenMove 280, 0
Randomize Timer
Window (-15, 35)-(35, -15) ' setup for 3D
Color &HFFDDDDFF, &HFF000000
ResetStart:
ReDim As Integer U(xmin To xmax, ymin To ymax, zmin To zmax), U2(xmin To xmax, ymin To ymax, zmin To zmax)
'' RANDOM TEST IMAGE
'For z = zmin + 10 To zmax - 10
' For x = xmin + 10 To xmax - 10
' For y = ymin + 10 To ymax - 10
' If Rnd > .9 Then U(x, y, z) = 1
' Next y
' Next x
'Next z
' TEST IMAGE TO TEST SKEWING
For z = zmin To zmax
U(15, 15, z) = 1
Next z
' -----------------------------------------------------------------------------
' INIT LIFE: try a blinker
'U(14, 15, 15) = 1: U(15, 15, 15) = 1: U(16, 15, 15) = 1
gen = 0
' RANDOMIZE COLORS?
rr = Rnd * 50 + 50: gg = Rnd * 50 + 50: bb = Rnd * 50 + 50
Do
Cls
_PrintString (10, 10), "Generation:" + Str$(gen) + " press any for next, escape to quit... "
' -----------------------------------------------------------------------------
' DRAW SCREEN
r = rr: g = gg: b = bb
For z = zmin + 1 To zmax - 1
'' CHANGE COLOR FARTHER AWAY?
'r = r * 1.04: g = g * 1.04: b = b * 1.04
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
If U(x, y, z) = 1 Then
'drawCube x, y, z, .9, _RGB32(r, g, b)
' first draw it in red (left eye)
drawCube x, y, z, .9, _RGB32(255, 0, 0), FALSE
' then draw it in cyan (right eye)
drawCube x, y, z, .9, _RGB32(0, 255, 255), TRUE
End If
Next y
Next x
_Display
_Limit 30
Next z
_Display
' -----------------------------------------------------------------------------
' PRESS A KEY TO CONTINUE
Sleep
' -----------------------------------------------------------------------------
' PRESS ENTER TO RESTART
If _KeyDown(13) Then Cls: _Delay .5: GoTo ResetStart
' -----------------------------------------------------------------------------
' GAME OF LIFE LOGIC
'IF TRUE=FALSE THEN
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
Next yy
Next xx
If (mm > 1) And (mm < 4) Then ' neighbors for birth
U2(x, y, z) = 1
ElseIf U(x, y, z) = 1 And mm = 3 Then ' neighbors to survive
U2(x, y, z) = 1
Else
U2(x, y, z) = 0
End If
Next y
Next x
Next 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
Next x
Next z
gen = gen + 1
'END IF
' -----------------------------------------------------------------------------
Loop Until _KeyDown(27)
' /////////////////////////////////////////////////////////////////////////////
Sub drawCube (cx, cy, cz, side, colr~&, bShift) '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
Dim PercentShift As Double ' Single
Dim PixelsRight
Dim PC ' PC = Parallel Constant
ReDim corners(0 To 7) As XYZ
ReDim xy(0 To 7) As XY
sd2 = side / 2
rx = (cx + sd2): lx = (cx - sd2)
ty = cy + sd2: by = cy - sd2
fz = cz + sd2: bz = cz - sd2
' if bShift=TRUE then shift right for the right eye image
If bShift = TRUE Then
' cz can be from zmin to zmin (1-30)
' use this value to determine how far right to shift cube
' (farther away = shift less far right, closer = shift farther right)
'
' So: what percent of (cMaxZ - cMinZ) is cz?
'PercentShift = cz / (cMaxZ - cMinZ)
'PixelsRight = Int(cMaxShift * PercentShift)
PercentShift = (cz / cMaxZ) * .4
PixelsRight = cMaxShift * PercentShift
'PixelsRight = cMaxZ - cz
'PC = .35
PC = .32 ' here is where we try to change right eye perspective a little?
Else
PixelsRight = 0
PC = .35
End If
'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
' take a corner x,y,z and convert to screen coordinates x,y
For i = 0 To 7
Project corners(i), xy(i), PC, PixelsRight
Next i
' GET RGB OF COLOR
r = _Red32(colr~&): g = _Green32(colr~&): b = _Blue32(colr~&)
'debug
'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~&
' top face
'c2 = _RGB32(.5 * r, .5 * g, .5 * b, 128)
c2 = _RGB32(.7 * r, .7 * g, .7 * b, cAlpha)
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
' right face
'c2 = _RGB32(.25 * r, .25 * g, .25 * b, 128)
c2 = _RGB32(.5 * r, .5 * g, .5 * b, cAlpha)
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
' front face
'c2 = _RGB32(.75 * r, .75 * g, .75 * b, 128)
c2 = _RGB32(.9 * r, .9 * g, .9 * b, cAlpha)
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), c2
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), c2
End Sub ' drawCube
' /////////////////////////////////////////////////////////////////////////////
' 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 ' FillTriangle
' /////////////////////////////////////////////////////////////////////////////
' 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
' PC = Parallel Constant
' M2SPP = Model (3D) 2 Screen Per Parallelism
Sub Project (pIN As XYZ, pOut As XY, PC, ShiftX)
pOut.x = (pIN.x - PC * pIN.z) + ShiftX
pOut.y = pIN.y - PC * pIN.z
End Sub ' Project
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%