Sophie

Sophie

distrib > Fedora > 15 > i386 > by-pkgid > 732693838133900f9b7cdf5a0a2e5f55 > files > 70

gauche-gl-0.5-1.fc15.i686.rpm

;;
;; Calculate and show Mandelbrot set.
;;

(use gauche.uvector)
(use gl)
(use gl.glut)
(use math.const)

(define *size*  256)
(define *image* (make-u8vector (* *size* *size* 3) 0))
(define *tex* #f)

(define *speed-phi* 0)
(define *xrot* 0)
(define *yrot* 0)

(define (fill-image)
  (dotimes (y *size*)
    (dotimes (x *size*)
      (let ((i (* (+ (* y *size*) x) 3))
            (z (make-rectangular (- (* 3 (/ x *size*)) 2)
                                 (- (* 3 (/ y *size*)) 1.5))))
        (letrec ((rank (lambda (zn n)
                         (cond ((>= n 16) 0)
                               ((>= (magnitude zn) 2) n)
                               (else (rank (+ (* zn zn) z) (+ n 1)))))))
          (let ((r (rank z 0)))
            (u8vector-set! *image* i       (ash (logand r #xc) 4))
            (u8vector-set! *image* (+ i 1) (ash (logand r #x2) 6))
            (u8vector-set! *image* (+ i 2) (ash (logand r #x1) 7))
            ))))))

(define (init)
  (fill-image)
  (gl-clear-color 0.0 0.0 0.0 0.0)
  (gl-shade-model GL_FLAT)
  (set! *tex* (u32vector-ref (gl-gen-textures 1) 0))
  (gl-bind-texture GL_TEXTURE_2D *tex*)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST)
  (gl-tex-image-2d GL_TEXTURE_2D 0 GL_RGB *size* *size* 0
                   GL_RGB GL_UNSIGNED_BYTE *image*)
  )

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-enable GL_TEXTURE_2D)
  (gl-tex-env GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_REPLACE)
  (gl-bind-texture GL_TEXTURE_2D *tex*)
  (gl-push-matrix)
  (gl-load-identity)
  (gl-translate 0.5 0.5 0.0)
  (gl-rotate *xrot* 1.0 0.0 0.0)
  (gl-rotate *yrot* 0.0 1.0 0.0)
  (gl-translate -0.5 -0.5 0.0)
  (gl-begin GL_QUADS)
  (gl-tex-coord '#f32(0.0 0.0)) (gl-vertex '#f32(0.0 0.0))
  (gl-tex-coord '#f32(0.0 1.0)) (gl-vertex '#f32(0.0 1.0))
  (gl-tex-coord '#f32(1.0 1.0)) (gl-vertex '#f32(1.0 1.0))
  (gl-tex-coord '#f32(1.0 0.0)) (gl-vertex '#f32(1.0 0.0))
  (gl-end)
  (gl-pop-matrix)
  (glut-swap-buffers)
  (gl-disable GL_TEXTURE_2D)
  (animate)
  )

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-ortho-2d 0 1 0 1)
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity)
  )

(define (animate)
  (let1 speed (abs (sin (* *speed-phi* pi/180)))
    (set! *xrot* (fmod (+ *xrot* (/ speed 172.0)) 360.0))
    (set! *yrot* (fmod (+ *yrot* (/ speed 334.0)) 360.0))
    (set! *speed-phi* (fmod (+ *speed-phi* 0.003) 360.0)))
  (glut-post-redisplay)
  )

(define (main args)
  (glut-init args)
  (glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGB))
  (glut-init-window-size 256 256)
  (glut-create-window "mandelbrot")
  (init)
;  (glut-idle-func animate)
  (glut-reshape-func reshape)
  (glut-display-func disp)
  (glut-main-loop)
  0
  )