groworld/plant-eyes/scripts/game-modes.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 
  "logic.ss" 
  "view.ss" 
  "controller.ss" 
  "client.ss" 
  "jabberer.ss" 
  "list-utils.ss")
  
(provide (all-defined-out))

(define-struct player-info (jid pass tex pos col property shape-params))

(define plant-colour (vector 0.5 0.55 0.45))

(define gui-game-mode%
  (class object%
    (init-field
		(seed-obs '()))
  
    (field
     (players (list
               (make-player-info "plant0000001@fo.am" "plant0000001" 
                                 "textures/plant0000001.png" (list-ref (list-ref seed-obs 0) 2)
								  plant-colour
								  'flower
								  '(10 0))
               (make-player-info "plant0000002@fo.am" "plant0000002" 
                                 "textures/plant0000002.png" (list-ref (list-ref seed-obs 1) 2) 
								 plant-colour
								 'leaf
								 '(20 0))
               (make-player-info "plant0000004@fo.am" "plant0000004" 
                                 "textures/plant0000004.png" (list-ref (list-ref seed-obs 2) 2) 
								 plant-colour
								 'fork
								 '(40 0))
               (make-player-info "plant0000005@fo.am" "plant0000005" 
                                 "textures/plant0000005.png" (list-ref (list-ref seed-obs 3) 2) 
								 plant-colour
								 'horn
								 '(50 0))
               ))
     (seeds '())
     (clicked -1))
    
    (define/public (get-player-info) 
      (list-ref players clicked))
	  
	(define/public (get-players)
		players)
        
    (define/public (setup)
      (let ((c 0))
      (set! seeds (map
                   (lambda (pi)
                     (with-state
                      (translate (vmul (vector (sin (* 2 3.141 (/ c (length players))))
                                               (cos (* 2 3.141 (/ c (length players)))) 0) 4))
                      ;(texture (load-texture (player-info-tex pi)))
                      (colour (player-info-col pi))
                      (set! c (+ c 1))
                      ;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
                      (load-primitive "meshes/seed.obj")))
                   players))))
                     
    (define/public (update t d)
      (for-each 
       (lambda (seed)
         (with-primitive seed
                         (rotate (vector 0 1 0))))
       seeds)
      (cond 
        ((mouse-button 1)
         (let ((o (mouse-over)))
           (cond
             (o
              (set! clicked (which-element o seeds 0))
              (when clicked
                (for-each 
                 (lambda (seed)
                   (destroy seed))
                 seeds))
              (if clicked #t #f))
             (else 
              #f))))
        (else
         #f)))
    
    (super-new)))


(define main-game-mode%
  (class object%
    (init-field
		(world-list '()))
		
    (field
     (gl (make-object game-logic%))
     (gv (make-object game-view%))
     (c (make-object controller% gv gl))
     (cl #f)
     (tick-time 0)
     (player #f)
     (logic-tick 0.5)) ; time between logic updates

    (define/public (setup pi players)
      (set! cl (make-object client% (player-info-jid pi) (player-info-pass pi)))
      (set! player (make-object plant-logic% 
	  				 gl
                     (player-info-jid pi) 
                     (player-info-pos pi)                     
                     (player-info-col pi)
                     (player-info-tex pi) 
					 #t
					 (player-info-property pi)
					 (player-info-shape-params pi)))
					
      (send c set-player-plant player)
      (send gl add-player player)

	  ; add the other players...
 	  (for-each 
	  	(lambda (player)
		  (display (player-info-pos player))(newline)
		  (when (not (eq? player pi))
		      (send gl add-plant (make-object plant-logic% 
			  		 gl
                     (player-info-jid player) 
                     (player-info-pos player)                     
                     (player-info-col player)
                     (player-info-tex player)
					 #f
					 (player-info-property player)
					 (player-info-shape-params player)
					 ))))
		players)

      (send c setup)
      (send gv setup world-list)
      (send gl setup world-list)
      (send cl setup))

    (define/public (update t d)
      (cond ((< tick-time t)    
        
        
        (let ((messages (send gl update t d)))
          ; pass the messages to the network client 
          (send gv update t d (send cl update messages gl))) ; and the game view
        
        (set! tick-time (+ t logic-tick)))
      
      (else (send gv update t d '())))
      (send c update t d))
    
    (super-new)))