Split UseItem module
This commit is contained in:
@@ -0,0 +1,27 @@
|
||||
module Geometry.Bezier
|
||||
where
|
||||
import Geometry.Data
|
||||
import Geometry.Vector
|
||||
|
||||
type BQuad = (Point2,Point2,Point2)
|
||||
|
||||
splitBezierquad :: BQuad -> Float -> (BQuad,BQuad)
|
||||
splitBezierquad (a,b,c) z
|
||||
= ( ( a
|
||||
, (z *.* b) -.- ((z-1) *.* a)
|
||||
, (z**2 *.* c) +.+ ((z-1)**2 *.* a) -.- (2*z*(z-1) *.* b)
|
||||
)
|
||||
, ( (z**2 *.* c) +.+ ((z-1)**2 *.* a) -.- (2*z*(z-1) *.* b)
|
||||
, (z *.* c) -.- ((z-1) *.* b)
|
||||
, c
|
||||
)
|
||||
)
|
||||
|
||||
bQuadToLine :: BQuad -> Int -> [Point2]
|
||||
bQuadToLine (a,_,c) 0 = [a,c]
|
||||
bQuadToLine x i = let (l,r) = splitBezierquad x 0.5
|
||||
in bQuadToLine l (i-1) ++ bQuadToLine r (i-1)
|
||||
|
||||
bQuadToF :: (Point2,Point2,Point2) -> Float -> Point2
|
||||
bQuadToF (c,b,a) t = t *.* (t *.* a +.+ (1-t) *.* b) +.+
|
||||
(1-t) *.* (t *.* b +.+ (1-t) *.* c)
|
||||
@@ -0,0 +1,110 @@
|
||||
module Geometry.Intersect
|
||||
where
|
||||
import Geometry.Data
|
||||
|
||||
import Control.Applicative
|
||||
|
||||
intersectSegBezquad :: Point2 -> Point2 -> Point2 -> Point2 -> Point2 -> [Point2]
|
||||
intersectSegBezquad = undefined
|
||||
|
||||
intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
|
||||
{-# INLINE intersectLineLine' #-}
|
||||
intersectLineLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
|
||||
| den == 0 = Nothing
|
||||
| otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
|
||||
where
|
||||
den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
|
||||
t' = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
|
||||
|
||||
intersectSegSeg' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
|
||||
{-# INLINE intersectSegSeg' #-}
|
||||
intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
|
||||
| den == 0 = Nothing
|
||||
| den > 0 && (t' < 0 || u' < 0 || t' > den || u' > den)
|
||||
= Nothing
|
||||
| den < 0 && (t' > 0 || u' > 0 || t' < den || u' < den)
|
||||
= Nothing
|
||||
| otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
|
||||
where
|
||||
den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
|
||||
t' = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
|
||||
u' = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
|
||||
|
||||
intersectSegLineFrom' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
|
||||
{-# INLINE intersectSegLineFrom' #-}
|
||||
intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
|
||||
| den == 0 = Nothing
|
||||
| den > 0 && ( t' < 0 || u' < 0 || t' > den )
|
||||
= Nothing
|
||||
| den < 0 && ( t' > 0 || u' > 0 || t' < den )
|
||||
= Nothing
|
||||
| otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
|
||||
where
|
||||
den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
|
||||
t' = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
|
||||
u' = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
|
||||
|
||||
intersectSegLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
|
||||
{-# INLINE intersectSegLine' #-}
|
||||
intersectSegLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
|
||||
| den == 0 = Nothing
|
||||
| den > 0 && (t' < 0 || t' > den)
|
||||
= Nothing
|
||||
| den < 0 && (t' > 0 || t' < den)
|
||||
= Nothing
|
||||
| otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
|
||||
where
|
||||
den = (x1-x2)*(y3-y4) - (y1-y2)*(x3-x4)
|
||||
t' = (x1-x3)*(y3-y4) - (y1-y3)*(x3-x4)
|
||||
u' = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
|
||||
|
||||
-- intersectSegSeg is sometimes broken-- the following fixes at least some of
|
||||
-- the cases
|
||||
-- it is, however, slow
|
||||
myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLineLine a b c d of
|
||||
Nothing -> Nothing
|
||||
Just (x,y) -> if inbetween x && inbetween' y
|
||||
then Just (x,y)
|
||||
else Nothing
|
||||
where inbetween x = ((ax <= x && x <= bx) || (bx <= x && x <= ax)) &&
|
||||
((cx <= x && x <= dx) || (dx <= x && x <= cx))
|
||||
inbetween' y = ((ay <= y && y <= by) || (by <= y && y <= ay)) &&
|
||||
((cy <= y && y <= dy) || (dy <= y && y <= cy))
|
||||
|
||||
myIntersectLineLine :: (Eq a,Fractional a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Maybe (a,a)
|
||||
myIntersectLineLine a@(ax,ay) b c@(cx,cy) d
|
||||
| linGrad a b == Nothing = fmap ((,) ax) $ axisInt (c *-* (ax,0)) (d *-* (ax,0))
|
||||
| linGrad c d == Nothing = fmap ((,) cx) $ axisInt (a *-* (cx,0)) (b *-* (cx,0))
|
||||
| otherwise
|
||||
= case linGrad a b ^-^ linGrad c d of
|
||||
Just 0 -> Nothing
|
||||
_ -> liftA2 (,) newx
|
||||
((linGrad a b ^*^ newx) ^+^ axisInt a b)
|
||||
where (^-^) = liftA2 (-)
|
||||
(^+^) = liftA2 (+)
|
||||
(^/^) = liftA2 (/)
|
||||
(^*^) = liftA2 (*)
|
||||
newx = (axisInt c d ^-^ axisInt a b) ^/^ (linGrad a b ^-^ linGrad c d)
|
||||
(*-*) (ax,ay) (bx,by) = (ax-bx,ay-by)
|
||||
|
||||
ratIntersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
|
||||
ratIntersectLineLine a b c d = fmap toNumPoint2 $ myIntersectLineLine (toRatPoint2 a) (toRatPoint2 b) (toRatPoint2 c) (toRatPoint2 d)
|
||||
where toRatPoint2 (x,y) = (toRational x, toRational y)
|
||||
toNumPoint2 (x,y) = (fromRational x, fromRational y)
|
||||
f = toRatPoint2 . roundPoint2
|
||||
|
||||
roundPoint2 :: Point2 -> Point2
|
||||
roundPoint2 (x,y) = (fromIntegral $ round x,fromIntegral $ round y)
|
||||
|
||||
linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
|
||||
linGrad (x,y) (a,b) | x-a == 0 = Nothing
|
||||
| otherwise = Just $ (y-b)/(x-a)
|
||||
|
||||
axisInt :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
|
||||
axisInt p (a,b) = pure b ^-^ (pure a ^*^ linGrad p (a,b))
|
||||
where (^-^) = liftA2 (-)
|
||||
(^*^) = liftA2 (*)
|
||||
|
||||
|
||||
intersectSegsSeg :: [Point2] -> Point2 -> Point2 -> Maybe Point2
|
||||
intersectSegsSeg = undefined
|
||||
@@ -0,0 +1,141 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Geometry.Vector
|
||||
where
|
||||
import Geometry.Data
|
||||
|
||||
zeroZ :: Point2 -> Point3
|
||||
{-# INLINE zeroZ #-}
|
||||
zeroZ (x,y) = (x,y,0)
|
||||
|
||||
infixl 6 +.+, -.-
|
||||
infixl 7 *.*
|
||||
|
||||
(+.+) :: Point2 -> Point2 -> Point2
|
||||
{-# INLINE (+.+) #-}
|
||||
(x1, y1) +.+ (x2, y2) =
|
||||
let
|
||||
!x = x1 + x2
|
||||
!y = y1 + y2
|
||||
in (x, y)
|
||||
|
||||
(-.-) :: Point2 -> Point2 -> Point2
|
||||
{-# INLINE (-.-) #-}
|
||||
(x1, y1) -.- (x2, y2) =
|
||||
let
|
||||
!x = x1 - x2
|
||||
!y = y1 - y2
|
||||
in (x, y)
|
||||
|
||||
(*.*) :: Float -> Point2 -> Point2
|
||||
{-# INLINE (*.*) #-}
|
||||
a *.* (x2, y2) =
|
||||
let
|
||||
!x = a * x2
|
||||
!y = a * y2
|
||||
in (x, y)
|
||||
|
||||
infixl 6 +.+.+, -.-.-
|
||||
infixl 7 *.*.*
|
||||
|
||||
(+.+.+) :: Point3 -> Point3 -> Point3
|
||||
{-# INLINE (+.+.+) #-}
|
||||
(x1, y1, z1) +.+.+ (x2, y2, z2) =
|
||||
let
|
||||
!x = x1 + x2
|
||||
!y = y1 + y2
|
||||
!z = z1 + z2
|
||||
in (x, y, z)
|
||||
|
||||
(-.-.-) :: Point3 -> Point3 -> Point3
|
||||
{-# INLINE (-.-.-) #-}
|
||||
(x1, y1, z1) -.-.- (x2, y2, z2) =
|
||||
let
|
||||
!x = x1 - x2
|
||||
!y = y1 - y2
|
||||
!z = z1 - z2
|
||||
in (x, y, z)
|
||||
|
||||
(*.*.*) :: Point3 -> Point3 -> Point3
|
||||
{-# INLINE (*.*.*) #-}
|
||||
(x1, y1, z1) *.*.* (x2, y2, z2) =
|
||||
let
|
||||
!x = x1 * x2
|
||||
!y = y1 * y2
|
||||
!z = z1 * z2
|
||||
in (x, y, z)
|
||||
|
||||
normalizeV :: Point2 -> Point2
|
||||
{-# INLINE normalizeV #-}
|
||||
normalizeV p = (1 / magV p) *.* p
|
||||
|
||||
angleVV :: Point2 -> Point2 -> Float
|
||||
{-# INLINE angleVV #-}
|
||||
angleVV a b = let ma = magV a
|
||||
mb = magV b
|
||||
d = a `dotV` b
|
||||
in acos $ d / (ma * mb)
|
||||
|
||||
dotV :: Point2 -> Point2 -> Float
|
||||
{-# INLINE dotV #-}
|
||||
dotV (x,y) (z,w) = x*z + y*w
|
||||
|
||||
argV :: Point2 -> Float
|
||||
{-# INLINE argV #-}
|
||||
argV (x,y) = normalizeAngle $ atan2 y x
|
||||
|
||||
detV :: Point2 -> Point2 -> Float
|
||||
{-# INLINE detV #-}
|
||||
detV (x1, y1) (x2, y2)
|
||||
= x1 * y2 - y1 * x2
|
||||
|
||||
-- | Angle in radians, anticlockwise from +ve x-axis.
|
||||
unitVectorAtAngle :: Float -> Point2
|
||||
{-# INLINE unitVectorAtAngle #-}
|
||||
unitVectorAtAngle r
|
||||
= (cos r, sin r)
|
||||
|
||||
-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.
|
||||
rotateV :: Float -> Point2 -> Point2
|
||||
rotateV r (x, y)
|
||||
= ( x * cos r - y * sin r
|
||||
, x * sin r + y * cos r)
|
||||
{-# INLINE rotateV #-}
|
||||
|
||||
-- | Convert degrees to radians
|
||||
degToRad :: Float -> Float
|
||||
degToRad d = d * pi / 180
|
||||
{-# INLINE degToRad #-}
|
||||
|
||||
|
||||
-- | Convert radians to degrees
|
||||
radToDeg :: Float -> Float
|
||||
radToDeg r = r * 180 / pi
|
||||
{-# INLINE radToDeg #-}
|
||||
|
||||
|
||||
-- | Normalize an angle to be between 0 and 2*pi radians
|
||||
normalizeAngle :: Float -> Float
|
||||
normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))
|
||||
where floor' :: Float -> Float
|
||||
floor' x = fromIntegral (floor x :: Int)
|
||||
{-# INLINE normalizeAngle #-}
|
||||
|
||||
vNormal :: Point2 -> Point2
|
||||
{-# INLINE vNormal #-}
|
||||
vNormal (x,y) = (y,-x)
|
||||
|
||||
vInverse :: Point2 -> Point2
|
||||
vInverse (x,y) = (-x,-y)
|
||||
|
||||
normV :: Point2 -> Point2
|
||||
{-# INLINE normV #-}
|
||||
normV (0,0) = (0,0)
|
||||
normV p = (1/magV p ) *.* p
|
||||
|
||||
magV :: Point2 -> Float
|
||||
{-# INLINE magV #-}
|
||||
magV (x,y) = sqrt $ x^2 + y^2
|
||||
|
||||
crossV :: Point2 -> Point2 -> Float
|
||||
crossV (ax,ay) (bx,by) = ax*by - ay*bx
|
||||
|
||||
Reference in New Issue
Block a user