;;;; complete.scm

;;;; This example illustrates phong-shading in glls with a model
;;;; loaded by opengl-glew. The file "horse.ply.gz" must be in
;;;; the same directory as this program.

;;;; NOTE:
;;;; This uses glls-render, so if this file is compiled it must be linked with OpenGL
;;;; E.g.:
;;;; csc -lGL complete.scm

;;;; Use arrow keys to rotate, zoom camera.

(import chicken scheme)
(use glls-render gl-math gl-utils (prefix glfw3 glfw:) (prefix opengl-glew gl:))

;;; Matrices
(define projection-matrix (perspective 640 480 0.01 100 70))
(define view-matrix (make-parameter #f))
(define model-matrix (rotate-y (degrees->radians 90)
                               (rotate-x (degrees->radians -90)
                                         (mat4-identity #t))))
(define mvp (make-parameter (make-f32vector 16)))
(define inverse-transpose-model
  (inverse (transpose model-matrix)
           #t))

;;; Camera movement
(define pan (make-parameter 0))
(define zoom (make-parameter 0))
(define angle (make-parameter 0))
(define distance (make-parameter 0.2))
(define camera-position (make-parameter (make-f32vector 3 0)))

(glfw:key-callback
 (lambda (window key scancode action mods)
   (cond
    [(and (eq? key glfw:+key-escape+) (eq? action glfw:+press+))
     (glfw:set-window-should-close window 1)]
    [(and (eq? key glfw:+key-left+) (eq? action glfw:+press+))
     (pan (sub1 (pan)))]
    [(and (eq? key glfw:+key-right+) (eq? action glfw:+press+))
     (pan (add1 (pan)))]
    [(and (eq? key glfw:+key-left+) (eq? action glfw:+release+))
     (pan (add1 (pan)))]
    [(and (eq? key glfw:+key-right+) (eq? action glfw:+release+))
     (pan (sub1 (pan)))]
    [(and (eq? key glfw:+key-up+) (eq? action glfw:+press+))
     (zoom (sub1 (zoom)))]
    [(and (eq? key glfw:+key-down+) (eq? action glfw:+press+))
     (zoom (add1 (zoom)))]
    [(and (eq? key glfw:+key-up+) (eq? action glfw:+release+))
     (zoom (add1 (zoom)))]
    [(and (eq? key glfw:+key-down+) (eq? action glfw:+release+))
     (zoom (sub1 (zoom)))])))

(define (update)
  (angle (+ (angle) (/ (pan) 30)))
  (if (positive? (+ (distance) (* (zoom) 0.005)))
      (distance (+ (distance) (* (zoom) 0.005))))
   (let ([camera-x (* (distance) (sin (angle)))]
         [camera-z (* (distance) (cos (angle)))])
     (f32vector-set! (camera-position) 0 camera-x)
     (f32vector-set! (camera-position) 2 camera-z)
     (view-matrix (look-at camera-x 0 camera-z
                           0 0 0
                           0 1 0)))
   (mvp (m* projection-matrix
            (m* (view-matrix) model-matrix)
            (mvp))))

;;; Rendering
(define-pipeline phong-shader 
  ((#:vertex input: ((vertex #:vec3) (normal #:vec3))
             uniform: ((mvp #:mat4) (model #:mat4) (inv-transpose-model #:mat4))
             output: ((p #:vec3) (n #:vec3)))
   (define (main) #:void
     (set! gl:position (* mvp (vec4 vertex 1.0)))
     (set! p (vec3 (* model (vec4 vertex 1))))
     (set! n (- ; Normals facing in for this model
              (normalize (vec3 (* inv-transpose-model (vec4 normal 0))))))))
  ((#:fragment input: ((n #:vec3) (p #:vec3))
               uniform: ((camera-position #:vec3))
               output: ((frag-color #:vec4)))
   (let ((light-position #:vec3 (vec3 0 0 2))
         (light-diffuse #:vec3 (vec3 0.7 0.7 0.7))
         (light-specular #:vec3 (vec3 1 1 1))
         (ambient #:vec3 (vec3 0.2 0.2 0.2))
         (surface-ambient #:vec3 (vec3 0.2 0.1 0))
         (surface-diffuse #:vec3 (vec3 0.2 0.1 0.04))
         (surface-specular #:vec3 (vec3 0.4 0.4 0.4))
         (specular-exponent #:float 100.0))
     (define (main) #:void
       (let* ((ambient-intensity #:vec3 (* ambient surface-ambient))
              (to-light #:vec3 (normalize (- light-position p)))
              (diffuse-intensity #:vec3 (* light-diffuse surface-diffuse
                                           (max (dot to-light n) 0)))
              (spec #:float (max (dot (reflect (- to-light) n)
                                      (normalize (- camera-position p)))
                                 0))
              (specular-intensity #:vec3 (* light-specular surface-specular
                                            (expt spec specular-exponent))))
         (set! frag-color
           (vec4 (+ ambient-intensity diffuse-intensity specular-intensity)
                 (swizzle n x))))))))

(define renderable (make-parameter #f))

;;; Initialize and main loop
(glfw:with-window (640 480 "Example" resizable: #f)
   (gl:init)
   (gl:enable gl:+depth-test+)
   (gl:depth-func gl:+less+)
   (compile-pipelines)
   (map (lambda (s) (print (shader-source s))) (pipeline-shaders phong-shader))
   (renderable (receive (r vertex-data index-data)
                   (load-ply-renderable
                    "horse.ply.gz"
                    make-phong-shader-renderable
                    vertex: `((,(pipeline-attribute 'vertex phong-shader)
                               x y z)
                              (,(pipeline-attribute 'normal phong-shader)
                               nx ny nz))
                    face: 'vertex_indices
                    mvp: (mvp)
                    model: model-matrix
                    camera-position: (camera-position)
                    inv-transpose-model: inverse-transpose-model)
                 (list r vertex-data index-data))) ; Gotta keep the data safe from being GC'd
   (let loop ()
     (glfw:swap-buffers (glfw:window))
     (gl:clear (bitwise-ior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
     (update)
     (render-phong-shader (car (renderable)))
     (check-error)
     (glfw:poll-events)
     (unless (glfw:window-should-close (glfw:window))
       (loop))))