{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}
-- | Game time and speed.
module Game.LambdaHack.Common.Time
  ( Time, timeZero, timeEpsilon, timeClip, timeTurn, timeSecond
  , absoluteTimeAdd, absoluteTimeSubtract, absoluteTimeNegate
  , timeFit, timeFitUp
  , Delta(..), timeShift, timeDeltaToFrom, timeDeltaAdd, timeDeltaSubtract
  , timeDeltaReverse, timeDeltaScale, timeDeltaPercent, timeDeltaDiv
  , timeDeltaToDigit
  , Speed, toSpeed, fromSpeed, minSpeed
  , speedZero, speedWalk, speedLimp, speedThrust, modifyDamageBySpeed
  , speedScale, speedAdd, speedNegate
  , ticksPerMeter, speedFromWeight, rangeFromSpeedAndLinger
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , _timeTick, turnsInSecond, sInMs, minimalSpeed, rangeFromSpeed
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Common.Prelude

import           Data.Binary
import qualified Data.Char as Char
import           Data.Int (Int64)

-- | Game time in ticks. The time dimension.
-- One tick is 1 microsecond (one millionth of a second),
-- one turn is 0.5 s.
newtype Time = Time {timeTicks :: Int64}
  deriving (Show, Eq, Ord, Enum, Bounded, Binary)

-- | Start of the game time, or zero lenght time interval.
timeZero :: Time
timeZero = Time 0

-- | The smallest unit of time. Should not be exported and used elsewhere,
-- because the proportion of turn to tick is an implementation detail.
-- The significance of this detail is only that it determines resolution
-- of the time dimension.
_timeTick :: Time
_timeTick = Time 1

-- | An infinitesimal time period.
timeEpsilon :: Time
timeEpsilon = _timeTick

-- | At least once per clip all moves are resolved
-- and a frame or a frame delay is generated.
-- Currently one clip is 0.05 s, but it may change,
-- and the code should not depend on this fixed value.
timeClip :: Time
timeClip = Time 50000

-- | One turn is 0.5 s. The code may depend on that.
-- Actors at normal speed (2 m/s) take one turn to move one tile (1 m by 1 m).
timeTurn :: Time
timeTurn = Time 500000

-- | This many turns fit in a single second.
turnsInSecond :: Int64
turnsInSecond = 2

-- | This many ticks fits in a single second. Do not export,
timeSecond :: Time
timeSecond = Time $ timeTicks timeTurn * turnsInSecond

-- | Absolute time addition, e.g., for summing the total game session time
-- from the times of individual games.
absoluteTimeAdd :: Time -> Time -> Time
{-# INLINE absoluteTimeAdd #-}
absoluteTimeAdd (Time t1) (Time t2) = Time (t1 + t2)

absoluteTimeSubtract :: Time -> Time -> Time
{-# INLINE absoluteTimeSubtract #-}
absoluteTimeSubtract (Time t1) (Time t2) = Time (t1 - t2)

-- | Absolute time negation. To be used for reversing time flow,
-- e.g., for comparing absolute times in the reverse order.
absoluteTimeNegate :: Time -> Time
{-# INLINE absoluteTimeNegate #-}
absoluteTimeNegate (Time t) = Time (-t)

-- | How many time intervals of the latter kind fits in an interval
-- of the former kind.
timeFit :: Time -> Time -> Int
{-# INLINE timeFit #-}
timeFit (Time t1) (Time t2) = fromEnum $ t1 `div` t2

-- | How many time intervals of the latter kind cover an interval
-- of the former kind (rounded up).
timeFitUp :: Time -> Time -> Int
{-# INLINE timeFitUp #-}
timeFitUp (Time t1) (Time t2) = fromEnum $ t1 `divUp` t2

-- | One-dimentional vectors. Introduced to tell apart the 2 uses of Time:
-- as an absolute game time and as an increment.
newtype Delta a = Delta a
  deriving (Show, Eq, Ord, Enum, Bounded, Binary, Functor)

-- | Shifting an absolute time by a time vector.
timeShift :: Time -> Delta Time -> Time
{-# INLINE timeShift #-}
timeShift (Time t1) (Delta (Time t2)) = Time (t1 + t2)

-- | Time time vector between the second and the first absolute times.
-- The arguments are in the same order as in the underlying scalar subtraction.
timeDeltaToFrom :: Time -> Time -> Delta Time
{-# INLINE timeDeltaToFrom #-}
timeDeltaToFrom (Time t1) (Time t2) = Delta $ Time (t1 - t2)

-- | Addition of time deltas.
timeDeltaAdd :: Delta Time -> Delta Time -> Delta Time
{-# INLINE timeDeltaAdd #-}
timeDeltaAdd (Delta (Time t1)) (Delta (Time t2)) = Delta $ Time (t1 - t2)

-- | Subtraction of time deltas.
-- The arguments are in the same order as in the underlying scalar subtraction.
timeDeltaSubtract :: Delta Time -> Delta Time -> Delta Time
{-# INLINE timeDeltaSubtract #-}
timeDeltaSubtract (Delta (Time t1)) (Delta (Time t2)) = Delta $ Time (t1 - t2)

-- | Reverse a time vector.
timeDeltaReverse :: Delta Time -> Delta Time
{-# INLINE timeDeltaReverse #-}
timeDeltaReverse (Delta (Time t)) = Delta (Time (-t))

-- | Scale the time vector by an @Int@ scalar value.
timeDeltaScale :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaScale #-}
timeDeltaScale (Delta (Time t)) s = Delta (Time (t * fromIntegral s))

-- | Take the given percent of the time vector.
timeDeltaPercent :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaPercent #-}
timeDeltaPercent (Delta (Time t)) s =
  Delta (Time (t * fromIntegral s `div` 100))

-- | Divide a time vector.
timeDeltaDiv :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaDiv #-}
timeDeltaDiv (Delta (Time t)) n = Delta (Time (t `div` fromIntegral n))

-- | Represent the main 10 thresholds of a time range by digits,
-- given the total length of the time range.
timeDeltaToDigit :: Delta Time -> Delta Time -> Char
{-# INLINE timeDeltaToDigit #-}
timeDeltaToDigit (Delta (Time maxT)) (Delta (Time t)) =
  let k = 1 + 9 * t `div` maxT
      digit | k > 9     = '*'
            | k < 1     = '-'
            | otherwise = Char.intToDigit $ fromEnum k
  in digit

-- | Speed in meters per 1 million seconds (m/Ms).
-- Actors at normal speed (2 m/s) take one time turn (0.5 s)
-- to make one step (move one tile, which is 1 m by 1 m).
newtype Speed = Speed Int64
  deriving (Eq, Ord, Binary)

instance Show Speed where
  show s = show $ fromSpeed s

-- | Number of seconds in a mega-second.
sInMs :: Int64
sInMs = 1000000

-- | Constructor for content definitions.
toSpeed :: Int -> Speed
{-# INLINE toSpeed #-}
toSpeed s = Speed $ fromIntegral s * sInMs `div` 10

-- | Pretty-printing of speed in the format used in content definitions.
fromSpeed :: Speed -> Int
{-# INLINE fromSpeed #-}
fromSpeed (Speed s) = fromEnum $ s * 10 `div` sInMs

minSpeed :: Int
minSpeed = 5

-- | The minimal speed is half a meter (half a step across a tile)
-- per second (two standard turns, which the time span during which
-- projectile moves, unless it has modified linger value).
-- This is four times slower than standard human movement speed.
--
-- It needen't be lower, because @rangeFromSpeed@ gives 0 steps
-- with such speed, so the actor's trajectory is empty, so it drops down
-- at once. Twice that speed already moves a normal projectile one step
-- before it stops. It shouldn't be lower or a slow actor would incur
-- such a time debt for performing a single action that he'd be paralyzed
-- for many turns, e.g., leaving his dead body on the screen for very long.
minimalSpeed :: Int64
minimalSpeed =
  let Speed msp = toSpeed minSpeed
  in assert (msp == sInMs `div` 2) msp

-- | No movement possible at that speed.
speedZero :: Speed
speedZero = Speed 0

-- | Fast walk speed (2 m/s) that suffices to move one tile in one turn.
speedWalk :: Speed
speedWalk = Speed $ 2 * sInMs

-- | Limp speed (1 m/s) that suffices to move one tile in two turns.
-- This is the minimal speed for projectiles to fly just one space and drop.
speedLimp :: Speed
speedLimp = Speed sInMs

-- | Sword thrust speed (10 m/s). Base weapon damages, both melee and ranged,
-- are given assuming this speed and ranged damage is modified
-- accordingly when projectile speeds differ. Differences in melee
-- weapon swing speeds are captured in damage bonuses instead,
-- since many other factors influence total damage.
--
-- Billiard ball is 25 m/s, sword swing at the tip is 35 m/s,
-- medieval bow is 70 m/s, AK47 is 700 m/s.
speedThrust :: Speed
speedThrust = Speed $ 10 * sInMs

-- | Modify damage when projectiles is at a non-standard speed.
-- Energy and so damage is proportional to the square of speed,
-- hence the formula.
modifyDamageBySpeed :: Int64 -> Speed -> Int64
modifyDamageBySpeed dmg (Speed s) =
  let Speed sThrust = speedThrust
  in round (fromIntegral dmg * fromIntegral s ^ (2 :: Int)  -- overflows Int64
            / fromIntegral sThrust ^ (2 :: Int) :: Double)

-- | Scale speed by an @Int@ scalar value.
speedScale :: Rational -> Speed -> Speed
{-# INLINE speedScale #-}
speedScale s (Speed v) = Speed (round $ fromIntegral v * s)

-- | Speed addition.
speedAdd :: Speed -> Speed -> Speed
{-# INLINE speedAdd #-}
speedAdd (Speed s1) (Speed s2) = Speed (s1 + s2)

-- | Speed negation.
speedNegate :: Speed -> Speed
{-# INLINE speedNegate #-}
speedNegate (Speed n) = Speed (-n)

-- | The number of time ticks it takes to walk 1 meter at the given speed.
ticksPerMeter :: Speed -> Delta Time
{-# INLINE ticksPerMeter #-}
ticksPerMeter (Speed v) =
  -- Prevent division by zero or infinite time taken for any action.
  Delta $ Time $ timeTicks timeSecond * sInMs `divUp` max minimalSpeed v

-- | Calculate projectile speed from item weight in grams
-- and velocity percent modifier.
-- See <https://github.com/LambdaHack/LambdaHack/wiki/Item-statistics>.
speedFromWeight :: Int -> Int -> Speed
speedFromWeight !weight !throwVelocity =
  let w = fromIntegral weight
      mpMs | w < 250 = sInMs * 20
           | w < 1500 = sInMs * 20 * 1250 `div` (w + 1000)
           | w < 10500 = sInMs * (11000 - w) `div` 1000
           | otherwise = minimalSpeed * 2  -- move one step and drop
      v = mpMs * fromIntegral throwVelocity `div` 100
      -- We round down to the nearest multiple of 2M (unless the speed
      -- is very low), to ensure both turns of flight cover the same distance
      -- and that the speed matches the distance traveled exactly.
      multiple2M = if v > 2 * sInMs
                   then 2 * sInMs * (v `div` (2 * sInMs))
                   else v
  in Speed $ max minimalSpeed multiple2M

-- | Calculate maximum range in meters of a projectile from its speed.
-- See <https://github.com/LambdaHack/LambdaHack/wiki/Item-statistics>.
-- With this formula, each projectile flies for at most 1 second,
-- that is 2 standard turns, and then drops to the ground.
rangeFromSpeed :: Speed -> Int
{-# INLINE rangeFromSpeed #-}
rangeFromSpeed (Speed v) = fromEnum $ v `div` sInMs

-- | Calculate maximum range taking into account the linger percentage.
rangeFromSpeedAndLinger :: Speed -> Int -> Int
rangeFromSpeedAndLinger !speed !throwLinger =
  let range = rangeFromSpeed speed
  in throwLinger * range `divUp` 100