' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2024.09.09.00.00]) on 2026.01.19 at 19:59 (Coordinated Universal Time)
_TITLE "Klein Bottle"

' This program by Charlie Veniot is a port and mod of a QBJS program
' by Vince, shared with the QB64pe community in the following post:
' https://qb64phoenix.com/forum/showthread.php?tid=270&pid=39021#pid39021

' 🟠🟠🟠 Declarations & Initializations

DIM pi, p, q, a, b, x, y, z, t

DECLARE SUB f(u, v)
DECLARE SUB proj
DECLARE SUB rotx(u)
DECLARE SUB roty(u)
DECLARE SUB rotz(u)

pi = _PI ' 4 * ATN(1)
zoom = 150
sw = 624
sh = 690

SCREEN _NEWIMAGE( sw, sh, 32 )

du = 2 * pi / 200
dv = 2 * pi / 20
a = pi / 4
b = pi / 4
ou = 0
ov = 0
tt = 0

' 🟠🟠🟠 Main program


DO
    tt = tt + 0.01
    t = 0.5
    a = a + 0.01
    b = b + 0.01
    zoom = zoom - 10 * _MOUSEWHEEL

    CLS

    xu = 0
    xv = 0

    FOR u = 0 TO 2 * pi STEP du
        xu = xu XOR 1
        FOR v = 0 to 2 * pi STEP dv
            xu = xu XOR 1

            nx = SIN( v )
            ny = -COS( v )
            nz = u

            CALL roty( a )
            CALL rotx( b )

            'parallel
            sx = -1
            sy = -sx / 0.707
            sz = -0.707 * sy

            'perspective
            sx = 0  
            sy = -1 
            sz = 0  
            
            CALL f( u, v )
            ccc = 110 + z * 150
            ccc = MAX( MIN( ccc, 255 ), 0 )
            COLOR _RGB( ccc, ccc, 255 - ccc )

            CALL proj()
            x1 = sw / 2 + zoom * p
            y1 = sh / 2 - zoom * q
            CIRCLE( x1, y1 ), 1, , , , , T

            CALL f( u + du, v )
            CALL proj()
            x2 = sw / 2 + zoom * p
            y2 = sh / 2 - zoom * q
            LINE - ( x2, y2 )

            CALL f( u + du, v + dv )
            CALL proj()
            x3 = sw / 2 + zoom * p
            y3 = sh / 2 - zoom * q
            LINE - ( x3, y3 )

            CALL f( u, v + dv )
            CALL proj()
            x4 = sw / 2 + zoom * p
            y4 = sh / 2 - zoom * q
        NEXT
    NEXT
    _DISPLAY
LOOP

' 🟠🟠🟠 SUB Subroutines

SUB f(u, v)
    sinu = SIN(u)
    cosu = COS(u)
    cosv = COS(v)
    x = -( 2 / 15 ) * cosu * ( 3 * cosv - 30 * sinu + 90 * ( ( cosu ) ^ 4 ) * sinu - 60 * ( cosu ) ^ 6 * sinu + 5 * cosu * cosv * sinu )
    y = -( 1 / 15 ) * sinu * ( 3 * cosv -  3 * ( cosv ) ^ 2 * cosv - 48 * ( cosu ) ^ 4 * cosv + 48 * ( cosu ) ^ 6 * cosv - 60 * sinu + 5 * cosu * cosv * sinu - 5 * ( cosu ) ^ 3 * cosv * sinu - 80 * ( cosu ) ^ 5 * cosv * sinu + 80 * ( cosu ) ^ 7 * cosv * sinu ) - 2
    z = ( 2 / 15 ) * ( 3 + 5 * cosu * sinu ) * SIN(v)
END SUB

SUB proj
    CALL roty( a )
    CALL rotx( b )
    d = 10
    p = x * d / ( 10 + y )
    q = z * d / ( 10 + y )
END SUB

SUB rotx(u)
    xx = x
    yy = y * COS(u) - z * SIN(u)
    zz = y * SIN(u) + z * COS(u)
    x = xx
    y = yy
    z = zz
END SUB

SUB roty(u)
    xx =  x * COS(u) + z * SIN(u)
    yy =  y
    zz = -x * SIN(u) + z * COS(u)
    x = xx
    y = yy
    z = zz
END SUB

SUB rotz(u)
    xx = x * COS(u) - y * SIN(u)
    yy = x * SIN(u) + y * COS(u)
    zz = z
    x = xx
    y = yy
    z = zz
END SUB