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

Start of attempt to add light and bounces.

parent 1cdc7fc2
......@@ -4,14 +4,14 @@
# % #
# #############%#%##
# # # # #
# % # # #
# L % # # #
# #######****#**#**#
###%####:::::::::::::::::
::* *::::::::::::::::::
::* *::::::::::::::::::
::# #::::::::::::::::::
::* *::::::::::::::::::
::* *::::::::::::::::::
::* *::::::::L:::::::::
::# #::::::::::::::::::
::* *::::::::::::::::::
::* *::::::::::::::::::
......@@ -20,7 +20,7 @@
::* *::::::::::::::::::
# ###**#*#**#**#**#**#
# % # # # # # # #
# ### # # # # # #
# L### # # # # # #
# ####%#%##%##%#%##%##
# %
## ####################
......@@ -53,11 +53,14 @@
(hit-float-point #:getter hitf #:init-keyword #:hitf)
(solid? #:getter solid? #:init-keyword #:solid?)
(tile-type #:getter type
#:initial-value #f
#:init-value #f
#:init-keyword #:type)
(hits-to-wall #:getter hits-to-wall
#:init-value -1
#:init-keyword #:htw)
)
(export a length vec pos-on-wall hitf solid? type)
(export a length vec pos-on-wall hitf solid? type hits-to-wall)
(define-method (initialize (self <ray>) args)
(next-method)
......
......@@ -15,6 +15,7 @@ exec guile -q -e main -s $0
(string-append (dirname (current-filename)) str))
(use-modules (srfi srfi-1)
(srfi srfi-27)
(sdl2)
(sdl2 ttf)
......@@ -97,23 +98,23 @@ exec guile -q -e main -s $0
))
keys-down))))
(define (find-next-wall x y a callback)
(define (find-next-edge x y a callback)
(let ((dx-ampl (mod (* -1 (sgn (cos a)) (decimals x)) 1))
(dy-ampl (mod (* -1 (sgn (sin a)) (decimals y)) 1)))
(let* ((dx (* 1.01 dx-ampl (sgn (cos a))))
(dy (* dx (tan a))))
(if (<= (abs dy) dy-ampl)
(callback (+ x dx) (+ y dy))
(callback (+ x dx) (+ y dy) 'x)
(let* ((dy (* 1.01 dy-ampl (sgn (sin a))))
(dx (* dy (cot a))))
(callback (+ x dx) (+ y dy)))))))
(callback (+ x dx) (+ y dy) 'y))))))
(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) (dir 'x))
(cond [(or (not (and (<= 0 x) (< x (board-width game-map))
(<= 0 y) (< y (board-height game-map))))
(< 15 (sqrt (+ (expt (- x px) 2)
......@@ -127,8 +128,65 @@ exec guile -q -e main -s $0
[(array-ref (board-data game-map) (int y) (int x))
(lambda (tile) (memv tile '(wall)))
=> (lambda (tile)
(format #t "start!!!~%")
(list (make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y)
#:htw
;; (random-integer 5)
;; för a > 0:
(let loop ((htl 1)
(x (- x (* 0.1 (sgn (cos a)))))
(y (- y (* 0.1 (sgn (sin a)))))
(a (case dir
((x) (mod (- a) tau))
((y) (mod (- pi a) tau)))))
(find-next-edge
x y a
(lambda (x y dir)
;; (format #t "x = ~a, y = ~a, a = ~a~%"
;; x y a)
(cond
[(or (not (and (<= 0 x) (< x (board-width game-map))
(<= 0 y) (< y (board-height game-map))))
#;
(< 15 (sqrt (+ (expt (- x px) 2) ;
(expt (- y py) 2)))))
-1
]
[(eq? 'lamp
(array-ref (board-data game-map)
(int y) (int x)))
htl]
[(> htl 10)
-1]
[(array-ref (board-data game-map) (int y) (int x))
(lambda (tile) (memv tile '(wall)))
=> (lambda _
(loop (1+ htl)
(- x (* 0.1 (sgn (cos a))))
(- y (* 0.1 (sgn (sin a))))
(case dir
((x) (mod (- a) tau))
((y) (mod (- pi a) tau)))))]
[else
(loop htl
x y a
#; (mod (+ pi a) tau)
)]))))))
)]
[(array-ref (board-data game-map) (int y) (int x))
(lambda (tile) (memv tile '(lamp)))
=> (lambda (tile)
(list (make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py))
#:htw 0
#:hitf (v3 x y))))]
;; hit window
......@@ -138,10 +196,10 @@ exec guile -q -e main -s $0
(cons (make-ray #:a a #:type tile
#:v (v3 (- x px) (- y py))
#:hitf (v3 x y))
(find-next-wall x y a loop)))]
(find-next-edge x y a loop)))]
;; follow ray
[else (find-next-wall x y a loop)])))
[else (find-next-edge x y a loop)])))
(iota ray-count (- (a player) (/ (fov player) 2))
(/ (fov player) ray-count)))))
......@@ -158,6 +216,7 @@ exec guile -q -e main -s $0
(case (array-ref (board-data game-map) (y pt) (x pt))
((wall) '(#xBB #xBB #xBB))
((window) '(#x10 #x10 #xFF))
((lamp) '(#xFF #xFF #x0))
((grass) '(0 #xCC 0))
(else '(#xFF #xFF #xFF))))
(fill-rect (x pt) (y pt) 1 1))
......@@ -199,8 +258,18 @@ exec guile -q -e main -s $0
(let* ((l (length r))
(segment-height (int (- 480 (* 30 l) 40))))
(let ((c (max 0 (int (- #xFF (* l 20))))))
(set-texture-color-mod! texture c c c))
;; 0, 5
;; (format #t "HTL = ~a~%" (hits-to-wall r))
(when (= -1 (hits-to-wall r))
(let ((c 0))
;; add light effect
(set-texture-color-mod! texture c c c)))
(when (< 0 (hits-to-wall r))
(let ((c (max 0 (int (- #xFF (* (/ (hits-to-wall r)) l 10))))))
;; add light effect
(set-texture-color-mod! texture c c c)))
(render-copy
(current-renderer)
......@@ -302,6 +371,16 @@ exec guile -q -e main -s $0
(surface->texture rend (load-image (media (format #f "/textures/~a.png" type))))))
'(wall window))
(parameterize ((current-renderer rend))
(let ((lamp-text (make-texture rend 'rgba8888 'target 16 16)))
(format #t "lamp = ~a~%" lamp-text)
(with-render-target
lamp-text
(lambda ()
(set-draw-color #xFF #xFF #x0)
(clear)))
(hashq-set! texture-map 'lamp lamp-text)))
(let ((counter 0))
(while #t
(sigaction SIGINT (lambda (sig) (break)))
......
......@@ -19,6 +19,7 @@
(case (string-ref (list-ref spec i) j)
((#\P #\p) (set! spawn (list j i)) 'space)
((#\space) 'space)
((#\L) 'lamp)
((#\#) 'wall)
((#\:) 'grass)
((#\;) 'teleporter)
......
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