Browse Source

finished MonadicGame.hs

threadPool
Andrea Bellandi 9 years ago
parent
commit
48a433716a
2 changed files with 80 additions and 9 deletions
  1. BIN
      doc/paper.pdf
  2. +80
    -9
      src/MonadicGame.hs

BIN
doc/paper.pdf View File


+ 80
- 9
src/MonadicGame.hs View File

@ -1,13 +1,13 @@
{-# OPTIONS -Wall #-} {-# OPTIONS -Wall #-}
module MonadicGame(executeGame, move, moves, readScore, readNote) where
module MonadicGame(executeGame, move, moves, readScore, readNote, getBestMovesFromHere, saveGame, loadGame, deleteSavedGame, deleteAllSaved, loadFromGame, executeStepCommands, retrieveGameData) where
import Control.Applicative import Control.Applicative
import qualified Data.HashMap as M
import Data.Maybe
import Datatypes.Game import Datatypes.Game
import VM import VM
data MonadicGameInternal = MonadicGameInternal { igame :: Game , inote :: Notes}
data MonadicGameInternal = MonadicGameInternal { igame :: Game , inote :: Notes, isaves :: M.Map String (Game,Notes) }
data MonadicGame a = MonadicAction {action :: (MonadicGameInternal -> (MonadicGameInternal, a))} data MonadicGame a = MonadicAction {action :: (MonadicGameInternal -> (MonadicGameInternal, a))}
@ -50,22 +50,40 @@ readGame readFunction = modifyGame (\_ x -> (x, readFunction x)) ()
writeGame :: (a -> MonadicGameInternal -> MonadicGameInternal) -> a -> MonadicGame () writeGame :: (a -> MonadicGameInternal -> MonadicGameInternal) -> a -> MonadicGame ()
writeGame writeFunction = modifyGame (\x y -> (writeFunction x y, ())) writeGame writeFunction = modifyGame (\x y -> (writeFunction x y, ()))
------ Public Functions -----
-----------------------------
------ Public Functions -----
-- Apply the monad to a Game
-- Apply the monad to a Game, return the list of command to execute and the score
executeGame :: Game -> MonadicGame () -> ([Command], Int) executeGame :: Game -> MonadicGame () -> ([Command], Int)
executeGame game (MonadicAction finalFunction) = (history executedGame, score executedGame)
executeGame game (MonadicAction actions) = (history executedGame, score executedGame)
where where
executedGame = (igame . fst . finalFunction) (MonadicGameInternal{igame = game, inote = OK})
executedGame = (igame . fst . actions) (MonadicGameInternal{igame = game, inote = OK, isaves = M.empty})
loadFromGame :: Game -> MonadicGameInternal
loadFromGame game = (MonadicGameInternal{igame = game, inote = OK, isaves = M.empty})
executeStepCommands :: MonadicGame () -> MonadicGameInternal -> MonadicGameInternal
executeStepCommands (MonadicAction actions) game = newGame
where
newGame = (fst . actions) game
retrieveGameData :: MonadicGameInternal -> ([Command],Int)
retrieveGameData game = bestData
where
bestData = M.fold findBestFun initData (isaves game)
initData = ((history . igame) game, (score . igame) game)
findBestFun procEl (bestHist,bestScore) = if bestScore > (score . fst) procEl
then (bestHist,bestScore)
else (bestHist,bestScore)
-- Execute a command -- Execute a command
move :: Command -> MonadicGame () move :: Command -> MonadicGame ()
move command = writeGame applyMove command move command = writeGame applyMove command
where where
applyMove param oldGameInternal = newInternals applyMove param oldGameInternal = newInternals
where where
newInternals = MonadicGameInternal {igame = newIgame, inote = newInote}
newInternals = oldGameInternal{igame = newIgame, inote = newInote}
newIgame = fst $ step (igame oldGameInternal) param newIgame = fst $ step (igame oldGameInternal) param
newInote = snd $ step (igame oldGameInternal) param newInote = snd $ step (igame oldGameInternal) param
@ -81,4 +99,57 @@ readScore = readGame (score . igame)
readNote :: MonadicGame Notes readNote :: MonadicGame Notes
readNote = readGame inote readNote = readGame inote
getBestMovesFromHere :: [MonadicGame ()] -> MonadicGame ()
getBestMovesFromHere [] = return ()
getBestMovesFromHere movesArr = writeGame bestGameFun movesArr
where
bestGameFun param oldGameInternal = bestBranch
where
bestBranch = foldl maxBranch oldGameInternal gameBranches
gameBranches = map (\x -> (fst . (action x)) oldGameInternal) param
maxBranch oldMax actualBranch = if (score . igame $ oldMax) > (score . igame $ actualBranch)
then oldMax
else actualBranch
saveGame :: String -> MonadicGame ()
saveGame saveStr = writeGame saveGameFun saveStr
where
saveGameFun param oldGameInternal = savedGameInternal
where
savedGameInternal = oldGameInternal{isaves = (M.insert param (actualIgame,actualNote) actualIsaves)}
actualIsaves = isaves oldGameInternal
actualIgame = igame oldGameInternal
actualNote = inote oldGameInternal
loadGame :: String -> MonadicGame Bool
loadGame loadStr = modifyGame loadGameFun loadStr
where
loadGameFun param oldGameInternal = (loadedGameInternal, loaded)
where
lookupResult = M.lookup param (isaves oldGameInternal)
(loadedGame, loadedNote, loaded) = if isJust lookupResult
then (fst $ fromJust lookupResult,snd $ fromJust lookupResult, True)
else (igame oldGameInternal, inote oldGameInternal, False)
loadedGameInternal = oldGameInternal{igame = loadedGame, inote = loadedNote}
deleteSavedGame :: String -> MonadicGame Bool
deleteSavedGame delStr = modifyGame deleteSavedGameFun delStr
where
deleteSavedGameFun param oldGameInternal = (deletedSavedGameInternal, deleted)
where
oldGameISaved = isaves oldGameInternal
deleted = M.member param oldGameISaved
deletedSavedGameInternal = if deleted
then oldGameInternal{isaves = (M.delete param oldGameISaved)}
else oldGameInternal
deleteAllSaved :: MonadicGame ()
deleteAllSaved = writeGame deleteAllSavedGameFun ()
where
deleteAllSavedGameFun _ oldGameInternal = deletedAllSavedGameInternal
where
deletedAllSavedGameInternal = oldGameInternal{isaves = M.empty}
----------------------------- -----------------------------

Loading…
Cancel
Save