From 474696d9bdc61c4f22d270c5ae81a51d40acb80b Mon Sep 17 00:00:00 2001 From: Shaun Kerr Date: Tue, 21 May 2019 11:37:03 +1200 Subject: [PATCH] compiles again, added more player stuff --- Cards.hs | 3 ++- Connect.hs | 32 ++++++++++++++------------------ Init.hs | 16 ++++++++++++++-- Players.hs | 29 ++++++++++++++++++----------- Types.hs | 8 +++++++- Util.hs | 8 ++++---- 6 files changed, 59 insertions(+), 37 deletions(-) diff --git a/Cards.hs b/Cards.hs index 324f029..723d244 100644 --- a/Cards.hs +++ b/Cards.hs @@ -1,12 +1,13 @@ module Cards where import Types +import Util getCardInfo :: CardSym -> CardLib -> CardInfo getCardInfo c cl = snd $ head $ filter (\(s, _) -> s == c) cl getCardLine :: CardSym -> CardLib -> String -getCardLine c cl = '"' : ciLine (getCardInfo c cl) ++ '"' +getCardLine c cl = '"' : (unwrapMaybe (ciLine (getCardInfo c cl))) ++ ['"'] gCardLib :: CardLib gCardLib = diff --git a/Connect.hs b/Connect.hs index 8b1d00c..f70e4fb 100644 --- a/Connect.hs +++ b/Connect.hs @@ -11,28 +11,24 @@ import Players -- * Further, make it a list of restrictions, for going in timing order. -- makes for better log messages. -conAnnounceLine :: PlayerId -> CardSym -> MainCharacter -> BoardState -> BoardState -conAnnounceLine p l t oldBoardState - | not $ PlayerId `elem` (bsPlayerLib oldBoardState) = oldBoardState - { bsGameLog = (bsGameLog oldBoardState) - ++ [ Right ("Player " ++ show PlayerId ++ " is not in the game") ] - } - | not $ isInHand l p oldBoardState = oldBoardState - { bsGameLog = (bsGameLog oldBoardState) - ++ [ Right (show CardSym ++ " is not in " ++ (playerName p) ++ "'s hand" ] - } - | otherwise = oldBoardState - { bsGameLog = (bsGameLog oldBoardState) - ++ [ Left (playerName p oldBoardState) ++ " announced " ++ (getCardLine l) ++ ", moved to active" ] - , +--conAnnounceLine :: PlayerId -> CardSym -> MainCharacter -> BoardState -> BoardState +--conAnnounceLine p l t oldBoardState +-- | not $ PlayerId `elem` (bsPlayerLib oldBoardState) = oldBoardState +-- { bsGameLog = (bsGameLog oldBoardState) +-- ++ [ Right ("Player " ++ show PlayerId ++ " is not in the game") ] +-- } +-- | not $ isInHand l p oldBoardState = oldBoardState +-- { bsGameLog = (bsGameLog oldBoardState) +-- ++ [ Right (show CardSym ++ " is not in " ++ (playerName p) ++ "'s hand" ] +-- } +-- | otherwise = oldBoardState +-- { bsGameLog = (bsGameLog oldBoardState) +-- ++ [ Left (playerName p oldBoardState) ++ " announced " ++ (getCardLine l) ++ ", moved to active" ] +-- , -- TODO -- * manipulate the card stack after writing it - } - where - newHand = removeFromHand p l bs - -- Passes state for X to hurt Y conHurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState conHurt charX charY oldBoardState diff --git a/Init.hs b/Init.hs index ef12b1d..22b0780 100644 --- a/Init.hs +++ b/Init.hs @@ -13,8 +13,20 @@ initBS = BoardState , ntDowned = [] } , bsPlayerLib = - [ (1, ("tA", [ S02_Asuka, S02_Asuka, S01_Shinji ], [], [])) - , (2, ("lunarised", [ S03_Rei, S03_Rei, S01_Shinji, S05_Ritsuko ], [], [])) + [ (1, PlayerState + { psPlayerName = "tA" + , psHand = [ S02_Asuka, S02_Asuka, S01_Shinji, S04_Misato, S05_Ritsuko, S05_Ritsuko ] + , psDeck = [ S02_Asuka, S01_Shinji, S06_Gendo ] + , psDiscard = [ S02_Asuka ] + , psDP = 0 + }) + , (2, PlayerState + { psPlayerName = "lunarised" + , psHand = [ S03_Rei, S03_Rei, S01_Shinji, S04_Misato, S06_Gendo, S06_Gendo ] + , psDeck = [ S03_Rei, S01_Shinji, S06_Gendo ] + , psDiscard = [ S03_Rei ] + , psDP = 0 + }) ] , bsActivePlayers = [1,2] , bsPriorityPlayer = 1 diff --git a/Players.hs b/Players.hs index 1a047da..cc752d0 100644 --- a/Players.hs +++ b/Players.hs @@ -1,30 +1,27 @@ module Players where import Types +import Util isInHand :: CardSym -> PlayerId -> BoardState -> Bool -isInHand c p bs = c `elem` hand +isInHand c p bs = c `elem` (psHand player) where playerLib = (bsPlayerLib bs) - hand = snd $ getFirstMatchNS playerLib (matchSnd p) - -playerName :: PlayerId -> BoardState -> BoardState -playerName p bs = getFirstMatchNS (bsPlayerLib bs) (matchSnd p) + player = snd $ getFirstMatchNS playerLib (matchSnd p) findPlayer :: PlayerId -> BoardState -> PlayerState -findPlayer p bs - | elemSnd p pl = getFirstMatchNS pl (matchSnd p) +findPlayer p bs = snd $ getFirstMatchNS pl (matchSnd p) where pl = (bsPlayerLib bs) getHand :: PlayerId -> BoardState -> Hand -getHand p bs = (\(_,h,_,_) -> h) (snd $ findPlayer p bs) +getHand p bs = psHand (findPlayer p bs) getDiscard :: PlayerId -> BoardState -> Discard -getDiscard p bs = (\(_,_,_,d) -> d) (snd $ findPlayer p bs) +getDiscard p bs = psDiscard (findPlayer p bs) playerName :: PlayerId -> BoardState -> String -playerName p bs = (\(n,_,_,_) -> n) (snd $ findPlayer p bs) +playerName p bs = psPlayerName (findPlayer p bs) removeFromHand :: PlayerId -> CardSym -> BoardState -> Hand removeFromHand p c bs = rmFirstMatch (getHand p bs) (== c) @@ -33,4 +30,14 @@ addToDiscard :: PlayerId -> CardSym -> BoardState -> Discard addToDiscard p c bs = c : (getDiscard p bs) handToDiscard :: PlayerId -> CardSym -> BoardState -> PlayerState -handToDiscard p c bs = (\(n,h,d,dis) -> (n,(addToHand c),d,(addToDiscard d))) (findPlayer p bs) +handToDiscard p c bs = ps + { psHand = removeFromHand p c bs + , psDiscard = addToDiscard p c bs + } + where + ps = (findPlayer p bs) + +adjustDP :: PlayerId -> Integer -> BoardState -> PlayerState +adjustDP p i bs = ps { psDP = (psDP ps) + i } + where + ps = (findPlayer p bs) diff --git a/Types.hs b/Types.hs index 85b0541..1301e95 100644 --- a/Types.hs +++ b/Types.hs @@ -38,7 +38,13 @@ type PlayerLib = [(PlayerId, PlayerState)] type ActivePlayers = [PlayerId] type PriorityPlayer = PlayerId type PlayerId = Integer -type PlayerState = (PlayerName, Hand, Deck, Discard) +data PlayerState = PlayerState + { psPlayerName :: PlayerName + , psHand :: Hand + , psDeck :: Deck + , psDiscard :: Discard + , psDP :: Integer + } deriving (Show, Eq) type PlayerName = String type Hand = [CardSym] type Deck = [CardSym] diff --git a/Util.hs b/Util.hs index 448a616..1dbbfc5 100644 --- a/Util.hs +++ b/Util.hs @@ -1,13 +1,13 @@ module Util where -elemSnd :: a -> [(a,b)] -> Bool +elemSnd :: (Eq a) => a -> [(a,b)] -> Bool elemSnd a l = any (\(x,_) -> x == a) l -matchSnd :: a -> (a,b) -> Bool +matchSnd :: (Eq a) => a -> (a,b) -> Bool matchSnd t (a,_) = a == t -getFirstMatchNS :: [a] -> (a -> Bool) -> [a] -getFirstMatchNS l f = unwrapMaybe . (getFirstMatch l f) +getFirstMatchNS :: [a] -> (a -> Bool) -> a +getFirstMatchNS l f = unwrapMaybe (getFirstMatch l f) unwrapMaybe :: Maybe a -> a unwrapMaybe (Just a) = a