;; -*- mode: scheme; -*-
;; Planet Fluxus Copyright (C) 2013 Dave Griffiths
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(load "flx/scm/base.jscm")
(load "flx/scm/texture.jscm")
(load "flx/scm/maths.jscm")
(load "flx/scm/glsl.jscm")
(load "flx/scm/state.jscm")
(load "flx/scm/pdata.jscm")
(load "flx/scm/scenegraph.jscm")
(load "flx/scm/primitive.jscm")
(load "flx/scm/data.jscm")
(load "flx/scm/shaders.jscm")
(load "flx/scm/renderer.jscm")
(load "flx/scm/instanceprim.jscm")
(load "flx/scm/polyprim.jscm")
(load "flx/scm/geometry.jscm")
(load "flx/scm/meshcache.jscm")
(load "flx/scm/shadercache.jscm")

(define the-renderer 0)

(define flx-start-time (js "new Date().getTime()/1000"))
 
(define (time) 
  (let ((time-now (js "new Date()")))
    (- (/ (time-now.getTime) 1000) 
       flx_start_time)))

(define (push) (set! the-renderer (renderer-stack-dup the-renderer)))
(define (pop) (set! the-renderer (renderer-stack-pop the-renderer)))

;; due to the way with-primitive macro works, an unknown/bad
;; primitive id with cause following state modifications to 
;; happen to the global state!!!
(define (grab id) (set! the-renderer (renderer-grab-stack-push the-renderer id)))
(define (ungrab) (set! the-renderer (renderer-grab-stack-pop the-renderer)))

(define (identity)
  (mat4.identity (renderer-current-tx the-renderer)))

(define (translate v)
  (mat4.translate (renderer-current-tx the-renderer) v))

(define (rotate v)
  (mat4.rotate (renderer-current-tx the-renderer) (* (vx v) 0.0174532925) (list 1 0 0))
  (mat4.rotate (renderer-current-tx the-renderer) (* (vy v) 0.0174532925) (list 0 1 0))
  (mat4.rotate (renderer-current-tx the-renderer) (* (vz v) 0.0174532925) (list 0 0 1)))

(define aim-matrix (mat4.create))

(define (maim v up)
  (let ((l (vector 0 0 0))
	(u (vector 0 0 0)))
    (vec3.cross v up l)
    (vec3.cross v l u)

    (js "aim_matrix[0]=vx(v);")
    (js "aim_matrix[1]=vy(v);")
    (js "aim_matrix[2]=vz(v);")
    (js "aim_matrix[3]=0;")

    (js "aim_matrix[4]=vx(l);")
    (js "aim_matrix[5]=vy(l);")
    (js "aim_matrix[6]=vz(l);")
    (js "aim_matrix[7]=0;")

    (js "aim_matrix[8]=vx(u);")
    (js "aim_matrix[9]=vy(u);")
    (js "aim_matrix[10]=vz(u);")
    (js "aim_matrix[11]=0;")

    (js "aim_matrix[12]=0;")
    (js "aim_matrix[13]=0;")
    (js "aim_matrix[14]=0;")
    (js "aim_matrix[15]=1;")

    (mat4.multiply (renderer-current-tx the-renderer) aim-matrix)))

(define (concat m)
    (mat4.multiply (renderer-current-tx the-renderer) m))

(define (get-transform)
  (renderer-current-tx the-renderer))

(define (get-global-transform)
  (renderer-global-tx the-renderer))

(define (camera-transform)
  (renderer-camera the-renderer))

(define (set-camera-transform tx)
  (set! the-renderer (renderer-modify-camera the-renderer tx)))

(define (set-camera-angle a)
  (set! the-renderer (renderer-modify-view-angle the-renderer a)))

(define (get-camera-angle a)
  (renderer-view-angle the-renderer))

;;(define (vtransform m v)
;; (mat4.multiplyVec3 m v))

(define (clear-colour col)
  (set! the-renderer (renderer-modify-clear-colour the-renderer col)))

(define (view-transform)
  (renderer-view the-renderer))

;; returns the 2D screen coordinate of a 3D world space one
(define (project-point p)
  (let ((ret (list (vx p) (vy p) (vz p) 1)))
    (mat4.multiplyVec4 (renderer-world-to-screen the-renderer) ret)
    (let ((z (list-ref ret 3)))
      (vec3.create 
       (list (* (+ (/ (vx ret) z) 1) screen-width 0.5)
	     (* (+ (/ (- 0 (vy ret)) z) 1) screen-height 0.5)
	     0)))))

(define (ndc-coords gl v z)
  (list
   (* 2 (- (/ (vx v) gl.viewportWidth) 1))
   (* -2 (- (/ (vy v) gl.viewportHeight) 1))
   z
   1))

(define (divide-w v)
  (vector 
   (/ (vx v) (list-ref v 3))
   (/ (vy v) (list-ref v 3))
   (/ (vz v) (list-ref v 3))))

;; returns the 3D line representing a screen space coordinate
;; not yet working...
(define (unproject-point p)
  (let ((gl (renderer-gl the-renderer))
	(screen-to-world (minverse (renderer-world-to-screen the-renderer))))
    (divide-w (mat4.multiplyVec4 screen-to-world (ndc-coords gl (list (vx p) (vy p)) 0)))))

;; screen point to world coordinate
(define (unproject-point-ortho pos)
  ;; pos is in screen pixel space
  ;; so divide to normalise (0 - 1)
  (let ((scr-aspect (/ screen-width screen-height))
	(norm (vector (/ (vx pos) screen-width)
		      (/ (vy pos) screen-height)
		      0)))
    ;; convert into ortho world coordinates but account for half scale
    (let ((top (frustum-top (renderer-frustum the-renderer))))
      (vector
       (* (/ (- (vx pos) (/ screen-width 2)) screen-width) (* top scr-aspect 2))
       (* (/ (- (/ screen-height 2) (vy pos)) screen-height) (* top 2)) 
       (* (vy norm) 0.1)))))

(define (primitive-screen-pos p)
  (project-point
   (with-primitive p (mtransform (get-transform) (vector 0 0 0)))))

(define (primitive-global-screen-pos p)
  (project-point
   (with-primitive p (mtransform (get-global-transform) (vector 0 0 0)))))

(define (scale v)
  (mat4.scale (renderer-current-tx the-renderer) v))

(define (load-texture name)
  (load-texture-impl!
   (renderer-gl the-renderer)
   (+ "textures/" name)))

(define (texture name)
  (set! the-renderer (renderer-modify-current-state
           the-renderer
           (lambda (state)
             (state-modify-texture state name)))))

(define (shader-compile name attrib-names vert frag)
  (internal-load-shader-cache (renderer-gl the-renderer) name attrib-names vert frag))

(define (shader-assign-compiled name)
  (set! the-renderer 
	(renderer-modify-current-state
	 the-renderer
           (lambda (state)
             (state-modify-shader
              state
              (shader-cache-search name))))))

(define (shader vert frag)
  (set! the-renderer 
	(renderer-modify-current-state
	 the-renderer
           (lambda (state)
             (state-modify-shader
              state
              (build-shader (renderer-gl the-renderer) 
			    (list "p" "n" "t" "c") vert frag))))))

;; use this version for defining custon attributes
;; all vec3 at the moment...
(define (shader-attrib-names names vert frag)
  (set! the-renderer 
	(renderer-modify-current-state
	 the-renderer
	 (lambda (state)
	   (state-modify-shader
	    state
	    (build-shader (renderer-gl the-renderer) names vert frag))))))

;; setting uniforms - this one sets the unform for this shader program
;; affecting all primitives using it
(define (shader-shared-uniform! name type value)
  (set! the-renderer 
	(renderer-modify-current-state
	 the-renderer
           (lambda (state)
	     (let ((gl (renderer-gl the-renderer))
		   (shader (state-shader state)))
	       (gl.useProgram shader) 
	       (internal-uniform! gl shader name type value)
	       state)))))

;; setting uniforms - locally to this primitive state only
(define (shader-uniform! name type value)
  (set! the-renderer 
	(renderer-modify-current-state
	 the-renderer
           (lambda (state)
	     (let ((gl (renderer-gl the-renderer)))
	       (state-modify-uniform-items
		state (set-uniform-item
		       (make-uniform-item name type value)
		       (state-uniform-items state))))))))

(define (colour col)
  (set! the-renderer (renderer-modify-current-state
           the-renderer
           (lambda (state)
             (state-modify-colour state col)))))

(define (every-frame-impl hook)
  (set! the-renderer (renderer-modify-hook the-renderer hook)))

(define (draw-cube)
  (set! the-renderer (renderer-immediate-add
	   the-renderer (list-ref (renderer-prefab the-renderer) 0))))

(define (draw-sphere)
  (set! the-renderer (renderer-immediate-add
	   the-renderer (list-ref (renderer-prefab the-renderer) 1))))

(define (draw-torus)
  (set! the-renderer (renderer-immediate-add
	   the-renderer (list-ref (renderer-prefab the-renderer) 2))))

(define (draw-obj obj)
  (set! the-renderer (renderer-immediate-add
	   the-renderer (list-ref (renderer-prefab the-renderer) obj))))

(define (build-polygons type size-verts)
  (let ((gl (renderer-gl the-renderer)))
    (add-to-scenegraph!     
     (primitive
      'polyprim
      (build-empty-polyprim gl type size-verts)))))

;; build a new primitive which is a combination of the supplied ones
(define (build-combined polyprim-id-list)
  (let ((gl (renderer-gl the-renderer)))
	(add-to-scenegraph!     
     (primitive
      'polyprim
      (polyprim-combine
	   gl (map
		   (lambda (id)
			 (scenenode-primitive
			  (scenegraph-find (renderer-scenegraph the-renderer) id)))
		   polyprim-id-list))))))

(define (get-parent)
  (if (renderer-grabbed? the-renderer)
	  (state-parent (renderer-stack-top the-renderer)) ;; parent from state 
	  -1))

(define (get-children)
  (if (renderer-grabbed? the-renderer)
	  (map
	   (lambda (p)
		 (scenenode-id p))
	   (scenenode-children (renderer-grab-stack-top the-renderer)))
	  '()))

(define (print-scenegraph)  
  (scenegraph-print (renderer-scenegraph the-renderer) 0))

(define (apply-transform!)
  (let ((tx (get-transform)))
    (pdata-map!
     (lambda (p)
       (mtransform tx p))
     "p")
	(pdata-map!
	 (lambda (p)
	   (mtransform-norm tx p))
     "n")
	(identity)))

;; does not unparent.
(define (apply-global-transform!)
  (let ((tx (get-global-transform)))
    (pdata-map!
     (lambda (p)
       (mtransform tx p))
     "p")
	(pdata-map!
	 (lambda (p)
       (mtransform-norm tx p))
     "n")
	(identity)))

(define (set-hint! hint)
  (set! the-renderer 
	(renderer-modify-current-state
	 the-renderer (lambda (state)
	     (state-modify-hints state (bitwise-or (state-hints state) hint))))))

(define (clear-hints!)
  (set! the-renderer 
	(renderer-modify-current-state
	 the-renderer (lambda (state)
	     (state-modify-hints state 0)))))

(define (hint-none) (clear-hints!))
(define (hint-solid) (set-hint! FLX_HINT_SOLID))
(define (hint-wire) (set-hint! FLX_HINT_WIRE))
(define (hint-ignore-depth) (set-hint! FLX_HINT_IGNORE_DEPTH))
(define (hint-nozwrite) (set-hint! FLX_HINT_NOZWRITE))
(define (hint-cullface) (set-hint! FLX_HINT_CULL_FACE))
(define (hint-cullccw) (set-hint! FLX_HINT_CULL_CCW))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; loading meshes

(define (load-primitive url)
  (let ((gl (renderer-gl the-renderer))
	(raw (mesh-cache-search url)))
    (add-to-scenegraph!     
     (primitive
      'polyprim
      (build-polyprim gl 'triangles raw)))))

(define (load-ply-primitive url)
  (let ((gl (renderer-gl the-renderer))
	(raw (mesh-cache-search url)))
    (add-to-scenegraph!     
     (primitive
      'polyprim
      (build-polyprim gl 'triangles raw)))))

;; (list
;; 	(buffer gl "p" (list-ref raw 0) 3)
;; 	(buffer gl "n" (list-ref raw 1) 3)
;; 	(buffer gl "t" (list-ref raw 0) 3)
;; 	))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; retained mode

(define next-id 0)
(define (new-id) 
  (set! next-id (+ next-id 1))
  next-id)

(define (parent id)
  (set! the-renderer (renderer-modify-current-state
           the-renderer
           (lambda (state)
             (state-modify-parent state id)))))



(define (hide v)
  (set! the-renderer (renderer-modify-current-state
           the-renderer
           (lambda (state)
             (state-modify-hidden state v)))))

(define (add-to-scenegraph! prim)
  (let ((id (new-id)))
    (set! the-renderer (renderer-modify-scenegraph
	     the-renderer 
	     (scenegraph-add 
	      (renderer-scenegraph the-renderer) 
	      (state-parent (renderer-stack-top the-renderer)) ;; parent from state 
	      (scenenode
	       id 
	       (state-clone (renderer-stack-top the-renderer)) ;; stack
	       prim
	       '() ;; children
	       ))))
    id))

(define (destroy id)
  (set! the-renderer 
	(renderer-modify-scenegraph
	 the-renderer (scenegraph-remove 
		       (renderer-scenegraph the-renderer) 
		       id))))

(define (build-cube)
  (add-to-scenegraph! (list-ref (renderer-prefab the-renderer) 0)))

(define (build-instance polyref)
  (add-to-scenegraph! 
   (primitive 
    'instanceprim 
    (instanceprim 
     (primitive-inner
      (scenenode-primitive 
       (scenegraph-find 
	(renderer-scenegraph the-renderer) 
	polyref)))))))

(define (build-locator)
  ;; locator is an empty primitive for positioning things 
  ;; in the scenegraph - we might want to add axis rendering
  ;; for debugging
  (add-to-scenegraph! 
   (primitive 'locatorprim 0)))

(define (pdata-map! fn name)
  (when (renderer-grabbed? the-renderer)
	(pdata-internal-map!
	 (renderer-gl the-renderer) 
	 ;; todo: check type is polyprim
	 (polyprim-pdata 
	  (primitive-inner
	   (scenenode-primitive (renderer-grab-stack-top the-renderer))))
	 fn name)))

(define (pdata-index-map! fn name)
  (when (renderer-grabbed? the-renderer)
	(pdata-internal-index-map!
	 (renderer-gl the-renderer) 
	 ;; todo: check type is polyprim
	 (polyprim-pdata 
	  (primitive-inner
	   (scenenode-primitive (renderer-grab-stack-top the-renderer))))
	 fn name)))

(define (pdata-fold fn start name)
  (when (renderer-grabbed? the-renderer)
	(pdata-internal-fold
	 ;; todo: check type is polyprim
	 (polyprim-pdata 
	  (primitive-inner
	   (scenenode-primitive (renderer-grab-stack-top the-renderer))))
	 fn start name)))

(define (pdata-add! name)
  (when (renderer-grabbed? the-renderer)
	 ;; todo: check type is polyprim
	(let ((pp (primitive-inner
		   (scenenode-primitive (renderer-grab-stack-top the-renderer)))))
	  (pdata-internal-add!
	   (renderer-gl the-renderer) 
	   (polyprim-pdata pp)
	   name))))

(define (pdata-exists? name)
  (if (renderer-grabbed? the-renderer)
	  ;; todo: check type is polyprim
	  (let ((pp (primitive-inner
				 (scenenode-primitive (renderer-grab-stack-top the-renderer)))))
		(pdata-offset (polyprim-pdata pp) name))
	  #f))

(define (pdata-copy! from to)
  (msg "pc")
  (when (not (pdata-exists? to))
		(pdata-add! from))
  ;; probably a quicker way...
  (pdata-index-map!
   (lambda (i o)
	 (pdata-ref from i))
   to))

(define (pdata-size)
  (when (renderer-grabbed? the-renderer)
	;; todo: check type is polyprim
	(let ((pp (primitive-inner
		   (scenenode-primitive (renderer-grab-stack-top the-renderer)))))
	  (pdata-size-verts  
	   (polyprim-pdata pp)))))

(define (pdata-set! name pos value)
  (when (renderer-grabbed? the-renderer)
	 ;; todo: check type is polyprim
	(let ((pp (primitive-inner
		   (scenenode-primitive (renderer-grab-stack-top the-renderer)))))
	  (pdata-internal-set!
	   (renderer-gl the-renderer) 
	   (polyprim-pdata pp)
	   name (modulo pos (polyprim-size pp)) value))))

(define (pdata-ref name pos)
  (when (renderer-grabbed? the-renderer)
	 ;; todo: check type is polyprim
	(let ((pp (primitive-inner
		   (scenenode-primitive (renderer-grab-stack-top the-renderer)))))
	  (pdata-internal-ref
	   (renderer-gl the-renderer) 
	   (polyprim-pdata pp)
	   name (modulo pos (polyprim-size pp))))))

;; new command to upload the vbo from the modified data - use for 
;; pdata-set! (maybe pdata-map! in the future???)
(define (pdata-upload!)
  (let ((grabbed (renderer-grab-stack-top the-renderer)))
    (when grabbed
	  (pdata-update-vbo! 
	   (renderer-gl the-renderer)
	   (polyprim-pdata
	    (primitive-inner
	     (scenenode-primitive grabbed)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define t 0)
(define stat-period 60)
(define last-stat 0)
(define avg-framerate 60)

(define (fluxus-startup fn)
  (set! ready-fn fn)
  (when (not external-gl-context)
    (outer-render)))

(define (debug-renderer)
  (renderer-print the-renderer))

(define (set-framerate-divide! v)
  (set! framerate-divide v))

(define framerate-divide 1)

(define (ready-to-render?)
  (and
   (meshes-loaded?)
   (textures-loaded?)))

(define (outer-render timestamp)
  (set! t (+ t 1))  
  (do-load-update)
  (when (zero? (modulo t framerate-divide))
		(set! the-renderer (renderer-render the-renderer))
		(set! stat-period (- stat-period 1))            
		(when (zero? stat-period)
			  (set! stat-period 60)
			  (set! current-fps (/ (- (Date.now) last-stat) stat-period))
			  (when (< current-fps 999)
					(set! avg-framerate (/ (+ avg-framerate current-fps) 2)))
			  ;;(console.log
			  ;;(+ "FPS: " (trunc (/ 1 (/ current-fps 1000)))
			  ;;	  " AVG: " (trunc (/ 1 (/ avg-framerate 1000)))))
			  (set! last-stat (Date.now))))
  (window.requestAnimationFrame outer-render))

(define (print-renderer-top)
  (msg (renderer-stack-top the-renderer)))

(define (ortho top)
  (set! the-renderer 
	(renderer-modify-frustum 
	 the-renderer 
	 (frustum #t top 
		  (frustum-near (renderer-frustum the-renderer))
		  (frustum-far (renderer-frustum the-renderer))))))  

(define (persp)
  (set! the-renderer 
	(renderer-modify-frustum 
	 the-renderer 
	 (frustum #f
		  (frustum-top frustum)
		  (frustum-near (renderer-frustum the-renderer))
		  (frustum-far (renderer-frustum the-renderer))))))


(define (frustum-clip near far)
  (set! the-renderer 
	(renderer-modify-frustum 
	 the-renderer 
	 (frustum (frustum-ortho? (renderer-frustum the-renderer))
		  (frustum-top (renderer-frustum the-renderer))
		  near
		  far))))

(define external-gl-context #f)

(define (flx-init-with-gl gl)
  (set! shader-cache ())
  (set! textures ())
  (set! external-gl-context #t)
  (set! the-renderer (renderer gl))
  ;; set up camera transform
  (mat4.translate (renderer-camera the-renderer) (list 0 0 0))
  (set! the-renderer (renderer-build-prefab the-renderer))
  (gl.clearColor 0.0 0.0 0.0 1.0)
  (gl.enable gl.DEPTH_TEST)
  ;;(gl.disable gl.CULL_FACE)
  ;; make sure the default texture is loaded
  (texture (load-texture "white.png")))

(define (clear)
  (let ((gl (if external-gl-context
				(renderer-gl the-renderer)
				(let ((canvas (document.getElementById "webgl-canvas")))
				  (canvas.getContext "experimental-webgl")))))
	(when (not external-gl-context) 		
		  (let ((canvas (document.getElementById "webgl-canvas")))
			(set! gl.viewportWidth canvas.width)
			(set! gl.viewportHeight canvas.height)))	
	(set! the-renderer (renderer gl))
	;; set up camera transform
	(mat4.translate (renderer-camera the-renderer) (list 0 0 0))
	(set! the-renderer (renderer-build-prefab the-renderer))
	(gl.clearColor 0.0 0.0 0.0 1.0)
	(gl.enable gl.DEPTH_TEST)
	;;(gl.disable gl.CULL_FACE)
	;; make sure the default texture is loaded
	(texture (load-texture "white.png"))))

(define (resize-glcanvas canvas) 
  (let ((canvas (document.getElementById "webgl-canvas")))
	;; Lookup the size the browser is displaying the canvas.
	(let ((displayWidth canvas.clientWidth)
		  (displayHeight canvas.clientHeight)) 
	  ;; Check if the canvas is not the same size.
	  (when (or (not (eq? canvas.width displayWidth))
				(not (eq? canvas.height displayHeight)))
			;; Make the canvas the same size
			(set! canvas.width displayWidth)
			(set! canvas.height displayHeight)
			(let ((gl (canvas.getContext "experimental-webgl")))
			  (set! gl.viewportWidth canvas.width)
			  (set! gl.viewportHeight canvas.height))))

	(set! screen-width canvas.width)
	(set! screen-height canvas.height)
	))

(define (size-glcanvas canvas displayWidth displayHeight) 
  ;; Make the canvas the same size
  (set! canvas.width displayWidth)
  (set! canvas.height displayHeight)
  (let ((gl (canvas.getContext "experimental-webgl")))
    (set! gl.viewportWidth canvas.width)
    (set! gl.viewportHeight canvas.height)))


(define webgl-canvas (document.getElementById "webgl-canvas"))

