Time.hs

{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}
-- | Game time and speed.
module Game.LambdaHack.Common.Time
  ( Time, timeZero, timeClip, timeTurn, timeEpsilon
  , absoluteTimeAdd, absoluteTimeNegate, timeFit, timeFitUp
  , Delta(..), timeShift, timeDeltaToFrom, timeDeltaReverse, timeDeltaScale
  , timeDeltaToDigit, ticksPerMeter
  , Speed, toSpeed, fromSpeed, speedZero, speedNormal
  , speedScale, timeDeltaDiv, speedAdd, speedNegate
  , speedFromWeight, rangeFromSpeed, rangeFromSpeedAndLinger
  ) where

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

import Game.LambdaHack.Common.Misc

-- | 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 Int64
  deriving (Show, Eq, Ord, Enum, Bounded, Binary)

-- | 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)

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

-- | The smallest unit of time. Do not export, 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

-- TODO: don't have a fixed time, but instead set it at 1/3 or 1/4
-- of timeTurn depending on level. Clips are a UI feature
-- after all, so should depend on the user situation.
-- | At least once per clip all moves are resolved and a frame
-- or a frame delay is generated.
-- Currently one clip is 0.1 s, but it may change,
-- and the code should not depend on this fixed value.
timeClip :: Time
timeClip = Time 100000

-- | 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,
_ticksInSecond :: Int64
_ticksInSecond =
  let Time ticksInTurn = timeTurn
  in ticksInTurn * turnsInSecond

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

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

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

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

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

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

-- | 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
timeDeltaToFrom (Time t1) (Time t2) = Delta $ Time (t1 - t2)

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

-- | Divide a time vector.
timeDeltaDiv :: Delta Time -> Int -> Delta Time
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
timeDeltaToDigit (Delta (Time maxT)) (Delta (Time t)) =
  let k = 10 * t `div` maxT
      digit | k > 9     = '*'
            | k < 0     = '-'
            | otherwise = Char.intToDigit $ fromIntegral 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
toSpeed s = Speed $ fromIntegral s * sInMs `div` 10

-- Can't be lower or actors would slow down (via tmp organs and weight),
-- boost time with InsertMove, speed up and have lots of free moves.
minimalSpeed :: Int64
minimalSpeed = sInMs `div` 10

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

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

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

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

-- | Speed addition.
speedAdd :: Speed -> Speed -> Speed
speedAdd (Speed s1) (Speed s2) = Speed (s1 + s2)

-- | Speed negation.
speedNegate :: Speed -> Speed
speedNegate (Speed n) = Speed (-n)

-- | The number of time ticks it takes to walk 1 meter at the given speed.
ticksPerMeter :: Speed -> Delta Time
ticksPerMeter (Speed v) =
  Delta $ Time $ _ticksInSecond * 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 velocityPercent =
  let w = fromIntegral weight
      vp = fromIntegral velocityPercent
      mpMs | w <= 500 = sInMs * 16
           | w > 500 && w <= 2000 = sInMs * 16 * 1500 `div` (w + 1000)
           | w < 16000 = sInMs * (18000 - w) `div` 1000
           | w < 200000 = sInMs  -- half a step per turn is the minimum
           | otherwise = minimalSpeed  -- unless _very_ heavy
               -- TODO: such high weight should also affect moving
      v = mpMs * vp `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 = sInMs * if v > 2 * sInMs
                           then 2 * (v `div` (2 * sInMs))
                           else v `div` sInMs
      minimumSpeed = if mpMs == minimalSpeed then minimalSpeed else sInMs
  in Speed $ max minimumSpeed 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 turns, and then drops to the ground.
rangeFromSpeed :: Speed -> Int
rangeFromSpeed (Speed v) = fromIntegral $ v `div` sInMs

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