module Animate.Option where import Data.Monoid ((<>)) import qualified Options.Applicative as OP import Control.Applicative(pure, liftA2, (<$>), (<*>)) info :: OP.Parser a -> OP.ParserInfo a info p = OP.info (OP.helper <*> p) (OP.fullDesc <> OP.progDesc "Generate animation of playing MED/OctaMED song.") parser :: OP.Parser (Option, [FilePath]) parser = liftA2 (,) oparser (OP.many $ OP.strArgument $ OP.metavar "FILE" <> OP.help "Input MED module") oparser :: OP.Parser Option oparser = pure Option <*> (OP.strOption $ OP.long "frame-pattern" <> OP.metavar "PATHFMT" <> OP.value "" <> OP.help "Format string for frame paths") <*> (OP.option (Just <$> readNonNeg) $ OP.long "repeat-until" <> OP.metavar "SECONDS" <> OP.value Nothing <> OP.help "Loop song for a certain maximum time") <*> (OP.option readNonNeg $ OP.long "fade-out" <> OP.metavar "SECONDS" <> OP.value 0 <> OP.help "Reduce brightness for a certain duration at the end") <*> (OP.option OP.auto $ OP.long "context-size" <> OP.metavar "NATURAL" <> OP.value 16 <> OP.help "Number of lines before and after current one") <*> (OP.option OP.auto $ OP.long "height" <> OP.metavar "POINTS" <> OP.value 720 <> OP.help "Height of the paper in typographical points") <*> (OP.switch $ OP.long "strip-zero-commands" <> OP.help "Strip trailing command columns consisting entirely of 0000") <*> (OP.switch $ OP.long "strip-noteless-tracks" <> OP.help "Strip tracks without notes") <*> fontParser {- | Also allow numbers like @.123@ instead of @0.123@. -} readNonNeg :: OP.ReadM Double readNonNeg = OP.eitherReader $ \arg -> case reads ('0':arg) of [(r, "")] -> if r<0 then Left $ "negative number `" ++ arg ++ "'" else return r _ -> Left $ "not a number `" ++ arg ++ "'" data Option = Option { framePattern :: FilePath, repeatUntil :: Maybe Double, fadeOut :: Double, contextSize :: Int, height :: Int, stripZeroCommands, stripNotelessTracks :: Bool, font :: Font } fontParser :: OP.Parser Font fontParser = pure Font <*> (OP.strOption $ OP.long "font" <> OP.metavar "NAME" <> OP.value "Courier" <> OP.help "PostScript Font name") <*> (OP.option readNonNeg $ OP.long "font-height" <> OP.metavar "POINTS" <> OP.value 17 <> OP.help "Font height") <*> (OP.option readNonNeg $ OP.long "font-relative-width" <> OP.metavar "RATIO" <> OP.value (3/5) <> OP.help "Font width relative to font height") data Font = Font { fontName :: String, fontHeight :: Double, fontRelativeWidth :: Double }