{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash    #-}
{-# OPTIONS_HADDOCK hide #-}

-- | Fast(ish) rendering of circles.
module Graphics.Gloss.Internals.Rendering.Circle
        ( renderCircle
        , renderArc)
where
import  Graphics.Gloss.Internals.Rendering.Common
import  GHC.Exts
import  qualified Graphics.Rendering.OpenGL.GL          as GL


-------------------------------------------------------------------------------
-- | Decide how many line segments to use to render the circle.
--   The number of segments we should use to get a nice picture depends on
--   the size of the circle on the screen, not its intrinsic radius.
--   If the viewport has been zoomed-in then we need to use more segments.
circleSteps :: Float -> Int
circleSteps :: Float -> Int
circleSteps Float
sDiam
        | Float
sDiam Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
8     = Int
8
        | Float
sDiam Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
16    = Int
16
        | Float
sDiam Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
32    = Int
32
        | Bool
otherwise     = Int
64
{-# INLINE circleSteps #-}


-- Circle ---------------------------------------------------------------------
-- | Render a circle with the given thickness
renderCircle :: Float -> Float -> Float -> Float -> Float -> IO ()
renderCircle :: Float -> Float -> Float -> Float -> Float -> IO ()
renderCircle Float
posX Float
posY Float
scaleFactor Float
radius_ Float
thickness_
 = Float -> Float -> IO ()
go (Float -> Float
forall a. Num a => a -> a
abs Float
radius_) (Float -> Float
forall a. Num a => a -> a
abs Float
thickness_)
 where go :: Float -> Float -> IO ()
go Float
radius Float
thickness

        -- If the circle is smaller than a pixel, render it as a point.
        | Float
thickness     Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0
        , Float
radScreen     <- Float
scaleFactor Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
radius Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
thickness Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)
        , Float
radScreen     Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1
        = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
GL.renderPrimitive PrimitiveMode
GL.Points
            (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex2 Float -> IO ()
forall a. Vertex a => a -> IO ()
GL.vertex (Vertex2 Float -> IO ()) -> Vertex2 Float -> IO ()
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Vertex2 Float
forall a. a -> a -> Vertex2 a
GL.Vertex2 (Float -> Float
gf Float
posX) (Float -> Float
gf Float
posY)

        -- Render zero thickness circles with lines.
        | Float
thickness Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0
        , Float
radScreen     <- Float
scaleFactor Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
radius
        , Int
steps         <- Float -> Int
circleSteps Float
radScreen
        = Float -> Float -> Int -> Float -> IO ()
renderCircleLine  Float
posX Float
posY Int
steps Float
radius

        -- Some thick circle.
        | Float
radScreen     <- Float
scaleFactor Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
radius Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
thickness Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)
        , Int
steps         <- Float -> Int
circleSteps Float
radScreen
        = Float -> Float -> Int -> Float -> Float -> IO ()
renderCircleStrip Float
posX Float
posY Int
steps Float
radius Float
thickness


-- | Render a circle as a line.
renderCircleLine :: Float -> Float -> Int -> Float -> IO ()
renderCircleLine :: Float -> Float -> Int -> Float -> IO ()
renderCircleLine (F# Float#
posX) (F# Float#
posY) Int
steps (F# Float#
rad)
 = let  n :: Float
n               = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
steps
        !(F# Float#
tStep)     = (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
n
        !(F# Float#
tStop)     = (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi)

   in   PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
GL.renderPrimitive PrimitiveMode
GL.LineLoop
         (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO ()
renderCircleLine_step Float#
posX Float#
posY Float#
tStep Float#
tStop Float#
rad Float#
0.0#
{-# INLINE renderCircleLine #-}


-- | Render a circle with a given thickness as a triangle strip
renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO ()
renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO ()
renderCircleStrip (F# Float#
posX) (F# Float#
posY) Int
steps Float
r Float
width
 = let  n :: Float
n               = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
steps
        !(F# Float#
tStep)     = (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
n
        !(F# Float#
tStop)     = (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float# -> Float
F# Float#
tStep) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        !(F# Float#
r1)        = Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        !(F# Float#
r2)        = Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2

   in   PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
GL.renderPrimitive PrimitiveMode
GL.TriangleStrip
         (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> IO ()
renderCircleStrip_step Float#
posX Float#
posY Float#
tStep Float#
tStop Float#
r1 Float#
0.0# Float#
r2
                (Float#
tStep Float# -> Float# -> Float#
`divideFloat#` Float#
2.0#)
{-# INLINE renderCircleStrip #-}


-- Arc ------------------------------------------------------------------------
-- | Render an arc with the given thickness.
renderArc
 :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()
renderArc :: Float
-> Float -> Float -> Float -> Float -> Float -> Float -> IO ()
renderArc Float
posX Float
posY Float
scaleFactor Float
radius_ Float
a1 Float
a2 Float
thickness_
 = Float -> Float -> IO ()
go (Float -> Float
forall a. Num a => a -> a
abs Float
radius_) (Float -> Float
forall a. Num a => a -> a
abs Float
thickness_)
 where
       go :: Float -> Float -> IO ()
go Float
radius Float
thickness
        -- Render zero thickness arcs with lines.
        | Float
thickness Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0
        , Float
radScreen     <- Float
scaleFactor Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
radius
        , Int
steps         <- Float -> Int
circleSteps Float
radScreen
        = Float -> Float -> Int -> Float -> Float -> Float -> IO ()
renderArcLine Float
posX Float
posY Int
steps Float
radius Float
a1 Float
a2

        -- Some thick arc.
        | Float
radScreen     <- Float
scaleFactor Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
radius Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
thickness Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)
        , Int
steps         <- Float -> Int
circleSteps Float
radScreen
        = Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()
renderArcStrip Float
posX Float
posY Int
steps Float
radius Float
a1 Float
a2 Float
thickness


-- | Render an arc as a line.
renderArcLine
 :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()
renderArcLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()
renderArcLine (F# Float#
posX) (F# Float#
posY) Int
steps (F# Float#
rad) Float
a1 Float
a2
 = let  n :: Float
n               = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
steps
        !(F# Float#
tStep)     = (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
n
        !(F# Float#
tStart)    = Float -> Float
degToRad Float
a1
        !(F# Float#
tStop)     = Float -> Float
degToRad Float
a2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ if Float
a1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
a2 then Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi else Float
0

        -- force the line to end at the desired angle
        endVertex :: IO ()
endVertex       = Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
rad Float#
tStop

   in   PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
GL.renderPrimitive PrimitiveMode
GL.LineStrip
         (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do   Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO ()
renderCircleLine_step Float#
posX Float#
posY Float#
tStep Float#
tStop Float#
rad Float#
tStart
                IO ()
endVertex
{-# INLINE renderArcLine #-}


-- | Render an arc with a given thickness as a triangle strip
renderArcStrip
 :: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()
renderArcStrip :: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()
renderArcStrip (F# Float#
posX) (F# Float#
posY) Int
steps Float
r Float
a1 Float
a2 Float
width
 = let  n :: Float
n               = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
steps
        tStep :: Float
tStep           = (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
n

        t1 :: Float
t1              = Float -> Float
normalizeAngle (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
degToRad Float
a1

        a2' :: Float
a2'             = Float -> Float
normalizeAngle (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
degToRad Float
a2
        t2 :: Float
t2              = if Float
a2' Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 then Float
2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
forall a. Floating a => a
pi else Float
a2'

        (Float
tStart, Float
tStop) = if Float
t1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
t2 then (Float
t1, Float
t2) else (Float
t2, Float
t1)
        tDiff :: Float
tDiff           = Float
tStop Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
tStart
        tMid :: Float
tMid            = Float
tStart Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
tDiff Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2

        !(F# Float#
tStep')    = Float
tStep
        !(F# Float#
tStep2')   = Float
tStep Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        !(F# Float#
tStart')   = Float
tStart
        !(F# Float#
tStop')    = Float
tStop
        !(F# Float#
tCut')     = Float
tStop Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
tStep
        !(F# Float#
tMid')     = Float
tMid
        !(F# Float#
r1')       = Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
        !(F# Float#
r2')       = Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2

   in   PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
GL.renderPrimitive PrimitiveMode
GL.TriangleStrip
         (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do   -- start vector
                Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r1' Float#
tStart'
                Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r2' Float#
tStart'

                -- If we don't have a complete step then just drop a point
                -- between the two ending lines.
                if Float
tDiff Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
tStep
                  then do
                        Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r1' Float#
tMid'

                        -- end vectors
                        Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r2' Float#
tStop'
                        Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r1' Float#
tStop'

                  else do
                        Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> IO ()
renderCircleStrip_step Float#
posX Float#
posY
                                Float#
tStep' Float#
tCut' Float#
r1' Float#
tStart' Float#
r2'
                                (Float#
tStart' Float# -> Float# -> Float#
`plusFloat#` Float#
tStep2')

                        -- end vectors
                        Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r1' Float#
tStop'
                        Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r2' Float#
tStop'
{-# INLINE renderArcStrip #-}


-- Step functions -------------------------------------------------------------
renderCircleLine_step
        :: Float# -> Float#
        -> Float# -> Float#
        -> Float# -> Float#
        -> IO ()

renderCircleLine_step :: Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO ()
renderCircleLine_step Float#
posX Float#
posY Float#
tStep Float#
tStop Float#
rad Float#
tt
        | Int#
1# <- Float#
tt Float# -> Float# -> Int#
`geFloat#` Float#
tStop
        = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        | Bool
otherwise
        = do    Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
rad Float#
tt
                Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO ()
renderCircleLine_step Float#
posX Float#
posY Float#
tStep Float#
tStop Float#
rad
                        (Float#
tt Float# -> Float# -> Float#
`plusFloat#` Float#
tStep)
{-# INLINE renderCircleLine_step #-}


renderCircleStrip_step
        :: Float# -> Float#
        -> Float# -> Float#
        -> Float# -> Float#
        -> Float# -> Float# -> IO ()

renderCircleStrip_step :: Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> IO ()
renderCircleStrip_step Float#
posX Float#
posY Float#
tStep Float#
tStop Float#
r1 Float#
t1 Float#
r2 Float#
t2
        | Int#
1# <- Float#
t1 Float# -> Float# -> Int#
`geFloat#` Float#
tStop
        = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        | Bool
otherwise
        = do    Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r1 Float#
t1
                Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
r2 Float#
t2
                Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> IO ()
renderCircleStrip_step Float#
posX Float#
posY Float#
tStep Float#
tStop Float#
r1
                        (Float#
t1 Float# -> Float# -> Float#
`plusFloat#` Float#
tStep) Float#
r2 (Float#
t2 Float# -> Float# -> Float#
`plusFloat#` Float#
tStep)
{-# INLINE renderCircleStrip_step #-}


addPoint :: Float# -> Float# -> IO ()
addPoint :: Float# -> Float# -> IO ()
addPoint Float#
x Float#
y =
  Vertex2 Float -> IO ()
forall a. Vertex a => a -> IO ()
GL.vertex (Vertex2 Float -> IO ()) -> Vertex2 Float -> IO ()
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Vertex2 Float
forall a. a -> a -> Vertex2 a
GL.Vertex2 (Float -> Float
gf (Float# -> Float
F# Float#
x)) (Float -> Float
gf (Float# -> Float
F# Float#
y))
{-# INLINE addPoint #-}


addPointOnCircle :: Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle :: Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle Float#
posX Float#
posY Float#
rad Float#
tt =
  Float# -> Float# -> IO ()
addPoint
    (Float#
posX Float# -> Float# -> Float#
`plusFloat#` (Float#
rad Float# -> Float# -> Float#
`timesFloat#` (Float# -> Float#
cosFloat# Float#
tt)))
    (Float#
posY Float# -> Float# -> Float#
`plusFloat#` (Float#
rad Float# -> Float# -> Float#
`timesFloat#` (Float# -> Float#
sinFloat# Float#
tt)))
{-# INLINE addPointOnCircle #-}


-- | Convert degrees to radians
degToRad :: Float -> Float
degToRad :: Float -> Float
degToRad Float
d      = Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
180
{-# INLINE degToRad #-}


-- | Normalise an angle to be between 0 and 2*pi radians
normalizeAngle :: Float -> Float
normalizeAngle :: Float -> Float
normalizeAngle Float
f = Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
floor' (Float
f Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi))
 where  floor' :: Float -> Float
        floor' :: Float -> Float
floor' Float
x = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
x :: Int)
{-# INLINE normalizeAngle #-}


{- Unused sector drawing code.
   Sectors are currently drawn as compound Pictures,
   but we might want this if we end up implementing the ThickSector
   version as well.

-- | Render a sector as a line.
renderSectorLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()
renderSectorLine pX@(F# posX) pY@(F# posY) steps (F# rad) a1 a2
 = let  n               = fromIntegral steps
        !(F# tStep)     = (2 * pi) / n
        !(F# tStart)    = degToRad a1
        !(F# tStop)     = degToRad a2 + if a1 >= a2 then 2 * pi else 0

        -- need to set up the edges of the start/end triangles
        startVertex     = GL.vertex $ GL.Vertex2 (gf pX) (gf pY)
        endVertex       = addPointOnCircle posX posY rad tStop

   in   GL.renderPrimitive GL.LineLoop
         $ do   startVertex
                renderCircleLine_step posX posY tStep tStop rad tStart
                endVertex

-- | Render a sector.
renderSector :: Float -> Float -> Float -> Float -> Float -> Float -> IO ()
renderSector posX posY scaleFactor radius a1 a2
        | radScreen     <- scaleFactor * radius
        , steps         <- circleSteps (2 * radScreen)
        = renderSectorLine posX posY steps radius a1 a2
-}