Commit 5e21da07 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Fix remaining angles.

parent ba307a25
......@@ -42,29 +42,35 @@
(length #:accessor length #:init-keyword #:length #:init-value #f)
(vec #:accessor vec #:init-keyword #:v)
(pos-on-wall #:accessor pos-on-wall)
(local-wall-segment #:accessor local-wall-segment)
(hit-coord #:accessor hit #:init-keyword #:hit)
(hit-float-point #:getter hitf #:init-keyword #:hitf)
(wall-direction #:accessor wall-direction)
(tile-type #:getter type
#:initial-value 'space
#:init-keyword #:type
)
)
(export a length vec pos-on-wall hit local-wall-segment wall-direction)
(export a length vec pos-on-wall hit hitf local-wall-segment wall-direction type)
(define (decimals x)
(- x (truncate x)))
(define-method (initialize (self <ray>) args)
(next-method)
(unless (length self)
(set! (length self) (vector-length (vec self))))
(set! (wall-direction self) (if (> 0.1 (x (vec self))) 'x 'y)
(pos-on-wall self)
(case (wall-direction self)
((x) (- (y (vec self)) (floor (y (vec self)))))
((y) (- (x (vec self)) (floor (x (vec self))))))
(let* ((xx (x (hitf self)))
(yy (y (hitf self))))
(set! (pos-on-wall self)
(min
(max (abs (decimals xx))
(abs (decimals yy)))
(max (- 1 (abs (decimals xx)))
(- 1 (abs (decimals yy)))))
(local-wall-segment self)
(case (wall-direction self)
((x) (floor (x (vec self))))
((y) (floor (y (vec self))))))
))
)
......
......@@ -21,7 +21,8 @@
(draw)
)
(define brick-texture #f)
(define texture-map (make-hash-table))
(define (get-t)
(define t (gettimeofday))
......@@ -75,7 +76,7 @@
cached-rays #f) ret)
(else ret)
))
#f (keys-down))))
#f keys-down)))
(unless cached-rays
(set! cached-rays (ray-trace player (1+ ray-count))))
......@@ -96,9 +97,14 @@
(iy (int ny)))
(if (or (not (and (<= 0 nx board-width)
(<= 0 ny board-height)))
(eq? 'wall (array-ref game-map iy ix)))
(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))
......@@ -107,21 +113,22 @@
(define fps-time (get-t))
(define (draw-map)
;;(set-draw-color #xFF #xFF #xFF)
(set-draw-color #x88 #x88 #x88 0 )
(set-draw-color #xFF #xFF #xFF)
(clear)
(set-draw-color 0 0 #xFF)
(fill-rects
(filter-map
(lambda (pt)
(if (eq? 'wall (array-ref game-map (y pt) (x pt)))
(make-rect* (x pt) (y pt)
1 1)
#f))
(map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height)))))
(for-each
(lambda (pt)
(case (array-ref game-map (y pt) (x pt))
((wall) (set-draw-color #xBB #xBB #xBB))
((window) (set-draw-color #x10 #x10 #xFF))
(else (set-draw-color #xFF #xFF #xFF)))
(fill-rect
(x pt) (y pt)
1 1))
(map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height))))
;; (set-draw-color 0 0 0)
......@@ -174,21 +181,21 @@
(set-draw-color 0 #xEE #xEE)
(for-each (lambda (i r r+)
(let* ((l (length r))
(segment-height (- 480 (* 70 l))))
(render-copy
(current-renderer)
brick-texture
#:dstrect (list (int (* i (/ 640 ray-count)))
(int (/ (- 480 segment-height) 2))
(int (+ 0 (/ 640 ray-count)))
(int segment-height))
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16))))
(when (hashq-ref texture-map (type r))
(let* ((l (length r))
(segment-height (- 480 (* 70 l))))
(render-copy
(current-renderer)
(hashq-ref texture-map (type r))
#:dstrect (list (int (* i (/ 640 ray-count)))
(int (/ (- 480 segment-height) 2))
(int (+ 0 (/ 640 ray-count)))
(int segment-height))
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16)))))
(iota ray-count)
cached-rays
(cdr cached-rays)
......@@ -207,7 +214,6 @@
(* board-width (current-tile-size))
(* board-height (current-tile-size)))))
(set-render-target! rend texture)
(set-draw-color #xFF #xFF #xFF)
(draw-map)
(set-render-target! rend #f)
......@@ -242,8 +248,12 @@
(define (main-loop window)
(define rend (make-renderer window '(accelerated #; vsync texture)))
(define last-t (get-t))
(set! brick-texture (surface->texture rend (load-image (media "/polished_andesite.png"))))
(for-each
(lambda (type)
(hashq-set! texture-map type
(surface->texture rend (load-image (media (format #f "/textures/~a.png" type))))))
'(wall window))
(let loop ((counter 0))
;; (usleep (int (/ 1000000 (* 60 60))))
......
......@@ -11,8 +11,7 @@
((#\#) 'wall)
((#\:) 'grass)
((#\;) 'teleporter)
((#\*) 'wall #; 'window
)
((#\*) 'window)
((#\%) 'entrance))))
arr))
......@@ -27,25 +26,18 @@
" # # # # #"
" # % # # #"
" # #######****#**#**#"
"###%%###:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"::* *:::::::::::::::::"
"###%####:::::::::::::::::"
"::* *::::::::::::::::::"
"::* *::::::::::::::::::"
"::# #::::::::::::::::::"
"::* *::::::::::::::::::"
"::* *::::::::::::::::::"
"::# #::::::::::::::::::"
"::* *::::::::::::::::::"
"::* *::::::::::::::::::"
"::# #::::::::::::::::::"
"::* *::::::::::::::::::"
"::* *::::::::::::::::::"
" # ###**#*#**#**#**#**#"
" # % # # # # # # #"
" # ### # # # # # #"
......
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