;; Example 7-5  Multiple Display Lists to Define a Stroked Font

(use gl)
(use gl.glut)
(use gauche.uvector)
(use srfi-13)

(define *data*
  '((#\A (0 0 PT) (0 9 PT) (1 10 PT) (4 10 PT)
         (5 9 PT) (5 0 STROKE) (0 5 PT) (5 5 END))
    (#\E (5 0 PT) (0 0 PT) (0 10 PT) (5 10 STROKE)
         (0 5 PT) (4 5 END))
    (#\P (0 0 PT) (0 10 PT) (4 10 PT) (5 9 PT) (5 6 PT)
         (4 5 PT) (0 5 END))
    (#\R (0 0 PT) (0 10 PT) (4 10 PT) (5 9 PT) (5 6 PT)
         (4 5 PT) (0 5 END))
    (#\S (0 1 PT) (1 0 PT) (4 0 PT) (5 1 PT) (5 4 PT)
         (4 5 PT) (1 5 PT) (0 6 PT) (0 9 PT) (1 10 PT)
         (4 10 PT) (5 9 END))))

(define (draw-letter commands)
  (gl-begin GL_LINE_STRIP)
  (for-each (lambda (command)
              (gl-vertex (car command) (cadr command))
              (case (caddr command)
                ((PT) (values))
                ((STROKE)
                 (gl-end)
                 (gl-begin GL_LINE_STRIP))
                ((END)
                 (gl-end)
                 (gl-translate 8.0 0.0 0.0))))
            commands))

(define (init)
  (let1 base (gl-gen-lists 128)
    (gl-list-base base)
    (for-each (lambda (letter)
                (gl-new-list (+ base (char->integer (car letter))) GL_COMPILE)
                (draw-letter (cdr letter))
                (gl-end-list))
              *data*)
    (gl-new-list (+ base (char->integer #\space)) GL_COMPILE)
    (gl-translate 8.0 0.0 0.0)
    (gl-end-list)))

(define (print-stroked-string s)
  (gl-call-lists s))

(define (disp)
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-color 1.0 1.0 1.0)
  (gl-push-matrix)
  (gl-scale 2.0 2.0 2.0)
  (gl-translate 10.0 30.0 0.0)
  (print-stroked-string "A SPARE SERAPE APPEARS AS")
  (gl-pop-matrix)
  (gl-push-matrix)
  (gl-scale 2.0 2.0 2.0)
  (gl-translate 10.0 13.0 0.0)
  (print-stroked-string "APES PREPARE RARE PEPPERS")
  (gl-pop-matrix)
  (gl-flush)
  )

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

(define (keyboard key x y)
  (cond
   ((= key 32)                          ;space
    (glut-post-redisplay))
   ((= key 27)                          ;ESC
    (exit 0)))
  )

(define (main args)
  (glut-init args)
  (glut-init-display-mode (logior GLUT_SINGLE GLUT_RGB))
  (glut-init-window-size 440 120)
  (glut-create-window (car args))
  (init)
  (glut-reshape-func reshape)
  (glut-keyboard-func keyboard)
  (glut-display-func disp)
  (glut-main-loop)
  0)