{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK hide #-}
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
circleSteps :: Float -> Int
circleSteps sDiam
| sDiam < 8 = 8
| sDiam < 16 = 16
| sDiam < 32 = 32
| otherwise = 64
{-# INLINE circleSteps #-}
renderCircle :: Float -> Float -> Float -> Float -> Float -> IO ()
renderCircle posX posY scaleFactor radius_ thickness_
= go (abs radius_) (abs thickness_)
where go radius thickness
| thickness == 0
, radScreen <- scaleFactor * (radius + thickness / 2)
, radScreen <= 1
= GL.renderPrimitive GL.Points
$ GL.vertex $ GL.Vertex2 (gf posX) (gf posY)
| thickness == 0
, radScreen <- scaleFactor * radius
, steps <- circleSteps radScreen
= renderCircleLine posX posY steps radius
| radScreen <- scaleFactor * (radius + thickness / 2)
, steps <- circleSteps radScreen
= renderCircleStrip posX posY steps radius thickness
renderCircleLine :: Float -> Float -> Int -> Float -> IO ()
renderCircleLine (F# posX) (F# posY) steps (F# rad)
= let n = fromIntegral steps
!(F# tStep) = (2 * pi) / n
!(F# tStop) = (2 * pi)
in GL.renderPrimitive GL.LineLoop
$ renderCircleLine_step posX posY tStep tStop rad 0.0#
{-# INLINE renderCircleLine #-}
renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO ()
renderCircleStrip (F# posX) (F# posY) steps r width
= let n = fromIntegral steps
!(F# tStep) = (2 * pi) / n
!(F# tStop) = (2 * pi) + (F# tStep) / 2
!(F# r1) = r - width / 2
!(F# r2) = r + width / 2
in GL.renderPrimitive GL.TriangleStrip
$ renderCircleStrip_step posX posY tStep tStop r1 0.0# r2
(tStep `divideFloat#` 2.0#)
{-# INLINE renderCircleStrip #-}
renderArc
:: Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()
renderArc posX posY scaleFactor radius_ a1 a2 thickness_
= go (abs radius_) (abs thickness_)
where
go radius thickness
| thickness == 0
, radScreen <- scaleFactor * radius
, steps <- circleSteps radScreen
= renderArcLine posX posY steps radius a1 a2
| radScreen <- scaleFactor * (radius + thickness / 2)
, steps <- circleSteps radScreen
= renderArcStrip posX posY steps radius a1 a2 thickness
renderArcLine
:: Float -> Float -> Int -> Float -> Float -> Float -> IO ()
renderArcLine (F# posX) (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
endVertex = addPointOnCircle posX posY rad tStop
in GL.renderPrimitive GL.LineStrip
$ do renderCircleLine_step posX posY tStep tStop rad tStart
endVertex
{-# INLINE renderArcLine #-}
renderArcStrip
:: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()
renderArcStrip (F# posX) (F# posY) steps r a1 a2 width
= let n = fromIntegral steps
tStep = (2 * pi) / n
t1 = normalizeAngle $ degToRad a1
a2' = normalizeAngle $ degToRad a2
t2 = if a2' == 0 then 2*pi else a2'
(tStart, tStop) = if t1 <= t2 then (t1, t2) else (t2, t1)
tDiff = tStop - tStart
tMid = tStart + tDiff / 2
!(F# tStep') = tStep
!(F# tStep2') = tStep / 2
!(F# tStart') = tStart
!(F# tStop') = tStop
!(F# tCut') = tStop - tStep
!(F# tMid') = tMid
!(F# r1') = r - width / 2
!(F# r2') = r + width / 2
in GL.renderPrimitive GL.TriangleStrip
$ do
addPointOnCircle posX posY r1' tStart'
addPointOnCircle posX posY r2' tStart'
if tDiff < tStep
then do
addPointOnCircle posX posY r1' tMid'
addPointOnCircle posX posY r2' tStop'
addPointOnCircle posX posY r1' tStop'
else do
renderCircleStrip_step posX posY
tStep' tCut' r1' tStart' r2'
(tStart' `plusFloat#` tStep2')
addPointOnCircle posX posY r1' tStop'
addPointOnCircle posX posY r2' tStop'
{-# INLINE renderArcStrip #-}
renderCircleLine_step
:: Float# -> Float#
-> Float# -> Float#
-> Float# -> Float#
-> IO ()
renderCircleLine_step posX posY tStep tStop rad tt
| 1# <- tt `geFloat#` tStop
= return ()
| otherwise
= do addPointOnCircle posX posY rad tt
renderCircleLine_step posX posY tStep tStop rad
(tt `plusFloat#` tStep)
{-# INLINE renderCircleLine_step #-}
renderCircleStrip_step
:: Float# -> Float#
-> Float# -> Float#
-> Float# -> Float#
-> Float# -> Float# -> IO ()
renderCircleStrip_step posX posY tStep tStop r1 t1 r2 t2
| 1# <- t1 `geFloat#` tStop
= return ()
| otherwise
= do addPointOnCircle posX posY r1 t1
addPointOnCircle posX posY r2 t2
renderCircleStrip_step posX posY tStep tStop r1
(t1 `plusFloat#` tStep) r2 (t2 `plusFloat#` tStep)
{-# INLINE renderCircleStrip_step #-}
addPoint :: Float# -> Float# -> IO ()
addPoint x y =
GL.vertex $ GL.Vertex2 (gf (F# x)) (gf (F# y))
{-# INLINE addPoint #-}
addPointOnCircle :: Float# -> Float# -> Float# -> Float# -> IO ()
addPointOnCircle posX posY rad tt =
addPoint
(posX `plusFloat#` (rad `timesFloat#` (cosFloat# tt)))
(posY `plusFloat#` (rad `timesFloat#` (sinFloat# tt)))
{-# INLINE addPointOnCircle #-}
degToRad :: Float -> Float
degToRad d = d * pi / 180
{-# INLINE degToRad #-}
normalizeAngle :: Float -> Float
normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))
where floor' :: Float -> Float
floor' x = fromIntegral (floor x :: Int)
{-# INLINE normalizeAngle #-}