content: #!/usr/bin/env stack
  -- stack runghc --package reanimate
  {-# LANGUAGE ApplicativeDo     #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes       #-}
  {-# LANGUAGE PackageImports    #-}
  module Main (main) where
  
  import           Reanimate
  import           Reanimate.Builtin.Documentation
  
  import           Codec.Picture.Types
  import           Control.Lens                    ((&), (^.))
  import           Control.Monad
  import qualified Data.Text                       as T
  import           Graphics.SvgTree
  import           NeatInterpolation
  import           System.Random
  import "random-shuffle" System.Random.Shuffle
  
  -- spritePercent = (/) <$> spriteT <*> spriteDur
  
  main :: IO ()
  main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic bg $ scene $ do
      bend <- newVar 0
      trans <- newVar 0
      rotX <- newVar 0
      rotY <- newVar 0
      newSprite_ $ do
        getBend <- unVar bend
        getTrans <- unVar trans
        getRotX <- unVar rotX
        getRotY <- unVar rotY
        t <- spriteT
        dur <- spriteDuration
        return $ seq (texture (t/dur)) $
          blender (script (texture (t/dur)) getBend getTrans getRotX getRotY)
      wait 2
      fork $ tweenVar trans 5 $ \v -> fromToS v (-2) .  curveS 2
      fork $ tweenVar bend 5 $ \v -> fromToS v 1 . curveS 2
      fork $ tweenVar rotY 15 $ \v -> fromToS v (pi*2*2) . curveS 2
      fork $ do
        tweenVar rotX 5 $ \v -> fromToS v (-pi/5) . curveS 2
        tweenVar rotX 5 $ \v -> fromToS v (pi/5) . curveS 2
      wait (15-5)
      fork $ tweenVar bend 5 $ \v -> fromToS v 0 . curveS 2
      fork $ tweenVar rotX 5 $ \v -> fromToS v 0 . curveS 2
      fork $ tweenVar trans 5 $ \v -> fromToS v 0 . curveS 2
      wait 4
      -- tweenVar trans 1 (\t v -> fromToS v 0 $ curveS 2 t)
      wait 1
      wait 2
    where
      bg = mkBackgroundPixel rtfdBackgroundColor
  
  texture :: Double -> FilePath
  texture t = svgAsPngFile $ mkGroup
    [ checker 20 20
    , frameAt (t*duration latexExample) latexExample
    ]
  
  script :: FilePath -> Double -> Double -> Double -> Double -> T.Text
  script img bend transZ rotX rotY =
    let img_ = T.pack img
        bend_ = T.pack $ show bend
        transZ_ = T.pack $ show transZ
        rotX_ = T.pack $ show rotX
        rotY_ = T.pack $ show rotY
        yScale_ = T.pack $ show (fromToS (9/2) 4 bend)
        pWidthT = T.pack $ show (max 800 pWidth)
        pHeightT = T.pack $ show (max 450 pHeight)
    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.25 + ${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
  image_node = mat.node_tree.nodes.new('ShaderNodeTexImage')
  output = mat.node_tree.nodes['Material Output']
  #texture = mat.node_tree.nodes['Principled BSDF']
  #texture.inputs['Roughness'].default_value = 1
  #mat.node_tree.links.new(image_node.outputs['Color'], texture.inputs['Base Color'])
  mat.node_tree.links.new(image_node.outputs['Color'], output.inputs['Surface'])
  
  
  image_node.image = bpy.data.images.load('${img_}')
  
  
  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_set(type='ORIGIN_GEOMETRY')
  bpy.ops.object.origin_clear()
  bpy.ops.object.origin_set(type='GEOMETRY_ORIGIN')
  
  plane.rotation_euler = (0, ${rotY_}, 0)
  
  scn = bpy.context.scene
  
  scn.view_settings.view_transform = 'Standard'
  
  #scn.render.engine = 'CYCLES'
  #scn.render.resolution_percentage = 10
  
  scn.render.resolution_x = ${pWidthT} #3200
  scn.render.resolution_y = ${pHeightT} #1800
  
  scn.render.film_transparent = True
  
  bpy.ops.render.render( write_still=True )
  |]
  
  checker :: Int -> Int -> SVG
  checker w h =
    withStrokeColor "lightgrey" $
    withStrokeWidth (defaultStrokeWidth/2) $
    mkGroup
    [ mkBackground "darkgrey"
    , mkGroup
      [ translate (stepX*x-offsetX + stepX/2) 0 $
        mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
      | x <- map fromIntegral [0..w-1]
      ]
    ,
      mkGroup
      [ translate 0 (stepY*y-offsetY) $
        mkLine (-screenWidth/2, 0) (screenWidth/2, 0)
      | y <- map fromIntegral [0..h]
      ]
    ]
    where
      stepX = screenWidth/fromIntegral w
      stepY = screenHeight/fromIntegral h
      offsetX = screenWidth/2
      offsetY = screenHeight/2
  
  
  
  
  -----------------------------------
  -- COPIED FROM tut_glue_latex.hs --
  
  
  latexExample :: Animation
  latexExample = scene $ do
      -- Draw equation
      play $ drawAnimation strokedSvg
      sprites <- forM glyphs $ \(fn, _, elt) ->
        newSpriteSVG $ fn elt
      -- Yoink each glyph
      forM_ (reverse sprites) $ \sprite -> do
        spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)
        wait 0.5
      -- Flash glyphs randomly with color
      forM_ (shuffleList (sprites++sprites)) $ \sprite -> do
        spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)
        wait 0.1
      wait 0.5
      mapM_ destroySprite sprites
      -- Undraw equations
      play $ drawAnimation' (Just 0xdeadbeef) 1 0.1 strokedSvg
        & reverseA
    where
      glyphs = svgGlyphs svg
      strokedSvg =
        withStrokeWidth (defaultStrokeWidth*0.5) $
        withStrokeColor "black" svg
      svg = lowerTransformations $ simplify $ scale 2 $ center $
        latexAlign "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
      shuffleList lst = shuffle' lst (length lst) (mkStdGen 0xdeadbeef)
  
  highlightE :: Effect
  highlightE d t =
    scale (1 + bellS 2 (t/d)*0.5) . rotate (wiggleS (t/d) * 20)
  
  flashE :: Effect
  flashE d t =
    withStrokeColor "black" .
    withStrokeWidth (defaultStrokeWidth*0.5*bellS 2 (t/d)) .
    withFillColorPixel (promotePixel $ turbo (t/d))
  
  -- s-curve, sin, s-curve
  wiggleS :: Signal
  wiggleS t
    | t < 0.25  = curveS 2 (t*4)
    | t < 0.75  = sin ((t-0.25)*2*pi+pi/2)
    | otherwise = curveS 2 ((t-0.75)*4)-1
  
  --
  
  drawAnimation :: SVG -> Animation
  drawAnimation = drawAnimation' Nothing 0.5 0.3
  
  drawAnimation' :: Maybe Int -> Double -> Double -> SVG -> Animation
  drawAnimation' mbSeed fillDur step svg = scene $ do
    forM_ (zip [0..] $ shuf $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do
      let sWidth =
            case toUserUnit defaultDPI <$> (attr ^. strokeWidth) of
              Just (Num d) -> d
              _            -> defaultStrokeWidth
      fork $ do
        wait (n*step)
        play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
          & applyE (overEnding fillDur $ fadeLineOutE sWidth))
      fork $ do
        wait (n*step+(1-fillDur))
        newSprite $ do
          t <- spriteT
          pure $
            withStrokeWidth 0 $ fn $ withFillOpacity (min 1 $ t/fillDur) tree
    where
      shuf lst =
        case mbSeed of
          Nothing   -> lst
          Just seed -> shuffle' lst (length lst) (mkStdGen seed)
  