tA/evac
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

chchchchanges

Browse Source
This commit is contained in:
Thorn Avery 2019-05-19 15:33:34 +12:00
parent 43cd96e6cc
commit 638ae3edd2
4 changed files with 27 additions and 335 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

187
Cards.hs
View File

@ -1,187 +0,0 @@
{-# 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

69
Groups.hs
View File

@ -1,69 +0,0 @@
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)

69
Main.hs
View File

@ -1,69 +0,0 @@
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)

37
State.hs
View File

@ -2,27 +2,44 @@ module State where
import Data.Either
type CardLib = [(CardSym, CardInfo)]
type BoardState = (CardLib, Players, Downed, PutCards)
type Downed = [MainCharacter]
type PutCards = [(Either MainCharacter MainEva, CardSym)]
type CardStack = [(PlayerId, CardSym)]
type NeoTokyo = ([Group], Evas)
type Evas = [MainEvas]
type Group = [MainCharacter]
type Angels = [Angel]
type PlayerLib = [PlayerId, PlayerState]
type ActivePlayers = [PlayerId]
type PriorityPlayer = PlayerId
type PlayerId = Integer
type PlayerState = (PlayerName, Hand, Deck, Discard)
type PlayerName = String
type Hand = [CardSym]
type Deck = [CardSym]
type Discard = [CardSym]
type GameLog = [GameMessage]
type GameMessage = Either GameLine GameError
type GameLine = String
type GameError = String
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 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 Mark = Circle | Triangle deriving (Show)
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