90 lines
2.4 KiB
Scheme
90 lines
2.4 KiB
Scheme
|
(define-module (game level)
|
||
|
#:use-module (ice-9 match)
|
||
|
#:use-module (ice-9 pretty-print)
|
||
|
#:use-module (srfi srfi-1)
|
||
|
#:use-module (srfi srfi-9)
|
||
|
#:use-module (srfi srfi-64)
|
||
|
|
||
|
#:export (make-level
|
||
|
level-width
|
||
|
level-height
|
||
|
level-tiles
|
||
|
level-entities
|
||
|
level-player
|
||
|
level-goal)
|
||
|
|
||
|
)
|
||
|
|
||
|
(define-record-type <level>
|
||
|
(%make-level width height tiles goal player entities)
|
||
|
level?
|
||
|
(width level-width)
|
||
|
(height level-height)
|
||
|
(tiles level-tiles)
|
||
|
(goal level-goal)
|
||
|
(player level-player)
|
||
|
(entities level-entities))
|
||
|
|
||
|
(define (parse-tile c)
|
||
|
(case c
|
||
|
((#\W) 'wall)
|
||
|
((#\B) 'brick)
|
||
|
((#\H) 'ladder)
|
||
|
((#\P) 'player)
|
||
|
((#\E) 'enemy)
|
||
|
((#\G) 'goal)
|
||
|
(else 'empty)))
|
||
|
|
||
|
(define (content->lines content)
|
||
|
(map
|
||
|
(lambda (line)
|
||
|
(string-trim-right
|
||
|
(car (string-split line #\-))
|
||
|
#\space))
|
||
|
(string-split content #\newline)))
|
||
|
|
||
|
(define (parse-lines lines)
|
||
|
(fold append
|
||
|
'()
|
||
|
(map
|
||
|
(lambda (line)
|
||
|
(map parse-tile (string->list line)))
|
||
|
lines)))
|
||
|
|
||
|
(define (parse-level content)
|
||
|
(let* ((lines (map
|
||
|
(lambda (line)
|
||
|
(string-trim-right
|
||
|
(car (string-split line #\-))
|
||
|
#\space))
|
||
|
(string-split content #\newline)))
|
||
|
(width (string-length (car lines)))
|
||
|
(height (length lines))
|
||
|
(tiles (list->vector
|
||
|
(parse-lines lines)))
|
||
|
(entities '()))
|
||
|
(%make-level width height tiles #f #f entities)))
|
||
|
|
||
|
(test-begin "level")
|
||
|
|
||
|
(test-assert (level? (parse-level "WWWWW\nWP GW\nWWWWW\n")))
|
||
|
(test-assert (level-width (parse-level "WWWWW\nWP GW\nWWWWW\n")) 5)
|
||
|
(test-assert (level-height (parse-level "WWWWW\nWP GW\nWWWWW\n")) 3)
|
||
|
(test-equal (level-tiles (parse-level "W")) #(wall))
|
||
|
(test-equal
|
||
|
(level-tiles (parse-level "WWWWW\nWP GW\nWWWWW\n"))
|
||
|
#(wall wall wall wall wall wall player empty goal wall wall wall wall wall wall))
|
||
|
(test-equal
|
||
|
(level-tiles (parse-level "--- ignore this line\nWWWWW\nWP GW - must be ignored\nWWWWW\n"))
|
||
|
#(wall wall wall wall wall wall player empty goal wall wall wall wall wall wall))
|
||
|
|
||
|
(test-equal (parse-tile #\W) 'wall)
|
||
|
(test-equal (parse-tile #\B) 'brick)
|
||
|
(test-equal (parse-tile #\H) 'ladder)
|
||
|
(test-equal (parse-tile #\P) 'player)
|
||
|
(test-equal (parse-tile #\E) 'enemy)
|
||
|
(test-equal (parse-tile #\G) 'goal)
|
||
|
(test-equal (parse-tile #\space) 'empty)
|
||
|
|
||
|
(test-end "level")
|