{- |
  Parameters define the global context of an animation. They are set once
  before an animation is rendered and may not change during rendering.
-}
module Reanimate.Parameters
  ( Raster(..)
  , Width
  , Height
  , FPS
  , pRaster
  , pFPS
  , pWidth
  , pHeight
  , pNoExternals
  , pRootDirectory
  , setRaster
  , setFPS
  , setWidth
  , setHeight
  , setNoExternals
  , setRootDirectory
  ) where

import           Data.IORef       (IORef, newIORef, readIORef, writeIORef)
import           System.IO.Unsafe (unsafePerformIO)

-- | Width of animation in pixels.
type Width = Int
-- | Height of animation in pixels.
type Height = Int
-- | Framerate of animation in frames per second.
type FPS = Int

-- | Raster engines turn SVG images into pixels.
data Raster
  = RasterNone     -- ^ Do not use any external raster engine. Rely on the browser or ffmpeg.
  | RasterAuto     -- ^ Scan for installed raster engines and pick the fastest one.
  | RasterInkscape -- ^ Use Inkscape to raster SVG images.
  | RasterRSvg     -- ^ Use rsvg-convert to raster SVG images.
  | RasterMagick   -- ^ Use imagemagick to raster SVG images.
  deriving (Int -> Raster -> ShowS
[Raster] -> ShowS
Raster -> String
(Int -> Raster -> ShowS)
-> (Raster -> String) -> ([Raster] -> ShowS) -> Show Raster
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Raster] -> ShowS
$cshowList :: [Raster] -> ShowS
show :: Raster -> String
$cshow :: Raster -> String
showsPrec :: Int -> Raster -> ShowS
$cshowsPrec :: Int -> Raster -> ShowS
Show, Raster -> Raster -> Bool
(Raster -> Raster -> Bool)
-> (Raster -> Raster -> Bool) -> Eq Raster
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Raster -> Raster -> Bool
$c/= :: Raster -> Raster -> Bool
== :: Raster -> Raster -> Bool
$c== :: Raster -> Raster -> Bool
Eq)

{-# NOINLINE pRasterRef #-}
pRasterRef :: IORef Raster
pRasterRef :: IORef Raster
pRasterRef = IO (IORef Raster) -> IORef Raster
forall a. IO a -> a
unsafePerformIO (Raster -> IO (IORef Raster)
forall a. a -> IO (IORef a)
newIORef Raster
RasterNone)

{-# NOINLINE pRaster #-}
-- | Selected raster engine.
pRaster :: Raster
pRaster :: Raster
pRaster = IO Raster -> Raster
forall a. IO a -> a
unsafePerformIO (IORef Raster -> IO Raster
forall a. IORef a -> IO a
readIORef IORef Raster
pRasterRef)

-- | Set raster engine.
setRaster :: Raster -> IO ()
setRaster :: Raster -> IO ()
setRaster = IORef Raster -> Raster -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Raster
pRasterRef

{-# NOINLINE pFPSRef #-}
pFPSRef :: IORef FPS
pFPSRef :: IORef Int
pFPSRef = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0)

{-# NOINLINE pFPS #-}
-- | Selected framerate.
pFPS :: FPS
pFPS :: Int
pFPS = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
pFPSRef)

-- | Set desired framerate.
setFPS :: FPS -> IO ()
setFPS :: Int -> IO ()
setFPS = IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
pFPSRef

{-# NOINLINE pWidthRef #-}
pWidthRef :: IORef FPS
pWidthRef :: IORef Int
pWidthRef = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0)

{-# NOINLINE pWidth #-}
-- | Width of animation in pixel.
pWidth :: Width
pWidth :: Int
pWidth = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
pWidthRef)

-- | Set desired width of animation in pixel.
setWidth :: Width -> IO ()
setWidth :: Int -> IO ()
setWidth = IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
pWidthRef

{-# NOINLINE pHeightRef #-}
pHeightRef :: IORef FPS
pHeightRef :: IORef Int
pHeightRef = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0)

{-# NOINLINE pHeight #-}
-- | Height of animation in pixel.
pHeight :: Height
pHeight :: Int
pHeight = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
pHeightRef)

-- | Set desired height of animation in pixel.
setHeight :: Height -> IO ()
setHeight :: Int -> IO ()
setHeight = IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
pHeightRef

{-# NOINLINE pNoExternalsRef #-}
pNoExternalsRef :: IORef Bool
pNoExternalsRef :: IORef Bool
pNoExternalsRef = IO (IORef Bool) -> IORef Bool
forall a. IO a -> a
unsafePerformIO (Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False)

{-# NOINLINE pNoExternals #-}
-- | This parameter determined whether or not external tools are allowed.
--   If this flag is True then tools such as 'Reanimate.LaTeX.latex' and
--   'Reanimate.Blender.blender' will not be invoked.
pNoExternals :: Bool
pNoExternals :: Bool
pNoExternals = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
pNoExternalsRef)

-- | Set whether external tools are allowed.
setNoExternals :: Bool -> IO ()
setNoExternals :: Bool -> IO ()
setNoExternals = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
pNoExternalsRef

{-# NOINLINE pRootDirectoryRef #-}
pRootDirectoryRef :: IORef FilePath
pRootDirectoryRef :: IORef String
pRootDirectoryRef = IO (IORef String) -> IORef String
forall a. IO a -> a
unsafePerformIO (String -> IO (IORef String)
forall a. a -> IO (IORef a)
newIORef (ShowS
forall a. HasCallStack => String -> a
error String
"root directory not set"))

{-# NOINLINE pRootDirectory #-}
-- | Root directory of animation. Images and other data has to be placed
--   here if they are referenced in an SVG image.
pRootDirectory :: FilePath
pRootDirectory :: String
pRootDirectory = IO String -> String
forall a. IO a -> a
unsafePerformIO (IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
pRootDirectoryRef)

-- | Set the root animation directory.
setRootDirectory :: FilePath -> IO ()
setRootDirectory :: String -> IO ()
setRootDirectory = IORef String -> String -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef String
pRootDirectoryRef