{-# LANGUAGE LambdaCase #-} module Main where import Control.Concurrent (threadDelay) import qualified Control.Concurrent.STM as STM import Options.Applicative -- internal imports import Client.Communication import Client.Types import Library.Types main :: IO () main = do putStrLn "Hello, Arena!" (Options socketLocation) <- execParser opts putStrLn $ "connecting to Socket " <> socketLocation sock <- connectSocket socketLocation putStrLn "connected" queue <- STM.newTQueueIO sendMessage (IdRequest) sock threadDelay $ 1 * 10 ^ 6 receiveMessage sock queue awaitResponse queue 1 clientIdMsg <- head <$> STM.atomically (STM.flushTQueue queue) let clientId = acClientUUID clientIdMsg putStrLn $ "received client UUID: " <> show clientId putStrLn welcomeText threadDelay $ 5 * 10 ^ 6 sendMessage (ClientMessage clientId ClientRequestWizard) sock threadDelay $ 1 * 10 ^ 6 receiveMessage sock queue awaitResponse queue 1 playerWizard <- head <$> STM.atomically (STM.flushTQueue queue) putStrLn $ "received wizard: " <> show (initWizard playerWizard) let initRead = ReaderContainer sock clientId initState = StateContainer (initWizard playerWizard) putStrLn "sending quit message" sendMessage (ClientMessage clientId ClientQuit) sock where opts = info (options <**> helper) ( fullDesc <> progDesc "Run the \"wizard-wipeout\" Server." <> header "wizard-wipeout - Last Mage standing" ) welcomeText :: String welcomeText = mconcat $ map (<> "\n") [ "Welcome to the arena, wizards." , "" , "Let the toughest and bravest of you survive" , "" , "Some last hints before you enter the fighting grounds:" , "" , "press [SPACE] to fire your wand" , "press [1] through [9] to change wands, if you have collected more wands" , "press [ESC] to leave" , "" , "Good Luck!" ] awaitResponse :: STM.TQueue ServerMessage -> Int -> IO () awaitResponse _ 10 = error "Tries to communicate with server exceeded" awaitResponse queue numTries = do responsePresent <- not <$> STM.atomically (STM.isEmptyTQueue queue) if responsePresent then pure () else do threadDelay $ 10 ^ 6 awaitResponse queue (succ numTries)