Skip to content
Snippets Groups Projects
Commit 4d2225f9 authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files

Merge remote-tracking branch 'origin/master' into ttt

parents 1c516e64 2cde0f4a
Branches
Tags
No related merge requests found
Show whitespace changes
Inline Side-by-side
class.scm
+ 1
− 3
View file @ 4d2225f9
...@@ -45,6 +45,7 @@ ...@@ -45,6 +45,7 @@
(vec #:accessor vec #:init-keyword #:v) (vec #:accessor vec #:init-keyword #:v)
(pos-on-wall #:accessor pos-on-wall) (pos-on-wall #:accessor pos-on-wall)
(hit-point #:getter hitf #:init-keyword #:hitf) (hit-point #:getter hitf #:init-keyword #:hitf)
(hit-float-point #:getter hitf #:init-keyword #:hitf)
(tile-type #:getter type (tile-type #:getter type
#:initial-value #f #:initial-value #f
#:init-keyword #:type) #:init-keyword #:type)
...@@ -52,9 +53,6 @@ ...@@ -52,9 +53,6 @@
(export a length vec pos-on-wall hitf type) (export a length vec pos-on-wall hitf type)
(define (decimals x)
(- x (truncate x)))
(define-method (initialize (self <ray>) args) (define-method (initialize (self <ray>) args)
(next-method) (next-method)
(unless (length self) (unless (length self)
......
main.scm
+ 159
− 57
View file @ 4d2225f9
...@@ -34,7 +34,7 @@ ...@@ -34,7 +34,7 @@
(define texture-map (make-hash-table)) (define texture-map (make-hash-table))
(define player (make-player 5 13 -2)) (define player (make-player 5 13 0))
(define ray-count 64) (define ray-count 64)
...@@ -65,32 +65,136 @@ ...@@ -65,32 +65,136 @@
(sin (a player)))))) (sin (a player))))))
(wake)) (wake))
((j) (set! (a player) = (- (* dt 4e-3))) ((j) (set! (a player) = (- (* dt 4e-3)))
(when (> 0 (a player))
(set! (a player) tau))
(wake)) (wake))
((p) (set! (a player) = (+ (* dt 4e-3))) ((p) (set! (a player) = (+ (* dt 4e-3)))
(wake)))) (when (< tau (a player))
(set! (a player) 0))
(wake))
))
keys-down)))) keys-down))))
;; (define (ray-trace player ray-count)
;; (let ((x (x (p player)))
;; (y (y (p player))))
;; (map
;; (lambda (a)
;; (let loop ((dx 0)
;; (dy 0))
;; (let ((nx (+ x dx))
;; (ny (+ y dy)))
;; (let ((ix (int nx))
;; (iy (int ny)))
;; (if (or (not (and (<= 0 nx board-width)
;; (<= 0 ny board-height)))
;; (memv (array-ref game-map iy ix)
;; '(wall window)))
;; (make-ray #:a a
;; #:v (v3 dx dy)
;; #:type (if (not (and (<= 0 nx board-width)
;; (<= 0 ny board-height)))
;; #f (array-ref game-map iy ix))
;; #:hitf (v3 nx ny)
;; #:hit (v3 ix iy))
;; (loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a)))))))))
;; (iota ray-count (- (a player) (/ (fov player) 2))
;; (/ (fov player) ray-count)))))
(define (pow x y)
(let ((xd (abs (decimals x)))
(yd (abs (decimals y))))
(min (max xd yd)
(max (- 1 xd) (- 1 yd)))))
(define (decimals x)
(- x (truncate x)))
(define (cot a)
(/ (tan a)))
(define sgn signum)
(define (ray-trace player ray-count) (define (ray-trace player ray-count)
(let ((p (p player))) (let ((p (p player)))
(map (let ((px (x p))
(lambda (a) (py (y p)))
(let loop ((dx 0) (dy 0)) (map (lambda (a)
(let ((nx (+ dx (x p))) (let loop ((x px)
(ny (+ dy (y p)))) (y py))
(if (not (and (<= 0 nx board-width)
(<= 0 ny board-height))) (cond [(not (and (<= 0 x board-width)
(make-ray #:a a #:v (v3 dx dy) (<= 0 y board-height)))
#:hitf (v3 nx ny) ;; outside board
#:type #f) (make-ray #:a a
(let ((tile (array-ref game-map (int ny) (int nx)))) #:v (v3 (- x px) (- y py))
(if (memv tile '(wall window)) #:type #f
(make-ray #:a a #:v (v3 dx dy) #:hitf (v3 x y)) ]
[(array-ref game-map (int y) (int x))
(lambda (s) (memv s '(wall window)))
=> (lambda (tile)
;; hit wall
(make-ray #:a a
#:v (v3 (- x px) (- y py))
#:type tile #:type tile
#:hitf (v3 nx ny)) #:hitf (v3 x y)))]
;; else continue [else
(loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a)))))))))) ;; follow ray
(cond [(< (abs (decimals x)) 0.01)
;; hit wall from left or right
(let ((p (- (round (pow x y)) (pow x y))))
(cond
[(= a 0) (loop (+ x (sgn (cos a))) y)]
;; enter x, leave x
[(< 0 (abs (sin a)) (sin (/ tau 8)))
(cond [(= p 0)
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))]
[(<= p (tan a))
(loop (+ x (sgn (cos a)))
(+ y (tan a)))]
[else
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
#;
(let ((dy (* (sgn (sin a))
(if (= 1 (sgn (sin a)))
(- 1 (pow x y))
(pow x y)))))
(loop (+ x (* dy (cot a)))
(+ y dy)))])]
;; enter x, leave y
[else
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
#;
(if (= p 0)
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
(let ((dy (* (- 1 p) (sgn (sin a)))))
(loop (+ x (* dy (cot a)))
(+ y dy) ))
)]))]
[(< (abs (decimals y)) 0.01)
;; hit wall from top or bottom
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))]
[else
;; Middle of square
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))]
)])))
(iota ray-count (- (a player) (/ (fov player) 2)) (iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count))))) (/ (fov player) ray-count)))))
)
(define (draw-map) (define (draw-map)
(set-draw-color #xFF #xFF #xFF) (set-draw-color #xFF #xFF #xFF)
...@@ -109,16 +213,16 @@ ...@@ -109,16 +213,16 @@
(map (lambda (p) (apply v3 p)) (map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height)))) (cross-product (iota board-width) (iota board-height))))
;; draw raycast ;; draw raycast
(set-draw-color #xFF 0 0) (set-draw-color #xFF 0 0)
(let ((p (p player)))
(for-each (let ((pp (p player)))
(lambda (ray) (for-each (lambda (ray)
(let ((v (+ p (vec ray)))) (let ((v (+ pp (vec ray))))
(draw-line (x p) (y p) (draw-line (x pp) (y pp)
(x v) (y v)))) (x v) (y v))))
(atomic-box-ref rays)))) (atomic-box-ref rays)))
)
(define (draw-first-person-perspective) (define (draw-first-person-perspective)
(set-draw-color #xBB #xBB #xFF) ; light blue (set-draw-color #xBB #xBB #xFF) ; light blue
...@@ -129,22 +233,21 @@ ...@@ -129,22 +233,21 @@
(render-fill-rect (current-renderer) (render-fill-rect (current-renderer)
(make-rect 0 240 640 240)) (make-rect 0 240 640 240))
(let ((rays (atomic-box-ref rays))) (let ((rays (atomic-box-ref rays)))
(unless (null? rays) (unless (null? rays)
(for-each (lambda (i r) (for-each
(let ((hit-tile (hashq-ref texture-map (type r)))) (lambda (i r)
(when hit-tile (cond ((hashq-ref texture-map (type r))
=> (lambda (texture)
(let* ((l (length r)) (let* ((l (length r))
(segment-height (int (- 480 (* 30 l) 40)))) (segment-height (int (- 480 (* 30 l) 40))))
;; Fade to black when far away
(let ((c (max 0 (int (- #xFF (* l 20)))))) (let ((c (max 0 (int (- #xFF (* l 20))))))
(set-texture-color-mod! hit-tile c c c)) (set-texture-color-mod! texture c c c))
(render-copy (render-copy
(current-renderer) (current-renderer)
hit-tile texture
#:dstrect (list (floor/ (* i 640) ray-count) #:dstrect (list (floor/ (* i 640) ray-count)
(floor/ (- 480 segment-height) 2) (floor/ (- 480 segment-height) 2)
(floor/ 640 ray-count) (floor/ 640 ray-count)
...@@ -153,12 +256,11 @@ ...@@ -153,12 +256,11 @@
#:srcrect #:srcrect
(list (int (* 16 (pos-on-wall r))) 0 (list (int (* 16 (pos-on-wall r))) 0
1 16)))))) 1 16)))))))
(iota ray-count) (iota ray-count)
rays rays
))) ))))
)
......
util.scm
+ 5
− 0
View file @ 4d2225f9
...@@ -25,6 +25,8 @@ ...@@ -25,6 +25,8 @@
((positive? x) 1) ((positive? x) 1)
(else -1))) (else -1)))
(define-public sgn signum)
(define (cross-product l1 l2) (define (cross-product l1 l2)
(concatenate (concatenate
(map (lambda (a) (map (lambda (a)
...@@ -32,6 +34,9 @@ ...@@ -32,6 +34,9 @@
l2)) l2))
l1))) l1)))
(define-public (decimals x)
(- x (truncate x)))
(define pi 3.141592653589793) (define pi 3.141592653589793)
(define tau (* 2 pi)) (define tau (* 2 pi))
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment