source: project/gl-display-glx/gl-util.scm @ 3309

;;; gl-util.scm
;;; 2007-02-06 - 2007-02-08
;;;
;;; The intent of this file is to provide small practical
;;; things : grid, axis, null-cube, ...

(define M_PI 3.14159265358979323846) ; from math.h

(define (load-identity)
  (gl:LoadIdentity))

(define (gl-util:initialize)
  (gl:ShadeModel gl:SMOOTH)
  (gl:ClearColor 1.0 1.0 1.0 0.0)
  (gl:ClearDepth 1.0)
  (gl:Enable     gl:DEPTH_TEST)
  (gl:DepthFunc  gl:LEQUAL)
  (gl:Hint       gl:PERSPECTIVE_CORRECTION_HINT gl:NICEST)
  (gl:Flush))

(define-macro in-mode
              (lambda (mode . rest)
                `(begin (gl:Begin ,mode)
                        ,@rest
                        (gl:End))))

(define-macro emit-points
              (lambda rest
                `(in-mode gl:POINTS ,@rest)))
(define-macro emit-quads
              (lambda rest
                `(in-mode gl:QUADS ,@rest)))
(define-macro emit-lines
              (lambda rest
                `(in-mode gl:LINES ,@rest)))
;
; One usefull event processing abstraction is related to
; the way some people have an array[255] of key to know
; the current state of key. If it the state changes and
; the query on the state are not synchronized, state
; change could be lost. A remedy would be to have for
; each event a list of its occurences (with time-stamp).
;
; Then a test on the state of a key can remove the event
; or not.
; 

; Enable backface culling.
; Default is (glCullFace gl:BACK).
(define (enable-backface-culling)
  (gl:Enable gl:CULL_FACE))

; TODO merge the two following procedure.

; Draw a unit square on the x/y plane.
(define (unit-square-xy)
  (emit-quads
    (vertex -0.5 -0.5)
    (vertex  0.5 -0.5)
    (vertex  0.5  0.5)
    (vertex -0.5  0.5)))

; Draw a square on the x/y plane. Size is given in argument.
(define (square-xy size)
  (let ((-s (/ (- size) 2))
        (s (/ size 2)))
    (emit-quads
      (vertex -s -s)
      (vertex  s -s)
      (vertex  s  s)
      (vertex -s  s))))

; Draw a grid.
; n is the number segments.
; s is the size of a segment.
(define (grid n s)
  (let ((w/2 (* s (/ n 2.0)))
        )
    (emit-lines
      (let loop ((i (- w/2)))
        (when (<= i w/2)
          (vertex i (- w/2)) ; vertical line
          (vertex i w/2)
          (vertex (- w/2) i)
          (vertex w/2 i)
          (loop (+ i s)))))))


(define (clear)
  (gl:Clear (+ gl:COLOR_BUFFER_BIT gl:DEPTH_BUFFER_BIT)))

(define (clear-color r g b . a)
  (gl:ClearColor r g b (:optional a 0)))

(define (background . args)
  (case (length args)
    ((1) (let ((a (/ (car args) 255)))
           (clear-color a a a)))
    ((3) (let ((r (/ (car args) 255))
               (g (/ (cadr args) 255))
               (b (/ (caddr args) 255)))
           (clear-color r g b)))))

(define (map_ f lst)
  (when (not (null? lst))
    (f (car lst))
    (map_ f (cdr lst))))

(define (map_2 f lst)
  (when (not (null? lst))
    (f (car lst) (cadr lst))
    (map_2 f (cddr lst))))

(define (map_3 f lst)
  (when (not (null? lst))
    (f (car lst) (cadr lst) (caddr lst))
    (map_3 f (cdddr lst))))

;

(define (vertex x y . z)
    (gl:Vertex3f x y (:optional z 0)))

(define (points_3 pts)
  (emit-points (map_3 vertex pts)))

(define (points_2 pts)
  (emit-points (map_2 vertex pts)))