groworld/pluggable/pluggable.scm

; converts a 2D vector into an angle, with some dodgy dave maths
(define (2dvec->angle x y)
    (let ((q (/ 3.141 2)))
        (when (zero? y) (set! y 0.0001))
        (cond 
            ((>= y 0)
                (fmod (* (+ q q q (- q (atan (/ x y)))) 57.2957795) 360))
            (else
                (fmod (* (+ q (- q (atan (/ x y)))) 57.2957795) 360)))))

(define (i->pos i)
    (vector (modulo i (pixels-width)) 
        (quotient i (pixels-width)) 0))

(define (pos->i pos)
    (+ (* (round (vy pos)) (pixels-width)) (round (vx pos))))

(define (pixels-ref name pos)
    (pdata-ref name (pos->i pos)))

(define (pixels-set! name pos s)
    (pdata-set! name (pos->i pos) s))

(define (search i)
    (cond
        ((eq? i (pdata-size)) i)
        ((< (vr (pdata-ref "c" i)) 0.5) i)
        (else (search (+ i 1)))))

(define (flood pos tc av)
    (define (rec-flood pos)
        (pixels-set! "c" pos (vector 1 0 1))
        (set! tc (+ tc 1))
        (set! av (vadd av pos))
        (when (< (vr (pixels-ref "c" (vadd pos (vector -1 0 0)))) 0.5)
            (rec-flood (vadd pos (vector -1 0 0))))
        (when (< (vr (pixels-ref "c" (vadd pos (vector 1 0 0)))) 0.5)
            (rec-flood (vadd pos (vector 1 0 0))))
        (when (< (vr (pixels-ref "c" (vadd pos (vector 0 1 0)))) 0.5)
            (rec-flood (vadd pos (vector 0 1 0))))
        (when (< (vr (pixels-ref "c" (vadd pos (vector 0 -1 0)))) 0.5)
            (rec-flood (vadd pos (vector 0 -1 0)))))
    (rec-flood pos)
    (vmul av (/ 1 tc)))

(define (find-centroids pos l)
    (let ((i (search pos)))
        (cond ((eq? i (pdata-size)) l)
            (else
                (find-centroids i 
                    (cons (flood (i->pos i) 0 (vector 0 0 0)) l))))))

(define (convert-to-pos l)
    (map 
        (lambda (cp)
            (vector (- (- (/ (vx cp) (pixels-width)) 0.5))
                (/ (vy cp) (pixels-height)) 0))
        l))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define connection-cache '())

(define (get-connection-list id)
    (let ((ret (assoc id connection-cache)))
        (cond 
            (ret (cdr ret))
            (else
                (let* ((tex (load-primitive (string-append "textures/comp-cp-" id ".png")))
                        (connections (with-primitive tex (convert-to-pos (find-centroids 0 '())))))
                    (set! connection-cache (cons (cons id connections) connection-cache))
                    (destroy tex)
                    connections)))))


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define-struct component (root children))

(define (build-component id children)
    (cond 
        ((null? children) 
            (let ((root (with-state
                            (translate (vector 0 0.5 0))
                            (hint-ignore-depth)
                            (texture (load-texture (string-append "textures/comp-" id ".png")))
                            (build-plane))))
                (with-primitive root (apply-transform))
                (make-component root '())))
        (else
            (let* ((connection-list (get-connection-list id))
                    (root (with-state
                            (translate (vector 0 0.5 0))
                            (texture (load-texture (string-append "textures/comp-" id ".png")))
                            (build-plane)))
                    (comp (make-component root
                            (map
                                (lambda (child connection)
                                    (with-state                                        
                            (hint-ignore-depth)
                                        (parent root)
                                        (translate (vector 0 0 -0.01))
                                        (printf "~a~n" connection)
                                        (translate connection)
                                        (scale 0.8)
                                        (rotate (vector 0 0 (2dvec->angle 
                                                    (vx connection) (- (vy connection) 0.5))))
                                        (rotate (vector 0 0 0))
                                        (build-component (car child) (cadr child))))
                                children
                                connection-list))))
                (with-primitive root (apply-transform))
                comp))))

(define (component-print component)
    (printf "~a~n" (component-children component)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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

(define (make-random-plant depth)
    (let ((num-children (if (> depth 10) 0 (choose (list 0 1 2 3)))))
        (cond 
            ((eq? num-children 0) (list (choose (list "0" "0")) (list)))
            ((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1)))))
            ((eq? num-children 2) (list "2-1" (list (make-random-plant (+ depth 1))
                        (make-random-plant (+ depth 1)))))
            ((eq? num-children 3) (list (string-append "3-" (choose (list "1" "2")))
                        (list (make-random-plant (+ depth 1))
                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)))))
            ((eq? num-children 4) (list "4-1" (list (make-random-plant (+ depth 1))
                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1)) 
                        (make-random-plant (+ depth 1)))))
            ((eq? num-children 5) (list "5-0" (list (make-random-plant (+ depth 1))
                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))
                        (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))))))))

(clear)
(clear-colour (vector 1 1 1))
(clear-geometry-cache)
(clear-texture-cache)
(hint-unlit)
;(opacity 0.5)
(define p (make-random-plant 0))
(display p) (newline)

(define c (build-component "1-1" (list p)))