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