justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove non-existent import

Browse Source
This commit is contained in:
justin
2025-01-04 21:12:15 +00:00
parent 86173f9f6a
commit 02f5bdae31
1 changed files with 129 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+129 -107
View File
@@ -1,125 +1,147 @@
--{-# LANGUAGE TupleSections #-} --{-# LANGUAGE TupleSections #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{- | {- |
Basic helpers. Basic helpers.
These modules should have few dependencies. -} These modules should have few dependencies.
module Dodge.Base -}
( module Dodge.Base module Dodge.Base (
, module Dodge.Base.Arithmetic module Dodge.Base,
, module Dodge.Base.You module Dodge.Base.You,
, module Dodge.Base.NewID module Dodge.Base.NewID,
, module Dodge.Base.Window module Dodge.Base.Window,
, module Dodge.Base.Coordinate module Dodge.Base.Coordinate,
, module Dodge.Base.Collide module Dodge.Base.Collide,
, module Dodge.Base.CardinalPoint module Dodge.Base.CardinalPoint,
, module Dodge.Base.Wall module Dodge.Base.Wall,
) where ) 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 Control.Lens
--import Data.Bifunctor import Data.List (unfoldr)
--import qualified Data.IntSet as IS import Dodge.Base.CardinalPoint
--import qualified Data.Set as S 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. -} -- | Expands a line out to a given thickness.
lineGeom :: Float -> Point2 -> Point2 -> [Point2] lineGeom :: Float -> Point2 -> Point2 -> [Point2]
lineGeom t x y lineGeom t x y
| x == y = [] | x == y = []
| otherwise = [x +.+ n x y, x -.- n x y, y +.+ n x y, y -.- n x y] | otherwise = [x +.+ n x y, x -.- n x y, y +.+ n x y, y -.- n x y]
where where
n a b = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b)) 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. -} {- | A triangular wedge thick at the first point and
insertIMInZone - tapering off to the second.
:: Int -- ^ First key -}
-> Int -- ^ Second key wedgeGeom ::
-> Int -- ^ Third key Float -> -- Thickness
-> a -- ^ Item to insert Point2 ->
-> IM.IntMap (IM.IntMap (IM.IntMap a)) Point2 ->
-> IM.IntMap (IM.IntMap (IM.IntMap a)) [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 insertIMInZone x y obid obj = IM.insertWith f x $ IM.singleton y $ IM.singleton obid obj
where where
f _ = IM.insertWith g y $ IM.singleton obid obj f _ = IM.insertWith g y $ IM.singleton obid obj
g _ = IM.insert obid obj g _ = IM.insert obid obj
deleteIMInZone
:: Int -- ^ First key deleteIMInZone ::
-> Int -- ^ Second key -- | First key
-> Int -- ^ Third key Int ->
-> IM.IntMap (IM.IntMap (IM.IntMap a)) -- | Second key
-> IM.IntMap (IM.IntMap (IM.IntMap a)) 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 deleteIMInZone x y z = ix x . ix y %~ IM.delete z
adjustIMZone
:: (a -> a) -- ^ Update function adjustIMZone ::
-> Int -- ^ First key -- | Update function
-> Int -- ^ Second key (a -> a) ->
-> Int -- ^ Third key -- | First key
-> IM.IntMap (IM.IntMap (IM.IntMap a)) Int ->
-> IM.IntMap (IM.IntMap (IM.IntMap a)) -- | 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 adjustIMZone f x y n = IM.adjust f' x
where where
f' = IM.adjust f'' y f' = IM.adjust f'' y
f'' = IM.adjust f n f'' = IM.adjust f n
{- | Create a logistic function given three parameters. -} -- | Create a logistic function given three parameters.
logistic :: Float -> Float -> Float -> (Float -> Float) logistic :: Float -> Float -> Float -> (Float -> Float)
logistic x0 l k x = l / (1 + exp (k*(x0 - x))) 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 {- | given a target and a start point, shift toward the end point by a given
amount. amount.
If close enough, end up on the end point -} If close enough, end up on the end point
mvPointTowardAtSpeed -}
:: Float -- ^ Speed. mvPointTowardAtSpeed ::
-> Point2 -- ^ End point. -- | Speed.
-> Point2 -- ^ Start point. Float ->
-> Point2 -- | End point.
mvPointTowardAtSpeed !speed !ep !p Point2 ->
-- | Start point.
Point2 ->
Point2
mvPointTowardAtSpeed !speed !ep !p
| dist p ep < speed = ep | dist p ep < speed = ep
| otherwise = p +.+ speed *.* normalizeV (ep -.- p) | otherwise = p +.+ speed *.* normalizeV (ep -.- p)
{- | given a target and a start point, shift toward the end point by a given {- | given a target and a start point, shift toward the end point by a given
amount. amount.
If close enough, go past the end point -} If close enough, go past the end point
mvPointAlongAtSpeed -}
:: Float -- ^ Speed. mvPointAlongAtSpeed ::
-> Point2 -- ^ End point. -- | Speed.
-> Point2 -- ^ Start point. Float ->
-> Point2 -- | End point.
mvPointAlongAtSpeed !speed !ep !p Point2 ->
-- | Start point.
Point2 ->
Point2
mvPointAlongAtSpeed !speed !ep !p
| dist p ep == 0 = ep | dist p ep == 0 = ep
| otherwise = p +.+ speed *.* normalizeV (ep -.- p) | otherwise = p +.+ speed *.* normalizeV (ep -.- p)
{- | given a target and a start point, shift toward the end point by 1. {- | given a target and a start point, shift toward the end point by 1.
If close enough, end up on the end point -} If close enough, end up on the end point
mvPointToward -}
:: Point2 -- ^ End point. mvPointToward ::
-> Point2 -- ^ Start point. -- | End point.
-> Point2 Point2 ->
mvPointToward !ep !p -- | Start point.
Point2 ->
Point2
mvPointToward !ep !p
| dist p ep < 1 = ep | dist p ep < 1 = ep
| otherwise = p +.+ normalizeV (ep -.- p) | otherwise = p +.+ normalizeV (ep -.- p)
vecBetweenSpeed :: Float -> Point2 -> Point2 -> Point2 vecBetweenSpeed :: Float -> Point2 -> Point2 -> Point2
vecBetweenSpeed !s !sp !ep vecBetweenSpeed !s !sp !ep
@@ -127,18 +149,18 @@ vecBetweenSpeed !s !sp !ep
| otherwise = s *.* normalizeV (ep -.- sp) | otherwise = s *.* normalizeV (ep -.- sp)
sigmoid :: Floating a => a -> a sigmoid :: Floating a => a -> a
sigmoid x = x/sqrt(1+x^(2::Int)) sigmoid x = x / sqrt (1 + x ^ (2 :: Int))
normalizeAnglePi :: Float -> Float normalizeAnglePi :: Float -> Float
normalizeAnglePi angle normalizeAnglePi angle
| normalizeAngle angle > pi = normalizeAngle angle - 2*pi | normalizeAngle angle > pi = normalizeAngle angle - 2 * pi
| otherwise = normalizeAngle angle | otherwise = normalizeAngle angle
-- | Taken from online, splits a list into its even and odd elements -- | Taken from online, splits a list into its even and odd elements
evenOddSplit :: [a] -> ([a],[a]) evenOddSplit :: [a] -> ([a], [a])
evenOddSplit = foldr f ([],[]) evenOddSplit = foldr f ([], [])
where where
f a (ls,rs) = (rs, a : ls) f a (ls, rs) = (rs, a : ls)
dbArg :: (a -> a -> b) -> a -> b dbArg :: (a -> a -> b) -> a -> b
{-# INLINE dbArg #-} {-# INLINE dbArg #-}
@@ -149,7 +171,7 @@ dbArgChain :: (a -> b -> b) -> (a -> b -> b) -> a -> b -> b
dbArgChain f g x = f x . g x dbArgChain f g x = f x . g x
spreadAroundCenter :: Int -> Float -> [Float] spreadAroundCenter :: Int -> Float -> [Float]
spreadAroundCenter i x = [x * fromIntegral j - x*fromIntegral (i-1)*0.5 | j <- [0 .. i - 1]] spreadAroundCenter i x = [x * fromIntegral j - x * fromIntegral (i -1) * 0.5 | j <- [0 .. i - 1]]
spreadFromCenter :: Int -> Float -> [Float] spreadFromCenter :: Int -> Float -> [Float]
spreadFromCenter i x = [x * fromIntegral j | j <- js] spreadFromCenter i x = [x * fromIntegral j | j <- js]
@@ -159,8 +181,8 @@ spreadFromCenter i x = [x * fromIntegral j | j <- js]
outwardIntegers :: [Int] outwardIntegers :: [Int]
outwardIntegers = unfoldr f (0, False) outwardIntegers = unfoldr f (0, False)
where where
f (x,True) = Just (x, (x,False)) f (x, True) = Just (x, (x, False))
f (x,False) = Just (-x, (x+1,True)) f (x, False) = Just (- x, (x + 1, True))
spreadCenter :: Int -> Float -> [Float] spreadCenter :: Int -> Float -> [Float]
spreadCenter i x = [x * fromIntegral j - x*fromIntegral (i-1)*0.5 | j <- [0 .. i - 1]] spreadCenter i x = [x * fromIntegral j - x * fromIntegral (i -1) * 0.5 | j <- [0 .. i - 1]]