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

Fix texture mapping for half of angles.

parent da8f4893
......@@ -30,7 +30,7 @@
(define-class <player> ()
(pos #:accessor p #:init-form (v3 1 1))
(angle #:accessor a #:init-value 0)
(feild-of-view #:accessor fov #:init-value (/ tau 6)))
(feild-of-view #:accessor fov #:init-value (/ tau 8)))
(export p a fov)
(define (make-player x y a)
......@@ -38,24 +38,35 @@
(define-class <ray> ()
(angle #:acessor a #:init-keyword #:a)
(angle #:accessor a #:init-keyword #:a)
(length #:accessor length #:init-keyword #:length #:init-value #f)
(vec #:accessor vec #:init-keyword #:v)
(pos-on-wall #:accessor pos-on-wall)
(local-wall-segment #:accessor local-wall-segment)
(hit-coord #:accessor hit #:init-keyword #:hit)
(wall-direction #:accessor wall-direction)
)
(export a length vec pos-on-wall hit)
(export a length vec pos-on-wall hit local-wall-segment wall-direction)
(define-method (initialize (self <ray>) args)
(next-method)
(unless (length self)
(set! (length self) (vector-length (vec self))))
(set! (pos-on-wall self)
(if (> 0.1 (x (vec self)))
(- (y (vec self)) (floor (y (vec self))))
(- (x (vec self)) (floor (x (vec self)))))))
(set! (wall-direction self) (if (> 0.1 (x (vec self))) 'x 'y)
(pos-on-wall self)
(case (wall-direction self)
((x) (- (y (vec self)) (floor (y (vec self)))))
((y) (- (x (vec self)) (floor (x (vec self))))))
(local-wall-segment self)
(case (wall-direction self)
((x) (floor (x (vec self))))
((y) (floor (y (vec self))))))
)
(define (make-ray . args)
(apply make <ray> args))
(add-to-load-path "/usr/local/share/guile/site/2.2/")
(add-to-load-path (dirname (current-filename)))
(define (media str)
(string-append (dirname (current-filename)) str))
(use-modules (srfi srfi-1)
(sdl2)
......@@ -28,56 +31,55 @@
(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
[(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 (1+ ray-count))))
ret)
(define update
(let ((keys-down '()))
(lambda (dt)
(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)))
(set! keys-down (cons (keyboard-event-scancode ev)
keys-down))]
[(keyboard-up-event? ev)
(set! 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 (1+ ray-count))))
ret)))
)
......@@ -105,7 +107,8 @@
(define fps-time (get-t))
(define (draw-map)
(set-draw-color #xFF #xFF #xFF)
;;(set-draw-color #xFF #xFF #xFF)
(set-draw-color #x88 #x88 #x88 0 )
(clear)
(set-draw-color 0 0 #xFF)
......@@ -120,17 +123,17 @@
(map (lambda (p) (apply v3 p))
(cross-product (iota board-width) (iota board-height)))))
(set-draw-color 0 0 0)
;; (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
;; 0 i
;; board-width i))
;; (iota board-height))
(for-each (lambda (i) (draw-line
i 0
i board-height))
(iota board-width))
;; (for-each (lambda (i) (draw-line
;; i 0
;; i board-height))
;; (iota board-width))
......@@ -171,29 +174,21 @@
(set-draw-color 0 #xEE #xEE)
(for-each (lambda (i r r+)
(let* ((l (length r))
(segment-height (- 480 (* 70 l))))
(set-draw-color 0
(int (min #xFF (- #x100 (* #x100 (/ l 7)))))
(int (min #xFF (- #x100 (* #x100 (/ l 7))))))
(render-copy
(current-renderer)
brick-texture
#:dstrect (list (int (* i (/ 640 ray-count)))
(int (/ (- 480 segment-height) 2))
(int (1+ (/ 640 ray-count)))
(int (+ 0 (/ 640 ray-count)))
(int segment-height))
#:srcrect (list (inexact->exact (round (* 56 (pos-on-wall r)))) 0
(inexact->exact (round (* 56 (pos-on-wall r+)))) 56)
)
#;
(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)))))
#:srcrect
(list (int (* 16 (pos-on-wall r))) 0
1 16))))
(iota ray-count)
cached-rays
(cdr cached-rays)
......@@ -209,8 +204,8 @@
(clear)
(let ((texture (make-texture rend 'rgba8888 'target
(* 8 (current-tile-size))
(* 5 (current-tile-size)))))
(* board-width (current-tile-size))
(* board-height (current-tile-size)))))
(set-render-target! rend texture)
(set-draw-color #xFF #xFF #xFF)
(draw-map)
......@@ -221,9 +216,8 @@
;; minimap
(render-copy rend texture
#:dstrect (list 0 0
(* 2 (current-tile-size))
(* 2 (current-tile-size))))
#:dstrect (list 0 (- 480 100)
100 100))
(delete-texture! texture))
......@@ -248,12 +242,12 @@
(define (main-loop window)
(define rend (make-renderer window '(accelerated #; vsync texture)))
(define last-t (get-t))
(set! brick-texture (surface->texture rend (load-image (string-append (dirname (current-filename)) "/purplebrick.png"))))
(set! brick-texture (surface->texture rend (load-image (media "/polished_andesite.png"))))
(let loop ((counter 0))
;; (usleep (int (/ 1000000 (* 60 60))))
;; (sigaction SIGINT (lambda (sig) (set! looping #f)))
(sigaction SIGINT (lambda (sig) (set! looping #f)))
(if (= counter 1)
(begin (draw window rend) (loop 0))
......@@ -270,7 +264,7 @@
(sdl-init)
(ttf-init)
(current-font (load-font "/usr/share/fonts/truetype/gentium/Gentium-R.ttf" 12))
(current-font (load-font (media "/font.otf") 12))
(format #t "Loaded font ~a~%" (current-font))
......
......@@ -11,7 +11,8 @@
((#\#) 'wall)
((#\:) 'grass)
((#\;) 'teleporter)
((#\*) 'window)
((#\*) 'wall #; 'window
)
((#\%) 'entrance))))
arr))
......
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