SubLineSpec.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Data.Geometry.SubLineSpec where

import Control.Lens
import Data.Ext
import Data.Geometry
import Data.Geometry.Line
import Data.Geometry.LineSegment
import Data.Geometry.SubLine
import Data.Ratio
import Data.UnBounded
import Data.Vinyl.CoRec
import Test.QuickCheck.HGeometryInstances ()
import Test.Hspec
import Test.QuickCheck


spec :: Spec
spec = do
  describe "subLineTests" $
    it "subline specialization in R^2" $
      property $ \(alpha :: Rational) l@(Line p v) (i :: Interval () Rational)  ->
        let q  = p .+^ alpha *^ v
            sl = SubLine l i
        in onSubLineOrig q sl `shouldBe` onSubLine2 q sl

  it "manual test " $
      ((Point2 (-1) (-1 :: Rational)) `onSubLine2`
       (seg^._SubLine))
    `shouldBe` False

  it "Intersection test" $
    let mySeg :: LineSegment 2 () Rational
        mySeg    = ClosedLineSegment (ext origin) (ext $ Point2 14 0)
        myLine :: SubLine 2 () (UnBounded Rational) Rational
        myLine   = fromLine $ lineThrough (Point2 0 0) (Point2 10 0)
        myAnswer :: Interval () (UnBounded Rational)
        myAnswer = ClosedInterval (ext $ Val 0) (ext . Val $ 7 % 5)
    in (myLine `intersect` (mkSL mySeg))
       `shouldBe`
       coRec (myLine&subRange .~ myAnswer)


mkSL  :: (Num r, Arity d) => LineSegment d () r -> SubLine d () (UnBounded r) r
mkSL s = s^._SubLine.re _unBounded


seg :: LineSegment 2 () Rational
seg = ClosedLineSegment (ext (Point2 1 1)) (ext (Point2 5 5))



-- | Original def of onSubline
onSubLineOrig                 :: (Ord r, Fractional r, Arity d)
                          => Point d r -> SubLine d p r r -> Bool
onSubLineOrig p (SubLine l r) = toOffset' p l `inInterval` r