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

; the fluxus code to make things look the way they do

(define debug-messages #t) ; prints out all the messages sent to the renderer
(define audio-on #f)

(define (ornament-colour) (vector 0.5 1 0.4))
(define (pickup-colour) (vector 1 1 1))
(define (earth-colour) (vector 0.2 0.1 0))
(define (stones-colour) (vmul (earth-colour) (+ 0.5 (* (rndf) 0.5))))

(define wire-mode #f)
(define fog-col (earth-colour))
(define fog-strength 0.001)
(define max-ornaments 30) ; per twig
(define default-grow-speed 0.5)

(when audio-on (oa-start)) ;; start openAL audio

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

(define ornament-view%
  (class object%
    (init-field
     (pos (vector 0 0 0))
	 (sc 1)
	 (dir (vector 0 0 1))
     (property 'none)
     (time 0))
	
    (field
	 (const-scale 2)
	 (rot (vector 0 0 0))
     (root (with-state
            (translate pos)
            (concat (maim dir (vector 0 1 0)))
            (scale (* const-scale sc))
			;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
            (cond 
              ((eq? property 'wiggle) 
;               (opacity 1)
               (hint-depth-sort)
               (colour (vector 0.5 0.0 0.0))
               (load-primitive "meshes/wiggle.obj"))
              ((eq? property 'leaf) 
               (colour (vector 0.8 1 0.6))			   			  
               (texture (load-texture "textures/leaf.png"))
               (set! rot (vector 0 0 0))
			   (hint-origin)
			   (load-primitive "meshes/leaf.obj"))
              (else (error ""))))))
    
    (define/public (update t d)
      (when (< time 1)
        (with-primitive root
                        (identity)
                        (translate pos)
                        (concat (maim dir (vector 0 1 0)))
						(rotate rot)
                        (scale (* const-scale sc 0.2 time)))
        (set! time (+ time (* 0.1 d)))))
    
    (super-new)))

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

(define pickup-view%
  (class object%
    (init-field
     (id -1)
     (type 'none)
     (pos (vector 0 0 0)))
    
    (field
     (rot (vmul (rndvec) 360))
     (root (with-state
            (translate pos)
            (rotate rot)
            (colour (pickup-colour))
            (scale 0.3)
			;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
            (texture
             (cond 
              ((eq? type 'wiggle) (load-texture "textures/wiggle.png"))
              ((eq? type 'leaf) (load-texture "textures/leaf.png"))
              ((eq? type 'curly) (load-texture "textures/curl.png"))))
             (cond 
              ((eq? type 'wiggle) (load-primitive "meshes/pickup.obj"))
              ((eq? type 'leaf) (load-primitive "meshes/leaf.obj"))
              ((eq? type 'curly) (load-primitive "meshes/pickup.obj")))))
     (from pos)
     (destination (vector 0 0 0))
     (speed 0.05)
     (t -1))
    
    (define/public (pick-up)
      (destroy root))
    
    (define/public (move-to s)
      (set! t 0)
      (set! from pos)
      (set! destination s))
    
    (define/public (update t d)
      (with-primitive root
                      (rotate (vector (* d 10) 0 0)))
      #;(when (and (>= t 0) (< t 1))
        (set! pos (vadd pos (vmul (vsub destination from) speed)))
        (with-primitive root
                        (identity)
                        (translate pos)
                        (rotate rot))
        (set! t (+ t speed))))
    
    (super-new)))

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

(define twig-view%
    (class object%
      (init-field
       (id 0)
       (pos (vector 0 0 0))
       (type 'none)
       (dir (vector 0 1 0))
       (radius 1)
       (num-points 0)) 
      
      (field
       (index 0)
       (parent-twig-id -1)
       (child-twig-ids '())
       (ornaments '())
       (col (vector 1 1 1))
       (tex "")
	   (markers '())
	   (grow-t 999)
	   (marker-destroy-t 0)
	   (grow-speed default-grow-speed))
      
      (define/public (get-id)
        id)
      
      (define/public (get-dir)
        dir)
      
      (define/public (set-col! s)
        (set! col s))

      (define/public (set-tex! s)
        (set! tex s))

      (define/public (build)
        0)
      
      (define/public (get-num-points)
        index)

      (define/public (set-pos! s)
        (set! pos s))
      
      (define/public (get-child-twig-ids)
        child-twig-ids)
      
      (define/public (get-root)
        (error "need to overide this"))
      
      (define/public (destroy-twig)
        (destroy (get-root)))

      (define/public (set-parent-twig-id s)
        (set! parent-twig-id s))
      
      (define/public (get-point point-index)
        (error "need to overide this"))
      
      (define/public (get-width point-index)
        (error "need to overide this"))
      
      (define/public (add-child-twig-id twig-id)
        (set! child-twig-ids (cons twig-id child-twig-ids)))
      
      (define/public (start-growing)
	  	(set! grow-t 0)
		(set! markers (cons (build-locator) markers)))
		
      (define/pubment (add-point point width)
    (when audio-on (let ((growing-noise (oa-load-sample (fullpath "snd/event01.wav")))) 
      (oa-play growing-noise (vector 0 0 0) (rndf) 0.3)))
	  
	  	  	(set! markers (append markers (list (with-state
				(parent (get-root))
				(translate point)
				(scale 0.2)
				(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
				(colour col)
				(build-sphere 10 10)))))
	  
        (inner (void) add-point point width))

      (define/public (add-ornament point-index property)
        (when (< (length ornaments) max-ornaments)
          (with-state
           (parent (get-root))
           ; todo - different ornament-view objects per property needed?
           ; todo - delete existing ornaments here
           (set! ornaments (cons (list point-index 
                                       (make-object ornament-view% 
                                         (get-point point-index)
                                         (get-width point-index)
                                         (vnormalise (vsub (get-point point-index)
				                                           (get-point (- point-index 1))))
                                         property))
                                 ornaments)))))
      
      (define/pubment (update t d)        
        (for-each
         (lambda (ornament)
           (send (cadr ornament) update t d))
         ornaments)
                
        (inner (void) update t d)
		
		(when (< grow-t num-points) 
			(set! grow-t (+ grow-t (* d grow-speed)))
			(when (> 0 (- marker-destroy-t grow-t))
				; soundtodo: marker gobble
				(set! marker-destroy-t (+ 1 marker-destroy-t))
				(destroy (car markers))
				(set! markers (cdr markers)))))
      
      (super-new)))

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

(define ribbon-twig-view%
    (class twig-view%
      
      (inherit-field pos radius num-points index col tex)
      
      (field
       (root 0))
      
      (define/override (build)
        (set! root (let ((p (with-state
                       (translate pos)
                       (colour col)
                       (texture (load-texture tex)) 
                       (build-ribbon num-points))))
               (with-primitive p
                               (pdata-map! 
                                (lambda (w)
                                  0)
                                "w")
                               (pdata-set! "w" 0 radius))
               p)))
      
      
      (define/override (get-root)
        root)

      (define/override (get-point point-index)
        (with-primitive root
                        (pdata-ref "p" point-index)))
      
      (define/override (get-width point-index)
        (with-primitive root
                        (pdata-ref "w" point-index)))
           
      (define/augment (add-point point width)
        (with-primitive root
                        (pdata-index-map! ; set all the remaining points to the end
                         (lambda (i p)    ; in order to hide them
                           (if (< i index)
                               p
                               point))
                         "p")
                        (pdata-index-map! ; do a similar thing with the width
                         (lambda (i w)    
                           (if (< i (+ index 1))
                               w
                               width))
                         "w"))
        (set! index (+ index 1)))

      (define/augment (update t d)
        0)

      (super-new)))

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

(define extruded-twig-view%
    (class twig-view%
      
      (inherit-field index radius num-points pos dir col tex grow-t)
      
      (field
       (profile '())
       (path '())
       (root 0)
       (widths '()))
      
      (define/override (build)
       (set! profile (build-circle-profile 12 1))
       (set! path (build-list num-points (lambda (_) (vector 0 0 0))))
       (set! widths (build-list num-points (lambda (_) 1)))
       (set! root (let ((p (with-state
                            (backfacecull 0)
                            (when wire-mode 
                              (hint-none)
                              (hint-wire))
						(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
                       (texture (load-texture tex))
                       (opacity 0.6)
                       (colour col)
                       #;(colour (vector 1 1 1))
                       #;(texture (load-texture "textures/root.png")) 
                       (build-partial-extrusion profile path 3))))
               p)))
      
      (define/override (get-root)
        root)
      
      (define/override (get-point point-index)
        (list-ref path point-index))

      (define/override (get-width point-index)
        (list-ref widths point-index))

      (define (list-set l c s)
        (cond ((null? l) '())
              ((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
              (else (cons (car l) (list-set (cdr l) (- c 1) s)))))
            
      (define/augment (add-point point width)
        (set! path (list-set path index point))
        (set! widths (list-set widths index width))
        (set! index (+ index 1)))

      (define/augment (update t d)                   
        (when (< grow-t (length path))
          (with-primitive root
            (partial-extrude grow-t profile path widths (vector 1 0 0) 0.05))))
      
      (define/public (get-end-pos)
	  	(list-ref path (if (zero? index) 0 (- index 1)))
        #;(with-primitive root (pdata-ref "p" (- (* index (length profile)) 1))))

      (super-new)))

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

(define plant-view%
    (class object%
      
      (init-field
       (id "none")
       (pos (vector 0 0 0))
       (size 0)
       (col (vector 1 1 1))
       (tex "ooo"))
       
       (field 
        (twigs '()) ; a assoc list map between ids and twigs stored flat here,       
                    ; for fast access, but prims heirachically in the scenegraph
        (root (with-state 
               (translate pos)
               (build-locator)))
        (seed (with-state
               (parent root)
			   (shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
               (texture (load-texture tex))
               (backfacecull 0)
               (opacity 0.6)
               (colour col)
               (hint-depth-sort)
               (scale (* 0.12 size))
                            (when wire-mode 
                              (hint-none)
                              (hint-wire))
               ;(hint-unlit)
               (load-primitive "meshes/seed.obj")))
        (nutrients (let ((p (with-state
                            (hint-depth-sort)
                            (hint-unlit)
                            (parent root)
                            (blend-mode 'src-alpha 'one)
                            (texture (load-texture "textures/star.png"))
                            (build-particles 100))))
                        (with-primitive p
                                      (pdata-add "twig" "f")
                                      (pdata-add "point" "f")
                                      (pdata-add "offset" "v")
                                      (pdata-add "speed" "f")
                                      (pdata-map! 
                                       (lambda (point)
                                         0)
                                       "point")
                                      (pdata-map! 
                                       (lambda (point)
                                         (* 3 (+ 0.1 (rndf))))
                                       "speed")
                                      (pdata-map! 
                                       (lambda (offset)
                                         (vector 0 0 0))
                                       "offset")
                                      (pdata-map! 
                                       (lambda (c)
                                         (vector 0 (rndf) (rndf)))
                                       "c")
                                      (pdata-map! 
                                       (lambda (p)
                                         (vmul (vadd (crndvec) (vector 0 -1 0)) 900))
                                       "p")
                                      (pdata-map! 
                                (lambda (s)
                                    (vmul (vector 1 1 1) (+ 0.1 (rndf))))
                                "s"))
                        p)))
        
      (define/public (get-id)
        id)
      
      (define/public (get-col)
        col)
      
      (define/public (get-twig twig-id)
        (let ((l (assq twig-id twigs)))
          (if l              
              (cadr (assq twig-id twigs))
              #f)))
      
      (define/public (destroy-branch-twig twig-id)
        (for-each
         (lambda (twig-id)
           (destroy-branch-twig twig-id))
         (send (get-twig twig-id) get-child-twig-ids))
        (send (get-twig twig-id) destroy-twig)
        (set! twigs (assoc-remove twig-id twigs)))
      
      (define/public (destroy-plant)
        (destroy root)
        (for-each
         (lambda (twig)
           (destroy-branch-twig (car twig)))
         twigs))
      
      (define/public (add-twig parent-twig-id point-index twig)
        (let ((ptwig (get-twig parent-twig-id)))
          (when ptwig                        
            (send twig set-pos! (send ptwig get-point point-index)) ; attach to parent twig   
            ; tell the twigs about this relationship (might turn out to be overkill)
            (send ptwig add-child-twig-id (send twig get-id))
            (send twig set-parent-twig-id parent-twig-id))
            
          (send twig set-col! col)   
          (send twig set-tex! tex)   
          (send twig build)
          
          (with-primitive (send twig get-root)
                          (parent root))
                    
          (set! twigs (cons (list (send twig get-id) twig) twigs))))
      
      (define/public (add-twig-point twig-id point width)
        (send (get-twig twig-id) add-point point width))

      (define/public (start-twig-growing twig-id)
        (send (get-twig twig-id) start-growing))
      
      (define/public (grow-seed amount)
        (with-primitive seed (scale amount)))
      
      (define/public (add-ornament twig-id point-index property)
        (send (get-twig twig-id) add-ornament point-index property))
      
      (define/public (update-nutrients t d)
       (when (not (null? twigs))
          (with-primitive nutrients
                          (pdata-index-map!
                           (lambda (i p twig-id point offset speed)
                             (let* ((twig-id (inexact->exact twig-id))
                                    (twig (get-twig twig-id))
                                    (point (inexact->exact point)))
                             (cond 
                               ((or (< point 1) (not twig))
                                (let* ((new-twig (choose twigs))
                                       (num-points (send (cadr new-twig) get-num-points))
                                       (new-point (if (zero? num-points) 0 (random num-points))))
                                  (pdata-set! "twig" i (car new-twig))
                                  (pdata-set! "point" i new-point)
                                  (pdata-set! "offset" i (vmix offset (vmul (srndvec) (send (cadr new-twig) get-width new-point)) 0.2))
                                  (send (cadr new-twig) get-point new-point)))
                               ((< (vdist (vadd (send twig get-point point) offset) p) 0.1)
                                (pdata-set! "point" i (- point 1))                               
                                (vadd p (vmul (vnormalise (vsub (vadd (send twig get-point (- point 1)) offset) p)) (* speed d))))
                               (else
                                (vadd p (vmul (vnormalise (vsub (vadd (send twig get-point point) offset) p)) (* speed d)))))))
                           "p" "twig" "point" "offset" "speed"))))
              
      (define/public (update t d)
        (update-nutrients t d)
        (with-primitive seed
                        (scale (+ 1 (* 0.001 (sin (* 2 t))))))                       
        
        (for-each 
         (lambda (twig)
           (send (cadr twig) update t d))
         twigs))
        
      (super-new)))

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

(define (build-env-box top bottom left right front back lower)    
  (let ((p (build-locator)))
    (with-state
     (parent p)
  (hint-unlit)  
  
  (list
  (let ((t (with-state
        (texture (load-texture top))
        (translate (vector 0 0.5 0))
        (rotate (vector 90 0 0))
        (build-plane))))
      (when lower (with-primitive t
                      (pdata-map!
                       (lambda (t)
                         (vmul t 10))
                       "t"))
					   ) t)
    
    (with-state
        (texture (load-texture left))
        (translate (vector 0 0 -0.5))
        (rotate (vector 0 0 0))
        (build-plane))
    
    (with-state
        (texture (load-texture back))
        (translate (vector 0.5 0 0))
        (rotate (vector 0 90 0))
        (build-plane))
    
    (with-state
        (texture (load-texture right))
        (translate (vector 0 0 0.5))
        (rotate (vector 0 0 0))
        (build-plane))
    
    (with-state
        (texture (load-texture front))
        (translate (vector -0.5 0 0))
        (rotate (vector 0 90 0))
        (build-plane))
    
    (if lower
      (with-state
        (texture (load-texture bottom))
        (translate (vector 0 -0.5 0))
        (rotate (vector 90 0 0))        
        (build-plane)) 0)))))

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

(define game-view%
  (class object%
    
    (field
     (plants '()) ; map of ids -> plants     
     (pickups '()) ; map of ids -> pickups
     (camera-dist 1)
     (env-root (with-state (scale 1000) (build-locator)))
     (root-camera-t 0)
     #;(upper-env (with-state
                 (parent env-root)
                 (hint-depth-sort)
                 (colour 2)
                 (translate (vector 0 0.28 0))
                 (build-env-box "textures/top.png" "textures/bottom-trans.png" 
                                "textures/left.png" "textures/right.png"
                                "textures/front.png" "textures/back.png")))
    #;(lower-env (with-state
                (parent env-root)
                 (hint-depth-sort)
                 (translate (vector 0 -0.22001 0))
                 (build-env-box "textures/bottom-trans.png" "textures/bottom.png" 
                                "textures/sleft.png" "textures/sright.png"
                                "textures/sfront.png" "textures/sback.png")))
    (upper-env (with-state
                 (parent env-root)
                 ;(hint-depth-sort)
                 (hint-unlit)
                 (translate (vector 0 0.28 0))
                 (build-env-box "textures/sky-top.png" "textures/floor.png" 
                                "textures/sky-side.png" "textures/sky-side.png"
                                "textures/sky-side.png" "textures/sky-side.png" #f)))
    (lower-env (with-state
                (parent env-root)
                 ;(hint-depth-sort)
                 (hint-unlit)
                 (colour (earth-colour))
                 (translate (vector 0 -0.22001 0))
                 (build-env-box "textures/floor.png" "textures/earth-bottom.png" 
                                "textures/earth-side.png" "textures/earth-side.png"
                                "textures/earth-side.png" "textures/earth-side.png" #t)))
								
	(stones '()))
    
    (define/public (setup world-list)      
      (let ((l (make-light 'point 'free)))
      (light-diffuse 0 (vector 0.5 0.5 0.5))
      (light-diffuse l (vector 1 1 1))
      (light-position l (vector 10 50 -4)))

      (clear-colour fog-col)
      (clip 0.5 10000)
      (fog fog-col fog-strength 1 100)
	  
	  (set! stones
           (map 
              (lambda (stone)
                (let ((p (with-state  
                          (hint-frustum-cull)
				(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
		         (colour (stones-colour))
                 (translate (list-ref stone 1))
                 (scale (list-ref stone 2))
                 (rotate (list-ref stone 3))
                 (texture (load-texture "textures/quartz.png"))
                 (load-primitive (list-ref stone 0)))))
                  (with-primitive p (apply-transform) (recalc-bb)) ; apply the transform to speed up the ray tracing, don't have to tranform the ray into object space
                  p))
              (list-ref world-list 2))))

    (define/public (get-stones)
      stones)
	
    (define/public (add-plant plant)
      (printf "ADD-PLANT~n")
      ;(destroy-plant (send plant get-id)) ; just in case
      (set! plants (cons (list (send plant get-id) plant) plants)))
    
    (define/public (get-plant plant-id)
      (let ((p (assoc plant-id plants)))
        (if (not p) #f (cadr p))))
    
    (define/public (destroy-plant plant-id)
      (let ((p (get-plant plant-id)))
        (when p (send p destroy-plant)
          (set! plants (assoc-remove plant-id plants)))))
    
    (define/public (destroy-branch-twig plant-id twig-id)
      (send (get-plant plant-id) destroy-branch-twig twig-id))
    
    (define/public (add-twig plant-id parent-twig-id point-index twig)
      (send (get-plant plant-id) add-twig parent-twig-id point-index twig))
    
    (define/public (grow-seed plant-id amount)    
      (send (get-plant plant-id) grow-seed amount))
    
    (define/public (get-pickup pickup-id)
      (cadr (assq pickup-id pickups)))
    
    (define/public (add-pickup pickup-id type pos)
      (set! pickups (cons (list pickup-id (make-object pickup-view% pickup-id type pos)) pickups)))
    
    (define/public (pick-up-pickup pickup-id)
      (send (get-pickup pickup-id) pick-up)
      (set! pickups (assoc-remove pickup-id pickups)))
    
    (define/public (add-ornament plant-id twig-id point-index property)
      (send (get-plant plant-id) add-ornament twig-id point-index property))
                                 
    (define/public (update t d messages)            		 
	                    
      (for-each 
       (lambda (plant)
         (send (cadr plant) update t d))
       plants)

      (for-each 
       (lambda (pickup)
         (send (cadr pickup) update t d))
       pickups)
      
      (when debug-messages
        (for-each
         (lambda (msg)
           (send msg print))
         messages))      
      (for-each
       (lambda (msg)
         (cond
           ((eq? (send msg get-name) 'player-plant) ; not really any difference now
            (add-plant (make-object plant-view% 
                         (send msg get-data 'plant-id) 
                         (send msg get-data 'pos)
                         (send msg get-data 'size)
                         (send msg get-data 'col)
                         (send msg get-data 'tex))))
                      
           ((eq? (send msg get-name) 'new-plant)
            (printf "adding new plant to view ~a~n" (send msg get-data 'plant-id))
            (add-plant (make-object plant-view% 
                         (send msg get-data 'plant-id) 
                         (send msg get-data 'pos)
                         (send msg get-data 'size)
                         (send msg get-data 'col)
                         (send msg get-data 'tex))))
           
           ((eq? (send msg get-name) 'grow-seed)
            (grow-seed (send msg get-data 'plant-id) 
                       (send msg get-data 'amount)))
           
           ((eq? (send msg get-name) 'destroy-branch-twig)
            (destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id)))          
           
           ((eq? (send msg get-name) 'new-twig)
            (add-twig (send msg get-data 'plant-id)
                      (send msg get-data 'parent-twig-id)
                      (send msg get-data 'point-index)
                      (cond                         
                        ((eq? (send msg get-data 'render-type) 'ribbon)
                         (make-object ribbon-twig-view%                               
                           (send msg get-data 'twig-id)
                           (vector 0 0 0) ; will be filled in by add-twig
                           (send msg get-data 'type)                               
                           (send msg get-data 'dir)
                           (send msg get-data 'width)
                           (send msg get-data 'num-points)))
                        
                        ((eq? (send msg get-data 'render-type) 'extruded)
                         (make-object extruded-twig-view%                               
                           (send msg get-data 'twig-id)
                           (vector 0 0 0) ; will be filled in by add-twig
                           (send msg get-data 'type)                               
                           (send msg get-data 'dir)
                           (send msg get-data 'width)
                           (send msg get-data 'num-points))))))
           
           ((eq? (send msg get-name) 'add-twig-point)
            (send (get-plant (send msg get-data 'plant-id)) add-twig-point
                  (send msg get-data 'twig-id)
                  (send msg get-data 'point)
                  (send msg get-data 'width)))
           
           ((eq? (send msg get-name) 'start-growing)
            (send (get-plant (send msg get-data 'plant-id)) start-twig-growing
                  (send msg get-data 'twig-id)))                  
           
           ((eq? (send msg get-name) 'new-pickup)
            (add-pickup 
             (send msg get-data 'pickup-id) 
             (send msg get-data 'type) 
             (send msg get-data 'pos)))
           
           ((eq? (send msg get-name) 'pick-up-pickup)
            (pick-up-pickup 
             (send msg get-data 'pickup-id)))

           ((eq? (send msg get-name) 'pick-up-pickup)
            (pick-up-pickup 
             (send msg get-data 'pickup-id)))

           ((eq? (send msg get-name) 'light-level)
             (for-each 
			  	(lambda (p)
				  (with-primitive p
				  	(colour (send msg get-data 'amount))))
					upper-env))
                      
           ))
       messages))
    
    


    (super-new)))