evac/Connect.hs

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