Skip to content

GitLab

Commit 2820bcc3 authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files

At least left-right as well as inside works.

parent f90ddc8f
Hide whitespace changes
Inline Side-by-side
Showing with 107 additions and 52 deletions
main.scm
View file @ 2820bcc3
......@@ -39,7 +39,7 @@
(define texture-map (make-hash-table))
(define ray-count 64)
(define ray-count 2)
(define rays (make-atomic-box '()))
......@@ -47,7 +47,7 @@
(define player (make-player (+ 1/2 (car (board-spawn game-map)))
(+ 1/2 (cadr (board-spawn game-map)))
0))
0.1))
(define update
(let ((keys-down '()))
......@@ -128,34 +128,31 @@
(define (x-from-edge x a)
"distance-from-y-wall"
(mod (* (sgn (sin a))
(mod (* (sgn (cos a))
(decimals x))
1))
(define (y-from-edge y a)
"distance-from-x-wall"
(mod (* (sgn (cos a))
(mod (* (sgn (sin a))
(decimals y))
1))
(define distance-from-x-wall y-from-edge)
(define distance-from-y-wall x-from-edge)
(define (hit-x? x y a)
(and (< (x-from-edge x a) 0.01)
(< (x-from-edge x a) (y-from-edge y a))))
(define (hit-y? x y a)
(and (< (y-from-edge y a) 0.01)
(< (y-from-edge y a) (x-from-edge x a))))
;; (loop (+ x (* 0.01 (cos a)))
;; (+ y (* 0.01 (sin a))))
(define (ray-trace player ray-count)
(let ((p (p player)))
(let ((px (x p))
(py (y p)))
(map (lambda (a)
;; (format #t "ray ~,3f τ~%" (/ a tau))
(let loop ((x px) (y py))
(format #t "a = ~,3f x = ~,6f y = ~,6f~%" a x y)
;; (format #t "x = ~,6f y = ~,6f~%" x y)
(cond [(or (not (and (<= 0 x) (< x (board-width game-map))
(<= 0 y) (< y (board-height game-map))))
......@@ -170,7 +167,7 @@
(lambda (s) (memv s '(wall window)))
=> (lambda (tile)
(format #t "hit ~a~%" tile)
;; (format #t "hit ~a~%" tile)
;; hit wall
(make-ray #:a a #:type tile
......@@ -178,29 +175,61 @@
#:hitf (v3 x y)))]
;; ================= follow ray ===============================
[(hit-x? x y a)
(let ((possible-dy (* (sgn (sin a))
(tan a))))
(if (> 1 (abs (+ (* (sgn (sin a))
(distance-from-x-wall y a))
possible-dy)))
;; enter x, leave x
(loop (+ x (sgn (cos a)))
(+ y possible-dy))
;; else, enter x, leave y
(let ((dy (* (sgn (sin a))
(distance-from-x-wall y a))))
(format #t "xxx: a = ~,2f x = ~,2f y = ~,2f dy = ~,2f~%" a x y dy)
(loop (+ x (* dy (cot a)))
(+ y dy)))))]
;; hit wall from top or bottom
[(hit-y? x y a)
;; (hit-x?)
[(distance-from-x-wall y a)
(lambda (d) (let ((dyw (distance-from-y-wall x a)))
(and (< dyw 0.01)
(< dyw d))))
=> (lambda (d)
(let ((possible-dy (* (sgn (cos a))
(tan a))))
(if (> 1 (abs (+ (* d (sgn (cos a)))
possible-dy)))
;; enter x, leave x
(loop (+ x (sgn (cos a)))
(+ y possible-dy))
;; else, enter x, leave y
(let ((dy (* d (sgn (cos a)))))
(loop (+ x (* dy (tan a)))
(+ y dy))))))]
;; hit wall from top or bottom (hit-y?)
[(distance-from-y-wall x a)
(lambda (d) (let ((dxw (distance-from-x-wall y a)))
(and (< dxw 0.01)
(< dxw d))))
=> (lambda (d)
(make-ray #:a a #:type 'wall
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y))
#;
;; dy = 1 = h * sin a
;; dx = h * cos a = 1/sin a * cos a = cos a / sin a = cot a
(let ((possible-dx (* (sgn (cos a)) (cot a))))
(if (> 1 (abs (+ (* d (sgn (cos a)))
possible-dx)))
(loop (+ x possible-dx)
(+ y (sgn (sin a))))
;; h /|
;; / | dy
;; /__+
;; dx
;; sin a = dx / h ↔ dx = h * sin a
;; dy = h * cos a = dx * (cos a / sin a)
(let ((dx (* d (sgn (sin a)))))
(loop (+ x dx)
(+ y (* dx (cot a)))))))
)
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
#;
(let ((b (- a (/ tau 4))))
......@@ -221,28 +250,50 @@
1))))
(format #t "yyy: a = ~,2f x = ~,2f y = ~,2f dx = ~,2f~%" a x y dx)
(loop (+ x dx)
(+ y (* dx (tan b))))))))]
(+ y (* dx (tan b))))))))
;; Middle of square
;; h * sin a = 1
;; dx = h * cos a = sin^-1 a * cos a = cot a
]
;; ===== Middle of square =====
;; moving horizontally
[(> (abs (cos a))
(abs (sin a)))
(let ((dx (* 1.01 (sgn (cos a))
(let* ((dx (* 1.01 (sgn (cos a))
(mod (* x -1 (sgn (cos a)))
1))))
(loop (+ x dx)
(+ y (* dx (tan a) (sgn (cos a))))))
1)))
(pdy (* dx (tan a))))
(if (= (truncate y) (truncate (+ y pdy)))
(loop (+ x dx)
(+ y pdy))
(let ((dy (* 1.01 (sgn (sin a))
(mod (* y -1 (sgn (sin a)))
1))))
(loop (+ x (* dy (cot a)))
(+ y dy)))))]
]
;; moving vertically
[else
(let ((dy (* 1.01 (sgn (sin a))
(let* ((dy (* 1.01 (sgn (sin a))
(mod (* y -1 (sgn (sin a)))
1))))
(loop (+ x (* dy (cot a)))
(+ y dy)))])))
1)))
(pdx (* dy (cot a))))
(if (= (truncate x) (truncate (+ x pdx)))
(loop (+ x pdx)
(+ y dy))
(let ((dx (* 1.01 (sgn (cos a))
(mod (* x -1 (sgn (cos a)))
1))))
(loop (+ x (* dx (tan a)))
(+ y dy))
)
))])))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
)
......@@ -322,7 +373,8 @@
(surface->texture (current-renderer) surf)
#:dstrect (list 5 (+ 1 (* line (+ 1 (font-height (current-font)))))
(surface-width surf)
(surface-height surf)))))
(surface-height surf)))
(delete-surface! surf)))
......@@ -334,6 +386,8 @@
(define (make-fps-counter)
(let ((last-time (sdl-ticks)))
(lambda ()
;; TODO this only ticks when sdl is active, which is NOT when
;; the window is unmapped
(let ((new-time (sdl-ticks)))
(let ((return (- new-time last-time)))
(set! last-time new-time)
......@@ -342,7 +396,8 @@
(define draw
(let ((fps-counter (make-fps-counter)))
(lambda ( window rend)
(parameterize ((current-renderer rend))
(parameterize ((current-renderer rend)
(current-tile-size (/ 480 (board-height game-map))))
;; minimap
(let ((texture (make-texture rend 'rgba8888 'target
......@@ -351,11 +406,11 @@
(with-render-target texture draw-map)
;; Camera
(draw-first-person-perspective)
;; (draw-first-person-perspective)
(render-copy rend texture
#:dstrect
(let ((map-size 200))
(let ((map-size 480))
(list 0 (- 480 map-size)
map-size map-size)))
......@@ -380,7 +435,7 @@
(begin-thread
(while
#t (let ((rays-next (ray-trace player (1+ ray-count))))
#t (let ((rays-next (ray-trace player ray-count)))
(atomic-box-set! rays rays-next)
(wait))))
......
simple.map
View file @ 2820bcc3
#####
# #
# P #
# #
#:::#
#: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