From 638ae3edd2ea489bf08b8ea3dd7601f1523992f5 Mon Sep 17 00:00:00 2001 From: techieAgnostic Date: Sun, 19 May 2019 15:33:34 +1200 Subject: [PATCH] chchchchanges --- Cards.hs | 187 -------------------------------------------------------------- Groups.hs | 69 ----------------------- Main.hs | 69 ----------------------- State.hs | 37 +++++++++---- 4 files changed, 27 insertions(+), 335 deletions(-) delete mode 100644 Cards.hs delete mode 100644 Groups.hs delete mode 100644 Main.hs diff --git a/Cards.hs b/Cards.hs deleted file mode 100644 index 8fac63d..0000000 --- a/Cards.hs +++ /dev/null @@ -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 - diff --git a/Groups.hs b/Groups.hs deleted file mode 100644 index a0da67a..0000000 --- a/Groups.hs +++ /dev/null @@ -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) diff --git a/Main.hs b/Main.hs deleted file mode 100644 index a0da67a..0000000 --- a/Main.hs +++ /dev/null @@ -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) diff --git a/State.hs b/State.hs index 5fca0be..bc4dd45 100644 --- a/State.hs +++ b/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