#!/usr/bin/newlisp
#
# Simple OpenGL demo - tested with Slackware 10 and WinXP
#
# Read the history of the Utah Teapot here: http://sjbaker.org/teapot/
#
# Enjoy!
# Peter van Eerten, nov 9 2004
#
#------------------------------------------------
# Rewritten for GLUT at August 21, 2005.
#------------------------------------------------

# Load libraries
(load "freeglut.lsp" "GL.lsp")

# Define this program to be the MAIN context
(context 'MAIN)

# Define lighting and coloring of objects
(constant 'lightpos (pack "ffff" 2.0 2.0 -8.0 0.0))
(constant 'lightdif (pack "ffff" 1.0 1.0 1.0 1.0))
(constant 'lightamb (pack "fff" 0.15 0.15 0.15))
(constant 'lightspe (pack "ffff" 1.0 1.0 1.0 1.0))
(constant 'teapot_color (pack "ffff" 0.1 0.7 0.1 0.5))
(constant 'bitmap_font_color (pack "ffff" 1.0 0.0 0.0 0.0))
(constant 'stroke_font_color (pack "ffff" 0.0 0.0 1.0 0.0))

# Initialize OpenGL
(define (GL_init argc argv)
	# GLUT start video
	(GLUT:glutInit (address argc) (address argv))
	(GLUT:glutInitDisplayMode (| GLUT:GLUT_DOUBLE GLUT:GLUT_DEPTH GLUT:GLUT_RGB))
	(GLUT:glutInitWindowSize 640 480)
	(GLUT:glutCreateWindow "newLisp OpenGL example")
	# Set some variables
	(set 'rotx 0)	; rotation around x-axis
	(set 'roty 330)	; rotation around y-axis
	(set 'size 0.4)	; size of teapot
)

# Draw some text on the screen
(define (bitmap_text txt)
	(for (l 0 (- (length txt) 1)) (GLUT:glutBitmapCharacter GLUT:GLUT_BITMAP_HELVETICA_18 (char (nth l txt)) )))

# Draw STROKE text on the screen
(define (stroke_text txt)
	(for (l 0 (- (length txt) 1)) (GLUT:glutStrokeCharacter GLUT:GLUT_STROKE_ROMAN (char (nth l txt)) )))

# Draw teapot in angle
(define (draw_all)
	# Define white as clearing color
	(GL:glClearColor (flt 1.0) (flt 1.0) (flt 1.0) (flt 0.0))
	# Clear screen
	(GL:glClear (| GL:GL_COLOR_BUFFER_BIT GL:GL_DEPTH_BUFFER_BIT))
	# Enable shading, depth and lighting
	(GL:glShadeModel GL:GL_SMOOTH)
	(GL:glEnable GL:GL_DEPTH_TEST)
	(GL:glEnable GL:GL_LIGHTING)
	(GL:glEnable GL:GL_LIGHT0)
	# Setup lighting
	(GL:glLightfv GL:GL_LIGHT0 GL:GL_POSITION lightpos)
	(GL:glLightfv GL:GL_LIGHT0 GL:GL_DIFFUSE lightdif)
	(GL:glLightfv GL:GL_LIGHT0 GL:GL_AMBIENT lightamb)
	(GL:glLightfv GL:GL_LIGHT0 GL:GL_SPECULAR lightspe)
	# Setup reflected color of object
	(GL:glMaterialfv GL:GL_FRONT GL:GL_AMBIENT_AND_DIFFUSE teapot_color)
	# Make sure we see the model
	(GL:glMatrixMode GL:GL_MODELVIEW)
	# Save current matrix
	(GL:glPushMatrix)
	# Rotate
	(GL:glRotatef (flt rotx) (flt 0.0) (flt 1.0) (flt 0.0))
	(GL:glRotatef (flt roty) (flt 1.0) (flt 0.0) (flt 0.0))
	# Dump rotated image
	(GLUT:glutSolidTeapot size)
	# Undo the last rotation
	(GL:glLoadIdentity)
	# Setup reflected color of font
	(GL:glMaterialfv GL:GL_FRONT GL:GL_AMBIENT_AND_DIFFUSE bitmap_font_color)
	# Determine position of bitmapped text
	(GL:glRasterPos2f (flt 0.0) (flt -0.8))
	# Draw some bitmapped text
	(bitmap_text "GLUT for newLisp demo.")
	# Setup reflected color of font
	(GL:glMaterialfv GL:GL_FRONT GL:GL_AMBIENT_AND_DIFFUSE stroke_font_color)
	# Determine position of STROKED text -> drawed so translate
	(GL:glTranslatef (flt -0.9) (flt 0.8) (flt 0.0))
	# Setup scaling -> stroked characters are large, make smaller
	(GL:glScalef (flt 0.0006) (flt 0.0007) (flt 0.0))
	# Draw some stroked text
	(stroke_text "The <escape> key exits this demo.")
	# Now put back the matrix
	(GL:glPopMatrix)
	# Dump buffer on screen
	(GLUT:glutSwapBuffers))

(define (reshape width height)
	(GL:glViewport 0 0 width height)
	(GL:glMatrixMode GL:GL_PROJECTION)
	(GL:glLoadIdentity)
	(GL:glMatrixMode GL:GL_MODELVIEW)
)

(define (rotation)
	(set 'rotx (- rotx 5))
	(set 'roty (- roty 3))
	# Make sure rotation is a valid value
	(if (> rotx 359) (set 'rotx 0))
	(if (< rotx 0) (set 'rotx 360))
	(if (> roty 359) (set 'roty 0))
	(if (< roty 0) (set 'roty 360))
	# Redraw
	(GLUT:glutPostRedisplay)
)

(define (key k)
	(case k
		(27: (exit))
	)
)

#------------------------------------------------------

# Program starts here 
(GL_init 0 0)

(GLUT:glutReshapeFunc 'reshape)
(GLUT:glutIdleFunc 'rotation)
(GLUT:glutDisplayFunc 'draw_all)
(GLUT:glutKeyboardFunc 'key)

(GLUT:glutMainLoop)

# Exit newLisp
(exit)