{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

{-
    Convenience function to put it all together.
-}
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