#!/local/gauche/bin/gosh

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

(define xangle 0)
(define yangle 0)
(define gradient 0)
(define polygonmode 0)
(define pgm-list #f)
(define pgm-max #f)
(define pgm-width #f)
(define pgm-height #f)

; algorithm snarfed from
; http://www.cs.rit.edu/~ncs/color/t_convert.html
(define (hsv-to-rgb h s v)
  (if (= s 0)
    (f32vector v v v)
    (let* ((h (/ h 60))
           (i (floor h))
           (f (- h i))
           (p (* v (- 1 s)))
           (q (* v (- 1 (* s f))))
           (t (* v (- 1 (* s (- 1 f))))))
      (cond
        ((= i 0) (f32vector v t p))
        ((= i 1) (f32vector q v p))
        ((= i 2) (f32vector p v t))
        ((= i 3) (f32vector p q v))
        ((= i 4) (f32vector t p v))
        (else    (f32vector v p q))
      )
    )
  )
)

(define (advance-list x w vlist)
  (if (= x w) vlist (advance-list (+ x 1) w (cdr vlist)))
)

(define (do-grid w h maxval vlist)
  (let ((pv vlist)
        (ae 0)
        (xcf (/ 20.0 w))
        (ycf (/ 20.0 h))
        (zcf (/ 20.0 2000.0))
        (x 0)
        (y 1))
    (gl-new-list 1 GL_COMPILE)
    (gl-begin GL_QUAD_STRIP)
    (for-each
      (lambda (v)
        (if (= x w)
          (begin
            (gl-end)
            (gl-begin GL_QUAD_STRIP)
            (set! x 0)
            (inc! y)
          )
        )

        (if (= gradient 0)
          (let ((c (/ v maxval)))
            (gl-color c c c)
          )
          (let ((c (* 360 (/ v maxval))))
            (gl-color (hsv-to-rgb c 1 1))
          )
        )

        (gl-vertex (- (* xcf x) 10.0) (- (* ycf (- y 1)) 10.0)
          (- (* zcf (car pv)) 10.0))
        (gl-vertex (- (* xcf x) 10.0) (- (* ycf y) 10.0)
          (- (* zcf v) 10.0))

        (set! pv (cdr pv))
        (inc! x)
      )
      (advance-list 0 w vlist)
    )
    (gl-end)
    (gl-end-list)
  )
)

(define (timer x)
  (disp)
  (glut-timer-func 100 timer 0)
)

(define (disp)
  (if (= polygonmode 0)
    (gl-polygon-mode GL_FRONT_AND_BACK GL_LINE)
    (gl-polygon-mode GL_FRONT_AND_BACK GL_FILL)
  )
  (gl-clear GL_COLOR_BUFFER_BIT)
  (gl-rotate xangle 10.0 0.0 0.0)
  (gl-rotate yangle 0.0 10.0 0.0)
  (set! xangle 0.0)
  (set! yangle 0.0)
  (gl-color 0.5 0.5 0.5)
  (gl-call-list 1)
  (gl-flush)
)

(define (my-gl-init)
  (gl-clear-color 0.0 0.0 0.0 0.0)
  (gl-matrix-mode GL_PROJECTION)
  (gl-load-identity)
  (gl-ortho -15.0 15.0 -15.0 15.0 -15.0 15.0)
  ;(gl-polygon-mode GL_FRONT_AND_BACK GL_LINE)
)

(define (keyboard key x y)
  (cond
   ((= key 27) (exit 0))
   ((= key 119)
     (set! xangle (+ 1 xangle))
     (if (> xangle 359) (set! xangle 0.0))
     (glut-post-redisplay)
   )
   ((= key 115)
     (set! xangle (- xangle 1))
     (if (< xangle 0.0) (set! xangle 359.0))
     (glut-post-redisplay)
   )
   ((= key 100)
     (set! yangle (+ 1 yangle))
     (if (> yangle 359) (set! yangle 0.0))
     (glut-post-redisplay)
   )
   ((= key 97)
     (set! yangle (- yangle 1))
     (if (< yangle 0.0) (set! yangle 359.0))
     (glut-post-redisplay)
   )
  )
)

(define (menu value)
  (cond
    ((= value 0)
      (set! gradient (- 1 gradient))
      (glut-change-to-menu-entry 1
        (if (= gradient 0) "Hue Gradient" "Grayscale Gradient") 0)
      (do-grid pgm-width pgm-height pgm-max pgm-list)
    )
    ((= value 1)
      (set! polygonmode (- 1 polygonmode))
      (glut-change-to-menu-entry 2
        (if (= polygonmode 0) "Solid" "Wireframe") 1)
    )
    ((= value 2) (exit 0))
    (else (error "Unknown menu entry"))
  )
  (glut-post-redisplay)
)

(define (next-data-line)
  (let ((l (read-line)))
    (if (string-prefix? l "#") (next-data-line) l)
  )
)

(define (readpgm)
  (if (not (string=? (next-data-line) "P2"))
    (error "Not Plain PGM \"P2\" file\n"))

  (let ((vallist '())
        (w #f)
        (h #f)
        (maxval #f))
    (let ((dim (string-tokenize (next-data-line))))
      (set! w (string->number (car dim)))
      (set! h (string->number (cadr dim)))
    )

    (set! maxval (string->number (next-data-line)))

    (port-for-each
      (lambda (l)
        (for-each
          (lambda (c) (set! vallist (cons c vallist)))
          (map string->number (string-tokenize l))
        )
      )
      read-line
    )

    (values w h maxval vallist)
  )
)

(define (main args)
  (receive (w h m v) (readpgm)
    (print "Width  : " w)
    (print "Height : " h)
    (print "Max    : " m)
    (print "Values : " (length v))

    (if (not (= (* w h) (length v)))
      (error "Length of image list does not match stated width * height"))

    (glut-init args)
    (glut-init-display-mode (logior GLUT_SINGLE GLUT_RGB))
    (glut-init-window-size 250 250)
    (glut-init-window-position 100 100)
    (glut-create-window "qs")
    (my-gl-init)
    (glut-display-func disp)
    (glut-keyboard-func keyboard)
    (glut-create-menu menu)
    (glut-add-menu-entry "Hue Gradient" 0)
    (glut-add-menu-entry "Solid" 1)
    (glut-add-menu-entry "Quit" 2)
    (glut-attach-menu GLUT_RIGHT_BUTTON)
    ;(glut-timer-func 100 timer 0)

    (do-grid w h m v)

    (set! pgm-width w)
    (set! pgm-height h)
    (set! pgm-list v)
    (set! pgm-max m)

    (glut-main-loop)
  )
)