snake.cljs

(ns hello-cljs.main)

(defn log [str]
    (.log js/console str))

(def state (atom {:direction [1 0]}))

(defn canvas []
    (let [canvas (.getElementById js/document "game")
          ctx (.getContext canvas "2d")
          width  (.-width canvas)
          height (.-height canvas)]
        (set! (.-fillStyle ctx) "black")
        (.fillRect ctx 0 0 width height)
        ctx))

(defn draw-block [ctx [x y]]
    (set! (.-strokeStyle ctx) "rgba(255,255,255, 0.5)")
    (.strokeRect ctx (+ (* x 10) 0.5) (+ (* y 10) 0.5) 8 8)
    (set! (.-fillStyle ctx) "rgba(255,255,255, 0.2)")
    (.fillRect ctx (+ (* x 10) 0.5) (+ (* y 10) 0.5) 8 8))

(defn erase-block [ctx [x y]]
    (set! (.-fillStyle ctx) "black")
    (.fillRect ctx (* x 10) (* y 10) 10 10))

(defn game-over [] false)

(defn new-food [] [(rand-int 30) (rand-int 30)])

(defn collision? [snake newhead]
    (let [[nx ny] newhead]
        (or
            (not (nil? (some #{newhead} snake)))
            (< nx 0) (> nx 30)
            (< ny 0) (> ny 30))))

(defn game [[ctx snake food]]
    (let [
        [hx hy] (first snake)
        [dx dy] (get @state :direction)
        newhead [(+ hx dx) (+ hy dy)]]
        (if (collision? snake newhead)
            (game-over)
            (if (= food newhead)
                (let [
                    newfood (new-food)
                    newsnake (conj snake newhead)]
                    (draw-block ctx newfood)
                    [ctx newsnake newfood])
                (let [newsnake (conj (butlast snake) newhead)]
                    (erase-block ctx (last snake))
                    (draw-block ctx newhead)
                    [ctx newsnake food])))))

(defn game-loop [gstate]
    (if gstate
        (js/setTimeout (fn [] (game-loop (game gstate))) 100)))

(game-loop (let [
    ctx (canvas)
    snake [[5 5] [4 5] [3 5]]
    food (new-food)]
    (draw-block ctx food)
    [ctx snake food]))

(.addEventListener js/document "keydown" (fn [event]
    (let [
        [odx ody] (get @state :direction)
        newdir (condp = (.-keyCode event)
            39 [1 0]  ;right
            40 [0 1]  ;down
            37 [-1 0] ;left
            38 [0 -1] ;up
            false)
        [ndx ndy] newdir]
        (if (not (and
            (false? newdir))
            (and (not (= odx 0)) (= odx (- ndx)))
            (and (not (= ody 0)) (= ody (- ndy))))
            (swap! state assoc :direction newdir)))))