Commit 192ef961 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Move ray-tracing to own thread.

This frees up the main thread to actually handle input.
parent 680885f2
...@@ -15,12 +15,22 @@ ...@@ -15,12 +15,22 @@
(sdl2 surface) (sdl2 surface)
(sdl2 events) (sdl2 events)
(ice-9 threads)
(ice-9 atomic)
(util) (util)
(map) (map)
(class) (class)
(draw) (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)) (define texture-map (make-hash-table))
...@@ -34,7 +44,7 @@ ...@@ -34,7 +44,7 @@
(define current-font (make-parameter #f)) (define current-font (make-parameter #f))
(define cached-rays #f) (define rays (make-atomic-box '()))
(define update (define update
(let ((keys-down '())) (let ((keys-down '()))
...@@ -51,38 +61,34 @@ ...@@ -51,38 +61,34 @@
keys-down))])) keys-down))]))
(let ((ret (for-each
(fold (lambda (key ret) (lambda (key)
(case key (case key
((x q) 'game-end) ((x q) (raise SIGINT))
((w) (set! (p player) = (+ (* dt 0.000003 ((w) (set! (p player) = (+ (* dt 0.000003
(v3 (cos (a player)) (v3 (cos (a player))
(sin (a player))))) (sin (a player))))))
cached-rays #f) (wake)
ret) )
((s) (set! (p player) = (+ (* dt 0.000003 -1 ((s) (set! (p player) = (+ (* dt 0.000003 -1
(v3 (cos (a player)) (v3 (cos (a player))
(sin (a player))))) (sin (a player))))))
cached-rays #f) ret) (wake)
;; ((a) (set! (p player) = (+ (* dt 0.000003 -1 )
;; (v3 (sin (a player)) ;; ((a) (set! (p player) = (+ (* dt 0.000003 -1
;; (cos (a player)))))) ret) ;; (v3 (sin (a player))
;; ((d) (set! (p player) = (+ (* dt 0.000003 ;; (cos (a player)))))) ret)
;; (v3 (sin (a player)) ;; ((d) (set! (p player) = (+ (* dt 0.000003
;; (cos (a player)))))) ret) ;; (v3 (sin (a player))
((j) (set! (a player) = (- (* dt 0.000003)) ;; (cos (a player)))))) ret)
cached-rays #f) ret) ((j) (set! (a player) = (- (* dt 0.000003)))
((p) (set! (a player) = (+ (* dt 0.000003)) (wake)
cached-rays #f) ret) )
(else ret) ((p) (set! (a player) = (+ (* dt 0.000003)))
)) (wake)
#f keys-down))) )
))
(unless cached-rays keys-down))))
(set! cached-rays (ray-trace player (1+ ray-count))))
ret)))
)
(define (ray-trace player ray-count) (define (ray-trace player ray-count)
(let ((x (x (p player))) (let ((x (x (p player)))
...@@ -123,6 +129,7 @@ ...@@ -123,6 +129,7 @@
(case (array-ref game-map (y pt) (x pt)) (case (array-ref game-map (y pt) (x pt))
((wall) (set-draw-color #xBB #xBB #xBB)) ((wall) (set-draw-color #xBB #xBB #xBB))
((window) (set-draw-color #x10 #x10 #xFF)) ((window) (set-draw-color #x10 #x10 #xFF))
((grass) (set-draw-color 0 #xCC 0))
(else (set-draw-color #xFF #xFF #xFF))) (else (set-draw-color #xFF #xFF #xFF)))
(fill-rect (fill-rect
(x pt) (y pt) (x pt) (y pt)
...@@ -130,20 +137,6 @@ ...@@ -130,20 +137,6 @@
(map (lambda (p) (apply v3 p)) (map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height)))) (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) (set-draw-color #xFF 0 0)
(fill-rect (fill-rect
...@@ -156,7 +149,7 @@ ...@@ -156,7 +149,7 @@
(let ((v (+ pp (vec ray)))) (let ((v (+ pp (vec ray))))
(draw-line (x pp) (y pp) (draw-line (x pp) (y pp)
(x v) (y v)))) (x v) (y v))))
cached-rays (atomic-box-ref rays)
)) ))
(set-draw-color 0 #xFF 0) (set-draw-color 0 #xFF 0)
...@@ -197,8 +190,8 @@ ...@@ -197,8 +190,8 @@
(list (int (* 16 (pos-on-wall r))) 0 (list (int (* 16 (pos-on-wall r))) 0
1 16))))) 1 16)))))
(iota ray-count) (iota ray-count)
cached-rays (atomic-box-ref rays)
(cdr cached-rays) (cdr (atomic-box-ref rays))
) )
) )
...@@ -206,6 +199,8 @@ ...@@ -206,6 +199,8 @@
(define texture #f) (define texture #f)
(define (draw window rend) (define (draw window rend)
(parameterize ((current-renderer rend)) (parameterize ((current-renderer rend))
(set-draw-color #xFF #xFF #xFF) (set-draw-color #xFF #xFF #xFF)
(clear) (clear)
...@@ -249,27 +244,33 @@ ...@@ -249,27 +244,33 @@
(define rend (make-renderer window '(accelerated #; vsync texture))) (define rend (make-renderer window '(accelerated #; vsync texture)))
(define last-t (get-t)) (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 (for-each
(lambda (type) (lambda (type)
(hashq-set! texture-map type (hashq-set! texture-map type
(surface->texture rend (load-image (media (format #f "/textures/~a.png" type)))))) (surface->texture rend (load-image (media (format #f "/textures/~a.png" type))))))
'(wall window)) '(wall window))
(let loop ((counter 0)) (let ((counter 0))
;; (usleep (int (/ 1000000 (* 60 60)))) (while #t
(sigaction SIGINT (lambda (sig) (set! looping #f))) ;; (usleep (int (/ 1000000 (* 60 60))))
(sigaction SIGINT (lambda (sig) (break )))
(if (= counter 1)
(begin (draw window rend) (loop 0)) (if (= counter 1)
(let ((dt (let ((t (get-t))) (begin (draw window rend) (set! counter 0))
(let ((dt (- t last-t))) (let ((dt (let ((t (get-t)))
(set! last-t t) (let ((dt (- t last-t)))
dt)))) (set! last-t t)
(if (update dt) dt))))
'return (update dt)
(begin (usleep (int (/ (- 1000000 dt) 1000)))
(usleep (int (/ (- 1000000 dt) 100))) (set! counter = (+ 1)))))))
(loop (1+ counter))))))))
(sdl-init) (sdl-init)
(ttf-init) (ttf-init)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment