bunch of stuff in prep for playing lines
This commit is contained in:
parent
3821f609ff
commit
16831a1d33
3
Cards.hs
3
Cards.hs
@ -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)
|
||||||
|
30
Connect.hs
30
Connect.hs
@ -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
36
Players.hs
Normal 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)
|
4
Types.hs
4
Types.hs
@ -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
13
Util.hs
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user