groworld/plant-eyes/scripts/logic.ss

;; p l a n t   e y e s  [ copyright (c) 2009 foam vzw : gpl v3 ]

#lang scheme
(require scheme/class 
  fluxus-016/fluxus 
  "message.ss" 
  "list-utils.ss"
  "path-gen.ss")
  
(provide (all-defined-out))

(define branch-probability 6) ; as in one in branch-probability chance
(define branch-width-reduction 0.5)
(define twig-jitter 0.1)
(define branch-jitter 0.5)
(define start-twig-points 15)
(define start-twig-dist 0.05)
(define start-twig-width 0.1)
(define default-max-twigs 2)
(define default-scale-factor 1.05)
(define num-pickups 10)
(define pickup-dist-radius 200)
(define pickup-size 1)
(define ornament-grow-probability 4)
(define curl-amount 40)
(define start-size 50)
(define max-ornaments 5) ; per twig
(define nutrient-twig-size-increase 1)
(define num-worms 10)
(define num-spiders 10)
(define num-butterflies 10)
(define auto-twig-var 5)
(define auto-time 1)
(define pickup-check-prob 200)
(define max-pickups 150)
(define insect-send-prob 3)

(define update-count 0)
(define num-checks 0)

; moveme
(define (collide? line objs)
    (foldl
     (lambda (ob r)
       (if r r
           (with-primitive ob
                           (cond ((bb/point-intersect? (cadr line) 0)
                                  (cond
                                    ((not (null? (geo/line-intersect 
                                                  (car line) (cadr line))))
                                     #t)                                        
                                    (else #f)))
                                 (else #f)))))
     #f
     objs))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the base class logic object - all logic side objects can 
; send messages to the render side at any time by calling add-message
; this takes care of the propagation of information. (not just oo fetish, I hope)
(define game-logic-object%
  (class object%
    (field
     (messages '())
     (children '()))
    
    (define/public (send-message name data)
      (set! messages (append messages (list (make-object message% name data)))))
        
    ; convert a list of lists in to just a single list - needed to convert
    ; the update lists into one big list of messages
    (define (flatten l)
      (cond
        ((null? l) '())
        ((list? (car l)) (append (flatten (car l)) (flatten (cdr l))))
        (else (cons (car l) (flatten (cdr l))))))

    (define/pubment (update t d) ; need to augement this if we have child logic objects, 
	  (set! update-count (+ update-count 1))
      (let ((l (inner '() update t d)) ; and call update on them too.
	        (m messages))    
        (set! messages '())        
         (append
          m
          (flatten l)))) ; the augmented method gets called here
    
    (super-new)))

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

(define insect-logic%
    (class game-logic-object%
        (init-field
            (id 0)
            (pos 0)
			(type 'none)
            (d (if (eq? type 'worm) (+ 20 (* 20 (rndf)))
									(+ 10 (* 2 (rndf))))) ; time to get from one place to another
			(mission-time -1))
        
        (field
            (next-update 0)
			(centre (vector 0 0 0)))
 
        (inherit send-message)
       
        (define/public (get-id)
            id)
        
        (define/public (get-pos)
            pos)
      
	    (define/public (get-type)
            type)
			
		(define/public (set-centre s)
			(set! centre s))
        
		(define/public (move-to p)
			(set! mission-time 5)
			(set! pos p))
		
        (define (move)
			; todo check stones	
			(when (> mission-time 0)
				(set! pos (vadd pos (vmul (hsrndvec) 5))))
				
			(when (< mission-time 0)
				(let ((speed (if (eq? type 'worm) 5 50)))
				(if (> (vdist pos centre) 100)
            		(set! pos (vadd pos (vmul (vnormalise (vsub centre pos)) speed)))
			    	(set! pos (vadd pos (vmul (srndvec) speed))))
				;(when (< (vdist pos centre) 12) (move))
				(when (eq? type 'spider)
					(set! pos (vector (vx pos) 0 (vz pos))))
				(when (and (eq? type 'worm) (> (vy pos) -10))
					(set! pos (vector (vx pos) -10 (vz pos))))
				(when (and (eq? type 'butterfly) (< (vy pos) 50))
					(set! pos (vector (vx pos) 50 (vz pos)))))))
        
        (define/augment (update time delta)
            (cond ((> time next-update)
                    (move)
					; todo: drop stuff
                    ;(when (zero? (random pickup-drop-probability))
                    ;    (send cell set-pickup! 'default))
					(let ((d (if (> mission-time 0) (/ d 3) d)))
                    	(set! next-update (+ time d))
						(send-message 'insect-move (list 
                                    	(list 'insect-id id)
										(list 'pos pos)
										(list 'duration d))))))
									
			(when (> mission-time 0) 
				(set! mission-time (- mission-time delta)))
				
			'())
        
        (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a twig, which can contain other twigs things.
; (roots and shoots are both twigs)
(define twig-logic%
  (class game-logic-object%
    (init-field
     (last-point (vector 0 0 0))      
     (id #f)               ; our id (for matching up with the renderer geometry)
     (plant #f)            ; the plant we belong to
     (type 'root)          ; or 'shoot
     (dir (vector 0 1 0))  ; the general direction we are pointing in
     (width 0)            ; the width of this root
     (num-points start-twig-points) ; number of points in this twig
     (render-type 'extruded) ; the way to tell the view to render this twig
     (dist start-twig-dist)               ; distance between points          
     (parent-twig-id -1)
     (parent-twig-point-index -1))
    
    (field
     (points '())     ; the 3d points for this twig
     (widths '())
     (twigs '())      ; children are stored with the point number they are connected to.
     (ornaments '())  ; the things attached to this twig, an assoc list with point index
     (w 0)                ; the width of this segment
     (curl (vmul (crndvec) curl-amount)) ; the angles to turn each point, if curly  
	 (pickedups '())) ; the pickups we've collected
    
    (inherit send-message)
    
    (define/public (get-id)
      id)
    
    (define/public (set-id! s)
      (set! id s))
    
    (define/public (get-type)
      type)

    (define/public (get-dist)
      dist)
    
	(define/public (get-w)
		w)
	
    (define/public (get-dir)
      dir)
    
    (define/public (get-width)
      width)

    (define/public (get-width-at-point point-index)
      (list-ref widths point-index))
    
    (define/public (get-num-points)
      num-points)      
    
    (define/public (get-render-type)
      render-type)
    
    (define/public (get-point point-index)
      (list-ref points point-index))
    
    (define/public (get-length)
      (length points))
    
    (define/public (get-end-pos)
      (if (not (null? points))
          (list-ref points (- (get-length) 1))
          #f))
    
    (define/public (growing?)
      (< (length points) num-points))
    
	
    (define/public (scale a)
      (set! width (* width a))
      (set! dist (* dist a)))
        
    (define/public (grow pos)
      (when (growing?)
        (let ((new-point (if (zero? (length points))
                             ; first point should be at edge of the seed if we are a branch
                             (if (eq? parent-twig-id -1) pos 
                                 last-point)
                             pos)))         
          
          
            (set! w (if (zero? (- num-points 2)) width 
			 (* width (- 1 (/ (length points) (- num-points 2))))))
			 (set! dist (* w 1.5))
          (set! last-point new-point)
          (set! points (append points (list new-point)))
          (set! widths (append widths (list w)))
          (send-message 'add-twig-point (list 
                                    (list 'plant-id (send plant get-id))
                                    (list 'twig-id id)
                                    (list 'point new-point)
                                    (list 'width w))))))
    
    (define/public (get-desc-list)
       (list
          (list 'plant-id (send plant get-id))
          (list 'parent-twig-id parent-twig-id)
          (list 'point-index parent-twig-point-index)
          (list 'twig-id id)
          (list 'type type)
          (list 'dir dir)
          (list 'width width)
          (list 'num-points num-points)
          (list 'render-type render-type)))
    
    (define/public (add-twig point-index dir)
      (let ((twig (make-object twig-logic% 
                    (get-point point-index)
                      (send plant get-next-twig-id)
                      plant 
                      type 
                      dir
                      (list-ref widths point-index)
                      (quotient num-points 2)
                      render-type
                      dist
                    id
                    point-index
                    )))
      
      (send-message 'new-twig (send twig get-desc-list))
      (set! twigs (cons (list point-index twig) twigs))
        twig))
    
    (define/public (serialise)
      (append  
        (list (make-object message% 'new-twig (get-desc-list)))
        (append (map
                 (lambda (point width)
                   (make-object message% 'twig-grow (list 
                                                     (list 'plant-id (send plant get-id))
                                                     (list 'twig-id id)
                                                     (list 'point point)
                                                     (list 'width width))))
                 points widths))
        (append
         (map
          (lambda (twig)
            (send (cadr twig) serialise))
          twigs))))
    
    (define/public (get-twig point-index)
      (cadr (assq point-index twigs)))
    
    (define/public (get-random-twig)
      (if (or (null? twigs) (zero? (random 10)))
          this
          (send (cadr (choose twigs)) get-random-twig)))
    
	(define/public (get-ornament point-index)
	  (let ((o (assq point-index ornaments)))
	  	 (if o (cadr o) #f))) 		
	
	(define/public (get-random-ornament)
	  (if (null? ornaments) #f (cadr (choose ornaments))))
	
	(define/public (room-for-new-ornament? point-index)
		(and (not (get-ornament point-index)) 
			(< (length ornaments) max-ornaments)))	
	
	(define/public (drop-pickups type game-logic)
		(for-each
			(lambda (ornament)
				(send (cadr ornament) drop-pickup type game-logic))
			ornaments))
			
    (define/public (add-ornament point-index ornament)
	      (send-message 'new-ornament 
                     (list 
                      (list 'plant-id (send plant get-id))
                      (list 'twig-id id)
                      (list 'point-index point-index)
                      (list 'property (send ornament get-property))))
    	  (set! ornaments (cons (list point-index ornament) ornaments)))
    
	(define/public (deal-with-pickups)
	  (for-each
	    (lambda (pu)
		  (let ((pickup (car pu))
		        (point (cadr pu)))
		  (send plant add-property (send pickup get-type))
          (send-message 'pick-up-pickup 
                       (list 
                        (list 'pickup-id (send pickup get-id))
						(list 'point point)))))
		 pickedups)
		(set! pickedups '()))
    
    ; adds the ornament if it's close, and checks sub-twigs
    ; returns true if it's succeded
    (define/public (check-pickup pickup)
	  ; check last point in our twig
	  (set! num-checks (+ num-checks 1))
      ; if we havent found anything yet and it's intersecting					  						
      (cond ((and (not (null? points)) 
	  			(< (vdist-sq (vadd (send plant get-pos) (last points)) 
                                  (send pickup get-pos))
                                 100 #;(+ width (send pickup get-size))))
			 (set! pickedups (cons (list pickup (- (length points) 1)) pickedups))
             (send pickup pick-up) ; this will remove the pickup for us
			 (send-message 'pick-up-highlight 
                (list (list 'pickup-id (send pickup get-id))
					  (list 'plant-id (send plant get-id))))
             #t)
		(else
			(foldl
			   (lambda (twig found) 
  				   (if (not found) 
  					   (send (cadr twig) check-pickup pickup)
 					#f))
 			  #f
		   twigs)))
							 
      ; check each point in our twig      
      #;(let* ((i -1) (found (foldl
                    (lambda (point found)
                      (set! i (+ i 1))
					  (set! num-checks (+ num-checks 1))
                      ; if we havent found anything yet and it's intersecting					  						
                      (cond ((and (not found) (< (vdist (vadd (send plant get-pos) point) 
                                                  (send pickup get-pos))
                                                 10 #;(+ width (send pickup get-size))))
							 (set! pickedups (cons (list pickup i) pickedups))
                             (send pickup pick-up) ; this will remove the pickup for us
							 (send-message 'pick-up-highlight 
                       			(list (list 'pickup-id (send pickup get-id))
								      (list 'plant-id (send plant get-id))))
                             #t)
                            (else #f)))
                    #f
                    points)))
					
        ; now check each sub-twig
        (if (not found)
          (foldl
           (lambda (twig found) 
             (if (not found) 
                 (send (cadr twig) check-pickup pickup)
                 #f))
           #f
           twigs)
          found)))
     
    (define/augment (update t d)	
	  (when (and (not (null? pickedups)) (not (growing?)))
	    (deal-with-pickups))
      (append
       (map
        (lambda (ornament)
          (send (cadr ornament) update t d))
        ornaments)
       (map
        (lambda (twig)
          (send (cadr twig) update t d))
        twigs)))
        
    (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; abilities live on twigs, and can do things. 
; this is the base class for all abilities.
(define ornaments-above-ground '(flower leaf fork horn))
(define ornaments-below-ground '(inflatoe))

(define ornament-logic%
  (class game-logic-object%
    (init-field
     (id -1)
     (property 'none)
     (plant #f)        ; the plant we belong to
     (twig #f)         ; the twig we are on
     (point-index -1)) ; the index to the point on our twig
  
    (field
     (pos (send twig get-point point-index))) ; figure out the position here
    
    (define/public (get-property)
      property)
    
    (define/public (get-pos)
      pos)
	  
    (define/public (get-global-pos)
      (vadd (send plant get-pos) pos))
    
	(define/public (drop-pickup type game-logic)
         (when (eq? property 'inflatoe)
			; put a pickup inside of the inflatoe
			(send game-logic add-pickup 
				(make-object pickup-logic% (send game-logic new-pickup-id) type
                       (vadd (send plant get-pos) pos)))))
	
    (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; pickups map to abilities, and live out in space
; this is the base class for all pickups.
(define pickup-logic%
  (class game-logic-object%
    (init-field
     (id -1)
     (type 'none)
     (pos (vector 0 0 0)))
    
    (field 
     (size pickup-size)
     (picked-up #f))
    
    (define/public (picked-up?)
      picked-up)
    
    (define/public (pick-up)
      (set! picked-up #t))
    
    (define/public (get-id)
      id)
    
    (define/public (get-type)
      type)
    
    (define/public (get-pos)
      pos)
    
    (define/public (get-size)
      size)
    
    (super-new)))

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

(define plant-logic%
  (class game-logic-object%
    (init-field
	 (game-logic #f)
     (id #f)
     (pos (vector 0 0 0))
     (col (vector 1 1 1))
     (tex "fff")
	 (is-player #f)
	 (implicit-property #f)
	 (shape-params '(0 0)))
    
    (field
     (twigs '())     ; a assoc list map of ids to twigs
     (leader-twig #f) ; the temporary twig controlled by the player
     (properties (list 'inflatoe implicit-property)) ; a list of symbols - properties come from pickups
     (size start-size)         ; the age of this plant
     (max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
     (next-twig-id 0)
     (next-ornament-id 0)
     (grow-amount default-scale-factor)
	 (twig-size start-twig-points)
	 (auto-pilot-t 0)
	 (auto-pilot-d (* (+ 1 (rndf)) auto-time))
	 (auto-twig #f)
	 (auto-path-gen (make-object path-gen% (car shape-params) (cadr shape-params))))
	     
    (inherit send-message)
    
    (define/public (get-id)
      id)

    (define/public (get-pos)
      pos)
    
    (define/public (get-size)
      size)
    
    (define/public (get-col)
      col)
    
    (define/public (get-tex)
      tex)
	  
	(define/public (get-twig-size)
	  twig-size)
    
	(define/public (get-shape-params)
      shape-params)

    (define/public (grow pos)      
      (when leader-twig
        (send leader-twig grow pos)
        (when (not (send leader-twig growing?))
          (send-message 'start-growing (list
                                        (list 'plant-id id)
                                        (list 'twig-id (send leader-twig get-id))))
          (set! leader-twig #f))))
    
    (define/public (add-property name)
	  (set! twig-size (+ twig-size nutrient-twig-size-increase))
	  (when (and (not (eq? name 'nutrient)) (not (list-contains name properties)))
         (set! properties (cons name properties))))
    
    ; we need to maintain our list of twig ids here, for this plant
    (define/public (get-next-twig-id)
      (let ((id next-twig-id))
        (set! next-twig-id (+ next-twig-id 1))
        next-twig-id))

    ; we need to maintain our list of ornament ids here, for this plant
    (define/public (get-next-ornament-id)
      (let ((id next-ornament-id))
        (set! next-ornament-id (+ next-ornament-id 1))
        next-ornament-id))
    
    (define/public (check-pickup pickups) 
	  (when (or is-player (random pickup-check-prob)) ; reduce the frequency for non-player plants
		  (when leader-twig 
		  	(for-each
				(lambda (pickup)
					(when (not (list-contains (send pickup get-type) properties))
					    (send leader-twig check-pickup pickup)))
				pickups))))
	   
    (define/public (destroy-twig twig)
	   (send-message 'shrink-twig
		   	(list (list 'plant-id id)
			      (list 'twig-id (send (cadr twig) get-id))))
	   (send (cadr twig) drop-pickups implicit-property game-logic)
	   #;(send-message 'destroy-branch-twig (list
									(list 'plant-id id)
									(list 'twig-id (send (cadr twig) get-id))
									)))
 
	 ; a util to keep a fixed size list of twigs, calling destroy twig when needed.
	 (define (cons-twig thing in count out)
	   (cond
		 ((null? in)
		  (cons thing out))
		 ((zero? count)
		  (destroy-twig (car in))
		  (cons thing out))
		 (else (cons-twig thing (cdr in) (- count 1) (append out (list (car in)))))))
 
 	(define/public (destroy-all-twigs)
		(for-each
			(lambda (twig)
				(destroy-twig twig))
			twigs)
		(set! twigs '()))
 
 	(define/public (get-random-ornament)
		(if (null? twigs) #f (send (cadr (choose twigs)) get-random-ornament)))

    (define/public (add-twig twig)
      (send twig set-id! (get-next-twig-id))
      ;(set! size (* size grow-amount))
      (send twig scale size)  
      (set! leader-twig twig)
      #;(send-message 'grow-seed (list 
                                (list 'plant-id id)
                                (list 'amount grow-amount)))
      (send-message 'new-twig (send twig get-desc-list))      
      (set! twigs (cons-twig (list (send twig get-id) twig) twigs max-twigs '())))

    (define/public (add-sub-twig ptwig point-index dir)
          (set! leader-twig (send ptwig add-twig point-index dir))
        leader-twig)
    
    (define/public (get-random-twig)
      (if (not (null? twigs))
          (send (cadr (choose twigs)) get-random-twig)
          #f))
    
    (define/public (get-twig-from-dir dir)
      (let ((dir (vnormalise dir)))
      (cadr (foldl
             (lambda (twig l)
               (let ((d (vdot (vnormalise (send (cadr twig) get-dir)) dir)))
                 (if (> d (car l))
                     (list d (cadr twig))
                     l)))
             (list -99 #f)
             twigs))))
      
    (define/public (serialise)
      (append (list (make-object message% 'new-plant (list
                                      (list 'plant-id id)
                                (list 'pos pos)
                                (list 'size size)
                                (list 'col col)
                                (list 'tex tex))))

              (append
               (map
                (lambda (twig)
                  (send (cadr twig) serialise))
                twigs))))
    
	(define/public (run-auto-pilot t d stones)
		(when (or (> t auto-pilot-t) (< (length twigs) 3))
			(set! auto-pilot-t (+ t auto-pilot-d))
			(when (or (not auto-twig) (not (send auto-twig growing?)))
				(let ((auto-twig-dir (hsrndvec)))
  				  (send auto-path-gen reset auto-twig-dir auto-twig-dir)
				  (set! auto-twig (make-object twig-logic%  (vector 0 0 0) 0 this 'root 
                                       	auto-twig-dir
                                    	start-twig-width 
										twig-size
										'extruded)))
				(add-twig auto-twig))
			
			(let ((pos (send auto-path-gen get-pos (send auto-twig get-dist))))
  			  (when (not (collide? pos stones))
				(grow pos)))))
	
    (define/augment (update t d)      
      ; grow a new ornament?
      (when (and (not (null? properties)) (zero? (random ornament-grow-probability)))
        (let ((twig (get-random-twig)))
          (when (and twig (> (send twig get-length) 3) (not (send twig growing?)))
            (let* ((property (choose properties))
                   (point-index (+ 1 (random (- (send twig get-length) 2))))
				   (pos (vadd pos (send twig get-point point-index))))
				
				(when (and (send twig room-for-new-ornament? point-index)
							; check we can grow here
							(and (or (not (list-contains property ornaments-above-ground)) (> (vy pos) 5))
						 	     (or (not (list-contains property ornaments-below-ground)) (< (vy pos) -5))))			           
                	(send twig add-ornament point-index
                                    	 (make-object ornament-logic% 
                                        	(get-next-ornament-id) 
                                        	property
                                        	this
                                        	twig
                                        	point-index)))))))
	   ;(printf "plant ~a has ~a twigs~n" id (length twigs))
       (map
        (lambda (twig)
          (send (cadr twig) update t d))
        twigs))
    
    (super-new)))

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

(define game-logic%
  (class game-logic-object%
    (field
     (plants '())
     (pickups '())
     (player #f)
	 (insects '())
	 (next-pickup-id 0)
	 (next-insect-id 0)
	 (stones '()))
   
    (inherit send-message)
    
	(define/public (set-stones s)
		(set! stones s))
	
	(define/public (new-pickup-id)
		(let ((r next-pickup-id))
			(set! next-pickup-id (+ next-pickup-id 1)) r))

	(define/public (new-insect-id)
		(let ((r next-insect-id))
			(set! next-insect-id (+ next-insect-id 1)) r))
	
    (define/public (setup world-list)
     (let ((pickups (list-ref world-list 1)))
      (for-each
          (lambda (pickup)
           (add-pickup (make-object pickup-logic% (new-pickup-id) 'nutrient
                                     (list-ref pickup 2))))
        pickups)
	  (for ((id (in-range 0 num-worms)))
		(add-insect (make-object insect-logic% (new-insect-id) (vmul (vsub (srndvec) (vector 0 1 0)) 100) 'worm)))
	  (for ((id (in-range 0 num-spiders)))
		(add-insect (make-object insect-logic% (new-insect-id) (vmul (vsub (srndvec) (vector 0 1 0)) 100) 'spider)))
	  (for ((id (in-range 0 num-butterflies)))
		(add-insect (make-object insect-logic% (new-insect-id) (vmul (srndvec) 100) 'butterfly)))
	  	))
        
	(define/public (clear)
		(for-each 
			(lambda (plant)
				(send plant destroy-all-twigs))
			plants))
	
    (define/public (add-player plant)
      (send-message 'player-plant (list
                                (list 'plant-id (send plant get-id))
                                (list 'pos (send plant get-pos))
                                (list 'size (send plant get-size))
                                (list 'col (send plant get-col))
                                (list 'tex (send plant get-tex))
								(list 'curve (car (send plant get-shape-params)))
								(list 'corner (cadr (send plant get-shape-params)))))
      (set! player plant)
      (set! plants (cons plant plants))
	  
	  (for-each 
	  	(lambda (insect)
			(send insect set-centre (send plant get-pos)))
			insects))
     
    (define/public (add-plant plant)
      (send-message 'new-plant (list
                                (list 'plant-id (send plant get-id))
                                (list 'pos (send plant get-pos))
                                (list 'size (send plant get-size))
                                (list 'col (send plant get-col))
                                (list 'tex (send plant get-tex))
								(list 'curve (car (send plant get-shape-params)))
								(list 'corner (cadr (send plant get-shape-params)))))
      (set! plants (cons plant plants)))
    
    (define/public (add-pickup pickup)
		(when (< (length pickups) max-pickups)
            (send-message 'new-pickup
                      (list
                       (list 'pickup-id (send pickup get-id))
                       (list 'type (send pickup get-type))
                       (list 'pos (send pickup get-pos))))
     	 (set! pickups (cons pickup pickups))))

   (define/public (add-insect insect)
      (send-message 'new-insect (list
                                (list 'insect-id (send insect get-id))
                                (list 'pos (send insect get-pos))
                                (list 'type (send insect get-type))))
		(send insect set-centre (send player get-pos))
      (set! insects (cons insect insects)))
   
    (define/public (serialise)
	  ; send player-plant serialise I think...
	  0)
	  
	(define/public (insect-send)
      (let ((ornament (send (choose plants) get-random-ornament)))
	  	(when (and ornament 
				  (not (eq? (send ornament get-property) 'inflatoe))
				  #;(or (eq? (send ornament get-property) 'flower)
				  (eq? (send ornament get-property) 'horn)))
		    (let ((insect (choose insects)))
				(when (eq? (send insect get-type) 'butterfly)
					(send insect move-to (send ornament get-global-pos)))))))
	  
	(define/public (run-auto-pilot t d)
		(for-each
		  (lambda (plant)
		  	(when (not (eq? plant player))
				(send plant run-auto-pilot t d stones)))							
			plants))
		  
    
    ; todo - distribute the checking of stuff like
    ; this to a random selection of pickups/plants
    ; to distribute the cpu load
    (define/augment (update t d) 
	
	  (printf "num updates ~a~n" update-count)
	  (printf "num pickups ~a~n" (length pickups))
	  (printf "num checks ~a~n" num-checks)
	  (set! update-count 0)
	  (set! num-checks 0)
	
	  (run-auto-pilot t d)       
	  
	  (when (zero? (random insect-send-prob))
	  	(insect-send))
	  
      (for-each 
          (lambda (plant)
            (send plant check-pickup pickups))
          plants)
	         
      ; remove the pickups that have been 'picked up'
      (set! pickups (filter 
                     (lambda (pickup)
                       (not (send pickup picked-up?)))
                     pickups))
      
	  (append
		(map
         (lambda (plant)
           (send plant update t d))
         plants)
		 (map
		 	(lambda (insect)
				(send insect update t d))
			insects)))
    
    (super-new)))