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)