bloatrunner/game/main.scm

(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 render level)
  #:use-module (game render hero)
  #:use-module (game render other)
  #: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 level #f)
(define repl #f)
(define hero #f)
(define others #f)
(define inputs '())

(define (load)
  (render-level-load)
  (render-hero-load)
  (render-other-load)
  (set! level (level-parse-file "assets/levels/level-1.map"))
  (render-level-set! level)
  (set! hero (hero-load level))
  (set! others (other-load-others level))
  (set! repl (spawn-coop-repl-server)))

(define (update dt)
  (poll-coop-repl-server repl)
  (set! hero (hero-update hero level inputs dt))
  (set! others (map (lambda (other) (other-update other level hero others dt)) others))
  )

(define (draw _alpha)
  (render-level-draw level)
  (render-hero hero)
  (for-each render-other others)
  )

(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))
   ))