' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2023.12.16.16.28]) on 2024.03.26 at 03:10 (Coordinated Universal Time)

' 🟠🟠🟠 REMARKS

' This program by Charlie Veniot is a port and mod
' of a QBJS program by vince

' 🟠🟠🟠 DECLARATIONS 

sw = 430 : sh = 400 : d = 700 : z0 = 1500

DIM x(16), y(16), z(16), w(16)
    x( 0) = 0-1 : y( 0) = 0-1 : z( 0) = 0-1 : w( 0) = 0-1
    x( 1) = 1   : y( 1) = 0-1 : z( 1) = 0-1 : w( 1) = 0-1
    x( 2) = 1   : y( 2) = 1   : z( 2) = 0-1 : w( 2) = 0-1
    x( 3) = 0-1 : y( 3) = 1   : z( 3) = 0-1 : w( 3) = 0-1
    x( 4) = 0-1 : y( 4) = 0-1 : z( 4) = 1   : w( 4) = 0-1
    x( 5) = 1   : y( 5) = 0-1 : z( 5) = 1   : w( 5) = 0-1
    x( 6) = 1   : y( 6) = 1   : z( 6) = 1   : w( 6) = 0-1
    x( 7) = 0-1 : y( 7) = 1   : z( 7) = 1   : w( 7) = 0-1
    x( 8) = 0-1 : y( 8) = 0-1 : z( 8) = 0-1 : w( 8) = 1
    x( 9) = 1   : y( 9) = 0-1 : z( 9) = 0-1 : w( 9) = 1
    x(10) = 1   : y(10) = 1   : z(10) = 0-1 : w(10) = 1
    x(11) = 0-1 : y(11) = 1   : z(11) = 0-1 : w(11) = 1
    x(12) = 0-1 : y(12) = 0-1 : z(12) = 1   : w(12) = 1
    x(13) = 1   : y(13) = 0-1 : z(13) = 1   : w(13) = 1
    x(14) = 1   : y(14) = 1   : z(14) = 1   : w(14) = 1
    x(15) = 0-1 : y(15) = 1   : z(15) = 1   : w(15) = 1

DECLARE SUB proj(x, y, z, w)

' 🟠🟠🟠 MAIN PROGRAM

SCREEN _NEWIMAGE(sw, sh, 32)

DO
FOR t = 0 TO 2 * _PI STEP 0.01
    CLS
    
    FOR xa = -1 TO 1 : FOR ya = -1 TO 1

    f = 0
    i = 0
    CALL proj( x( i ), y( i ), z( i ), w( i ) )
    PSET ( p + xa, q + ya )
    FOR i= 1 TO 2
        CALL proj( x( i ), y( i ), z( i ), w( i ) )
        LINE -( p + xa, q + ya ), _RGB( 0, 255, 0)
    NEXT
    i = 0
    CALL proj( x( i ), y( i ), z( i ), w( i ) )
    LINE -( p + xa, q + ya ),_RGB( 0, 255, 0 )
   
    k = 4
    FOR i = 0 TO 2
        CALL proj( x( i ), y( i ), z( i ), w( i ) )
        PSET ( p + xa, q + ya )
        CALL proj( x( k ), y( k ), z( k ), w( k ) )
        LINE -( p + xa, q + ya ), _RGB( 0, 255, 255 )
    NEXT
   
    FOR i = 0 TO 2
        CALL proj( x( i ), y( i ), z( i ), w( i ) )
        PSET ( p + xa, q + ya ), _RGB( 255, 0, 0 )
        CIRCLE ( POINT( 0 ), POINT( 1 ) ), 4, _RGB( 255, 0, 0), , , , T
        k = 9
   
        CALL proj( x( k ), y( k ), z( k ), w( k ) )
        LINE -( p + xa, q + ya ), _RGB( 255, 255, 0 )
        CIRCLE ( POINT( 0 ), POINT( 1 ) ), 4, _RGB( 255, 0, 0), , , , T
    NEXT
   
    k = 4
    CALL proj ( x( k ), y( k ), z( k ), w( k ) )
    LINE -( p + xa, q + ya ), _RGB( 255, 255, 0 )
        CIRCLE ( POINT( 0 ), POINT( 1 ) ), 4, _RGB( 255, 0, 0 ), , , , T    
    NEXT ya : NEXT xa
    
    SLEEP 0.01

NEXT
LOOP

' 🟠🟠🟠 SUBROUTINE

SUB proj( x, y, z, w )
    xx = x
    yy = y * COS( t ) - w * SIN( t )
    zz = z
    ww = y * SIN( t ) + w * COS( t )

    d2 = 3
    w0 = 3
    xx = xx * d2 / ( w0 + ww )
    yy = yy * d2 / ( w0 + ww )
    zz = zz * d2 / ( w0 + ww )

    xxx = xx * COS( 0 ) - zz * SIN( 0 )
    zzz = xx * SIN( 0 ) + zz * COS( 0 )
    xx = xxx
    zz = zzz

    a = _PI / 3
    b = _PI / 8
    xxx = xx * COS( a ) - yy * SIN( a )
    yyy = xx * SIN( a ) + yy * COS( a )
    xx = xxx
    yy = yyy

    yyy = yy * COS( b ) - zz * SIN( b )
    zzz = yy * SIN( b ) + zz * COS( b )
    yy = yyy
    zz = zzz

    xx = 100 * xx
    yy = 100 * yy
    zz = 100 * zz

    p = sw / 2 + 2 * xx * d / ( yy + z0 )
    q = sh / 2.9 - 2 * zz * d / ( yy + z0 )
END SUB