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