58 lines
2.0 KiB
Haskell
58 lines
2.0 KiB
Haskell
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))
|
|
|
|
-- Hurt character x
|
|
hurt :: MainCharacter -> BoardState -> BoardState
|
|
hurt x (nt,d)
|
|
| x `elem` d = if (curFrens x nt == [])
|
|
then (nt, d)
|
|
else ([x] : (groupMinusChar x) : (otherGroups x nt), d)
|
|
| otherwise = (nt, x:d)
|
|
where
|
|
groupMinusChar x = (filter (/= x) $ charsGroup x nt)
|
|
|
|
-- Attract X and Y
|
|
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)
|