;; author: technomancy
;; desc: raycast demo
;; script: fennel
;; input: gamepad

(local (W MW H MH tau) (values 240 136 140 68 (* math.pi 2)))
(local (spd tspd pw ph) (values 0.7 0.06 0.7 0.5))
(var (x y r) (values 12 12 0)) ; player position/rotation

(fn ok? [x y] (= 0 (mget (// x 8) (// y 8))))

(fn move [spd]
  (let [nx (+ x (* spd (math.cos r))) ny (+ y (* spd (math.sin r)))]
    (when (and (ok? (- nx pw) (- ny pw)) (ok? (- nx pw) (+ ny pw))
               (ok? (+ nx pw) (- ny pw)) (ok? (+ nx pw) (+ ny pw)))
      (set (x y) (values nx ny)))))

(fn input []
  (when (btn 0) (move spd))
  (when (btn 1) (move (- spd)))
  (when (btn 2) (set r (% (- r tspd) tau)))
  (when (btn 3) (set r (% (+ r tspd) tau))))

(fn cast-n [n d]
  (- (* 8 (if (< 0 d) (+ 1 (// n 8)) (- (math.ceil (/ n 8)) 1) )) n))

(fn ray-hits-x? [nx ny nxy nyx]
  (< (+ (* nx nx) (* nxy nxy)) (+ (* ny ny) (* nyx nyx))))

(fn cast [x y cos sin]
  (let [nx (cast-n x cos) nxy (/ (* nx sin) cos)
        ny (cast-n y sin) nyx (/ (* ny cos) sin)]
    (if (ray-hits-x? nx ny nxy nyx)
        (let [cx (+ x nx) cy (+ y nxy)]
          (values cx cy (mget (// (+ cx cos) 8) (// cy 8))))
        (let [cx (+ x nyx) cy (+ y ny)]
          (values cx cy (mget (// cx 8) (// (+ cy sin) 8)))))))

(fn draw-ray [col sin cos cos-th rx ry x y limit]
  (let [(nrx nry tile) (cast rx ry cos sin) ; where and what tile is hit?
        dist (math.sqrt (+ (math.pow (- nrx x) 2) (math.pow (- nry y) 2)))
        h (/ 800 (* dist cos-th))
        top (- MH (* h (+ (// tile 16) (- 1 ph))))
        bottom (+ MH (* h ph))]
    (when (< 0 limit) ; draw behind the current tile first
      (draw-ray col sin cos cos-th nrx nry x y (- limit 1)))
    (when (not= tile 0) ; zero is empty
      (line col top col bottom (% tile 16)))))

(fn _G.TIC []
  (input)
  (cls)
  (for [col 0 W] ; draw one column of the screen at a time
    (let [th (math.atan (/ (- col MW) 100))]
      (draw-ray col (math.sin (+ r th)) (math.cos (+ r th))
                (math.cos th) x y x y 16))))

;; <MAP>
;; 000:011021412135353521212121252525252121212625212121212121212121000000000000000000000000e0000000002000c2c04b2e20850ea3020baff1cffee0c59992885ce2ceaeae244de7000000000000e0000000d0a000000000000000000000000000000000000000000000000000d0000000000000be00d0000000000000000000000000000000000000e00000000000000000e0c0000000c000b0000000000000001600000000f0000000c00000000000000000c0000000f0000000000000000000e00000000000000000000000c000000010000000000000d0a000a000000000a0000000000000000000a000
;; 001:000000000041003500000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
;; 002:000000000000003500000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
;; 003:000041410000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
;; </MAP>

;; <PALETTE>
;; 000:200c2c04b2e20850ea3020baff1cffee0c59992885ce2ceaeae244de7d0000000000000e0000000d0a00000000000000
;; </PALETTE>

Generated by Phil Hagelberg using scpaste at Mon Sep 28 12:26:59 2020. PDT. (original)