;;;
;;; Contributed by Issac Trotts
;;;
;;; $Id: gl-plot.scm,v 1.1 2006-11-09 10:43:55 shirok Exp $
;;;

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

(define *pad* 30)

(define (range n)
  (define (aux acc n)
    (if (<= n 0)
      acc
      (aux (cons (- n 1) acc) (- n 1))))
  (aux '() n))

(define (iter f ls)
  (cond
    ((null? ls)) ; do nothing
    ((pair? ls)
     (f (car ls))
     (iter f (cdr ls)))
    (else (error "Cannot iterate over a non-list"))))

(define (iter2 f lsa lsb)
  (cond
    ((or (null? lsa) (null? lsb))) ; do nothing
    ((and (pair? lsa) (pair? lsb))
     (f (car lsa) (car lsb))
     (iter2 f (cdr lsa) (cdr lsb)))
    (else (error "Cannot iterate over a non-list"))))

(define (draw-string x y s)
  (gl-raster-pos x y)
  (iter (lambda (c) (glut-bitmap-character GLUT_BITMAP_8_BY_13
                                           (char->integer c)))
        (string->list s)))

(define plot
  (let1 have-called-glut-init #f
    (lambda (f a b)
      (let ((w 500)
            (h 500))
        (if (not have-called-glut-init)
          (begin
            (glut-init '())
            (set! have-called-glut-init #t)))
        (glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGBA))
        (glut-init-window-size w h)
        (glut-create-window "plot")

                                        ; Initialize GL
        (begin
          (gl-enable GL_BLEND)
          (gl-blend-func GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
          (gl-enable GL_LINE_SMOOTH)
          (gl-clear-color 1.0 1.0 1.0 1.0)
          )
        (let*
            ((xs (map (lambda (x) (+ a (* (- b a) (/ x w)))) (range w)))
             (ys (map f xs))
             (mx (apply max ys))
             (mn (apply min ys)))
          (glut-reshape-func
           (lambda (new-w new-h)
             (gl-viewport 0 0 new-w new-h)
             (set! w new-w)
             (set! h new-h)
             ))
          (glut-display-func
           (lambda ()
             (gl-clear GL_COLOR_BUFFER_BIT)
             (gl-color 0 0 0 1)

             ;; Draw the plot
             (begin
               (gl-viewport *pad* *pad* (- w (* 2 *pad*)) (- h (* 2 *pad*)))
               (gl-matrix-mode GL_PROJECTION)
               (gl-load-identity)
               (glu-ortho-2d a b mn mx)
               (gl-matrix-mode GL_MODELVIEW)
               (gl-load-identity)
               (gl-begin GL_LINE_STRIP)
               (iter2 (lambda (x y) (gl-vertex x y 0.0)) xs ys)
               (gl-end)
               )

             ;; Change to pixel coordinates
             (begin
               (gl-viewport 0 0 w h)
               (gl-matrix-mode GL_PROJECTION)
               (gl-load-identity)
               (glu-ortho-2d 0 w 0 h)
               )

             ;; Show a, b, min, max.
             (let1 pad2 (/ *pad* 2)
               (draw-string pad2        (/ h 2)    (format #f "~a" a))
               (draw-string (- w *pad*) (/ h 2)    (format #f "~a" b))
               (draw-string (/ w 2)     (- h pad2) (format #f "~a" mx))
               (draw-string (/ w 2)     pad2       (format #f "~a" mn))
               )

             ;; Todo: Show axis labels.

             ;; Todo: show tick marks

             (glut-swap-buffers)
             ))
          (glut-keyboard-func
           (lambda (key x y)
             (case (integer->char key)
               ((#\q) (error "Don't worry about this error.")))))
          (guard (exc (else 'foo))
            (glut-main-loop))
          0
          )))))