module HGE2D.Geometry where
import Data.List
import HGE2D.Math
import HGE2D.Types
import HGE2D.Datas
import HGE2D.Classes
import Safe
rad2deg :: Double -> Double
rad2deg rad = rad * 180 / pi
deg2rad :: Double -> Double
deg2rad deg = deg * pi / 180
radRealPos :: RealPosition -> RealPosition -> Radian
radRealPos p1 p2 = atan2 dY dX
where
dX = (fst p2) (fst p1)
dY = (snd p2) (snd p1)
velAngle :: Velocity -> Radian
velAngle v = atan2 (fst v) (snd v)
distance :: (Positioned a, Positioned b) => a -> b -> Double
distance x y = sqrt $ distanceSqr x y
distanceSqr :: (Positioned a, Positioned b) => a -> b -> Double
distanceSqr x y = (fst p1 fst p2)**2 + (snd p1 snd p2)**2
where
p1 = getPos x
p2 = getPos y
distanceBB :: (Positioned a, HasBoundingBox b) => a -> b -> Double
distanceBB p bb = sqrt $ distanceBBSqr p bb
distanceBBSqr :: (Positioned a, HasBoundingBox b) => a -> b -> Double
distanceBBSqr p bb = dx * dx + dy * dy
where
dx = max 0 $ abs (xP xBB) w / 2.0
dy = max 0 $ abs (yP yBB) h / 2.0
xP = getX p
yP = getY p
xBB = fst $ centerBB $ getBB bb
yBB = snd $ centerBB $ getBB bb
(w, h) = sizeBB $ getBB bb
direction :: (Positioned a, Positioned b) => a -> b -> RealPosition
direction x y = (newX, newY)
where
newX = ((fst p2) (fst p1)) / l
newY = ((snd p2) (snd p1)) / l
l = distance x y
p1 = getPos x
p2 = getPos y
closest :: (Positioned a, Positioned b) => a -> [b] -> Maybe b
closest a bs = minimumByMay ( \ x y -> compare (distanceSqr a x) (distanceSqr a y) ) bs
furthest :: (Positioned a, Positioned b) => a -> [b] -> Maybe b
furthest a bs = maximumByMay ( \ x y -> compare (distanceSqr a x) (distanceSqr a y) ) bs
interceptionPos :: (RealPosition, Double) -> (RealPosition, Velocity) -> RealPosition
interceptionPos (p1, v) (p2, v2) = (newX, newY)
where
tx = (fst p2) (fst p1)
ty = (snd p2) (snd p1)
tvx = fst v2
tvy = snd v2
a = tvx*tvx + tvy*tvy v*v :: Double
b = 2 * (tvx * tx + tvy * ty) :: Double
c = tx*tx + ty*ty :: Double
ts = quadraticEquation a b c
t0 = fst ts
t1 = snd ts
temp = min t0 t1
t | temp > 0 = temp
| otherwise = max t0 t1
newX = (fst p2) + (fst v2) * t
newY = (snd p2) + (snd v2) * t
makeRB :: RealPosition -> Velocity -> Pixel -> Pixel -> RigidBody
makeRB center vel width height = RigidBody { rigidPos = center, rigidVel = vel, rigidBB = sizedBB center width height }
sizedBB :: RealPosition -> Pixel -> Pixel -> BoundingBox
sizedBB center width height = BoundingBox posMin posMax
where
posMin = (minX, minY)
posMax = (maxX, maxY)
minX = (fst center) width / 2
minY = (snd center) height / 2
maxX = (fst center) + width / 2
maxY = (snd center) + height / 2
sizeBB :: BoundingBox -> (Pixel, Pixel)
sizeBB bb = (width, height)
where
width = (fst $ bbMax bb) (fst $ bbMin bb)
height = (snd $ bbMax bb) (snd $ bbMin bb)
centerBB :: BoundingBox -> RealPosition
centerBB bb = (newX, newY)
where
newX = (fst $ bbMin bb) + (width / 2)
newY = (snd $ bbMin bb) + (height / 2)
(width, height) = sizeBB bb
bbFromList :: (Positioned a) => [a] -> BoundingBox
bbFromList [] = BBEmpty
bbFromList [_] = BBEmpty
bbFromList xs = BoundingBox (minX, minY) (maxX, maxY)
where
minX = minimum $ map getX xs
minY = minimum $ map getY xs
maxX = maximum $ map getX xs
maxY = maximum $ map getY xs
mergeBB :: BoundingBox -> BoundingBox -> BoundingBox
mergeBB BBEmpty bb2 = bb2
mergeBB bb1 BBEmpty = bb1
mergeBB bb1 bb2 = BoundingBox newMin newMax
where
newMin = mergeMin poss
newMax = mergeMax poss
poss = [bbMin bb1, bbMin bb2, bbMax bb1, bbMax bb2]
mergeMin :: [RealPosition]-> RealPosition
mergeMin poss = (x, y)
where
x = fst $ minimumBy compareX poss
y = snd $ minimumBy compareY poss
mergeMax :: [RealPosition] -> RealPosition
mergeMax poss = (x, y)
where
x = fst $ maximumBy compareX poss
y = snd $ maximumBy compareY poss
compareX a b = compare (fst a) (fst b)
compareY a b = compare (snd a) (snd b)
makeBB :: RealPosition -> Pixel -> Pixel -> BoundingBox
makeBB center width height = BoundingBox newMin newMax
where
newMin = ((fst center width / 2), (snd center height / 2))
newMax = ((fst center + width / 2), (snd center + height / 2))
applyVelocity :: RealPosition -> Velocity -> Millisecond -> RealPosition
applyVelocity oldPos vel time =
(((fst oldPos) + (fromIntegral time) * (fst vel)),
((snd oldPos) + (fromIntegral time) * (snd vel)))