REM
REM This is the BaCon port of the famous 'GEARS' OpenGL program.
REM Originally written by Brian Paul.
REM
REM See also: http://www.opengl.org/resources/code/samples/glut_examples/mesademos/mesademos.html
REM
REM Port by Peter van Eerten - July 2009.
REM Adapted for GLUT and GL INCLUDE files in January 2010.
REM
REM Reason for this port is to see if BaCon can use OpenGL and GLUT (it can).
REM

INCLUDE "gl.bac"
INCLUDE "glut.bac"

REM Draw a gear wheel.  You'll probably want to call this function when
REM building a display list since we do a lot of trig here.
REM
REM Input:  inner_radius - radius of hole at center
REM         outer_radius - radius at center of teeth
REM         width - width of gear
REM         teeth - number of teeth
REM         tooth_depth - depth of tooth

SUB gear(float inner_radius, float outer_radius, float width, float teeth, float tooth_depth)

    LOCAL r0, r1, r2 TYPE float
    LOCAL i
    LOCAL angle, da TYPE float
    LOCAL u, v, len TYPE float

    r0 = inner_radius
    r1 = outer_radius - (tooth_depth / 2.0)
    r2 = outer_radius + (tooth_depth / 2.0)

    da = 2.0 * PI / teeth / 4.0

    glShadeModel(GL_FLAT)

    glNormal3f(0.0, 0.0, 1.0)

    REM Draw front face
    glBegin(GL_QUAD_STRIP)
    FOR i = 0 TO teeth
        angle = ((i * 2.0) * PI) / teeth
        glVertex3f(r0 * COS(angle), r0 * SIN(angle), width * 0.5)
        glVertex3f(r1 * COS(angle), r1 * SIN(angle), width * 0.5)
        glVertex3f(r0 * COS(angle), r0 * SIN(angle), width * 0.5)
        glVertex3f(r1 * COS(angle + 3 * da), r1 * SIN(angle + 3 * da), width * 0.5)
    NEXT
    glEnd

    REM Draw front sides of teeth
    glBegin(GL_QUADS)
    da = 2.0 * PI / teeth / 4.0
    FOR i = 0 TO teeth
        angle = i * 2.0 * PI / teeth

        glVertex3f(r1 * COS(angle), r1 * SIN(angle), width * 0.5)
        glVertex3f(r2 * COS(angle + da), r2 * SIN(angle + da), width * 0.5)
        glVertex3f(r2 * COS(angle + 2 * da), r2 * SIN(angle + 2 * da), width * 0.5)
        glVertex3f(r1 * COS(angle + 3 * da), r1 * SIN(angle + 3 * da), width * 0.5)
    NEXT
    glEnd

    glNormal3f(0.0, 0.0, -1.0)

    REM Draw back face
    glBegin(GL_QUAD_STRIP)
    FOR i = 0 TO teeth
        angle = i * 2.0 * PI / teeth
        glVertex3f(r1 * COS(angle), r1 * SIN(angle), -width * 0.5)
        glVertex3f(r0 * COS(angle), r0 * SIN(angle), -width * 0.5)
        glVertex3f(r1 * COS(angle + 3 * da), r1 * SIN(angle + 3 * da), -width * 0.5)
        glVertex3f(r0 * COS(angle), r0 * SIN(angle), -width * 0.5)
    NEXT
    glEnd

    REM Draw back sides of teeth
    glBegin(GL_QUADS)
    da = 2.0 * PI / teeth / 4.0
    FOR i = 0 TO teeth
        angle = i * 2.0 * PI / teeth

        glVertex3f(r1 * COS(angle + 3 * da), r1 * SIN(angle + 3 * da), -width * 0.5)
        glVertex3f(r2 * COS(angle + 2 * da), r2 * SIN(angle + 2 * da), -width * 0.5)
        glVertex3f(r2 * COS(angle + da), r2 * SIN(angle + da), -width * 0.5)
        glVertex3f(r1 * COS(angle), r1 * SIN(angle), -width * 0.5)
    NEXT
    glEnd

    REM Draw outward faces of teeth
    glBegin(GL_QUAD_STRIP)
    FOR i = 0 TO teeth
        angle = i * 2.0 * PI / teeth

        glVertex3f(r1 * COS(angle), r1 * SIN(angle), width * 0.5)
        glVertex3f(r1 * COS(angle), r1 * SIN(angle), -width * 0.5)
        u = r2 * COS(angle + da) - r1 * COS(angle)
        v = r2 * SIN(angle + da) - r1 * SIN(angle)
        length = sqrt(u * u + v * v)
        u = u / length
        v = v / length
        glNormal3f(v, -u, 0.0)
        glVertex3f(r2 * COS(angle + da), r2 * SIN(angle + da), width * 0.5)
        glVertex3f(r2 * COS(angle + da), r2 * SIN(angle + da), -width * 0.5)
        glNormal3f(COS(angle), SIN(angle), 0.0)
        glVertex3f(r2 * COS(angle + 2 * da), r2 * SIN(angle + 2 * da), width * 0.5)
        glVertex3f(r2 * COS(angle + 2 * da), r2 * SIN(angle + 2 * da), -width * 0.5)
        u = r1 * COS(angle + 3 * da) - r2 * COS(angle + 2 * da)
        v = r1 * COS(angle + 3 * da) - r2 * SIN(angle + 2 * da)
        glNormal3f(v, -u, 0.0);
        glVertex3f(r1 * COS(angle + 3 * da), r1 * SIN(angle + 3 * da), width * 0.5)
        glVertex3f(r1 * COS(angle + 3 * da), r1 * SIN(angle + 3 * da), -width * 0.5)
        glNormal3f(COS(angle), SIN(angle), 0.0)
    NEXT

    glVertex3f(r1 * COS(0), r1 * SIN(0), width * 0.5)
    glVertex3f(r1 * COS(0), r1 * SIN(0), -width * 0.5)

    glEnd

    glShadeModel(GL_SMOOTH)

    REM Draw inside radius cylinder
    glBegin(GL_QUAD_STRIP)
    FOR i = 0 TO teeth
        angle = i * 2.0 * PI / teeth

        glNormal3f(-COS(angle), -SIN(angle), 0.0)
        glVertex3f(r0 * COS(angle), r0 * SIN(angle), -width * 0.5)
        glVertex3f(r0 * COS(angle), r0 * SIN(angle), width * 0.5)
    NEXT
    glEnd

END SUB

GLOBAL view_rotx, view_roty, view_rotz TYPE float
GLOBAL gear1, gear2, gear3 TYPE int
GLOBAL angle TYPE float
GLOBAL limit, count TYPE int

view_rotx = 20.0
view_roty = 30.0
view_rotz = 0.0
angle = 0.0

count = 1

SUB draw

    glClear (GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT)

    glPushMatrix
    glRotatef (view_rotx, 1.0, 0.0, 0.0)
    glRotatef (view_roty, 0.0, 1.0, 0.0)
    glRotatef (view_rotz, 0.0, 0.0, 1.0)

    glPushMatrix
    glTranslatef (-3.0, -2.0, 0.0)
    glRotatef (angle, 0.0, 0.0, 1.0)
    glCallList(gear1)
    glPopMatrix

    glPushMatrix
    glTranslatef (3.1, -2.0, 0.0)
    glRotatef(-2.0 * angle - 9.0, 0.0, 0.0, 1.0)
    glCallList(gear2)
    glPopMatrix

    glPushMatrix
    glTranslatef (-3.1, 4.2, 0.0)
    glRotatef (-2.0 * angle - 25.0, 0.0, 0.0, 1.0)
    glCallList(gear3)
    glPopMatrix

    glPopMatrix
    glutSwapBuffers

    count = count + 1
    IF count EQ limit THEN
        END
    END IF

END SUB

SUB idle

    angle = angle + 2.0
    glutPostRedisplay

END SUB

REM change view angle, exit upon ESC
REM ARGSUSED1
SUB key (NUMBER k, NUMBER x, NUMBER y)

    REM 'z'
    IF k EQ 122 THEN
        view_rotz = view_rotz + 5.0
    REM 'Z'
    ELIF k EQ 90 THEN
        view_rotz = view_rotz - 5.0
    REM Escape
    ELIF k EQ 27 THEN
        END
    END IF

    glutPostRedisplay

END SUB

REM change view angle
REM ARGSUSED1
SUB special(NUMBER k, NUMBER x, NUMBER y)

    REM GLUT_KEY_UP
    IF k EQ DEC("0065") THEN
        view_rotx = view_rotx + 5.0
    REM GLUT_KEY_DOWN
    ELIF k EQ DEC("0067") THEN
        view_rotx = view_rotx - 5.0
    REM GLUT_KEY_LEFT
    ELIF k EQ DEC("0064") THEN
        view_roty = view_roty + 5.0
    REM  GLUT_KEY_RIGHT
    ELIF k EQ DEC("0066") THEN
        view_roty = view_roty - 5.0
    END IF

    glutPostRedisplay

END SUB

REM New window size or exposure
SUB reshape (int width, int height)

    LOCAL h TYPE float

    h = height / width

    glViewport (0, 0, width, height)
    glMatrixMode(GL_PROJECTION)
    glLoadIdentity
    glFrustum(-1.0, 1.0, -1 * h, h, 5.0, 60.0)
    glMatrixMode(GL_MODELVIEW)
    glLoadIdentity
    glTranslatef(0.0, 0.0, -40.0)

END SUB

SUB init

    LOCAL Pos[] = { 5.0, 5.0, 10.0, 0.0 } TYPE float
    LOCAL Red[] = { 0.8, 0.1, 0.0, 1.0 } TYPE float
    LOCAL Green[] = { 0.0, 0.8, 0.2, 1.0 } TYPE float
    LOCAL Blue[] = { 0.2, 0.2, 1.0, 1.0 } TYPE float

    glLightfv(GL_LIGHT0, GL_POSITION, ADDRESS(Pos))
    glEnable(GL_CULL_FACE)
    glEnable(GL_LIGHTING)
    glEnable(GL_LIGHT0)
    glEnable(GL_DEPTH_TEST)

    REM Make the gears
    gear1 = glGenLists(1)
    glNewList(gear1, GL_COMPILE)
    glMaterialfv(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, ADDRESS(Red))
    gear(1.0, 4.0, 1.0, 20, 0.7)
    glEndList

    gear2 = glGenLists(1)
    glNewList(gear2, GL_COMPILE)
    glMaterialfv(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, ADDRESS(Green))
    gear(0.5, 2.0, 2.0, 10, 0.7)
    glEndList

    gear3 = glGenLists(1)
    glNewList(gear3, GL_COMPILE)
    glMaterialfv(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, ADDRESS(Blue))
    gear(1.3, 2.0, 0.5, 10, 0.7)
    glEndList

    glEnable(GL_NORMALIZE)

END SUB

SUB visible (NUMBER vis)

    IF vis EQ GLUT_VISIBLE THEN
        glutIdleFunc(ADDRESS(idle))
    ELSE
        glutIdleFunc(0)
    END IF

END SUB

SUB mainprog

    limit = 0
    glutInitDisplayMode (GLUT_RGB | GLUT_DEPTH | GLUT_DOUBLE)
    glutCreateWindow ("Gears")

    init

    glutDisplayFunc (ADDRESS (draw))
    glutReshapeFunc (ADDRESS(reshape))
    glutKeyboardFunc (ADDRESS(key))
    glutSpecialFunc (ADDRESS(special))
    glutVisibilityFunc (ADDRESS(visible))

    PRINT "Current GL vendor: ", glGetString(GL_VENDOR) FORMAT "%s%s\n"
    PRINT "Current GL renderer: ", glGetString(GL_RENDERER) FORMAT "%s%s\n"
    PRINT "Current GL version: ", glGetString(GL_VERSION) FORMAT "%s%s\n"

    glutMainLoop

END SUB

mainprog