2d raycasting using Quil

raycast2d.cljs

(ns my.core
  (:require [quil.core :as q :include-macros true]
            [quil.middleware :as m]))

(defn cast [{[x1 y1] :a [x2 y2] :b} {[x3 y3] :pos [x4 y4] :dir}]
  (let [x4 (+ x3 x4)
        y4 (+ y3 y4)
        den (- (* (- x1 x2) (- y3 y4))
               (* (- y1 y2) (- x3 x4)))]
    	(if-not (= 0 den)
          (let [t (/ (- (* (- x1 x3) (- y3 y4))
               	        (* (- y1 y3) (- x3 x4))) den)
                u (- (/ (- (* (- x1 x2) (- y1 y3))
               	           (* (- y1 y2) (- x1 x3))) den))]
            (when (and (> t 0) (< t 1) (> u 0))
              [(+ x1 (* t (- x2 x1)))
               (+ y1 (* t (- y2 y1)))])))))

(defn make-ray [pos angle]
  (let [angle (q/radians angle)]
  {:pos pos
   :dir [(q/cos angle) (q/sin angle)]}))

(defn make-rnd-wall []
  {:a [(rand-int 400) (rand-int 400)]
   :b [(rand-int 400) (rand-int 400)]})

(defn make-particle []
  (let [pos [(/ 400 2) (/ 400 2)]
        rays (mapv #(make-ray pos %) (range 0 360 0.5))]
    {:pos pos
     :rays rays}))

(defn draw-wall [{[x1 y1] :a [x2 y2] :b}]
  (q/stroke 255 0 0)
  (q/line x1 y1 x2 y2))

(defn draw-particle [{[x y] :pos rays :rays}]
  (q/fill 255)
  (q/ellipse x y 10))

(defn look [walls {:keys [rays pos]}]
  (q/stroke 240 120)
  (q/stroke-weight 2)
  (doall (map #(apply q/line (concat pos %))
	      (remove nil?
  (map #(second (apply min-key first (remove nil? %)))
       (for [ray rays]
	    (for [wall walls]
		 (if-let [pt (cast wall ray)]
		     (let [d (apply q/dist (concat pos pt))]        
	               [d pt])))))))))
(defn borders []
  [{:a [0 0] 
   :b [500 0]}
  {:a [500 0] 
   :b [500 500]}
  {:a [500 500] 
   :b [0 500]}
  {:a [0 500] 
   :b [0 0]}])

(defn setup []
  (q/frame-rate 60)
  {:wall {:a [300 100]
          :b [400 300]}
   :walls (concat (borders) (repeatedly 5 make-rnd-wall))
   :particle (make-particle)})
    
(defn update-state [state]
  (let [pos [(q/mouse-x) (q/mouse-y)]
        rays (map #(assoc % :pos pos) (get-in state [:particle :rays]))]
      (-> state	
  	  	(assoc-in [:particle :pos] pos)
        (assoc-in [:particle :rays ] rays))))
          
(defn draw-state [{:keys [wall particle walls]}]
  (q/background 0)
  (doall (map draw-wall walls))
  (draw-particle particle)
  (look walls particle))

(q/defsketch my
  :host "host"
  :size [500 500]
  :setup setup
  :update update-state
  :draw draw-state
  :middleware [m/fun-mode])