(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))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment