Raincat-1.1.1: src/Nxt/Types.hs
module Nxt.Types
(Vector2d,
Texture(Texture),
textureWidth,
textureHeight,
textureObject,
Nxt.Types.Rect(Rect),
rectX,
rectY,
rectWidth,
rectHeight,
rectRight,
rectBottom,
rectIntersect,
pointInRect,
overlapRect,
Poly(Poly),
polySides,
polyVertices,
polyIntersect,
Direction(DirLeft,DirRight)) where
import Graphics.Rendering.OpenGL as GL hiding (Rect)
-- Direction
data Direction = DirLeft | DirRight
-- Texture
data Texture = Texture
{
textureWidth :: GLsizei,
textureHeight :: GLsizei,
textureObject :: TextureObject
}
-- Rect
data Rect = Rect
{
rectX :: Double,
rectY :: Double,
rectWidth :: Double,
rectHeight :: Double
}
deriving Show
-- rectRight
rectRight :: Rect -> Double
rectRight (Rect x _ w _) = x + w
-- rectBottom
rectBottom :: Rect -> Double
rectBottom (Rect _ y _ h) = y + h
-- rectIntersect
rectIntersect :: Rect -> Rect -> Bool
rectIntersect (Rect r1X r1Y r1Width r1Height) (Rect r2X r2Y r2Width r2Height) =
not (r1X > (r2X + r2Width) || r2X > (r1X + r1Width) ||
r1Y > (r2Y + r2Height) || r2Y > (r1Y + r1Height))
-- pointInRect
pointInRect :: Vector2d -> Rect -> Bool
pointInRect (x, y) (Rect rectXt rectYt width height) =
x >= rectXt && x <= (rectXt + width) && y >= rectYt && y <= (rectYt + height)
-- overlapRect
overlapRect :: Rect -> Rect -> Rect
overlapRect (Rect r1x r1y r1Width r1Height) (Rect r2x r2y r2Width r2Height) =
Rect x y width height
where x = max r1x r2x
y = max r1y r2y
width = min (r1x + r1Width) (r2x + r2Width) - x
height = min (r1y + r1Height) (r2y + r2Height) - r2Height
-- Vector2d
type Vector2d = (Double, Double)
-- Poly
data Poly = Poly
{
polySides :: Int,
polyVertices :: [Vector2d]
}
deriving Show
-- dotProduct
dotProduct :: Vector2d -> Vector2d -> Double
dotProduct (p1X, p1Y) (p2X, p2Y) = p1X * p2X + p1Y * p2Y
-- polyIntersect
polyIntersect :: Poly -> Poly -> Bool
polyIntersect polyA polyB =
let polyAVerts = polyVertices polyA
polyAPrevVerts = last polyAVerts : init polyAVerts
polyAPairVerts = zip polyAPrevVerts polyAVerts
polyBVerts = polyVertices polyB
polyBPrevVerts = last polyBVerts : init polyBVerts
polyBPairVerts = zip polyBPrevVerts polyBVerts
normalizeAxis :: (Vector2d, Vector2d) -> Vector2d
normalizeAxis (prevVert, vert) =
let
(ptPrevX, ptPrevY) = prevVert
(ptCurrX, ptCurrY) = vert
axisX = ptPrevY - ptCurrY
axisY = ptCurrX - ptPrevX
tmp = sqrt (axisX * axisX + axisY * axisY)
in
(axisX / tmp, axisY / tmp)
projRange :: [Vector2d] -> Vector2d -> (Double,Double)
projRange vertices axis =
let
projLengths = map (`dotProduct` axis) vertices
minl = minimum projLengths
maxl = maximum projLengths
in
(minl, maxl)
overlap :: (Vector2d, Vector2d) -> Bool
overlap pairVerts =
not (maxA < minB || minA > maxB)
where axis = normalizeAxis pairVerts
(minA, maxA) = projRange polyAVerts axis
(minB, maxB) = projRange polyBVerts axis
in
all overlap polyAPairVerts && all overlap polyBPairVerts