Commit f90ddc8f authored by Hugo Hörnquist's avatar Hugo Hörnquist

Move game maps to data files.

parent 92c26a61
######
# % #
# ####################
# % #
# #############%#%##
# # # # #
# % # # #
# #######****#**#**#
###%####:::::::::::::::::
::* *::::::::::::::::::
::* *::::::::::::::::::
::# #::::::::::::::::::
::* *::::::::::::::::::
::* *::::::::::::::::::
::# #::::::::::::::::::
::* *::::::::::::::::::
::* *::::::::::::::::::
::# #::::::::::::::::::
::* *::::::::::::::::::
::* *::::::::::::::::::
# ###**#*#**#**#**#**#
# % # # # # # # #
# ### # # # # # #
# ####%#%##%##%#%##%##
# %
## ####################
......@@ -39,12 +39,16 @@
(define texture-map (make-hash-table))
(define player (make-player 5.5 13.5 0))
(define ray-count 64)
(define rays (make-atomic-box '()))
(define game-map (call-with-input-file "simple.map" (compose parse-map read-map)))
(define player (make-player (+ 1/2 (car (board-spawn game-map)))
(+ 1/2 (cadr (board-spawn game-map)))
0))
(define update
(let ((keys-down '()))
(lambda (dt) ; dt in ms
......@@ -153,8 +157,8 @@
(let loop ((x px) (y py))
(format #t "a = ~,3f x = ~,6f y = ~,6f~%" a x y)
(cond [(or (not (and (<= 0 x) (< x board-width)
(<= 0 y) (< y board-height)))
(cond [(or (not (and (<= 0 x) (< x (board-width game-map))
(<= 0 y) (< y (board-height game-map))))
(< 15 (sqrt (+ (expt (- x px) 2)
(expt (- y py) 2)))))
;; outside board
......@@ -162,7 +166,7 @@
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y)) ]
[(array-ref game-map (int y) (int x))
[(array-ref (board-data game-map) (int y) (int x))
(lambda (s) (memv s '(wall window)))
=> (lambda (tile)
......@@ -251,14 +255,14 @@
(for-each
(lambda (pt)
(apply set-draw-color
(case (array-ref game-map (y pt) (x pt))
(case (array-ref (board-data game-map) (y pt) (x pt))
((wall) '(#xBB #xBB #xBB))
((window) '(#x10 #x10 #xFF))
((grass) '(0 #xCC 0))
(else '(#xFF #xFF #xFF))))
(fill-rect (x pt) (y pt) 1 1))
(map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height))))
(cross-product (iota (board-width game-map)) (iota (board-height game-map)))))
;; draw raycast
(set-draw-color #xFF 0 0)
......@@ -342,8 +346,8 @@
;; minimap
(let ((texture (make-texture rend 'rgba8888 'target
(* board-width (current-tile-size))
(* board-height (current-tile-size)))))
(* (board-width game-map) (current-tile-size))
(* (board-height game-map) (current-tile-size)))))
(with-render-target texture draw-map)
;; Camera
......
(define-module (map)
:export (game-map board-height board-width))
:use-module (ice-9 rdelim)
:export ())
(define-public (read-map port)
(let loop ((board '()))
(let ((p (read-line port 'split)))
(let ((line (car p))
(delim (cdr p)))
(if (eof-object? delim)
(reverse board)
(loop (cons line board)))))))
(define (parse-map spec)
(let ((arr (make-array #f (length spec) (string-length (car spec)))))
(define-public (parse-map spec)
(let ((arr (make-array #f (length spec) (string-length (car spec))))
(spawn '(1 1)))
(array-index-map! arr
(lambda (i j)
(case (string-ref (list-ref spec i) j)
((#\P #\p) (set! spawn (list j i)) 'space)
((#\space) 'space)
((#\#) 'wall)
((#\:) 'grass)
((#\;) 'teleporter)
((#\*) 'window)
((#\%) 'entrance))))
arr))
(list spawn arr)))
(define-public board-spawn car)
(define-public board-data cadr)
(define-public (board-height board) (car (array-dimensions (board-data board))))
(define-public (board-width board) (cadr (array-dimensions (board-data board))))
#;
(define game-map
......@@ -35,6 +51,7 @@
" # ###**#*#**#**#**#**#"
" ## #####################")))
#;
(define game-map
(parse-map
......@@ -68,5 +85,3 @@
(define-values (board-height board-width)
(apply values (array-dimensions game-map)))
#####
# #
# P #
# #
#####
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment