(define-module (game main) #:use-module (ice-9 pretty-print) #:use-module (game model level) #:use-module (game model hero) #:use-module (game model other) #:use-module (game model key) #:use-module (game render level) #:use-module (game render hero) #:use-module (game render other) #:use-module (game render key) #:use-module (game util assets) #:use-module (chickadee) #:use-module (chickadee math rect) #:use-module (chickadee math vector) #:use-module (chickadee graphics color) #:use-module (chickadee graphics sprite) #:use-module (chickadee graphics texture) #:use-module (chickadee graphics text) #:use-module (chickadee graphics tile-map) #:use-module (system repl coop-server) #:use-module (srfi srfi-1) #:export (launch-game)) (define levels #f) (define level #f) (define repl #f) (define hero #f) (define others #f) (define keys #f) (define inputs '()) (define has-won? #f) (define (load) (assets-load) (render-level-load) (set! levels (assets-map-levels level-parse-file)) (load-level) (set! repl (spawn-coop-repl-server))) (define (load-level) (set! level (car levels)) (set! levels (cdr levels)) (render-level-set! level) (set! hero (hero-load level)) (set! others (other-load-others level)) (set! keys (keys-load level)) ) (define (update dt) (poll-coop-repl-server repl) (set! hero (hero-update hero level inputs keys dt)) (set! others (map (lambda (other) (other-update other level hero others dt)) others)) (set! keys (keys-update keys hero)) (if (level-same-cell? (hero-position hero) (level-find-goal level)) (if (null? levels) (set! has-won? #t) (load-level))) ) (define (render-level) (render-level-draw level) (for-each render-other others) (render-keys keys (level-find-goal level)) (render-hero hero)) (define (draw _alpha) (if has-won? (render-victory) (render-level))) (define (set-add set item) (if (member item set) set (cons item set))) (define (key-press key _modifiers _repeat?) (set! inputs (cond ((eq? key 'left) (set-add inputs 'left)) ((eq? key 'right) (set-add inputs 'right)) ((eq? key 'up) (set-add inputs 'up)) ((eq? key 'down) (set-add inputs 'down )) ((eq? key 'space) (set-add inputs 'dig )) (else inputs))) ) (define (key-release key _modifiers) (set! inputs (cond ((eq? key 'left) (delete 'left inputs)) ((eq? key 'right) (delete 'right inputs)) ((eq? key 'up) (delete 'up inputs)) ((eq? key 'down) (delete 'down inputs)) ((eq? key 'space) (delete 'dig inputs)) (else inputs)))) (define (launch-game args) (run-game #:window-title "Bloatrunner" #:load (lambda () (load)) #:update (lambda (dt) (update dt)) #:draw (lambda (alpha) (draw alpha)) #:key-press (lambda (key modifiers repeat?) (key-press key modifiers repeat?)) #:key-release (lambda (key modifiers) (key-release key modifiers)) ))