Commit 2cde0f4a authored by Hugo Hörnquist's avatar Hugo Hörnquist
Browse files

Trig, or something

parent c3ac8699
......@@ -44,7 +44,6 @@
(length #:accessor length #:init-keyword #:length #:init-value #f)
(vec #:accessor vec #:init-keyword #:v)
(pos-on-wall #:accessor pos-on-wall)
(hit-coord #:accessor hit #:init-keyword #:hit)
(hit-float-point #:getter hitf #:init-keyword #:hitf)
(wall-direction #:accessor wall-direction)
(tile-type #:getter type
......@@ -53,7 +52,7 @@
)
)
(export a length vec pos-on-wall hit hitf local-wall-segment wall-direction type)
(export a length vec pos-on-wall hitf local-wall-segment wall-direction type)
(define (decimals x)
(- x (truncate x)))
......
......@@ -38,11 +38,10 @@
(define t (gettimeofday))
(+ (cdr t) (* 1000000 (car t))))
(define player (make-player 5 13 -2))
(define player (make-player 5 13 0))
(define ray-count 64)
(define rays (make-atomic-box '()))
(define update
......@@ -68,53 +67,143 @@
((w) (set! (p player) = (+ (* dt 0.000009
(v3 (cos (a player))
(sin (a player))))))
(wake)
)
(wake))
((s) (set! (p player) = (+ (* dt 0.000006 -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)
(wake))
((j) (set! (a player) = (- (* dt 0.000004)))
(when (> 0 (a player))
(set! (a player) tau))
(wake)
)
((p) (set! (a player) = (+ (* dt 0.000004)))
(when (< tau (a player))
(set! (a player) 0))
(wake)
)
))
keys-down))))
;; (define (ray-trace player ray-count)
;; (let ((x (x (p player)))
;; (y (y (p player))))
;; (map
;; (lambda (a)
;; (let loop ((dx 0)
;; (dy 0))
;; (let ((nx (+ x dx))
;; (ny (+ y dy)))
;; (let ((ix (int nx))
;; (iy (int ny)))
;; (if (or (not (and (<= 0 nx board-width)
;; (<= 0 ny board-height)))
;; (memv (array-ref game-map iy ix)
;; '(wall window)))
;; (make-ray #:a a
;; #:v (v3 dx dy)
;; #:type (if (not (and (<= 0 nx board-width)
;; (<= 0 ny board-height)))
;; #f (array-ref game-map iy ix))
;; #:hitf (v3 nx ny)
;; #:hit (v3 ix iy))
;; (loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a)))))))))
;; (iota ray-count (- (a player) (/ (fov player) 2))
;; (/ (fov player) ray-count)))))
(define (pow x y)
(let ((xd (abs (decimals x)))
(yd (abs (decimals y))))
(min (max xd yd)
(max (- 1 xd) (- 1 yd)))))
(define (decimals x)
(- x (truncate x)))
(define (cot a)
(/ (tan a)))
(define sgn signum)
(define (ray-trace player ray-count)
(let ((x (x (p player)))
(y (y (p player))))
(map
(lambda (a)
(let loop ((dx 0)
(dy 0))
(let ((nx (+ x dx))
(ny (+ y dy)))
(let ((ix (int nx))
(iy (int ny)))
(if (or (not (and (<= 0 nx board-width)
(<= 0 ny board-height)))
(memv (array-ref game-map iy ix)
'(wall window)))
(make-ray #:a a
#:v (v3 dx dy)
#:type (if (not (and (<= 0 nx board-width)
(<= 0 ny board-height)))
#f (array-ref game-map iy ix))
#:hitf (v3 nx ny)
#:hit (v3 ix iy))
(loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a)))))))))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
(let ((p (p player)))
(let ((px (x p))
(py (y p)))
(map (lambda (a)
(let loop ((x px)
(y py))
(cond [(not (and (<= 0 x board-width)
(<= 0 y board-height)))
;; outside board
(make-ray #:a a
#:v (v3 (- x px) (- y py))
#:type #f
#:hitf (v3 x y)) ]
[(array-ref game-map (int y) (int x))
(lambda (s) (memv s '(wall window)))
=> (lambda (tile)
;; hit wall
(make-ray #:a a
#:v (v3 (- x px) (- y py))
#:type tile
#:hitf (v3 x y)))]
[else
;; follow ray
(cond [(< (abs (decimals x)) 0.01)
;; hit wall from left or right
(let ((p (- (round (pow x y)) (pow x y))))
(cond
[(= a 0) (loop (+ x (sgn (cos a))) y)]
;; enter x, leave x
[(< 0 (abs (sin a)) (sin (/ tau 8)))
(cond [(= p 0)
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))]
[(<= p (tan a))
(loop (+ x (sgn (cos a)))
(+ y (tan a)))]
[else
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
#;
(let ((dy (* (sgn (sin a))
(if (= 1 (sgn (sin a)))
(- 1 (pow x y))
(pow x y)))))
(loop (+ x (* dy (cot a)))
(+ y dy)))])]
;; enter x, leave y
[else
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
#;
(if (= p 0)
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
(let ((dy (* (- 1 p) (sgn (sin a)))))
(loop (+ x (* dy (cot a)))
(+ y dy) ))
)]))]
[(< (abs (decimals y)) 0.01)
;; hit wall from top or bottom
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))]
[else
;; Middle of square
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))]
)])))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
)
(define fps-time (get-t))
......@@ -127,40 +216,22 @@
(for-each
(lambda (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))
((grass) (set-draw-color 0 #xCC 0))
(else (set-draw-color #xFF #xFF #xFF)))
(fill-rect
(x pt) (y pt)
1 1))
((grass) (set-draw-color 0 #xCC 0))
(else (set-draw-color #xFF #xFF #xFF)))
(fill-rect (x pt) (y pt) 1 1))
(map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height))))
(set-draw-color #xFF 0 0)
(fill-rect
(- (x (p player)) 0.1)
(- (y (p player)) 0.1)
0.2 0.2)
(let ((pp (p player)))
(for-each (lambda (ray)
(let ((v (+ pp (vec ray))))
(draw-line (x pp) (y pp)
(x v) (y v))))
(atomic-box-ref rays)
))
(set-draw-color 0 #xFF 0)
(draw-line
(x (p player)) (y (p player))
(+ (cos (a player)) (x (p player)))
(+ (sin (a player)) (y (p player))))
;; (present)
(atomic-box-ref rays)))
)
(define (draw-first-person-perspective)
......@@ -172,33 +243,33 @@
(render-fill-rect (current-renderer)
(make-rect 0 240 640 240))
(let ((rays (atomic-box-ref rays)))
(unless (null? rays)
(for-each (lambda (i r r+)
(when (hashq-ref texture-map (type r))
(let* ((l (length r))
(segment-height (- 480 (* 30 l) 40))
(texture (hashq-ref texture-map (type r))))
(let ((c (max 0 (int (- #xFF (* l 20))))))
(set-texture-color-mod! texture c c c))
(render-copy
(current-renderer)
texture
#:dstrect (list (int (* i (/ 640 ray-count)))
(int (/ (- 480 segment-height) 2))
(int (+ 0 (/ 640 ray-count)))
(int segment-height))
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16)))))
(iota ray-count)
rays (cdr rays)
)))
(for-each
(lambda (i r)
(cond ((hashq-ref texture-map (type r))
=> (lambda (texture)
(let* ((l (length r))
(segment-height (- 480 (* 30 l) 40)))
(let ((c (max 0 (int (- #xFF (* l 20))))))
(set-texture-color-mod! texture c c c))
(render-copy
(current-renderer)
texture
#:dstrect (list (int (* i (/ 640 ray-count)))
(int (/ (- 480 segment-height) 2))
(int (+ 0 (/ 640 ray-count)))
(int segment-height))
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16)))))))
(iota ray-count)
rays
)))
)
......@@ -294,10 +365,10 @@
(make-parameter
(load-font (media "/font.otf") 20)))
(let ((sock-path "/tmp/guile-socket"))
(use-modules (system repl server))
(delete-file sock-path)
(spawn-server (make-unix-domain-server-socket #:path sock-path)))
;; (let ((sock-path "/tmp/guile-socket"))
;; (use-modules (system repl server))
;; (delete-file sock-path)
;; (spawn-server (make-unix-domain-server-socket #:path sock-path)))
(call-with-window
(make-window
......
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