bunch of stuff in prep for playing lines

This commit is contained in:
Thorn Avery 2019-05-20 22:51:06 +12:00
parent 3821f609ff
commit 16831a1d33
5 changed files with 86 additions and 0 deletions

View File

@ -5,6 +5,9 @@ import Types
getCardInfo :: CardSym -> CardLib -> CardInfo getCardInfo :: CardSym -> CardLib -> CardInfo
getCardInfo c cl = snd $ head $ filter (\(s, _) -> s == c) cl getCardInfo c cl = snd $ head $ filter (\(s, _) -> s == c) cl
getCardLine :: CardSym -> CardLib -> String
getCardLine c cl = '"' : ciLine (getCardInfo c cl) ++ '"'
gCardLib :: CardLib gCardLib :: CardLib
gCardLib = gCardLib =
[ (S01_Shinji, ciS01_Shinji) [ (S01_Shinji, ciS01_Shinji)

View File

@ -2,6 +2,36 @@ module Connect where
import Types import Types
import Groups import Groups
import Players
-- IDEAS
-- * Bank of bool function, boardstate affection pairs
-- One global, one per player
-- used as a list of restrictions for whether you can play a card.
-- * 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" ]
,
-- TODO
-- * manipulate the card stack after writing it
}
where
newHand = removeFromHand p l bs
-- Passes state for X to hurt Y -- Passes state for X to hurt Y
conHurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState conHurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState

36
Players.hs Normal file
View File

@ -0,0 +1,36 @@
module Players where
import Types
isInHand :: CardSym -> PlayerId -> BoardState -> Bool
isInHand c p bs = c `elem` hand
where
playerLib = (bsPlayerLib bs)
hand = snd $ getFirstMatchNS playerLib (matchSnd p)
playerName :: PlayerId -> BoardState -> BoardState
playerName p bs = getFirstMatchNS (bsPlayerLib bs) (matchSnd p)
findPlayer :: PlayerId -> BoardState -> PlayerState
findPlayer p bs
| elemSnd p pl = getFirstMatchNS pl (matchSnd p)
where
pl = (bsPlayerLib bs)
getHand :: PlayerId -> BoardState -> Hand
getHand p bs = (\(_,h,_,_) -> h) (snd $ findPlayer p bs)
getDiscard :: PlayerId -> BoardState -> Discard
getDiscard p bs = (\(_,_,_,d) -> d) (snd $ findPlayer p bs)
playerName :: PlayerId -> BoardState -> String
playerName p bs = (\(n,_,_,_) -> n) (snd $ findPlayer p bs)
removeFromHand :: PlayerId -> CardSym -> BoardState -> Hand
removeFromHand p c bs = rmFirstMatch (getHand p bs) (== c)
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)

View File

@ -5,6 +5,10 @@ data MainEva = UnitZero | UnitOne | UnitTwo deriving (Show, Eq)
data Angel = Sachiel | Shamshel | Ramiel | Gaghiel | Israfel | Sandalphon | Matariel | Sahaquiel | Ireul | Leliel | Bardiel | Zeruel | Arael | Armisael | Kaworu | Man | Lilith | Adam data Angel = Sachiel | Shamshel | Ramiel | Gaghiel | Israfel | Sandalphon | Matariel | Sahaquiel | Ireul | Leliel | Bardiel | Zeruel | Arael | Armisael | Kaworu | Man | Lilith | Adam
data CardSym = S01_Shinji | S02_Asuka | S03_Rei | S04_Misato | S05_Ritsuko | S06_Gendo deriving (Show, Eq) data CardSym = S01_Shinji | S02_Asuka | S03_Rei | S04_Misato | S05_Ritsuko | S06_Gendo deriving (Show, Eq)
-- TODO
-- * Create worker functions for the Card Stack
-- work into playing line
type CardLib = [(CardSym, CardInfo)] type CardLib = [(CardSym, CardInfo)]
type Downed = [MainCharacter] type Downed = [MainCharacter]
type PutCards = [(Either MainCharacter MainEva, CardSym)] type PutCards = [(Either MainCharacter MainEva, CardSym)]

13
Util.hs
View File

@ -1,5 +1,18 @@
module Util where module Util where
elemSnd :: a -> [(a,b)] -> Bool
elemSnd a l = any (\(x,_) -> x == a) l
matchSnd :: a -> (a,b) -> Bool
matchSnd t (a,_) = a == t
getFirstMatchNS :: [a] -> (a -> Bool) -> [a]
getFirstMatchNS l f = unwrapMaybe . (getFirstMatch l f)
unwrapMaybe :: Maybe a -> a
unwrapMaybe (Just a) = a
unwrapMaybe _ = error "Brutal Present: Unwrapped Nothing"
rmFirstMatch :: [a] -> (a -> Bool) -> [a] rmFirstMatch :: [a] -> (a -> Bool) -> [a]
rmFirstMatch [] _ = [] rmFirstMatch [] _ = []
rmFirstMatch (l:ls) f rmFirstMatch (l:ls) f