Commit 92c26a61 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Who could have guessed trigonometry was hso hard.

parent 2782de89
......@@ -9,6 +9,11 @@
(z #:accessor z #:init-keyword #:z))
(export x y z)
(define-method (write (v <v3>) port)
(write (list 'v3 (x v) (y v) (z v))
port)
)
(define* (v3 #:optional (x 0) (y 0) (z 0))
(make <v3> #:x x #:y y #:z z))
......
#!/usr/bin/guile \
-e main -s
!#
(add-to-load-path "/usr/local/share/guile/site/2.2/")
(add-to-load-path (dirname (current-filename)))
......@@ -35,7 +39,7 @@
(define texture-map (make-hash-table))
(define player (make-player 5 8 pi))
(define player (make-player 5.5 13.5 0))
(define ray-count 64)
......@@ -118,78 +122,123 @@
(define sgn signum)
(define (x-from-edge x a)
"distance-from-y-wall"
(mod (* (sgn (sin a))
(decimals x))
1))
(define (y-from-edge y a)
"distance-from-x-wall"
(mod (* (sgn (cos a))
(decimals y))
1))
(define distance-from-x-wall y-from-edge)
(define distance-from-y-wall x-from-edge)
(define (hit-x? x y a)
(and (< (x-from-edge x a) 0.01)
(< (x-from-edge x a) (y-from-edge y a))))
(define (hit-y? x y a)
(and (< (y-from-edge y a) 0.01)
(< (y-from-edge y a) (x-from-edge x a))))
(define (ray-trace player ray-count)
(let ((p (p player)))
(let ((px (x p))
(py (y p)))
(map (lambda (a)
(let loop ((x px)
(y py))
(let loop ((x px) (y py))
(format #t "a = ~,3f x = ~,6f y = ~,6f~%" a x y)
(cond [(not (and (<= 0 x board-width)
(<= 0 y board-height)))
(cond [(or (not (and (<= 0 x) (< x board-width)
(<= 0 y) (< y board-height)))
(< 15 (sqrt (+ (expt (- x px) 2)
(expt (- y py) 2)))))
;; outside board
(make-ray #:a a
(make-ray #:a a #:type #f
#: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)
(format #t "hit ~a~%" tile)
;; hit wall
(make-ray #:a a
(make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py))
#:type tile
#:hitf (v3 x y)))]
;; ================= follow ray ===============================
[(hit-x? x y a)
(let ((possible-dy (* (sgn (sin a))
(tan a))))
(if (> 1 (abs (+ (* (sgn (sin a))
(distance-from-x-wall y a))
possible-dy)))
;; enter x, leave x
(loop (+ x (sgn (cos a)))
(+ y possible-dy))
;; else, enter x, leave y
(let ((dy (* (sgn (sin a))
(distance-from-x-wall y a))))
(format #t "xxx: a = ~,2f x = ~,2f y = ~,2f dy = ~,2f~%" a x y dy)
(loop (+ x (* dy (cot a)))
(+ y dy)))))]
;; hit wall from top or bottom
[(hit-y? x y a)
(loop (+ x (* 0.01 (cos a)))
(+ y (* 0.01 (sin a))))
#;
(let ((b (- a (/ tau 4))))
(let ((possible-dx (* (sgn (sin b))
(tan b))))
(if (> 1 (abs (+ (* (sgn (cos a))
(mod (* (sgn (cos b))
(pow x y))
1))
possible-dx)))
(begin
(format #t "yy: dx = ~a~%" possible-dx )
(loop (+ x possible-dx)
(+ y (sgn (sin b)))))
(let ((dx (* (sgn (sin b))
(mod (* (sgn (sin b))
(pow x y))
1))))
(format #t "yyy: a = ~,2f x = ~,2f y = ~,2f dx = ~,2f~%" a x y dx)
(loop (+ x dx)
(+ y (* dx (tan b))))))))]
;; Middle of square
;; moving horizontally
[(> (abs (cos a))
(abs (sin a)))
(let ((dx (* 1.01 (sgn (cos a))
(mod (* x -1 (sgn (cos a)))
1))))
(loop (+ x dx)
(+ y (* dx (tan a) (sgn (cos a))))))
]
;; moving vertically
[else
;; follow ray
(cond [(< (mod (* (sgn (cos a))
(decimals x))
1)
0.01)
;; hit wall from left or right
(let ((p (mod (* (sgn (sin a))
(pow x y))
1)))
(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))))]
[(< (abs (+ (* p (sgn (sin a)))
(* (tan a) (sgn (sin a)))))
1)
(loop (+ x (sgn (cos a)))
(+ y (* (tan a) (sgn (cos a)))))]
[else ; enter x, leave y
(let ((dy (* (sgn (sin a))
(mod (* -1 (pow x y) (sgn (sin a)))
1))))
(loop (+ x (* dy (cot a)))
(+ y dy)))])]
[else ; enter x, leave y
(let ((dy (* (sgn (sin a))
(mod (* -1 (pow x y) (sgn (sin a)))
1))))
(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))))]
)])))
(let ((dy (* 1.01 (sgn (sin a))
(mod (* y -1 (sgn (sin a)))
1))))
(loop (+ x (* dy (cot a)))
(+ y dy)))])))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
)
......@@ -301,8 +350,10 @@
(draw-first-person-perspective)
(render-copy rend texture
#:dstrect (list 0 (- 480 400)
400 400))
#:dstrect
(let ((map-size 200))
(list 0 (- 480 map-size)
map-size map-size)))
(delete-texture! texture))
......@@ -347,23 +398,24 @@
(usleep (max 0 (floor/ (- 1000 dt) 360)))
(set! counter = (+ 1)))))))
(sdl-init)
(ttf-init)
(define current-font (make-parameter #f))
(define (main args)
(sdl-init)
(ttf-init)
(define current-font
(make-parameter
(load-font (media "/font.otf") 20)))
(current-font (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
#:title "Wolf 3D"
#:size '(640 480))
main-loop)
(call-with-window
(make-window
#:title "Wolf 3D"
#:size '(640 480))
main-loop)
(ttf-quit)
(sdl-quit)
(ttf-quit)
(sdl-quit))
......@@ -15,6 +15,7 @@
((#\%) 'entrance))))
arr))
#;
(define game-map
(parse-map
'(
......@@ -33,7 +34,8 @@
"::* *::::::::::::::::::"
" # ###**#*#**#**#**#**#"
" ## #####################")))
#;
(define game-map
(parse-map
'(
......
......@@ -40,4 +40,4 @@
(define pi 3.141592653589793)
(define tau (* 2 pi))
(define int (compose inexact->exact floor))
(define int (compose inexact->exact truncate))
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