wakyct
/
janus0x1
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

added bounds and walkable test in move action 

simplified vector-ref'ing
This commit is contained in:
George Oliver 2020-06-30 20:39:35 -07:00
parent b3008eeb53
commit 7db1719c3a
1 changed files with 23 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
janus0x1.scm
View File

@ -78,7 +78,8 @@
(vector-for-each
(lambda (x) (tile-walkable?-set! x #f) (tile-clear?-set! x #f))
(subvector world 96 128))
(subvector world 30 33))
;;;;
;; output views
(define-record view glyph)
@ -99,6 +100,11 @@
(make-view (glyphs #x0023)))
;;;;
(define (in-bounds? x y)
(and (<= 0 x) (<= 0 y) (>= (sub1 ww) x) (>= (sub1 wh) y)))
(define (walkable? x y)
(tile-walkable? (vector-ref world (pos->idx x y))))
;; actions
(define (move thing dir)
@ -106,10 +112,15 @@
(y (thing-y thing))
(dirs '((#:up 0 -16) (#:down 0 16) (#:left -16 0) (#:right 16 0)))
(dx (second (assoc dir dirs)))
(dy (third (assoc dir dirs))))
(thing-x-set! thing (+ x dx))
(thing-y-set! thing (+ y dy))))
(dy (third (assoc dir dirs)))
(nx (+ x dx))
(ny (+ y dy)))
(when (and (in-bounds? nx ny) (walkable? nx ny))
(begin
(thing-x-set! thing nx)
(thing-y-set! thing ny)))))
;;;;
;; event handler
(define (handle-event event exit-main!)
@ -138,8 +149,8 @@
;; y will go from 0 to 380 by 20s (based on screen height divided by 16).
;; add x and y to get i.
(define (pos->screen-rect x y)
(vector-ref screen-rects (+ (/ x 16) (* (/ wh 16) (/ y 16)))))
(define (pos->idx x y)
(+ (/ x 16) (* (/ wh 16) (/ y 16))))
;; given an index i, how to find the (x y) where the tile is?
;; take (304, 0) which is index 19.
@ -150,24 +161,22 @@
(define (idx->pos i)
(values (* 16 (modulo i (/ ww 16))) (* 16 (quotient i (/ wh 16)))))
(define (idx->screen-rect i)
(vector-ref screen-rects i))
(define (draw-world! xs)
(let loop ((xs xs)
(i 0))
(cond ((tile-walkable? (vector-ref xs i))
(sdl2:blit-surface! (view-glyph tile-space-view) #f w-surf (idx->screen-rect i)))
(sdl2:blit-surface! (view-glyph tile-space-view) #f w-surf (vector-ref screen-rects i)))
((not (tile-walkable? (vector-ref xs i)))
(sdl2:blit-surface! (view-glyph tile-wall-view) #f w-surf (idx->screen-rect i))))
(sdl2:blit-surface! (view-glyph tile-wall-view) #f w-surf (vector-ref screen-rects i))))
(when (> (sub1 (vector-length xs)) i) (loop xs (add1 i)))))
(define (redraw!)
(sdl2:fill-rect! w-surf #f black)
(draw-world! world)
(sdl2:blit-surface! (view-glyph player-view) #f w-surf (pos->screen-rect (thing-x player) (thing-y player)))
(sdl2:blit-surface! (view-glyph npc-view) #f w-surf (pos->screen-rect (thing-x npc) (thing-y npc)))
(sdl2:blit-surface!
(view-glyph player-view) #f w-surf (vector-ref screen-rects (pos->idx (thing-x player) (thing-y player))))
(sdl2:blit-surface!
(view-glyph npc-view) #f w-surf (vector-ref screen-rects (pos->idx (thing-x npc) (thing-y npc))))
(sdl2:update-window-surface! window))
;;;;