#!/usr/bin/gosh ;; ;; 3-D gear wheels. This program is in the public domain. ;; ;; Brian Paul ;; ;; Conversion to GLUT by Mark J. Kilgard ;; Conversion to GtkGLExt by Naofumi Yasufuku ;; Port to Scheme/Gauche(GtkGLExt) by Shiro Kawai ;; Port to Scheme/Gauche(GLUT) by YOKOTA Hiroshi (use math.const) (use gl) (use gl.glut) ;(use slib) ;(require 'printf) ;; 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) (let ((r0 inner-radius) (r1 (- outer-radius (/ tooth-depth 2.0))) (r2 (+ outer-radius (/ tooth-depth 2.0))) (da (* 2.0 (/ pi teeth 4.0)))) (gl-shade-model GL_FLAT) (gl-normal 0.0 0.0 1.0) ;; draw front face (gl-begin GL_QUAD_STRIP) (dotimes (i (+ teeth 1)) (let1 _angle (* i 2.0 (/ pi teeth)) (gl-vertex (* r0 (cos _angle)) (* r0 (sin _angle)) (* width 0.5)) (gl-vertex (* r1 (cos _angle)) (* r1 (sin _angle)) (* width 0.5)) (when (< i teeth) (gl-vertex (* r0 (cos _angle)) (* r0 (sin _angle)) (* width 0.5)) (gl-vertex (* r1 (cos (+ _angle (* 3 da)))) (* r1 (sin (+ _angle (* 3 da)))) (* width 0.5))))) (gl-end) ;; draw front sides of teeth (gl-begin GL_QUADS) (dotimes (i teeth) (let1 _angle (* i 2.0 (/ pi teeth)) (gl-vertex (* r1 (cos _angle)) (* r1 (sin _angle)) (* width 0.5)) (gl-vertex (* r2 (cos (+ _angle da))) (* r2 (sin (+ _angle da))) (* width 0.5)) (gl-vertex (* r2 (cos (+ _angle (* 2 da)))) (* r2 (sin (+ _angle (* 2 da)))) (* width 0.5)) (gl-vertex (* r1 (cos (+ _angle (* 3 da)))) (* r1 (sin (+ _angle (* 3 da)))) (* width 0.5)))) (gl-end) (gl-normal 0.0 0.0 -1.0) ;; draw back face (gl-begin GL_QUAD_STRIP) (dotimes (i (+ teeth 1)) (let1 _angle (* i 2.0 (/ pi teeth)) (gl-vertex (* r1 (cos _angle)) (* r1 (sin _angle)) (* width -0.5)) (gl-vertex (* r0 (cos _angle)) (* r0 (sin _angle)) (* width -0.5)) (when (< i teeth) (gl-vertex (* r1 (cos (+ _angle (* 3 da)))) (* r1 (sin (+ _angle (* 3 da)))) (* width -0.5)) (gl-vertex (* r0 (cos _angle)) (* r0 (sin _angle)) (* width -0.5))))) (gl-end) ;; draw back sides of teeth (gl-begin GL_QUADS) (dotimes (i teeth) (let1 _angle (* i 2.0 (/ pi teeth)) (gl-vertex (* r1 (cos (+ _angle (* 3 da)))) (* r1 (sin (+ _angle (* 3 da)))) (* width -0.5)) (gl-vertex (* r2 (cos (+ _angle (* 2 da)))) (* r2 (sin (+ _angle (* 2 da)))) (* width -0.5)) (gl-vertex (* r2 (cos (+ _angle da))) (* r2 (sin (+ _angle da))) (* width -0.5)) (gl-vertex (* r1 (cos _angle)) (* r1 (sin _angle)) (* width -0.5)))) (gl-end) ;; draw outward faces of teeth (gl-begin GL_QUAD_STRIP) (dotimes (i teeth) (let ((_angle (* i 2.0 (/ pi teeth))) (u 0) (v 0) (len 0)) (gl-vertex (* r1 (cos _angle)) (* r1 (sin _angle)) (* width 0.5)) (gl-vertex (* r1 (cos _angle)) (* r1 (sin _angle)) (* width -0.5)) (set! u (- (* r2 (cos (+ _angle da))) (* r1 (cos _angle)))) (set! v (- (* r2 (sin (+ _angle da))) (* r1 (sin _angle)))) (set! len (sqrt (+ (* u u) (* v v)))) ;; canonicalize normal vector (set! u (/ u len)) (set! v (/ v len)) (gl-normal v (- u) 0.0) (gl-vertex (* r2 (cos (+ _angle da))) (* r2 (sin (+ _angle da))) (* width 0.5)) (gl-vertex (* r2 (cos (+ _angle da))) (* r2 (sin (+ _angle da))) (* width -0.5)) (gl-normal (cos _angle) (sin _angle) 0.0) (gl-vertex (* r2 (cos (+ _angle (* 2 da)))) (* r2 (sin (+ _angle (* 2 da)))) (* width 0.5)) (gl-vertex (* r2 (cos (+ _angle (* 2 da)))) (* r2 (sin (+ _angle (* 2 da)))) (* width -0.5)) (set! u (- (* r1 (cos (+ _angle (* 3 da)))) (* r2 (cos (+ _angle (* 2 da)))))) (set! v (- (* r1 (sin (+ _angle (* 3 da)))) (* r2 (sin (+ _angle (* 2 da)))))) (gl-normal v (- u) 0.0) (gl-vertex (* r1 (cos (+ _angle (* 3 da)))) (* r1 (sin (+ _angle (* 3 da)))) (* width 0.5)) (gl-vertex (* r1 (cos (+ _angle (* 3 da)))) (* r1 (sin (+ _angle (* 3 da)))) (* width -0.5)) (gl-normal (cos _angle) (sin _angle) 0.0))) (gl-vertex (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5)) (gl-vertex (* r1 (cos 0)) (* r1 (sin 0)) (* width -0.5)) (gl-end) (gl-shade-model GL_SMOOTH) ;; draw inside radius cylinder (gl-begin GL_QUAD_STRIP) (dotimes (i (+ teeth 1)) (let1 _angle (* i 2.0 (/ pi teeth)) (gl-normal (- (cos _angle)) (- (sin _angle)) 0.0) (gl-vertex (* r0 (cos _angle)) (* r0 (sin _angle)) (* width -0.5)) (gl-vertex (* r0 (cos _angle)) (* r0 (sin _angle)) (* width 0.5)))) (gl-end) )) (define *view-rotx* 20.0) (define *view-roty* 30.0) (define *view-rotz* 0.0) (define *gear1* 0) (define *gear2* 0) (define *gear3* 0) (define *angle* 0.0) (define *timer* #f) (define *frames* 0) (define *t0* 0) (define (draw) ;;*** OpenGL BEGIN *** (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) (begin (gl-push-matrix) (gl-rotate *view-rotx* 1.0 0.0 0.0) (gl-rotate *view-roty* 0.0 1.0 0.0) (gl-rotate *view-rotz* 0.0 0.0 1.0) (begin (gl-push-matrix) (gl-translate -3.0 -2.0 0.0) (gl-rotate *angle* 0.0 0.0 1.0) (gl-call-list *gear1*) (gl-pop-matrix)) (begin (gl-push-matrix) (gl-translate 3.1 -2.0 0.0) (gl-rotate (- (* -2.0 *angle*) 9.0) 0.0 0.0 1.0) (gl-call-list *gear2*) (gl-pop-matrix)) (begin (gl-push-matrix) (gl-translate -3.1 4.2 0.0) (gl-rotate (- (* -2.0 *angle*) 25.0) 0.0 0.0 1.0) (gl-call-list *gear3*) (gl-pop-matrix)) (gl-pop-matrix)) (glut-swap-buffers) (inc! *frames*) (let1 t (glut-get GLUT_ELAPSED_TIME) (when (>= (- t *t0*) 5000) (let1 seconds (/ (- t *t0*) 1000.0) (print #`",*frames* in ,seconds seconds = ,(/ *frames* seconds) FPS") (set! *t0* t) (set! *frames* 0))))) ;; new window size or exposure (define (reshape width height) (let1 h (/ height width) ;;*** OpenGL BEGIN *** (gl-viewport 0 0 width height) (gl-matrix-mode GL_PROJECTION) (gl-load-identity) (gl-frustum -1.0 1.0 (- h) h 5.0 60.0) (gl-matrix-mode GL_MODELVIEW) (gl-load-identity) (gl-translate 0.0 0.0 -40.0) ;;*** OpenGL END *** )) (define (init) ;;*** OpenGL BEGIN *** (gl-light GL_LIGHT0 GL_POSITION '#f32(5.0 5.0 10.0 0.0)) (gl-enable GL_CULL_FACE) (gl-enable GL_LIGHTING) (gl-enable GL_LIGHT0) (gl-enable GL_DEPTH_TEST) ;; make the gears (set! *gear1* (gl-gen-lists 1)) (gl-new-list *gear1* GL_COMPILE) (gl-material GL_FRONT GL_AMBIENT_AND_DIFFUSE '#f32(0.8 0.1 0.0 1.0)) (gear 1.0 4.0 1.0 20 0.7) (gl-end-list) (set! *gear2* (gl-gen-lists 1)) (gl-new-list *gear2* GL_COMPILE) (gl-material GL_FRONT GL_AMBIENT_AND_DIFFUSE '#f32(0.0 0.8 0.2 1.0)) (gear 0.5 2.0 2.0 10 0.7) (gl-end-list) (set! *gear3* (gl-gen-lists 1)) (gl-new-list *gear3* GL_COMPILE) (gl-material GL_FRONT GL_AMBIENT_AND_DIFFUSE '#f32(0.2 0.2 1.0 1.0)) (gear 1.3 2.0 0.5 10 0.7) (gl-end-list) (gl-enable GL_NORMALIZE) (newline) (print #`"GL_RENDERER = ,(gl-get-string GL_RENDERER)") (print #`"GL_VERSION = ,(gl-get-string GL_VERSION)") (print #`"GL_VENDOR = ,(gl-get-string GL_VENDOR)") (print #`"GL_EXTENSIONS = ,(gl-get-string GL_EXTENSIONS)") (newline) ;;*** OpenGL END *** ) (define (idle) (inc! *angle* 0.5) (if (> *angle* 360) (set! *angle* (fmod *angle* 360))) (glut-post-redisplay)) ;; change view angle, exit upon ESC (define (key k x y) (let1 q (lambda () (glut-post-redisplay)) (cond ((= k (char->integer #\z)) (set! *view-rotz* (fmod (+ *view-rotz* 5.0) 360)) (q)) ((= k (char->integer #\Z)) (set! *view-rotz* (fmod (- *view-rotz* 5.0) 360)) (q)) ((= k (char->integer #\escape)) (exit))))) ;; change view angle (define (special k x y) (let1 q (lambda () (glut-post-redisplay)) (cond ((= k GLUT_KEY_UP) (set! *view-rotx* (fmod (+ *view-rotx* 5.0) 360)) (q)) ((= k GLUT_KEY_DOWN) (set! *view-rotx* (fmod (- *view-rotx* 5.0) 360)) (q)) ((= k GLUT_KEY_LEFT) (set! *view-roty* (fmod (+ *view-roty* 5.0) 360)) (q)) ((= k GLUT_KEY_RIGHT) (set! *view-roty* (fmod (- *view-roty* 5.0) 360)) (q))))) (define (visible vis) (if (= vis GLUT_VISIBLE) (glut-idle-func idle) (glut-idle-func #f))) (define (main args) (glut-init args) (glut-init-display-mode (logior GLUT_DOUBLE GLUT_DEPTH GLUT_RGB)) (glut-init-window-position 0 0) (glut-init-window-size 300 300) (glut-create-window "Gears") (init) (glut-display-func draw) (glut-reshape-func reshape) (glut-keyboard-func key) (glut-special-func special) (glut-visibility-func visible) (glut-main-loop) 0) ;; end