only State.hs matters
This commit is contained in:
parent
d0ba175a9f
commit
fe97ea1432
187
Cards.hs
Normal file
187
Cards.hs
Normal file
@ -0,0 +1,187 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
data CardSym = StartShinji1 | StartUnitTwo1 | StopIt | SomethingLikeThis | ProgKnife | Maya | Adam | InstShinji1a | InstShinji1b deriving (Show)
|
||||
data TypeSym = Angel
|
||||
| Character
|
||||
| MainCharacter
|
||||
| Instrumentality
|
||||
| Battle
|
||||
| Put
|
||||
| Drama
|
||||
| Eva deriving (Show)
|
||||
|
||||
data Faction = Blue | Red | White | Green | Yellow | Black | Purple deriving (Show)
|
||||
data Mark = Circle | Triangle deriving (Show)
|
||||
type LineMark = (Mark, Faction)
|
||||
type LineMarks = [LineMark]
|
||||
data Trait = Reaction | Other | Male | Female | Weapon deriving (Show)
|
||||
type Traits = [Trait]
|
||||
|
||||
instShinji1a = CardInfo
|
||||
{ ciName = "3rd Child - Shinji Ikari"
|
||||
, ciFaction = Blue
|
||||
, ciDP = Nothing
|
||||
, ciType = Instrumentality
|
||||
, ciLineMarks = Nothing
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Nothing
|
||||
, ciText = "Asuka is down."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Just 1
|
||||
, ciNextInst = Just InstShinji1b
|
||||
}
|
||||
|
||||
instShinji1b = CardInfo
|
||||
{ ciName = "I'm such a loser..."
|
||||
, ciFaction = Blue
|
||||
, ciDP = Nothing
|
||||
, ciType = Instrumentality
|
||||
, ciLineMarks = Nothing
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Nothing
|
||||
, ciText = "All main characters other than Shinji and Asuka are down."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Just 2
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
adam = CardInfo
|
||||
{ ciName = "The 1st Angel - Adam"
|
||||
, ciFaction = Purple
|
||||
, ciDP = Nothing
|
||||
, ciType = Angel
|
||||
, ciLineMarks = Nothing
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Nothing
|
||||
, ciText = "When Adam is defeated, discard all Put cards in Neo-Tokyo."
|
||||
, ciStrength = Just 3
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
maya = CardInfo
|
||||
{ ciName = "Maya Ibuki"
|
||||
, ciFaction = Yellow
|
||||
, ciDP = Just 1
|
||||
, ciType = Character
|
||||
, ciLineMarks = Just [(Circle, Yellow)]
|
||||
, ciTraits = [Other, Female]
|
||||
, ciSpeaks = Just 1
|
||||
, ciLine = Just "That's the Doctor I know!"
|
||||
, ciText = "Can speak one yellow Battle card each turn. Cards spoken by Maya get +1 DP."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
progKnife = CardInfo
|
||||
{ ciName = "Progressive Knife"
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 2
|
||||
, ciType = Put
|
||||
, ciLineMarks = Just [(Triangle, White), (Triangle, Green), (Triangle, Yellow), (Triangle, Black)]
|
||||
, ciTraits = [Other, Weapon]
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "That's just a selfish excuse."
|
||||
, ciText = "Target Eva gains +1 Strength."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
startShinji1 = CardInfo
|
||||
{ ciName = "3rd Child - Shinji Ikari"
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 0
|
||||
, ciType = MainCharacter
|
||||
, ciLineMarks = Just [(Circle, Blue)]
|
||||
, ciTraits = [Male]
|
||||
, ciSpeaks = Just 1
|
||||
, ciLine = Just "I feel like I belong here!"
|
||||
, ciText = "Can speak one blue card every turn."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
startUnitTwo1 = CardInfo
|
||||
{ ciName = "Evangelion Unit Two"
|
||||
, ciFaction = Red
|
||||
, ciDP = Just 1
|
||||
, ciType = Eva
|
||||
, ciLineMarks = Just [(Circle, Red)]
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "They picked me! I'm gonna be an elite pilot protecting humanity!"
|
||||
, ciText = "If put on Unit Two, it gains +1 Strength and can use one additional *weapon* every Battle phase. Cannot be assigned to battle if Asuka is down."
|
||||
, ciStrength = Just 1
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
stopIt = CardInfo
|
||||
{ ciName = "Stop it! This isn't the time..."
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 1
|
||||
, ciType = Battle
|
||||
, ciLineMarks = Just [(Triangle, Red), (Triangle, White), (Triangle, Green), (Triangle, Black)]
|
||||
, ciTraits = [Reaction]
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "Stop it!"
|
||||
, ciText = "Cancel target Drama card."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
somethingLikeThis = CardInfo
|
||||
{ ciName = "But when it comes to something like this..."
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 2
|
||||
, ciType = Drama
|
||||
, ciLineMarks = Just [(Circle, Red), (Circle, White), (Circle, Green)]
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "That reminds me..."
|
||||
, ciText = "All characters grouped with Shinji can speak one additional card this turn."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
data CardInfo = CardInfo
|
||||
{ ciName :: String
|
||||
, ciFaction :: Faction
|
||||
, ciDP :: Maybe Integer
|
||||
, ciType :: TypeSym
|
||||
, ciLineMarks :: Maybe LineMarks
|
||||
, ciTraits :: Traits
|
||||
, ciSpeaks :: Maybe Integer
|
||||
, ciLine :: Maybe String
|
||||
, ciText :: String
|
||||
, ciStrength :: Maybe Integer
|
||||
, ciLevel :: Maybe Integer
|
||||
, ciNextInst :: Maybe CardSym
|
||||
} deriving (Show)
|
||||
|
||||
data CardMeta = CardMeta
|
||||
{ cmOwner :: PlayerId
|
||||
}
|
||||
|
||||
|
||||
|
||||
type CardId = Integer
|
||||
type PlayerId = Integer
|
||||
|
||||
class SymLookup where
|
||||
getSym :: CardId -> CardSym
|
||||
|
||||
class MetaLookup where
|
||||
getMeta :: CardId -> CardMeta
|
||||
|
||||
class CardLookup where
|
||||
getCard :: CardSym -> CardInfo
|
||||
|
||||
232
Main.hs
232
Main.hs
@ -1,187 +1,69 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
module Groups where
|
||||
|
||||
data CardSym = StartShinji1 | StartUnitTwo1 | StopIt | SomethingLikeThis | ProgKnife | Maya | Adam | InstShinji1a | InstShinji1b deriving (Show)
|
||||
data TypeSym = Angel
|
||||
| Character
|
||||
| MainCharacter
|
||||
| Instrumentality
|
||||
| Battle
|
||||
| Put
|
||||
| Drama
|
||||
| Eva deriving (Show)
|
||||
import State
|
||||
|
||||
data Faction = Blue | Red | White | Green | Yellow | Black | Purple deriving (Show)
|
||||
data Mark = Circle | Triangle deriving (Show)
|
||||
type LineMark = (Mark, Faction)
|
||||
type LineMarks = [LineMark]
|
||||
data Trait = Reaction | Other | Male | Female | Weapon deriving (Show)
|
||||
type Traits = [Trait]
|
||||
-- Each characters default adjacents
|
||||
defFrens :: MainCharacter -> [MainCharacter]
|
||||
defFrens Asuka = [Rei, Shinji, Misato]
|
||||
defFrens Shinji = [Rei, Gendo, Ritsuko, Misato, Asuka]
|
||||
defFrens Rei = [Gendo, Shinji, Asuka]
|
||||
defFrens Misato = [Asuka, Shinji, Ritsuko]
|
||||
defFrens Ritsuko = [Misato, Shinji, Gendo]
|
||||
defFrens Gendo = [Rei, Shinji, Ritsuko]
|
||||
|
||||
instShinji1a = CardInfo
|
||||
{ ciName = "3rd Child - Shinji Ikari"
|
||||
, ciFaction = Blue
|
||||
, ciDP = Nothing
|
||||
, ciType = Instrumentality
|
||||
, ciLineMarks = Nothing
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Nothing
|
||||
, ciText = "Asuka is down."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Just 1
|
||||
, ciNextInst = Just InstShinji1b
|
||||
}
|
||||
-- The group that character x belongs to
|
||||
charsGroup :: MainCharacter -> NeoTokyo -> Group
|
||||
charsGroup x nt = head $ filter (\g -> x `elem` g) nt
|
||||
|
||||
instShinji1b = CardInfo
|
||||
{ ciName = "I'm such a loser..."
|
||||
, ciFaction = Blue
|
||||
, ciDP = Nothing
|
||||
, ciType = Instrumentality
|
||||
, ciLineMarks = Nothing
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Nothing
|
||||
, ciText = "All main characters other than Shinji and Asuka are down."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Just 2
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
-- The characters currently grouped with x
|
||||
curFrens :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
||||
curFrens x nt = filter (/= x) $ charsGroup x nt
|
||||
|
||||
adam = CardInfo
|
||||
{ ciName = "The 1st Angel - Adam"
|
||||
, ciFaction = Purple
|
||||
, ciDP = Nothing
|
||||
, ciType = Angel
|
||||
, ciLineMarks = Nothing
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Nothing
|
||||
, ciText = "When Adam is defeated, discard all Put cards in Neo-Tokyo."
|
||||
, ciStrength = Just 3
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
-- Remove duplicates, stabily
|
||||
uniq :: (Eq a) => [a] -> [a]
|
||||
uniq x = reverse $ go x []
|
||||
where
|
||||
go [] al = al
|
||||
go (c:cs) al = if (c `elem` al) then (go cs al) else (go cs (c:al))
|
||||
|
||||
maya = CardInfo
|
||||
{ ciName = "Maya Ibuki"
|
||||
, ciFaction = Yellow
|
||||
, ciDP = Just 1
|
||||
, ciType = Character
|
||||
, ciLineMarks = Just [(Circle, Yellow)]
|
||||
, ciTraits = [Other, Female]
|
||||
, ciSpeaks = Just 1
|
||||
, ciLine = Just "That's the Doctor I know!"
|
||||
, ciText = "Can speak one yellow Battle card each turn. Cards spoken by Maya get +1 DP."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
-- The groups a character is adaject to
|
||||
adjGroups :: MainCharacter -> NeoTokyo -> [Group]
|
||||
adjGroups x nt = filter (\g -> any (\x -> x `elem` adjFrens) g) (otherGroups x nt)
|
||||
where
|
||||
adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x nt)
|
||||
|
||||
progKnife = CardInfo
|
||||
{ ciName = "Progressive Knife"
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 2
|
||||
, ciType = Put
|
||||
, ciLineMarks = Just [(Triangle, White), (Triangle, Green), (Triangle, Yellow), (Triangle, Black)]
|
||||
, ciTraits = [Other, Weapon]
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "That's just a selfish excuse."
|
||||
, ciText = "Target Eva gains +1 Strength."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
-- The groups a character isnt in
|
||||
otherGroups :: MainCharacter -> NeoTokyo -> [Group]
|
||||
otherGroups x nt = filter (\g -> not $ x `elem` g) nt
|
||||
|
||||
startShinji1 = CardInfo
|
||||
{ ciName = "3rd Child - Shinji Ikari"
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 0
|
||||
, ciType = MainCharacter
|
||||
, ciLineMarks = Just [(Circle, Blue)]
|
||||
, ciTraits = [Male]
|
||||
, ciSpeaks = Just 1
|
||||
, ciLine = Just "I feel like I belong here!"
|
||||
, ciText = "Can speak one blue card every turn."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
-- All characters a X is adjacent to
|
||||
getAdj :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
||||
getAdj x nt = curFrens x nt ++ (foldr (++) [] (adjGroups x nt))
|
||||
|
||||
startUnitTwo1 = CardInfo
|
||||
{ ciName = "Evangelion Unit Two"
|
||||
, ciFaction = Red
|
||||
, ciDP = Just 1
|
||||
, ciType = Eva
|
||||
, ciLineMarks = Just [(Circle, Red)]
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "They picked me! I'm gonna be an elite pilot protecting humanity!"
|
||||
, ciText = "If put on Unit Two, it gains +1 Strength and can use one additional *weapon* every Battle phase. Cannot be assigned to battle if Asuka is down."
|
||||
, ciStrength = Just 1
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
-- X hurts Y (only if adjacent)
|
||||
hurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
hurt x y (nt,d)
|
||||
| not $ y `elem` (getAdj x nt) = (nt,d)
|
||||
| otherwise = hurt' x y (nt,d)
|
||||
|
||||
stopIt = CardInfo
|
||||
{ ciName = "Stop it! This isn't the time..."
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 1
|
||||
, ciType = Battle
|
||||
, ciLineMarks = Just [(Triangle, Red), (Triangle, White), (Triangle, Green), (Triangle, Black)]
|
||||
, ciTraits = [Reaction]
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "Stop it!"
|
||||
, ciText = "Cancel target Drama card."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
-- X hurts Y (no restrictions)
|
||||
hurt' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
hurt' x y (nt,d)
|
||||
| y `elem` d = if (curFrens y nt == [])
|
||||
then (nt, d)
|
||||
else ([y] : (groupMinusChar y) : (otherGroups y nt), d)
|
||||
| otherwise = (nt, y:d)
|
||||
where
|
||||
groupMinusChar y = (filter (/= y) $ charsGroup y nt)
|
||||
|
||||
somethingLikeThis = CardInfo
|
||||
{ ciName = "But when it comes to something like this..."
|
||||
, ciFaction = Blue
|
||||
, ciDP = Just 2
|
||||
, ciType = Drama
|
||||
, ciLineMarks = Just [(Circle, Red), (Circle, White), (Circle, Green)]
|
||||
, ciTraits = []
|
||||
, ciSpeaks = Nothing
|
||||
, ciLine = Just "That reminds me..."
|
||||
, ciText = "All characters grouped with Shinji can speak one additional card this turn."
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
data CardInfo = CardInfo
|
||||
{ ciName :: String
|
||||
, ciFaction :: Faction
|
||||
, ciDP :: Maybe Integer
|
||||
, ciType :: TypeSym
|
||||
, ciLineMarks :: Maybe LineMarks
|
||||
, ciTraits :: Traits
|
||||
, ciSpeaks :: Maybe Integer
|
||||
, ciLine :: Maybe String
|
||||
, ciText :: String
|
||||
, ciStrength :: Maybe Integer
|
||||
, ciLevel :: Maybe Integer
|
||||
, ciNextInst :: Maybe CardSym
|
||||
} deriving (Show)
|
||||
|
||||
data CardMeta = CardMeta
|
||||
{ cmOwner :: PlayerId
|
||||
}
|
||||
|
||||
|
||||
|
||||
type CardId = Integer
|
||||
type PlayerId = Integer
|
||||
|
||||
class SymLookup where
|
||||
getSym :: CardId -> CardSym
|
||||
|
||||
class MetaLookup where
|
||||
getMeta :: CardId -> CardMeta
|
||||
|
||||
class CardLookup where
|
||||
getCard :: CardSym -> CardInfo
|
||||
-- Attract X and Y (only if adjacent)
|
||||
attract :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
attract x y (nt,d)
|
||||
| not $ y `elem` (getAdj x nt) = (nt,d)
|
||||
| otherwise = attract' x y (nt,d)
|
||||
|
||||
-- Attract X and Y (no restrictions)
|
||||
attract' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
attract' x y (nt,d)
|
||||
| x `elem` d = (nt, (filter (/= x) d))
|
||||
| otherwise = ((uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt)), d)
|
||||
|
||||
272
State.hs
272
State.hs
@ -1,29 +1,255 @@
|
||||
module State where
|
||||
|
||||
-- needed state:
|
||||
-- NeoTokyo groups
|
||||
-- Put cards
|
||||
-- id counter
|
||||
--
|
||||
--
|
||||
--
|
||||
--
|
||||
import Data.Either
|
||||
|
||||
type Group = [MainCharacter]
|
||||
type NeoTokyo = [Group]
|
||||
type Downed = [MainCharacter]
|
||||
type Angels = [Angel]
|
||||
type BoardState = (NeoTokyo, Downed, Angels)
|
||||
data MainCharacter = Asuka | Shinji | Rei | Misato | Ritsuko | Gendo
|
||||
deriving (Show, Eq)
|
||||
data Angel = Sachial | Shamshel | Ramiel | Gaghiel | Israfel
|
||||
| Sandalphon | Matariel | Sahaquiel | Treul | Leliel
|
||||
| Bardiel | Zeruel | Arael | Armisael | Kaworu | Man | Lillith | Adam
|
||||
data Faction = Blue | Red | White | Green | Yellow | Black deriving (Show)
|
||||
data TypeSym = Character | Eva | Angel | Drama | Put | Intstrumentality deriving (Show, Eq)
|
||||
data Trait = Other | Reaction | Male | Female | Weapon deriving (Show)
|
||||
data MainCharacter = Shinji | Asuka | Rei | Misato | Ritsuko | Gendo deriving (Show, Eq)
|
||||
data MainEva = UnitZero | UnitOne | UnitTwo deriving (Show, Eq)
|
||||
data CardSym = S01_Shinji | S02_Asuka | S03_Rei | S04_Misato | S05_Ritsuko | S06_Gendo deriving (Show, Eq)
|
||||
data Mark = Circle | Triangle deriving (Show)
|
||||
|
||||
data Card = MainCharacter | Angel | Eva | Put | Battle | Instrumentality | Character
|
||||
type Deck = [Card]
|
||||
type Hand = [Card]
|
||||
type Discard = [Card]
|
||||
type Player = (String, Hand, Deck, Discard, Instrumentality)
|
||||
type CardLib = [(CardSym, CardInfo)]
|
||||
type Traits = [Trait]
|
||||
type Hand = [CardSym]
|
||||
type Discard = [CardSym]
|
||||
type PlayerName = String
|
||||
type Player = (PlayerName, Hand, Discard)
|
||||
type Players = [Player]
|
||||
type LineMark = (Mark, Faction)
|
||||
type LineMarks = [LineMark]
|
||||
type PutCards = [(Either MainCharacter MainEva, CardSym)]
|
||||
type Downed = [MainCharacter]
|
||||
type BoardState = (CardLib, Players, Downed, PutCards)
|
||||
type GameError = String
|
||||
|
||||
getCardInfo :: CardSym -> CardLib -> CardInfo
|
||||
getCardInfo c cl = snd $ head $ filter (\(s, _) -> s == c) cl
|
||||
|
||||
defCharsFaction :: Faction -> MainCharacter
|
||||
defCharsFaction Blue = Shinji
|
||||
defCharsFaction Red = Asuka
|
||||
defCharsFaction White = Rei
|
||||
defCharsFaction Green = Misato
|
||||
defCharsFaction Yellow = Ritsuko
|
||||
defCharsFaction Black = Gendo
|
||||
|
||||
numPut :: Either MainCharacter MainEva -> PutCards -> Integer
|
||||
numPut c p = toInteger $ length $ filter (\x -> (fst x) == c) p
|
||||
|
||||
rmFirstMatch :: [a] -> (a -> Bool) -> [a]
|
||||
rmFirstMatch (l:ls) f
|
||||
| f l = ls
|
||||
| otherwise = (l : rmFirstMatch ls f)
|
||||
|
||||
removeHand :: CardSym -> Player -> Either Player GameError
|
||||
removeHand c p@(n, h, d)
|
||||
| not $ c `elem` h = Right "Card not in hand"
|
||||
| otherwise = Left (n, nh, nd)
|
||||
where
|
||||
nh = rmFirstMatch h (== c)
|
||||
nd = (c:d)
|
||||
|
||||
playChar :: Player -> CardSym -> BoardState -> Either BoardState GameError
|
||||
playChar p@(on, oh, od) c ob@(cl, ps, d, pc)
|
||||
| ciType (getCardInfo c cl) /= Character = Right "Not a character"
|
||||
| numPut (Left targetChar) pc >= 2 = Right "Too many put cards"
|
||||
| targetChar `elem` d = Right "Character is down"
|
||||
| isRight np = Right $ unwrapRight np
|
||||
| otherwise = Left $ (cl, (unwrapLeft np):(rmFirstMatch ps (\(n, _, _) -> n == on)), d, npc)
|
||||
where
|
||||
targetChar = defCharsFaction $ ciFaction (getCardInfo c cl)
|
||||
np = removeHand c p
|
||||
npc = (Left targetChar, c):pc
|
||||
|
||||
unwrapLeft :: Either a b -> a
|
||||
unwrapLeft (Left x) = x
|
||||
unwrapLeft (Right _) = error "Not a Left value"
|
||||
|
||||
unwrapRight :: Either a b -> b
|
||||
unwrapRight (Right x) = x
|
||||
unwrapRight (Left _) = error "Not a Right value"
|
||||
|
||||
p1 :: Player
|
||||
p1 = ("Shaun", [S01_Shinji, S02_Asuka, S03_Rei, S04_Misato, S05_Ritsuko, S06_Gendo], [])
|
||||
|
||||
gCardLib :: CardLib
|
||||
gCardLib =
|
||||
[ (S01_Shinji, ciS01_Shinji)
|
||||
, (S02_Asuka, ciS02_Asuka)
|
||||
, (S03_Rei, ciS03_Rei)
|
||||
, (S04_Misato, ciS04_Misato)
|
||||
, (S05_Ritsuko, ciS05_Ritsuko)
|
||||
, (S06_Gendo, ciS06_Gendo)
|
||||
]
|
||||
|
||||
data CardInfo = CardInfo
|
||||
{ ciName :: String
|
||||
, ciFaction :: Faction
|
||||
, ciType :: TypeSym
|
||||
, ciText :: String
|
||||
, ciTraits :: Traits
|
||||
, ciLineMarks :: Maybe LineMarks
|
||||
, ciLine :: Maybe String
|
||||
, ciDP :: Maybe Integer
|
||||
, ciStrength :: Maybe Integer
|
||||
, ciLevel :: Maybe Integer
|
||||
, ciNextInst :: Maybe CardSym
|
||||
} deriving (Show)
|
||||
|
||||
ciS01_Shinji = CardInfo
|
||||
{ ciName = "3rd Child - Shinji Ikari"
|
||||
, ciFaction = Blue
|
||||
, ciType = Character
|
||||
, ciText = "Can speak one blue card every turn."
|
||||
, ciTraits = [Male]
|
||||
, ciLineMarks = Just [(Circle, Blue)]
|
||||
, ciLine = Just "I feel like I belong here!"
|
||||
, ciDP = Just 0
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
ciS02_Asuka = CardInfo
|
||||
{ ciName = "2nd Child - Asuka Langley-Soryu"
|
||||
, ciFaction = Red
|
||||
, ciType = Character
|
||||
, ciText = "Can speak one red card every turn."
|
||||
, ciTraits = [Female]
|
||||
, ciLineMarks = Just [(Triangle, Blue), (Triangle, Green), (Triangle, Yellow)]
|
||||
, ciLine = Just "What're you, stupid?!"
|
||||
, ciDP = Just 1
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
ciS03_Rei = CardInfo
|
||||
{ ciName = "1st Child - Rei Ayanami"
|
||||
, ciFaction = White
|
||||
, ciType = Character
|
||||
, ciText = "Can speak one white card every turn. All white lines are zero DP. If down at the start of the Opening Draw phase, Rei recovers automatically."
|
||||
, ciTraits = [Female]
|
||||
, ciLineMarks = Just [(Circle, White)]
|
||||
, ciLine = Just "I feel connected."
|
||||
, ciDP = Just (-1)
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
ciS04_Misato = CardInfo
|
||||
{ ciName = "Misato Katsuragi"
|
||||
, ciFaction = Green
|
||||
, ciType = Character
|
||||
, ciText = "Can speak one green card every turn."
|
||||
, ciTraits = [Female]
|
||||
, ciLineMarks = Just [(Circle, Green)]
|
||||
, ciLine = Just "We can't wait for a miracle, let's give it our best shot."
|
||||
, ciDP = Just 0
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
ciS05_Ritsuko = CardInfo
|
||||
{ ciName = "Ritsuko Akagi"
|
||||
, ciFaction = Yellow
|
||||
, ciType = Character
|
||||
, ciText = "Can speak one yellow card every turn."
|
||||
, ciTraits = [Female]
|
||||
, ciLineMarks = Just [(Circle, Yellow)]
|
||||
, ciLine = Just "The one Unit Zero was after was me."
|
||||
, ciDP = Just 0
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
ciS06_Gendo = CardInfo
|
||||
{ ciName = "Gendo Ikari"
|
||||
, ciFaction = Black
|
||||
, ciType = Character
|
||||
, ciText = "Can speak one black card every turn."
|
||||
, ciTraits = [Male]
|
||||
, ciLineMarks = Just [(Circle, Black)]
|
||||
, ciLine = Just "There is no problem."
|
||||
, ciDP = Just (-1)
|
||||
, ciStrength = Nothing
|
||||
, ciLevel = Nothing
|
||||
, ciNextInst = Nothing
|
||||
}
|
||||
|
||||
{--
|
||||
module Groups where
|
||||
|
||||
import State
|
||||
|
||||
-- Each characters default adjacents
|
||||
defFrens :: MainCharacter -> [MainCharacter]
|
||||
defFrens Asuka = [Rei, Shinji, Misato]
|
||||
defFrens Shinji = [Rei, Gendo, Ritsuko, Misato, Asuka]
|
||||
defFrens Rei = [Gendo, Shinji, Asuka]
|
||||
defFrens Misato = [Asuka, Shinji, Ritsuko]
|
||||
defFrens Ritsuko = [Misato, Shinji, Gendo]
|
||||
defFrens Gendo = [Rei, Shinji, Ritsuko]
|
||||
|
||||
-- The group that character x belongs to
|
||||
charsGroup :: MainCharacter -> NeoTokyo -> Group
|
||||
charsGroup x nt = head $ filter (\g -> x `elem` g) nt
|
||||
|
||||
-- The characters currently grouped with x
|
||||
curFrens :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
||||
curFrens x nt = filter (/= x) $ charsGroup x nt
|
||||
|
||||
-- Remove duplicates, stabily
|
||||
uniq :: (Eq a) => [a] -> [a]
|
||||
uniq x = reverse $ go x []
|
||||
where
|
||||
go [] al = al
|
||||
go (c:cs) al = if (c `elem` al) then (go cs al) else (go cs (c:al))
|
||||
|
||||
-- The groups a character is adaject to
|
||||
adjGroups :: MainCharacter -> NeoTokyo -> [Group]
|
||||
adjGroups x nt = filter (\g -> any (\x -> x `elem` adjFrens) g) (otherGroups x nt)
|
||||
where
|
||||
adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x nt)
|
||||
|
||||
-- The groups a character isnt in
|
||||
otherGroups :: MainCharacter -> NeoTokyo -> [Group]
|
||||
otherGroups x nt = filter (\g -> not $ x `elem` g) nt
|
||||
|
||||
-- All characters a X is adjacent to
|
||||
getAdj :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
||||
getAdj x nt = curFrens x nt ++ (foldr (++) [] (adjGroups x nt))
|
||||
|
||||
-- X hurts Y (only if adjacent)
|
||||
hurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
hurt x y (nt,d)
|
||||
| not $ y `elem` (getAdj x nt) = (nt,d)
|
||||
| otherwise = hurt' x y (nt,d)
|
||||
|
||||
-- X hurts Y (no restrictions)
|
||||
hurt' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
hurt' x y (nt,d)
|
||||
| y `elem` d = if (curFrens y nt == [])
|
||||
then (nt, d)
|
||||
else ([y] : (groupMinusChar y) : (otherGroups y nt), d)
|
||||
| otherwise = (nt, y:d)
|
||||
where
|
||||
groupMinusChar y = (filter (/= y) $ charsGroup y nt)
|
||||
|
||||
-- Attract X and Y (only if adjacent)
|
||||
attract :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
attract x y (nt,d)
|
||||
| not $ y `elem` (getAdj x nt) = (nt,d)
|
||||
| otherwise = attract' x y (nt,d)
|
||||
|
||||
-- Attract X and Y (no restrictions)
|
||||
attract' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
attract' x y (nt,d)
|
||||
| x `elem` d = (nt, (filter (/= x) d))
|
||||
| otherwise = ((uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt)), d)
|
||||
--}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user