Mid strictifying

src/Geometry/Intersect.hs

@@ -11,22 +11,22 @@ import Data.Maybe (isNothing)
 -- | If two lines intersect, return 'Just' that point.
 intersectLineLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectLineLine' #-}
-intersectLineLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectLineLine' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
-    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    | otherwise = Just $ V2 (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)
 -- | If two segments intersect, return 'Just' that point.
 intersectSegSeg' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegSeg' #-}
-intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegSeg' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 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)
+    | otherwise = Just $ V2 (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)
@@ -35,13 +35,13 @@ intersectSegSeg' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
 -- extending infinitely in one direction.
 intersectSegLineFrom' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLineFrom' #-}
-intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegLineFrom' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 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)
+    | otherwise = Just $ V2 (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)
@@ -49,13 +49,13 @@ intersectSegLineFrom' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
 -- | Similar to 'intersectSegLineFrom'', but this version is probably not correct...
 intersectSegLineext :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLineext #-}
-intersectSegLineext (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegLineext (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
     | den == 0 = Nothing
     | den > 0 && ( t' < 0 || u' < den || t' > den )
         = Nothing
     | den < 0 && ( t' > 0 || u' > - den || t' < den )
         = Nothing
-    | otherwise = Just (x1 + (x2-x1)*t'/den, y1 + (y2-y1)*t'/den)
+    | otherwise = Just $ V2 (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)
@@ -63,13 +63,13 @@ intersectSegLineext (x1,y1) (x2,y2) (x3,y3) (x4,y4)
 -- | Intersect a segment with a line.
 intersectSegLine' :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 {-# INLINE intersectSegLine' #-}
-intersectSegLine' (x1,y1) (x2,y2) (x3,y3) (x4,y4)
+intersectSegLine' (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 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)
+    | otherwise = Just $ V2 (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)
@@ -87,10 +87,10 @@ myIntersectSegSeg
     -> Point2
     -> Point2
     -> Maybe Point2
-myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLineLine a b c d of
+myIntersectSegSeg a@(V2 ax ay) b@(V2 bx by) c@(V2 cx cy) d@(V2 dx dy) = case ratIntersectLineLine a b c d of
     Nothing    -> Nothing
-    Just (x,y) -> if inbetween x && inbetween' y 
-        then Just (x,y)
+    Just (V2 x y) -> if inbetween x && inbetween' y 
+        then Just (V2 x y)
         else Nothing
   where 
     inbetween  x = ((ax <= x && x <= bx) || (bx <= x && x <= ax)) 
@@ -98,28 +98,28 @@ myIntersectSegSeg a@(ax,ay) b@(bx,by) c@(cx,cy) d@(dx,dy) = case ratIntersectLin
     inbetween' y = ((ay <= y && y <= by) || (by <= y && y <= ay)) 
         &&  ((cy <= y && y <= dy) || (dy <= y && y <= cy))
 -- | Polymorphic intersection of fractional line points.
-myIntersectLineLine :: (Eq a,Fractional a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Maybe (a,a)
-myIntersectLineLine a@(ax,_) b c@(cx,_) d
-    | isNothing (linGrad a b) = (ax ,) <$> axisInt (c *-* (ax,0)) (d *-* (ax,0))
-    | isNothing (linGrad c d) = (cx ,) <$> axisInt (a *-* (cx,0)) (b *-* (cx,0))
+myIntersectLineLine :: (Eq a,Fractional a) => V2 a -> V2 a -> V2 a -> V2 a -> Maybe (V2 a)
+myIntersectLineLine a@(V2 ax _) b c@(V2 cx _) d
+    | isNothing (linGrad a b) = (V2 ax) <$> axisInt (c *-* (V2 ax 0)) (d *-* (V2 ax 0))
+    | isNothing (linGrad c d) = (V2 cx) <$> axisInt (a *-* (V2 cx 0)) (b *-* (V2 cx 0))
     | otherwise              
         = case linGrad a b ^-^ linGrad c d of
             Just 0 -> Nothing
-            _      -> liftA2 (,) newx ((linGrad a b ^*^ newx) ^+^ axisInt a b)
+            _      -> liftA2 (V2) 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)
+    (*-*) (V2 ax' ay) (V2 bx by) = V2 (ax'-bx) (ay-by)
 -- | Transforms floating points to rationals then performs line intersection.
 ratIntersectLineLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
 ratIntersectLineLine a b c d = 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)
+    toRatPoint2 (V2 x y) = V2 (toRational x)  (toRational y)
+    toNumPoint2 (V2 x y) = V2 (fromRational x)  (fromRational y)
 {- | Round the floats within a 'Point2' to the nearest integer.
 __Examples__
 Rounding jumps after intervals of .5:
@@ -134,18 +134,15 @@ but is symmetric around 0:
 
 -}
 roundPoint2 :: Point2 -> Point2
-roundPoint2 (x,y) = (fromIntegral (round x :: Int),fromIntegral (round y :: Int))
+roundPoint2 (V2 x y) = V2 (fromIntegral (round x :: Int)) (fromIntegral (round y :: Int))
 -- | Given two points, finds the linear gradient if it is non-infinite.
-linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
-linGrad (x,y) (a,b) 
+linGrad :: (Eq a,Fractional a) => V2 a -> V2 a -> Maybe a
+linGrad (V2 x y) (V2 a b) 
     | x-a == 0  = Nothing
     | otherwise = Just $ (y-b)/(x-a)
 -- | Given two points, finds the intersection with the y axis if it exists.
-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 (*)
+axisInt :: (Eq a,Fractional a) => V2 a -> V2 a -> Maybe a
+axisInt p (V2 a b) =  fmap (\lg -> b - (a*lg)) $ linGrad p (V2 a b)
 -- | Placeholder, undefined.
 intersectSegsSeg :: [Point2] -> Point2 -> Point2 -> Maybe Point2
 intersectSegsSeg = undefined