{-# LANGUAGE OverloadedStrings #-}
import Network.AMQP

import qualified Data.ByteString.Lazy as BL
import Data.Binary.Put

import System.Random
import Control.Monad (replicateM)
import Control.Concurrent as Concurrent

randomList :: (Random a) => Int -> a -> a -> IO([a])
randomList n min max = replicateM n $ randomRIO (min, max)

data Thing = Thing { 
  x :: Float, 
  y :: Float,
  xVel :: Float,
  yVel :: Float,
  xSize :: Float,
  ySize :: Float,
  r :: Int,
  g :: Int,
  b :: Int 
}

createRandomThing :: [Float] -> [Float] -> [Float] -> [Int] -> Thing
createRandomThing pos vel sz col = 
  Thing (pos!!0) (pos!!1) (vel!!0) (vel!!1) (sz!!0) (sz!!1) (col!!0) (col!!1) (col!!2)
  
serialiseAThing :: Thing -> Put
serialiseAThing thing = do
  putFloatbe $ x thing
  putFloatbe $ y thing
  putFloatbe $ xVel thing
  putFloatbe $ yVel thing
  putFloatbe $ xSize thing
  putFloatbe $ ySize thing
  putWord32be $ fromIntegral $ r thing
  putWord32be $ fromIntegral $ g thing
  putWord32be $ fromIntegral $ b thing

publishAThing :: Thing -> Channel -> IO (Maybe Int)
publishAThing thing channel = do
  let serialisedThing = serialiseAThing thing
  publishMsg channel "myExchange" "myKey"
            newMsg {msgBody = (runPut $ serialisedThing),
                msgDeliveryMode = Just Persistent}

createRandomThings :: [Float] -> [Float] -> [Float] -> [Int] -> [Thing]
createRandomThings (x:y:pos) (xVel:yVel:vel) (xSize:ySize:size) (r:g:b:colors) = [createRandomThing (x:y:[]) (xVel:yVel:[]) (xSize:ySize:[]) (r:g:b:[])] ++ createRandomThings pos vel size colors 
createRandomThings _ _ _ _ = []

publishThingsWithDelay :: [Thing] -> Channel -> IO ()
publishThingsWithDelay (x:xs) channel = do
  publishAThing x channel
  Concurrent.threadDelay(1000000)
  publishThingsWithDelay xs channel

publishThingsWithDelay [] channel = return () 

data World = World {
  things :: [Thing]
}

serialiseThings :: [Thing] -> Put
serialiseThings (thing:things) = do
  serialiseAThing thing
  serialiseThings things

serialiseThings [] = return ()

serialiseWorld :: World -> Put
serialiseWorld world = do
  putWord32be $ fromIntegral (length (things world))
  serialiseThings (things world) 

displayWorld :: World -> Channel -> IO (Maybe Int)
displayWorld world channel = do
  Concurrent.threadDelay(1000*16)
  publishMsg channel "myExchange" "myKey"
    newMsg {msgBody = (runPut $ serialiseWorld world), msgDeliveryMode = Just Persistent}   

flipThingColors :: Thing -> Thing
flipThingColors thing = Thing 
    ((x thing) + (xVel thing)) ((y thing) + (yVel thing))
    (xVel thing) (yVel thing)
    (xSize thing) (ySize thing)
    (r thing) (g thing) (b thing)

gameLoop :: World -> World
gameLoop world = World $ fmap flipThingColors (things world)

simulation initWorld chan = 
  loop initWorld chan
  where loop w chan = displayWorld w chan >> loop (gameLoop w) chan

main = do
    conn <- openConnection "127.0.0.1" "/" "guest" "guest"
    chan <- openChannel conn

    let numThings = 5000
    randomPos  <- randomList (2*numThings) ( -50 :: Float) (  50 :: Float)
    randomVel  <- randomList (2*numThings) (-0.2 :: Float) ( 0.2 :: Float)
    randomSize <- randomList (2*numThings) ( 1.0 :: Float) (  10 :: Float)
    randomColors <- randomList (3*numThings) (0 :: Int) (255 :: Int)
    let randomThings = createRandomThings randomPos randomVel randomSize randomColors

    -- declare a queue, exchange and binding
    declareQueue chan newQueue {queueName = "hello_machine", queueDurable = False}
    declareExchange chan newExchange {exchangeName = "myExchange", exchangeType = "direct"}
    bindQueue chan "hello_machine" "myExchange" "myKey"

    -- publishThingsWithDelay randomThings chan

    let world = World randomThings
    let numThingsInWorld = length (things world)
    putStrLn (show numThingsInWorld)
    -- displayWorld world chan
    simulation world chan

    getLine -- wait for keypress
    closeConnection conn
    putStrLn "connection closed"