|
|
@ -9,6 +9,7 @@ module Eval ( |
|
|
|
Value (..), |
|
|
|
Card (..), |
|
|
|
cardNames, |
|
|
|
pCard, |
|
|
|
Move (..), |
|
|
|
card, |
|
|
|
initGame, |
|
|
@ -22,6 +23,9 @@ import qualified Data.Array.IO as A |
|
|
|
import System.IO.Unsafe |
|
|
|
import Data.Maybe |
|
|
|
|
|
|
|
import Text.ParserCombinators.ReadP |
|
|
|
import Data.Char |
|
|
|
|
|
|
|
type Field = (Value, Int) |
|
|
|
type Fields = A.IOArray Int Field |
|
|
|
data Player = Player { fields :: Fields } deriving (Show, Eq) |
|
|
@ -40,6 +44,7 @@ data Card = Card_I | Card_Zero | Card_Succ | Card_Dbl | Card_Get | Card_Put | Ca |
|
|
|
data Move = MoveLeft Card Int | MoveRight Int Card |
|
|
|
|
|
|
|
cardNames = [(Card_I, "I"),(Card_Zero, "zero"),( Card_Succ, "succ"),( Card_Dbl, "dbl"),( Card_Get, "get"),( Card_Put, "put"),( Card_S, "S"),( Card_K, "K"),( Card_Inc, "inc"),( Card_Dec, "dec"),( Card_Attack, "attack"),( Card_Help, "help"),( Card_Copy, "copy"),( Card_Revive, "revive"),( Card_Zombie, "zombie")] |
|
|
|
cardNamesX = map (\(a,b) -> (b,a)) cardNames |
|
|
|
|
|
|
|
instance Monad Turn where |
|
|
|
(Turn f) >>= g = Turn $ \game -> (f game >>=) $ \(game', r) -> case r of Right x -> (case g x of Turn g' -> g' game'); Left s -> return (game', Left s) |
|
|
@ -71,8 +76,24 @@ instance Show Card where |
|
|
|
show c = fromJust $ lookup c cardNames |
|
|
|
|
|
|
|
instance Show Move where |
|
|
|
show (MoveLeft c pos) = (show c) ++ " >> " ++ (show pos) |
|
|
|
show (MoveRight pos c) = (show pos) ++ " << " ++ (show c) |
|
|
|
show (MoveLeft c pos) = (show c) ++ " " ++ (show pos) |
|
|
|
show (MoveRight pos c) = (show pos) ++ " " ++ (show c) |
|
|
|
|
|
|
|
pCard :: ReadP Card |
|
|
|
pCard = do |
|
|
|
s <- many1 (satisfy isAlpha) |
|
|
|
case lookup s cardNamesX of |
|
|
|
Just c -> return c |
|
|
|
Nothing -> pfail |
|
|
|
pmPos = readS_to_P reads >>= \i -> if (i >= 0 && i <= 255) then return i else pfail |
|
|
|
|
|
|
|
pMove = skipSpaces >> ((do c <- pCard; skipSpaces; pos <- pmPos; skipSpaces; return $ MoveLeft c pos) <++ (do pos <- pmPos; skipSpaces; c <- pCard; skipSpaces; return $ MoveRight pos c)) |
|
|
|
|
|
|
|
instance Read Card where |
|
|
|
readsPrec _ = readP_to_S pCard |
|
|
|
instance Read Move where |
|
|
|
readsPrec _ = readP_to_S pMove |
|
|
|
|
|
|
|
|
|
|
|
take1 :: String -> (Value -> Turn Value) -> Value |
|
|
|
take1 name f = ValFunction name $ \v -> apply 1 >> f v |
|
|
|