From fe97ea143211e979ff9c122df1eaa24c854ba104 Mon Sep 17 00:00:00 2001 From: techieAgnostic Date: Sat, 18 May 2019 19:10:33 +1200 Subject: [PATCH] only State.hs matters --- Cards.hs | 187 +++++++++++++++++++++++++++++++++++++++++++ Main.hs | 232 +++++++++++++---------------------------------------- State.hs | 272 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++------ 3 files changed, 493 insertions(+), 198 deletions(-) create mode 100644 Cards.hs diff --git a/Cards.hs b/Cards.hs new file mode 100644 index 0000000..8fac63d --- /dev/null +++ b/Cards.hs @@ -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 + diff --git a/Main.hs b/Main.hs index 8fac63d..a0da67a 100644 --- a/Main.hs +++ b/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) diff --git a/State.hs b/State.hs index 8fc9912..336bd47 100644 --- a/State.hs +++ b/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) +--}