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

Fix windows.

parent 0ed5e52c
......@@ -51,12 +51,13 @@
(pos-on-wall #:accessor pos-on-wall)
(hit-point #:getter hitf #:init-keyword #:hitf)
(hit-float-point #:getter hitf #:init-keyword #:hitf)
(solid? #:getter solid? #:init-keyword #:solid?)
(tile-type #:getter type
#:initial-value #f
#: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)
(next-method)
......
......@@ -85,13 +85,16 @@
))
keys-down))))
(define (decimals x)
(- x (truncate x)))
(define (cot a)
(/ (tan a)))
(define sgn signum)
(define (find-next-wall x y a callback)
(let ((dx-ampl (mod (* -1 (sgn (cos a)) (decimals x)) 1))
(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)
(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)
(let ((p (p player)))
......@@ -104,28 +107,29 @@
(< 15 (sqrt (+ (expt (- x px) 2)
(expt (- y py) 2)))))
;; outside board
(make-ray #:a a #:type #f
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y)) ]
(list (make-ray #:a a #:type #f
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y))) ]
;; hit wall
[(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)
(make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y)))]
(cons (make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y))
(find-next-wall x y a loop)))]
;; follow ray
[else (let ((dx-ampl (mod (* -1 (sgn (cos a)) (decimals x)) 1))
(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))))))])))
[else (find-next-wall x y a loop)])))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
......@@ -152,11 +156,15 @@
(set-draw-color #xFF 0 0)
(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)))
(for-each
(lambda (rays)
(for-each
(lambda (ray)
(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)
......@@ -171,27 +179,30 @@
(let ((rays (atomic-box-ref 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)))))))
(lambda (i rays)
(for-each
(lambda (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)))))))
rays))
(iota ray-count)
rays
))))
......
......@@ -41,3 +41,6 @@
(define tau (* 2 pi))
(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