;; -*- mode: scheme; -*-
;; Planet Fluxus Copyright (C) 2017 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/>.

(define (scenenode id state primitive children) (list id state primitive children (mat4.identity (mat4.create))))
(define (scenenode-id p) (list-ref p 0))
(define (scenenode-state p) (list-ref p 1))
(define (scenenode-modify-state! p v) (set! p (list-replace p 1 v)))
(define (scenenode-primitive p)  (list-ref p 2))
(define (scenenode-children p)  (list-ref p 3))
(define (scenenode-modify-children p v)  (list-replace p 3 v))
(define (scenenode-global-tx p) (list-ref p 4))
(define (scenenode-modify-global-tx! p v) (set! p (list-replace p 4 v)))
;;(define (scenenode-modify-add-child p child) (list-replace p 3 (cons child (scenenode-children p))))

(define (scenenode-print p depth)
  (define (_ str n)
	(if (zero? n)
		str
		(_ (+ str " ") (- n 1))))
  (msg (+ (_ "" depth) (scenenode-id p))))

;; order children by id
(define (scenenode-modify-add-child-slow p child)
  (define (_ l v)
    (cond
     ((null? l) (list v))
     ((< (scenenode-id  v) (scenenode-id (car l))) (cons v l))
     (else (cons (car l) (_ (cdr l) v)))))
  (list-replace p 3 (_ (scenenode-children p) child)))

;; optimised version
(define (scenenode-modify-add-child p child)
  (list-replace
   p 3
   (cond
	;; empty list case
	((null? (scenenode-children p)) (list child))
	;; prob most common if id is bigger than the last
	((< (scenenode-id
		   (list-ref (scenenode-children p)
					 (- (length (scenenode-children p)) 1)))
		  (scenenode-id child))
	 (append (scenenode-children p) (list child)))
	(else
	 ;; do the search
	 (cadr
	  (foldl
	   (lambda (c r)
		 (if (and (not (car r)) (< (scenenode-id child)
								   (scenenode-id c)))
			 (list #t (append (cadr r) (list child c)))
			 (list (car r) (append (cadr r) (list c)))))
	   (list #f '())
	   (scenenode-children p)))))))

;; binary search
(define (scenenode-search-child l id)
  (define (_ start end)
    (cond
     ;; no children
     ((null? l) #f)
     (else
      (let ((mid (trunc (+ start (/ (- end start) 2)))))
	(cond
	 ;; not found
	 ((< (- end start) 2) #f)
	 ;; found
	 ((eq? id (car (list-ref l mid))) (list-ref l mid))
	 ;; search down
	 ((> (car (list-ref l mid)) id)
	  (_ start mid))
	 ;; search up
	 (else
	  (_ mid end)))))))
  (_ 0 (length l)))

(define (scenenode-visible? sn frustum-planes)
  (foldl
   (lambda (plane r)
	 (if (and r (boundingbox-plane-inside? plane (scenenode-bb sn)))
		 #f r))
   #t frustum-planes))

(define (scenegraph-find sn id)
  (cond
   ((eq? (scenenode-id sn) id) sn)
   (else 
    (let ((result (scenenode-search-child (scenenode-children sn) id)))
      (if result result
	  (foldl
	   (lambda (sn r)
	     (if r r (scenegraph-find sn id)))
	   #f
	   (scenenode-children sn)))))))

(define (scenegraph-remove sn id)
  (scenenode-modify-children
   sn
   (filter (lambda (sn)
	     (not (eq? (scenenode-id sn) id)))
	   (map
	    (lambda (sn)
	      (scenegraph-remove sn id))
	    (scenenode-children sn)))))

 (define (scenegraph-add sn parent-id node)
  (cond
   ((eq? (scenenode-id sn) parent-id) 
    (scenenode-modify-add-child sn node))
   (else 
    (scenenode-modify-children
     sn
     (map
      (lambda (sn)
	(scenegraph-add sn parent-id node))
      (scenenode-children sn))))))

(define max-depth 0)

(define (scenegraph-render sn gl view-camera camera-pos tx depth)
  (when (not (state-hidden (scenenode-state sn)))
		(when (not (zero? (scenenode-primitive sn)))
			  (let ((hints (state-hints (scenenode-state sn))))
				;; hints that affect all types of primitive
				(if (bitwise-and hints FLX_HINT_NOZWRITE)
					(gl.depthMask false)
					(gl.depthMask true))
				(if (bitwise-and hints FLX_HINT_CULL_FACE)
					(gl.enable gl.CULL_FACE)
					(gl.disable gl.CULL_FACE))
				(if (bitwise-and hints FLX_HINT_CULL_CCW) 
					(gl.frontFace gl.CW)
					(gl.frontFace gl.CCW))
				(if (bitwise-and hints FLX_HINT_IGNORE_DEPTH) 
					(gl.disable gl.DEPTH_TEST)
					(gl.enable gl.DEPTH_TEST))
				(primitive-render 
				 (scenenode-primitive sn) gl view-camera camera-pos 
				 (scenenode-state sn)
				 tx)))
		
		(let ((child-tx (mat4.create)))
		  ;; pass the heirachical transform down
		  (mat4.multiply tx (state-tx (scenenode-state sn)) child-tx)    
		  ;; child-tx is actually the local transform for this object
		  (scenenode-modify-global-tx! sn child-tx)
		  (for-each 
		   (lambda (child)
			 (scenegraph-render child gl view-camera camera-pos child-tx (+ depth 1)))
		   (scenenode-children sn)))))

(define (scenegraph-print sn depth)
  (scenenode-print sn depth)
  (for-each 
   (lambda (child)
     (scenegraph-print child (+ depth 1)))
   (scenenode-children sn)))
