Commit cbd0f972 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Raycast:

parent 26c42d3d
......@@ -7,6 +7,7 @@
(oop goops)
(sdl2)
(sdl2 ttf)
(sdl2 video)
(sdl2 rect)
(sdl2 render)
......@@ -30,6 +31,11 @@
((_ field proc rest ...)
(begin ((@ (guile) set!) field proc) (set! rest ...)))))
(define (signum x)
(cond ((zero? x) 0)
((positive? x) 1)
(else -1)))
(define (parse-map spec)
(let ((arr (make-array #f (length spec) (string-length (car spec)))))
......@@ -70,8 +76,12 @@
(define (make-point x y)
(make <point> #:x x #:y y))
(define pi 3.141592653589793)
(define tau (* 2 pi))
(define-class <player> (<point>)
(angle #:accessor a #:init-value 0))
(angle #:accessor a #:init-value 0)
(feild-of-view #:accessor fov #:init-value (/ tau 6)))
(define (get-t)
(define t (gettimeofday))
......@@ -79,6 +89,7 @@
(define current-tile-size (make-parameter 50))
(define current-renderer (make-parameter #f))
(define int (compose inexact->exact floor))
......@@ -122,8 +133,13 @@
(present-renderer (current-renderer)))
(define player (make <player> #:x 1 #:y 1 #:a 0))
(define ray-count 50)
(define keys-down (make-parameter '()))
(define current-font (make-parameter #f))
(define (update dt)
(let ((ev (poll-event)))
......@@ -153,6 +169,7 @@
)
(define fps-time (get-t))
(define (draw-map)
(set-draw-color #xFF #xFF #xFF)
......@@ -186,9 +203,27 @@
(set-draw-color #xFF 0 0)
(fill-rect
(- (x player) 0.25)
(- (y player) 0.25)
0.5 0.5)
(- (x player) 0.1)
(- (y player) 0.1)
0.2 0.2)
(let ((x (x player))
(y (y player)))
(for-each (lambda (a)
(let ((cv (cos a))
(sv (sin a)))
(apply draw-line x y
(let loop ((dx 0)
(dy 0))
(let ((ix (int (+ x dx)))
(iy (int (+ y dy))))
(if (or (not (and (< -1 ix board-width)
(< -1 iy board-height)))
(eq? 'wall (array-ref game-map iy ix)))
(list (+ x dx) (+ y dy))
(loop (+ dx (* 0.1 cv)) (+ dy (* 0.1 sv)))))))))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count))))
(set-draw-color 0 #xFF 0)
......@@ -197,9 +232,18 @@
(+ (cos (a player)) (x player))
(+ (sin (a player)) (y player)))
;; (present)
(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)
#:dstrect (list 1 1
(surface-width surf)
(surface-height surf))))
(set! fps-time nt))
)
;; (present)
)
(define (draw window rend)
(parameterize ((current-renderer rend))
......@@ -220,7 +264,7 @@
(set-render-target! rend #f)
(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))))
;; (render-copy rend texture #:dstrect (list 0 0 (* 2 (current-tile-size)) (* 2 (current-tile-size))))
(delete-texture! texture)
......@@ -231,26 +275,32 @@
))
(define (main-loop window)
(define rend (make-renderer window))
(define rend (make-renderer window '(accelerated #; vsync texture
)
))
(define last-t (get-t))
(let loop ((counter 0))
(usleep (int (/ 1000000 (* 60 60))))
;; (usleep (int (/ 1000000 (* 60 60))))
;; (sigaction SIGINT (lambda (sig) (set! looping #f)))
(if (= counter 60)
(if (= counter 10)
(begin (draw window rend) (loop 0))
(begin (let ((dt (let ((t (get-t)))
(let ((dt (- t last-t)))
(set! last-t t)
dt))))
(format #t "Δr = ~a~%" dt)
(if (update dt)
'return
(loop (1+ counter))))))))
(sdl-init)
(ttf-init)
(current-font (load-font "/usr/share/fonts/OTF/FiraMono-Regular.otf" 12))
(format #t "Loaded font ~a~%" (current-font))
(call-with-window
(make-window
......@@ -258,4 +308,5 @@
#:size '(640 480))
main-loop)
(ttf-quit)
(sdl-quit)
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