--{-# LANGUAGE TupleSections #-} {-# LANGUAGE BangPatterns #-} {- | Basic helpers. These modules should have few dependencies. -} module Dodge.Base ( module Dodge.Base , module Dodge.Base.Arithmetic , 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 Dodge.Base.Wall import Dodge.Base.Arithmetic import Dodge.Base.NewID import Dodge.Base.Coordinate import Dodge.Base.CardinalPoint import Data.List (unfoldr) --import Dodge.Zone --import Dodge.Zone.Data import Dodge.Base.Window import Dodge.Base.Collide import Geometry --import Picture import qualified IntMapHelp as IM --import FoldableHelp import Dodge.Base.You import Control.Lens --import Data.Bifunctor --import qualified Data.IntSet as IS --import qualified Data.Set as S {- | 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 :: Int -- ^ First key -> Int -- ^ Second key -> Int -- ^ Third key -> a -- ^ Item to insert -> 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 :: Int -- ^ First key -> Int -- ^ Second key -> Int -- ^ Third key -> 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 :: (a -> a) -- ^ Update function -> Int -- ^ First key -> Int -- ^ Second key -> Int -- ^ Third key -> 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 :: Float -- ^ Speed. -> Point2 -- ^ End point. -> Point2 -- ^ Start point. -> 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 :: Float -- ^ Speed. -> Point2 -- ^ End point. -> Point2 -- ^ Start point. -> 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 :: Point2 -- ^ End point. -> Point2 -- ^ Start point. -> 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]]