{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Common.Time
( Time, timeTicks
, timeZero, timeEpsilon, timeClip, timeTurn, timeSecond, clipsInTurn
, absoluteTimeAdd, absoluteTimeSubtract, absoluteTimeNegate
, timeFit, timeFitUp
, Delta(..), timeShift, timeDeltaToFrom, timeDeltaAdd, timeDeltaSubtract
, timeDeltaReverse, timeDeltaScale, timeDeltaPercent, timeDeltaDiv
, timeDeltaToDigit, timeDeltaInSecondsText
, Speed, toSpeed, fromSpeed, minSpeed, displaySpeed
, speedZero, speedWalk, speedLimp, speedThrust, modifyDamageBySpeed
, speedScale, speedAdd
, ticksPerMeter, speedFromWeight, rangeFromSpeedAndLinger
#ifdef EXPOSE_INTERNAL
, _timeTick, turnsInSecond, sInMs, minimalSpeed, rangeFromSpeed
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Binary
import qualified Data.Char as Char
import Data.Int (Int64)
import Game.LambdaHack.Common.Misc
newtype Time = Time {timeTicks :: Int64}
deriving (Show, Eq, Ord, Binary)
timeZero :: Time
timeZero = Time 0
_timeTick :: Time
_timeTick = Time 1
timeEpsilon :: Time
timeEpsilon = _timeTick
timeClip :: Time
timeClip = Time 50000
timeTurn :: Time
timeTurn = Time 500000
timeSecond :: Time
timeSecond = Time $ timeTicks timeTurn * turnsInSecond
turnsInSecond :: Int64
turnsInSecond = 2
clipsInTurn :: Int
clipsInTurn =
let r = timeTurn `timeFit` timeClip
in assert (r >= 5) r
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)
absoluteTimeNegate :: Time -> Time
{-# INLINE absoluteTimeNegate #-}
absoluteTimeNegate (Time t) = Time (-t)
timeFit :: Time -> Time -> Int
{-# INLINE timeFit #-}
timeFit (Time t1) (Time t2) = fromEnum $ t1 `div` t2
timeFitUp :: Time -> Time -> Int
{-# INLINE timeFitUp #-}
timeFitUp (Time t1) (Time t2) = fromEnum $ t1 `divUp` t2
newtype Delta a = Delta a
deriving (Show, Eq, Ord, Binary, Functor)
timeShift :: Time -> Delta Time -> Time
{-# INLINE timeShift #-}
timeShift (Time t1) (Delta (Time t2)) = Time (t1 + t2)
timeDeltaToFrom :: Time -> Time -> Delta Time
{-# INLINE timeDeltaToFrom #-}
timeDeltaToFrom (Time t1) (Time t2) = Delta $ Time (t1 - t2)
timeDeltaAdd :: Delta Time -> Delta Time -> Delta Time
{-# INLINE timeDeltaAdd #-}
timeDeltaAdd (Delta (Time t1)) (Delta (Time t2)) = Delta $ Time (t1 - t2)
timeDeltaSubtract :: Delta Time -> Delta Time -> Delta Time
{-# INLINE timeDeltaSubtract #-}
timeDeltaSubtract (Delta (Time t1)) (Delta (Time t2)) = Delta $ Time (t1 - t2)
timeDeltaReverse :: Delta Time -> Delta Time
{-# INLINE timeDeltaReverse #-}
timeDeltaReverse (Delta (Time t)) = Delta (Time (-t))
timeDeltaScale :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaScale #-}
timeDeltaScale (Delta (Time t)) s = Delta (Time (t * fromIntegral s))
timeDeltaPercent :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaPercent #-}
timeDeltaPercent (Delta (Time t)) s =
Delta (Time (t * fromIntegral s `div` 100))
timeDeltaDiv :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaDiv #-}
timeDeltaDiv (Delta (Time t)) n = Delta (Time (t `div` fromIntegral n))
timeDeltaToDigit :: Delta Time -> Delta Time -> Char
{-# INLINE timeDeltaToDigit #-}
timeDeltaToDigit (Delta (Time maxT)) (Delta (Time t)) =
let n = (20 * t) `div` maxT
k = (n + 1) `div` 2
digit | k > 9 = '9'
| k < 1 = '1'
| otherwise = Char.intToDigit $ fromEnum k
in digit
timeDeltaInSeconds :: Delta Time -> Int64
timeDeltaInSeconds (Delta (Time dt)) = oneM * dt `div` timeTicks timeSecond
timeDeltaInSecondsText :: Delta Time -> Text
timeDeltaInSecondsText delta = show64With2 (timeDeltaInSeconds delta) <> "s"
newtype Speed = Speed Int64
deriving (Eq, Ord, Binary)
instance Show Speed where
show s = show $ fromSpeed s
sInMs :: Int64
sInMs = 1000000
toSpeed :: Int -> Speed
{-# INLINE toSpeed #-}
toSpeed s = Speed $ fromIntegral s * sInMs `div` 10
fromSpeed :: Speed -> Int
{-# INLINE fromSpeed #-}
fromSpeed (Speed s) = fromEnum $ s * 10 `div` sInMs
minSpeed :: Int
minSpeed = 5
displaySpeed :: Int -> String
displaySpeed kRaw =
let k = max minSpeed kRaw
l = k `div` 10
x = k - l * 10
in show l
<> (if x == 0 then "" else "." <> show x)
<> "m/s"
minimalSpeed :: Int64
minimalSpeed =
let Speed msp = toSpeed minSpeed
in assert (msp == sInMs `div` 2) msp
speedZero :: Speed
speedZero = Speed 0
speedWalk :: Speed
speedWalk = Speed $ 2 * sInMs
speedLimp :: Speed
speedLimp = Speed sInMs
speedThrust :: Speed
speedThrust = Speed $ 10 * sInMs
modifyDamageBySpeed :: Int64 -> Speed -> Int64
modifyDamageBySpeed dmg (Speed s) =
let Speed sThrust = speedThrust
in round (fromIntegral dmg * fromIntegral s ^ (2 :: Int)
/ fromIntegral sThrust ^ (2 :: Int) :: Double)
speedScale :: Rational -> Speed -> Speed
{-# INLINE speedScale #-}
speedScale s (Speed v) = Speed (round $ fromIntegral v * s)
speedAdd :: Speed -> Speed -> Speed
{-# INLINE speedAdd #-}
speedAdd (Speed s1) (Speed s2) = Speed (s1 + s2)
ticksPerMeter :: Speed -> Delta Time
{-# INLINE ticksPerMeter #-}
ticksPerMeter (Speed v) =
Delta $ Time $ timeTicks timeSecond * sInMs `divUp` max minimalSpeed v
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
v = mpMs * fromIntegral throwVelocity `div` 100
multiple2M = if v > 2 * sInMs
then 2 * sInMs * (v `div` (2 * sInMs))
else v
in Speed $ max minimalSpeed multiple2M
rangeFromSpeed :: Speed -> Int
{-# INLINE rangeFromSpeed #-}
rangeFromSpeed (Speed v) = fromEnum $ v `div` sInMs
rangeFromSpeedAndLinger :: Speed -> Int -> Int
rangeFromSpeedAndLinger !speed !throwLinger =
let range = rangeFromSpeed speed
in throwLinger * range `divUp` 100