Game of Life again but by way of Parallelism

[bplus]

This time we start out with simple "Blinker" in the 2D version and see what becomes of it in 3D version per parallelism:

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

Dim Shared As Long SW, SH: SW = 720: SH = 720
Screen _NewImage(SW, SH, 32)
_ScreenMove 280, 0
Randomize Timer

Type XYZ
    As Single x, y, z
End Type
Type XY
    As Single x, y
End Type
Dim Shared PC: PC = .35 ' or something  PC = Parallel Constant
Window (-15, 35)-(35, -15) ' setup for 3D

' setup for Game of Life
Dim As Integer xmin, xmax, ymin, ymax, zmin, zmax
xmin = 1: xmax = 30: ymin = 1: ymax = 30: zmin = 1: zmax = 30
Dim As Integer x, y, z, r, g, b, mm, xx, yy, zz, rr, gg, bb, gen
Color &HFFDDDDFF, &HFF000000

ResetStart:
gen = 0
ReDim As Integer U(xmin To xmax, ymin To ymax, zmin To zmax), U2(xmin To xmax, ymin To ymax, zmin To zmax)
'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, x, z

'try a blinker
U(14, 15, 15) = 1: U(15, 15, 15) = 1: U(16, 15, 15) = 1
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... "
    r = rr: g = gg: b = bb
    For z = zmin + 1 To zmax - 1
        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)
                End If
        Next y, x
        _Display
        _Limit 30
    Next z
    _Display
    Sleep
    If _KeyDown(13) Then Cls: _Delay .5: GoTo ResetStart
    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 > 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, 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, x, z
    gen = gen + 1
Loop Until _KeyDown(27)

Sub drawCube (cx, cy, cz, side, colr~&) 'draw a cube on screen from an xyz() 3D array
    Dim As Integer i, r, g, b
    Dim sd2, lx, rx, ty, by, fz, bz
    Dim c2 As _Unsigned Long
    r = _Red32(colr~&): g = _Green32(colr~&): b = _Blue32(colr~&)
    ReDim corners(0 To 7) As XYZ
    sd2 = side / 2
    rx = cx + sd2: lx = cx - sd2
    ty = cy + sd2: by = cy - sd2
    fz = cz + sd2: bz = cz - sd2
    'bck face
    corners(0).x = lx: corners(0).y = ty: corners(0).z = bz
    corners(1).x = rx: corners(1).y = ty: corners(1).z = bz
    corners(2).x = rx: corners(2).y = by: corners(2).z = bz
    corners(3).x = lx: corners(3).y = by: corners(3).z = bz
    'frt face
    corners(4).x = lx: corners(4).y = ty: corners(4).z = fz
    corners(5).x = rx: corners(5).y = ty: corners(5).z = fz
    corners(6).x = rx: corners(6).y = by: corners(6).z = fz
    corners(7).x = lx: corners(7).y = by: corners(7).z = fz

    ReDim xy(0 To 7) As XY
    For i = 0 To 7
        Project corners(i), xy(i) ' take a corner x,y,z and convert to screen coordinates x,y
    Next

    '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(.85 * r, .85 * g, .85 * b)
    FillTriangle PMap(xy(0).x, 0), PMap(xy(0).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(4).x, 0), PMap(xy(4).y, 1), c2
    FillTriangle PMap(xy(4).x, 0), PMap(xy(4).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), c2

    ' right face
    c2 = _RGB32(.6 * r, .6 * g, .6 * b)
    FillTriangle PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), c2
    FillTriangle PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), c2

    ' front face
    FillTriangle PMap(xy(4).x, 0), PMap(xy(4).y, 1), PMap(xy(5).x, 0), PMap(xy(5).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), colr~&
    FillTriangle PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), PMap(xy(4).x, 0), PMap(xy(4).y, 1), colr~&

End Sub

' steves latest version to check out, seems to be working OK
Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    $Checking:Off
    Static a&, m As _MEM
    If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
    _MemPut m, m.OFFSET, K
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    $Checking:On
End Sub

' here I am working with a Window so Screen obeys right hand rule so as z increases
' the image x, y plane is closer to the eye/camera so is bigger
' but should be distance squared
' thankyou vince '2024-02  the bigger the Z the closer it is to the eye the greater the image
Sub Project (pIN As XYZ, pOut As XY) 'M2SPP = Model (3D) 2 Screen Per Parallelism
    pOut.x = pIN.x - PC * pIN.z
    pOut.y = pIN.y - PC * pIN.z
End Sub

It's Alive! well at least until it blows it's symmetry
   

[bobalooie]

That's slick.

[Pete]

It looks like The Borg booked another Tony Robbins seminar. Everyone remember where we parked.

Pete