evac/Groups.hs

module Groups where

import Util
import Types

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

-- Return true if charater is downed
isDowned :: MainCharacter -> Downed -> Bool
isDowned c d = c `elem` d

-- Return true if character is not grouped
isAlone :: MainCharacter -> Groups -> Bool
isAlone c g = curFrens c g == []

-- Return true if X is adjacent to Y
isAdjacent :: MainCharacter -> MainCharacter -> Groups -> Bool
isAdjacent x y g = y `elem` (getAdj x g)

-- All characters a X is adjacent to
getAdj :: MainCharacter -> Groups -> [MainCharacter]
getAdj x g = curFrens x g ++ (foldr (++) [] (adjGroups x g))

-- The characters currently grouped with x
curFrens :: MainCharacter -> Groups -> [MainCharacter]
curFrens x g = filter (/= x) $ charsGroup x g

-- The group that character x belongs to
charsGroup :: MainCharacter -> Groups -> Group
charsGroup x g = head $ filter (\y -> x `elem` y) g

-- The groups a character isnt in
otherGroups :: MainCharacter -> Groups -> Groups
otherGroups x g = filter (\y -> not $ x `elem` y) g

-- The groups a character is adaject to
adjGroups :: MainCharacter -> Groups -> Groups
adjGroups x g = filter (\y -> any (\z -> z `elem` adjFrens) y) (otherGroups x g)
   where
      adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x g)

-- Return the groups with C removed from its current group
removeFromGroup :: MainCharacter -> Groups -> Groups
removeFromGroup c g = ( [c] : (groupMinusChar c) : (otherGroups c g) )
   where
      groupMinusChar x = curFrens x g

-- Return the groups with X grouped with Y
joinGroups :: MainCharacter -> MainCharacter -> Groups -> Groups
joinGroups x y g
   | x `elem` curFrens y g = g
   | otherwise = (groupX ++ groupY) : (otherGroups x . otherGroups y) g
   where
      groupX = charsGroup x g
      groupY = charsGroup y g

-- Return the Downed with the new character
downChar :: MainCharacter -> Downed -> Downed
downChar c d
   | c `elem` d = d
   | otherwise = (c : d)

-- Return the Downed minus the chosen character
readyChar :: MainCharacter -> Downed -> Downed
readyChar c d = filter (/= c) d

{--
-- 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)
--}