3D rendering of Game of Life by 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

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