{-# LANGUAGE OverloadedStrings #-}
{-|
  [Povray](http://povray.org/) is a scriptable raytracer. All povray functions
  are cached and will reuse images when scripts stay the same.
-}
module Reanimate.Povray
  ( povray
  , povrayQuick
  , povraySlow
  , povrayExtreme
  , povray'
  , povrayQuick'
  , povraySlow'
  , povrayExtreme'
  ) where

import           Data.Hashable              (Hashable (hash))
import           Data.Text                  (Text)
import qualified Data.Text                  as T
import qualified Data.Text.IO               as T
import           Graphics.SvgTree           (Tree)
import           Reanimate.Cache            (cacheFile, encodeInt)
import           Reanimate.Constants        (screenHeight, screenWidth)
import           Reanimate.Misc             (requireExecutable, runCmd)
import           Reanimate.Parameters       (pNoExternals)
import           Reanimate.Raster           (mkImage)
import           Reanimate.Svg.Constructors (mkText)
import           System.FilePath            (replaceExtension, (<.>))
import           System.IO.Unsafe           (unsafePerformIO)

povrayRaw :: [String] -> Text -> Tree
povrayRaw :: [String] -> Text -> Tree
povrayRaw [String]
args Text
script =
  IO Tree -> Tree
forall a. IO a -> a
unsafePerformIO (IO Tree -> Tree) -> IO Tree -> Tree
forall a b. (a -> b) -> a -> b
$ [String] -> Text -> IO Tree
mkPovrayImage [String]
args Text
script

povrayRaw' :: [String] -> Text -> FilePath
povrayRaw' :: [String] -> Text -> String
povrayRaw' [String]
args Text
script =
  IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Text -> IO String
mkPovrayImage' [String]
args Text
script

-- | Run the povray raytracer with a default resolution of 320x180
--   and antialiasing enabled. The resulting image is scaled to fit
--   the screen exactly.
povray :: [String] -> Text -> Tree
povray :: [String] -> Text -> Tree
povray [String]
args = [String] -> Text -> Tree
povrayRaw ([String
"+H180",String
"+W320", String
"+A"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

-- | Run the povray raytracer with a default resolution of 320x180
--   and antialiasing enabled. The FilePath points to a PNG file
--   containing the resulting image.
povray' :: [String] -> Text -> FilePath
povray' :: [String] -> Text -> String
povray' [String]
args = [String] -> Text -> String
povrayRaw' ([String
"+H180",String
"+W320", String
"+A"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

-- | Run the povray raytracer with a default resolution of 320x180
--   but without antialiasing. The resulting image is scaled to fit
--   the screen exactly.
povrayQuick :: [String] -> Text -> Tree
povrayQuick :: [String] -> Text -> Tree
povrayQuick [String]
args = [String] -> Text -> Tree
povrayRaw ([String
"+H180",String
"+W320"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

-- | Run the povray raytracer with a default resolution of 320x180
--   but without antialiasing. The FilePath points to a PNG file
--   containing the resulting image.
povrayQuick' :: [String] -> Text -> FilePath
povrayQuick' :: [String] -> Text -> String
povrayQuick' [String]
args = [String] -> Text -> String
povrayRaw' ([String
"+H180",String
"+W320"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

-- | Run the povray raytracer with a default resolution of 1440x2560
--   and antialiasing enabled. The FilePath points to a PNG file
--   containing the resulting image.
povraySlow :: [String] -> Text -> Tree
povraySlow :: [String] -> Text -> Tree
povraySlow [String]
args = [String] -> Text -> Tree
povrayRaw ([String
"+H1440",String
"+W2560", String
"+A"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

-- | Run the povray raytracer with a default resolution of 1440x2560
--   and antialiasing enabled. The FilePath points to a PNG file
--   containing the resulting image.
povraySlow' :: [String] -> Text -> FilePath
povraySlow' :: [String] -> Text -> String
povraySlow' [String]
args = [String] -> Text -> String
povrayRaw' ([String
"+H1440",String
"+W2560", String
"+A"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

-- | Run the povray raytracer with a default resolution of 2160x3840
--   and antialiasing enabled. The FilePath points to a PNG file
--   containing the resulting image.
povrayExtreme :: [String] -> Text -> Tree
povrayExtreme :: [String] -> Text -> Tree
povrayExtreme [String]
args = [String] -> Text -> Tree
povrayRaw ([String
"+H2160",String
"+W3840", String
"+A"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

-- | Run the povray raytracer with a default resolution of 2160x3840
--   and antialiasing enabled. The FilePath points to a PNG file
--   containing the resulting image.
povrayExtreme' :: [String] -> Text -> FilePath
povrayExtreme' :: [String] -> Text -> String
povrayExtreme' [String]
args = [String] -> Text -> String
povrayRaw' ([String
"+H2160",String
"+W3840", String
"+A"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)

mkPovrayImage :: [String] -> Text -> IO Tree
mkPovrayImage :: [String] -> Text -> IO Tree
mkPovrayImage [String]
_ Text
script | Bool
pNoExternals = Tree -> IO Tree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree -> IO Tree) -> Tree -> IO Tree
forall a b. (a -> b) -> a -> b
$ Text -> Tree
mkText Text
script
mkPovrayImage [String]
args Text
script =
  Double -> Double -> String -> Tree
mkImage Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight (String -> Tree) -> IO String -> IO Tree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Text -> IO String
mkPovrayImage' [String]
args Text
script

mkPovrayImage' :: [String] -> Text -> IO FilePath
mkPovrayImage' :: [String] -> Text -> IO String
mkPovrayImage' [String]
_ Text
_ | Bool
pNoExternals = String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"/povray/has/been/disabled"
mkPovrayImage' [String]
args Text
script = String -> (String -> IO ()) -> IO String
cacheFile String
template ((String -> IO ()) -> IO String) -> (String -> IO ()) -> IO String
forall a b. (a -> b) -> a -> b
$ \String
target -> do
    String
exec <- String -> IO String
requireExecutable String
"povray"
    let pov_file :: String
pov_file = String -> String -> String
replaceExtension String
target String
"pov"
    String -> Text -> IO ()
T.writeFile String
pov_file Text
script
    String -> [String] -> IO ()
runCmd String
exec ([String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-D",String
"+UA", String
pov_file, String
"+o"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
target])
  where
    template :: String
template = Int -> String
encodeInt (Text -> Int
forall a. Hashable a => a -> Int
hash Text
key) String -> String -> String
<.> String
"png"
    key :: Text
key = [Text] -> Text
T.concat (Text
scriptText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:(String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
args)