haskell-spacegoo 0.1 → 0.2

raw patch · 2 files changed

+137/−17 lines, 2 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Game/Spacegoo.hs +134/−14
• haskell-spacegoo.cabal +3/−3

@@ -9,6 +9,8 @@  module Game.Spacegoo (     -- * The state+    PlayerId(..),+    Round(..),     Units(..),     Coord(..),     Player(..),@@ -20,6 +22,19 @@     Strategy(..),     -- * Writing clients     client,+    -- * Utilities+    -- Convenience functions for working with the state+    me,+    he,+    opponentName,+    battle,+    winsAgainst,+    distance,+    hasMore,+    ownerAt,+    linInt,+    nemesisOf,+    minimizeUnits,     -- * Example strategies     -- These are some simple strategies, for demonstration purposes.     nop,@@ -28,6 +43,8 @@     intercept,     ) where +import Data.List (sortBy)+import Data.Ord import Data.Monoid import qualified Data.Text as T import qualified Data.Text.IO as T@@ -56,7 +73,7 @@  data Player = Player     { itsme :: Bool-    , playerId :: Int+    , playerId :: PlayerId     , name :: Text     }     deriving Show@@ -67,13 +84,21 @@                <*> v .: "id"                <*> v .: "name" +-- | The player (0,1 or 2)+type PlayerId = Int++-- | A Round count+type Round = Int+ -- | A position on the map type Coord = (Int, Int)  -- | Units, either on a planet, on a fleet, or as a production indication. type Units = (Int, Int, Int) +type FUnits = (Double, Double, Double) + fleetFromVector :: Monad m => V.Vector Int -> m Units fleetFromVector v | V.length v /= 3 = fail "Wrong number of elements in array"                   | otherwise       = return (v V.! 0, v V.! 1, v V.! 2)@@ -81,7 +106,7 @@  data Fleet = Fleet     { fleetId :: Int-    , fleetOwner :: Int+    , fleetOwner :: PlayerId     , origin :: Int     , target :: Int     , fleetShips :: Units@@ -101,7 +126,7 @@ data Planet = Planet     { planetId :: Int     , position :: Coord-    , planetOwner :: Int+    , planetOwner :: PlayerId     , production :: Units     , planetShips :: Units     } @@ -117,8 +142,8 @@  data State = State      { gameOver :: Bool-    , round :: Int-    , maxRounds :: Int+    , currentRound :: Round+    , maxRounds :: Round     , players :: [Player]     , fleets :: [Fleet]     , planets :: [Planet]@@ -159,6 +184,7 @@             $= C.decode C.utf8             $= C.lines             $= C.encode C.utf8+            $= disconnect             $= parseState              -- not $= logState             $= C.iterM (putStrLn . stateSummary)@@ -171,13 +197,19 @@             =$= C.iterM (F.mapM_ putStrLn . moveSummary)             =$= C.map serializeMove -nopClient =  client 6000 "spacegoo.rent-a-geek.de" "foo" "bar" (const Nothing)- logState :: Conduit State IO State logState = awaitForever $ \s -> do     liftIO $ putStrLn (render (ppDoc s))     yield s +disconnect :: Conduit ByteString IO ByteString+disconnect = do +    v <- await+    F.forM_ v $ \s ->+        unless (s == "game is over. please disconnect") $ do+            yield s+            disconnect+ parseState :: Conduit ByteString IO State parseState = do     awaitForever $ \line ->@@ -196,13 +228,13 @@      stateSummary :: State -> String stateSummary State{..} =-    printf "[Round %3d/%3d]" round maxRounds+    printf "[Round %3d/%3d]" currentRound maxRounds     ++ " We: " ++ statsFor me ++ " He: " ++ statsFor he ++ " Neutral: " ++ statsFor 0   where     Just me = playerId <$> find itsme players     he = 3 - me     statsFor i = printf  "%2dp" (length ps) ++-                 printf " %5dp" (sum (map (unitSum . planetShips) ps) + +                 printf " %5ds" (sum (map (unitSum . planetShips) ps) +                                  sum (map (unitSum . fleetShips) fs)) ++                  (if i == 0 then "" else printf " %2df" (length fs))       where ps = filter (\p -> planetOwner p == i) planets@@ -227,7 +259,7 @@ sendSomewhere (State {..}) = do     me <- playerId <$> find itsme players     let he = 3 - me-    aPlanet <- find (\p -> planetOwner p == me) planets+    aPlanet <- find (\p -> planetOwner p == me && planetShips p /= (0,0,0)) planets     otherPlanet <- find (\p -> planetOwner p == he) planets     return (planetId aPlanet, planetId otherPlanet, planetShips aPlanet) @@ -255,17 +287,105 @@         msum $ flip map planets $ \p -> do             guard $ planetOwner p == me             guard $ planetShips p `hasMore` fleetShips f-            guard $ round + distance p t - eta f `elem` [0,1,2]+            guard $ currentRound + distance p t - eta f `elem` [1,2]             return $ (planetId p, planetId t, fleetShips f) +-- | Whether the first player has at least as many ships as the other hasMore :: Units -> Units -> Bool hasMore (a,b,c) (a',b',c') = a >= a && b >= b' && c >= c'-        + float2 :: (Int, Int) -> (Double, Double) float2 (a,b) = (fromIntegral a, fromIntegral b) -float3 :: (Int, Int, Int) -> (Double, Double, Double)-float3 (a,b,c) = (fromIntegral a, fromIntegral b, fromIntegral c)+map3 :: (a->b) -> (a,a,a) -> (b,b,b)+map3 f (a,b,c) = (f a, f b, f c) +float3 :: Units -> FUnits+float3 = map3 fromIntegral++floor3 :: FUnits -> Units+floor3 = map3 floor++nonneg3:: FUnits -> FUnits+nonneg3 = map3 (max 0)+ distance :: Planet -> Planet -> Int distance p1 p2 = ceiling (magnitude (float2 (position p1 ^-^ position p2)))++linInt :: Double -> Units -> Units -> Units+linInt f u1 u2 = floor3 (lerp (float3 u1) (float3 u2) f)++-- | My id+me :: State -> Int+me s = fromJust $ playerId <$> find itsme (players s)++-- | The other players id+he :: State -> Int+he s = 3 - me s ++-- | The opponent's name; to filter out known bad opponents+opponentName :: State -> Text+opponentName s = fromJust $ +    name <$> find (not . itsme) (players s)++damage :: FUnits -> FUnits+damage (a,b,c)  = ( 0.25 * c + (if c > 0 then 2 else 0)+                  + 0.1  * a + (if a > 0 then 1 else 0) +                  + 0.01 * b + (if b > 0 then 1 else 0) +                  , 0.25 * a + (if a > 0 then 2 else 0)+                  + 0.1  * b + (if b > 0 then 1 else 0) +                  + 0.01 * c + (if c > 0 then 1 else 0) +                  , 0.25 * b + (if b > 0 then 2 else 0)+                  + 0.1  * c + (if c > 0 then 1 else 0) +                  + 0.01 * a + (if a > 0 then 1 else 0) +                  ) ++oneRound :: FUnits -> FUnits -> FUnits+oneRound att def = nonneg3 $ def ^-^ damage att++-- | Whether the first argument wins against the second, and how many ships are+-- left+battle :: Units -> Units -> (Bool, Units)+battle att def = go (float3 att) (float3 def)+    where go a d | magnitude a <= 1e-5 = (False, floor3 d)+                 | magnitude d <= 1e-5 = (True, floor3 a)+                 | otherwise = go (oneRound d a) (oneRound a d)++-- | Whether the first fleet wins against the second (defaulting to the second)+winsAgainst :: Units -> Units -> Bool+winsAgainst att def = fst (battle att def)+++-- | Predict the owner and strength of the planet at the given round+ownerAt :: State -> Int -> Round ->  (PlayerId, Units) +ownerAt s i round = go (currentRound s, planetOwner p, planetShips p) $+    sortBy (comparing eta) $+    filter (\f -> target f == i) $+    filter (\f -> eta f <= round) $+    fleets s+  where+    go (r, o, ships) [] = (o, produce o ships (round - r))+    go (r, o, ships) (f:fs)+        | fleetOwner f == o+        = go (eta f, o, produce o ships (eta f - r) ^+^ fleetShips f) fs+        | fleetOwner f /= o+        = case battle (fleetShips f) (produce o ships (eta f - r)) of+            (True, rest) ->  go (eta f, fleetOwner f, rest) fs+            (False, rest) -> go (eta f, o, rest) fs+    Just p = find (\p -> planetId p == i) (planets s)+    produce 0 ships _ = ships  +    produce _ ships n = ships ^+^ n *^ production p++nemesisOf :: Units -> Units+nemesisOf (a,b,c) = (b,c,a)+++-- If the attacker wins against the defender, try to find a subset that also wins.+minimizeUnits :: Units -> Units -> Units+minimizeUnits a d = go a a +  where+    go last a = case battle a d of+                    (True, r)  -> let r' = map3 (`div` 3) (a ^-^ r)+                                  in if r' /= (0,0,0) then go a (a ^-^ r') else a+                    (False, _) -> last+

@@ -1,9 +1,9 @@ name:                haskell-spacegoo-version:             0.1+version:             0.2 synopsis:            Client API for Rocket Scissor Spacegoo description:         Using this package you can quickly create code to take                      part in a game of Rocket Scissor Spacegoo; see-                     <http://spacegoo.rent-a-geek.de/> for more details on the+                     <https://bitbucket.org/dividuum/rocket-scissor-spacegoo> for more details on the                      game. license:             MIT license-file:        LICENSE@@ -18,7 +18,7 @@   exposed-modules:              Game.Spacegoo   build-depends:-        base ==4.6.*+        base == 4.*         , vector         , pretty         , pretty-show