#!/usr/bin/newlisp
#
# gears.c
#
#
# 3-D gear wheels.  This program is in the public domain.
#
# Brian Paul
#
#
# Conversion to GLUT by Mark J. Kilgard
#-------------------------------------------------------------------
# Ported to newLisp by Peter van Eerten.
#
# This is a 1-to-1 port of the original program.
# November 13, 2005.
# Adapted for newLisp 10, january 6 2009 - PvE.
#-------------------------------------------------------------------

(load "GL.lsp" "freeglut.lsp")

(constant 'M_PI 3.14159265)

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

(define (gear inner_radius outer_radius width teeth tooth_depth)

    (set 'r0 inner_radius)
    (set 'r1 (sub outer_radius (div tooth_depth 2.0)))
    (set 'r2 (add outer_radius (div tooth_depth 2.0)))

    (set 'da (div (div (mul 2.0 M_PI) teeth) 4.0))

    (GL:glShadeModel GL:GL_FLAT)

    (GL:glNormal3f (flt 0.0) (flt 0.0) (flt 1.0))

    # draw front face
    (GL:glBegin GL:GL_QUAD_STRIP)
    (for (i 0 teeth)
	(set 'angle (div (mul (mul i 2.0) M_PI) teeth))
	(GL:glVertex3f (flt (mul r0 (cos angle))) (flt (mul r0 (sin angle))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r1 (cos angle))) (flt (mul r1 (sin angle))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r0 (cos angle))) (flt (mul r0 (sin angle))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r1 (cos (add angle (mul 3 da))))) (flt (mul r1 (sin(add angle (mul 3 da))))) (flt (mul width 0.5)))
    )
    (GL:glEnd)

    # draw front sides of teeth
    (GL:glBegin GL:GL_QUADS)
    (set 'da (div (div (mul 2.0 M_PI) teeth) 4.0))
    (for (i 0 (- teeth 1))
	(set 'angle (div (mul (mul i 2.0) M_PI) teeth))

	(GL:glVertex3f (flt (mul r1 (cos angle))) (flt (mul r1 (sin angle))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r2 (cos (add angle da)))) (flt (mul r2 (sin (add angle da)))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r2 (cos (add angle (mul 2 da))))) (flt (mul r2 (sin (add angle (mul 2 da))))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r1 (cos (add angle (mul 3 da))))) (flt (mul r1 (sin (add angle (mul 3 da))))) (flt (mul width 0.5)))
    )
    (GL:glEnd)

    (GL:glNormal3f (flt 0.0) (flt 0.0) (flt -1.0))

    # draw back face
    (GL:glBegin GL:GL_QUAD_STRIP)
    (for (i 0 teeth)
	(set 'angle (div (mul (mul i 2.0) M_PI) teeth))
	(GL:glVertex3f (flt (mul r1 (cos angle))) (flt (mul r1 (sin angle))) (flt (mul (mul -1 width) 0.5)))
	(GL:glVertex3f (flt (mul r0 (cos angle))) (flt (mul r0 (sin angle))) (flt (mul (mul -1 width) 0.5)))
	(GL:glVertex3f (flt (mul r1 (cos (add angle (mul 3 da))))) (flt (mul r1 (sin (add angle (mul 3 da))))) (flt (mul (mul -1 width) 0.5)))
	(GL:glVertex3f (flt (mul r0 (cos angle))) (flt (mul r0 (sin angle))) (flt (mul (mul -1 width) 0.5)))
    )
    (GL:glEnd)

    # draw back sides of teeth
    (GL:glBegin GL:GL_QUADS)
    (set 'da (div (div (mul 2.0 M_PI) teeth) 4.0))
    (for (i 0 (- teeth 1))
	(set 'angle (div (mul (mul i 2.0) M_PI) teeth))

	(GL:glVertex3f (flt (mul r1 (cos (add angle (mul 3 da))))) (flt (mul r1 (sin (add angle (mul 3 da))))) (flt (mul (mul -1 width) 0.5)))
	(GL:glVertex3f (flt (mul r2 (cos (add angle (mul 2 da))))) (flt (mul r2 (sin (add angle (mul 2 da))))) (flt (mul (mul -1 width) 0.5)))
	(GL:glVertex3f (flt (mul r2 (cos (add angle da)))) (flt (mul r2 (sin (add angle da)))) (flt (mul (mul -1 width) 0.5)))
	(GL:glVertex3f (flt (mul r1 (cos angle))) (flt (mul r1 (sin angle))) (flt (mul (mul -1 width) 0.5)))
    )
    (GL:glEnd)

    # draw outward faces of teeth
    (GL:glBegin GL:GL_QUAD_STRIP)
    (for (i 0 (- teeth 1))
	(set 'angle (div (mul (mul i  2.0) M_PI) teeth))

	(GL:glVertex3f (flt (mul r1 (cos angle))) (flt (mul r1 (sin angle))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r1 (cos angle))) (flt (mul r1 (sin angle))) (flt (mul (mul -1 width) 0.5)))
	(set 'u (sub (mul r2 (cos (add angle da))) (mul r1 (cos angle)) ))
	(set 'v (sub (mul r2 (sin (add angle da))) (mul r1 (sin angle)) ))
	(set 'len (sqrt (add (mul u u) (mul v v))))
	(set 'u (div u len))
	(set 'v (div v len))
	(GL:glNormal3f (flt v) (flt (mul -1 u)) (flt 0.0))
	(GL:glVertex3f (flt (mul r2 (cos (add angle da)))) (flt (mul r2 (sin (add angle da)))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r2 (cos (add angle da)))) (flt (mul r2 (sin (add angle da)))) (flt (mul (mul -1 width) 0.5)))
	(GL:glNormal3f (flt (cos angle)) (flt (sin angle)) (flt 0.0))
	(GL:glVertex3f (flt (mul r2 (cos (add angle (mul 2 da))))) (flt (mul r2 (sin (add angle (mul 2 da))))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r2 (cos (add angle (mul 2 da))))) (flt (mul r2 (sin (add angle (mul 2 da))))) (flt (mul (mul -1 width) 0.5)))
	(set 'u (sub (mul r1 (cos (add angle (mul 3 da)))) (mul r2 (cos (add angle (mul 2 da))))))
	(set 'v (sub (mul r1 (sin (add angle (mul 3 da)))) (mul r2 (sin (add angle (mul 2 da))))))
	(GL:glNormal3f (flt v) (flt (mul -1 u)) (flt 0.0))
	(GL:glVertex3f (flt (mul r1 (cos (add angle (mul 3 da))))) (flt (mul r1 (sin (add angle (mul 3 da))))) (flt (mul width 0.5)))
	(GL:glVertex3f (flt (mul r1 (cos (add angle (mul 3 da))))) (flt (mul r1 (sin (add angle (mul 3 da))))) (flt (mul (mul -1 width) 0.5)))
	(GL:glNormal3f (flt (cos angle)) (flt (sin angle)) (flt 0.0))
    )

    (GL:glVertex3f (flt (mul r1 (cos 0))) (flt (mul r1 (sin 0))) (flt (mul width 0.5)))
    (GL:glVertex3f (flt (mul r1 (cos 0))) (flt (mul r1 (sin 0))) (flt (mul (mul -1 width) 0.5)))

    (GL:glEnd)

    (GL:glShadeModel GL:GL_SMOOTH)

    # draw inside radius cylinder
    (GL:glBegin GL:GL_QUAD_STRIP)
    (for (i 0 teeth)
	(set 'angle (div (mul (mul i 2.0) M_PI) teeth))

	(GL:glNormal3f (flt (mul -1 (cos angle))) (flt (mul -1 (sin angle))) (flt 0.0))
	(GL:glVertex3f (flt (mul r0 (cos angle))) (flt (mul r0 (sin angle))) (flt (mul (mul -1 width) 0.5)))
	(GL:glVertex3f (flt (mul r0 (cos angle))) (flt (mul r0 (sin angle))) (flt (mul width 0.5)))
    )
    (GL:glEnd)

)

(set 'view_rotx 20.0)
(set 'view_roty 30.0)
(set 'view_rotz 0.0)
(set 'angle 0.0)

(set '_count 1)	# 'count' is a newLisp keyword, hence the leading underscore

(define (draw)

    (GL:glClear (| GL:GL_COLOR_BUFFER_BIT GL:GL_DEPTH_BUFFER_BIT))

    (GL:glPushMatrix)
    (GL:glRotatef (flt view_rotx) (flt 1.0) (flt 0.0) (flt 0.0))
    (GL:glRotatef (flt view_roty) (flt 0.0) (flt 1.0) (flt 0.0))
    (GL:glRotatef (flt view_rotz) (flt 0.0) (flt 0.0) (flt 1.0))

    (GL:glPushMatrix)
    (GL:glTranslatef (flt -3.0) (flt -2.0) (flt 0.0))
    (GL:glRotatef (flt angle) (flt 0.0) (flt 0.0) (flt 1.0))
    (GL:glCallList gear1)
    (GL:glPopMatrix)

    (GL:glPushMatrix)
    (GL:glTranslatef (flt 3.1) (flt -2.0) (flt 0.0))
    (GL:glRotatef (flt (sub (mul -2.0 angle) 9.0)) (flt 0.0) (flt 0.0) (flt 1.0))
    (GL:glCallList gear2)
    (GL:glPopMatrix)

    (GL:glPushMatrix)
    (GL:glTranslatef (flt -3.1) (flt 4.2) (flt 0.0))
    (GL:glRotatef (flt (sub (mul -2.0 angle) 25.0)) (flt 0.0) (flt 0.0) (flt 1.0))
    (GL:glCallList gear3)
    (GL:glPopMatrix)

    (GL:glPopMatrix)
    (GLUT:glutSwapBuffers)

    (inc _count)
    (if (= _count limit) (exit)	)
)

(define (idle)

    (set 'angle (add angle 2.0))
    (GLUT:glutPostRedisplay)
)

# change view angle, exit upon ESC
# ARGSUSED1
(define (key k x y)

    (case k
	(122:	#'z':
	    (set 'view_rotz (add view_rotz 5.0)))
	(90:	#'Z':
	    (set 'view_rotz (sub view_rotz 5.0)))
	(27:	#Escape
	    (exit))
    )
    (GLUT:glutPostRedisplay)
)

# change view angle
# ARGSUSED1
(define (special k x y)

    (case k
	(0x0065:	#GLUT_KEY_UP:
	    (set 'view_rotx (add view_rotx 5.0)))
	(0x0067:	#GLUT_KEY_DOWN:
	    (set 'view_rotx (sub view_rotx 5.0)))
	(0x0064:	#GLUT_KEY_LEFT:
	    (set 'view_roty (add view_roty 5.0)))
	(0x0066:	#GLUT_KEY_RIGHT:
	    (set 'view_roty (sub view_roty 5.0)))
    )
    (GLUT:glutPostRedisplay)
)

# new window size or exposure
(define (reshape width height)

    (set 'h (div height width))

    (GL:glViewport 0 0 (int width) (int height))
    (GL:glMatrixMode GL:GL_PROJECTION)
    (GL:glLoadIdentity)
    (GL:glFrustum -1.0 1.0 (mul -1 h) h 5.0 60.0)
    (GL:glMatrixMode GL:GL_MODELVIEW)
    (GL:glLoadIdentity)
    (GL:glTranslatef (flt 0.0) (flt 0.0) (flt -40.0))
)

(define (init)

    (set 'pos (pack "ffff" 5.0 5.0 10.0 0.0))
    (set 'red (pack "ffff" 0.8 0.1 0.0 1.0))
    (set 'green (pack "ffff" 0.0 0.8 0.2 1.0))
    (set 'blue (pack "ffff" 0.2 0.2 1.0 1.0))

    (GL:glLightfv GL:GL_LIGHT0 GL:GL_POSITION pos)
    (GL:glEnable GL:GL_CULL_FACE)
    (GL:glEnable GL:GL_LIGHTING)
    (GL:glEnable GL:GL_LIGHT0)
    (GL:glEnable GL:GL_DEPTH_TEST)

    # make the gears
    (set 'gear1 (GL:glGenLists 1))
    (GL:glNewList gear1 GL:GL_COMPILE)
    (GL:glMaterialfv GL:GL_FRONT GL:GL_AMBIENT_AND_DIFFUSE red)
    (gear 1.0 4.0 1.0 20 0.7)
    (GL:glEndList)

    (set 'gear2 (GL:glGenLists 1))
    (GL:glNewList gear2 GL:GL_COMPILE)
    (GL:glMaterialfv GL:GL_FRONT GL:GL_AMBIENT_AND_DIFFUSE green)
    (gear 0.5 2.0 2.0 10 0.7)
    (GL:glEndList)

    (set 'gear3 (GL:glGenLists 1))
    (GL:glNewList gear3 GL:GL_COMPILE)
    (GL:glMaterialfv GL:GL_FRONT GL:GL_AMBIENT_AND_DIFFUSE blue)
    (gear 1.3 2.0 0.5 10 0.7)
    (GL:glEndList)

    (GL:glEnable GL:GL_NORMALIZE)
)

(define (visible vis)

    (if (= vis GLUT:GLUT_VISIBLE)
	(GLUT:glutIdleFunc 'idle)
	(GLUT:glutIdleFunc 'NULL)
    )
)

(define (main argc argv)

    (GLUT:glutInit (address argc) (address argv))
    (if (!= (int (main-args -1)) nil)
	(set 'limit (+ (int (main-args -1)) 1))
    	(set 'limit 0)
    )
    (GLUT:glutInitDisplayMode (| GLUT:GLUT_RGB GLUT:GLUT_DEPTH GLUT:GLUT_DOUBLE))

    (GLUT:glutCreateWindow "Gears")
    (init)

    (GLUT:glutDisplayFunc 'draw)
    (GLUT:glutReshapeFunc 'reshape)
    (GLUT:glutKeyboardFunc 'key)
    (GLUT:glutSpecialFunc 'special)
    (GLUT:glutVisibilityFunc 'visible)

    (GLUT:glutMainLoop)
)

(main 0 0)
(exit)