    {-# OPTIONS_HADDOCK hide #-}

    module Graphics.Gloss.Internals.Rendering.Polygon(renderComplexPolygon) where
    import Graphics.Gloss.Internals.Rendering.Common
    import Graphics.Rendering.OpenGL.GLU.Tessellation
    import qualified Graphics.Rendering.OpenGL.GL           as GL

    combiner :: a -> b -> ()
    combiner :: forall a b. a -> b -> ()
    combiner a
    _ b
    _ = ()

    -- written this way to measurably improve performance
    zipLoop :: [a] -> [(a,a)]
    zipLoop :: forall a. [a] -> [(a, a)]
    zipLoop [] = []
    zipLoop (a
    x:[a]
    xs) = a -> [a] -> [(a, a)]
    go a
    x [a]
    xs where
      go :: a -> [a] -> [(a, a)]
    go a
    y [] = [(a
    y,a
    x)]
      go a
    y (a
    z:[a]
    rs) = (a
    y,a
    z) (a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    : a -> [a] -> [(a, a)]
    go a
    z [a]
    rs

    zipWithLoop :: (a->a->b) -> [a] -> [b]
    zipWithLoop :: forall a b. (a -> a -> b) -> [a] -> [b]
    zipWithLoop a -> a -> b
    f = ((a, a) -> b) -> [(a, a)] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> a -> b) -> (a, a) -> b
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry a -> a -> b
    f) ([(a, a)] -> [b]) -> ([a] -> [(a, a)]) -> [a] -> [b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [(a, a)]
    forall a. [a] -> [(a, a)]
    zipLoop

    -- signed angle between 2 vectors
    -- https://stackoverflow.com/a/16544330/1779797
    -- Note: `isConvex` would remain correct if this returned a value between theta*7/2pi and theta*7/4pi which probably provides an opportunity for optimisation
    angle :: (Float,Float) -> (Float,Float) -> Float
    angle :: (GLfloat, GLfloat) -> (GLfloat, GLfloat) -> GLfloat
    angle (GLfloat
    x1,GLfloat
    y1) (GLfloat
    x2,GLfloat
    y2) = let dot :: GLfloat
    dot = GLfloat
    x1GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    *GLfloat
    x2 GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    + GLfloat
    y1GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    *GLfloat
    y2 -- cos theta * |v1||v2|
                                det :: GLfloat
    det = GLfloat
    y2GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    *GLfloat
    x1 GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    - GLfloat
    x2GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    *GLfloat
    y1 -- sin theta * |v1||v2|
                            in GLfloat -> GLfloat -> GLfloat
    forall a. RealFloat a => a -> a -> a
    atan2 GLfloat
    det GLfloat
    dot

    -- Approximating 2pi by 7 is reasonable here.
    -- The total rotation theoretically must be a multiple of 2pi,
    -- so a little generosity doesn't break anything, but might save some cases that would fail due to floating point errors
    isConvex :: [(Float,Float)] -> Bool
    isConvex :: [(GLfloat, GLfloat)] -> Bool
    isConvex [(GLfloat, GLfloat)]
    ps =
        -- check that it doesn't turn more than one full circle in total
        (GLfloat -> Bool) -> [GLfloat] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\GLfloat
    theta -> (GLfloat
    theta GLfloat -> GLfloat -> Bool
    forall a. Ord a => a -> a -> Bool
    <= GLfloat
    7) Bool -> Bool -> Bool
    && (GLfloat
    theta GLfloat -> GLfloat -> Bool
    forall a. Ord a => a -> a -> Bool
    > -GLfloat
    7)) ([GLfloat] -> Bool) -> [GLfloat] -> Bool
    forall a b. (a -> b) -> a -> b
    $
        (GLfloat -> GLfloat -> GLfloat)
    -> GLfloat -> [GLfloat] -> [GLfloat]
    forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl GLfloat -> GLfloat -> GLfloat
    angleAdd GLfloat
    0 ([GLfloat] -> [GLfloat]) -> [GLfloat] -> [GLfloat]
    forall a b. (a -> b) -> a -> b
    $ -- check that the path's direction is consistent
        ((GLfloat, GLfloat) -> (GLfloat, GLfloat) -> GLfloat)
    -> [(GLfloat, GLfloat)] -> [GLfloat]
    forall a b. (a -> a -> b) -> [a] -> [b]
    zipWithLoop (GLfloat, GLfloat) -> (GLfloat, GLfloat) -> GLfloat
    angle ([(GLfloat, GLfloat)] -> [GLfloat])
    -> [(GLfloat, GLfloat)] -> [GLfloat]
    forall a b. (a -> b) -> a -> b
    $ -- compute angles of turns at each vertex
        ((GLfloat, GLfloat) -> Bool)
    -> [(GLfloat, GLfloat)] -> [(GLfloat, GLfloat)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((GLfloat, GLfloat) -> (GLfloat, GLfloat) -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (GLfloat
    0,GLfloat
    0)) ([(GLfloat, GLfloat)] -> [(GLfloat, GLfloat)])
    -> [(GLfloat, GLfloat)] -> [(GLfloat, GLfloat)]
    forall a b. (a -> b) -> a -> b
    $ -- discard edges arising from duplicated vertices
        ((GLfloat, GLfloat) -> (GLfloat, GLfloat) -> (GLfloat, GLfloat))
    -> [(GLfloat, GLfloat)] -> [(GLfloat, GLfloat)]
    forall a b. (a -> a -> b) -> [a] -> [b]
    zipWithLoop (\(GLfloat
    x1,GLfloat
    y1) (GLfloat
    x2,GLfloat
    y2) -> (GLfloat
    x2GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    -GLfloat
    x1,GLfloat
    y2GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    -GLfloat
    y1) ) -- produce vectors for each edge
            [(GLfloat, GLfloat)]
    ps
      where
        -- Combine angles, but return a value greater than 7 if they have opposite signs
        angleAdd :: Float -> Float -> Float
        angleAdd :: GLfloat -> GLfloat -> GLfloat
    angleAdd GLfloat
    a GLfloat
    b = if GLfloat -> GLfloat
    forall a. Num a => a -> a
    signum GLfloat
    aGLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    *GLfloat -> GLfloat
    forall a. Num a => a -> a
    signum GLfloat
    b GLfloat -> GLfloat -> Bool
    forall a. Ord a => a -> a -> Bool
    < -GLfloat
    0.5 then GLfloat
    10 else GLfloat
    a GLfloat -> GLfloat -> GLfloat
    forall a. Num a => a -> a -> a
    + GLfloat
    b

    renderComplexPolygon :: [(Float,Float)] -> IO ()
    renderComplexPolygon :: [(GLfloat, GLfloat)] -> IO ()
    renderComplexPolygon [(GLfloat, GLfloat)]
    path = if [(GLfloat, GLfloat)] -> Bool
    isConvex [(GLfloat, GLfloat)]
    path
      then PrimitiveMode -> IO () -> IO ()
    forall a. PrimitiveMode -> IO a -> IO a
    GL.renderPrimitive PrimitiveMode
    GL.Polygon (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [(GLfloat, GLfloat)] -> IO ()
    vertexPFs [(GLfloat, GLfloat)]
    path
      else do
        Triangulation ts <- Tessellator Triangulation ()
    forall v. Storable v => Tessellator Triangulation v
    triangulate TessWinding
    TessWindingOdd GLdouble
    0 ( GLdouble -> GLdouble -> GLdouble -> Normal3 GLdouble
    forall a. a -> a -> a -> Normal3 a
    GL.Normal3 GLdouble
    0 GLdouble
    0 GLdouble
    1) Vertex3 GLdouble -> WeightedProperties () -> ()
    forall a b. a -> b -> ()
    combiner
          ([ComplexContour ()] -> ComplexPolygon ()
    forall v. [ComplexContour v] -> ComplexPolygon v
    ComplexPolygon [[AnnotatedVertex ()] -> ComplexContour ()
    forall v. [AnnotatedVertex v] -> ComplexContour v
    ComplexContour [Vertex3 GLdouble -> () -> AnnotatedVertex ()
    forall v. Vertex3 GLdouble -> v -> AnnotatedVertex v
    AnnotatedVertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
    forall a. a -> a -> a -> Vertex3 a
    GL.Vertex3 (GLfloat -> GLdouble
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac GLfloat
    a) (GLfloat -> GLdouble
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac GLfloat
    b) GLdouble
    0) () | (GLfloat
    a,GLfloat
    b) <- [(GLfloat, GLfloat)]
    path]])
        GL.renderPrimitive GL.Triangles (trisToGLVertices ts)
        return ()

    trisToGLVertices ::    [Triangle a] -> IO ()
    trisToGLVertices :: forall a. [Triangle a] -> IO ()
    trisToGLVertices []    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    trisToGLVertices ((Triangle (AnnotatedVertex Vertex3 GLdouble
    v1 (a, EdgeFlag)
    _) (AnnotatedVertex Vertex3 GLdouble
    v2 (a, EdgeFlag)
    _) (AnnotatedVertex Vertex3 GLdouble
    v3 (a, EdgeFlag)
    _)) : [Triangle a]
    rest)
     = do   Vertex3 GLdouble -> IO ()
    forall a. Vertex a => a -> IO ()
    GL.vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Vertex3 GLdouble
    v1
            Vertex3 GLdouble -> IO ()
    forall a. Vertex a => a -> IO ()
    GL.vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Vertex3 GLdouble
    v2
            Vertex3 GLdouble -> IO ()
    forall a. Vertex a => a -> IO ()
    GL.vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Vertex3 GLdouble
    v3
            [Triangle a] -> IO ()
    forall a. [Triangle a] -> IO ()
    trisToGLVertices [Triangle a]
    rest
    {-# INLINE trisToGLVertices #-}

    vertexPFs ::    [(Float, Float)] -> IO ()
    vertexPFs :: [(GLfloat, GLfloat)] -> IO ()
    vertexPFs []    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    vertexPFs ((GLfloat
    x, GLfloat
    y) : [(GLfloat, GLfloat)]
    rest)
     = do   Vertex2 GLfloat -> IO ()
    forall a. Vertex a => a -> IO ()
    GL.vertex (Vertex2 GLfloat -> IO ()) -> Vertex2 GLfloat -> IO ()
    forall a b. (a -> b) -> a -> b
    $ GLfloat -> GLfloat -> Vertex2 GLfloat
    forall a. a -> a -> Vertex2 a
    GL.Vertex2 (GLfloat -> GLfloat
    gf GLfloat
    x) (GLfloat -> GLfloat
    gf GLfloat
    y)
            [(GLfloat, GLfloat)] -> IO ()
    vertexPFs [(GLfloat, GLfloat)]
    rest
    {-# INLINE vertexPFs #-}