Commit 698634d8 authored by Hugo Hörnquist's avatar Hugo Hörnquist

huh?

parent 12d55f96
......@@ -145,45 +145,58 @@
(define player (make <player> #:x 1 #:y 1 #:a 0))
(define ray-count 50)
(define ray-count 64)
(define keys-down (make-parameter '()))
(define current-font (make-parameter #f))
(define cached-rays #f)
(define (update dt)
(let ((ev (poll-event)))
(cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
[(keyboard-down-event? ev)
(keys-down (cons (keyboard-event-scancode ev)
(keys-down)))]
[(keyboard-up-event? ev)
(keys-down (delv (keyboard-event-scancode ev)
(keys-down)))]))
(fold (lambda (key ret)
(case key
((x q) 'game-end)
((w) (set! (p player) = (+ (* dt 0.000003
(v3 (cos (a player))
(sin (a player))))))
ret)
((s) (set! (p player) = (+ (* dt 0.000003 -1
(v3 (cos (a player))
(sin (a player)))))) 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))) ret)
((p) (set! (a player) = (+ (* dt 0.000003))) ret)
(else ret)
))
#f (keys-down))
(let ((ev (poll-event)))
(cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
[(and (keyboard-down-event? ev)
(not (memv (keyboard-event-scancode ev)
(keys-down))))
(keys-down (cons (keyboard-event-scancode ev)
(keys-down)))]
[(keyboard-up-event? ev)
(keys-down (delv (keyboard-event-scancode ev)
(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 ray-count)))
ret)
)
......@@ -201,7 +214,10 @@
(if (or (not (and (<= 0 nx board-width)
(<= 0 ny board-height)))
(eq? 'wall (array-ref game-map iy ix)))
(v3 dx dy)
(cons
(min (- dx (round dx))
(- dy (round dy)))
(v3 dx dy))
(loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a)))))))))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
......@@ -247,10 +263,11 @@
(let ((pp (p player)))
(for-each (lambda (p)
(let ((v (+ pp p)))
(let ((v (+ pp (cdr p))))
(draw-line (x pp) (y pp)
(x v) (y v))))
(ray-trace player ray-count)))
cached-rays
))
(set-draw-color 0 #xFF 0)
......@@ -264,7 +281,7 @@
)
(define (draw-first-person-perspective)
(set-draw-color #xEE #xEE #xEE)
(set-draw-color #xBB #xBB #xFF)
(clear)
(set-draw-color #x33 #x33 #x33)
......@@ -274,18 +291,21 @@
(set-draw-color 0 #xEE #xEE)
(for-each (lambda (i p)
(let ((segment-height (- 480 (* 70 (vector-length p)))))
(set-draw-color 0
(int (min #xFF (- #x100 (* #x100 (/ (vector-length p) 7)))))
(int (min #xFF (- #x100 (* #x100 (/ (vector-length p) 7))))))
(render-fill-rect
(current-renderer)
(make-rect (int (* i (/ 640 ray-count)))
(int (/ (- 480 segment-height) 2))
(int (1+ (/ 640 ray-count)))
(int segment-height)))))
(let ((pos-on-wall (car p))
(ray (cdr p)))
(let* ((l (vector-length ray))
(segment-height (- 480 (* 70 l))))
(set-draw-color 0
(int (min #xFF (- #x100 (* #x100 (/ l 7)))))
(int (min #xFF (- #x100 (* #x100 (/ l 7))))))
(render-fill-rect
(current-renderer)
(make-rect (int (* i (/ 640 ray-count)))
(int (/ (- 480 segment-height) 2))
(int (1+ (/ 640 ray-count)))
(int segment-height))))))
(iota ray-count)
(ray-trace player ray-count))
cached-rays)
)
......@@ -300,30 +320,29 @@
(* 8 (current-tile-size))
(* 5 (current-tile-size)))))
(set-render-target! rend texture)
(set-draw-color #xFF #xFF #xFF)
(draw-map)
#;
(parameterize ((current-tile-size 16))
)
(set-render-target! rend #f)
;; Camera
(draw-first-person-perspective)
;; (render-copy rend texture #:dstrect (list 0 0 (* 16 (current-tile-size)) (* 10 (current-tile-size))))
(render-copy rend texture #:dstrect (list 0 0 (* 2 (current-tile-size)) (* 2 (current-tile-size))))
;; minimap
(render-copy rend texture
#:dstrect (list 0 0
(* 2 (current-tile-size))
(* 2 (current-tile-size))))
(delete-texture! texture)
)
(delete-texture! texture))
;; 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)
(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))))
......@@ -335,25 +354,24 @@
))
(define (main-loop window)
(define rend (make-renderer window '(accelerated #; vsync texture
)
))
(define rend (make-renderer window '(accelerated #; vsync texture)))
(define last-t (get-t))
(let loop ((counter 0))
;; (usleep (int (/ 1000000 (* 60 60))))
;; (sigaction SIGINT (lambda (sig) (set! looping #f)))
(if (= counter 10)
(if (= counter 1)
(begin (draw window rend) (loop 0))
(begin (let ((dt (let ((t (get-t)))
(let ((dt (- t last-t)))
(set! last-t t)
dt))))
(if (update dt)
'return
(loop (1+ counter))))))))
(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))))))))
(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