2019-05-18 23:56:48 -04:00
|
|
|
module Groups where
|
|
|
|
|
|
|
|
import State
|
|
|
|
import Util
|
|
|
|
import Cards
|
|
|
|
import Types
|
|
|
|
import Data.Either
|
|
|
|
|
|
|
|
-- 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]
|
|
|
|
|
2019-05-19 00:55:53 -04:00
|
|
|
-- 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))
|
2019-05-18 23:56:48 -04:00
|
|
|
|
|
|
|
-- The characters currently grouped with x
|
2019-05-19 00:55:53 -04:00
|
|
|
curFrens :: MainCharacter -> Groups -> [MainCharacter]
|
|
|
|
curFrens x g = filter (/= x) $ charsGroup x g
|
2019-05-18 23:56:48 -04:00
|
|
|
|
2019-05-19 00:55:53 -04:00
|
|
|
-- The group that character x belongs to
|
|
|
|
charsGroup :: MainCharacter -> Groups -> Group
|
|
|
|
charsGroup x g = head $ filter (\y -> x `elem` y) g
|
2019-05-18 23:56:48 -04:00
|
|
|
|
|
|
|
-- The groups a character isnt in
|
2019-05-19 00:55:53 -04:00
|
|
|
otherGroups :: MainCharacter -> Groups -> Groups
|
|
|
|
otherGroups x g = filter (\y -> not $ x `elem` y) g
|
2019-05-18 23:56:48 -04:00
|
|
|
|
2019-05-19 00:55:53 -04:00
|
|
|
-- 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 y g) )
|
2019-05-18 23:56:48 -04:00
|
|
|
|
2019-05-19 00:55:53 -04:00
|
|
|
{--
|
2019-05-18 23:56:48 -04:00
|
|
|
-- 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)
|
2019-05-19 00:55:53 -04:00
|
|
|
--}
|