Skip to content

W
wolf3d
Commit 4d2225f9 authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files
Options

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

parents 1c516e64 2cde0f4a
Hide whitespace changes
Inline Side-by-side
Showing with 165 additions and 60 deletions
class.scm
View file @ 4d2225f9
......@@ -45,6 +45,7 @@
(vec #:accessor vec #:init-keyword #:v)
(pos-on-wall #:accessor pos-on-wall)
(hit-point #:getter hitf #:init-keyword #:hitf)
(hit-float-point #:getter hitf #:init-keyword #:hitf)
(tile-type #:getter type
#:initial-value #f
#:init-keyword #:type)
......@@ -52,9 +53,6 @@
(export a length vec pos-on-wall hitf type)
(define (decimals x)
(- x (truncate x)))
(define-method (initialize (self <ray>) args)
(next-method)
(unless (length self)
......
main.scm
View file @ 4d2225f9
......@@ -34,7 +34,7 @@
(define texture-map (make-hash-table))
(define player (make-player 5 13 -2))
(define player (make-player 5 13 0))
(define ray-count 64)
......@@ -65,32 +65,136 @@
(sin (a player))))))
(wake))
((j) (set! (a player) = (- (* dt 4e-3)))
(when (> 0 (a player))
(set! (a player) tau))
(wake))
((p) (set! (a player) = (+ (* dt 4e-3)))
(wake))))
(when (< tau (a player))
(set! (a player) 0))
(wake))
))
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)
(let ((p (p player)))
(map
(lambda (a)
(let loop ((dx 0) (dy 0))
(let ((nx (+ dx (x p)))
(ny (+ dy (y p))))
(if (not (and (<= 0 nx board-width)
(<= 0 ny board-height)))
(make-ray #:a a #:v (v3 dx dy)
#:hitf (v3 nx ny)
#:type #f)
(let ((tile (array-ref game-map (int ny) (int nx))))
(if (memv tile '(wall window))
(make-ray #:a a #:v (v3 dx dy)
#:type tile
#:hitf (v3 nx ny))
;; else continue
(loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a))))))))))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
(let ((px (x p))
(py (y p)))
(map (lambda (a)
(let loop ((x px)
(y py))
(cond [(not (and (<= 0 x board-width)
(<= 0 y board-height)))
;; outside board
(make-ray #:a a
#:v (v3 (- x px) (- y py))
#:type #f
#: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
#:hitf (v3 x y)))]
[else
;; 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))
(/ (fov player) ray-count)))))
)
(define (draw-map)
(set-draw-color #xFF #xFF #xFF)
......@@ -109,16 +213,16 @@
(map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height))))
;; draw raycast
(set-draw-color #xFF 0 0)
(let ((p (p player)))
(for-each
(lambda (ray)
(let ((v (+ p (vec ray))))
(draw-line (x p) (y p)
(x v) (y v))))
(atomic-box-ref rays))))
(let ((pp (p player)))
(for-each (lambda (ray)
(let ((v (+ pp (vec ray))))
(draw-line (x pp) (y pp)
(x v) (y v))))
(atomic-box-ref rays)))
)
(define (draw-first-person-perspective)
(set-draw-color #xBB #xBB #xFF) ; light blue
......@@ -129,36 +233,34 @@
(render-fill-rect (current-renderer)
(make-rect 0 240 640 240))
(let ((rays (atomic-box-ref rays)))
(unless (null? rays)
(for-each (lambda (i r)
(let ((hit-tile (hashq-ref texture-map (type r))))
(when hit-tile
(let* ((l (length r))
(segment-height (int (- 480 (* 30 l) 40))))
;; Fade to black when far away
(let ((c (max 0 (int (- #xFF (* l 20))))))
(set-texture-color-mod! hit-tile c c c))
(render-copy
(current-renderer)
hit-tile
#:dstrect (list (floor/ (* i 640) ray-count)
(floor/ (- 480 segment-height) 2)
(floor/ 640 ray-count)
segment-height)
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16))))))
(iota ray-count)
rays
)))
(unless (null? rays)
(for-each
(lambda (i r)
(cond ((hashq-ref texture-map (type r))
=> (lambda (texture)
(let* ((l (length r))
(segment-height (int (- 480 (* 30 l) 40))))
(let ((c (max 0 (int (- #xFF (* l 20))))))
(set-texture-color-mod! texture c c c))
(render-copy
(current-renderer)
texture
#:dstrect (list (floor/ (* i 640) ray-count)
(floor/ (- 480 segment-height) 2)
(floor/ 640 ray-count)
segment-height)
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16)))))))
(iota ray-count)
rays
))))
)
......
util.scm
View file @ 4d2225f9
......@@ -25,6 +25,8 @@
((positive? x) 1)
(else -1)))
(define-public sgn signum)
(define (cross-product l1 l2)
(concatenate
(map (lambda (a)
......@@ -32,6 +34,9 @@
l2))
l1)))
(define-public (decimals x)
(- x (truncate x)))
(define pi 3.141592653589793)
(define tau (* 2 pi))
......
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