bejewelled.clj

(ns ^{:doc
       "Bejewelled Blitz (Facebook) player
     
      Clojure program to play Bejewelled Blitz on Facebook
      Work in progress
      Only works with game on primary monitor
      
      First you need to determine where the game board is on the screen
      then set the :x and :y values in the game-loc def appropriately
     
      You can find the values by doing the following (albeit quite slow)
      1. Start the game, make sure to leave the game board visible on the primary screen
      2. Wait for the text on the game board to clear, so you just have a view of the gems
      4. (find-game) ; this is very slow (2 hours on a core i7) it will return the coordinates of the game
      5. change (def game-loc {...}) to have the x and y coordinate from step 4
     
      Personally I find the values by hand using
     
      (def test-image (grab-image)) ; with a board visible on the primary screen
      (image-to-frame (.getSubimage test-image x y 320 320)) ; vary x,y until you get close
      and (total-discrepancy (.getSubimage test-image x y 320 320)) ; use to find perfect spot
      you're trying to find the x and y that minimizes the latter
     
      Once you have game-loc set (.start timer) and (.stop timer) turn the game player on and off
     
      TODO
      Better gem identification (still some multipliers and stars with wrong colour id)
      Detect stars, bombs etc and use the info in making moves (multipliers done)
      Prediction - figure out what the board will be like after a move and use that instead of move heuristics
      Faster way of finding the game on the screen
      Exploder moves include multipliers in it's calculation

      Thanks to everyone on #clojure, especially rhudson, raek, Raynes, cemerick, mfex and chouser"}
    bejewelled.core
  (:import (java.awt Robot GraphicsEnvironment GraphicsDevice Rectangle Dimension)
	   (java.awt.image BufferedImage MemoryImageSource)
	   (java.awt.event InputEvent ActionListener)
	   (javax.swing JPanel JFrame Timer)))

(in-ns 'bejewelled.core) ;make my slime-repl work nicely for some reason

(def ^{:doc "Number of cells in the board, assumed to be square."}
     board-size 8)

(def ^{:doc "How big each cell of the board is in pixels."}
     cell-size-in-pixels 40)

(def ^{:doc "Where the game is on the screen. find-game will detect the values for this albeit slowly."}
     game-loc {:x 834 :y 338 :w (* board-size cell-size-in-pixels) :h (* board-size cell-size-in-pixels)})

(def ^{:doc "Used to remote control the mouse and take screenshots."}
       robot (new Robot))

(def white [255 255 255])

(def ^{:doc "Mapping from key colours to gem type (incomplete)."}
     colour-to-gem-map
     {[160 29 160] :purple 
      [1 172 27] :green
      [23 162 254] :blue
      [166 134 26] :yellow
      [205 223 161] :yellow ;yellow star gems are very bright, easily mistaken for white
      [219 219 219] :white
      [217 16 40] :red
      [213 84 14] :orange
      [89 95 72] :exploder})

(def ^{:doc "Map from a display character to the corresponding colour."} 
     reverse-display-colour-map {\o :orange \r :red \g :green \y :yellow \e :exploder \w :white \p :purple \b :blue})

(def ^{:doc
       "When an image is converted to a game layout we calculate
        how likely we think the image is actually a game board.
        If the error goes over this threshold then we won't try
        and make any moves.
        The value is based on how close cell rgb values are to
        a set of key values."}
     board-detection-threshold 80000)

(def ^{:doc
       "If a board is detected, but an individual cell has a error value
        over this threshold then report information about the worst cell
        This helps with adding more data to the key values map."}
       cell-detection-threshold 4000)

(def ^{:doc "How frequently to try and make a move in milliseconds."}
     move-interval-ms 50)

(def ^{:doc "If we make moves close together in time and space they can interact with each other in a livelock. This var determins how long to wait after making a move before making a close by move"}
     close-move-delay-ms 300)

(defn rgb-to-parts [rgb]
  "Break apart an rgb value into its constituent parts as a vector."
  (let [r (bit-shift-right (bit-and 0xff0000 rgb) 16)
	g (bit-shift-right (bit-and 0xff00 rgb) 8)
	b (bit-and 0xff rgb)]
    [r g b]))

;(use '[clojure.contrib.repl-utils :only [expression-info]])

(defn moving-average
  "Moving average calculation."
  [avg-so-far trials next-value]
  (/
   (+
    (* avg-so-far (dec trials))
    next-value)
   trials))

(defn average-rgb-seq
  "Moving average applied to rgb vectors."
  [seq]
  (first
   (reduce
    (fn [[[ra ga ba] t] [r g b]]
      [[ (moving-average ra t r)
	 (moving-average ga t g)
	 (moving-average ba t b)]
       (inc t)])
    [[0 0 0] 1] seq)))

(defn average-rgb
  "work out the average rgb value of the supplied pixel and some
   nearby key points in an attempt to identify what gem is there."
  [image [px py]]
  (average-rgb-seq
   (map rgb-to-parts
	(for [[xoff yoff] [[0 0] [-10 -10] [0 12]]] ;These key points are based on guesswork.
	  (.getRGB image (+ px xoff) (+ py yoff))))))

(defn distance-squared [c1 c2]
  "Euclidean distance between two collections considered as coordinates."
  (->> (map - c1 c2) (map #(* % %)) (reduce +)))

(defn rgb-to-key-colour
  "Find closest colour in supplied map of colours."
  [rgb-triple colour-map]
  (colour-map
   (apply min-key (partial distance-squared rgb-triple) (keys colour-map))))

(defn rgb-to-gem
  "Given an rgb, find the nearest gem colour, using euclidean distance in rgb space."
  [rgb]
  (let [key-colour (rgb-to-key-colour rgb colour-to-gem-map)]
    {:colour key-colour :type :normal})) ; maybe a constructor for gems?

(defn scale-coordinates-to-centre
  "get the centre of a cell in pixel coordinates from its game coordinates"
  [coords]
  (vec (map #(+ (/ cell-size-in-pixels 2) (* % cell-size-in-pixels)) coords)))

(defn scale-coordinates
  "Get the top left of a cell in pixel coordinates from its game coordinates"
  [coords]
  (vec (map #(* % cell-size-in-pixels) coords)))

(defn multiplier-at
  "Given a multiplier gem, what colour is it?"
  [game-image coords]
  (let [[px py] (scale-coordinates coords)
	rgb (rgb-to-parts (.getRGB game-image (+ 13 px) (+ 13 py)))
	key-colour (rgb-to-key-colour rgb colour-to-gem-map)]
    {:colour key-colour :type :multiplier})
  )

(defn is-multiplier?
  "Is the gem at [x y] a multiplier. Guess by looking for white pixels making up the x symbol"
  [game-image coords]
  (every?
   #(= white %)
   (map rgb-to-parts
	(let [[px py] (scale-coordinates coords)
	      pixel-offsets [[11 16] [13 20]]]
	  (for [[xoff yoff] pixel-offsets]
	    (.getRGB game-image (+ px xoff) (+ py yoff)))))))

(defn average-rgb-at
  "Work out the average rgb value of a pixel and surrounding area from game coordinates."
  [game-image coords]
  (map int (average-rgb game-image (scale-coordinates-to-centre coords))))

(defn identify-gem-at
  "In image, guess what gem is at game-coords."
  [game-image game-coords]
  (if (is-multiplier? game-image game-coords)
    (multiplier-at game-image game-coords)
    (rgb-to-gem (average-rgb-at game-image game-coords))))

(defn image-to-layout
  [game-image]
  "Try and construct a bejewelled game board out of the image.
   Take the average of rgb points around each board cell.
   Maps them on to a set of key colour values as best as possible."
  (into {}
	(for [x (range board-size) y (range board-size)]
	  [[x y] (identify-gem-at game-image [x y])])))


;;; Functions for determining how likely an image is actually a game board
(defn max-discrepancy
  "Returns the how far the worst cell was from a key colour
   when converting a game-image to a layout."
  [game-image]
  (apply
   max
   (for [x (range board-size) y (range board-size)]
     (let [rgb (average-rgb-at game-image [x y])]
       (apply
	min
	(map
	 (partial distance-squared rgb)
	 (keys colour-to-gem-map)))))))

(defn max-discrepancy-cell
  "Given an image, returns the game-coordinates of the cell that we were most unsure about"
  [image]
  (let [ds (into {} ;compute a map from coordinates to the distance squared of the gem we detected there
		 (for [x (range board-size) y (range board-size)]
		   (let [rgb (average-rgb-at image [x y])
			 key (apply
			      min-key
			      (partial distance-squared rgb)
			      (keys colour-to-gem-map))]
		     [[x y] (distance-squared rgb key)])))]
    (apply max-key ds (keys ds))))

(defn total-discrepancy
  "Given an image, how far in total was each cell from a key colours."
  [image]
  (apply
   +
   (for [x (range board-size) y (range board-size)]
     (let [rgb (average-rgb-at image [x y])]
       (apply min
	      (map (partial distance-squared rgb)
		   (keys colour-to-gem-map)))))))

(defn valid-coordinate?
  "Is [x y] within the board?"
  [[x y]]
  (and
   (>= x 0)
   (< x board-size)
   (>= y 0)
   (< y board-size)))


;;; Functions for determining whether a game layout has particular features 
(defn coords-contain-multiplier?
  "Are any of the gems in layout at coords in coord-set a multipler gem?"
  [layout coord-set]
  (and (every? valid-coordinate? coord-set)
       (some #(= :multiplier %)
	     (map #(:type (layout %)) coord-set))))

(defn coords-same-colour?
  "true if all the coordinates in coord set are valid, and the gems at those coords
   in layout have the same colour"
  [layout coord-set]
  (and (every? valid-coordinate? coord-set)
       (->> (map layout coord-set)
	    (map :colour)
	    (apply =))))

(defn one-coord-set-same-colour?
  "true if at least one of the set of coordinates are all valid, and the gems at those
   coords in layout have the same colour."
  [layout coord-sets]
  (some identity
	(map (partial coords-same-colour? layout) coord-sets)))

(defn has-t-or-l?
  "Does a layout have a T shape in it with [x y] as the cross point?
   Or an L with [x y] as the apex?"
  [layout [x y]]
  (let [patterns [[[x y] [(dec x) y] [(inc x) y] [x (inc y)] [x (+ y 2)]] ;upright T
		  [[x y] [(dec x) y] [(inc x) y] [x (dec y)] [x (- y 2)]] ;upside down T
		  [[x y] [x (dec y)] [x (inc y)] [(- x 2) y] [(dec x) y]] ;T to right
		  [[x y] [x (dec y)] [x (inc y)] [(inc x) y] [(+ x 2) y]] ;T to left
		  [[x y] [x (- y 2)] [x (dec y)] [(inc x) y] [(+ x 2) y]] ;L
		  [[x y] [x (- y 2)] [x (dec y)] [(dec x) y] [(- x 2) y]] ;L rotated 90 left
		  [[x y] [x (+ y 2)] [x (inc y)] [(dec x) y] [(- x 2) y]] ;L rotated 180
		  [[x y] [x (+ y 2)] [x (inc y)] [(inc x) y] [(+ x 2) y]] ;L rotated 90 right
		  ]] 
    (one-coord-set-same-colour? layout patterns)))

(defn coord-sets-n-in-a-row-down-at
  "Get a list of lists of coordinates. Each sublist represents n in a row coordinates
   including [x y]"
  [[x y] n]
  (filter #(every? valid-coordinate? %)
   (for [j (range (- (inc y) n) (inc y))]
     (concat 
      (for [c (range n)]
	[x (+ c j)])))))

(defn coord-sets-n-in-a-row-across-at
  "Get a list of lists of coordinates. Each sublist represents the coordinates of n gems
   in a row from left to right, including the gem at [x y]"
  [[x y] n]
  (filter #(every? valid-coordinate? %)
   (for [i (range (- (inc x) n) (inc x))]
     (concat 
      (for [c (range n)]
	[(+ c i) y]))))  )

(defn has-n-in-a-row-at?
  "Does the layout have n gems in a row of the same colour including the gem at [x y]"
  [layout coords n]
  (one-coord-set-same-colour?
   layout
   (concat
    (coord-sets-n-in-a-row-across-at coords n)
    (coord-sets-n-in-a-row-down-at coords n))))

(defn has-n-in-a-row-with-multiplier-at?
  "Does the layout have n gems in a row of the same colour including the gem at [x y]
   and is at least one gem a multiplier gem."
  [layout coords n]
  (let [coord-sets (concat
		    (coord-sets-n-in-a-row-across-at coords n)
		    (coord-sets-n-in-a-row-down-at coords n))]
    (some identity
	  (map #(and
		 (coords-same-colour? layout %)
		 (coords-contain-multiplier? layout %))
	       coord-sets))))

(defn apply-move
  "Apply a move to a layout and return the resulting layout"
  [layout move]
  (let [{:keys [from to]} move
	from-gem (layout from)
	to-gem (layout to)]
    (assoc layout from to-gem to from-gem)))

(defn possible-moves-from
  "Generate the possible moves from a particular cell"
  [[x y]]
  (filter
   #(valid-coordinate? (:to %))
   [{:from [x y] :to [(dec x) y]}
    {:from [x y] :to [(inc x) y]}
    {:from [x y] :to [x (dec y)]}
    {:from [x y] :to [x (inc y)]}]))

(defn possible-moves-from-down-right-only
  "Generate the possible moves down or right from a particular cell"
  [[x y]]
  (filter
   #(valid-coordinate? (:to %))
   [{:from [x y] :to [(inc x) y]}
    {:from [x y] :to [x (inc y)]}]))

(defn possible-moves []
  "List of all possible moves in a game (regardless of whether performing that move would do anything useful)"
  ;; backwards as it's better to move from the bottom if possible
  ;; both because that area of the board is more stable
  ;; and because moves there cause more chance of cascades
  (reverse
   (flatten
    (for [y (range board-size) x (range board-size)]
      (possible-moves-from-down-right-only [x y])))))

(def pm (possible-moves))

(defn has-colour
  "Does a gem have a particular colour?"
  [gem colour]
  (= colour (:colour gem)))

(defn count-gems-of-colour
  "How many gems of the given colour are in the layout?"
  [layout colour]
  (count (filter #(has-colour % colour) (vals layout))))

(defn exploder-moves
  "exploder moves, in order of usefulness"
  [layout]
  (let [exploder-coords (filter #(has-colour (layout %) :exploder) (keys layout))
	moves (flatten (map possible-moves-from exploder-coords))]
    (sort-by #(count-gems-of-colour layout (:colour (layout (:to %)))) >  moves)))

(defn move-contains-exploder?
  "Does a move contain an exploder"
  [layout move]
  (or  (= :exploder (:colour (layout (:from move))))
       (= :exploder (:colour (layout (:to move))))))

(defn valid-moves
  "List of moves that could be made in the game of given layout, in order of usefulness"
  ;with the doubling up of :to :from, might be worth going back to all valid moves, rather than removing the ones that are opposites
  [layout]
  (concat
   (exploder-moves layout)
   (filter #(has-t-or-l? (apply-move layout %) (:to %)) pm)
   (filter #(has-t-or-l? (apply-move layout %) (:from %)) pm)
   (filter #(has-n-in-a-row-with-multiplier-at? (apply-move layout %) (:to %) 5) pm)
   (filter #(has-n-in-a-row-with-multiplier-at? (apply-move layout %) (:from %) 5) pm)
   (filter #(has-n-in-a-row-at? (apply-move layout %) (:to %) 5) pm)
   (filter #(has-n-in-a-row-at? (apply-move layout %) (:from %) 5) pm)
   (filter #(has-n-in-a-row-with-multiplier-at? (apply-move layout %) (:from %) 4) pm)
   (filter #(has-n-in-a-row-with-multiplier-at? (apply-move layout %) (:to %) 4) pm)
   (filter #(has-n-in-a-row-with-multiplier-at? (apply-move layout %) (:from %) 3) pm)
   (filter #(has-n-in-a-row-with-multiplier-at? (apply-move layout %) (:to %) 3) pm)
   (filter #(has-n-in-a-row-at? (apply-move layout %) (:from %) 4) pm)
   (filter #(has-n-in-a-row-at? (apply-move layout %) (:to %) 4) pm)
   (filter #(has-n-in-a-row-at? (apply-move layout %) (:from %) 3) pm)
   (filter #(has-n-in-a-row-at? (apply-move layout %) (:to %) 3) pm)))

(defn display-layout
  "Write a layout to the screen in a readable way (only displays colours, loses gem type info)"
  [layout]
  (doseq [y (range board-size)]
    (doseq [x (range board-size)]
      (let [gem (layout [x y])
	    colour (:colour gem)
	    is-mult (= :multiplier (:type gem))
	    letter (first (name colour))]
	(print (if is-mult (.toUpperCase (str letter)) letter)))) 
    (println)))

(defn display-to-layout
  "Turn a string representation of a layout into a layout. only deals with :type normal gems"
  [display]
  (into {}
	(for [x (range board-size) y (range board-size) ]
	  [ [x y]
	    {:colour (reverse-display-colour-map
		      (.charAt display (+ x (* (inc board-size) y)))) ; doesn't deal with os dependent line endings properly
	     :type :normal} ])))

(defn game-to-screen-coords
  [game-loc coords]
  (let [[px py] (scale-coordinates-to-centre coords)]
    [(+ (game-loc :x) px)
     (+ (game-loc :y) py)]))

(defn perform-move
  "Perform a move by using java.awt.Robot to control the mouse.
   game-loc is where the bejewelled game is on the screen
   move is the move to perform"
  [game-loc move]
  (let [[from-px from-py] (game-to-screen-coords game-loc (move :from))
	[to-px to-py] (game-to-screen-coords game-loc (move :to))]
    (doto robot
      (.mouseMove from-px from-py)
      (.mousePress InputEvent/BUTTON1_MASK)
      (.mouseMove to-px to-py)
      (.mouseRelease InputEvent/BUTTON1_MASK ))))

(defn grab-game-image
  "Grab a screenshot on the primary monitor as specified by game-loc"
  [game-loc]
  (let [game-rect (new Rectangle (game-loc :x) (game-loc :y) (game-loc :w) (game-loc :h))]
    (.createScreenCapture robot game-rect)))

(defn is-game?
  "See if we think the supplied game is an image"
  [game-image threshold]
  (< (total-discrepancy game-image) threshold))

(defn print-cell-diagnostics
  "print diagnostics about a game cell"
  [game-image cell discrepancy]
  (println
   cell
   discrepancy
   (average-rgb-at game-image cell)
   (identify-gem-at game-image cell)))

(defn in-a-line-n?
  "Determine whether x1 y1 and x2 y2 are in a line with at most n-1 gems between them"
  [[x1 y1] [x2 y2] n]
  (or
   (and (= x1 x2) (<= (Math/abs (- y1 y2)) n))
   (and (= y1 y2) (<= (Math/abs (- x1 x2)) n))))

(defn moves-too-close
  "true if you can draw a straight line between either end of move1 and move2 with at most 1 cell in between"
  [move1 move2]
  (or (in-a-line-n? (:from move1) (:from move2) 2)
      (in-a-line-n? (:from move1) (:to move2) 2)
      (in-a-line-n? (:to move1) (:from move2) 2)
      (in-a-line-n? (:to move1) (:to move2) 2)))

(defn move-too-close
  "Check whether a move is too close in time and space to any of a list of other moves"
  [recent-move-list move]
  (let [ms (System/currentTimeMillis)
	relevant-recent-moves (filter #(> close-move-delay-ms (- ms (:timestamp %))) recent-move-list)]
    (some (partial moves-too-close move) (map :move relevant-recent-moves))))

(defn update-recent-move-list
  "Add a move onto the recent move list and cull any old stuff"
  [old-list move]
  (let [ms (System/currentTimeMillis)]
    (cons {:timestamp ms :move move}
	      (filter #(> close-move-delay-ms (- ms (:timestamp %))) old-list))))

(defn move-if-able-fn
  "If the supplied image looks like a game then make the best move
   we can see if one is available. If no move available then dump
   the layout as a training aid."
  []
  (let [recent-move-list (atom '())]
    (fn [game-image game-loc total-threshold worst-threshold]
      (if (is-game? game-image total-threshold)
	(let [worst-discrepancy (max-discrepancy game-image)
	      layout (image-to-layout game-image)
	      move (first (filter #(not (move-too-close @recent-move-list %)) (valid-moves layout)))]
	  (if (> worst-discrepancy worst-threshold)
	    (let [problem-cell (max-discrepancy-cell game-image)]
	      (print-cell-diagnostics game-image problem-cell worst-discrepancy)))
	  (if (not (nil? move))
	    (do
	      (swap! recent-move-list update-recent-move-list move)
	      (perform-move game-loc move))
	    (do
	      (println "No Move")
	      (display-layout layout)
	      (println))))))))

(defn engine [game-loc]
  "Return an action listener to fire on the game timer and play the game."
  (let [move-if-able (move-if-able-fn)]
    (proxy [ActionListener] []
      (actionPerformed [e]
		       (let [game-image (grab-game-image game-loc)]
			 (move-if-able game-image
				       game-loc
				       board-detection-threshold
				       cell-detection-threshold))))))

(def ^{:doc "The timer that pumps the game engine."}
     timer (new Timer move-interval-ms (engine game-loc)))


;;; Some helper functions for finding the right settings for game-loc
(def ^{:doc "The primary screen"}
 screen
     (.getDefaultScreenDevice
      (GraphicsEnvironment/getLocalGraphicsEnvironment)))

(defn grab-image
  "grab a snapshot of the desktop on the primary monitor"
  []
  (let [dm (.getDisplayMode screen)]
    (.createScreenCapture robot
       (new Rectangle
	    (.getWidth dm)
	    (.getHeight dm)))))

(defn clone-image
  "clone a BufferedImage"
  [image]
  (new BufferedImage
       (.getColorModel image)
       (.copyData image nil)
       (.isAlphaPremultiplied image)
       nil))

(defn panel-to-frame
  "display the supplied JPanel in a JFrame"
  [panel]
  (doto (new JFrame)
    (.add panel)
    (.pack)
    (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
    (.show)))

(defn image-to-frame
  "Display the supplied image in a window"
  [image]
  (let [panel
	(doto (proxy [JPanel] []
		(paintComponent [g]
		       (.drawImage g image 0 0 nil)))
	  (.setPreferredSize
	   (new Dimension
		(.getWidth image)
		(.getHeight image))))]
    (panel-to-frame panel)))

(defn find-game-from-image
  "Given an image, find a game board in it. (Very slow)
   does this by considering every sub-image of the correct size
   and seeing which one looks most like a game board."
     [screen-image]
     (let [game-size (* board-size cell-size-in-pixels)]
       (apply min-key val
	      (into {}
		    (for [x (range (- (.getWidth screen-image) game-size))
			  y (range (- (.getHeight screen-image) game-size))]
		      (do ( if (zero? y) (println x))
			  [[x y] (total-discrepancy (.getSubimage screen-image x y game-size game-size))]))))))

(defn find-game []
  "Take a snapshot of the screen on the primary monitor and try and find a bejewelled game in it"
  (find-game-from-image (grab-image)))