; YACS (Yet Another Clojure Snake) inspired by and partly copied from the snakes that have gone before:
;   Abhishek Reddy's snake:  http://www.plt1.com/1070/even-smaller-snake/
;   Stuart Halloway's snake: http://github.com/stuarthalloway/programming-clojure/tree/master/examples/snake.clj
;   Mark Volkmann's snake:   http://www.ociweb.com/mark/programming/ClojureSnake.html

; This one uses an Agent to hold the state and seperates GUI and model event loops using
; invokeLater to update the GUI from the model

(ns net.notwaving.snake
  (:import (java.awt Color Dimension) 
           (javax.swing SwingUtilities JPanel JFrame Timer JOptionPane)
           (java.awt.event ActionListener KeyListener))  
    (:use clojure.contrib.import-static
    [clojure.contrib.seq-utils :only (includes?)]))

(import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)         

(def dirs {VK_LEFT  [-1  0] 
           VK_RIGHT [ 1  0]
           VK_UP    [ 0 -1]
           VK_DOWN  [ 0  1]})
 
;------------------------------------------------------------------------------
; MODEL
;------------------------------------------------------------------------------
(defn new-apple [board]
  [(rand-int (board 0)) (rand-int (board 1))])

(defn new-snake []
  {:body [[0,0]] :dir [1,0] :fed false})

(defn make-model-agent [board]
  (agent 
    {:snake (new-snake)
     :apple (new-apple board)
     :board board
     :state :run}))

(defn new-head [& pts]
  (vec (apply map + pts)))

(defn move-snake [{:keys [body dir fed] :as snake}]
  (assoc snake :body (cons (new-head dir (first body)) (if fed body (butlast body))) 
               :dir dir 
               :fed false))
  
(defn found-apple [snake apple board]
  (if (= (first (snake :body)) apple)
    {:snake (assoc snake :fed true) :apple (new-apple board)}
    {:snake snake :apple apple}))

(defn new-dir [old-dir dir]
  (if (= dir [(* (old-dir 0) -1) (* (old-dir 1) -1)])
    old-dir
    dir))
      
(defn off-edge? [[x y] [head-x head-y]]
  (or (< head-x 0) (< head-y 0) (>= head-x x) (>= head-y y))) 
  
(defn action-move [mdl]
  (merge mdl (found-apple (move-snake (mdl :snake)) (mdl :apple) (mdl :board))))
  
(defn action-check [mdl]
  (let [body (get-in mdl [:snake :body])
        head (first body)]
    (assoc mdl :state
      (cond
        (includes? body head) :lose
        (off-edge? (mdl :board) head) :lose
        (>= (count body) 5) :win
        true :run))))

(defn action-turn [mdl dir]
  (let [snake (mdl :snake)]       
    (assoc mdl :snake (assoc snake :dir (new-dir (snake :dir) dir)))))

(defn action-reset [mdl]
    (merge mdl {:snake (new-snake)
                :apple (new-apple (mdl :board))
                :state :run}))

(defn confirm [frame outcome]
  (let [option (JOptionPane/showConfirmDialog frame "Do you want to play again" outcome JOptionPane/YES_NO_OPTION)]
    (= JOptionPane/NO_OPTION option)))

(defn stop? [mdl frame]
  (if (= (@mdl :state) :run)
    false
    (if (confirm frame (if (= (@mdl :state) :lose) "You Lost!" "You Won!"))
      true
      (do
        (dosync (send mdl action-reset))
        false))))

(defn run [mdl frame turn-length]
    (loop [stop false]
      (if stop
          "ended"
          (do 
            (Thread/sleep turn-length)
            (dosync (send mdl action-move))
            (dosync (send mdl action-check))
            (await mdl)
            (recur (stop? mdl frame))))))

;------------------------------------------------------------------------------
; GUI
;------------------------------------------------------------------------------
(defn cell-to-screen-rect [cell cell-size]
  (map #(* cell-size %)
       [(cell 0) (cell 1) 1 1]))

(defn fill-cell [g pt cell-size color]
  (let [[x y dx dy] (cell-to-screen-rect pt cell-size)]
    (.setColor g color)
    (.fillRect g x y dx dy)))

(defn paint [g mdl cell-size]
  (doseq [cell ((@mdl :snake) :body)] (fill-cell g cell cell-size Color/GREEN))
  (fill-cell g (@mdl :apple) cell-size Color/RED))

(defn make-panel [mdl frame cell-size]
  (proxy [JPanel ActionListener KeyListener] []
    (getPreferredSize []
      (Dimension.
        (* ((@mdl :board) 0) cell-size)
        (* ((@mdl :board) 1) cell-size)))
    (paintComponent [g]
      (proxy-super paintComponent g)
      (paint g mdl cell-size))
    (keyPressed [e]
      (dosync (send mdl action-turn (dirs (.getKeyCode e)))))
    (keyReleased [e])
    (keyTyped [e])))

(defn set-gui [mdl frame cell-size]
  (let [panel (make-panel mdl frame cell-size)]
    (doto panel
      (.setFocusable true)
      (.addKeyListener panel))
    (doto frame
      (.add panel)
      (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
      (.pack)
      (.setVisible true))
    panel))

;------------------------------------------------------------------------------
; Root function of Program
;------------------------------------------------------------------------------
(defn main [] 
  (let [cell-size 10
        board [25,25]
        turn-length 75
        mdl (make-model-agent board)
        frame (JFrame. "Snake")
        panel (set-gui mdl frame cell-size)]  
    (try
      (add-watch mdl :send (fn [w a b] (if b (SwingUtilities/invokeLater (fn [](.repaint panel)))) ))
      (run mdl frame turn-length)
      (finally
        (.dispose frame)
        (shutdown-agents)))))
    
;------------------------------------------------------------------------------
; Only run if being run as a script, not if loaded in a REPL with load-file.
; When run as a script, the path to this file will be a command-line argument.
(if *command-line-args* (main))