Fix windows.

class.scm

@@ -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)

main.scm

@@ -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
        ))))

util.scm

@@ -41,3 +41,6 @@
 (define tau (* 2 pi))
 
 (define int (compose inexact->exact truncate))
+
+(define-public (cot a)
+  (/ (tan a)))