wraparound-0.0.2: Data/WrapAround.hs
{-|
WrapAround is a convenience module which helps you perform calculations with
points that are supposed to exist on a 2-dimensional, finite, unbounded plane.
(Or infinite, bounded plane, depending on who you ask.) On such a plane, space
wraps around so that an object travelling vertically or horizontally eventually
comes back to the place where it started. This allows you to move objects
around on a seamless map. For example, in some video games when an object
crosses the bottom of the screen it reappears at the top.
WrapAround represents the points and handles the common calculations properly
so you don't have to bother with the messy math and edge cases. This is done
with two data structures: a 'WrapMap', which stores information about the size
of the plane, and a 'WrapPoint', which stores information about the location of
the point.
When you need the actual x, y coordinates, use the 'toCoords' conversion
function.
A WrapPoint is represented internally as a pair of angles, like in a torus.
The WrapMap and WrapPoint structures are kept separate because some WrapPoint
calculations can be performed without a WrapMap context. Functions typically
only need a WrapMap when a WrapPoint must be converted to actual x, y
coordinates or vice versa. Typically you do not want perform calculations with
WrapPoints that were generated with different WrapMaps, but this is possible
and sometimes useful.
If you are grateful for this software, I gladly accept donations!
<https://frigidcode.com/donate/>
-}
module Data.WrapAround ( WrapMap()
, WM
, wrapmap
, wm
, WrapPoint()
, WP
, wrappoint
, wp
, addPoints
, add
, addPoints'
, add'
, distance
, subtractPoints
, diff
, subtractPoints'
, diff'
, toCoords
, coords
, vec
, vectorRelation
, relation
-- , windowView
-- , WrapWindow(..)
) where
-- |Contains the contextual information necessary to convert a WrapPoint to
-- coordinates and vice versa.
data WrapMap = WrapMap { radiusr :: Double -- radius from tube center
, radiusR :: Double -- radius from torus center
}
deriving (Show)
type WM = WrapMap
circleRadians = 2 * pi
radius = (/ circleRadians)
-- |Generates a 'WrapMap'.
wm, wrapmap :: Double -- ^ Width
-> Double -- ^ Height
-> WrapMap
wrapmap w h = WrapMap { radiusR = radius h
, radiusr = radius w
}
wm = wrapmap
-- |A representation of a point location that allows for wrapping in the
-- vertical or horizontal direction.
data WrapPoint = WrapPoint { angler :: Double -- radians around tube center
, angleR :: Double -- radians around torus center
}
deriving (Show)
type WP = WrapPoint
-- |Generates a 'WrapPoint'.
wp, wrappoint :: WrapMap -- ^ Corresponding WrapMap structure
-> (Double, Double) -- ^ x, y coordinates
-> WrapPoint
wrappoint wmap (x, y) =
WrapPoint { angleR = fixAngle (y / radiusR wmap)
, angler = fixAngle (x / radiusr wmap)
}
wp = wrappoint
-- |Converts a 'WrapPoint' to coordinates.
coords,toCoords,vec :: WrapMap -- ^ Corresponding WrapMap structure
-> WrapPoint -- ^ WrapPoint to be converted
-> (Double, Double)
toCoords WrapMap { radiusR = rR, radiusr = rr }
WrapPoint { angleR = aR, angler = ar }
= (ar * rr, aR * rR)
coords = toCoords
vec = toCoords
-- |Adds two WrapPoints together (vector style).
add,addPoints
:: WrapPoint -- ^ The first WrapPoint in the operation
-> WrapPoint -- ^ The WrapPoint to be added to the first WrapPoint
-> WrapPoint
addPoints a b =
WrapPoint { angleR = fixAngle (angleRSum a b)
, angler = fixAngle (anglerSum a b)
}
add = addPoints
angleRSum a b = angleR a + angleR b
anglerSum a b = angler a + angler b
-- |Adds a WrapPoint and a pair of x, y coordinates (vector style).
add', addPoints'
:: WrapMap -- ^ The corresponding WrapMap structure
-> WrapPoint -- ^ The WrapPoint in the operation
-> (Double, Double) -- ^ The x, y coordinates to be added to the WrapPoint
-> WrapPoint
addPoints' w a v
= let b = wp w v in
WrapPoint { angleR = fixAngle (angleRSum a b)
, angler = fixAngle (anglerSum a b)
}
add' = addPoints'
angleRDiff a b = angleR a - angleR b
anglerDiff a b = angleR a - angler b
-- |Subtracts a WrapPoint from a WrapPoint (vector style).
diff, subtractPoints
:: WrapPoint -- ^ The first WrapPoint in the operation
-> WrapPoint -- ^ The WrapPoint to be subtracted from the first WrapPoint
-> WrapPoint
subtractPoints a b =
WrapPoint { angleR = fixAngle (angleRDiff a b)
, angler = fixAngle (anglerDiff a b)
}
diff = subtractPoints
negV (x,y) = (-x,-y)
-- |Subtracts coordinates from a WrapPoint (vector style).
diff', subtractPoints'
:: WrapMap -- ^ The corresponding WrapMap structure
-> WrapPoint -- ^ The WrapPoint in the operation
-> (Double, Double) -- ^ The x, y coordinates to be added to the WrapPoint
-> WrapPoint
subtractPoints' a b c = addPoints' a b (negV c)
diff' = subtractPoints'
join f a = f a a
sqr = join (*)
distrib f g a b = g (f a) (f b)
sumSquares = distrib sqr (+)
hypotenuse a b = sqrt (sumSquares a b)
-- |Finds the distance between two WrapPoints.
distance :: WrapMap -- ^ The corresponding WrapMap structure
-> WrapPoint -- ^ The first WrapPoint
-> WrapPoint -- ^ The second WrapPoint
-> Double
distance w a b
= let (x, y) = vectorRelation w a b in
hypotenuse x y
isPos = (>= 0)
isNeg = not . isPos
fixAngle r
= let q = r / circleRadians in
let a = r - fromIntegral (truncate q) * circleRadians in
if isNeg a then circleRadians + a
else a
absDiff a b = abs (a - b)
spinCCW = (+ circleRadians)
spinCW = flip (-) circleRadians
-- |Returns the relationship between two WrapPoints as a pair of x, y
-- coordinates (a vector).
relation, vectorRelation
:: WrapMap -- ^ The corresponding WrapMap structure
-> WrapPoint -- ^ The first WrapPoint
-> WrapPoint -- ^ The second WrapPoint
-> (Double, Double)
vectorRelation WrapMap { radiusR = rR, radiusr = rr }
WrapPoint { angleR = aR1, angler = ar1 }
WrapPoint { angleR = aR2, angler = ar2 }
= let dXa = absDiff ar2 ar1 in
let dYa = absDiff aR2 aR1 in
let dXb = if ar1 < ar2
then abs (spinCCW ar1 - ar2)
else abs (spinCW ar1 - ar2) in
let dYb = if aR1 < aR2
then abs (spinCCW aR1 - aR2)
else abs (spinCW aR1 - aR2) in
let dX = if dXa <= dXb
then ar2 - ar1
else if ar1 <= ar2
then spinCW ar2 - ar1
else spinCCW ar2 - ar1 in
let dY = if dYa <= dYb
then aR2 - aR1
else if aR1 <= aR2
then spinCW aR2 - aR1
else spinCCW aR2 - aR1 in
(dX * rr, dY * rR)
relation = vectorRelation
-- Maybe add these someday after I find them useful
-- data WrapWindow = WrapWindow { tlCorner :: (Double, Double)
-- , width :: Double
-- , height :: Double
-- , wrapMap :: WrapMap
-- }
-- windowView :: WrapWindow -> WrapPoint -> WrapPoint -> (Double, Double)
-- windowView window centerpoint point
-- = let cornerPoint = addPoints'
-- (wrapMap window)
-- centerpoint
-- ((-width window) / 2.0, height window / 2.0) in
-- let (vx, vy) = vectorRelation (wrapMap window) cornerPoint point in
-- let vx' = vx in
-- let vy' = (-vy) in
-- (vx' + fst (tlCorner window), vy' + snd (tlCorner window))