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

-- | Fast(ish) rendering of circles.
module Brillo.Internals.Rendering.Circle (
  renderCircle,
  renderArc,
)
where

import Brillo.Internals.Rendering.Common (gf)
import GHC.Exts (
  Float (F#),
  Float#,
  cosFloat#,
  divideFloat#,
  geFloat#,
  plusFloat#,
  sinFloat#,
  timesFloat#,
 )
import Graphics.Rendering.OpenGL.GL qualified 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 ()
renderCircleLineStep 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 ()
renderCircleStripStep
          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 ()
renderCircleLineStep 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
2 Float -> 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 ()
renderCircleStripStep
                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 -------------------------------------------------------------
renderCircleLineStep
  :: Float#
  -> Float#
  -> Float#
  -> Float#
  -> Float#
  -> Float#
  -> IO ()
renderCircleLineStep :: Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO ()
renderCircleLineStep 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 ()
renderCircleLineStep
          Float#
posX
          Float#
posY
          Float#
tStep
          Float#
tStop
          Float#
rad
          (Float#
tt Float# -> Float# -> Float#
`plusFloat#` Float#
tStep)
{-# INLINE renderCircleLineStep #-}


renderCircleStripStep
  :: Float#
  -> Float#
  -> Float#
  -> Float#
  -> Float#
  -> Float#
  -> Float#
  -> Float#
  -> IO ()
renderCircleStripStep :: Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> Float#
-> IO ()
renderCircleStripStep 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 ()
renderCircleStripStep
          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 renderCircleStripStep #-}


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
                renderCircleLineStep 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
-}