80 lines
3.4 KiB
Haskell
80 lines
3.4 KiB
Haskell
module Connect where
|
|
|
|
import Types
|
|
import Groups
|
|
import Players
|
|
|
|
-- IDEAS
|
|
-- * Bank of bool function, boardstate affection pairs
|
|
-- One global, one per player
|
|
-- used as a list of restrictions for whether you can play a card.
|
|
-- * Further, make it a list of restrictions, for going in timing order.
|
|
-- makes for better log messages.
|
|
|
|
--conAnnounceLine :: PlayerId -> CardSym -> MainCharacter -> BoardState -> BoardState
|
|
--conAnnounceLine p l t oldBoardState
|
|
-- | not $ PlayerId `elem` (bsPlayerLib oldBoardState) = oldBoardState
|
|
-- { bsGameLog = (bsGameLog oldBoardState)
|
|
-- ++ [ Right ("Player " ++ show PlayerId ++ " is not in the game") ]
|
|
-- }
|
|
-- | not $ isInHand l p oldBoardState = oldBoardState
|
|
-- { bsGameLog = (bsGameLog oldBoardState)
|
|
-- ++ [ Right (show CardSym ++ " is not in " ++ (playerName p) ++ "'s hand" ]
|
|
-- }
|
|
-- | otherwise = oldBoardState
|
|
-- { bsGameLog = (bsGameLog oldBoardState)
|
|
-- ++ [ Left (playerName p oldBoardState) ++ " announced " ++ (getCardLine l) ++ ", moved to active" ]
|
|
-- , bsCardStack
|
|
|
|
-- TODO
|
|
-- * manipulate the card stack after writing it
|
|
|
|
-- 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
|