module Animate.Frames.Options where
import qualified Data.Map as Map
import System.Environment (getArgs)
import Data.Map (Map)
import Data.List (intercalate)
import Safe (readMay)
getOptions :: IO (Maybe Options)
getOptions = do
args <- getArgs
return $ toOptions args
printUsage :: IO ()
printUsage = do
putStrLn "Usage:"
putStrLn " animate-frames [--animation <key> <frame0.png> <frame1.png> ...] [--image <spritesheet.png>] [--metadata <target.json>] [--fps <int>] [--yaml]"
putStrLn ""
putStrLn "Example:"
putStrLn $ intercalate "\n"
[ "animate-frames \\"
, " --animation Idle idle_0000.png idle_0001.png idle_0002.png \\"
, " --animation Walk walk_0000.png walk_0001.png walk_0002.png \\"
, " --spritesheet sprite.png \\"
, " --metadata sprite.yaml \\"
, " --image \"path/to/sprite.png\" \\"
, " [--fps 60] \\ # default: 24fps"
, " [--yaml] # default is JSON"
]
putStrLn ""
data Options = Options
{ optionsAnimations :: Map String [String]
, optionsSpritesheet :: String
, optionsImage :: String
, optionsMetadata :: String
, optionsFps :: Int
, optionsYaml :: Bool
} deriving (Show, Eq)
startAnimation :: String -> Bool
startAnimation = (==) "--animation"
startSpritesheet :: String -> Bool
startSpritesheet = (==) "--spritesheet"
startMetadata :: String -> Bool
startMetadata = (==) "--metadata"
startFps :: String -> Bool
startFps = (==) "--fps"
startYaml :: String -> Bool
startYaml = (==) "--yaml"
startImage :: String -> Bool
startImage = (==) "--image"
toOptions :: [String] -> Maybe Options
toOptions strArgs = do
args <- toArgs strArgs
let animations = toAnimations args
spritesheet <- toSpritesheet args
metadata <- toMetadata args
image <- toImage args
let fps = toFps args
let yaml = toYaml args
Just Options
{ optionsAnimations = animations
, optionsSpritesheet = spritesheet
, optionsMetadata = metadata
, optionsFps = fps
, optionsYaml = yaml
, optionsImage = image
}
data Arg
= Arg'AnimationStart
| Arg'AnimationName String
| Arg'AnimationFrame String
| Arg'SpritesheetStart
| Arg'Spritesheet String
| Arg'MetadataStart
| Arg'Metadata String
| Arg'FpsStart
| Arg'Fps Int
| Arg'ImageStart
| Arg'Image String
| Arg'Yaml
deriving (Show, Eq)
data AniArg
= AniArg'Name String
| AniArg'Frame String
deriving (Show, Eq)
toAnimations :: [Arg] -> Map String [String]
toAnimations args = go (toAniArgs args) Map.empty
where
go (b@(AniArg'Name _):bs) m = let
(xs,ys) = span isFrame bs
in m `Map.union` (Map.fromList [(toName b, map toName xs)]) `Map.union` go ys m
go _ m = m
isFrame :: AniArg -> Bool
isFrame (AniArg'Frame _) = True
isFrame _ = False
toName :: AniArg -> String
toName (AniArg'Name s) = s
toName (AniArg'Frame s) = s
toSpritesheet :: [Arg] -> Maybe String
toSpritesheet [] = Nothing
toSpritesheet (a:as) = case a of
Arg'Spritesheet name -> Just name
_ -> toSpritesheet as
toMetadata :: [Arg] -> Maybe String
toMetadata [] = Nothing
toMetadata (a:as) = case a of
Arg'Metadata name -> Just name
_ -> toMetadata as
toImage :: [Arg] -> Maybe String
toImage [] = Nothing
toImage (a:as) = case a of
Arg'Image name -> Just name
_ -> toImage as
toAniArgs :: [Arg] -> [AniArg]
toAniArgs [] = []
toAniArgs (a:as) = case a of
Arg'AnimationName s -> AniArg'Name s : toAniArgs as
Arg'AnimationFrame s -> AniArg'Frame s : toAniArgs as
_ -> toAniArgs as
toFps :: [Arg] -> Int
toFps [] = 24
toFps (a:as) = case a of
Arg'Fps x -> x
_ -> toFps as
toYaml :: [Arg] -> Bool
toYaml = any (== Arg'Yaml)
toArgs :: [String] -> Maybe [Arg]
toArgs args = collapseEitherArgTokens (fmap firstPassToken args)
collapseEitherArgTokens :: [Either Arg String] -> Maybe [Arg]
collapseEitherArgTokens [] = Just []
collapseEitherArgTokens (a:as) = do
a' <- case a of
Left arg -> Just arg
Right _ -> Nothing
stepCollapse a' as
stepCollapse :: Arg -> [Either Arg String] -> Maybe [Arg]
stepCollapse _ [] = Just []
stepCollapse prev (a:as) = do
a' <- secondPassToken prev a
as' <- stepCollapse a' as
return $ a' : as'
firstPassToken :: String -> Either Arg String
firstPassToken s
| startAnimation s = Left Arg'AnimationStart
| startSpritesheet s = Left Arg'SpritesheetStart
| startMetadata s = Left Arg'MetadataStart
| startFps s = Left Arg'FpsStart
| startYaml s = Left Arg'Yaml
| startImage s = Left Arg'ImageStart
| otherwise = Right s
secondPassToken :: Arg -> Either Arg String -> Maybe Arg
secondPassToken _ (Left arg) = Just arg
secondPassToken prev (Right arg) = case prev of
Arg'AnimationStart -> Just $ Arg'AnimationName arg
Arg'AnimationName _ -> Just $ Arg'AnimationFrame arg
Arg'AnimationFrame _ -> Just $ Arg'AnimationFrame arg
Arg'SpritesheetStart -> Just $ Arg'Spritesheet arg
Arg'MetadataStart -> Just $ Arg'Metadata arg
Arg'ImageStart -> Just $ Arg'Image arg
Arg'FpsStart -> Arg'Fps <$> readMay arg
_ -> Nothing