新・物理入門問題演習 111頁

wave.scm

(use gauche.threads)
(use math.const)
(use srfi-42)
(use gl)
(use gl.glut)

(define a 40)
(define A 10)
(define f 1)
; v = 3/4 fa
(define v 30)
(define d 4)

(define (wave t x y)
  (let* ((inv-v (/. 1 v))
         (a/2 (*. a 0.5))
         (sq (^x (*. x x)))
         (r1 (sqrt (+. (sq (+. x a/2)) (sq y))))
         (r2 (sqrt (+. (sq (-. x a/2)) (sq y)))))
    (*. 2 A
        (sin (*. 2 pi f (-. t (*. (+. r1 r2) 0.5 inv-v))))
        (cos (*. (-. r1 r2) pi inv-v)))))

(define (main args)
  (define elapsed-time 0)
  (define theta-x 0)
  (define theta-y 0)
  (define theta-z 0)
  (define scale 1)
  (glut-init args)
  (glut-init-display-mode (logior GLUT_RGBA GLUT_DOUBLE GLUT_DEPTH))
  (glut-init-window-position 0 0)
  (glut-init-window-size 700 500)
  (glut-create-window "Wave")
  (gl-shade-model GL_SMOOTH)
  (gl-enable GL_DEPTH_TEST)
  (gl-enable GL_COLOR_MATERIAL)
  (gl-enable GL_LIGHTING)
  (gl-enable GL_LIGHT0)
  (gl-enable GL_NORMALIZE)
  (glut-reshape-func
   (^(width height)
     (gl-viewport 0 0 width height)
     (gl-matrix-mode GL_PROJECTION)
     (gl-load-identity)
     (gl-scale (/. height width) 1 1)))
  (glut-keyboard-func
   (^(key x y)
     (case (integer->char key)
       ((#\h) (dec! theta-z))
       ((#\l) (inc! theta-z))
       ((#\j) (inc! theta-y))
       ((#\k) (dec! theta-y))
       ((#\u) (inc! theta-x))
       ((#\d) (dec! theta-x))
       ((#\+) (inc! scale 0.01))
       ((#\-) (dec! scale 0.01)))
     (glut-post-redisplay)))
  (glut-idle-func
   (^() (set! elapsed-time (/. (glut-get GLUT_ELAPSED_TIME) 1000))
        (glut-post-redisplay)))
  (glut-display-func
   (^()
     (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
     (gl-light-model GL_LIGHT_MODEL_AMBIENT #f32(.2 .2 .2 1))
     (gl-light GL_LIGHT0 GL_DIFFUSE #f32(.5 .5 .5 1))
     (gl-light GL_LIGHT0 GL_POSITION #f32(20 20 20 1))
     (gl-matrix-mode GL_MODELVIEW)
     (gl-load-identity)
     (gl-scale .01 .01 .01)
     (gl-rotate 40 1 0 0)
     (gl-rotate 30 0 0 1)
     (gl-rotate theta-x 1 0 0)
     (gl-rotate theta-y 0 1 0)
     (gl-rotate theta-z 0 0 1)
     (gl-scale scale scale scale)
     (gl-color .2 1 .5)
     (gl-begin* GL_TRIANGLES
       (do-ec (: x -100 (- 100 d) d) (: y -100 (- 100 d) d)
         (let ((p (wave elapsed-time x y))
               (q (wave elapsed-time (+. x d) y))
               (r (wave elapsed-time (+. x d) (+. y d)))
               (s (wave elapsed-time x (+. y d))))
           (gl-vertex x y p)
           (gl-vertex (+. x d) y q)
           (gl-vertex (+. x d) (+. y d) r)
           (gl-vertex x y p)
           (gl-vertex (+. x d) (+. y d) r)
           (gl-vertex x (+. y d) s))))
     (glut-swap-buffers)))
  (glut-main-loop)
  ; (thread-start! (make-thread (.$ glut-main-loop)))
  ; (read-eval-print-loop)
  0)