Commit 8f8b0621 authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files

Fix windows.

parent 0ed5e52c
...@@ -51,12 +51,13 @@ ...@@ -51,12 +51,13 @@
(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) (hit-float-point #:getter hitf #:init-keyword #:hitf)
(solid? #:getter solid? #:init-keyword #:solid?)
(tile-type #:getter type (tile-type #:getter type
#:initial-value #f #:initial-value #f
#:init-keyword #:type) #:init-keyword #:type)
) )
(export a length vec pos-on-wall hitf type) (export a length vec pos-on-wall hitf solid? type)
(define-method (initialize (self <ray>) args) (define-method (initialize (self <ray>) args)
(next-method) (next-method)
......
...@@ -85,13 +85,16 @@ ...@@ -85,13 +85,16 @@
)) ))
keys-down)))) keys-down))))
(define (decimals x) (define (find-next-wall x y a callback)
(- x (truncate x))) (let ((dx-ampl (mod (* -1 (sgn (cos a)) (decimals x)) 1))
(dy-ampl (mod (* -1 (sgn (sin a)) (decimals y)) 1)))
(define (cot a) (let* ((dx (* 1.01 dx-ampl (sgn (cos a))))
(/ (tan a))) (dy (* dx (tan a))))
(if (<= (abs dy) dy-ampl)
(define sgn signum) (callback (+ x dx) (+ y dy))
(let* ((dy (* 1.01 dy-ampl (sgn (sin a))))
(dx (* dy (cot a))))
(callback (+ x dx) (+ y dy)))))))
(define (ray-trace player ray-count) (define (ray-trace player ray-count)
(let ((p (p player))) (let ((p (p player)))
...@@ -104,28 +107,29 @@ ...@@ -104,28 +107,29 @@
(< 15 (sqrt (+ (expt (- x px) 2) (< 15 (sqrt (+ (expt (- x px) 2)
(expt (- y py) 2))))) (expt (- y py) 2)))))
;; outside board ;; outside board
(make-ray #:a a #:type #f (list (make-ray #:a a #:type #f
#:v (v3 (- x px) (- y py)) #:v (v3 (- x px) (- y py))
#:hitf (v3 x y)) ] #:hitf (v3 x y))) ]
;; hit wall ;; hit wall
[(array-ref (board-data game-map) (int y) (int x)) [(array-ref (board-data game-map) (int y) (int x))
(lambda (s) (memv s '(wall window))) (lambda (tile) (memv tile '(wall)))
=> (lambda (tile)
(list (make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y))))]
;; hit window
[(array-ref (board-data game-map) (int y) (int x))
(lambda (tile) (memv tile '(window)))
=> (lambda (tile) => (lambda (tile)
(make-ray #:a a #:type tile (cons (make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py)) #:v (v3 (- x px) (- y py))
#:hitf (v3 x y)))] #:hitf (v3 x y))
(find-next-wall x y a loop)))]
;; follow ray ;; follow ray
[else (let ((dx-ampl (mod (* -1 (sgn (cos a)) (decimals x)) 1)) [else (find-next-wall x y a loop)])))
(dy-ampl (mod (* -1 (sgn (sin a)) (decimals y)) 1)))
(let* ((dx (* 1.01 dx-ampl (sgn (cos a))))
(dy (* dx (tan a))))
(if (<= (abs dy) dy-ampl)
(loop (+ x dx) (+ y dy))
(let* ((dy (* 1.01 dy-ampl (sgn (sin a))))
(dx (* dy (cot a))))
(loop (+ x dx) (+ 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)))))
...@@ -152,11 +156,15 @@ ...@@ -152,11 +156,15 @@
(set-draw-color #xFF 0 0) (set-draw-color #xFF 0 0)
(let ((pp (p player))) (let ((pp (p player)))
(for-each (lambda (ray) (for-each
(let ((v (+ pp (vec ray)))) (lambda (rays)
(draw-line (x pp) (y pp) (for-each
(x v) (y v)))) (lambda (ray)
(atomic-box-ref rays))) (let ((v (+ pp (vec ray))))
(draw-line (x pp) (y pp)
(x v) (y v))))
rays))
(atomic-box-ref rays)))
) )
(define (draw-first-person-perspective) (define (draw-first-person-perspective)
...@@ -171,27 +179,30 @@ ...@@ -171,27 +179,30 @@
(let ((rays (atomic-box-ref rays))) (let ((rays (atomic-box-ref rays)))
(unless (null? rays) (unless (null? rays)
(for-each (for-each
(lambda (i r) (lambda (i rays)
(cond ((hashq-ref texture-map (type r)) (for-each
=> (lambda (texture) (lambda (r)
(let* ((l (length r)) (cond ((hashq-ref texture-map (type r))
(segment-height (int (- 480 (* 30 l) 40)))) => (lambda (texture)
(let* ((l (length r))
(let ((c (max 0 (int (- #xFF (* l 20)))))) (segment-height (int (- 480 (* 30 l) 40))))
(set-texture-color-mod! texture c c c))
(let ((c (max 0 (int (- #xFF (* l 20))))))
(render-copy (set-texture-color-mod! texture c c c))
(current-renderer)
texture (render-copy
#:dstrect (list (floor/ (* i 640) ray-count) (current-renderer)
(floor/ (- 480 segment-height) 2) texture
(floor/ 640 ray-count) #:dstrect (list (floor/ (* i 640) ray-count)
segment-height) (floor/ (- 480 segment-height) 2)
(floor/ 640 ray-count)
segment-height)
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16))))))) #:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16)))))))
rays))
(iota ray-count) (iota ray-count)
rays rays
)))) ))))
......
...@@ -41,3 +41,6 @@ ...@@ -41,3 +41,6 @@
(define tau (* 2 pi)) (define tau (* 2 pi))
(define int (compose inexact->exact truncate)) (define int (compose inexact->exact truncate))
(define-public (cot a)
(/ (tan a)))
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