loop/src/Dodge/Base.hs

--{-# LANGUAGE TupleSections #-}
{-# LANGUAGE BangPatterns #-}

{- |
Basic helpers.
These modules should have few dependencies.
-}
module Dodge.Base (
    module Dodge.Base,
    module Dodge.Base.You,
    module Dodge.Base.NewID,
    module Dodge.Base.Window,
    module Dodge.Base.Coordinate,
    module Dodge.Base.Collide,
    module Dodge.Base.CardinalPoint,
    module Dodge.Base.Wall,
) where

import Control.Lens
import Data.List (unfoldr)
import Dodge.Base.CardinalPoint
import Dodge.Base.Collide
import Dodge.Base.Coordinate
import Dodge.Base.NewID
import Dodge.Base.Wall
import Dodge.Base.Window
import Dodge.Base.You
import Geometry
import qualified IntMapHelp as IM

-- | Expands a line out to a given thickness.
lineGeom :: Float -> Point2 -> Point2 -> [Point2]
lineGeom t x y
    | x == y = []
    | otherwise = [x +.+ n x y, x -.- n x y, y +.+ n x y, y -.- n x y]
  where
    n a b = (t * 0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))

{- | A triangular wedge thick at the first point and
 - tapering off to the second.
-}
wedgeGeom ::
    Float -> -- Thickness
    Point2 ->
    Point2 ->
    [Point2]
wedgeGeom t x y
    | x == y = []
    | otherwise = [x +.+ n x y, x -.- n x y, y]
  where
    n a b = (t * 0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))

-- | I believe this overwrites the value if it already exists, but not sure.
insertIMInZone ::
    -- | First key
    Int ->
    -- | Second key
    Int ->
    -- | Third key
    Int ->
    -- | Item to insert
    a ->
    IM.IntMap (IM.IntMap (IM.IntMap a)) ->
    IM.IntMap (IM.IntMap (IM.IntMap a))
insertIMInZone x y obid obj = IM.insertWith f x $ IM.singleton y $ IM.singleton obid obj
  where
    f _ = IM.insertWith g y $ IM.singleton obid obj
    g _ = IM.insert obid obj

deleteIMInZone ::
    -- | First key
    Int ->
    -- | Second key
    Int ->
    -- | Third key
    Int ->
    IM.IntMap (IM.IntMap (IM.IntMap a)) ->
    IM.IntMap (IM.IntMap (IM.IntMap a))
deleteIMInZone x y z = ix x . ix y %~ IM.delete z

adjustIMZone ::
    -- | Update function
    (a -> a) ->
    -- | First key
    Int ->
    -- | Second key
    Int ->
    -- | Third key
    Int ->
    IM.IntMap (IM.IntMap (IM.IntMap a)) ->
    IM.IntMap (IM.IntMap (IM.IntMap a))
adjustIMZone f x y n = IM.adjust f' x
  where
    f' = IM.adjust f'' y
    f'' = IM.adjust f n

-- | Create a logistic function given three parameters.
logistic :: Float -> Float -> Float -> (Float -> Float)
logistic x0 l k x = l / (1 + exp (k * (x0 - x)))

{- | given a target and a start point, shift toward the end point by a given
amount.
If close enough, end up on the end point
-}
mvPointTowardAtSpeed ::
    -- | Speed.
    Float ->
    -- | End point.
    Point2 ->
    -- | Start point.
    Point2 ->
    Point2
mvPointTowardAtSpeed !speed !ep !p
    | dist p ep < speed = ep
    | otherwise = p +.+ speed *.* normalizeV (ep -.- p)

{- | given a target and a start point, shift toward the end point by a given
amount.
If close enough, go past the end point
-}
mvPointAlongAtSpeed ::
    -- | Speed.
    Float ->
    -- | End point.
    Point2 ->
    -- | Start point.
    Point2 ->
    Point2
mvPointAlongAtSpeed !speed !ep !p
    | dist p ep == 0 = ep
    | otherwise = p +.+ speed *.* normalizeV (ep -.- p)

{- | given a target and a start point, shift toward the end point by 1.
If close enough, end up on the end point
-}
mvPointToward ::
    -- | End point.
    Point2 ->
    -- | Start point.
    Point2 ->
    Point2
mvPointToward !ep !p
    | dist p ep < 1 = ep
    | otherwise = p +.+ normalizeV (ep -.- p)

vecBetweenSpeed :: Float -> Point2 -> Point2 -> Point2
vecBetweenSpeed !s !sp !ep
    | dist sp ep < s = ep -.- sp
    | otherwise = s *.* normalizeV (ep -.- sp)

sigmoid :: Floating a => a -> a
sigmoid x = x / sqrt (1 + x ^ (2 :: Int))

normalizeAnglePi :: Float -> Float
normalizeAnglePi angle
    | normalizeAngle angle > pi = normalizeAngle angle - 2 * pi
    | otherwise = normalizeAngle angle

-- | Taken from online, splits a list into its even and odd elements
evenOddSplit :: [a] -> ([a], [a])
evenOddSplit = foldr f ([], [])
  where
    f a (ls, rs) = (rs, a : ls)

dbArg :: (a -> a -> b) -> a -> b
{-# INLINE dbArg #-}
dbArg f x = f x x

-- TODO check whether this is simply the reader monad, flipped
dbArgChain :: (a -> b -> b) -> (a -> b -> b) -> a -> b -> b
dbArgChain f g x = f x . g x

spreadAroundCenter :: Int -> Float -> [Float]
spreadAroundCenter i x = [x * fromIntegral j - x * fromIntegral (i -1) * 0.5 | j <- [0 .. i - 1]]

spreadFromCenter :: Int -> Float -> [Float]
spreadFromCenter i x = [x * fromIntegral j | j <- js]
  where
    js = take i outwardIntegers

outwardIntegers :: [Int]
outwardIntegers = unfoldr f (0, False)
  where
    f (x, True) = Just (x, (x, False))
    f (x, False) = Just (- x, (x + 1, True))

spreadCenter :: Int -> Float -> [Float]
spreadCenter i x = [x * fromIntegral j - x * fromIntegral (i -1) * 0.5 | j <- [0 .. i - 1]]