#!/usr/bin/newlisp # Copyright (c) Mark J. Kilgard, 1994. # This program is freely distributable without licensing fees # and is provided without guarantee or warrantee expressed or # implied. This program is -not- in the public domain. #------------------------------------------------------ # Conversion to newLisp by Peter van Eerten. # # This is a 1-to-1 port of the original program. # August 21, 2005. #------------------------------------------------------ (load "GL.lsp" "GLU.lsp" "freeglut.lsp") (set 'font GLUT:GLUT_BITMAP_TIMES_ROMAN_24) (set 'fonts (list GLUT:GLUT_BITMAP_9_BY_15 GLUT:GLUT_BITMAP_TIMES_ROMAN_10 GLUT:GLUT_BITMAP_TIMES_ROMAN_24)) (set 'defaultMessage "GLUT means OpenGL.") (set 'message defaultMessage) (define (selectFont newfont) (set 'font (nth newfont fonts)) (GLUT:glutPostRedisplay) ) (define (selectMessage msg) (case msg (1 (set 'message "abcdefghijklmnop")) (2 (set 'message "ABCDEFGHIJKLMNOP")) ) ) (define (selectColor color) (case color (1 (GL:glColor3f (flt 0.0) (flt 1.0) (flt 0.0))) (2 (GL:glColor3f (flt 1.0) (flt 0.0) (flt 0.0))) (3 (GL:glColor3f (flt 1.0) (flt 1.0) (flt 1.0))) ) (GLUT:glutPostRedisplay) ) (define (tick) (GLUT:glutPostRedisplay) ) (define (output x y str, len i) (GL:glRasterPos2f (flt x) (flt y)) (set 'len (length str)) (for (i 0 (- len 1)) (GLUT:glutBitmapCharacter font (char (nth i str)) ) ) ) (define (display) (GL:glClear GL:GL_COLOR_BUFFER_BIT) (output 0 24 "This is written in a GLUT bitmap font.") (output 100 100 message) (output 50 145 "(positioned in pixels with upper-left origin)") (GLUT:glutSwapBuffers) ) (define (reshape w h) (GL:glViewport 0 0 w h) (GL:glMatrixMode GL:GL_PROJECTION) (GL:glLoadIdentity) (GLU:gluOrtho2D (float 0.0) (float w) (float h) (float 0.0)) (GL:glMatrixMode GL:GL_MODELVIEW) ) (define (main argc argv, i msg_submenu color_submenu) (GLUT:glutInit (address argc) (address argv)) (if (= (main-args -1) "-mono") (set 'font GLUT:GLUT_BITMAP_9_BY_15) ) (GLUT:glutInitDisplayMode (| GLUT:GLUT_DOUBLE GLUT:GLUT_RGB)) (GLUT:glutInitWindowSize 500 150) (GLUT:glutCreateWindow "GLUT bitmap font example") (GL:glClearColor (flt 0.0) (flt 0.0) (flt 0.0) (flt 1.0)) (GLUT:glutDisplayFunc 'display) (GLUT:glutReshapeFunc 'reshape) (GLUT:glutIdleFunc 'tick) (set 'msg_submenu (GLUT:glutCreateMenu 'selectMessage)) (GLUT:glutAddMenuEntry "abc" 1) (GLUT:glutAddMenuEntry "ABC" 2) (set 'color_submenu (GLUT:glutCreateMenu 'selectColor)) (GLUT:glutAddMenuEntry "Green" 1) (GLUT:glutAddMenuEntry "Red" 2) (GLUT:glutAddMenuEntry "White" 3) (GLUT:glutCreateMenu 'selectFont) (GLUT:glutAddMenuEntry "9 by 15" 0) (GLUT:glutAddMenuEntry "Times Roman 10" 1) (GLUT:glutAddMenuEntry "Times Roman 24" 2) (GLUT:glutAddSubMenu "Messages" msg_submenu) (GLUT:glutAddSubMenu "Color" color_submenu) (GLUT:glutAttachMenu GLUT:GLUT_RIGHT_BUTTON) (GLUT:glutMainLoop) ) # Start program (main 0 0) # Exit newLisp (exit)