117 lines
3.9 KiB
Scheme
117 lines
3.9 KiB
Scheme
#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))
|
|
|
|
(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) 1)
|
|
(vector 0.5 1 0.5))
|
|
(make-player-info "plant0000002@fo.am" "plant0000002"
|
|
"textures/plant0000002.png" (list-ref (list-ref seed-obs 1) 1)
|
|
(vector 0.5 1 0))
|
|
(make-player-info "plant0000003@fo.am" "plant0000003"
|
|
"textures/plant0000003.png" (list-ref (list-ref seed-obs 2) 1)
|
|
(vector 0 1 0.5))
|
|
(make-player-info "plant0000004@fo.am" "plant0000004"
|
|
"textures/plant0000004.png" (list-ref (list-ref seed-obs 3) 1)
|
|
(vector 0.75 1 0.5))
|
|
(make-player-info "plant0000005@fo.am" "plant0000005"
|
|
"textures/plant0000005.png" (list-ref (list-ref seed-obs 4) 1)
|
|
(vector 0.5 1 0.75))
|
|
))
|
|
(seeds '())
|
|
(clicked -1))
|
|
|
|
(define/public (get-player-info)
|
|
(list-ref players clicked))
|
|
|
|
(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))
|
|
(cl #f)
|
|
(tick-time 0)
|
|
(player #f)
|
|
(logic-tick 0.5)) ; time between logic updates
|
|
|
|
(define/public (setup pi)
|
|
(set! cl (make-object client% (player-info-jid pi) (player-info-pass pi)))
|
|
(set! player (make-object plant-logic%
|
|
(player-info-jid pi)
|
|
(player-info-pos pi)
|
|
(player-info-col pi)
|
|
(player-info-tex pi)))
|
|
(send c set-player-plant player)
|
|
(send gl add-player player)
|
|
(send c setup)
|
|
(send gv setup world-list)
|
|
(send gl setup world-list)
|
|
(send cl setup))
|
|
|
|
(define/public (update t d)
|
|
(when (< tick-time t)
|
|
|
|
|
|
(let ((messages (send gl update)))
|
|
; 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)))
|
|
|
|
(send gv update t d '())
|
|
(send c update t d))
|
|
|
|
(super-new)))
|