2023-12-04 16:20:06 +00:00
|
|
|
module Main where
|
|
|
|
|
2023-12-10 11:44:23 +00:00
|
|
|
import Control.Concurrent (threadDelay)
|
|
|
|
|
2023-12-11 16:21:24 +00:00
|
|
|
import qualified Control.Concurrent.STM as STM
|
|
|
|
|
2023-12-13 12:36:06 +00:00
|
|
|
import Control.Monad
|
|
|
|
|
|
|
|
import Control.Monad.RWS
|
|
|
|
|
2024-04-17 17:44:47 +00:00
|
|
|
import Data.IORef
|
|
|
|
|
2023-12-20 07:12:22 +00:00
|
|
|
import qualified Data.Matrix as M
|
|
|
|
|
2023-12-13 12:36:06 +00:00
|
|
|
import Graphics.Vty
|
2024-05-01 21:53:12 +00:00
|
|
|
import Graphics.Vty.CrossPlatform
|
2023-12-13 12:36:06 +00:00
|
|
|
|
2024-11-03 03:40:46 +00:00
|
|
|
import Network.Socket (Socket, close)
|
2024-11-02 22:37:15 +00:00
|
|
|
|
2023-12-10 11:44:23 +00:00
|
|
|
import Options.Applicative
|
|
|
|
|
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Client.Communication
|
2023-12-20 07:12:22 +00:00
|
|
|
import Client.Game
|
2024-11-07 16:47:11 +00:00
|
|
|
import Client.Log
|
2023-12-10 11:44:23 +00:00
|
|
|
import Client.Types
|
|
|
|
|
2023-12-10 16:00:50 +00:00
|
|
|
import Library.Types
|
|
|
|
|
2023-12-04 16:20:06 +00:00
|
|
|
main :: IO ()
|
2023-12-10 11:44:23 +00:00
|
|
|
main = do
|
|
|
|
putStrLn "Hello, Arena!"
|
2024-11-07 16:47:11 +00:00
|
|
|
(Options logLevel socketLocation) <- execParser opts
|
|
|
|
logPrintIO Info logLevel $ "connecting to Socket " <> socketLocation
|
2023-12-10 19:12:53 +00:00
|
|
|
sock <- connectSocket socketLocation
|
2024-11-07 16:47:11 +00:00
|
|
|
logPrintIO Info logLevel "connected"
|
2023-12-12 01:53:05 +00:00
|
|
|
|
|
|
|
|
2024-10-28 11:20:04 +00:00
|
|
|
messageQueue <- STM.newTQueueIO
|
|
|
|
eventQueue <- STM.newTQueueIO
|
2023-12-12 08:01:21 +00:00
|
|
|
|
|
|
|
|
2023-12-13 12:36:06 +00:00
|
|
|
-- threadDelay $ 1 * 10 ^ 6
|
2024-11-07 16:47:11 +00:00
|
|
|
mockClientState <- STM.newTMVarIO
|
|
|
|
( ClientState
|
|
|
|
(error "trying to access vty of mock client state")
|
|
|
|
False
|
|
|
|
)
|
|
|
|
let mockState =
|
|
|
|
StateContainer
|
|
|
|
(error "trying to access wizard of mock game state")
|
|
|
|
mockClientState
|
|
|
|
(error "trying to access map slice of mock game state")
|
|
|
|
(error "trying to access stop condition of mock game state")
|
|
|
|
sendMessage logLevel IdRequest sock
|
|
|
|
clientIdMsg <- awaitResponse logLevel sock messageQueue mockState 0
|
2023-12-11 10:54:17 +00:00
|
|
|
let clientId = acClientUUID clientIdMsg
|
2024-11-07 16:47:11 +00:00
|
|
|
logPrintIO Info logLevel $ "received client UUID: " <> show clientId
|
2023-12-12 01:53:05 +00:00
|
|
|
|
|
|
|
|
2023-12-11 16:21:24 +00:00
|
|
|
putStrLn welcomeText
|
2024-11-07 16:47:11 +00:00
|
|
|
threadDelay $ 5 * 10 ^ (6 :: Int)
|
2023-12-12 01:53:05 +00:00
|
|
|
|
|
|
|
|
2024-11-07 16:47:11 +00:00
|
|
|
sendMessage logLevel (ClientMessage clientId ClientRequestWizard) sock
|
2023-12-13 12:36:06 +00:00
|
|
|
-- threadDelay $ 1 * 10 ^ 6
|
2024-11-07 16:47:11 +00:00
|
|
|
playerWizard <- awaitResponse logLevel sock messageQueue mockState 1
|
|
|
|
logPrintIO Info logLevel $ "received wizard: " <> show (initWizard playerWizard)
|
2023-12-12 01:53:05 +00:00
|
|
|
|
2024-05-01 21:53:12 +00:00
|
|
|
vty <- mkVty defaultConfig
|
|
|
|
hideCursor (outputIface vty)
|
2023-12-13 12:36:06 +00:00
|
|
|
|
|
|
|
-- shut down graphical interface for now
|
2024-03-29 03:14:21 +00:00
|
|
|
-- shutdown vty
|
2023-12-12 01:53:05 +00:00
|
|
|
|
2024-04-19 18:18:49 +00:00
|
|
|
stopper <- newIORef False
|
2024-06-09 05:32:03 +00:00
|
|
|
clientState <- STM.newTMVarIO (ClientState vty False)
|
2023-12-20 07:12:22 +00:00
|
|
|
let initSlice = MapSlice (M.matrix 9 9 (const Nothing)) []
|
2024-11-07 16:47:11 +00:00
|
|
|
let initRead = ReaderContainer sock clientId messageQueue eventQueue logLevel
|
2024-04-19 18:18:49 +00:00
|
|
|
initState = StateContainer (initWizard playerWizard) clientState initSlice stopper
|
2023-12-13 12:36:06 +00:00
|
|
|
-- putStrLn "sending quit message"
|
|
|
|
-- sendMessage (ClientMessage clientId ClientQuit) sock
|
2024-11-07 16:47:11 +00:00
|
|
|
logPrintIO Info logLevel "entering Game Monad"
|
2023-12-13 12:36:06 +00:00
|
|
|
void $ execRWST
|
|
|
|
(do
|
2024-04-17 17:44:47 +00:00
|
|
|
terminateGameOnSigint stopper
|
2024-11-07 16:47:11 +00:00
|
|
|
logPrint Verbose "entering main game function"
|
2024-04-19 18:18:49 +00:00
|
|
|
runGame
|
2023-12-13 12:36:06 +00:00
|
|
|
)
|
|
|
|
initRead
|
|
|
|
initState
|
2024-11-07 16:47:11 +00:00
|
|
|
logPrintIO Info logLevel "Shutting down client…"
|
2024-05-01 21:53:12 +00:00
|
|
|
showCursor (outputIface vty)
|
|
|
|
shutdown vty
|
2024-11-07 16:47:11 +00:00
|
|
|
threadDelay 1000
|
|
|
|
logPrintIO Info logLevel "Closing connection to server…"
|
2024-11-02 22:37:15 +00:00
|
|
|
close sock
|
2024-04-07 11:35:48 +00:00
|
|
|
putStrLn "bye bye"
|
2023-12-10 11:44:23 +00:00
|
|
|
where
|
|
|
|
opts = info (options <**> helper)
|
|
|
|
( fullDesc
|
2023-12-20 19:17:18 +00:00
|
|
|
<> progDesc "Run the \"wizard-wipeout\" Client."
|
2023-12-10 11:44:23 +00:00
|
|
|
<> header "wizard-wipeout - Last Mage standing"
|
|
|
|
)
|
2023-12-11 10:54:17 +00:00
|
|
|
|
|
|
|
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:"
|
|
|
|
, ""
|
2023-12-11 16:21:24 +00:00
|
|
|
, "press [SPACE] to fire your wand"
|
2023-12-11 10:54:17 +00:00
|
|
|
, "press [1] through [9] to change wands, if you have collected more wands"
|
|
|
|
, "press [ESC] to leave"
|
|
|
|
, ""
|
|
|
|
, "Good Luck!"
|
|
|
|
]
|
2023-12-12 08:01:21 +00:00
|
|
|
|
|
|
|
awaitResponse
|
2024-11-07 16:47:11 +00:00
|
|
|
:: LogLevel
|
|
|
|
-> Socket
|
2024-11-03 03:40:46 +00:00
|
|
|
-> STM.TQueue ServerMessage
|
|
|
|
-> StateContainer
|
2023-12-12 08:01:21 +00:00
|
|
|
-> Int
|
2024-11-07 16:47:11 +00:00
|
|
|
-> IO ServerMessage
|
|
|
|
awaitResponse _ _ _ _ 10 = error "Tries to communicate with server exceeded"
|
|
|
|
awaitResponse curLevel sock messageQueue mockState numTries = do
|
|
|
|
receiveMessage curLevel sock messageQueue mockState
|
2024-10-28 11:20:04 +00:00
|
|
|
responsePresent <- not <$> STM.atomically (STM.isEmptyTQueue messageQueue)
|
2023-12-12 08:01:21 +00:00
|
|
|
if responsePresent
|
2024-11-07 16:47:11 +00:00
|
|
|
then STM.atomically $ STM.readTQueue messageQueue
|
2023-12-12 08:01:21 +00:00
|
|
|
else do
|
2024-11-07 16:47:11 +00:00
|
|
|
threadDelay $ 10 ^ (6 :: Int)
|
|
|
|
awaitResponse curLevel sock messageQueue mockState (numTries + 1)
|