chchchchanges

Cards.hs

@@ -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
-

Groups.hs

@@ -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)

Main.hs

@@ -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)

State.hs

@@ -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