{-# LANGUAGE OverloadedStrings #-} module Eventloop.Module.Websocket.Mouse.Mouse ( defaultMouseModuleConfiguration , defaultMouseModuleIOState , mouseModuleIdentifier , mouseInitializer , mouseEventRetriever , mouseTeardown ) where import Data.Aeson import Data.Aeson.Types import Control.Monad import Control.Applicative import Data.Maybe import qualified Data.ByteString.Lazy.Char8 as BL import qualified Eventloop.Utility.BufferedWebsockets as WS import Eventloop.Types.EventTypes import Eventloop.Types.Common import Eventloop.Module.Websocket.Mouse.Types import Eventloop.Utility.Config import Eventloop.Utility.Vectors defaultMouseModuleConfiguration :: EventloopModuleConfiguration defaultMouseModuleConfiguration = ( EventloopModuleConfiguration mouseModuleIdentifier defaultMouseModuleIOState (Just mouseInitializer) (Just mouseEventRetriever) Nothing Nothing (Just mouseTeardown) Nothing ) defaultMouseModuleIOState :: IOState defaultMouseModuleIOState = MouseState undefined undefined undefined undefined undefined 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 sharedIO _ = do (recvBuffer, clientSocket, clientConn, serverSock, bufferedReaderThread) <- WS.setupWebsocketConnection ipAddress mousePort putStrLn "Mouse connection succesfull" return (sharedIO, MouseState recvBuffer clientSocket clientConn serverSock bufferedReaderThread) mouseEventRetriever :: EventRetriever mouseEventRetriever sharedIO mouseState = do messages <- WS.takeMessages (receiveBuffer mouseState) return (sharedIO, mouseState, map ((.) InMouse messageToMouseIn) messages) messageToMouseIn :: WS.Message -> MouseIn messageToMouseIn message = fromJust.decode $ BL.pack message mouseTeardown :: Teardown mouseTeardown sharedIO ms = do WS.closeWebsocketConnection (serverSocket ms) (clientSocket ms) (clientConnection ms) (bufferedReaderThread ms) return (sharedIO, defaultMouseModuleIOState)