(define-struct stones (mesh-list (pos-list #:mutable) size-list rot-list 
        (root #:mutable) (obj-list #:mutable)))


(define (stones->list s)
    (map list 
        (stones-mesh-list s)
        (stones-pos-list s)
        (stones-size-list s)
        (stones-rot-list s)))

(define (write-out fn s)
    (let ((f (open-output-file fn)))
        (write (stones->list s) f)
        (close-output-port f)))

(define (choose l)
    (list-ref l (random (length l))))

(define models (list 
        ;    "meshes/fork.obj"
        "meshes/stone1.obj"
        "meshes/stone2.obj"
        "meshes/stone3.obj"))

(define (stones-init num area size)
    (make-stones
        (append (build-list num
                (lambda (_)
                    (choose models)))
            (build-list 5
                (lambda (_)
                    "meshes/seed.obj")))

        (append
            (build-list num
                (lambda (_)
                    (vmul (srndvec) (* size area))))
            (build-list 5
                (lambda (_)
                    (vmul (srndvec) (* size area 0.5)))))

        (append
            (build-list num
                (lambda (_)
                    (* size (- 1 (expt (rndf) 2)))))
            (build-list 5
                (lambda (_)
                    1)))

        (append
            (build-list num
                (lambda (_)
                    (vmul (rndvec) 360)))
            (build-list 5
                (lambda (_)
                    (vmul (rndvec) 360))))

            0
            '()))
    
    (define (stones-build stones)
        (let* ((root (build-locator))
                (objs (with-state
                        (parent root)
                        (map
                            (lambda (mesh pos size)  
                                (let ((p (with-state
                                                (if (string=? mesh "meshes/seed.obj")
                                                    (colour (vector 0 1 0))
                                                    (colour (vector 1 0.5 0)))
                                                (load-primitive mesh))))
                                    0
                                    p))
                            (stones-mesh-list stones)
                            (stones-pos-list stones)
                            (stones-size-list stones)))))
            (set-stones-obj-list! stones objs)
            (set-stones-root! stones root)
            stones))
    
    (define (stones-relax stones amount)
        (let ((done #t))
            (set-stones-pos-list! stones
                (map 
                    (lambda (pos size)
                        (foldl
                            (lambda (opos osize r)
                                (cond ((< (vdist pos opos) (* 5 (+ size osize)))
                                        (set! done #f)
                                        (vadd r (vmul (vnormalise (vsub pos opos)) amount)))
                                    (else r)))
                            (if (> (vy pos) 0) (vadd pos (vector 0 (* amount -30) 0)) pos)
                            (stones-pos-list stones)
                            (stones-size-list stones)))
                    (stones-pos-list stones)
                    (stones-size-list stones)))
            done))
    
    (define (stones-update stones)
        (let ((root (build-locator)))
            (with-state
                (parent root)
                (for-each
                    (lambda (obj pos size rot)
                        (with-primitive obj
                            (identity)                        
                            (translate pos)
                            (rotate rot)
                            (scale size)))
                    (stones-obj-list stones)
                    (stones-pos-list stones)
                    (stones-size-list stones)
                    (stones-rot-list stones)))
            (set-stones-root! stones root)))
    
    (clear)
    (clear-colour 0)
    (define s (stones-build (stones-init 200 1 10)))
    
    (define l (make-light 'spot 'free))
    (light-diffuse 0 (vector 0 0 0))
    (light-specular 0 (vector 0 0 0))
    (light-diffuse l (vector 1 1 1))
    (light-position l (vector 0 1000 0))
    (light-specular l (vector 0.1 0.1 0.1))
    
    (define done #f)
    
    (define (animate)
        (when (key-pressed "s") (write-out "stones.txt" s))
        
        (when (not done)
            (set! done (stones-relax s 0.1))
            (stones-update s))
        (when done (printf "done~n")))
    
    (every-frame (animate))