Raycast:

main.scm

@@ -7,6 +7,7 @@
              (oop goops)
 
              (sdl2)
+             (sdl2 ttf)
              (sdl2 video)
              (sdl2 rect)
              (sdl2 render)
@@ -30,6 +31,11 @@
     ((_ field proc rest ...)
      (begin ((@ (guile) set!) field proc) (set! rest ...)))))
 
+(define (signum x)
+  (cond ((zero? x) 0)
+        ((positive? x) 1)
+        (else -1)))
+
 
 (define (parse-map spec)
   (let ((arr (make-array #f (length spec) (string-length (car spec)))))
@@ -70,8 +76,12 @@
 (define (make-point x y)
   (make <point> #:x x #:y y))
 
+(define pi 3.141592653589793)
+(define tau (* 2 pi))
+
 (define-class <player> (<point>)
-  (angle #:accessor a #:init-value 0))
+  (angle #:accessor a #:init-value 0)
+  (feild-of-view #:accessor fov #:init-value (/ tau 6)))
 
 (define (get-t)
   (define t (gettimeofday))
@@ -79,6 +89,7 @@
 
 
 (define current-tile-size (make-parameter 50))
+
 (define current-renderer (make-parameter #f))
 
 (define int (compose inexact->exact floor))
@@ -122,8 +133,13 @@
   (present-renderer (current-renderer)))
 
 (define player (make <player> #:x 1 #:y 1 #:a 0))
+
+(define ray-count 50)
+
 (define keys-down (make-parameter '()))
 
+(define current-font (make-parameter #f))
+
 (define (update dt)
 
     (let ((ev (poll-event)))
@@ -153,6 +169,7 @@
   )
 
 
+(define fps-time (get-t))
 
 (define (draw-map)
   (set-draw-color #xFF #xFF #xFF)
@@ -186,9 +203,27 @@
   (set-draw-color #xFF 0 0)
 
   (fill-rect
-   (- (x player) 0.25)
-   (- (y player) 0.25)
-   0.5 0.5)
+   (- (x player) 0.1)
+   (- (y player) 0.1)
+   0.2 0.2)
+
+  (let ((x (x player))
+        (y (y player)))
+    (for-each (lambda (a)
+                (let ((cv (cos a))
+                      (sv (sin a)))
+                  (apply draw-line x y
+                         (let loop ((dx 0)
+                                    (dy 0))
+                           (let ((ix (int (+ x dx)))
+                                 (iy (int (+ y dy))))
+                             (if (or (not (and (< -1 ix board-width)
+                                               (< -1 iy board-height)))
+                                     (eq? 'wall (array-ref game-map iy ix)))
+                                 (list (+ x dx) (+ y dy))
+                                 (loop (+ dx (* 0.1 cv)) (+ dy (* 0.1 sv)))))))))
+              (iota ray-count (- (a player) (/ (fov player) 2))
+                    (/ (fov player) ray-count))))
 
   (set-draw-color 0 #xFF 0)
 
@@ -197,8 +232,17 @@
    (+ (cos (a player)) (x player))
    (+ (sin (a player)) (y player)))
 
-  ;; (present)
+  (let ((nt (get-t)))
+    (let ((surf (render-font-solid (current-font) (format #f "FPS: ~,2f" (/ 1000000 (- nt fps-time)))
+                                   (make-color 0 0 0 #xFF))))
+      (render-copy (current-renderer) (surface->texture (current-renderer) surf)
+                   #:dstrect (list 1 1
+                                   (surface-width surf)
+                                   (surface-height surf))))
 
+    (set! fps-time nt))
+
+  ;; (present)
   )
 
 (define (draw window rend)
@@ -220,7 +264,7 @@
 
       (set-render-target! rend #f)
       (render-copy rend texture #:dstrect (list 0 0 (* 16 (current-tile-size)) (* 10 (current-tile-size))))
-      (render-copy rend texture #:dstrect (list 0 0 (* 2 (current-tile-size)) (* 2 (current-tile-size))))
+      ;; (render-copy rend texture #:dstrect (list 0 0 (* 2 (current-tile-size)) (* 2 (current-tile-size))))
 
       (delete-texture! texture)
 
@@ -231,26 +275,32 @@
     ))
 
 (define (main-loop window)
-  (define rend (make-renderer window))
+  (define rend (make-renderer window '(accelerated #; vsync texture
+                                                           )
+                              ))
 
   (define last-t (get-t))
 
   (let loop ((counter 0))
-    (usleep (int (/ 1000000 (* 60 60))))
+    ;; (usleep (int (/ 1000000 (* 60 60))))
     ;; (sigaction SIGINT (lambda (sig) (set! looping #f)))
 
-    (if (= counter 60)
+    (if (= counter 10)
         (begin (draw window rend) (loop 0))
         (begin (let ((dt (let ((t (get-t)))
                            (let ((dt (- t last-t)))
                              (set! last-t t)
                              dt))))
-                 (format #t "Δr = ~a~%" dt)
                  (if (update dt)
                      'return
                      (loop (1+ counter))))))))
 
 (sdl-init)
+(ttf-init)
+
+(current-font (load-font "/usr/share/fonts/OTF/FiraMono-Regular.otf" 12))
+
+(format #t "Loaded font ~a~%" (current-font))
 
 (call-with-window
     (make-window
@@ -258,4 +308,5 @@
      #:size '(640 480))
   main-loop)
 
+(ttf-quit)
 (sdl-quit)