actually commented, not even joking
This commit is contained in:
parent
f226c85a62
commit
4d29c62388
12
Main.hs
12
Main.hs
@ -1,9 +1,9 @@
|
||||
type Group = [MainCharacter]
|
||||
type NeoTokyo = [Group]
|
||||
|
||||
data MainCharacter = Asuka | Shinji | Rei | Misato | Ritsuko | Gendo
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- Each characters default adjacents
|
||||
defFrens :: MainCharacter -> [MainCharacter]
|
||||
defFrens Asuka = [Rei, Shinji, Misato]
|
||||
defFrens Shinji = [Rei, Gendo, Ritsuko, Misato, Asuka]
|
||||
@ -12,33 +12,41 @@ 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 = go x []
|
||||
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 -> NeoTokyo -> NeoTokyo
|
||||
hurt x nt
|
||||
| curFrens x nt == [] = nt
|
||||
| otherwise = [x] : (filter (/= x) $ charsGroup x nt) : (otherGroups x nt)
|
||||
|
||||
-- Attract X and Y
|
||||
attract :: MainCharacter -> MainCharacter -> NeoTokyo -> NeoTokyo
|
||||
attract x y nt = (uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt))
|
||||
|
Loading…
Reference in New Issue
Block a user