{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}
-- | Game time and speed.
module Game.LambdaHack.Common.Time
  ( Time, timeTicks
  , timeZero, timeEpsilon, timeClip, timeTurn, timeSecond, clipsInTurn
  , absoluteTimeAdd, absoluteTimeSubtract, absoluteTimeNegate
  , timeFit, timeFitUp, timeRecent5
  , Delta(..), timeShift, timeDeltaToFrom, timeDeltaAdd, timeDeltaSubtract
  , timeDeltaReverse, timeDeltaScale, timeDeltaPercent, timeDeltaDiv
  , timeDeltaToDigit, timeDeltaInSecondsText
  , Speed, toSpeed, fromSpeed, minSpeed, displaySpeed
  , speedWalk, speedLimp, speedThrust, modifyDamageBySpeed, speedScale, speedAdd
  , ticksPerMeter, speedFromWeight, rangeFromSpeedAndLinger
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , _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

-- | 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 {Time -> Int64
timeTicks :: Int64}
  deriving (Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Time] -> ShowS
$cshowList :: [Time] -> ShowS
show :: Time -> String
$cshow :: Time -> String
showsPrec :: Int -> Time -> ShowS
$cshowsPrec :: Int -> Time -> ShowS
Show, Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq, Eq Time
Eq Time
-> (Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmax :: Time -> Time -> Time
>= :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c< :: Time -> Time -> Bool
compare :: Time -> Time -> Ordering
$ccompare :: Time -> Time -> Ordering
$cp1Ord :: Eq Time
Ord, Get Time
[Time] -> Put
Time -> Put
(Time -> Put) -> Get Time -> ([Time] -> Put) -> Binary Time
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Time] -> Put
$cputList :: [Time] -> Put
get :: Get Time
$cget :: Get Time
put :: Time -> Put
$cput :: Time -> Put
Binary)

-- | Start of the game time, or zero lenght time interval.
timeZero :: Time
timeZero :: Time
timeZero = Int64 -> Time
Time Int64
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
_timeTick = Int64 -> Time
Time Int64
1

-- | An infinitesimal time period.
timeEpsilon :: Time
timeEpsilon :: Time
timeEpsilon = Time
_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
timeClip = Int64 -> Time
Time Int64
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
timeTurn = Int64 -> Time
Time Int64
500000

-- | This many ticks fits in a single second.
timeSecond :: Time
timeSecond :: Time
timeSecond = Int64 -> Time
Time (Int64 -> Time) -> Int64 -> Time
forall a b. (a -> b) -> a -> b
$ Time -> Int64
timeTicks Time
timeTurn Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
turnsInSecond

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

-- | This many clips fit in one turn. Determines the resolution
-- of actor move sampling and display updates.
clipsInTurn :: Int
clipsInTurn :: Int
clipsInTurn =
  let r :: Int
r = Time
timeTurn Time -> Time -> Int
`timeFit` Time
timeClip
  in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5) Int
r

-- | 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 -> Time -> Time
absoluteTimeAdd (Time Int64
t1) (Time Int64
t2) = Int64 -> Time
Time (Int64
t1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
t2)

absoluteTimeSubtract :: Time -> Time -> Time
{-# INLINE absoluteTimeSubtract #-}
absoluteTimeSubtract :: Time -> Time -> Time
absoluteTimeSubtract (Time Int64
t1) (Time Int64
t2) = Int64 -> Time
Time (Int64
t1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
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 -> Time
absoluteTimeNegate (Time Int64
t) = Int64 -> Time
Time (-Int64
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 -> Time -> Int
timeFit (Time Int64
t1) (Time Int64
t2) = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
t1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
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 -> Time -> Int
timeFitUp (Time Int64
t1) (Time Int64
t2) = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
t1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
t2

timeRecent5 :: Time -> Time -> Bool
timeRecent5 :: Time -> Time -> Bool
timeRecent5 Time
localTime Time
time = Time -> Time -> Delta Time
timeDeltaToFrom Time
localTime Time
time
                             Delta Time -> Delta Time -> Bool
forall a. Ord a => a -> a -> Bool
< Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn) Int
5

-- | 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 (Int -> Delta a -> ShowS
[Delta a] -> ShowS
Delta a -> String
(Int -> Delta a -> ShowS)
-> (Delta a -> String) -> ([Delta a] -> ShowS) -> Show (Delta a)
forall a. Show a => Int -> Delta a -> ShowS
forall a. Show a => [Delta a] -> ShowS
forall a. Show a => Delta a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delta a] -> ShowS
$cshowList :: forall a. Show a => [Delta a] -> ShowS
show :: Delta a -> String
$cshow :: forall a. Show a => Delta a -> String
showsPrec :: Int -> Delta a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Delta a -> ShowS
Show, Delta a -> Delta a -> Bool
(Delta a -> Delta a -> Bool)
-> (Delta a -> Delta a -> Bool) -> Eq (Delta a)
forall a. Eq a => Delta a -> Delta a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delta a -> Delta a -> Bool
$c/= :: forall a. Eq a => Delta a -> Delta a -> Bool
== :: Delta a -> Delta a -> Bool
$c== :: forall a. Eq a => Delta a -> Delta a -> Bool
Eq, Eq (Delta a)
Eq (Delta a)
-> (Delta a -> Delta a -> Ordering)
-> (Delta a -> Delta a -> Bool)
-> (Delta a -> Delta a -> Bool)
-> (Delta a -> Delta a -> Bool)
-> (Delta a -> Delta a -> Bool)
-> (Delta a -> Delta a -> Delta a)
-> (Delta a -> Delta a -> Delta a)
-> Ord (Delta a)
Delta a -> Delta a -> Bool
Delta a -> Delta a -> Ordering
Delta a -> Delta a -> Delta a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Delta a)
forall a. Ord a => Delta a -> Delta a -> Bool
forall a. Ord a => Delta a -> Delta a -> Ordering
forall a. Ord a => Delta a -> Delta a -> Delta a
min :: Delta a -> Delta a -> Delta a
$cmin :: forall a. Ord a => Delta a -> Delta a -> Delta a
max :: Delta a -> Delta a -> Delta a
$cmax :: forall a. Ord a => Delta a -> Delta a -> Delta a
>= :: Delta a -> Delta a -> Bool
$c>= :: forall a. Ord a => Delta a -> Delta a -> Bool
> :: Delta a -> Delta a -> Bool
$c> :: forall a. Ord a => Delta a -> Delta a -> Bool
<= :: Delta a -> Delta a -> Bool
$c<= :: forall a. Ord a => Delta a -> Delta a -> Bool
< :: Delta a -> Delta a -> Bool
$c< :: forall a. Ord a => Delta a -> Delta a -> Bool
compare :: Delta a -> Delta a -> Ordering
$ccompare :: forall a. Ord a => Delta a -> Delta a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Delta a)
Ord, Get (Delta a)
[Delta a] -> Put
Delta a -> Put
(Delta a -> Put)
-> Get (Delta a) -> ([Delta a] -> Put) -> Binary (Delta a)
forall a. Binary a => Get (Delta a)
forall a. Binary a => [Delta a] -> Put
forall a. Binary a => Delta a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Delta a] -> Put
$cputList :: forall a. Binary a => [Delta a] -> Put
get :: Get (Delta a)
$cget :: forall a. Binary a => Get (Delta a)
put :: Delta a -> Put
$cput :: forall a. Binary a => Delta a -> Put
Binary, a -> Delta b -> Delta a
(a -> b) -> Delta a -> Delta b
(forall a b. (a -> b) -> Delta a -> Delta b)
-> (forall a b. a -> Delta b -> Delta a) -> Functor Delta
forall a b. a -> Delta b -> Delta a
forall a b. (a -> b) -> Delta a -> Delta b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Delta b -> Delta a
$c<$ :: forall a b. a -> Delta b -> Delta a
fmap :: (a -> b) -> Delta a -> Delta b
$cfmap :: forall a b. (a -> b) -> Delta a -> Delta b
Functor)

-- | Shifting an absolute time by a time vector.
timeShift :: Time -> Delta Time -> Time
{-# INLINE timeShift #-}
timeShift :: Time -> Delta Time -> Time
timeShift (Time Int64
t1) (Delta (Time Int64
t2)) = Int64 -> Time
Time (Int64
t1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
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 -> Time -> Delta Time
timeDeltaToFrom (Time Int64
t1) (Time Int64
t2) = Time -> Delta Time
forall a. a -> Delta a
Delta (Time -> Delta Time) -> Time -> Delta Time
forall a b. (a -> b) -> a -> b
$ Int64 -> Time
Time (Int64
t1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
t2)

-- | Addition of time deltas.
timeDeltaAdd :: Delta Time -> Delta Time -> Delta Time
{-# INLINE timeDeltaAdd #-}
timeDeltaAdd :: Delta Time -> Delta Time -> Delta Time
timeDeltaAdd (Delta (Time Int64
t1)) (Delta (Time Int64
t2)) = Time -> Delta Time
forall a. a -> Delta a
Delta (Time -> Delta Time) -> Time -> Delta Time
forall a b. (a -> b) -> a -> b
$ Int64 -> Time
Time (Int64
t1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
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 -> Delta Time -> Delta Time
timeDeltaSubtract (Delta (Time Int64
t1)) (Delta (Time Int64
t2)) = Time -> Delta Time
forall a. a -> Delta a
Delta (Time -> Delta Time) -> Time -> Delta Time
forall a b. (a -> b) -> a -> b
$ Int64 -> Time
Time (Int64
t1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
t2)

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

-- | Scale the time vector by an @Int@ scalar value.
timeDeltaScale :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaScale #-}
timeDeltaScale :: Delta Time -> Int -> Delta Time
timeDeltaScale (Delta (Time Int64
t)) Int
s = Time -> Delta Time
forall a. a -> Delta a
Delta (Int64 -> Time
Time (Int64
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
forall target source. From source target => source -> target
into @Int64 Int
s))

-- | Take the given percent of the time vector.
timeDeltaPercent :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaPercent #-}
timeDeltaPercent :: Delta Time -> Int -> Delta Time
timeDeltaPercent (Delta (Time Int64
t)) Int
s =
  Time -> Delta Time
forall a. a -> Delta a
Delta (Int64 -> Time
Time (Int64
t Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
forall target source. From source target => source -> target
into @Int64 Int
s Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
100))

-- | Divide a time vector.
timeDeltaDiv :: Delta Time -> Int -> Delta Time
{-# INLINE timeDeltaDiv #-}
timeDeltaDiv :: Delta Time -> Int -> Delta Time
timeDeltaDiv (Delta (Time Int64
t)) Int
n = Time -> Delta Time
forall a. a -> Delta a
Delta (Int64 -> Time
Time (Int64
t Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int -> Int64
forall target source. From source target => source -> target
into @Int64 Int
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 -> Delta Time -> Char
timeDeltaToDigit (Delta (Time Int64
maxT)) (Delta (Time Int64
t)) =
  let n :: Int64
n = (Int64
20 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
t) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
maxT
      k :: Int64
k = (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
2
      digit :: Char
digit | Int64
k Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
9     = Char
'9'
            | Int64
k Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
1     = Char
'1'
            | Bool
otherwise = Int -> Char
Char.intToDigit (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a. Enum a => a -> Int
fromEnum Int64
k
  in Char
digit

-- @oneM@ times the number of seconds represented by the time delta
timeDeltaInSeconds :: Delta Time -> Int64
timeDeltaInSeconds :: Delta Time -> Int64
timeDeltaInSeconds (Delta (Time Int64
dt)) = Int64
oneM Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
dt Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Time -> Int64
timeTicks Time
timeSecond

timeDeltaInSecondsText :: Delta Time -> Text
timeDeltaInSecondsText :: Delta Time -> Text
timeDeltaInSecondsText Delta Time
delta = Int64 -> Text
show64With2 (Delta Time -> Int64
timeDeltaInSeconds Delta Time
delta) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s"

-- | 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 (Speed -> Speed -> Bool
(Speed -> Speed -> Bool) -> (Speed -> Speed -> Bool) -> Eq Speed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Speed -> Speed -> Bool
$c/= :: Speed -> Speed -> Bool
== :: Speed -> Speed -> Bool
$c== :: Speed -> Speed -> Bool
Eq, Eq Speed
Eq Speed
-> (Speed -> Speed -> Ordering)
-> (Speed -> Speed -> Bool)
-> (Speed -> Speed -> Bool)
-> (Speed -> Speed -> Bool)
-> (Speed -> Speed -> Bool)
-> (Speed -> Speed -> Speed)
-> (Speed -> Speed -> Speed)
-> Ord Speed
Speed -> Speed -> Bool
Speed -> Speed -> Ordering
Speed -> Speed -> Speed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Speed -> Speed -> Speed
$cmin :: Speed -> Speed -> Speed
max :: Speed -> Speed -> Speed
$cmax :: Speed -> Speed -> Speed
>= :: Speed -> Speed -> Bool
$c>= :: Speed -> Speed -> Bool
> :: Speed -> Speed -> Bool
$c> :: Speed -> Speed -> Bool
<= :: Speed -> Speed -> Bool
$c<= :: Speed -> Speed -> Bool
< :: Speed -> Speed -> Bool
$c< :: Speed -> Speed -> Bool
compare :: Speed -> Speed -> Ordering
$ccompare :: Speed -> Speed -> Ordering
$cp1Ord :: Eq Speed
Ord, Get Speed
[Speed] -> Put
Speed -> Put
(Speed -> Put) -> Get Speed -> ([Speed] -> Put) -> Binary Speed
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Speed] -> Put
$cputList :: [Speed] -> Put
get :: Get Speed
$cget :: Get Speed
put :: Speed -> Put
$cput :: Speed -> Put
Binary)

instance Show Speed where
  show :: Speed -> String
show Speed
s = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Speed -> Int
fromSpeed Speed
s

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

-- | Constructor for content definitions.
toSpeed :: Int -> Speed
{-# INLINE toSpeed #-}
toSpeed :: Int -> Speed
toSpeed Int
s = Int64 -> Speed
Speed (Int64 -> Speed) -> Int64 -> Speed
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall target source. From source target => source -> target
into @Int64 Int
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
sInMs Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
10

-- | Readable representation of speed in the format used in content definitions.
fromSpeed :: Speed -> Int
{-# INLINE fromSpeed #-}
fromSpeed :: Speed -> Int
fromSpeed (Speed Int64
s) = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
sInMs

minSpeed :: Int
minSpeed :: Int
minSpeed = Int
5

-- | Pretty-print speed given in the format used in content definitions.
displaySpeed :: Int -> String
displaySpeed :: Int -> String
displaySpeed Int
kRaw =
  let k :: Int
k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minSpeed Int
kRaw
      l :: Int
l = Int
k Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10
      x :: Int
x = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10
  in Int -> String
forall a. Show a => a -> String
show Int
l
     String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
x)
     String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"m/s"

-- | 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 :: Int64
minimalSpeed =
  let Speed Int64
msp = Int -> Speed
toSpeed Int
minSpeed
  in Bool -> Int64 -> Int64
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int64
msp Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
sInMs Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
2) Int64
msp

-- | Fast walk speed (2 m/s) that suffices to move one tile in one turn.
speedWalk :: Speed
speedWalk :: Speed
speedWalk = Int64 -> Speed
Speed (Int64 -> Speed) -> Int64 -> Speed
forall a b. (a -> b) -> a -> b
$ Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
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
speedLimp = Int64 -> Speed
Speed Int64
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
speedThrust = Int64 -> Speed
Speed (Int64 -> Speed) -> Int64 -> Speed
forall a b. (a -> b) -> a -> b
$ Int64
10 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
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 :: Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
dmg (Speed Int64
s) =
  let Speed Int64
sThrust = Speed
speedThrust
  in if Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
minimalSpeed
     then Int64
0  -- needed mostly not to display useless ranged damage
     else Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int64) -> Double -> Int64
forall a b. (a -> b) -> a -> b
$  -- Double, because overflows Int64
       Int64 -> Double
int64ToDouble Int64
dmg Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int64 -> Double
int64ToDouble Int64
s Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)
       Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
int64ToDouble Int64
sThrust Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)

-- | Scale speed by a scalar value.
speedScale :: Rational -> Speed -> Speed
{-# INLINE speedScale #-}
speedScale :: Rational -> Speed -> Speed
speedScale Rational
s (Speed Int64
v) =
  Int64 -> Speed
Speed (Rational -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int64) -> Rational -> Int64
forall a b. (a -> b) -> a -> b
$ (Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegralWrap :: Int64 -> Rational) Int64
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
s)

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

-- | The number of time ticks it takes to walk 1 meter at the given speed.
ticksPerMeter :: Speed -> Delta Time
{-# INLINE ticksPerMeter #-}
ticksPerMeter :: Speed -> Delta Time
ticksPerMeter (Speed Int64
v) =
  -- Prevent division by zero or infinite time taken for any action.
  Time -> Delta Time
forall a. a -> Delta a
Delta (Time -> Delta Time) -> Time -> Delta Time
forall a b. (a -> b) -> a -> b
$ Int64 -> Time
Time (Int64 -> Time) -> Int64 -> Time
forall a b. (a -> b) -> a -> b
$ Time -> Int64
timeTicks Time
timeSecond Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
sInMs Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
minimalSpeed Int64
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 :: Int -> Int -> Speed
speedFromWeight !Int
weight !Int
throwVelocity =
  let w :: Int64
w = Int -> Int64
forall target source. From source target => source -> target
into @Int64 Int
weight
      mpMs :: Int64
mpMs | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
250 = Int64
sInMs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
20
           | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
1500 = Int64
sInMs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
20 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1250 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` (Int64
w Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1000)
           | Int64
w Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
10500 = Int64
sInMs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Int64
11500 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
w) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000
           | Bool
otherwise = Int64
minimalSpeed Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
2  -- move one step and drop
      v :: Int64
v = Int64
mpMs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
forall target source. From source target => source -> target
into @Int64 Int
throwVelocity Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
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 :: Int64
multiple2M = if Int64
v Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
sInMs
                   then Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
sInMs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* (Int64
v Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
sInMs))
                   else Int64
v
  in Int64 -> Speed
Speed (Int64 -> Speed) -> Int64 -> Speed
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
minimalSpeed Int64
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 -> Int
rangeFromSpeed (Speed Int64
v) = Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64
v Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
sInMs

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