module Eventloop.Module.Websocket.Mouse.Mouse
( setupMouseModuleConfiguration
, mouseModuleIdentifier
, mouseInitializer
, mouseEventRetriever
, mouseEventSender
) where
import Control.Applicative
import Control.Monad
import Control.Concurrent.MVar
import Control.Concurrent.SafePrint
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Maybe
import Eventloop.Module.Websocket.Mouse.Types
import Eventloop.Types.Common
import Eventloop.Types.Events
import Eventloop.Types.System
import Eventloop.Utility.Websockets
import Eventloop.Utility.Config
import Eventloop.Utility.Vectors
setupMouseModuleConfiguration :: EventloopSetupModuleConfiguration
setupMouseModuleConfiguration = ( EventloopSetupModuleConfiguration
mouseModuleIdentifier
(Just mouseInitializer)
(Just mouseEventRetriever)
Nothing
Nothing
(Just mouseEventSender)
Nothing
)
mouseModuleIdentifier :: EventloopModuleIdentifier
mouseModuleIdentifier = "mouse"
instance FromJSON MouseIn where
parseJSON vO@(Object v)
= do
mouseEvent <- parseJSON vO :: Parser MouseEvent
mouseType <- parseJSON vO :: Parser MouseType
point <- parseJSON vO :: Parser Point
id <- v .: "id" :: Parser NumericId
return $ Mouse mouseType id mouseEvent point
instance FromJSON MouseType where
parseJSON (Object v)
= do
type' <- v .: "elementType" :: Parser String
return $ case type' of "canvas" -> MouseCanvas
"svg" -> MouseSVG
instance FromJSON MouseEvent where
parseJSON (Object v)
= do
eventType <- v .: "mouseEventType" :: Parser String
button <- parseJSON (Object v) :: Parser MouseButton
return $ case eventType of "click" -> Click button
"dblclick" -> DoubleClick button
"mousedown" -> MouseDown button
"mouseup" -> MouseUp button
"mouseenter" -> MouseEnter
"mouseleave" -> MouseLeave
"mousemove" -> MouseMove
instance FromJSON MouseButton where
parseJSON (Object v)
= do
button <- v .: "button" :: Parser String
return $ case button of "left" -> MouseLeft
"middle" -> MouseMiddle
"right" -> MouseRight
instance FromJSON Point where
parseJSON (Object v)
= do
x <- v .: "x"
y <- v .: "y"
return $ Point (x, y)
mouseInitializer :: Initializer
mouseInitializer sharedConst sharedIO
= do
(clientSocket, clientConn, serverSock) <- setupWebsocketConnection iNADDR_ANY mousePort
safePrintLn (safePrintToken sharedConst) "Mouse connection succesfull"
return (sharedConst, sharedIO, MouseConstants clientSocket clientConn serverSock, NoState)
mouseEventRetriever :: EventRetriever
mouseEventRetriever sharedConst sharedIOT ioConst ioStateT
= do
isConnected <- isConnected sock
case isConnected of
False -> return []
True -> do
messageM <- takeMessage safePrintToken_ sock conn
case messageM of
Nothing -> return []
(Just message) -> return [InMouse $ messageToMouseIn message]
where
sock = clientSocket ioConst
conn = clientConnection ioConst
safePrintToken_ = safePrintToken sharedConst
messageToMouseIn :: Message -> MouseIn
messageToMouseIn message = fromJust.decode $ BL.pack message
mouseEventSender :: EventSender
mouseEventSender sharedConst sharedIOT ioConst ioStateT Stop
= do
closeWebsocketConnection safePrintToken_ serverSock clientSock conn
where
serverSock = serverSocket ioConst
clientSock = clientSocket ioConst
conn = clientConnection ioConst
safePrintToken_ = safePrintToken sharedConst
mouseTeardown :: Teardown
mouseTeardown sharedConst sharedIO ioConst ioState
= do
destroyWebsocketConnection serverSock clientSock
return sharedIO
where
serverSock = serverSocket ioConst
clientSock = clientSocket ioConst
conn = clientConnection ioConst