{-# LANGUAGE BangPatterns #-}
module Graphics.Rasterific.Rasterize
    ( CoverageSpan( .. )
    , rasterize
    , toOpaqueCoverage
    , clip
    ) where

import Control.Monad.ST( runST )
import Data.Fixed( mod' )
import Data.Monoid( Endo( Endo, appEndo ) )
import Graphics.Rasterific.Types
import Graphics.Rasterific.QuadraticBezier
import Graphics.Rasterific.CubicBezier
import Graphics.Rasterific.Line
import qualified Data.Vector as V
import qualified Data.Vector.Algorithms.Intro as VS

data CoverageSpan = CoverageSpan
    { CoverageSpan -> Float
_coverageX      :: {-# UNPACK #-} !Float
    , CoverageSpan -> Float
_coverageY      :: {-# UNPACK #-} !Float
    , CoverageSpan -> Float
_coverageVal    :: {-# UNPACK #-} !Float
    , CoverageSpan -> Float
_coverageLength :: {-# UNPACK #-} !Float
    }
    deriving Int -> CoverageSpan -> ShowS
[CoverageSpan] -> ShowS
CoverageSpan -> String
(Int -> CoverageSpan -> ShowS)
-> (CoverageSpan -> String)
-> ([CoverageSpan] -> ShowS)
-> Show CoverageSpan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoverageSpan] -> ShowS
$cshowList :: [CoverageSpan] -> ShowS
show :: CoverageSpan -> String
$cshow :: CoverageSpan -> String
showsPrec :: Int -> CoverageSpan -> ShowS
$cshowsPrec :: Int -> CoverageSpan -> ShowS
Show

toOpaqueCoverage :: CoverageSpan -> CoverageSpan
{-# INLINE toOpaqueCoverage #-}
toOpaqueCoverage :: CoverageSpan -> CoverageSpan
toOpaqueCoverage CoverageSpan
coverage = CoverageSpan
coverage { _coverageVal :: Float
_coverageVal = Float
1 }

combineEdgeSamples :: (Float -> Float) -> V.Vector EdgeSample
                   -> [CoverageSpan]
{-# INLINE combineEdgeSamples #-}
combineEdgeSamples :: (Float -> Float) -> Vector EdgeSample -> [CoverageSpan]
combineEdgeSamples Float -> Float
prepareCoverage Vector EdgeSample
vec = Int -> Float -> Float -> Float -> Float -> [CoverageSpan]
go Int
0 Float
0 Float
0 Float
0 Float
0
  where
    !maxi :: Int
maxi = Vector EdgeSample -> Int
forall a. Vector a -> Int
V.length Vector EdgeSample
vec
    go :: Int -> Float -> Float -> Float -> Float -> [CoverageSpan]
go !Int
ix !Float
x !Float
y !Float
a !Float
_h | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxi = [Float -> Float -> Float -> Float -> CoverageSpan
CoverageSpan Float
x Float
y (Float -> Float
prepareCoverage Float
a) Float
1]
    go !Int
ix !Float
x !Float
y !Float
a !Float
h = EdgeSample -> [CoverageSpan]
sub (Vector EdgeSample
vec Vector EdgeSample -> Int -> EdgeSample
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
ix) where
      sub :: EdgeSample -> [CoverageSpan]
sub (EdgeSample Float
x' Float
y' Float
a' Float
h')
        | Float
y Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y' Bool -> Bool -> Bool
&& Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x' = Int -> Float -> Float -> Float -> Float -> [CoverageSpan]
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float
x' Float
y' (Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
a') (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h')
        | Float
y Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y' = CoverageSpan
p1 CoverageSpan -> [CoverageSpan] -> [CoverageSpan]
forall a. a -> [a] -> [a]
: CoverageSpan
p2 CoverageSpan -> [CoverageSpan] -> [CoverageSpan]
forall a. a -> [a] -> [a]
: Int -> Float -> Float -> Float -> Float -> [CoverageSpan]
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float
x' Float
y' (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
a') (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h')
        | Bool
otherwise =
           Float -> Float -> Float -> Float -> CoverageSpan
CoverageSpan Float
x Float
y (Float -> Float
prepareCoverage Float
a) Float
1 CoverageSpan -> [CoverageSpan] -> [CoverageSpan]
forall a. a -> [a] -> [a]
: Int -> Float -> Float -> Float -> Float -> [CoverageSpan]
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float
x' Float
y' Float
a' Float
h'
             where p1 :: CoverageSpan
p1 = Float -> Float -> Float -> Float -> CoverageSpan
CoverageSpan Float
x Float
y (Float -> Float
prepareCoverage Float
a) Float
1
                   p2 :: CoverageSpan
p2 = Float -> Float -> Float -> Float -> CoverageSpan
CoverageSpan (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1) Float
y (Float -> Float
prepareCoverage Float
h) (Float
x' Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1)

-- | Clip the geometry to a rectangle.

clip :: Point     -- ^ Minimum point (corner upper left)

     -> Point     -- ^ Maximum point (corner bottom right)

     -> Primitive -- ^ Primitive to be clipped

     -> Container Primitive
clip :: Point -> Point -> Primitive -> Container Primitive
clip Point
mini Point
maxi (LinePrim Line
l) = Point -> Point -> Line -> Container Primitive
clipLine Point
mini Point
maxi Line
l
clip Point
mini Point
maxi (BezierPrim Bezier
b) = Point -> Point -> Bezier -> Container Primitive
clipBezier Point
mini Point
maxi Bezier
b
clip Point
mini Point
maxi (CubicBezierPrim CubicBezier
c) = Point -> Point -> CubicBezier -> Container Primitive
clipCubicBezier Point
mini Point
maxi CubicBezier
c

decompose :: Primitive -> Producer EdgeSample
decompose :: Primitive -> Producer EdgeSample
decompose (LinePrim Line
l) = Line -> Producer EdgeSample
decomposeLine Line
l
decompose (BezierPrim Bezier
b) = Bezier -> Producer EdgeSample
decomposeBeziers Bezier
b
decompose (CubicBezierPrim CubicBezier
c) =
    {-decomposeCubicBezierForwardDifference c-}
    CubicBezier -> Producer EdgeSample
decomposeCubicBeziers CubicBezier
c

xyCompare :: EdgeSample -> EdgeSample -> Ordering
{-# INLINE xyCompare #-}
xyCompare :: EdgeSample -> EdgeSample -> Ordering
xyCompare !(EdgeSample { _sampleY :: EdgeSample -> Float
_sampleY = Float
ay, _sampleX :: EdgeSample -> Float
_sampleX = Float
ax })
          !(EdgeSample { _sampleY :: EdgeSample -> Float
_sampleY = Float
by, _sampleX :: EdgeSample -> Float
_sampleX = Float
bx }) =
  case Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
ay Float
by of
    Ordering
EQ -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
ax Float
bx
    Ordering
c -> Ordering
c

sortEdgeSamples :: [EdgeSample] -> V.Vector EdgeSample
sortEdgeSamples :: [EdgeSample] -> Vector EdgeSample
sortEdgeSamples [EdgeSample]
samples = (forall s. ST s (Vector EdgeSample)) -> Vector EdgeSample
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector EdgeSample)) -> Vector EdgeSample)
-> (forall s. ST s (Vector EdgeSample)) -> Vector EdgeSample
forall a b. (a -> b) -> a -> b
$ do
    -- Resist the urge to make this a storable vector,

    -- it is actually a pessimisation.

    MVector s EdgeSample
mutableVector <- Vector EdgeSample -> ST s (MVector (PrimState (ST s)) EdgeSample)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw (Vector EdgeSample -> ST s (MVector (PrimState (ST s)) EdgeSample))
-> Vector EdgeSample
-> ST s (MVector (PrimState (ST s)) EdgeSample)
forall a b. (a -> b) -> a -> b
$ [EdgeSample] -> Vector EdgeSample
forall a. [a] -> Vector a
V.fromList [EdgeSample]
samples
    (EdgeSample -> EdgeSample -> Ordering)
-> MVector (PrimState (ST s)) EdgeSample -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VS.sortBy EdgeSample -> EdgeSample -> Ordering
xyCompare MVector s EdgeSample
MVector (PrimState (ST s)) EdgeSample
mutableVector
    MVector (PrimState (ST s)) EdgeSample -> ST s (Vector EdgeSample)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector s EdgeSample
MVector (PrimState (ST s)) EdgeSample
mutableVector

rasterize :: FillMethod -> Container Primitive -> [CoverageSpan]
rasterize :: FillMethod -> Container Primitive -> [CoverageSpan]
rasterize FillMethod
method = 
  case FillMethod
method of
    FillMethod
FillWinding -> (Float -> Float) -> Vector EdgeSample -> [CoverageSpan]
combineEdgeSamples Float -> Float
combineWinding 
                        (Vector EdgeSample -> [CoverageSpan])
-> (Container Primitive -> Vector EdgeSample)
-> Container Primitive
-> [CoverageSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EdgeSample] -> Vector EdgeSample
sortEdgeSamples
                        ([EdgeSample] -> Vector EdgeSample)
-> (Container Primitive -> [EdgeSample])
-> Container Primitive
-> Vector EdgeSample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Producer EdgeSample -> Producer EdgeSample
forall a b. (a -> b) -> a -> b
$ []) (Producer EdgeSample -> [EdgeSample])
-> (Endo [EdgeSample] -> Producer EdgeSample)
-> Endo [EdgeSample]
-> [EdgeSample]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo [EdgeSample] -> Producer EdgeSample
forall a. Endo a -> a -> a
appEndo)
                        (Endo [EdgeSample] -> [EdgeSample])
-> (Container Primitive -> Endo [EdgeSample])
-> Container Primitive
-> [EdgeSample]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Primitive -> Endo [EdgeSample])
-> Container Primitive -> Endo [EdgeSample]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Producer EdgeSample -> Endo [EdgeSample]
forall a. (a -> a) -> Endo a
Endo (Producer EdgeSample -> Endo [EdgeSample])
-> (Primitive -> Producer EdgeSample)
-> Primitive
-> Endo [EdgeSample]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Primitive -> Producer EdgeSample
decompose)
    FillMethod
FillEvenOdd -> (Float -> Float) -> Vector EdgeSample -> [CoverageSpan]
combineEdgeSamples Float -> Float
forall a. Real a => a -> a
combineEvenOdd
                        (Vector EdgeSample -> [CoverageSpan])
-> (Container Primitive -> Vector EdgeSample)
-> Container Primitive
-> [CoverageSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EdgeSample] -> Vector EdgeSample
sortEdgeSamples
                        ([EdgeSample] -> Vector EdgeSample)
-> (Container Primitive -> [EdgeSample])
-> Container Primitive
-> Vector EdgeSample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Producer EdgeSample -> Producer EdgeSample
forall a b. (a -> b) -> a -> b
$ []) (Producer EdgeSample -> [EdgeSample])
-> (Endo [EdgeSample] -> Producer EdgeSample)
-> Endo [EdgeSample]
-> [EdgeSample]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo [EdgeSample] -> Producer EdgeSample
forall a. Endo a -> a -> a
appEndo)
                        (Endo [EdgeSample] -> [EdgeSample])
-> (Container Primitive -> Endo [EdgeSample])
-> Container Primitive
-> [EdgeSample]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Primitive -> Endo [EdgeSample])
-> Container Primitive -> Endo [EdgeSample]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Producer EdgeSample -> Endo [EdgeSample]
forall a. (a -> a) -> Endo a
Endo (Producer EdgeSample -> Endo [EdgeSample])
-> (Primitive -> Producer EdgeSample)
-> Primitive
-> Endo [EdgeSample]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Primitive -> Producer EdgeSample
decompose)
  where combineWinding :: Float -> Float
combineWinding = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
forall a. Num a => a -> a
abs
        combineEvenOdd :: a -> a
combineEvenOdd a
cov = a -> a
forall a. Num a => a -> a
abs (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs (a
cov a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Real a => a -> a -> a
`mod'` a
2 a -> a -> a
forall a. Num a => a -> a -> a
- a
1