SCREEN 12

RANDOMIZE (TIMER)

pi = 4 * ATN(1)

tau = (SQR(5) + 1) / 2

cosatntau = COS(ATN(tau)): REM approx. .525731112
sinatntau = SIN(ATN(tau)): REM approx. .850650808
height1 = cosatntau / 2: REM approx. .252865556
height2 = height1 + sinatntau: REM approx. 1.113516364
radius1 = sinatntau: REM approx. .850650808
radius2 = radius1 * tau: REM approx. 1.37638102

maxscale = 120
scale = maxscale

xxcentre = 380
yycentre = 260


theta = 25
thetarad = theta * pi / 180

REM phi = ATN(SQR(2))
phi = 80
phirad = phi * pi / 180

DIM angle(9)

FOR i = 0 TO 9
    angle(i) = 2 * pi * i / 10
NEXT i

DIM x(15), y(15), z(15), xx(15), yy(15)

FOR i = 1 TO 15
    READ x(i), y(i), z(i)
NEXT i

REM bottom layer
DATA -1,-1,-1
DATA -1,1,-1
DATA 1,1,-1
DATA 1,-1,-1
DATA 0,0,-1

REM middle layer
DATA -1,0,0
DATA 0,-1,0
DATA 1,0,0
DATA 0,1,0
DATA 0,0,0

REM top layer
DATA -1,-1,1
DATA -1,1,1
DATA 1,1,1
DATA 1,-1,1
DATA 0,0,1

octahedroncolour = 7: REM light grey
bottomcolour = 4: REM red
strutcolour1 = 14: REM yellow
strutcolour2 = 2: REM green
strutcolour3 = 9: REM light blue
strutcolour4 = 3: REM cyan
topcolour = 13: REM light magenta
axiscolour = 8: REM dark grey
dotcolour = 15
dotradius = 2

GOSUB workoutcoordinates

GOSUB drawstelloct

COLOR 6
LOCATE 6, 1: PRINT "STELLA OCTANGULA ANIMATION"
LOCATE 8, 1: PRINT "Copyright (c) 2005"
LOCATE 9, 1: PRINT "by Mad Teddy"


COLOR 7
LOCATE 1, 1: PRINT "theta =        degrees   Press L or R arrow keys to spin             ";
COLOR 12: PRINT "Esc to quit"
COLOR 7
LOCATE 2, 1: PRINT "elev. =        degrees   Press U or D arrow keys to change elevation"
LOCATE 3, 26: PRINT "(Ctrl => 0.25ø movements; Alt => 4ø movements)"
LOCATE 1, 9: PRINT "      "
LOCATE 1, 9: PRINT theta
LOCATE 2, 9: PRINT "      "
LOCATE 2, 9: PRINT 90 - phi

LOCATE 12, 2: PRINT "EDGE LENGTH:"
LOCATE 13, 6: PRINT "pixels"
LOCATE 13, 1: PRINT scale
LOCATE 14, 2: PRINT "(Max. = 120)"
LOCATE 16, 2: PRINT "Z zooms in"
LOCATE 17, 2: PRINT "X zooms out"
LOCATE 19, 2: PRINT "(Shift =>"
LOCATE 20, 2: PRINT "10 pixels"
LOCATE 21, 2: PRINT "at a time)"


REM LOCATE 30, 1: PRINT "         artan 2 ÷ 63.5ø      artan û2 ÷ 54.75ø      artan tau ÷ 58.25ø";


a$ = ""

DO UNTIL a$ = CHR$(27)

    a$ = INKEY$
    IF a$ <> "" THEN
        a$ = RIGHT$(a$, 1)
        IF a$ = CHR$(141) AND phi > 0 THEN
            phi = phi - .25
            IF phi <= 0 THEN
                BEEP
                phi = 0
            END IF
            phirad = phi * pi / 180
        ELSEIF a$ = CHR$(72) AND phi > 0 THEN
            phi = phi - 1
            IF phi <= 0 THEN
                BEEP
                phi = 0
            END IF
            phirad = phi * pi / 180
        ELSEIF a$ = CHR$(152) AND phi > 0 THEN
            phi = phi - 4
            IF phi <= 0 THEN
                BEEP
                phi = 0
            END IF
            phirad = phi * pi / 180
        ELSEIF a$ = CHR$(145) AND phi < 90 THEN
            phi = phi + .25
            IF phi >= 90 THEN
                BEEP
                phi = 90
            END IF
            phirad = phi * pi / 180
        ELSEIF a$ = CHR$(80) AND phi < 90 THEN
            phi = phi + 1
            IF phi >= 90 THEN
                BEEP
                phi = 90
            END IF
            phirad = phi * pi / 180
        ELSEIF a$ = CHR$(160) AND phi < 90 THEN
            phi = phi + 4
            IF phi >= 90 THEN
                BEEP
                phi = 90
            END IF
            phirad = phi * pi / 180
        ELSEIF a$ = CHR$(115) THEN
            IF theta = 0 THEN
                theta = 89.75
            ELSE
                theta = theta - .25
            END IF
            thetarad = theta * pi / 180
        ELSEIF a$ = CHR$(75) THEN
            IF theta < 1 THEN
                theta = theta + 90
            END IF
                theta = theta - 1
            thetarad = theta * pi / 180
        ELSEIF a$ = CHR$(155) THEN
            IF theta < 4 THEN
                theta = theta + 90
            END IF
                theta = theta - 4
            thetarad = theta * pi / 180
        ELSEIF a$ = CHR$(116) THEN
            IF theta = 89.75 THEN
                theta = 0
            ELSE
                theta = theta + .25
            END IF
            thetarad = theta * pi / 180
        ELSEIF a$ = CHR$(77) THEN
            IF theta >= 89 THEN
                theta = theta - 90
            END IF
                theta = theta + 1
            thetarad = theta * pi / 180
        ELSEIF a$ = CHR$(157) THEN
            IF theta >= 86 THEN
                theta = theta - 90
            END IF
                theta = theta + 4
            thetarad = theta * pi / 180
        ELSEIF a$ = "z" AND scale < maxscale THEN
            scale = scale + 1
            IF scale >= maxscale THEN
                BEEP
                scale = maxscale
            END IF
        ELSEIF a$ = "Z" AND scale < maxscale THEN
            scale = scale + 10
            IF scale > maxscale THEN
                BEEP
                scale = maxscale
            END IF
        ELSEIF a$ = "x" AND scale > 0 THEN
            scale = scale - 1
            IF scale <= 0 THEN
                BEEP
                scale = 0
            END IF
        ELSEIF a$ = "X" AND scale > 0 THEN
            scale = scale - 10
            IF scale < 0 THEN
                BEEP
                scale = 0
            END IF
        END IF

        IF a$ = CHR$(115) OR a$ = CHR$(75) OR a$ = CHR$(155) OR a$ = CHR$(116) OR a$ = CHR$(77) OR a$ = CHR$(157) THEN
            LOCATE 1, 9: PRINT "      "
            LOCATE 1, 9: PRINT theta
        ELSEIF a$ = CHR$(141) OR a$ = CHR$(72) OR a$ = CHR$(152) OR a$ = CHR$(145) OR a$ = CHR$(80) OR a$ = CHR$(160) THEN
            LOCATE 2, 9: PRINT "      "
            LOCATE 2, 9: PRINT 90 - phi
        ELSEIF a$ = "z" OR a$ = "Z" OR a$ = "x" OR a$ = "X" THEN
            LOCATE 13, 1: PRINT scale
        END IF
    END IF


REM    FOR j = 1 TO 10000
REM    NEXT j

    IF a$ = CHR$(115) OR a$ = CHR$(75) OR a$ = CHR$(155) OR a$ = CHR$(116) OR a$ = CHR$(77) OR a$ = CHR$(157) OR a$ = CHR$(141) OR a$ = CHR$(72) OR a$ = CHR$(152) OR a$ = CHR$(145) OR a$ = CHR$(80) OR a$ = CHR$(160) OR a$ = "z" OR a$ = "Z" OR a$ =  _
"x" OR a$ = "X" THEN

        GOSUB erasestelloct

        REM GOSUB drawaxes

        GOSUB workoutcoordinates

        GOSUB drawstelloct

    END IF

LOOP

END

REM *** SUBROUTINES ***


drawstelloct:

REM octahedron itself

LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(6), yycentre - yy(6)), octahedroncolour
LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(7), yycentre - yy(7)), octahedroncolour
LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(8), yycentre - yy(8)), octahedroncolour
LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(9), yycentre - yy(9)), octahedroncolour
LINE (xxcentre + xx(6), yycentre - yy(6))-(xxcentre + xx(7), yycentre - yy(7)), octahedroncolour
LINE (xxcentre + xx(7), yycentre - yy(7))-(xxcentre + xx(8), yycentre - yy(8)), octahedroncolour
LINE (xxcentre + xx(8), yycentre - yy(8))-(xxcentre + xx(9), yycentre - yy(9)), octahedroncolour
LINE (xxcentre + xx(9), yycentre - yy(9))-(xxcentre + xx(6), yycentre - yy(6)), octahedroncolour
LINE (xxcentre + xx(6), yycentre - yy(6))-(xxcentre + xx(15), yycentre - yy(15)), octahedroncolour
LINE (xxcentre + xx(7), yycentre - yy(7))-(xxcentre + xx(15), yycentre - yy(15)), octahedroncolour
LINE (xxcentre + xx(8), yycentre - yy(8))-(xxcentre + xx(15), yycentre - yy(15)), octahedroncolour
LINE (xxcentre + xx(9), yycentre - yy(9))-(xxcentre + xx(15), yycentre - yy(15)), octahedroncolour

REM bottom

LINE (xxcentre + xx(1), yycentre - yy(1))-(xxcentre + xx(3), yycentre - yy(3)), bottomcolour
LINE (xxcentre + xx(2), yycentre - yy(2))-(xxcentre + xx(4), yycentre - yy(4)), bottomcolour

REM struts

LINE (xxcentre + xx(1), yycentre - yy(1))-(xxcentre + xx(12), yycentre - yy(12)), strutcolour1
LINE (xxcentre + xx(2), yycentre - yy(2))-(xxcentre + xx(11), yycentre - yy(11)), strutcolour1
LINE (xxcentre + xx(2), yycentre - yy(2))-(xxcentre + xx(13), yycentre - yy(13)), strutcolour2
LINE (xxcentre + xx(3), yycentre - yy(3))-(xxcentre + xx(12), yycentre - yy(12)), strutcolour2
LINE (xxcentre + xx(3), yycentre - yy(3))-(xxcentre + xx(14), yycentre - yy(14)), strutcolour3
LINE (xxcentre + xx(4), yycentre - yy(4))-(xxcentre + xx(13), yycentre - yy(13)), strutcolour3
LINE (xxcentre + xx(4), yycentre - yy(4))-(xxcentre + xx(11), yycentre - yy(11)), strutcolour4
LINE (xxcentre + xx(1), yycentre - yy(1))-(xxcentre + xx(14), yycentre - yy(14)), strutcolour4

REM top

LINE (xxcentre + xx(11), yycentre - yy(11))-(xxcentre + xx(13), yycentre - yy(13)), topcolour
LINE (xxcentre + xx(12), yycentre - yy(12))-(xxcentre + xx(14), yycentre - yy(14)), topcolour

REM axes

LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(15), yycentre - yy(15)), axiscolour
LINE (xxcentre + xx(6), yycentre - yy(6))-(xxcentre + xx(8), yycentre - yy(8)), axiscolour
LINE (xxcentre + xx(7), yycentre - yy(7))-(xxcentre + xx(9), yycentre - yy(9)), axiscolour

REM dots

FOR i = 1 TO 15
    IF i <> 10 THEN
        CIRCLE (xxcentre + xx(i), yycentre - yy(i)), dotradius, 15
        PAINT (xxcentre + xx(i), yycentre - yy(i)), 15
    END IF
NEXT i

RETURN


erasestelloct:

REM dots

FOR i = 1 TO 15
    IF i <> 10 THEN
        CIRCLE (xxcentre + xx(i), yycentre - yy(i)), dotradius, 8
        PAINT (xxcentre + xx(i), yycentre - yy(i)), 0, 8
        CIRCLE (xxcentre + xx(i), yycentre - yy(i)), dotradius, 0
    END IF
NEXT i

REM bottom

LINE (xxcentre + xx(1), yycentre - yy(1))-(xxcentre + xx(3), yycentre - yy(3)), 0
LINE (xxcentre + xx(2), yycentre - yy(2))-(xxcentre + xx(4), yycentre - yy(4)), 0

REM struts

LINE (xxcentre + xx(1), yycentre - yy(1))-(xxcentre + xx(12), yycentre - yy(12)), 0
LINE (xxcentre + xx(2), yycentre - yy(2))-(xxcentre + xx(11), yycentre - yy(11)), 0
LINE (xxcentre + xx(2), yycentre - yy(2))-(xxcentre + xx(13), yycentre - yy(13)), 0
LINE (xxcentre + xx(3), yycentre - yy(3))-(xxcentre + xx(12), yycentre - yy(12)), 0
LINE (xxcentre + xx(3), yycentre - yy(3))-(xxcentre + xx(14), yycentre - yy(14)), 0
LINE (xxcentre + xx(4), yycentre - yy(4))-(xxcentre + xx(13), yycentre - yy(13)), 0
LINE (xxcentre + xx(4), yycentre - yy(4))-(xxcentre + xx(11), yycentre - yy(11)), 0
LINE (xxcentre + xx(1), yycentre - yy(1))-(xxcentre + xx(14), yycentre - yy(14)), 0

REM top

LINE (xxcentre + xx(11), yycentre - yy(11))-(xxcentre + xx(13), yycentre - yy(13)), 0
LINE (xxcentre + xx(12), yycentre - yy(12))-(xxcentre + xx(14), yycentre - yy(14)), 0

REM axes

LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(15), yycentre - yy(15)), 0
LINE (xxcentre + xx(6), yycentre - yy(6))-(xxcentre + xx(8), yycentre - yy(8)), 0
LINE (xxcentre + xx(7), yycentre - yy(7))-(xxcentre + xx(9), yycentre - yy(9)), 0

REM octahedron itself

LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(6), yycentre - yy(6)), 0
LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(7), yycentre - yy(7)), 0
LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(8), yycentre - yy(8)), 0
LINE (xxcentre + xx(5), yycentre - yy(5))-(xxcentre + xx(9), yycentre - yy(9)), 0
LINE (xxcentre + xx(6), yycentre - yy(6))-(xxcentre + xx(7), yycentre - yy(7)), 0
LINE (xxcentre + xx(7), yycentre - yy(7))-(xxcentre + xx(8), yycentre - yy(8)), 0
LINE (xxcentre + xx(8), yycentre - yy(8))-(xxcentre + xx(9), yycentre - yy(9)), 0
LINE (xxcentre + xx(9), yycentre - yy(9))-(xxcentre + xx(6), yycentre - yy(6)), 0
LINE (xxcentre + xx(6), yycentre - yy(6))-(xxcentre + xx(15), yycentre - yy(15)), 0
LINE (xxcentre + xx(7), yycentre - yy(7))-(xxcentre + xx(15), yycentre - yy(15)), 0
LINE (xxcentre + xx(8), yycentre - yy(8))-(xxcentre + xx(15), yycentre - yy(15)), 0
LINE (xxcentre + xx(9), yycentre - yy(9))-(xxcentre + xx(15), yycentre - yy(15)), 0


RETURN


drawaxes:

LINE (xxcentre, 0)-(xxcentre, 479), 8
LINE (0, yycentre)-(639, yycentre), 8

RETURN


workoutcoordinates:

FOR i = 1 TO 15
    xx(i) = (x(i) * COS(thetarad) - y(i) * SIN(thetarad)) * scale
    yy(i) = ((x(i) * SIN(thetarad) + y(i) * COS(thetarad)) * COS(phirad) + z(i) * SIN(phirad)) * scale
    REM PSET (xxcentre + xx(i), yycentre - yy(i)), 15
NEXT i

RETURN