Sophie

Sophie

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

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

;; Example 9-5  Mipmap Textures

(use gl)
(use gl.glut)
(use gauche.uvector)
(use srfi-1)
(use gauche.collection)

(define *mipmap*
  (map (lambda (i)
         (let1 size (expt 2 i)
           (make-u8vector (* size size 4))))
       (iota 6)))
(define *mm-colors*
  '((255 255 255)
    (0 0 255)
    (0 255 0)
    (255 0 0)
    (255 0 255)
    (255 255  0)))

(define *texname* 0)

(define (make-images)
  (dotimes (s 6)
    (let ((size (expt 2 s))
          (image (list-ref *mipmap* s))
          (colors (list-ref *mm-colors* s)))
      (dotimes (i size)
        (dotimes (j size)
          (let1 ij (* 4 (+ (* i size) j))
            (set! (ref image ij)       (ref colors 0))
            (set! (ref image (+ ij 1)) (ref colors 1))
            (set! (ref image (+ ij 2)) (ref colors 2))
            (set! (ref image (+ ij 3)) 255)))))))

(define (init)
  (gl-enable GL_DEPTH_TEST)
  (gl-shade-model GL_FLAT)

  (gl-translate 0.0 0.0 -3.6)
  (make-images)
  (gl-pixel-store GL_UNPACK_ALIGNMENT 1)

  (let1 texnames (gl-gen-textures 1)
    (set! *texname* (ref texnames 0))
    (gl-bind-texture GL_TEXTURE_2D *texname*))
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST)
  (gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST_MIPMAP_NEAREST)
  (for-each (lambda (image level)
              (let1 size (expt 2 (- 5 level))
                (gl-tex-image-2d GL_TEXTURE_2D level GL_RGBA size size 0
                                 GL_RGBA GL_UNSIGNED_BYTE image)))
            (reverse *mipmap*)
            (iota 6))
  (gl-tex-env GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_DECAL)
  (gl-enable GL_TEXTURE_2D)
  )

(define (disp)
  (gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
  (gl-bind-texture GL_TEXTURE_2D *texname*)
  (gl-begin GL_QUADS)
  (gl-tex-coord 0.0 0.0) (gl-vertex -2.0 -1.0 0.0)
  (gl-tex-coord 0.0 8.0) (gl-vertex -2.0 1.0 0.0)
  (gl-tex-coord 8.0 8.0) (gl-vertex 2000.0 1.0 -6000.0)
  (gl-tex-coord 9.0 0.0) (gl-vertex 2000.0 -1.0 -6000.0)
  (gl-end)
  (gl-flush)
  )

(define (reshape w h)
  (gl-viewport 0 0 w h)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (glu-perspective 60.0 (/ w h) 1.0 30000.0)
  (gl-matrix-mode GL_MODELVIEW)
  (gl-load-identity))

(define (keyboard key x y)
  (cond
   ((= key 27) (exit 0))
   ))

(define (main args)
  (glut-init args)
  (glut-init-display-mode (logior GLUT_SINGLE GLUT_RGB GLUT_DEPTH))
  (glut-init-window-size 500 500)
  (glut-init-window-position 50 50)
  (glut-create-window (car args))
  (init)
  (glut-display-func disp)
  (glut-reshape-func reshape)
  (glut-keyboard-func keyboard)
  (glut-main-loop)
  0)