diff --git a/main.scm b/main.scm
index 44c0db2243e946499ea35d90b3b1e1b61539b5f6..496ff168151818efcea5d2fa72b7b3733720e321 100644
--- a/main.scm
+++ b/main.scm
@@ -15,12 +15,22 @@
(sdl2 surface)
(sdl2 events)
+
+ (ice-9 threads)
+ (ice-9 atomic)
+
(util)
(map)
(class)
(draw)
)
+(define-values (wait wake)
+ (let ((mutex (make-mutex))
+ (condvar (make-condition-variable)))
+ (values
+ (lambda () (with-mutex mutex (wait-condition-variable condvar mutex)))
+ (lambda () (broadcast-condition-variable condvar)))))
(define texture-map (make-hash-table))
@@ -34,7 +44,7 @@
(define current-font (make-parameter #f))
-(define cached-rays #f)
+(define rays (make-atomic-box '()))
(define update
(let ((keys-down '()))
@@ -51,38 +61,34 @@
keys-down))]))
- (let ((ret
- (fold (lambda (key ret)
- (case key
- ((x q) 'game-end)
- ((w) (set! (p player) = (+ (* dt 0.000003
- (v3 (cos (a player))
- (sin (a player)))))
- cached-rays #f)
- ret)
- ((s) (set! (p player) = (+ (* dt 0.000003 -1
- (v3 (cos (a player))
- (sin (a player)))))
- cached-rays #f) ret)
- ;; ((a) (set! (p player) = (+ (* dt 0.000003 -1
- ;; (v3 (sin (a player))
- ;; (cos (a player)))))) ret)
- ;; ((d) (set! (p player) = (+ (* dt 0.000003
- ;; (v3 (sin (a player))
- ;; (cos (a player)))))) ret)
- ((j) (set! (a player) = (- (* dt 0.000003))
- cached-rays #f) ret)
- ((p) (set! (a player) = (+ (* dt 0.000003))
- cached-rays #f) ret)
- (else ret)
- ))
- #f keys-down)))
-
- (unless cached-rays
- (set! cached-rays (ray-trace player (1+ ray-count))))
- ret)))
-
- )
+ (for-each
+ (lambda (key)
+ (case key
+ ((x q) (raise SIGINT))
+ ((w) (set! (p player) = (+ (* dt 0.000003
+ (v3 (cos (a player))
+ (sin (a player))))))
+ (wake)
+ )
+ ((s) (set! (p player) = (+ (* dt 0.000003 -1
+ (v3 (cos (a player))
+ (sin (a player))))))
+ (wake)
+ )
+ ;; ((a) (set! (p player) = (+ (* dt 0.000003 -1
+ ;; (v3 (sin (a player))
+ ;; (cos (a player)))))) ret)
+ ;; ((d) (set! (p player) = (+ (* dt 0.000003
+ ;; (v3 (sin (a player))
+ ;; (cos (a player)))))) ret)
+ ((j) (set! (a player) = (- (* dt 0.000003)))
+ (wake)
+ )
+ ((p) (set! (a player) = (+ (* dt 0.000003)))
+ (wake)
+ )
+ ))
+ keys-down))))
(define (ray-trace player ray-count)
(let ((x (x (p player)))
@@ -123,6 +129,7 @@
(case (array-ref game-map (y pt) (x pt))
((wall) (set-draw-color #xBB #xBB #xBB))
((window) (set-draw-color #x10 #x10 #xFF))
+ ((grass) (set-draw-color 0 #xCC 0))
(else (set-draw-color #xFF #xFF #xFF)))
(fill-rect
(x pt) (y pt)
@@ -130,20 +137,6 @@
(map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height))))
- ;; (set-draw-color 0 0 0)
-
- ;; (for-each (lambda (i) (draw-line
- ;; 0 i
- ;; board-width i))
- ;; (iota board-height))
-
- ;; (for-each (lambda (i) (draw-line
- ;; i 0
- ;; i board-height))
- ;; (iota board-width))
-
-
-
(set-draw-color #xFF 0 0)
(fill-rect
@@ -156,7 +149,7 @@
(let ((v (+ pp (vec ray))))
(draw-line (x pp) (y pp)
(x v) (y v))))
- cached-rays
+ (atomic-box-ref rays)
))
(set-draw-color 0 #xFF 0)
@@ -197,8 +190,8 @@
(list (int (* 16 (pos-on-wall r))) 0
1 16)))))
(iota ray-count)
- cached-rays
- (cdr cached-rays)
+ (atomic-box-ref rays)
+ (cdr (atomic-box-ref rays))
)
)
@@ -206,6 +199,8 @@
(define texture #f)
(define (draw window rend)
+
+
(parameterize ((current-renderer rend))
(set-draw-color #xFF #xFF #xFF)
(clear)
@@ -249,27 +244,33 @@
(define rend (make-renderer window '(accelerated #; vsync texture)))
(define last-t (get-t))
+ (call-with-new-thread
+ (lambda ()
+ (while
+ #t (let ((rays-next (ray-trace player (1+ ray-count))))
+ (atomic-box-set! rays rays-next)
+ (wait)))))
+
(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))))
- (sigaction SIGINT (lambda (sig) (set! looping #f)))
-
- (if (= counter 1)
- (begin (draw window rend) (loop 0))
- (let ((dt (let ((t (get-t)))
- (let ((dt (- t last-t)))
- (set! last-t t)
- dt))))
- (if (update dt)
- 'return
- (begin
- (usleep (int (/ (- 1000000 dt) 100)))
- (loop (1+ counter))))))))
+ (let ((counter 0))
+ (while #t
+ ;; (usleep (int (/ 1000000 (* 60 60))))
+ (sigaction SIGINT (lambda (sig) (break )))
+
+ (if (= counter 1)
+ (begin (draw window rend) (set! counter 0))
+ (let ((dt (let ((t (get-t)))
+ (let ((dt (- t last-t)))
+ (set! last-t t)
+ dt))))
+ (update dt)
+ (usleep (int (/ (- 1000000 dt) 1000)))
+ (set! counter = (+ 1)))))))
(sdl-init)
(ttf-init)