3D rendering of Game of Life by ubi44

[bplus]

This code is far too good to NOT share here, but to be clear I did not write this, it comes from avatar name ubi44.

Code: (Select All)

Screen _NewImage(640, 488, 32)
_AllowFullScreen _SquarePixels
_FullScreen _SquarePixels , _Smooth
Dim As Integer MAX, MAX2

start:
MAX = 25 + Int(Rnd * 25): MAX2 = MAX / 2
ReDim U(MAX, MAX, MAX) As _Byte
ReDim U2(MAX, MAX, MAX) As _Byte

MoveZ = -MAX2 / 2
rand = (Rnd - Rnd * .25) * .2
Randomize Timer
t = 0
For x = 1 To MAX - 1
    For y = 1 To MAX - 1
        For z = 1 To MAX - 1
            If Rnd < .5 + rand Then U(x, y, z) = 1: t = t + 1 Else U(x, y, z) = -1
Next z, y, x
Dim Shade(255) As Long
For c = 0 To 255
    i& = _NewImage(1, 1, 32)
    _Dest i&
    Line (0, 0)-(_Width(i&), _Height(i&)), _RGB(c, c, c), BF
    Shade(c) = _CopyImage(i&, 33)
    _FreeImage i&
Next c
Do
    TEX = .4 - (MoveZ + 10.5) * .001
    If _FullScreen Then _MouseHide Else _MouseShow
    If _KeyDown(18432) Then MoveZ = MoveZ - 1
    If _KeyDown(20480) Then MoveZ = MoveZ + 1
    Cls
    frames% = frames% + 1
    If oldtime$ <> Time$ Then
        fps = frames%
        frames% = 1
        oldtime$ = Time$
    End If
    _Limit 10
    Color _RGB(0, 0, 0), _RGB(200, 200, 200)
    Print t; " first gen cell alive "; b; "live cell at now!"
    Color _RGB(0, 0, 0), _RGB(227, 227, 227)
    Print "up down arrow key to move forward or backward"
    Color _RGB(0, 0, 0), _RGB(255, 255, 255)
    Print "space to restart || current grid:"; MAX; "^3"
    Color _RGB(255, 255, 255), _RGB(0, 0, 0)
    a = a + (fps) / 160
    If a > 360 Then a = 0
    cos1 = Cos(a)
    sin1 = Sin(a)

    For x = 1 To MAX - 1
        For y = 1 To MAX - 1
            For z = 1 To MAX - 1
                If U(x, y, z) = 1 Then
                    'set up cube
                    ix = (x - MAX2) - TEX: iy = (y - MAX2) - TEX: iz = (z - MAX2) - TEX
                    jx = (x - MAX2) + TEX: jy = (y - MAX2) - TEX: jz = (z - MAX2) - TEX
                    kx = (x - MAX2) + TEX: ky = (y - MAX2) + TEX: kz = (z - MAX2) - TEX
                    lx = (x - MAX2) - TEX: ly = (y - MAX2) + TEX: lz = (z - MAX2) - TEX

                    mx = (x - MAX2) - TEX: my = (y - MAX2) - TEX: mz = (z - MAX2) + TEX
                    nx = (x - MAX2) + TEX: ny = (y - MAX2) - TEX: nz = (z - MAX2) + TEX
                    ox = (x - MAX2) + TEX: oy = (y - MAX2) + TEX: oz = (z - MAX2) + TEX
                    px = (x - MAX2) - TEX: py = (y - MAX2) + TEX: pz = (z - MAX2) + TEX
                    'rotation x/z
                    ax = (ix) * cos1 - (iz) * sin1 '
                    az = (ix) * sin1 + (iz) * cos1 '
                    ay = iy
                    bx = (jx) * cos1 - (jz) * sin1
                    bz = (jx) * sin1 + (jz) * cos1 '
                    by = jy
                    cx = (kx) * cos1 - (kz) * sin1
                    cz = (kx) * sin1 + (kz) * cos1 '
                    cy = ky
                    dx = (lx) * cos1 - (lz) * sin1
                    dz = (lx) * sin1 + (lz) * cos1 '
                    dy = ly

                    ex = (mx) * cos1 - (mz) * sin1
                    ez = (mx) * sin1 + (mz) * cos1 '
                    ey = my
                    fx = (nx) * cos1 - (nz) * sin1
                    fz = (nx) * sin1 + (nz) * cos1 '
                    fy = ny
                    gx = (ox) * cos1 - (oz) * sin1 '
                    gz = (ox) * sin1 + (oz) * cos1 '
                    gy = oy
                    hx = (px) * cos1 - (pz) * sin1
                    hz = (px) * sin1 + (pz) * cos1 '
                    hy = py

                    'front
                    push = -(MAX + MAX2 + MoveZ)
                    u = checkV(ax, ay, az - push, bx, by, bz - push, dx, dy, dz - push)
                    If u > 0 Then
                        col% = maxi((205 - (((dz + MAX2)) / MAX) * 205) * u + 25)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(ax, ay, -az + push)-(bx, by, -bz + push)-(dx, dy, -dz + push)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(bx, by, -bz + push)-(cx, cy, -cz + push)-(dx, dy, -dz + push)
                    End If
                    'back
                    u = checkV(hx, hy, hz - push, fx, fy, fz - push, ex, ey, ez - push)
                    If u > 0 Then
                        col% = maxi((205 - (((fz + MAX2)) / MAX) * 205) * u + 25)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(ex, ey, -ez + push)-(fx, fy, -fz + push)-(hx, hy, -hz + push)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(fx, fy, -fz + push)-(gx, gy, -gz + push)-(hx, hy, -hz + push)
                    End If
                    'left
                    u = checkV(dx, dy, dz - push, ex, ey, ez - push, ax, ay, az - push)
                    If u > 0 Then
                        col% = maxi((205 - (((ez + MAX2)) / MAX) * 205) * (u) + 25)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(ax, ay, -az + push)-(ex, ey, -ez + push)-(dx, dy, -dz + push)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(ex, ey, -ez + push)-(hx, hy, -hz + push)-(dx, dy, -dz + push)
                    End If
                    ''right
                    u = checkV(fx, fy, fz - push, cx, cy, cz - push, bx, by, bz - push)
                    If u > 0 Then
                        col% = maxi((205 - (((fz + MAX2)) / MAX) * 205) * (u) + 25)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(bx, by, -bz + push)-(cx, cy, -cz + push)-(fx, fy, -fz + push)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(cx, cy, -cz + push)-(gx, gy, -gz + push)-(fx, fy, -fz + push)
                    End If
                    'up
                    u = checkV(bx, by, bz - push, ax, ay, az - push, ex, ey, ez - push)
                    If u > 0 Then
                        col% = maxi((205 - (((ez + MAX2)) / MAX) * 205) * (u) + 25)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(ax, ay, -az + push)-(bx, by, -bz + push)-(ex, ey, -ez + push)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(bx, by, -bz + push)-(ex, ey, -ez + push)-(fx, fy, -fz + push)
                    End If
                    'down
                    u = checkV(hx, hy, hz - push, dx, dy, dz - push, cx, cy, cz - push)
                    If u > 0 Then
                        col% = maxi((205 - (((hz + MAX2)) / MAX) * 205) * (u) + 25)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(cx, cy, -cz + push)-(dx, dy, -dz + push)-(hx, hy, -hz + push)
                        _MapTriangle (0, 0)-(_Width(Shade(col%)), 0)-(0, _Height(Shade(col%))), Shade(col%) To(cx, cy, -cz + push)-(hx, hy, -hz + push)-(gx, gy, -gz + push)
                    End If
                End If
    Next z, y, x
    For x = 1 To MAX - 1
        For y = 1 To MAX - 1
            For z = 1 To MAX - 1
                mm = 0
                If U(x, y, z) = 1 Then
                    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 _Continue
                                If U(xx, yy, zz) = 1 Then mm = mm + 1
                    Next zz, yy, xx
                    If mm < 9 Or mm > 18 Then U2(x, y, z) = -1 Else U2(x, y, z) = 1
                Else
                    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 _Continue
                                If U(xx, yy, zz) = 1 Then mm = mm + 1
                    Next zz, yy, xx
                    If (mm > 12 And mm < 18) Then U2(x, y, z) = 1 Else U2(x, y, z) = -1
                End If
    Next z, y, x
    _Display
    b = 0
    For x = 1 To MAX - 1
        For y = 1 To MAX - 1
            For z = 1 To MAX - 1
                U(x, y, z) = U2(x, y, z)
                If U(x, y, z) = 1 Then b = b + 1
    Next z, y, x
    If _KeyDown(32) Then GoTo start
Loop Until _KeyDown(27)
Function checkV (x1, y1, z1, x2, y2, z2, x3, y3, z3)
    Xo = (y2 - y1) * (z3 - z1) - (z2 - z1) * (y3 - y1)
    Yo = (z2 - z1) * (x3 - x1) - (x2 - x1) * (z3 - z1)
    Zo = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)
    D = Sqr(Xo * Xo + Yo * Yo + Zo * Zo)
    nx = Xo / D: ny = Yo / D: nz = Zo / D
    px = x1: py = y1: pz = z1
    D = Sqr(px * px + py * py + pz * pz)
    dx = px / D: dy = py / D: dz = pz / D
    uv = (nz * dz + ny * dy + nx * dx)
    If uv < 0 Or uv > 1 Then checkV = -1 Else checkV = uv
End Function
Function maxi (x)
    If x > 255 Then maxi = 255: Exit Function
    If x < 0 Then maxi = 0: Exit Function
    maxi = x
End Function

What does _SquarePixels do?

[Sprezzo]

------

[bplus]

Hey Sprezzo!

Definitely a contender for Samples IMHO.

[SpriggsySpriggs]

Well, that's some neat code right there.

[bplus]

OK I took a shot at 3D Rendering of Game of Life from a slightly diferent angle:

Code: (Select All)

Option _Explicit
_Title "3D Render: Game of Life 2, hold enter key to reset and change color" ' B+
' this all 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
' 2024-02-15 add new draw cube and needed routines for it
' remove the rest of the stuff!

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

'Basis Vectors, isolate components e sub x Dot V w/arrowHat = V sub x
Dim Shared v3e(1 To 3) As xyzType ' dotProduct
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 = -80 '???

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
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, r, g, b, mm, xx, yy, zz, rr, gg, bb
restart:
For z = zmin + 1 To zmax - 1
    For x = xmin + 1 To xmax - 1
        For y = ymin + 1 To ymax - 1
            If Rnd > .9 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
        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, .7, _RGB32(r, g, b)
                End If
        Next y, x
        _Display
        _Limit 25
    Next z
    _Delay .45
    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 > 4) And (mm < 8) Then ' 5, 6, 7 neighbors for birth
                    U2(x, y, z) = 1
                ElseIf U(x, y, z) = 1 And mm = 4 Then
                    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

Loop Until _KeyDown(27)

' new 2024-02-15 testing with above code
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 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
    Next

    ' left side of face
    If xy(0).x > 0 Then
        c2 = _RGB32(r - 70, g - 60, b - 70)
        FillTriangle PMap(xy(0).x, 0), PMap(xy(0).y, 1), PMap(xy(3).x, 0), PMap(xy(3).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), c2
        FillTriangle PMap(xy(4).x, 0), PMap(xy(4).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), PMap(xy(0).x, 0), PMap(xy(0).y, 1), c2
    End If

    ' top face
    If xy(0).y < 0 Then
        c2 = _RGB32(r - 40, g - 40, b - 40)
        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
    End If

    ' right face
    If xy(1).x < 0 Then
        c2 = _RGB32(r - 70, g - 70, b - 70)
        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
    End If

    ' bottom face
    If xy(0).y > 0 Then
        c2 = _RGB32(r - 110, g - 110, b - 110)
        FillTriangle PMap(xy(3).x, 0), PMap(xy(3).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), PMap(xy(7).x, 0), PMap(xy(7).y, 1), c2
        FillTriangle PMap(xy(7).x, 0), PMap(xy(7).y, 1), PMap(xy(6).x, 0), PMap(xy(6).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), c2
    End If

    ' front face
    FillTriangle PMap(xy(0).x, 0), PMap(xy(0).y, 1), PMap(xy(1).x, 0), PMap(xy(1).y, 1), PMap(xy(2).x, 0), PMap(xy(2).y, 1), colr~&
    FillTriangle PMap(xy(2).x, 0), PMap(xy(2).y, 1), PMap(xy(3).x, 0), PMap(xy(3).y, 1), PMap(xy(0).x, 0), PMap(xy(0).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

' project (x, y, z) point in real space to screenXY of user's eye-line
Sub screenXY (xyzReal As xyzType, xyScreen As xyType)
    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

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