Player.hs

module Game.Player(
    Player(..)
  , PlayerId(..)
  , PlayerMessage
  , playerActor
  ) where

import Control.Wire
import Control.Wire.Unsafe.Event (event)
import Data.Text (pack)
import Linear
import Prelude hiding (id, (.))

import Game.Bullet.Data
import Game.Core
import Game.Data
import Game.Player.Data
import Game.Shared

import Game.GoreAndAsh
import Game.GoreAndAsh.Actor
import Game.GoreAndAsh.Logging
import Game.GoreAndAsh.Network
import Game.GoreAndAsh.Sync

playerActor :: (PlayerId -> Player) -> AppActor PlayerId Game Player
playerActor initialPlayer = makeActor $ \i -> stateWire (initialPlayer i) $ mainController i
  where
  mainController i = proc (g, p) -> do
    p2 <- peerProcessIndexedM peer (ChannelID 0) i netProcess -< p
    (_, p3) <- peerProcessIndexedM peer (ChannelID 0) globalGameId globalNetProcess -< (g, p2)
    forceNF . serverSync playerSync i . playerShot -< p3
    where
    -- | Shortcut for peer
    peer = playerPeer $ initialPlayer i

    -- | Handle when player is shot
    playerShot :: AppWire Player Player
    playerShot = proc p -> do
      emsg <- actorMessages i isPlayerShotMessage -< ()
      let newPlayer = p {
          playerPos = 0
        }
      returnA -< event p (const newPlayer) emsg

    -- | Process player specific net messages
    netProcess :: Player -> PlayerNetMessage -> GameMonadT AppMonad Player
    netProcess p msg = case msg of
      NetMsgPlayerFire v -> do
        let d = normalize v
            v2 a = V2 a a
            pos = playerPos p + d * v2 (playerSize p * 1.5)
            vel = d * v2 bulletSpeed
        putMsgLnM LogInfo $ "Fire bullet at " <> pack (show pos) <> " with velocity " <> pack (show vel)
        actorSendM globalGameId $ GameSpawnBullet pos vel $ playerId p
        return p

    -- | Process global net messages from given peer (player)
    globalNetProcess :: (Game, Player) -> GameNetMessage -> GameMonadT AppMonad (Game, Player)
    globalNetProcess (g, p) msg = case msg of
      PlayerRequestId -> do
        peerSendIndexedM peer (ChannelID 0) globalGameId ReliableMessage $
          PlayerResponseId (toCounter i) (toCounter $ gameBulletColId g) (toCounter $ gamePlayerColId g)
        return (g, p)
      _ -> do
        putMsgLnM LogInfo $ pack $ show msg
        return (g, p)

    playerSync :: FullSync AppMonad PlayerId Player
    playerSync = Player
      <$> pure i
      <*> clientSide peer 0 playerPos
      <*> clientSide peer 1 playerColor
      <*> clientSide peer 2 playerRot
      <*> clientSide peer 3 playerSpeed
      <*> clientSide peer 4 playerSize
      <*> pure peer