Animation.hs

module Animation where

import Brick (Widget)
import qualified Brick.Animation as A
import Brick.BChan (writeBChan)
import Brick.Types (EventM)
import Brick.Widgets.Core (fill, hBox, txt, vBox)
import Control.Exception (IOException, try)
import Control.Monad (forM)
import Control.Monad.RWS
import Data.List (sort)
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Editor.Core (OutputType (..))
import Graphics.UI.TinyFileDialogs (inputBox, selectFolderDialog)
import Lens.Micro (Lens', lens, (&), (.~), (^.))
import System.Directory (listDirectory)
import System.FilePath ((</>))
import qualified Text.Read as T
import UI.Core (AnimationConfig (..), AppEvent (..), AppState (..), Content (..), Name (..), Window (Window))

drawAnimationWindow :: AppState -> (Int, Int) -> Maybe (A.Animation AppState Name) -> Widget Name
drawAnimationWindow as (_, sy) = A.renderAnimation (const $ vBox $ replicate sy (fill ' ')) as

loadClipFromDirectory :: FilePath -> EventM Name AppState (Maybe (A.Clip AppState Name))
loadClipFromDirectory dir = do
  mfiles <- liftIO (try (listDirectory dir) :: IO (Either IOException [FilePath]))
  case mfiles of
    Left _ -> return Nothing
    Right unfiles -> do
      let files = sort unfiles
      frames <- fmap concat $ forM files $ \f -> liftIO $ do
        result <- try (TIO.readFile (dir </> f)) :: IO (Either IOException T.Text)
        case result of
          Left _ -> return []
          Right content -> return [content]
      let toClip c st = case Map.lookup Animator (asWindows st) of
            Just (Window _ (_, sy) _ _ _) -> vBox $ map (\l -> hBox [txt l, fill ' ']) ls ++ rest
              where
                ls = T.lines c
                rest = replicate (max 0 (sy - length ls)) $ fill ' '
            Nothing -> vBox $ map txt $ T.lines c
      case frames of
        [] -> do
          chan <- gets asChan
          liftIO $ writeBChan chan (UpdateOutput (OutputError, "Failed to load animation."))
          return Nothing
        _ -> return $ Just $ A.newClip (map toClip frames)

toggleAnimation :: EventM Name AppState ()
toggleAnimation = do
  mgr <- gets asAnimationManager
  wm <- gets asWindows
  case Map.lookup Animator wm of
    Just (Window _ _ (AnimationContent Nothing (AnimationConfig i p)) _ _) -> do
      mc <- loadClipFromDirectory p
      case mc of
        Just c -> A.startAnimation mgr c (fromIntegral i) A.Loop animatorWindowL
        Nothing -> return ()
    Just (Window _ _ (AnimationContent (Just a) _) _ _) -> A.stopAnimation mgr a
    _ -> return ()

startAnimation :: EventM Name AppState ()
startAnimation = do
  mgr <- gets asAnimationManager
  wm <- gets asWindows
  case Map.lookup Animator wm of
    Just (Window _ _ (AnimationContent _ (AnimationConfig i p)) _ _) -> do
      mc <- loadClipFromDirectory p
      case mc of
        Just c -> A.startAnimation mgr c (fromIntegral i) A.Loop animatorWindowL
        Nothing -> return ()
    _ -> return ()

stopAnimation :: EventM Name AppState ()
stopAnimation = do
  mgr <- gets asAnimationManager
  wm <- gets asWindows
  case Map.lookup Animator wm of
    Just (Window _ _ (AnimationContent (Just a) _) _ _) -> A.stopAnimation mgr a
    _ -> return ()

asWindowsL :: Lens' AppState (Map.Map Name Window)
asWindowsL = lens asWindows (\st newMap -> st {asWindows = newMap})

animatorWindowL :: Lens' AppState (Maybe (A.Animation AppState Name))
animatorWindowL = lens getter setter
  where
    getter st = case Map.lookup Animator (st ^. asWindowsL) of
      Just (Window _ _ (AnimationContent a _) _ _) -> a
      _ -> Nothing

    setter st newAnim =
      let alt (Just (Window x y (AnimationContent _ conf) z l)) = Just $ Window x y (AnimationContent newAnim conf) z l
          alt x = x
       in st & asWindowsL .~ Map.alter alt Animator (st ^. asWindowsL)

changeAnimation :: EventM Name AppState ()
changeAnimation = do
  mPath <- liftIO $ selectFolderDialog "Choose a folder containing animation frames" ""
  case mPath of
    Just path -> do
      let alt (Just (Window x y (AnimationContent a (AnimationConfig i _)) z l)) = Just $ Window x y (AnimationContent a (AnimationConfig i (T.unpack path))) z l
          alt _ = Nothing
      stopAnimation
      modify $ \as -> as {asWindows = Map.alter alt Animator $ asWindows as}
      startAnimation
    Nothing -> return ()

changeFramerate :: EventM Name AppState ()
changeFramerate = do
  mframe <- ((T.readMaybe . T.unpack) =<<) <$> liftIO (inputBox "" "Choose a framerate in milliseconds" (Just "150"))
  case mframe of
    Just frame -> do
      let alt (Just (Window x y (AnimationContent a (AnimationConfig _ p)) z l)) = Just $ Window x y (AnimationContent a (AnimationConfig frame p)) z l
          alt _ = Nothing
      stopAnimation
      modify $ \as -> as {asWindows = Map.alter alt Animator $ asWindows as}
      startAnimation
    Nothing -> return ()