packages feed

animate-frames (empty) → 0.0.0

raw patch · 10 files changed

+1031/−0 lines, 10 filesdep +JuicyPixelsdep +aesondep +animatesetup-changed

Dependencies added: JuicyPixels, aeson, animate, animate-frames, async, base, bytestring, containers, pureMD5, safe, stm, tasty, tasty-hspec, text, vector, yaml

Files

+ CHANGELOG.md view
@@ -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
+ LICENSE.md view
@@ -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
+ README.md view
@@ -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 <key> <frame0.png> <frame1.png> ...] [--image <spritesheet.png>] [--metadata <target.json>] [--fps <int>] [--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.+
+ Setup.hs view
@@ -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: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain
+ animate-frames.cabal view
@@ -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
+ executable/Main.hs view
@@ -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
+ library/Animate/Frames.hs view
@@ -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]]
+ library/Animate/Frames/Options.hs view
@@ -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 <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 -- 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
+ package.yaml view
@@ -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
+ test-suite/Main.hs view
@@ -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: <http://documentup.com/feuerbach/tasty>.+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: <https://hspec.github.io>.+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