{-# LANGUAGE OverloadedStrings #-}
{-|
  [Blender](https://www.blender.org/) is a free and open-source 3D graphics toolkit.
  It is usually used through a graphical user-interface but can also be
  scripted via Python. These Blender scripts can access 100% of Blender's
  functionality and offer a convenient way of coding 3D effects.

  Running Blender can be time-consuming but heavy caching means scripts
  are only run when they change.

  Blender cheatsheet:

> # To generate with a transparent background, set film_transparent = True:
> bpy.context.scene.render.film_transparent = True
>
> # Filmic is great for photorealism but bad for animations.
> # If you want your textures to keep their exact color values,
> # set the view_transform to 'Standard':
> bpy.context.scene.view_settings.view_transform = 'Standard'
>
> # Blender's default render engine is 'EEVEE', fast but not a raytracer.
> # To switch to raytracing, set the engine to 'CYCLES':
> bpy.context.scene.render.engine = 'CYCLES'
>
> # Rendering at full resolution can be slow. When developing, try
> # decreasing the resolution_percentage for faster renders.
> bpy.context.scene.render.resolution_percentage = 10
>
> # The resolution of the final image are set by resolution_x and resolution_y:
> bpy.context.scene.render.resolution_x = 320
> bpy.context.scene.render.resolution_y = 180

-}
module Reanimate.Blender
  ( blender
  , blender'
  ) where

import           Data.Hashable              (Hashable (hash))
import           Data.Text                  (Text)
import qualified Data.Text.IO               as T
import           Graphics.SvgTree           (Tree)
import           Reanimate.Animation        (SVG)
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)

-- | Run a Blender script and embed the resulting image file. The
--   image will be scaled to fit the screen exactly (assuming a default
--   canvas layout). Note that Blender resolution defaults to 1920x1080
--   but can be changed in the script code.
blender :: Text -> SVG
blender :: Text -> SVG
blender Text
script =
  IO SVG -> SVG
forall a. IO a -> a
unsafePerformIO (IO SVG -> SVG) -> IO SVG -> SVG
forall a b. (a -> b) -> a -> b
$ Text -> IO SVG
mkBlenderImage Text
script

-- | Generate Blender image as a separate PNG file. Can be embedded with
--   `mkImage`.
blender' :: Text -> FilePath
blender' :: Text -> FilePath
blender' Text
script =
  IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> IO FilePath
mkBlenderImage' Text
script

mkBlenderImage :: Text -> IO Tree
mkBlenderImage :: Text -> IO SVG
mkBlenderImage Text
script | Bool
pNoExternals = SVG -> IO SVG
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SVG -> IO SVG) -> SVG -> IO SVG
forall a b. (a -> b) -> a -> b
$ Text -> SVG
mkText Text
script
mkBlenderImage Text
script =
  Double -> Double -> FilePath -> SVG
mkImage Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight (FilePath -> SVG) -> IO FilePath -> IO SVG
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO FilePath
mkBlenderImage' Text
script

mkBlenderImage' :: Text -> IO FilePath
mkBlenderImage' :: Text -> IO FilePath
mkBlenderImage' Text
_ | Bool
pNoExternals = FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"/blender/has/been/disabled"
mkBlenderImage' Text
script = FilePath -> (FilePath -> IO ()) -> IO FilePath
cacheFile FilePath
template ((FilePath -> IO ()) -> IO FilePath)
-> (FilePath -> IO ()) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
target -> do
    FilePath
exec <- FilePath -> IO FilePath
requireExecutable FilePath
"blender"
    let py_file :: FilePath
py_file = FilePath -> FilePath -> FilePath
replaceExtension FilePath
target FilePath
"py"
    FilePath -> Text -> IO ()
T.writeFile FilePath
py_file Text
script
    FilePath -> [FilePath] -> IO ()
runCmd FilePath
exec [ FilePath
"--background",FilePath
"--render-format", FilePath
"PNG"
                , FilePath
"--python-exit-code", FilePath
"1"
                , FilePath
"--render-output", FilePath
target, FilePath
"--python", FilePath
py_file]
  where
    template :: FilePath
template = Int -> FilePath
encodeInt (Text -> Int
forall a. Hashable a => a -> Int
hash Text
script) FilePath -> FilePath -> FilePath
<.> FilePath
"png"