module Network.Metaverse where
import Control.Monad
import Control.Concurrent
import Data.Char
import Data.Word
import Data.Int
import Data.Bits
import Data.List
import Data.Binary
import Data.Binary.Put
import Data.Binary.IEEE754
import Data.Time.Clock
import Network.Metaverse.Utils
import Network.Metaverse.Packets
import Network.Metaverse.PacketTypes
import Network.Metaverse.Circuit
import Network.Metaverse.Login
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
login :: String -> String -> String -> IO Circuit
login firstName lastName password = do
token <- loginXml firstName lastName password
circ <- connectToSim token
source <- circuitSource circ
forkIO $ regionHandshaker circ source
circuitSend circ True $ CompleteAgentMovement $ CompleteAgentMovement_AgentData
(tokenAgentID token) (tokenSessionID token) (tokenCircuitCode token)
return circ
regionHandshaker :: Circuit -> IO PacketBody -> IO ()
regionHandshaker circ source = do
p <- source
case p of
RegionHandshake _ _ _ -> do
circuitSend circ True $ RegionHandshakeReply
(RegionHandshakeReply_AgentData (circuitAgentID circ) (circuitSessionID circ))
(RegionHandshakeReply_RegionInfo 0)
_ -> regionHandshaker circ source
sendAgentUpdate :: Circuit -> IO ()
sendAgentUpdate circ =
circuitSend circ True $ AgentUpdate $ AgentUpdate_AgentData
(circuitAgentID circ) (circuitSessionID circ)
(0,0,0,1) (0,0,0,1) 0 (128,128,20) (1,0,0) (0,1,0) (0,0,1) 128.0 0 0
sendAgentThrottle :: Circuit ->
Float -> Float -> Float -> Float -> Float -> Float -> Float
-> IO ()
sendAgentThrottle circ resend land wind cloud task texture asset = do
let putter = do putFloat32le resend
putFloat32le land
putFloat32le wind
putFloat32le cloud
putFloat32le task
putFloat32le texture
putFloat32le asset
let bin = B.concat (L.toChunks (runPut putter))
circuitSend circ True $ AgentThrottle
(AgentThrottle_AgentData (circuitAgentID circ) (circuitSessionID circ) (circuitCode circ))
(AgentThrottle_Throttle 0 bin)
sendSimpleIM :: Circuit -> UUID -> String -> IO Bool
sendSimpleIM circ toAgentID msg =
circuitSendSync circ $ ImprovedInstantMessage
(ImprovedInstantMessage_AgentData (circuitAgentID circ) (circuitSessionID circ))
(ImprovedInstantMessage_MessageBlock
False toAgentID 0 zeroUUID (0,0,0) 0 0 zeroUUID 0 (B.pack [0])
(B.pack (map (fromIntegral . ord) msg ++ [0])) B.empty)
data ChatMethod = Whisper | Say | Shout deriving (Eq, Enum)
sendChat :: Circuit -> Int -> ChatMethod -> String -> IO Bool
sendChat circ channel method msg =
circuitSendSync circ $ ChatFromViewer
(ChatFromViewer_AgentData (circuitAgentID circ) (circuitSessionID circ))
(ChatFromViewer_ChatData
(B.pack (map (fromIntegral . ord) msg ++ [0]))
(fromIntegral $ fromEnum method) (fromIntegral channel))
whisper :: Circuit -> String -> IO Bool
whisper circ msg = sendChat circ 0 Whisper msg
say :: Circuit -> String -> IO Bool
say circ msg = sendChat circ 0 Say msg
shout :: Circuit -> String -> IO Bool
shout circ msg = sendChat circ 0 Shout msg
commPrinter :: IO PacketBody -> IO ()
commPrinter source = do
msg <- source
case msg of
ImprovedInstantMessage
(ImprovedInstantMessage_AgentData _ _)
(ImprovedInstantMessage_MessageBlock _ _ _ _ _ _ dtype _ _ from text l)
-> do
let speaker = takeWhile (not . (== '\0')) $ map (chr . fromIntegral) $ B.unpack from
let msg = takeWhile (not . (== '\0')) $ map (chr . fromIntegral) $ B.unpack text
when (dtype `elem` [ 0, 1, 3, 4, 5, 6, 12, 17, 19, 31, 38 ]) $ do
putStrLn $ "IM: " ++ speaker ++ " -> " ++ msg
ChatFromSimulator
(ChatFromSimulator_ChatData from _ _ _ ctype aud _ text)
-> do
let speaker = takeWhile (not . (== '\0')) $ map (chr . fromIntegral) $ B.unpack from
let msg = takeWhile (not . (== '\0')) $ map (chr . fromIntegral) $ B.unpack text
when (aud /= 0 && ctype `elem` [ 0, 1, 2, 3, 6, 8 ]) $ do
putStrLn $ speaker ++ " -> " ++ msg
_ -> return ()
commPrinter source