Add fading effect.

class.scm

@@ -28,13 +28,15 @@
            (* (z v) (z v)))))
 
 (define-class <player> ()
-  (pos #:accessor p #:init-form (v3 1 1))
-  (angle #:accessor a #:init-value 0)
+  (pos #:accessor p
+       #:init-form (v3 1 1)
+       #:init-keyword #:p)
+  (angle #:accessor a #:init-value 0 #:init-keyword #:a)
   (feild-of-view #:accessor fov #:init-value (/ tau 8)))
 (export p a fov)
 
 (define (make-player x y a)
-   (make <player> #:x x #:y y #:a a))
+   (make <player> #:p (v3 x y) #:a a))
 
 
 (define-class <ray> ()

main.scm

@@ -38,11 +38,10 @@
   (define t (gettimeofday))
   (+ (cdr t) (* 1000000 (car t))))
 
-(define player (make-player 1 1 0))
+(define player (make-player 5 13 -2))
 
 (define ray-count 64)
 
-(define current-font (make-parameter #f))
 
 (define rays (make-atomic-box '()))
 
@@ -167,19 +166,26 @@
   (set-draw-color #xBB #xBB #xFF)
   (clear)
 
+  ;; floor
   (set-draw-color #x33 #x33 #x33)
   (render-fill-rect (current-renderer)
                     (make-rect 0 240 640 240))
 
-  (set-draw-color 0 #xEE #xEE)
 
+  (let ((rays (atomic-box-ref rays)))
+   (unless (null? rays)
      (for-each (lambda (i r r+)
                  (when (hashq-ref texture-map (type r))
                    (let* ((l (length r))
-                      (segment-height (- 480 (* 70 l))))
+                          (segment-height (- 480 (* 30 l) 40))
+                          (texture (hashq-ref texture-map (type r))))
+
+                     (let ((c (max 0 (int (- #xFF (* l 20))))))
+                       (set-texture-color-mod! texture c c c))
+
                      (render-copy
                       (current-renderer)
-                  (hashq-ref texture-map (type r))
+                      texture
                       #:dstrect (list (int (* i (/ 640 ray-count)))
                                       (int (/ (- 480 segment-height) 2))
                                       (int (+ 0 (/ 640 ray-count)))
@@ -190,66 +196,74 @@
                       (list (int (* 16 (pos-on-wall r))) 0
                             1 16)))))
                (iota ray-count)
-            (atomic-box-ref rays)
-            (cdr (atomic-box-ref rays))
-            )
+               rays (cdr rays)
+               )))
 
   )
 
-(define texture #f)
 
-(define (draw window rend)
 
+(define color (make-parameter (make-color 0 0 0 #xFF)))
+(define* (render-text str #:key (line 0))
+  (let ((surf (render-font-solid (current-font) str (color))))
+    (render-copy (current-renderer)
+                 (surface->texture (current-renderer) surf)
+                 #:dstrect (list 1 (+ 1 (* line (+ 3 (font-height (current-font)))))
+                                 (surface-width surf)
+                                 (surface-height surf)))))
+
+
+
+(define (with-render-target target thunk)
+  (dynamic-wind (lambda () (set-render-target! (current-renderer) target))
+                thunk
+                (lambda () (set-render-target! (current-renderer) #f))))
 
+(define (draw window rend)
   (parameterize ((current-renderer rend))
-    (set-draw-color #xFF #xFF #xFF)
-    (clear)
 
+    ;; minimap
     (let ((texture (make-texture rend 'rgba8888 'target
                                  (* board-width  (current-tile-size))
                                  (* board-height (current-tile-size)))))
-      (set-render-target! rend texture)
-      (draw-map)
-      (set-render-target! rend #f)
+      (with-render-target texture draw-map)
 
       ;; Camera
       (draw-first-person-perspective)
 
-      ;; minimap
       (render-copy rend texture
                    #:dstrect (list 0 (- 480 100)
                                    100 100))
 
       (delete-texture! texture))
 
+    ;; Text overlay
+    (parameterize ((color (make-color 0 0 0 #xFF)))
+
       ;; FPS counter
       (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))))
-
+        (render-text (format #f "FPS: ~,2f" (/ 1000000 (- nt fps-time)))
+                     #:line 0)
         (set! fps-time nt))
 
-    (present)
+      (render-text
+       (format #f "x = ~,4f   y = ~,4f   a = ~,4f"
+               (x (p player))
+               (y (p player))
+               (a player))
+       #:line 1))
 
-    ))
+    (present)))
 
 (define (main-loop window)
   (define rend (make-renderer window '(accelerated #; vsync texture)))
   (define last-t (get-t))
 
-  (call-with-new-thread
-   (lambda ()
+  (begin-thread
    (while
        #t (let ((rays-next (ray-trace player (1+ ray-count))))
             (atomic-box-set! rays rays-next)
-           (wait)))))
+            (wait))))
 
   (for-each
    (lambda (type)
@@ -275,9 +289,14 @@
 (sdl-init)
 (ttf-init)
 
-(current-font (load-font (media "/font.otf") 12))
+(define current-font
+  (make-parameter
+   (load-font (media "/font.otf") 20)))
 
-(format #t "Loaded font ~a~%" (current-font))
+(let ((sock-path "/tmp/guile-socket"))
+  (use-modules (system repl server))
+  (delete-file sock-path)
+  (spawn-server (make-unix-domain-server-socket #:path sock-path)))
 
 (call-with-window
     (make-window