module Graphics.Rasterific.Line
( lineFromPath
, decomposeLine
, clipLine
, sanitizeLine
, lineBreakAt
, flattenLine
, lineLength
, offsetLine
, isLinePoint
, extendLine
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( pure, (<$>) )
import Data.Monoid( mempty )
#endif
import Data.Monoid( (<>) )
import Graphics.Rasterific.Linear
( V2( .. )
, (^-^)
, (^+^)
, (^*)
, lerp
, norm )
import Graphics.Rasterific.Operators
import Graphics.Rasterific.Types
lineFromPath :: [Point] -> [Line]
lineFromPath [] = []
lineFromPath lst@(_:rest) =
uncurry Line <$> zip lst rest
isLinePoint :: Line -> Bool
isLinePoint (Line a b) = not $ a `isDistingableFrom` b
lineLength :: Line -> Float
lineLength (Line a b) = norm (b ^-^ a)
sanitizeLine :: Line -> Container Primitive
sanitizeLine l@(Line p1 p2)
| p1 `isNearby` p2 = mempty
| otherwise = pure $ LinePrim l
lineBreakAt :: Line -> Float -> (Line, Line)
lineBreakAt (Line a b) t = (Line a ab, Line ab b)
where ab = lerp t b a
flattenLine :: Line -> Container Primitive
flattenLine = pure . LinePrim
offsetLine :: Float -> Line -> Container Primitive
offsetLine offset (Line a b) = pure . LinePrim $ Line shiftedA shiftedB
where
u = a `normal` b
shiftedA = a ^+^ (u ^* offset)
shiftedB = b ^+^ (u ^* offset)
clipLine :: Point
-> Point
-> Line
-> Container Primitive
clipLine mini maxi poly@(Line a b)
| insideX && insideY = pure . LinePrim $ poly
| outsideX || outsideY = pure . LinePrim $ Line clampedA clampedB
| otherwise = recurse (Line a m) <> recurse (Line m b)
where
bmin = vmin a b
bmax = vmax a b
recurse = clipLine mini maxi
clamper = clampPoint mini maxi
clampedA = clamper a
clampedB = clamper b
V2 insideX insideY = mini ^<=^ bmin ^&&^ bmax ^<=^ maxi
V2 outsideX outsideY = bmax ^<=^ mini ^||^ maxi ^<=^ bmin
ab = a `midPoint` b
edgeSeparator =
vabs (ab ^-^ mini) ^<^ vabs (ab ^-^ maxi)
edge = vpartition edgeSeparator mini maxi
m = vpartition (vabs (ab ^-^ edge) ^< 0.1) edge ab
decomposeLine :: Line -> Producer EdgeSample
decomposeLine (Line (V2 aRx aRy) (V2 bRx bRy)) = go aRx aRy bRx bRy where
go !ax !ay !bx !by cont
| insideX && insideY =
let !px = fromIntegral $ min floorAx floorBx
!py = fromIntegral $ min floorAy floorBy
!w = px + 1 (bx `middle` ax)
!h = by ay
in
EdgeSample (px + 0.5) (py + 0.5) (w * h) h : cont
where
floorAx, floorAy :: Int
!floorAx = floor ax
!floorAy = floor ay
!floorBx = floor bx
!floorBy = floor by
!insideX = floorAx == floorBx || ceiling ax == (ceiling bx :: Int)
!insideY = floorAy == floorBy || ceiling ay == (ceiling by :: Int)
go !ax !ay !bx !by cont = go ax ay mx my $ go mx my bx by cont
where
!abx = ax `middle` bx
!aby = ay `middle` by
!mx | abs (abx mini) < 0.1 = mini
| abs (abx maxi) < 0.1 = maxi
| otherwise = abx
where !mini = fromIntegral (floor abx :: Int)
!maxi = fromIntegral (ceiling abx :: Int)
!my | abs (aby mini) < 0.1 = mini
| abs (aby maxi) < 0.1 = maxi
| otherwise = aby
where !mini = fromIntegral (floor aby :: Int)
!maxi = fromIntegral (ceiling aby :: Int)
extendLine :: Float
-> Float
-> Line
-> Line
extendLine beg end (Line p1 p2) =
Line (lerp beg p2 p1) (lerp end p2 p1)