support for adjacency
This commit is contained in:
parent
2e367ba36f
commit
64a03fbe3e
22
Groups.hs
22
Groups.hs
@ -40,18 +40,20 @@ otherGroups x nt = filter (\g -> not $ x `elem` g) nt
|
||||
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 == [])
|
||||
-- X hurts Y (only if adjacent)
|
||||
hurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
||||
hurt x y (nt,d)
|
||||
| not $ y `elem` (getAdj x nt) = (nt,d)
|
||||
| y `elem` d = if (curFrens y nt == [])
|
||||
then (nt, d)
|
||||
else ([x] : (groupMinusChar x) : (otherGroups x nt), d)
|
||||
| otherwise = (nt, x:d)
|
||||
else ([y] : (groupMinusChar y) : (otherGroups y nt), d)
|
||||
| otherwise = (nt, y:d)
|
||||
where
|
||||
groupMinusChar x = (filter (/= x) $ charsGroup x nt)
|
||||
groupMinusChar y = (filter (/= y) $ charsGroup y nt)
|
||||
|
||||
-- Attract X and Y
|
||||
-- Attract X and Y (only if adjacent)
|
||||
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)
|
||||
| not $ y `elem` (getAdj x nt) = (nt,d)
|
||||
| x `elem` d = (nt, (filter (/= x) d))
|
||||
| otherwise = ((uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt)), d)
|
||||
|
Loading…
Reference in New Issue
Block a user