module Graphics.Rasterific.Line
( lineFromPath
, decomposeLine
, clipLine
, sanitizeLine
, lineBreakAt
, flattenLine
, lineLength
, offsetLine
) where
import Control.Applicative( (<$>), (<*>), pure )
import Data.Monoid( (<>), mempty )
import Graphics.Rasterific.Linear
( V1( .. )
, V2( .. )
, (^-^)
, (^+^)
, (^*)
, lerp
, norm )
import Graphics.Rasterific.Operators
import Graphics.Rasterific.Types
lineFromPath :: [Point] -> [Line]
lineFromPath [] = []
lineFromPath lst@(_:rest) =
uncurry Line <$> zip lst rest
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 a b
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 -> Container EdgeSample
decomposeLine (Line aRoot bRoot) = go aRoot bRoot where
go !a@(V2 ax ay) !b@(V2 bx by)
| insideX && insideY = pure $ EdgeSample (px + 0.5) (py + 0.5) (w * h) h
where
!floorA = vfloor a
!floorB = vfloor b
!(V2 insideX insideY) =
floorA ^==^ floorB ^||^ vceil a ^==^ vceil b
!(V2 px py) = fromIntegral <$> vmin floorA floorB
!(V1 w) = (px + 1 ) <$> (V1 bx `midPoint` V1 ax)
!h = by ay
go a b = go a m <> go m b
where
!ab = a `midPoint` b
!mini = fromIntegral <$> vfloor ab
!maxi = fromIntegral <$> vceil ab
!nearmin = vabs (ab ^-^ mini) ^< 0.1
!nearmax = vabs (ab ^-^ maxi) ^< 0.1
minMaxing mi nearmi ma nearma p
| nearmi = mi
| nearma = ma
| otherwise = p
!m = minMaxing <$> mini <*> nearmin <*> maxi <*> nearmax <*> ab