diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +# Change log + +animate-frames uses [Semantic Versioning][]. +The change log is available through the [releases on GitHub][]. + +[Semantic Versioning]: http://semver.org/spec/v2.0.0.html +[releases on GitHub]: https://github.com/githubuser/animate-frames/releases diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,23 @@ +[The MIT License (MIT)][] + +Copyright (c) 2018 Author name here + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + +[The MIT License (MIT)]: https://opensource.org/licenses/MIT diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,156 @@ +# animate-frames + +`animate-frames` is a workflow tool for converting sprite frames into a spritesheet and [`animate`](https://github.com/jxv/animate) compatible metadata files. + +``` +Usage: + animate-frames [--animation ...] [--image ] [--metadata ] [--fps ] [--yaml] + +Example: +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 +``` + +## Workflow + +This is an example workflow using Krita and animate to create sprites iteratively. + +### Krita + +[Krita](https://krita.org/en/) is a profesional level drawing and digital painting program. +It's also open source and works wonderfully with a drawing tablet. +Most importantly, it allows for drawing animation with onion skinning. + +Here are the example stick figure animations -- walk and dance. + +[`walk.kra`](propaganda/walk.kra) + +![walk krita](propaganda/walk_krita.png) + +[`dance.kra`](propaganda/dance.kra) + +![dance krita](propaganda/dance_krita.png) + +### Generate individual animation frames + +In order to represent the animation, each project file will renderer as frames with a postfix'ed number. + +Don't forget to change the `basename`. + +![walk render](propaganda/walk_render.png) + +![dance render](propaganda/dance_render.png) + +Now, there's a folder with all the frames. + +![frames](propaganda/frames.png) + +Notice that there are duplicates of frames. +This is because ech frame implictly attaches a unit of time. +In this case, each frame lasts for 1/24th second. + +### Use `animate-frames` for spritesheet and metadata file + +Removing frame duplication, composing a spritesheet, and inferring metadata is the core of what `animate-frames` does. +What cannot be inferred are required as arguments. + +Here's the script the find frames then generate the spritesheet and metadata files. + +[`compile-frames.sh`](propaganda/compile-frames.sh) + +```shell +#! /bin/sh + +match() { + echo `find ./ -name "$1" -print0 | xargs -0 ls` +} + +walk=$(match "walk_*.png") +dance=$(match "dance_*.png") + +animate-frames \ + --spritesheet figure.png \ + --image "data/figure.png" \ + --metadata figure.yaml \ + --animation Walk $walk \ + --animation Dance $dance \ + --yaml \ # JSON is default + --fps 24 + +``` + +__Generated files__ + +A clip describes area of each frame on the spritesheet. +An animation is defined by a list of the clip indices and delays (in seconds). + +[`figure.yaml`](propaganda/figure.yaml) + +```yaml +image: "data/figure.png" +alpha: null +clips: +- [0, 0, 91, 135, 58, 80] # 0 +- [91, 0, 87, 135, 52, 78] # 1 +- [178, 0, 86, 134, 53, 76] # 2 +- [264, 0, 96, 131, 69, 75] # 3 +- [0, 135, 77, 135, 60, 78] # 4 +- [77, 135, 79, 131, 66, 74] # 5 +- [156, 135, 79, 130, 67, 74] # 6 +- [235, 135, 86, 132, 60, 75] # 7 +- [0, 270, 44, 143, 26, 86] # 8 +- [44, 270, 40, 139, 19, 81] # 9 +- [84, 270, 61, 141, 38, 83] # 10 +- [145, 270, 71, 137, 41, 81] # 11 +- [216, 270, 53, 139, 29, 84] # 12 +- [269, 270, 44, 137, 27, 83] # 13 +- [0, 413, 61, 139, 37, 83] # 14 +- [61, 413, 63, 141, 35, 84] # 15 +animations: + "Dance": + - [0, 0.2083] + - [1, 0.2083] + - [2, 0.2083] + - [3, 0.2083] + - [4, 0.2083] + - [5, 0.2083] + - [6, 0.2083] + - [7, 0.2083] + "Walk": + - [8, 0.2083] + - [9, 0.2083] + - [10, 0.2083] + - [11, 0.2083] + - [12, 0.2083] + - [13, 0.2083] + - [14, 0.2083] + - [15, 0.2083] +``` + +All the frames are collapsed into one spritesheet. + +[`figure.png`](propaganda/figure.png) + +![figure.png](propaganda/figure.png) + +### Preview animation + +Use [animate-preview](https://github.com/jxv/animate-preview) to preview the generated spritesheet and metadata files. + + +```shell +animate-preview --target figure.yaml --image figure.png --high-dpi --watch +``` + +![animate preview](propaganda/animate-preview.png) + +### Build into game + +When building a game, you'll want to use the [`animate`](https://github.com/jxv/animate) and [`animate-sdl2`](https://github.com/jxv/animate-sdl2) libraries to load and draw the sprites. The [`animate`](https://github.com/jxv/animate) has functions to load the generated files. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +-- This script is used to build and install your package. Typically you don't +-- need to change it. The Cabal documentation has more information about this +-- file: . +import qualified Distribution.Simple + +main :: IO () +main = Distribution.Simple.defaultMain diff --git a/animate-frames.cabal b/animate-frames.cabal new file mode 100644 --- /dev/null +++ b/animate-frames.cabal @@ -0,0 +1,81 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: a09c8bc7968f2e2ea591a6438991e4a05af4d4abd16c5c107419bb1dc368e100 + +name: animate-frames +version: 0.0.0 +description: Convert sprite frames to animate files +homepage: https://github.com/jxv/animate-frames#readme +bug-reports: https://github.com/jxv/animate-frames/issues +author: Joe Vargas +maintainer: Joe Vargas +license: MIT +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + CHANGELOG.md + LICENSE.md + package.yaml + README.md + +source-repository head + type: git + location: https://github.com/jxv/animate-frames + +library + hs-source-dirs: + library + default-extensions: NamedFieldPuns OverloadedStrings FlexibleContexts + ghc-options: -Wall + build-depends: + JuicyPixels + , aeson + , animate + , async + , base >=4.5 && <5 + , bytestring + , containers + , pureMD5 + , safe + , stm + , text + , vector + , yaml + exposed-modules: + Animate.Frames + Animate.Frames.Options + other-modules: + Paths_animate_frames + default-language: Haskell2010 + +executable animate-frames + main-is: Main.hs + hs-source-dirs: + executable + default-extensions: NamedFieldPuns OverloadedStrings FlexibleContexts + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + build-depends: + animate-frames + , base + other-modules: + Paths_animate_frames + default-language: Haskell2010 + +test-suite animate-frames-test-suite + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + test-suite + default-extensions: NamedFieldPuns OverloadedStrings FlexibleContexts + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + build-depends: + animate-frames + , base + , tasty + , tasty-hspec + other-modules: + Paths_animate_frames + default-language: Haskell2010 diff --git a/executable/Main.hs b/executable/Main.hs new file mode 100644 --- /dev/null +++ b/executable/Main.hs @@ -0,0 +1,7 @@ +-- It is generally a good idea to keep all your business logic in your library +-- and only use it in the executable. Doing so allows others to use what you +-- wrote in their libraries. +import qualified Animate.Frames + +main :: IO () +main = Animate.Frames.main diff --git a/library/Animate/Frames.hs b/library/Animate/Frames.hs new file mode 100644 --- /dev/null +++ b/library/Animate/Frames.hs @@ -0,0 +1,472 @@ +module Animate.Frames where + +import qualified Data.Map as Map +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.IO as T +import qualified Data.Text as T +import qualified Data.Aeson as A +import Control.Monad (forM) +import Control.Concurrent.Async +import Control.Concurrent.STM +import Data.Digest.Pure.MD5 +import Text.Printf (printf) +import Data.Map (Map) +import Data.Monoid ((<>)) +import Data.Text (pack, Text) +import Codec.Picture +import Codec.Picture.Png (encodePng) +import Safe (headMay) +import Data.Maybe (fromMaybe) +import Data.List (find, sortBy, foldl') +import GHC.Float (sqrtFloat) +import Animate (FrameIndex, SpriteSheetInfo(..), SpriteClip(..)) + +import Animate.Frames.Options (getOptions, printUsage, Options(..)) + +type Seconds = Float + +data Layout = Layout + { layoutSize :: (Int, Int) + , layoutRows :: [Row] + , layoutAnimations :: Map String [(FrameIndex, Seconds)] + } + +data CropInfo = CropInfo + { cInfoAnimations :: Map String [CropFrame] + , cInfoImages :: Map CropId CropImage + } + +data Row = Row + { rowCropImages :: [CropImage] + , rowTop :: Int + , rowHeight :: Int + , rowWidth :: Int + } + +data RowStep = RowStep + { rsCurrent :: Row + , rsFinished :: [Row] + } + +data CropImage = CropImage + { ciImage :: ImageId + , ciCoords :: ((Int, Int), (Int, Int)) + , ciOrigin :: (Int, Int) + , ciDim :: (Int, Int) + } + +instance Eq CropImage where + a == b = and + [ ciImage a == ciImage b + , ciCoords a == ciCoords b + , ciOrigin a == ciOrigin b + , ciDim a == ciDim b + ] + +type CropId = Int + +newtype ImageId = ImageId MD5Digest + deriving (Show, Eq, Ord) + +data CropFrame = CropFrame + { cfCropId :: CropId + , cfCount :: Int -- Number of sequental and equvialent frames compressed as one + } deriving (Show, Eq) + +data Tree a = Node a (Maybe (Tree a)) (Maybe (Tree a)) + deriving (Show, Eq) + +instance Functor Tree where + fmap f (Node a ml mr) = Node (f a) (fmap f <$> ml) (fmap f <$> mr) + +data Range = Range + { rMin :: Int + , rMax :: Int + } deriving (Show, Eq) + +data HorzNode = HorzNode + { hnRange :: Range + , hnCropImage :: CropImage + } + +data VertNode = VertNode + { vnRange :: Range + , vnHorzTree :: Tree HorzNode + } + +-- + +main :: IO () +main = do + options' <- getOptions + case options' of + Nothing -> printUsage + Just options -> + if validAnimationCount options + then do + let animations = Map.toList (optionsAnimations options) + animationImages <- forConcurrently animations $ \(animationKey,frames) -> do + imageIdsAndImages <- mapM readImageOrFail frames + return (animationKey, imageIdsAndImages) + let imageMap = Map.fromList $ concatMap snd animationImages + animations' <- createCropImagesWithCache animationImages imageMap + let layout = layoutCrops (optionsFps options) animations' + let spriteSheetInfo = layoutToSpriteSheetInfo (optionsImage options) layout + let image = generateImageFromLayout imageMap layout + BL.writeFile (optionsSpritesheet options) (encodePng image) + if optionsYaml options + then T.writeFile (optionsMetadata options) (customWriteSpriteSheetInfo spriteSheetInfo) + else BL.writeFile (optionsMetadata options) (A.encode spriteSheetInfo) + else do + putStrLn "Not enough animation frame images" + printUsage + +createCropImagesWithCache :: [(String, [(ImageId, a)])] -> Map ImageId (Image PixelRGBA8) -> IO (Map String [CropImage]) +createCropImagesWithCache animationImages imageMap = do + imageIdCropImageMapTVar <- newTVarIO Map.empty + animationImages' <- forM animationImages $ \(animationKey, imageIdsAndImages) -> do + xs <- forConcurrently imageIdsAndImages $ \(imageId, _) -> do + imageIdCropImageMap <- readTVarIO imageIdCropImageMapTVar + case Map.lookup imageId imageIdCropImageMap of + Nothing -> do + let cropImage = mkCropImage imageMap imageId + atomically $ modifyTVar imageIdCropImageMapTVar $ \m -> Map.insert imageId cropImage m + return cropImage + Just cropImage -> return cropImage + return (animationKey, xs) + return $ Map.fromList animationImages' +-- + +validAnimationCount :: Options -> Bool +validAnimationCount options = not $ any null $ Map.elems (optionsAnimations options) + +-- + +writeCropImage :: Map ImageId (Image PixelRGBA8) -> FilePath -> CropImage -> IO () +writeCropImage images fp ci = BL.writeFile fp (encodePng $ generateImageFromCropImage images ci) + +generateImageFromCropImage :: Map ImageId (Image PixelRGBA8) -> CropImage -> Image PixelRGBA8 +generateImageFromCropImage images ci = generateImage genPixel w h + where + (w, h) = ciDim ci + ((ofsX, ofsY), _) = ciCoords ci + img = images Map.! (ciImage ci) + genPixel x y = pixelAt img (x + ofsX) (y + ofsY) + +readImageOrFail :: FilePath -> IO (ImageId, Image PixelRGBA8) +readImageOrFail fp = do + bytes <- BL.readFile fp + let digest = md5 bytes + let img' = decodeImage (BL.toStrict bytes) + case img' of + Left _ -> fail $ "Can't load image: " ++ fp + Right img -> return (ImageId digest, convertRGBA8 img) + +layoutToSpriteSheetInfo :: FilePath -> Layout -> SpriteSheetInfo String Seconds +layoutToSpriteSheetInfo fp layout = SpriteSheetInfo + { ssiImage = fp + , ssiAlpha = Nothing + , ssiClips = spriteClipsFromRows (layoutRows layout) + , ssiAnimations = Map.mapKeys pack (layoutAnimations layout) + } + +customWriteSpriteSheetInfo :: SpriteSheetInfo a Seconds -> Text +customWriteSpriteSheetInfo ssi = T.unlines (linesOfSpriteSheetInfo ssi) + +linesOfSpriteSheetInfo :: SpriteSheetInfo a Seconds -> [Text] +linesOfSpriteSheetInfo ssi = + ["image: \"" <> pack (ssiImage ssi) <> "\""] ++ + ["alpha: null"] ++ + [] ++ + ["clips:"] ++ + (zipWith spriteClipToText [0..] (ssiClips ssi)) ++ + [] ++ + ["animations:"] ++ + concatMap (uncurry animationToText) (Map.toList (ssiAnimations ssi)) + +spriteClipToText :: Int -> SpriteClip a -> Text +spriteClipToText idx SpriteClip{scX,scY,scW,scH,scOffset} = mconcat $ + [ "- [" ] ++ + ([textShow scX, ", ", textShow scY, ", ", textShow scW, ", ", textShow scH] <> case scOffset of + Nothing -> [] + Just (x,y) -> [", ", textShow x, ", ", textShow y]) ++ + ["] # " <> textShow idx] + +animationToText :: Text -> [(FrameIndex, Seconds)] -> [Text] +animationToText name frames = + [" " <> textShow name <> ":"] ++ + map (\(frameIndex, seconds) -> mconcat [" - [", textShow frameIndex, ", ", showFloat seconds, "]"]) frames + +showFloat :: Float -> Text +showFloat f = pack $ printf "%.4f" f + +textShow :: Show a => a -> Text +textShow = pack . show + +spriteClipsFromRows :: [Row] -> [SpriteClip String] +spriteClipsFromRows = concatMap buildSpriteClips + where + buildSpriteClips :: Row -> [SpriteClip String] + buildSpriteClips row = fst $ foldr stepSpriteClips ([], 0) (rowCropImages row) + where + stepSpriteClips :: CropImage -> ([SpriteClip String], Int) -> ([SpriteClip String], Int) + stepSpriteClips ci (scs, widthTotal) = (scs ++ [sc], widthTotal + w) + where + (w, h) = ciDim ci + ((ofsX, ofsY), _) = ciCoords ci + (orgX, orgY) = ciOrigin ci + sc = SpriteClip + { scX = widthTotal + , scY = rowTop row + , scW = w + , scH = h + , scOffset = Just (orgX - ofsX, orgY - ofsY) + } + +generatePixelFromLayout :: Map ImageId (Image PixelRGBA8) -> Layout -> Int -> Int -> PixelRGBA8 +generatePixelFromLayout images layout x y = fromMaybe (PixelRGBA8 0 0 0 0) (getPixel x y) + where + tree = buildVertTree (layoutRows layout) + getPixel = lookupPixelFromTree images tree + +generateImageFromLayout :: Map ImageId (Image PixelRGBA8) -> Layout -> Image PixelRGBA8 +generateImageFromLayout images layout = generateImage (generatePixelFromLayout images layout) w h + where + (w, h) = layoutSize layout + +layoutCrops :: Int -> Map String [CropImage] -> Layout +layoutCrops fps cropImages = Layout size rows animations + where + size = getLayoutDim rows + boundaries = minBoundaries (Map.elems $ cInfoImages cropInfo) + rows = mkRows boundaries (map snd . sortByIndex . Map.toList $ cInfoImages cropInfo) + animations = cropAnimationsToLayoutAnimations fps (cInfoAnimations cropInfo) + cropInfo = buildCropInfo cropImages + +getLayoutDim :: [Row] -> (Int, Int) +getLayoutDim rows = (width, rowTop lastRow + rowHeight lastRow) + where + lastRow = last rows + width = maximum (map rowWidth rows) + +sortByIndex :: Ord a => [(a, b)] -> [(a, b)] +sortByIndex = sortBy (\x y -> compare (fst x) (fst y)) + +inRange :: Int -> Range -> Bool +inRange x r = x >= rMin r && x < rMax r + +lessThanRange :: Int -> Range -> Bool +lessThanRange x r = x < rMin r + +greaterThanRange :: Int -> Range -> Bool +greaterThanRange x r = x < rMax r + +lookupNodeWithinRange :: (n -> Range) -> Tree n -> Int -> Maybe n +lookupNodeWithinRange toRange (Node n left right) v = + if inRange v (toRange n) + then Just n + else if lessThanRange v (toRange n) + then left >>= \l -> lookupNodeWithinRange toRange l v + else right >>= \r -> lookupNodeWithinRange toRange r v + +lookupPixelFromTree :: Map ImageId (Image PixelRGBA8) -> Tree VertNode -> Int -> Int -> Maybe PixelRGBA8 +lookupPixelFromTree images tree x y = do + vn <- lookupNodeWithinRange vnRange tree y + hn <- lookupNodeWithinRange hnRange (vnHorzTree vn) x + let offset = (rMin (hnRange hn), rMin (vnRange vn)) + pixelFromCropImage images offset (x,y) (hnCropImage hn) + +pixelFromCropImage + :: Map ImageId (Image PixelRGBA8) + -> (Int, Int) -- ^ Offset + -> (Int, Int) -- ^ Spritesheet location + -> CropImage + -> Maybe PixelRGBA8 +pixelFromCropImage images (ofsX,ofsY) (x,y) ci = let + ((ofsX', ofsY'), _) = ciCoords ci + (x', y') = (x - ofsX + ofsX', y - ofsY + ofsY') + img = images Map.! (ciImage ci) + in if x' >= 0 && y' >= 0 && x' < imageWidth img && y' < imageHeight img + then Just $ pixelAt img x' y' + else Nothing + +mkRows + :: (Int, Int) -- Minimum boundaries + -> [CropImage] + -> [Row] +mkRows (minX, _) images = rsFinished done ++ (if null . rowCropImages $ rsCurrent done then [] else [rsCurrent done]) + where + done :: RowStep + done = foldl' stepRow initRowStep images + + stepRow :: RowStep -> CropImage -> RowStep + stepRow (RowStep cur finished) ci = let + cur' = appendCropImage cur ci + in if minX > rowWidth cur' + then RowStep cur' finished + else RowStep initRow{ rowTop = rowTop cur' + rowHeight cur' } (finished ++ [cur']) + +appendCropImage :: Row -> CropImage -> Row +appendCropImage row ci = row + { rowCropImages = ci : rowCropImages row + , rowHeight = max (rowHeight row) cropImageHeight + , rowWidth = rowWidth row + cropImageWidth + } + where + (cropImageWidth, cropImageHeight) = ciDim ci + +initRow :: Row +initRow = Row [] 0 0 0 + +initRowStep :: RowStep +initRowStep = RowStep initRow [] + +buildVertTree :: [Row] -> Tree VertNode +buildVertTree = fmap rowToVertNode . listToTree + +rowToVertNode :: Row -> VertNode +rowToVertNode row = VertNode + { vnRange = Range (rowTop row) (rowTop row + rowHeight row) + , vnHorzTree = buildHorzTree row + } + +buildHorzTree :: Row -> Tree HorzNode +buildHorzTree = listToTree . fst . foldr stepToHorzNode ([], 0) . rowCropImages + where + stepToHorzNode :: CropImage -> ([HorzNode], Int) -> ([HorzNode], Int) + stepToHorzNode ci (hns, width) = (hns ++ [hn], ciWidth + width) + where + hn = HorzNode (Range width (width + ciWidth)) ci + ciWidth = fst (ciDim ci) + +listToTree :: [a] -> Tree a +listToTree [] = error "Can't build VertTree" +listToTree xs = Node m left right + where + len = length xs + mid = div len 2 + (l, m:r) = splitAt mid xs + left = if null l then Nothing else Just (listToTree l) + right = if null r then Nothing else Just (listToTree r) + +cropAnimationsToLayoutAnimations + :: Int -- ^ Frames per seconds + -> Map String [CropFrame] -- ^ Crop animations + -> Map String [(FrameIndex, Seconds)] +cropAnimationsToLayoutAnimations fps = fmap $ map $ \CropFrame{cfCount,cfCropId} -> + (cfCropId, sum $ replicate cfCount spf) + where + spf = 1 / fromIntegral fps + +buildCropInfo :: Map String [CropImage] -> CropInfo +buildCropInfo animations = let + (frames, images) = Map.foldlWithKey' build (Map.empty, Map.empty) animations + in CropInfo frames images + where + build + :: (Map String [CropFrame], Map CropId CropImage) + -> String + -> [CropImage] + -> (Map String [CropFrame], Map CropId CropImage) + build (cropFrames, cropImages) aniName imgs = let + (cropImages', cropIds) = insertCropImages imgs cropImages + cropFrames' = Map.insert aniName (collapseIntoFrames cropIds) cropFrames + in (cropFrames', cropImages') + +insertCropImages :: [CropImage] -> Map CropId CropImage -> (Map CropId CropImage, [CropId]) +insertCropImages imgs cropImages = foldl' insertCropImagesStep (cropImages, []) imgs + +insertCropImagesStep + :: (Map CropId CropImage, [CropId]) + -> CropImage + -> (Map CropId CropImage, [CropId]) +insertCropImagesStep (cropImages, cropIds) cropImage = let + (cropImages', cropId) = insertCropImage cropImage cropImages + in (cropImages', cropIds ++ [cropId]) + +collapseIntoFrames :: [CropId] -> [CropFrame] +collapseIntoFrames [] = [] +collapseIntoFrames (x:xs) = let + (included, after) = span (== x) xs + in CropFrame x (1 + length included) : collapseIntoFrames after + +eqImagePixelRGBA8 :: Image PixelRGBA8 -> Image PixelRGBA8 -> Bool +eqImagePixelRGBA8 a b = + imageWidth a == imageWidth b && + imageHeight a == imageHeight b && + imageData a == imageData b + +insertCropImage :: CropImage -> Map CropId CropImage -> (Map CropId CropImage, CropId) +insertCropImage img imgs = case findByElem imgs img of + Just cropId -> (imgs, cropId) + Nothing -> let + cropId = Map.size imgs + imgs' = Map.insert cropId img imgs + in (imgs', cropId) + +findByElem :: Eq a => Map k a -> a -> Maybe k +findByElem m v = fst <$> find (\(_,w) -> v == w) (Map.toList m) + +sumDim :: [CropImage] -> (Int, Int) +sumDim = foldr (\CropImage{ciDim} (w,h) -> (fst ciDim + w, snd ciDim + h)) (0,0) + +maxHeight :: [CropImage] -> Int +maxHeight = maximum . map (snd . ciDim) + +minBoundaries :: [CropImage] -> (Int, Int) +minBoundaries images = let + bound = round . ((*) (sqrtFloat num)) . (/num) . fromIntegral + num = fromIntegral (length images) + dim = sumDim images + in ( bound (fst dim), bound (snd dim) ) + +mkCropImage :: Map ImageId (Image PixelRGBA8) -> ImageId -> CropImage +mkCropImage images imageId = CropImage + { ciImage = imageId + , ciCoords = coords + , ciOrigin = (imageWidth img `div` 2, imageHeight img `div` 2) + , ciDim = cropImageDim coords + } + where + img = images Map.! imageId + coords = cropCoordsImage img + +cropImageDim :: ((Int, Int), (Int, Int)) -> (Int, Int) +cropImageDim ((x0,y0), (x1,y1)) = (x1 - x0 + 1, y1 - y0 + 1) + +cropCoordsImage :: (Pixel a, Eq (PixelBaseComponent a), Ord (PixelBaseComponent a)) => Image a -> ((Int, Int), (Int, Int)) +cropCoordsImage img = fromMaybe ((0,0), (1,1)) maybeCropped + where + maybeCropped = (,) + <$> ((,) <$> findX0 img <*> findY0 img) + <*> ((,) <$> findX1 img <*> findY1 img) + +firstOpaquePoint :: (Pixel a, Eq (PixelBaseComponent a), Ord (PixelBaseComponent a)) => (Image a -> [(Int, Int)]) -> ((Int, Int) -> Int) -> Image a -> Maybe Int +firstOpaquePoint mkCoords whichPoint img = fmap fst $ headMay $ filter snd (map getPixel coords) + where + getPixel coord@(x,y) = (whichPoint coord, pixelOpacity (pixelAt img x y) > 0) + coords = mkCoords img + +findY0 :: (Pixel a, Eq (PixelBaseComponent a), Ord (PixelBaseComponent a)) => Image a -> Maybe Int +findY0 = firstOpaquePoint topDown snd + +findY1 :: (Pixel a, Eq (PixelBaseComponent a), Ord (PixelBaseComponent a)) => Image a -> Maybe Int +findY1 = firstOpaquePoint downTop snd + +findX0 :: (Pixel a, Eq (PixelBaseComponent a), Ord (PixelBaseComponent a)) => Image a -> Maybe Int +findX0 = firstOpaquePoint leftRight fst + +findX1 :: (Pixel a, Eq (PixelBaseComponent a), Ord (PixelBaseComponent a)) => Image a -> Maybe Int +findX1 = firstOpaquePoint rightLeft fst + +topDown :: Image a -> [(Int,Int)] +topDown Image{imageWidth,imageHeight} = [(x,y) | y <- [0..pred imageHeight], x <- [0..pred imageWidth]] + +downTop :: Image a -> [(Int, Int)] +downTop Image{imageWidth,imageHeight} = [(x,y) | y <- reverse [0..pred imageHeight], x <- [0..pred imageWidth]] + +leftRight :: Image a -> [(Int, Int)] +leftRight Image{imageWidth,imageHeight} = [(x,y) | x <- [0..pred imageWidth], y <- [0..pred imageHeight]] + +rightLeft :: Image a -> [(Int, Int)] +rightLeft Image{imageWidth,imageHeight} = [(x,y) | x <- reverse [0..pred imageWidth], y <- [0..pred imageHeight]] diff --git a/library/Animate/Frames/Options.hs b/library/Animate/Frames/Options.hs new file mode 100644 --- /dev/null +++ b/library/Animate/Frames/Options.hs @@ -0,0 +1,185 @@ +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 ...] [--image ] [--metadata ] [--fps ] [--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 -- Krita default animation FPS is 24fps +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 diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,76 @@ +name: animate-frames +version: '0.0.0' +github: "jxv/animate-frames" +license: MIT +author: "Joe Vargas" +maintainer: "Joe Vargas" +description: Convert sprite frames to animate files +synposis: Convert sprite frames to animate files + +extra-source-files: +- CHANGELOG.md +- LICENSE.md +- package.yaml +- README.md +- stack.yam +- propagada/animate-preview.png +- propagada/compile-frames.sh +- propagada/dance_krita.png +- propagada/dance_render.png +- propagada/dance.kra +- propagada/figure.png +- propagada/figure.yaml +- propagada/frames.png +- propagada/wall_krita.png +- propagada/wall_render.png +- propagada/wall.kra + +ghc-options: -Wall + +default-extensions: +- NamedFieldPuns +- OverloadedStrings +- FlexibleContexts + +library: + dependencies: + - aeson + - async + - base >= 4.5 && <5 + - bytestring + - animate + - JuicyPixels + - yaml + - containers + - pureMD5 + - safe + - text + - vector + - stm + source-dirs: library + +executables: + animate-frames: + source-dirs: executable + main: Main.hs + dependencies: + - base + - animate-frames + ghc-options: + - -rtsopts + - -threaded + - -with-rtsopts=-N + +tests: + animate-frames-test-suite: + source-dirs: test-suite + main: Main.hs + dependencies: + - base + - animate-frames + - tasty + - tasty-hspec + ghc-options: + - -rtsopts + - -threaded + - -with-rtsopts=-N diff --git a/test-suite/Main.hs b/test-suite/Main.hs new file mode 100644 --- /dev/null +++ b/test-suite/Main.hs @@ -0,0 +1,17 @@ +-- Tasty makes it easy to test your code. It is a test framework that can +-- combine many different types of tests into one suite. See its website for +-- help: . +import qualified Test.Tasty +-- Hspec is one of the providers for Tasty. It provides a nice syntax for +-- writing tests. Its website has more info: . +import Test.Tasty.Hspec + +main :: IO () +main = do + test <- testSpec "animate-frames" spec + Test.Tasty.defaultMain test + +spec :: Spec +spec = parallel $ do + it "is trivially true" $ do + True `shouldBe` True