add inputs detection and allow level tile inspection

This commit is contained in:
Peter Tillemans 2024-05-21 00:56:54 +02:00
parent 98b8d18e1c
commit e27621b86b
3 changed files with 60 additions and 8 deletions

View file

@ -12,11 +12,13 @@
#:use-module (chickadee graphics text) #:use-module (chickadee graphics text)
#:use-module (chickadee graphics tile-map) #:use-module (chickadee graphics tile-map)
#:use-module (system repl coop-server) #:use-module (system repl coop-server)
#:use-module (srfi srfi-1)
#:export (launch-game)) #:export (launch-game))
(define level #f) (define level #f)
(define repl #f) (define repl #f)
(define hero #f) (define hero #f)
(define inputs '())
(define (load) (define (load)
(render-level-load) (render-level-load)
@ -37,9 +39,39 @@
(render-hero hero) (render-hero hero)
) )
(define (set-add set item)
(if (member item set)
set
(cons item set)))
(define (key-press key)
(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)
(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) (define (launch-game args)
(run-game #:load (lambda () (load)) (run-game
;; #:title "Bloatrunner"
#:load (lambda () (load))
#:update (lambda (dt) (update dt)) #:update (lambda (dt) (update dt))
#:draw (lambda (alpha) (draw alpha)))) #:draw (lambda (alpha) (draw alpha))
;; #:key-press (lambda (key) (key-press key))
;; #:key-release (lambda (key) (key-release key))
))

View file

@ -66,10 +66,18 @@
(level-parse (call-with-input-file filename get-string-all))) (level-parse (call-with-input-file filename get-string-all)))
(define (level-tile-at level x y) (define (level-tile-at-row-col level row col )
(let ((index (+ (* y (level-width level)) x))) (let ((index (+ (* row (level-width level)) col)))
(vector-ref (level-tiles level) index))) (vector-ref (level-tiles level) index)))
(define cell-size 16)
(define (coord->cell coord)
(inexact->exact (floor (/ coord cell-size))))
(define (level-tile-at level x y )
(level-tile-at-row-col level (coord->cell y) (coord->cell x)))
(test-begin "level") (test-begin "level")
@ -99,11 +107,23 @@
(test-equal (level-height (level-parse-file "assets/levels/level-1.map")) 30) (test-equal (level-height (level-parse-file "assets/levels/level-1.map")) 30)
(test-equal (test-equal
(level-tile-at (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 1) (level-tile-at-row-col (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 1)
'player) 'player)
(test-equal (test-equal
(level-tile-at (level-parse "WWWWW\nWP GW\nWWWWW\n") 3 1) (level-tile-at-row-col (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 3)
'goal) 'goal)
(test-equal
(level-find-player (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 3)
(vec2 16 16))
(test-equal
(level-find-goal (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 3)
(vec2 48 16))
(test-equal
(level-find-goal (level-parse "WWWWW\nWE EW\nWWWWW\n") 1 3)
(list (vec 16 16) (vec2 48 16)))
(test-end "level") (test-end "level")

View file

@ -49,7 +49,7 @@
(let* (let*
((x (* 16 column)) ((x (* 16 column))
(y (* 16 row)) (y (* 16 row))
(tile (level-tile-at level column row)) (tile (level-tile-at level x y))
(texture-region (texture-atlas-ref tile-atlas (level-tile-index tile)))) (texture-region (texture-atlas-ref tile-atlas (level-tile-index tile))))
(sprite-batch-add! sprite-batch (vec2 x y) (sprite-batch-add! sprite-batch (vec2 x y)
#:texture-region texture-region))) #:texture-region texture-region)))