some docs

README.md

@@ -1,4 +1,34 @@
 OpenAlchemistAI
 ===============
 
-An AI for the game OpenAlchemist (http://www.openalchemist.com/)
+An AI for the game OpenAlchemist (http://www.openalchemist.com/)
+
+What does it do
+---------------
+
+Hopefully, play OpenAlchemist on its own, at least the "thinking part", even if it still requires you to move the objects yourself with your keyboard.
+The goal is to have an AI that can calculate the best moves and do better than my poor brain.
+
+How to use it
+-------------
+
+Run the executable while your new game of OpenAlchemist is open and visible on your desktop. It will give you the best move it thinks you should play, in the form of a tuple of Tile,Column, where Column starts at 0.
+
+How does it work
+----------------
+
+For the moment, it doesn't use any API from OpenAlchemist since it looked like everything was C++. So it capture the window where the game is running, tries to "see" what the game is, what the next
+objects to play are, and then calculate the best move.
+The best move is calculated taking into account the current state of the game, the two objects that have to be played, and the two objects that will come afterwards.
+
+Code organization
+-----------------
+
+There are three source folders:
+
+* exe: the executable entry point
+* src: the main source code
+	+ Game is the game handling (resolve object collapse and such) and AI code
+	+ Types contains the type definitions
+	+ Vision performs the capturing and detection of shapes 
+* test: contains the unit tests

exe/Main.hs

@@ -1,28 +1,31 @@
+-- | The executable entry point
 module Main where
 
 import Games.OpenAlchemist.AI.Game
 import Games.OpenAlchemist.AI.Vision
 import Games.OpenAlchemist.AI.Types
 
+-- | entry point
 main::IO()
 main = do
-        IconFingerPrint smallMM bigMM<-getIconFingerPrint
-        mpcis<-getGamePicture
+        IconFingerPrint smallMM bigMM<-getIconFingerPrint -- get icons fingerprint
+        mpcis<-getGamePicture -- capture picture of game
         case mpcis of
                  Nothing -> return ()
                  Just (preview,toplay,existing)->do
-                        let smallFound=find smallMM preview
+                        -- debugging
+                        let smallFound=find smallMM preview -- see what shapes are in the preview
                         print smallFound
-                        let bigFound1=find bigMM toplay
+                        let bigFound1=find bigMM toplay -- see what shapes are there to play
                         print bigFound1
-                        let bigFound2=find bigMM existing
+                        let bigFound2=find bigMM existing -- see the existing state of the game
                         print bigFound2
-                        let previewTiles=findTiles smallMM preview
+                        let previewTiles=findTiles smallMM preview -- get the preview tiles
                         print previewTiles
-                        let toPlayTiles=findTiles bigMM toplay
+                        let toPlayTiles=findTiles bigMM toplay -- get the current tiles
                         print toPlayTiles
-                        let game=readGame bigMM existing
+                        let game=readGame bigMM existing -- get the game
                         print game
-                        let advice=bestOn2 game toPlayTiles previewTiles
+                        let advice=bestOn2 game toPlayTiles previewTiles -- calculate best move
                         print advice
                         return()

src/Games/OpenAlchemist/AI/Game.hs

@@ -1,14 +1,13 @@
-
+-- | Game mechanics and AI
 module Games.OpenAlchemist.AI.Game where
 
 import Games.OpenAlchemist.AI.Types
 
-import Data.Ord
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.List (sortBy)
 
-import Debug.Trace
+-- import Debug.Trace
 
 maxWidth :: Int
 maxWidth = 6
@@ -19,6 +18,7 @@ maxHeight = 7
 multiForResolution :: Int
 multiForResolution = 3
 
+-- | is the game valid (no tile outside of limits)
 gameValid :: Tiles -> Bool
 gameValid =M.foldrWithKey f True
         where
@@ -29,9 +29,10 @@ gameValid =M.foldrWithKey f True
                         | y<0 || y>=maxHeight=False
                         | otherwise=True
 
-dropBall :: Tiles -> Tile -> Int -> Tiles
-dropBall ms m col=let
-        pos=[(col,-y) | y<- [-(maxHeight+1) .. 0]] -- allow two balls over top
+-- | drop a tile in a given column
+dropTile :: Tiles -> Tile -> Int -> Tiles
+dropTile ms m col=let
+        pos=[(col,-y) | y<- [-(maxHeight+1) .. 0]] -- allow two tiles over top
         in fst $ foldr f (ms,False) pos
         where 
                 f :: Coord -> (Tiles,Bool) -> (Tiles,Bool)
@@ -42,56 +43,63 @@ dropBall ms m col=let
                                 Nothing->(M.insert c m ms2,True)
                                 Just _ -> (ms2,False)
 
+-- | all possible drop positions
 dropPositions :: (Tile,Tile) -> [DropPosition]
 dropPositions (m1,m2)=[((m1,x),(m2,x+1)) | x <- [0..maxWidth-2]] -- m1 and m2, horizontal
         ++ [((m2,x),(m1,x+1)) | x <- [0..maxWidth-2]] -- m2 and m1, horizontal
         ++ [((m1,x),(m2,x)) | x <- [0..maxWidth-1]] -- m1 and m2 on same column, m1 on bottom
         ++ [((m2,x),(m1,x)) | x <- [0..maxWidth-1]] -- m1 and m2 on same column, m2 on bottom
-
+
+-- | all results from all drops        
 allDropResults :: Tiles -> (Tile,Tile) -> [(Tiles,DropPosition)]
 allDropResults ts ds=let
         dps=dropPositions ds
         in map f dps     
         where
                 f :: DropPosition -> (Tiles,DropPosition)
-                f pos@((t1,col1),(t2,col2))=(dropBall (dropBall ts t1 col1) t2 col2,pos)
-
+                f pos@((t1,col1),(t2,col2))=(dropTile (dropTile ts t1 col1) t2 col2,pos)
+
+-- | best move only taking into account the two tiles to play        
 bestOn1 ::   Tiles -> (Tile,Tile) ->  DropPosition
 bestOn1 ts ds=let
         drs=allDropResults ts ds
         res= map applyDropPosition drs
         --res2=trace (show res) res
         in fst $ head $ sortBy compDropPositions res
 
+-- | best move taking into acocunt the two tiles to play and the two preview tiles
 bestOn2 ::   Tiles -> (Tile,Tile) -> (Tile,Tile) ->  DropPosition
 bestOn2 ts ds1 ds2=let
         drs1=allDropResults ts ds1
         drs2=concatMap (\(ts1,dp)->map (\x->(fst x,dp)) $
                 allDropResults ts1 ds2) drs1
         res= map applyDropPosition drs2
-        res2=trace (show res) res
-        in fst $ head $ sortBy compDropPositions res2
+        --res2=trace (show res) res
+        in fst $ head $ sortBy compDropPositions res
 
+-- | drop the tiles as indicated in the position, return the position and the score of the final, resolved game state
 applyDropPosition :: (Tiles,DropPosition) -> (DropPosition,Int)
 applyDropPosition (ts1,pos)=let
                         (ts2,sc1)=resolve ts1
                         in (pos,if gameValid ts2 then sc1 else (-1))            
-
+
+-- | order positions by suitability (better first)              
 compDropPositions :: (DropPosition,Int) -> (DropPosition,Int) -> Ordering
 compDropPositions (dp1,sc1) (dp2,sc2)  
         | sc1 /= sc2=compare sc2 sc1
         | (snd $ fst dp1) /= (snd $ fst dp2)=compare (snd $ fst dp1) (snd $ fst dp2)
         | (snd $ snd dp1) /= (snd $ snd dp2)=compare (snd $ snd dp1) (snd $ snd dp2)  
         | otherwise=compare (fst $ fst dp2)  (fst $ fst dp1) 
-
+
+-- | resolve all groups of tiles and return the resolved tiles and the score        
 resolve :: Tiles -> (Tiles,Score)
 resolve ts=let (ts2,sc1)=resolve1 ts 
         in if ts==ts2
                 then (ts2,sc1)
                 else let (ts3,sc2)=resolve ts2
                      in (ts3,sc1+sc2)
 
-
+-- | one step resolve
 resolve1 :: Tiles -> (Tiles,Score)
 resolve1 ts=let
         (grps,_)= foldr fg ([],S.empty) $ M.keys ts
@@ -120,7 +128,8 @@ resolve1 ts=let
                                                 else ts1
                                         in (ts2,sc1+(mul * (tileScore t ) * (M.size grp)))
                                 Nothing ->(ts1,sc1)
-
+
+-- | find the group starting from the given coordinates: all tiles of the same nature, reachable horizontally and vertically                                
 findGroup :: Tiles -> Coord -> Tiles
 findGroup ts c = 
         let 
@@ -132,6 +141,7 @@ findGroup ts c =
                         ns=neighbourCoords c
                         in foldr (addGroup ts t) grp ns 
 
+-- | add a tile to a group and continue
 addGroup :: Tiles -> Tile -> Coord -> Tiles  -> Tiles
 addGroup tsFull t1 c grp   
         | M.notMember c grp =
@@ -145,10 +155,12 @@ addGroup tsFull t1 c grp
                                         in foldr (addGroup tsFull t1) grp2 ns 
                                 _ -> grp
         | otherwise = grp
-
+
+-- | all neighbours coordinates        
 neighbourCoords :: Coord -> [Coord]
 neighbourCoords (x,y)=[(x-1,y),(x+1,y),(x,y-1),(x,y+1)]
 
+-- | the coordinate of the new tile when a group has been resolved
 resolutionCoord :: Tiles -> Coord
 resolutionCoord ts = foldr f (maxWidth,maxHeight) $ M.keys ts
         where 
@@ -159,6 +171,7 @@ resolutionCoord ts = foldr f (maxWidth,maxHeight) $ M.keys ts
                                 then (x,y)   
                                 else (minx,miny)
 
+-- | tile score
 tileScore :: Tile -> Int
 tileScore Green=1
 tileScore Yellow=3

src/Games/OpenAlchemist/AI/Types.hs

@@ -1,8 +1,9 @@
-
+-- | Types
 module Games.OpenAlchemist.AI.Types where
 
 import qualified Data.Map as M
 
+-- | Represents a Pixel with red green blue and alpha
 data Pixel = Pixel {
         r :: Int,
         g :: Int,
@@ -11,36 +12,48 @@ data Pixel = Pixel {
         }  
         deriving (Eq,Read,Show,Ord)
 
+-- | Coordinates
 type Coord = (Int,Int)
 
+-- | simple representation of an image: a map of coordinates to Pixel
 type PMap=M.Map Coord Pixel
 
+-- | image: size + pixel map
 data PMapInfo=PMapInfo Coord PMap
         deriving (Eq,Read,Show,Ord)
 
+-- | each pixel associated with the number of pixel in that image        
 type Histo=M.Map Pixel Int
 
+-- | simple representation of a "undersood" game: a map of coordinates to Tiles
 type Tiles=M.Map Coord Tile
 
+-- | Score for moves
 type Score=Int
 
+-- | where to drop the two tiles: tile and column
 type DropPosition=((Tile,Int),(Tile,Int))
 
+-- | a tile represents a distinct shape
 data Tile= Green | Yellow | Red | Purple | Cherries | Penguin | Cheese | Cow
        deriving (Eq,Read,Show,Enum,Bounded,Ord) 
 
+-- | a Marker represents detection information for a Tile: a Pixel value, and how much before and after the pixel should be ignored to avoid detecting the same shape twice
 data Marker = Marker Pixel Coord Coord
          deriving (Eq,Read,Show,Ord)
 
+-- | finger prints for icons: holds the pixels that identify a tile, for both small icons (preview) and big         
 data IconFingerPrint = IconFingerPrint {
         smalls ::  M.Map Pixel (Tile,Marker),
         bigs :: M.Map Pixel (Tile,Marker)
         }
         deriving (Eq,Read,Show,Ord)
 
+-- | the full game state        
 data GameState = GameState {
-        preview :: (Tile,Tile),
-        next :: (Tile,Tile),
-        existing :: Tiles
+        preview :: (Tile,Tile), -- preview tiles
+        next :: (Tile,Tile), -- current tiles to play
+        existing :: Tiles -- existing tiles
         }        
-        deriving (Eq,Read,Show,Ord)
+        deriving (Eq,Read,Show,Ord)
+

src/Games/OpenAlchemist/AI/Vision.hs

@@ -1,4 +1,5 @@
-
+-- | Capture game window and detect shapes
+-- This could probably be enhanced by somebody who has studied the problem, instead of just me hacking around!
 module Games.OpenAlchemist.AI.Vision where
 
 import Games.OpenAlchemist.AI.Types

test/Games/OpenAlchemist/AI/GameTests.hs

@@ -42,10 +42,10 @@ testDrop = TestLabel "testDrop" (TestCase (
         do
         let empty=M.empty
         let zero=M.insert (0,0) Green empty
-        assertEqual "empty + Green !=zero" zero (dropBall empty Green 0)
+        assertEqual "empty + Green !=zero" zero (dropTile empty Green 0)
         let full0=M.fromList $ map (\y-> ((0,y),Green)) [0 .. maxHeight-1]
         let invalid0=M.fromList $ map (\y-> ((0,y),Green)) [0 .. maxHeight]
-        assertEqual "full0 + Green !=invalid0" invalid0 (dropBall full0 Green 0)
+        assertEqual "full0 + Green !=invalid0" invalid0 (dropTile full0 Green 0)
         ))    
 
 testFindGroups     :: Test

test/Main.hs

@@ -1,4 +1,4 @@
-
+-- | test entry point
 module Main where
 
 import Games.OpenAlchemist.AI.GameTests