;; plant/city/artificial life

#lang scheme/base

(require fluxus-017/fluxus)
(provide (all-defined-out))

; todo, move this
(define energy-loss 0.03)
(define spawn-loss 0.01)
(define child-energy-factor 0.2)
(define size-energy-factor 0.1)
(define spawn-energy-threshold 0.9)

(define (set-suck s) (set! suck-environment s))
(define (suck-environment pos) 0.1)

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a node

(define (make-node name pos)
  (cons name (list pos)))

(define (node-name node)
  (car node))

(define (node-pos node)
  (list-ref (cdr node) 0))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; an edge

(define (make-edge from to)
  (list from to))

(define (edge-from edge)
  (car edge))

(define (edge-to edge)
  (cadr edge))

(define (edge=? a b)
  (or 
   (and (eq? (edge-from a) (edge-from b)) (eq? (edge-to a) (edge-to b)))
   (and (eq? (edge-to a) (edge-from b)) (eq? (edge-from a) (edge-to b)))))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; base graph functions

(define (make-graph nodes edges)
  (list nodes edges))

(define (graph-nodes graph)
  (car graph))

(define (graph-edges graph)
  (cadr graph))

(define (graph-merge a b)
  (list (append (graph-nodes a) (graph-nodes b))
        (append (graph-edges a) (graph-edges b))))

(define (graph-find-node graph name)
  (assq name (graph-nodes graph)))

(define (graph-find-edge graph edge)
  (foldl
      (lambda (oedge r)
      (if (edge=? edge oedge) #t r))
    #f
    (graph-edges graph)))
  
(define (graph-find-node-edges graph name)
  (foldl
   (lambda (edge r)
     (if (or (eq? (edge-from edge) name) 
             (eq? (edge-to edge) name))
         (cons edge r) r))
   '()
   (graph-edges graph)))

(define (graph-nodes-connected? graph namea nameb)
  (foldl
   (lambda (edge r)
     (if (or (eq? (edge-from edge) nameb)
             (eq? (edge-to edge) nameb))
         edge r))
   #f
   (graph-find-node-edges graph namea)))

(define (graph-find-edges-to-node graph name)
  (foldl
   (lambda (edge r)
     (if (eq? (edge-to edge) name) (cons edge r) r))
   '()
   (graph-edges graph)))

(define (graph-find-edges-from-node graph name)
  (foldl
   (lambda (edge r)
     (if (eq? (edge-from edge) name) (cons edge r) r))
   '()
   (graph-edges graph)))

(define (graph-remove-unconnected-edges graph)
  (make-graph
   (graph-nodes graph)
   (filter
    (lambda (edge)
      (and (graph-find-node graph (edge-from edge))
           (graph-find-node graph (edge-to edge))))
    (graph-edges graph))))

(define (graph-remove-node graph name)
  (make-graph 
   (filter
    (lambda (node)
      (not (eq? (node-name node) name)))
    (graph-nodes graph))
   (filter
    (lambda (edge)
      (not (or (eq? (edge-from edge) name)
               (eq? (edge-to edge) name))))
    (graph-edges graph))))

(define (graph-remove-edge graph edge)
  (make-graph
   (graph-nodes graph)
   (filter
    (lambda (iedge)
      (not (edge=? iedge edge)))
    (graph-edges graph))))

(define (graph-add-node graph parent-node node)
  (graph-merge 
   graph 
   (make-graph (list node)
               (list (make-edge (node-name node)
                                (node-name parent-node))))))

(define (graph-node-get-children graph name)
  (map
   (lambda (edge)
     (graph-find-node graph (edge-to edge)))
   (graph-find-edges-from-node graph name)))

(define (graph-display-nodes graph)
  (for-each
   (lambda (node)
     (printf "node: ~a pos:~a~n" (node-name node) (node-pos node)))
   (graph-nodes graph))
    (display (length (graph-nodes graph)))(newline))

(define (graph-display-edges graph)
  (for-each
   (lambda (edge)
     (printf "~a -> ~a~n" (edge-from edge) (edge-to edge)))
   (graph-edges graph)))