{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE RecordWildCards   #-}
{- HLINT ignore -}
{-|
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX
-}
module Reanimate.Builtin.Flip
  ( FlipSprite(..)
  , flipSprite
  , flipTransition
  ) where

import           Reanimate.Animation        (Animation, duration, frameAt, setDuration)
import           Reanimate.Blender          (blender)
import           Reanimate.Ease             (fromToS, oscillateS)
import           Reanimate.Raster           (svgAsPngFile)
import           Reanimate.Scene            (Scene, Sprite, Var, fork, newSprite, newVar, scene,
                                             spriteDuration, spriteT, tweenVar, unVar)
import           Reanimate.Svg.Constructors (flipXAxis)
import           Reanimate.Transition       (Transition)

import qualified Data.Text                  as T
import           NeatInterpolation          (text)

-- | Control structure with parameters for the blender script.
data FlipSprite s = FlipSprite
  { FlipSprite s -> Sprite s
fsSprite :: Sprite s
  , FlipSprite s -> Var s Double
fsBend   :: Var s Double
  , FlipSprite s -> Var s Double
fsZoom   :: Var s Double
  , FlipSprite s -> Var s Double
fsWobble :: Var s Double
  }

-- | Project two animations on each side of a plane and flip the plane
--   upside down.
flipSprite :: Animation -> Animation -> Scene s (FlipSprite s)
flipSprite :: Animation -> Animation -> Scene s (FlipSprite s)
flipSprite Animation
front Animation
back = do
    Var s Double
bend <- Double -> Scene s (Var s Double)
forall a s. a -> Scene s (Var s a)
newVar Double
0
    Var s Double
trans <- Double -> Scene s (Var s Double)
forall a s. a -> Scene s (Var s a)
newVar Double
0
    Var s Double
rotX <- Double -> Scene s (Var s Double)
forall a s. a -> Scene s (Var s a)
newVar Double
0
    Sprite s
sprite <- Frame s SVG -> Scene s (Sprite s)
forall s. Frame s SVG -> Scene s (Sprite s)
newSprite (Frame s SVG -> Scene s (Sprite s))
-> Frame s SVG -> Scene s (Sprite s)
forall a b. (a -> b) -> a -> b
$ do
      Double
getBend <- Var s Double -> Frame s Double
forall s a. Var s a -> Frame s a
unVar Var s Double
bend
      Double
getTrans <- Var s Double -> Frame s Double
forall s a. Var s a -> Frame s a
unVar Var s Double
trans
      Double
getRotX <- Var s Double -> Frame s Double
forall s a. Var s a -> Frame s a
unVar Var s Double
rotX
      Double
time <- Frame s Double
forall s. Frame s Double
spriteT
      Double
dur <- Frame s Double
forall s. Frame s Double
spriteDuration
      return $
        let rotY :: Double
rotY = Double -> Double -> Signal
fromToS Double
0 Double
forall a. Floating a => a
pi (Double
timeDouble -> Signal
forall a. Fractional a => a -> a -> a
/Double
dur)
            frontTexture :: FilePath
frontTexture = SVG -> FilePath
svgAsPngFile (Double -> Animation -> SVG
frameAt Double
time (Animation -> SVG) -> Animation -> SVG
forall a b. (a -> b) -> a -> b
$ Double -> Animation -> Animation
setDuration Double
dur Animation
front)
            backTexture :: FilePath
backTexture = SVG -> FilePath
svgAsPngFile (SVG -> SVG
flipXAxis (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ Double -> Animation -> SVG
frameAt Double
time (Animation -> SVG) -> Animation -> SVG
forall a b. (a -> b) -> a -> b
$ Double -> Animation -> Animation
setDuration Double
dur Animation
back)
           -- seq'ing frontTexture and backTexture is required to avoid segfaults. :(
        in FilePath
frontTexture FilePath -> SVG -> SVG
`seq` FilePath
backTexture FilePath -> SVG -> SVG
`seq`
           Text -> SVG
blender (FilePath
-> FilePath -> Double -> Double -> Double -> Double -> Text
script FilePath
frontTexture FilePath
backTexture Double
getBend Double
getTrans Double
getRotX Double
rotY)
    return FlipSprite :: forall s.
Sprite s
-> Var s Double -> Var s Double -> Var s Double -> FlipSprite s
FlipSprite
      { fsSprite :: Sprite s
fsSprite = Sprite s
sprite
      , fsBend :: Var s Double
fsBend = Var s Double
bend
      , fsZoom :: Var s Double
fsZoom = Var s Double
trans
      , fsWobble :: Var s Double
fsWobble = Var s Double
rotX }

flipTransitionOpts :: Double -> Double -> Double -> Transition
flipTransitionOpts :: Double -> Double -> Double -> Transition
flipTransitionOpts Double
bend Double
zoom Double
wobble Animation
a Animation
b = (forall s. Scene s ()) -> Animation
forall a. (forall s. Scene s a) -> Animation
scene ((forall s. Scene s ()) -> Animation)
-> (forall s. Scene s ()) -> Animation
forall a b. (a -> b) -> a -> b
$ do
    FlipSprite{Var s Double
Sprite s
fsWobble :: Var s Double
fsZoom :: Var s Double
fsBend :: Var s Double
fsSprite :: Sprite s
fsWobble :: forall s. FlipSprite s -> Var s Double
fsZoom :: forall s. FlipSprite s -> Var s Double
fsBend :: forall s. FlipSprite s -> Var s Double
fsSprite :: forall s. FlipSprite s -> Sprite s
..} <- Animation -> Animation -> Scene s (FlipSprite s)
forall s. Animation -> Animation -> Scene s (FlipSprite s)
flipSprite Animation
a Animation
b
    Scene s () -> Scene s ()
forall s a. Scene s a -> Scene s a
fork (Scene s () -> Scene s ()) -> Scene s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$ Var s Double -> Double -> (Double -> Signal) -> Scene s ()
forall s a. Var s a -> Double -> (a -> Double -> a) -> Scene s ()
tweenVar Var s Double
fsZoom Double
dur   ((Double -> Signal) -> Scene s ())
-> (Double -> Signal) -> Scene s ()
forall a b. (a -> b) -> a -> b
$ \Double
v -> Double -> Double -> Signal
fromToS Double
v Double
zoom Signal -> Signal -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal
oscillateS
    Scene s () -> Scene s ()
forall s a. Scene s a -> Scene s a
fork (Scene s () -> Scene s ()) -> Scene s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$ Var s Double -> Double -> (Double -> Signal) -> Scene s ()
forall s a. Var s a -> Double -> (a -> Double -> a) -> Scene s ()
tweenVar Var s Double
fsBend Double
dur   ((Double -> Signal) -> Scene s ())
-> (Double -> Signal) -> Scene s ()
forall a b. (a -> b) -> a -> b
$ \Double
v -> Double -> Double -> Signal
fromToS Double
v Double
bend Signal -> Signal -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal
oscillateS
    Scene s () -> Scene s ()
forall s a. Scene s a -> Scene s a
fork (Scene s () -> Scene s ()) -> Scene s () -> Scene s ()
forall a b. (a -> b) -> a -> b
$ Var s Double -> Double -> (Double -> Signal) -> Scene s ()
forall s a. Var s a -> Double -> (a -> Double -> a) -> Scene s ()
tweenVar Var s Double
fsWobble Double
dur ((Double -> Signal) -> Scene s ())
-> (Double -> Signal) -> Scene s ()
forall a b. (a -> b) -> a -> b
$ \Double
v -> Double -> Double -> Signal
fromToS Double
v Double
wobble Signal -> Signal -> Signal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal
oscillateS
  where
    dur :: Double
dur = Double -> Signal
forall a. Ord a => a -> a -> a
max (Animation -> Double
duration Animation
a) (Animation -> Double
duration Animation
b)

-- | 3D flip transition.
flipTransition :: Transition
flipTransition :: Transition
flipTransition = Double -> Double -> Double -> Transition
flipTransitionOpts Double
bend Double
zoom Double
wobble
  where
    bend :: Double
bend = Double
1Double -> Signal
forall a. Fractional a => a -> a -> a
/Double
3
    zoom :: Double
zoom = Double
3
    wobble :: Double
wobble = -Double
forall a. Floating a => a
piDouble -> Signal
forall a. Num a => a -> a -> a
*Double
0.10

script :: FilePath -> FilePath -> Double -> Double -> Double -> Double -> T.Text
script :: FilePath
-> FilePath -> Double -> Double -> Double -> Double -> Text
script FilePath
frontImage FilePath
backImage Double
bend Double
transZ Double
rotX Double
rotY =
  let transZ_ :: Text
transZ_ = FilePath -> Text
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
transZ)
      rotX_ :: Text
rotX_ = FilePath -> Text
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
rotX)
      bend_ :: Text
bend_ = FilePath -> Text
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
bend)
      yScale_ :: Text
yScale_ = FilePath -> Text
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show (Double -> FilePath) -> Double -> FilePath
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Signal
fromToS (Double
9Double -> Signal
forall a. Fractional a => a -> a -> a
/Double
2) Double
4 Double
bend)
      frontImage_ :: Text
frontImage_ = FilePath -> Text
T.pack FilePath
frontImage
      backImage_ :: Text
backImage_ = FilePath -> Text
T.pack FilePath
backImage
      rotY_ :: Text
rotY_ = FilePath -> Text
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
rotY)
  in [text|
import os
import math

import bpy

light = bpy.data.objects['Light']
bpy.ops.object.select_all(action='DESELECT')
light.select_set(True)
bpy.ops.object.delete()


cam = bpy.data.objects['Camera']
cam.location = (0,0,22.22 + $transZ_)
cam.rotation_euler = (0, 0, 0)
bpy.ops.object.empty_add(location=(0.0, 0, 0))
focus_target = bpy.context.object
bpy.ops.object.select_all(action='DESELECT')
cam.select_set(True)
focus_target.select_set(True)
bpy.ops.object.parent_set()

focus_target.rotation_euler = ($rotX_, 0, 0)


origin = bpy.data.objects['Cube']
bpy.ops.object.select_all(action='DESELECT')
origin.select_set(True)
bpy.ops.object.delete()

x = $bend_
bpy.ops.mesh.primitive_plane_add()
plane = bpy.context.object
plane.scale = (16/2,$yScale_,1)
bpy.ops.object.shade_smooth()

bpy.context.object.active_material = bpy.data.materials['Material']
mat = bpy.context.object.active_material
mix = mat.node_tree.nodes.new('ShaderNodeMixShader')
geo = mat.node_tree.nodes.new('ShaderNodeNewGeometry')

mat.blend_method = 'HASHED'

image_node = mat.node_tree.nodes.new('ShaderNodeTexImage')
gh_node = mat.node_tree.nodes.new('ShaderNodeTexImage')
output = mat.node_tree.nodes['Material Output']

gh_mix = mat.node_tree.nodes.new('ShaderNodeMixShader')
transparent = mat.node_tree.nodes.new('ShaderNodeBsdfTransparent')

mat.node_tree.links.new(geo.outputs['Backfacing'], mix.inputs['Fac'])
mat.node_tree.links.new(mix.outputs['Shader'], output.inputs['Surface'])
mat.node_tree.links.new(image_node.outputs['Color'], mix.inputs[1])

#mat.node_tree.links.new(gh_node.outputs['Color'], mix.inputs[2])
mat.node_tree.links.new(gh_node.outputs['Color'], gh_mix.inputs[2])
mat.node_tree.links.new(gh_node.outputs['Alpha'], gh_mix.inputs['Fac'])
mat.node_tree.links.new(transparent.outputs['BSDF'], gh_mix.inputs[1])
mat.node_tree.links.new(gh_mix.outputs['Shader'], mix.inputs[2])

image_node.image = bpy.data.images.load('${frontImage_}')
image_node.interpolation = 'Closest'

gh_node.image = bpy.data.images.load('${backImage_}')
gh_node.interpolation = 'Closest'


modifier = plane.modifiers.new(name='Subsurf', type='SUBSURF')
modifier.levels = 7
modifier.render_levels = 7
modifier.subdivision_type = 'SIMPLE'

bpy.ops.object.empty_add(type='ARROWS',rotation=(math.pi/2,0,0))
empty = bpy.context.object

bendUp = plane.modifiers.new(name='Bend up', type='SIMPLE_DEFORM')
bendUp.deform_method = 'BEND'
bendUp.origin = empty
bendUp.deform_axis = 'X'
bendUp.factor = -math.pi*x

bendAround = plane.modifiers.new(name='Bend around', type='SIMPLE_DEFORM')
bendAround.deform_method = 'BEND'
bendAround.origin = empty
bendAround.deform_axis = 'Z'
bendAround.factor = -math.pi*2*x

bpy.context.view_layer.objects.active = plane
bpy.ops.object.modifier_apply(modifier='Subsurf')
bpy.ops.object.modifier_apply(modifier='Bend up')
bpy.ops.object.modifier_apply(modifier='Bend around')

bpy.ops.object.select_all(action='DESELECT')
plane.select_set(True);
bpy.ops.object.origin_clear()
bpy.ops.object.origin_set(type='GEOMETRY_ORIGIN')

plane.rotation_euler = (0, $rotY_, 0)

scn = bpy.context.scene

#scn.render.engine = 'CYCLES'
#scn.render.resolution_percentage = 10

scn.view_settings.view_transform = 'Standard'


scn.render.resolution_x = 2560
scn.render.resolution_y = 1440

scn.render.film_transparent = True

bpy.ops.render.render( write_still=True )
|]