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 @@
(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)
(for-each
(lambda (key)
(case key
((x q) 'game-end)
((x q) (raise SIGINT))
((w) (set! (p player) = (+ (* dt 0.000003
(v3 (cos (a player))
(sin (a player)))))
cached-rays #f)
ret)
(sin (a player))))))
(wake)
)
((s) (set! (p player) = (+ (* dt 0.000003 -1
(v3 (cos (a player))
(sin (a player)))))
cached-rays #f) ret)
(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))
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)))
((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))
(let ((counter 0))
(while #t
;; (usleep (int (/ 1000000 (* 60 60))))
(sigaction SIGINT (lambda (sig) (set! looping #f)))
(sigaction SIGINT (lambda (sig) (break )))
(if (= counter 1)
(begin (draw window rend) (loop 0))
(begin (draw window rend) (set! counter 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))))))))
(update dt)
(usleep (int (/ (- 1000000 dt) 1000)))
(set! counter = (+ 1)))))))
(sdl-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