54 lines
2.3 KiB
Haskell
54 lines
2.3 KiB
Haskell
module Connect where
|
|
|
|
import Types
|
|
import Groups
|
|
|
|
-- Passes state for X to hurt Y
|
|
conHurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
|
conHurt charX charY oldBoardState
|
|
| not $ isAdjacent charX charY oldGroups = oldBoardState
|
|
{ bsGameLog = (bsGameLog oldBoardState)
|
|
++ [ Right (show charX ++ " is not adjacent to " ++ show charY ++ ", could not hurt") ]
|
|
}
|
|
| isAlone charY oldGroups = oldBoardState
|
|
{ bsGameLog = (bsGameLog oldBoardState)
|
|
++ [ Left (show charX ++ " hurt " ++ show charY ++ ", " ++ show charY ++ " is downed") ]
|
|
, bsNeoTokyo = (bsNeoTokyo oldBoardState)
|
|
{ ntPutCards = filter (\x -> ((fst x) /= Left charX)) oldPut
|
|
, ntDowned = downChar charY oldDowned
|
|
}
|
|
}
|
|
| otherwise = oldBoardState
|
|
{ bsGameLog = (bsGameLog oldBoardState)
|
|
++ [ Left (show charX ++ " hurt " ++ show charY ++ ", " ++ show charY ++ " left their group") ]
|
|
, bsNeoTokyo = (bsNeoTokyo oldBoardState)
|
|
{ ntGroups = removeFromGroup charY oldGroups }
|
|
}
|
|
where
|
|
oldDowned = (ntDowned . bsNeoTokyo) oldBoardState
|
|
oldGroups = (ntGroups . bsNeoTokyo) oldBoardState
|
|
oldPut = (ntPutCards . bsNeoTokyo) oldBoardState
|
|
|
|
-- Passes state for X to attract Y
|
|
conAttract :: MainCharacter -> MainCharacter -> BoardState -> BoardState
|
|
conAttract charX charY oldBoardState
|
|
| not $ isAdjacent charX charY oldGroups = oldBoardState
|
|
{ bsGameLog = (bsGameLog oldBoardState)
|
|
++ [ Right (show charX ++ " is not adjacent to " ++ show charY ++ ", could not attract") ]
|
|
}
|
|
| isDowned charX oldDowned = oldBoardState
|
|
{ bsGameLog = (bsGameLog oldBoardState)
|
|
++ [ Left (show charX ++ " attracted " ++ show charY ++ ", " ++ show charY ++ " is ready") ]
|
|
, bsNeoTokyo = (bsNeoTokyo oldBoardState)
|
|
{ ntDowned = readyChar charY oldDowned }
|
|
}
|
|
| otherwise = oldBoardState
|
|
{ bsGameLog = (bsGameLog oldBoardState)
|
|
++ [ Left (show charX ++ " attracted " ++ show charY ++ ", " ++ show charY ++ "'s group joined " ++ show charX ++ "'s group") ]
|
|
, bsNeoTokyo = (bsNeoTokyo oldBoardState)
|
|
{ ntGroups = joinGroups charX charY oldGroups }
|
|
}
|
|
where
|
|
oldDowned = (ntDowned . bsNeoTokyo) oldBoardState
|
|
oldGroups = (ntGroups . bsNeoTokyo) oldBoardState
|