diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,4 @@
+0.1.0.0
+=======
+
+Initial release.
diff --git a/JuicyPixels-blp.cabal b/JuicyPixels-blp.cabal
new file mode 100644
--- /dev/null
+++ b/JuicyPixels-blp.cabal
@@ -0,0 +1,68 @@
+name:                JuicyPixels-blp
+version:             0.1.0.0
+synopsis:            BLP format decoder/encoder over JuicyPixels library
+description:         Please see README.md
+homepage:            http://github.com/NCrashed/JuicyPixels-blp#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Anton Gushcha
+maintainer:          ncrashed@gmail.com
+copyright:           2015-2018 Anton Gushcha
+category:            Codec, Graphics, Image
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md, CHANGELOG.md
+
+source-repository head
+  type:      git
+  location:  git@github.com:NCrashed/JuicyPixels-blp.git
+
+library
+  hs-source-dirs:      src
+  exposed-modules:
+    Codec.Picture.Blp
+    Codec.Picture.Blp.Internal.Convert
+    Codec.Picture.Blp.Internal.Data
+    Codec.Picture.Blp.Internal.Encoder
+    Codec.Picture.Blp.Internal.Parser
+
+  default-language:    Haskell2010
+  build-depends:
+      base                  >= 4.7    && < 5
+    , attoparsec            >= 0.12   && < 0.14
+    , binary                >= 0.8    && < 0.9
+    , bytestring            >= 0.10   && < 0.11
+    , hashable              >= 1.2    && < 1.3
+    , JuicyPixels           >= 3.2    && < 3.3
+    , text-show             >= 3.7    && < 3.8
+    , vector                >= 0.10   && < 0.13
+
+  default-extensions:
+    BangPatterns
+    DeriveGeneric
+    MultiWayIf
+    OverloadedStrings
+    RecordWildCards
+
+executable blp2any
+  hs-source-dirs:      blp2any
+  main-is:             Main.hs
+  other-modules:
+    Convert
+    File
+    Statistics
+  ghc-options:       -threaded -O2 -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+  build-depends:
+      base                  >= 4.7    && < 5
+    , bytestring
+    , directory             >= 1.2    && < 1.4
+    , filepath              >= 1.4    && < 1.5
+    , JuicyPixels
+    , JuicyPixels-blp
+    , optparse-simple       >= 0.0.3  && < 0.2
+    , text-show
+    , unordered-containers  >= 0.2    && < 0.3
+
+  default-extensions:
+    RecordWildCards
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright  (c) 2015
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of  nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,17 @@
+JuicyPixels-blp
+===============
+
+The library provides decoding/encoding functions for BLP1 texture format of Warcraft III game.
+The result is represented in types of [JuicyPixels](http://hackage.haskell.org/package/JuicyPixels) library.
+
+Features:
+
+- Supported all three subtypes of BLP1: JPEG with alpha, paletted without alpha and paletted with alpha.
+
+- Command line utility to convert BLPs from/to PNG, JPEG, BMP, TGA, TIFF, GIF, Radiance formats.
+
+TODO:
+
+- BLP0 support
+
+- BLP2 support
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/blp2any/Convert.hs b/blp2any/Convert.hs
new file mode 100644
--- /dev/null
+++ b/blp2any/Convert.hs
@@ -0,0 +1,171 @@
+module Convert(
+    convertFiles
+  , ConvertFormat(..)
+  , ConvertOptions(..)
+  , readConvertFormat
+  , BlpFormat(..)
+  , readBlpFormat
+  ) where
+
+import Codec.Picture
+import Codec.Picture.Blp
+import Control.Monad
+import Data.Char
+import Data.Maybe
+import Data.Monoid
+import System.Directory
+import System.FilePath
+
+import qualified Data.ByteString as BS
+
+import File
+
+data BlpFormat =
+    BlpJpeg
+  | BlpUncompressedWithAlpha
+  | BlpUncompressedWithoutAlpha
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
+readBlpFormat :: String -> Maybe BlpFormat
+readBlpFormat s = case toLower <$> s of
+  "jpeg" -> Just BlpJpeg
+  "jpg" -> Just BlpJpeg
+  "uncompressed1" -> Just BlpUncompressedWithAlpha
+  "uncompressedwithalpha" -> Just BlpUncompressedWithAlpha
+  "uncompressed2" -> Just BlpUncompressedWithoutAlpha
+  "uncompressedwithoutalpha" -> Just BlpUncompressedWithoutAlpha
+  _ -> Nothing
+
+data ConvertFormat =
+    Blp
+  | Png
+  | Jpeg
+  | Tiff
+  | Gif
+  | Bmp
+  | UnspecifiedFormat
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
+readConvertFormat :: String -> Maybe ConvertFormat
+readConvertFormat s = case toLower <$> s of
+  "blp" -> Just Blp
+  "png" -> Just Png
+  "jpeg" -> Just Jpeg
+  "jpg" -> Just Jpeg
+  "jpe" -> Just Jpeg
+  "jif" -> Just Jpeg
+  "jfif" -> Just Jpeg
+  "jfi" -> Just Jpeg
+  "tiff" -> Just Tiff
+  "gif" -> Just Gif
+  "bmp" -> Just Bmp
+  _ -> Nothing
+
+-- | Replaces Unspecified
+defaultFormat :: ConvertFormat
+defaultFormat = Png
+
+formatExtension :: ConvertFormat -> [String]
+formatExtension c = case c of
+  Blp -> [".blp"]
+  Png -> [".png"]
+  Jpeg -> [".jpeg", ".jpg", ".jpe", ".jif", ".jfif", ".jfi"]
+  Tiff -> [".tiff"]
+  Gif -> [".gif"]
+  Bmp -> [".bmp"]
+  UnspecifiedFormat -> []
+
+supportedExtensions :: [String]
+supportedExtensions = concat $ formatExtension <$> [Blp .. Bmp]
+
+data ConvertOptions = ConvertOptions {
+  convertInput          :: FilePath
+, convertOutput         :: FilePath
+, convertInputFormat    :: ConvertFormat
+, convertFormat         :: ConvertFormat
+, convertQuality        :: Int
+, convertPreservesDirs  :: Bool
+, convertShallow        :: Bool
+, convertBlpFormat      :: BlpFormat
+, convertBlpMinMipSize  :: Int
+}
+
+convertFiles :: ConvertOptions -> IO ()
+convertFiles opts@ConvertOptions{..} = do
+  efx <- doesFileExist convertInput
+  if efx
+    then convertFile opts False convertInput
+    else do
+      edx <- doesDirectoryExist convertInput
+      if edx then forEachFile' convertInput fileFilter $ convertFile opts True
+      else fail "Given path is not exists!"
+  where
+    fileFilter s = case convertFormat of
+      Blp -> or $ ((takeExtension s) ==) <$> supportedExtensions
+      _ -> (".blp" ==) . takeExtension $ s
+
+-- | Trye to guess format from name of file
+guessFormat :: FilePath -> Maybe ConvertFormat
+guessFormat = readConvertFormat . drop 1 . takeExtension
+
+-- | Try to load input file with desired format
+readInputFile :: FilePath -> ConvertFormat -> IO DynamicImage
+readInputFile inputFile format = case format of
+  Blp -> do
+    fc <- BS.readFile inputFile
+    case decodeBlp fc of
+      Left err -> fail $ "Failed to load file " <> inputFile <> ", parse error: " <> err
+      Right img -> pure img
+  Png -> loadJuicy readPng
+  Jpeg -> loadJuicy readJpeg
+  Tiff -> loadJuicy readTiff
+  Gif -> loadJuicy readGif
+  Bmp -> loadJuicy readBitmap
+  UnspecifiedFormat -> case guessFormat inputFile of
+    Just newFormat -> readInputFile inputFile newFormat
+    Nothing -> fail $ "Cannot infer format from filename " <> inputFile
+  where
+    loadJuicy :: (FilePath -> IO (Either String DynamicImage)) -> IO DynamicImage
+    loadJuicy f = do
+      mres <- f inputFile
+      case mres of
+        Left err -> fail $ "Failed to load file " <> inputFile <> " as " <> show format <> ", error: " <> err
+        Right img -> pure img
+
+convertFile :: ConvertOptions -> Bool -> FilePath -> IO ()
+convertFile ConvertOptions{..} isDir inputFile = do
+  img <- readInputFile inputFile convertInputFormat
+  let distFormat = case convertFormat of
+        UnspecifiedFormat -> if isDir then defaultFormat
+          else case guessFormat convertOutput of
+            Just f -> f
+            Nothing -> defaultFormat
+        _ -> convertFormat
+
+  when isDir $ createDirectoryIfMissing True convertOutput
+  let outputFile = if isDir
+      then convertOutput <> "/" <> takeBaseName inputFile <> fromMaybe "" (listToMaybe $ formatExtension distFormat)
+      else convertOutput
+
+  let mipsCount = mipMapsUpTo convertBlpMinMipSize img
+  res <- (convertionFunction distFormat convertQuality convertBlpFormat) outputFile mipsCount img
+  case res of
+    Left err -> fail $ inputFile <> ": " <> err
+    Right _ -> putStrLn $ inputFile <> ": Success"
+
+convertionFunction :: ConvertFormat -> Int -> BlpFormat -> FilePath -> Int -> DynamicImage -> IO (Either String ())
+convertionFunction f quality blpFormat path mipsCount img = case f of
+  Blp -> case blpFormat of
+    BlpJpeg -> writeBlpJpeg path quality mipsCount img >> pure (Right ())
+    BlpUncompressedWithAlpha -> writeBlpUncompressedWithAlpha path mipsCount img >> pure (Right ())
+    BlpUncompressedWithoutAlpha -> writeBlpUncompressedWithoutAlpha path mipsCount img >> pure (Right ())
+  Png -> do
+    res <- writeDynamicPng path img
+    pure $ void res
+  Jpeg -> saveJpgImage quality path img >> pure (Right ())
+  Tiff -> saveTiffImage path img >> pure (Right ())
+  Gif -> case saveGifImage path img of
+    Left er -> pure $ Left er
+    Right io -> io >> pure (Right ())
+  Bmp -> saveBmpImage path img >> pure (Right ())
+  UnspecifiedFormat -> pure $ Left "no conversion format specified"
diff --git a/blp2any/File.hs b/blp2any/File.hs
new file mode 100644
--- /dev/null
+++ b/blp2any/File.hs
@@ -0,0 +1,32 @@
+module File(
+    forEachFile
+  , forEachFile'
+  ) where
+
+import System.Directory
+import System.FilePath
+import Control.Monad 
+
+-- | Performs width traversion of given directory
+forEachFile :: FilePath -- ^ Directory to traverse
+  -> (FilePath -> Bool) -- ^ File selector
+  -> (a -> FilePath -> IO a) -- ^ Function to perform (mimics fold)
+  -> a -- ^ Start value of acum
+  -> IO a -- ^ Last value of accum
+forEachFile path predf f acc = go acc path
+  where
+    go a inputPath = do 
+      names <- fmap (\p -> inputPath ++ "/" ++ p) <$> getDirectoryContents inputPath
+      dirs <- filter (not . isSystemDir) <$> filterM doesDirectoryExist names
+      files <- filter predf <$> filterM doesFileExist names
+      a' <- foldM f a files 
+      a' `seq` foldM go a' dirs
+
+    isSystemDir s = let bs = takeFileName s in bs == "." || bs == ".."
+
+-- | Performs width traversion of given directory, simplified versino of forEachFile
+forEachFile' :: FilePath -- ^ Directory to traverse
+  -> (FilePath -> Bool) -- ^ File selector
+  -> (FilePath -> IO ()) -- ^ Function to perform
+  -> IO ()
+forEachFile' path predf f = forEachFile path predf (const f) ()
diff --git a/blp2any/Main.hs b/blp2any/Main.hs
new file mode 100644
--- /dev/null
+++ b/blp2any/Main.hs
@@ -0,0 +1,47 @@
+module Main where
+
+import Data.Monoid
+import Options.Applicative.Simple
+
+import Statistics
+import Convert
+
+-- | Helper for lifting pure parsing functions into ReadM monad
+readMPure :: String -- ^ Name of argument for pretty error message
+  -> (String -> Maybe a) -- ^ Function that parses the argument
+  -> ReadM a -- ^ Optparse parser monad
+readMPure desc f = do
+  s <- str
+  case f s of
+    Nothing -> fail $ "Unknown " ++ desc ++ " " ++ s
+    Just v -> return v
+
+-- | How to parse ConvertFormat
+convertFormatR :: ReadM ConvertFormat
+convertFormatR = readMPure "format" readConvertFormat
+
+-- | How to parse BlpFormat
+blpFormatR :: ReadM BlpFormat
+blpFormatR = readMPure "blp format" readBlpFormat
+
+main :: IO ()
+main = do
+  (_,runCmd) <- simpleOptions ver headerDesc desc (pure ()) $ do
+    addCommand "convert" "Converts given blp or folder with blps to PNG" convertFiles $ (<*>) helper $ ConvertOptions
+      <$> strArgument (metavar "INPUT_PATH" <> help "input file or directory (batch mode)")
+      <*> strArgument (metavar "OUTPUT_PATH" <> help "output file name or directory (need explicit format option)")
+      <*> option convertFormatR (long "input-format" <> short 'i' <> value UnspecifiedFormat <> help "Input file format, if not specified tries to infer from input file name. Values: blp png jpg tiff gif bmp.")
+      <*> option convertFormatR (long "format" <> short 'f' <> value UnspecifiedFormat <> help "Output file format, if not specified tries to infer from output file name. Values: blp png jpg tiff gif bmp.")
+      <*> option auto (long "quality" <> short 'q' <> value 90 <> help "Quality level for formats with lossy compression (default 90)")
+      <*> fmap not (switch (long "notPreserveStructure" <> short 'p' <> help "Will not produce subfolders while batch converting" ))
+      <*> switch (long "shallow" <> short 's' <> help "Not look into subfolders while batch converting")
+      <*> option blpFormatR (long "blpFormat" <> short 'b' <> value BlpJpeg <> help "Specifies what BLP internal format to use when converting to BLP. Values: jpg uncompressedWithAlpha uncompressedWithoutAlpha")
+      <*> option auto (long "min-mipmap-size" <> value 1 <> help "Minimum size of mimmap side to include in resulted BLP file")
+    addCommand "stats" "Collects statistics about BLP images in folder and saves examples of BLP's for each sample" (uncurry collectStatistics) $ (<*>) helper $ (,)
+      <$> strArgument (metavar "DIRECTORY" <> help "Input folder that stores blps (subfolders are processed)")
+      <*> strArgument (metavar "OUTPUT_PATH" <> help "Here blp samples would be stored")
+  runCmd
+  where
+    ver = "0.1.0.0"
+    headerDesc = ""
+    desc = "Converting BLP1 Warcraft III format to/from PNG, JPEG, TGA, TIFF, BMP, GIF"
diff --git a/blp2any/Statistics.hs b/blp2any/Statistics.hs
new file mode 100644
--- /dev/null
+++ b/blp2any/Statistics.hs
@@ -0,0 +1,59 @@
+module Statistics(
+    collectSamples 
+  , printStatistics
+  , collectStatistics
+  ) where
+
+import Codec.Picture.Blp.Internal.Data
+import Codec.Picture.Blp.Internal.Parser
+import Control.Monad 
+import Data.Word 
+import System.Directory
+import System.FilePath
+
+import qualified Data.ByteString as BS
+import qualified Data.HashMap.Strict as H 
+import qualified Data.List as L 
+
+import File 
+
+type BlpInfo = (BlpCompression, [BlpFlag], BlpPictureType, Word32)
+type BlpStat = (FilePath, Int)
+
+type StatMap = H.HashMap BlpInfo BlpStat
+
+collectSamples :: FilePath -> IO StatMap
+collectSamples dir = do 
+  f <- doesDirectoryExist dir
+  unless f $ fail $ "Provided directory " ++ dir ++ " doesn't exists!"
+  forEachFile dir ((".blp" ==).takeExtension) collectSample H.empty
+  
+collectSample :: StatMap -> FilePath -> IO StatMap 
+collectSample stats inputFile = do 
+  putStrLn $ "Sampling " ++ inputFile
+  fc <- BS.readFile inputFile
+  case parseBlp fc of 
+    Left err -> fail $ inputFile ++ ": " ++ err 
+    Right blp -> return $ adjust' (updateStat inputFile) (blpType blp) stats
+
+blpType :: BlpStruct -> BlpInfo 
+blpType BlpStruct{..} = (blpCompression, blpFlags, blpPictureType, blpPictureSubType)
+
+adjust' :: (Maybe BlpStat -> BlpStat) -> BlpInfo -> StatMap -> StatMap 
+adjust' f k m = H.insert k (f $ H.lookup k m) m
+
+updateStat :: FilePath -> Maybe BlpStat -> BlpStat 
+updateStat path Nothing = (path, 1)
+updateStat _ (Just (p, i)) = (p, i+1)
+
+printStatistics :: FilePath -> StatMap -> IO () 
+printStatistics dir stats = do
+    createDirectoryIfMissing True dir
+    forM_ (H.toList stats) $ \((compression, flags, pictureType, pictureSubType), (path, i)) -> do 
+      let postfix = L.intercalate "-" [show compression, show flags, show pictureType, show pictureSubType]
+      copyFile path $ dir ++ "/" ++ dropExtension (takeFileName path) ++ "-"
+        ++ postfix ++ ".blp"
+      putStrLn $ postfix ++ ": " ++ show i ++ " images"
+
+collectStatistics :: FilePath -> FilePath -> IO ()
+collectStatistics dir outputDir = printStatistics outputDir =<< collectSamples dir 
diff --git a/src/Codec/Picture/Blp.hs b/src/Codec/Picture/Blp.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Picture/Blp.hs
@@ -0,0 +1,118 @@
+module Codec.Picture.Blp(
+    readBlp
+  , readBlpMipmaps
+  , decodeBlp
+  , decodeBlpMipmaps
+  , writeBlpJpeg
+  , writeBlpUncompressedWithAlpha
+  , writeBlpUncompressedWithoutAlpha
+  , encodeBlpJpeg
+  , encodeBlpUncompressedWithAlpha
+  , encodeBlpUncompressedWithoutAlpha
+  , mipMapsUpTo
+  ) where
+
+import Codec.Picture
+import Codec.Picture.Types
+import Data.ByteString (ByteString)
+import Data.Monoid
+import Data.Word
+import TextShow.Debug.Trace
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.Vector as V
+
+import Codec.Picture.Blp.Internal.Convert
+import Codec.Picture.Blp.Internal.Data
+import Codec.Picture.Blp.Internal.Encoder
+import Codec.Picture.Blp.Internal.Parser
+
+-- | Read BLP from given file without mipmaps
+readBlp :: FilePath -> IO (Either String DynamicImage)
+readBlp fp = decodeBlp `fmap` BS.readFile fp
+
+-- | Read BLP from given file with mipmaps
+readBlpMipmaps :: FilePath -> IO (Either String [DynamicImage])
+readBlpMipmaps fp = decodeBlpMipmaps `fmap` BS.readFile fp
+
+-- | Decodes BLP without mipmaps
+decodeBlp :: ByteString -> Either String DynamicImage
+decodeBlp bs = do
+  is <- decodeBlpMipmaps bs
+  if null is then Left "No data in BLP"
+    else return $ head is
+
+-- | Decodes BLP and returns original image plus all mipmaps
+decodeBlpMipmaps :: ByteString -> Either String [DynamicImage]
+decodeBlpMipmaps bs = do
+  blp <- parseBlp bs
+  case blpExt $ traceTextShowId blp of
+    BlpJpeg {..} -> do
+      let jpegs = (blpJpegHeader <>) `fmap` blpJpegData
+      mips <- mapM decodeJpeg jpegs
+      return $ toPngRepresentable <$> mips
+
+    BlpUncompressed1 {..} -> do
+      let mkImage mip = ImageRGBA8 $ generateImage (gen mip) (fromIntegral $ blpWidth blp) (fromIntegral $ blpHeight blp)
+      return $ mkImage `fmap` blpU1MipMaps
+      where
+      palette :: Word8 -> PixelRGBA8
+      palette i = blpU1Palette V.! fromIntegral i
+
+      makeIndex x y = y*(fromIntegral $ blpWidth blp)+x
+      takeColor mip x y = palette $ fst mip `BS.index` makeIndex x y
+      takeAlpha mip x y = snd mip `BS.index` makeIndex x y
+      gen mip x y = let
+        PixelRGBA8 r g b _ = takeColor mip x y
+        a = takeAlpha mip x y
+        in PixelRGBA8 b g r a
+
+    BlpUncompressed2 {..} -> do
+      let mkImage mip = ImageRGBA8 $ generateImage (gen mip) (fromIntegral $ blpWidth blp) (fromIntegral $ blpHeight blp)
+      return $ mkImage `fmap` blpU2MipMaps
+      where
+      palette :: Word8 -> PixelRGBA8
+      palette i = blpU2Palette V.! fromIntegral i
+
+      makeIndex x y = y*(fromIntegral $ blpWidth blp)+x
+      takeColor mip x y = palette $ mip `BS.index` makeIndex x y
+      gen mip x y = let
+        PixelRGBA8 r g b a = takeColor mip x y
+        in PixelRGBA8 b g r (255 - a)
+
+-- | Calculate needed count of mipmaps to cover sizes up to given minimum size (helper for 'writeBlp*' functions)
+mipMapsUpTo :: Int -- ^ Minimum size of picture side for generation of mipmap (ex. 2, 4, 16, 32, 64, 512, 1024 and etc)
+  -> DynamicImage -- ^ Image for which we generate mipmaps
+  -> Int
+mipMapsUpTo minSize img = maxNum - minSizeNum
+  where
+    w = dynamicMap imageWidth img
+    h = dynamicMap imageHeight img
+    minSide = min w h
+    maxNum = ceiling $ logBase 2 (fromIntegral minSide)
+    minSizeNum = floor $ logBase 2 (fromIntegral (max 1 minSize))
+
+writeBlpJpeg :: FilePath -> Int -> Int -> DynamicImage -> IO ()
+writeBlpJpeg fp quality numMips img = do
+  let bs = encodeBlpJpeg quality numMips img
+  BSL.writeFile fp bs
+
+writeBlpUncompressedWithAlpha :: FilePath -> Int -> DynamicImage -> IO ()
+writeBlpUncompressedWithAlpha fp numMips img = do
+  let bs = encodeBlpUncompressedWithAlpha numMips img
+  BSL.writeFile fp bs
+
+writeBlpUncompressedWithoutAlpha :: FilePath -> Int -> DynamicImage -> IO ()
+writeBlpUncompressedWithoutAlpha fp numMips img = do
+  let bs = encodeBlpUncompressedWithoutAlpha numMips img
+  BSL.writeFile fp bs
+
+encodeBlpJpeg :: Int -> Int -> DynamicImage -> BSL.ByteString
+encodeBlpJpeg quality numMips = encodeBlp numMips {-. traceTextShowId-} . toBlpStruct BlpCompressionJPEG quality numMips
+
+encodeBlpUncompressedWithAlpha :: Int -> DynamicImage -> BSL.ByteString
+encodeBlpUncompressedWithAlpha numMips = encodeBlp numMips {-. traceTextShowId-} . toBlpStruct BlpCompressionUncompressed 100 numMips
+
+encodeBlpUncompressedWithoutAlpha :: Int -> DynamicImage -> BSL.ByteString
+encodeBlpUncompressedWithoutAlpha numMips = encodeBlp numMips {-. traceTextShowId-} . toBlpStruct BlpCompressionUncompressed 100 numMips
diff --git a/src/Codec/Picture/Blp/Internal/Convert.hs b/src/Codec/Picture/Blp/Internal/Convert.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Picture/Blp/Internal/Convert.hs
@@ -0,0 +1,118 @@
+module Codec.Picture.Blp.Internal.Convert(
+    toPngRepresentable
+  , toBlpUncompressable
+  , toBlpCMYK8
+  ) where
+
+import Codec.Picture
+import Codec.Picture.Types
+import Data.Word
+
+toPngRepresentable :: DynamicImage -> DynamicImage
+toPngRepresentable i = case i of
+  ImageY8 _ -> i
+  ImageY16 _ -> i
+  ImageYF p -> ImageRGB16 . convertFloatImage16 . promoteImage $ p
+  ImageYA8 _ -> i
+  ImageYA16 _ -> i
+  ImageRGB8 _ -> i
+  ImageRGB16 _ -> i
+  ImageRGBF p -> ImageRGB16 . convertFloatImage16 $ p
+  ImageRGBA8 _ -> i
+  ImageRGBA16 _ -> i
+  ImageYCbCr8 p -> ImageRGB8 . convertImage $ p
+  ImageCMYK8 p -> ImageRGBA8 . convertCMYK8Image $ p
+  ImageCMYK16 p -> ImageRGBA16 . convertCMYK16Image $ p
+
+toBlpUncompressable :: DynamicImage -> Image PixelRGBA8
+toBlpUncompressable i = case i of
+  ImageY8 p -> toBlpRGB8 (promoteImage p :: Image PixelRGB8)
+  ImageY16 p -> toBlpRGB8 (dropBits (promoteImage p :: Image PixelRGB16) :: Image PixelRGB8)
+  ImageYF p -> toBlpRGB8 (convertFloatImage8 (promoteImage p :: Image PixelRGBF) :: Image PixelRGB8)
+  ImageYA8 p -> toBlpRGBA8 (promoteImage p :: Image PixelRGBA8)
+  ImageYA16 p -> toBlpRGBA8 (dropBitsA (promoteImage p :: Image PixelRGBA16) :: Image PixelRGBA8)
+  ImageRGB8 p -> toBlpRGB8 p
+  ImageRGB16 p -> toBlpRGB8 (dropBits p :: Image PixelRGB8)
+  ImageRGBF p -> toBlpRGB8 (convertFloatImage8 p :: Image PixelRGB8)
+  ImageRGBA8 p -> toBlpRGBA8 p
+  ImageRGBA16 p -> toBlpRGBA8 (dropBitsA p :: Image PixelRGBA8)
+  ImageYCbCr8 p -> toBlpRGB8 (convertImage p :: Image PixelRGB8)
+  ImageCMYK8 p -> toBlpRGB8 (convertImage p :: Image PixelRGB8)
+  ImageCMYK16 p -> toBlpRGB8 (dropBits (convertImage p :: Image PixelRGB16) :: Image PixelRGB8)
+
+dropBits :: Image PixelRGB16 -> Image PixelRGB8
+dropBits = pixelMap $ \(PixelRGB16 r g b) -> PixelRGB8 (f r) (f g) (f b)
+  where
+    f :: Word16 -> Word8
+    f x = round $ 255 * (fromIntegral x :: Double) / 65535
+
+dropBitsA :: Image PixelRGBA16 -> Image PixelRGBA8
+dropBitsA = pixelMap $ \(PixelRGBA16 r g b a) -> PixelRGBA8 (f r) (f g) (f b) (f a)
+  where
+    f :: Word16 -> Word8
+    f x = round $ 255 * (fromIntegral x :: Double) / 65535
+
+convertFloatImage8 :: Image PixelRGBF -> Image PixelRGB8
+convertFloatImage8 = pixelMap convert
+  where
+    convert (PixelRGBF rf gf bf) = PixelRGB8
+      (round $ 255 * rf)
+      (round $ 255 * gf)
+      (round $ 255 * bf)
+
+convertFloatImage16 :: Image PixelRGBF -> Image PixelRGB16
+convertFloatImage16 = pixelMap convert
+  where
+    convert (PixelRGBF rf gf bf) = PixelRGB16
+      (round $ 65535 * rf)
+      (round $ 65535 * gf)
+      (round $ 65535 * bf)
+
+convertCMYK8Image :: Image PixelCMYK8 -> Image PixelRGBA8
+convertCMYK8Image = pixelMap convert
+  where
+  clampWord8 = fromIntegral . max 0 . min 255 . (`div` 256)
+  convert (PixelCMYK8 c m y k) =
+      PixelRGBA8 (clampWord8 r) (clampWord8 g) (clampWord8 b) k
+    where
+    ik :: Int
+    ik = fromIntegral k
+    r = fromIntegral y * ik
+    g = fromIntegral m * ik
+    b = fromIntegral c * ik
+
+toBlpCMYK8 :: Image PixelRGBA8 -> Image PixelCMYK8
+toBlpCMYK8 = pixelMap convert
+  where
+  clampWord8 = fromIntegral . max 0 . min 255
+  convert (PixelRGBA8 r g b a) = PixelCMYK8 (clampWord8 c) (clampWord8 m) (clampWord8 y) a
+    where
+    ik = fromIntegral a :: Double
+    c, m, y :: Int
+    c = round $ 256 * fromIntegral b / ik
+    m = round $ 256 * fromIntegral g / ik
+    y = round $ 256 * fromIntegral r / ik
+
+toBlpRGBA8 :: Image PixelRGBA8 -> Image PixelRGBA8
+toBlpRGBA8 = pixelMap convert
+  where
+  convert (PixelRGBA8 r g b a) = PixelRGBA8 b g r a
+
+toBlpRGB8 :: Image PixelRGB8 -> Image PixelRGBA8
+toBlpRGB8 = pixelMap convert
+  where
+  convert (PixelRGB8 r g b) = PixelRGBA8 b g r 0
+
+convertCMYK16Image :: Image PixelCMYK16 -> Image PixelRGBA16
+convertCMYK16Image = pixelMap convert
+  where
+  convert (PixelCMYK16 c m y k) =
+      PixelRGBA16 (clampWord16 r) (clampWord16 g) (clampWord16 b) 65535
+    where
+    clampWord16 = fromIntegral . max 0 . min 65535 . (`div` 65535)
+
+    ik :: Int
+    ik = fromIntegral k
+    r = fromIntegral y * ik
+    g = fromIntegral m * ik
+    b = fromIntegral c * ik
diff --git a/src/Codec/Picture/Blp/Internal/Data.hs b/src/Codec/Picture/Blp/Internal/Data.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Picture/Blp/Internal/Data.hs
@@ -0,0 +1,124 @@
+module Codec.Picture.Blp.Internal.Data(
+    BlpStruct(..)
+  , BlpCompression(..)
+  , BlpFlag(..)
+  , BlpPictureType(..)
+  , BlpExt(..)
+  ) where
+
+import Codec.Picture
+import Data.Bifunctor
+import Data.ByteString (ByteString)
+import Data.Hashable
+import Data.Monoid
+import Data.Vector (Vector)
+import Data.Word
+import GHC.Generics
+import TextShow
+
+import qualified Data.ByteString as BS
+import qualified Data.Vector as V
+
+data BlpStruct = BlpStruct {
+  blpCompression :: !BlpCompression
+, blpFlags :: ![BlpFlag]
+, blpWidth :: !Word32
+, blpHeight :: !Word32
+, blpPictureType :: !BlpPictureType
+, blpPictureSubType :: !Word32 -- is not used
+, blpExt :: BlpExt
+} deriving (Show, Generic)
+
+instance TextShow BlpStruct where
+  showb BlpStruct{..} = "BlpStruct {\n"
+    <> "  blpCompression = " <> showb blpCompression <> "\n"
+    <> ", blpFlags = " <> showb blpFlags <> "\n"
+    <> ", blpWidth = " <> showb blpWidth <> "\n"
+    <> ", blpHeight = " <> showb blpHeight <> "\n"
+    <> ", blpPictureType = " <> showb blpPictureType <> "\n"
+    <> ", blpPictureSubType = " <> showb blpPictureSubType <> "\n"
+    <> ", blpExt = " <> showb blpExt <> "\n"
+    <> "}"
+
+data BlpExt =
+    BlpJpeg {
+      blpJpegHeader :: !ByteString
+    , blpJpegData :: ![ByteString]
+    }
+  | BlpUncompressed1 {
+      blpU1Palette :: !(Vector PixelRGBA8)
+    , blpU1MipMaps :: ![(ByteString, ByteString)]
+    }
+  | BlpUncompressed2 {
+      blpU2Palette :: !(Vector PixelRGBA8)
+    , blpU2MipMaps :: ![ByteString]
+    }
+  deriving (Show, Generic)
+
+-- | Helper to display bytestring as placeholder with length
+showBinary :: ByteString -> Builder
+showBinary v = "<bslength " <> tl v <> ">"
+  where
+    tl = showb . BS.length
+
+-- | Helper to display bytestring as placeholder with length
+showVector :: Vector a -> Builder
+showVector v = "<veclength " <> tl v <> ">"
+  where
+    tl = showb . V.length
+
+-- | Helper that works as Data.Text.intercalate
+intercalateb :: Builder -> [Builder] -> Builder
+intercalateb _ [] = mempty
+intercalateb _ [x] = x 
+intercalateb spacer (x:xs) = x <> spacer <> intercalateb spacer xs
+
+instance TextShow BlpExt where
+  showb v = case v of
+    BlpJpeg{..} -> "BlpJpeg { \n"
+      <> "  blpJpegHeader = " <> showBinary blpJpegHeader <> "\n"
+      <> ", blpJpegData = [" <> intercalateb ", " (fmap showBinary blpJpegData) <> "]\n"
+      <> "}"
+    BlpUncompressed1{..} -> "BlpUncompressed1 { \n"
+      <> "  blpU1Palette = " <> showVector blpU1Palette <> "\n"
+      <> ", blpU1MipMaps = [" <> intercalateb ", " ( (\(a, b) -> "(" <> showBinary a <> ", " <> showBinary b <> ")") <$> blpU1MipMaps) <> "]\n"
+      <> "}"
+    BlpUncompressed2{..} -> "BlpUncompressed2 { \n"
+      <> "  blpU2Palette = " <> showVector blpU2Palette <> "\n"
+      <> ", blpU2MipMaps = [" <> intercalateb ", " (fmap showBinary blpU2MipMaps) <> "]\n"
+      <> "}"
+
+data BlpCompression =
+    BlpCompressionJPEG
+  | BlpCompressionUncompressed
+  deriving (Eq, Ord, Enum, Bounded, Show, Generic)
+
+instance TextShow BlpCompression where
+  showb v = case v of
+    BlpCompressionJPEG -> "BlpCompressionJPEG"
+    BlpCompressionUncompressed -> "BlpCompressionUncompressed"
+
+instance Hashable BlpCompression
+
+data BlpFlag = BlpFlagAlphaChannel
+  deriving (Eq, Ord, Enum, Bounded, Show, Generic)
+
+instance TextShow BlpFlag where
+  showb v = case v of
+    BlpFlagAlphaChannel -> "BlpFlagAlphaChannel"
+
+instance Hashable BlpFlag
+
+data BlpPictureType =
+    JPEGType
+  | UncompressedWithAlpha
+  | UncompressedWithoutAlpha
+  deriving (Eq, Ord, Enum, Bounded, Show, Generic)
+
+instance TextShow BlpPictureType where
+  showb v = case v of
+    JPEGType -> "JPEGType"
+    UncompressedWithAlpha -> "UncompressedWithAlpha"
+    UncompressedWithoutAlpha -> "UncompressedWithoutAlpha"
+
+instance Hashable BlpPictureType
diff --git a/src/Codec/Picture/Blp/Internal/Encoder.hs b/src/Codec/Picture/Blp/Internal/Encoder.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Picture/Blp/Internal/Encoder.hs
@@ -0,0 +1,297 @@
+module Codec.Picture.Blp.Internal.Encoder(
+    encodeBlp
+  , blpEncoder
+  , createMipMaps
+  , createMipMapsIndexed
+  , scanHeader
+  , toBlpStruct
+  , toBlpExt
+  ) where
+
+import Codec.Picture
+import Codec.Picture.ColorQuant
+import Codec.Picture.Jpg
+import Codec.Picture.Types
+import Data.Binary.Put
+import Data.Bits
+import Data.ByteString.Lazy (ByteString, toStrict)
+import Data.Foldable (traverse_)
+import Data.Maybe
+import Data.Monoid
+import Data.Word
+import Foreign
+import System.IO.Unsafe (unsafePerformIO)
+
+import qualified Codec.Picture.Metadata as CM
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BS
+import qualified Data.Foldable as F
+import qualified Data.Vector as V
+import qualified Data.Vector.Storable as VS
+
+import Codec.Picture.Blp.Internal.Convert
+import Codec.Picture.Blp.Internal.Data
+
+-- | Convert spare BLP structure into compact stream of bytes
+encodeBlp :: Int -> BlpStruct -> ByteString
+encodeBlp numMips = runPut . blpEncoder numMips
+
+-- | Raw encoder for BLP
+blpEncoder :: Int -> BlpStruct -> Put
+blpEncoder numMips BlpStruct{..} = do
+  putBlpVersion
+  putCompression
+  putFlags
+  putWidth
+  putHeight
+  putPictureType
+  putPictureSubType
+  putMipMapOffsets
+  putMipMapSizes
+  putBlpExt
+  where
+    putBlpVersion = putByteString "BLP1"
+    putCompression = putWord32le $ case blpCompression of
+      BlpCompressionJPEG -> 0
+      BlpCompressionUncompressed -> 1
+    putFlags = let
+      addFlag acc flag = (acc +) $ case flag of
+         BlpFlagAlphaChannel -> 1 `shiftL` 3
+      in putWord32le $ F.foldl' addFlag 0 blpFlags
+    putWidth = putWord32le blpWidth
+    putHeight = putWord32le blpHeight
+    putPictureType = putWord32le $ case blpPictureType of
+      JPEGType -> 2
+      UncompressedWithAlpha -> 3
+      -- UncompressedWithAlpha -> 4
+      UncompressedWithoutAlpha -> 5
+    putPictureSubType = putWord32le blpPictureSubType
+    headerSize = 4 -- BLP1
+      + 4 -- Compression
+      + 4 -- Flags
+      + 4 -- Width
+      + 4 -- Height
+      + 4 -- Picture type
+      + 4 -- Picture subtype
+      + 16 * 4 -- Mipmaps offsets
+      + 16 * 4 -- Mipmaps sizes
+    mipmaps = let
+      mkOffsetSize :: BS.ByteString -> (Int, [(Word32, Word32)]) ->  (Int, [(Word32, Word32)])
+      mkOffsetSize bs (!offset, !acc) = (offset + BS.length bs, (fromIntegral offset, fromIntegral $ BS.length bs) : acc)
+      uncomprStartOffset = headerSize + 4 * 256
+      in reverse . snd $ case blpExt of
+        BlpJpeg{..} -> let
+          startOffset = headerSize + 4 + BS.length blpJpegHeader
+          in F.foldr' mkOffsetSize (startOffset, []) $ reverse blpJpegData
+        BlpUncompressed1{..} -> let
+          mkOffsetSizeU (indbs, alpbs) (!offset, !acc) = (offset + BS.length indbs + BS.length alpbs, (fromIntegral offset, fromIntegral $ BS.length indbs + BS.length alpbs) : acc)
+          in F.foldr' mkOffsetSizeU (uncomprStartOffset, []) $ reverse blpU1MipMaps
+        BlpUncompressed2{..} -> F.foldr' mkOffsetSize (uncomprStartOffset, []) $ reverse blpU2MipMaps
+    ensureLength _ [] = []
+    ensureLength n xs = if length xs < n
+      then xs ++ replicate (n - length xs) (last xs)
+      else take n xs
+    ensureLengthV n a xs = if V.length xs < n then xs <> V.replicate (n - V.length xs) a else V.take n xs
+    putMipMapOffsets = traverse_ putWord32le . ensureLength 16 . take numMips . fmap fst $ mipmaps
+    putMipMapSizes = traverse_ putWord32le . ensureLength 16 . take numMips . fmap snd $ mipmaps
+    putRgba8 (PixelRGBA8 r g b a) = putWord8 r >> putWord8 g >> putWord8 b >> putWord8 a
+    putBlpExt = case blpExt of -- TODO: check sync of compression flag and BlpExt
+       BlpJpeg{..} -> do
+         putWord32le $ fromIntegral $ BS.length blpJpegHeader
+         putByteString blpJpegHeader
+         traverse_ putByteString $ take numMips blpJpegData
+       BlpUncompressed1{..} -> do
+         traverse_ putRgba8 . ensureLengthV 256 (PixelRGBA8 0 0 0 0) $ blpU1Palette
+         traverse_ (\(indbs, alpbs) -> putByteString indbs >> putByteString alpbs) $ take numMips blpU1MipMaps
+       BlpUncompressed2{..} -> do
+         traverse_ putRgba8 . ensureLengthV 256 (PixelRGBA8 0 0 0 0) $ blpU2Palette
+         traverse_ putByteString $ take numMips blpU2MipMaps
+
+-- | Return 'True' if given picture format has alpha channel
+hasAlpha :: DynamicImage -> Bool
+hasAlpha img = case img of
+  ImageYA8 _ -> True
+  ImageYA16 _ -> True
+  ImageRGBA8 _ -> True
+  ImageRGBA16 _ -> True
+  _ -> False
+
+-- | Convert to BLP structure some image with given BLP options and quality (for JPEG compression)
+toBlpStruct :: BlpCompression -> Int -> Int -> DynamicImage -> BlpStruct
+toBlpStruct compression quality numMips img = BlpStruct {
+    blpCompression = compression
+  , blpFlags = if hasAlpha img
+      then [BlpFlagAlphaChannel]
+      else []
+  , blpWidth = fromIntegral $ dynamicMap imageWidth img
+  , blpHeight = fromIntegral $ dynamicMap imageHeight img
+  , blpPictureType = pictype
+  , blpPictureSubType = 5 -- world edit use this for war3mapMap.blp
+  , blpExt = toBlpExt compression pictype quality numMips img'
+  }
+  where
+    pictype = if hasAlpha img
+      then UncompressedWithAlpha
+      else UncompressedWithoutAlpha
+    img' = convertRGBA8 img
+
+-- | Take only first N mipmaps in list, fill rest with last non-fake mipmap
+fakeMipMaps :: Int -- ^ How much true values to preserve (if <= 0, the function does nothing)
+  -> [a] -- ^ List of mimpaps
+  -> [a] -- ^ Result with fakes
+fakeMipMaps = go Nothing
+  where
+    go mprev n xs
+      | n <= 0 = case mprev of
+        Nothing -> xs
+        Just v -> case xs of
+          [] -> []
+          _ : xs' -> v : go (Just v) 0 xs'
+      | otherwise = case xs of
+        [] -> []
+        x : xs' -> x : go (Just x) (n-1) xs'
+
+-- | Scale image to form the sequence of mipmaps. The first element is always the original picture.
+--
+-- The scale procedure assumes that original image has power of 2 sides, that allows to simply pick
+-- average of 4 pixels.
+createMipMaps :: Image PixelRGBA8 -> [Image PixelRGBA8]
+createMipMaps img = img : go img
+  where
+    avg' v1 v2 v3 v4 = let
+      v = fromIntegral v1 + fromIntegral v2 + fromIntegral v3 + fromIntegral v4 :: Double
+      in round $ v / 4
+    avg i x y = let
+      PixelRGBA8 p00r p00g p00b p00a = pixelAt i (x*2) (y*2)
+      PixelRGBA8 p10r p10g p10b p10a = pixelAt i (x*2 + 1) (y*2)
+      PixelRGBA8 p01r p01g p01b p01a = pixelAt i (x*2) (y*2 + 1)
+      PixelRGBA8 p11r p11g p11b p11a = pixelAt i (x*2 + 1) (y*2 + 1)
+      in PixelRGBA8 (avg' p00r p10r p01r p11r) (avg' p00g p10g p01g p11g) (avg' p00b p10b p01b p11b) (avg' p00a p10a p01a p11a)
+    power2Scale i = generateImage (avg i) (downgrade $ imageWidth i) (downgrade $ imageHeight i)
+    downgrade v = max 1 $ v `div` 2
+    go i | imageWidth i <= 1 && imageHeight i <= 1 = []
+         | otherwise = let i' = power2Scale i in i' : go i'
+
+-- | Scale image to form the sequence of mipmaps. The first element is always the original picture.
+--
+-- The scale procedure assumes that original image has power of 2 sides, that allows to simply pick
+-- 1 of 4 pixels.
+createMipMapsIndexed :: Pixel a => Image a -> [Image a]
+createMipMapsIndexed img = img : go img
+  where
+    power2Scale i = generateImage (\x y -> pixelAt i (x*2) (y*2)) (downgrade $ imageWidth i) (downgrade $ imageHeight i)
+    downgrade v = max 1 $ v `div` 2
+    go i | imageWidth i <= 1 && imageHeight i <= 1 = []
+         | otherwise = let i' = power2Scale i in i' : go i'
+
+-- | Convert picture to BLP payload
+toBlpExt :: BlpCompression -> BlpPictureType -> Int -> Int -> Image PixelRGBA8 -> BlpExt
+toBlpExt compr pictype quality numMips img = case compr of
+  BlpCompressionJPEG -> toBlpJpg (fromIntegral quality) numMips hasAlpha img
+  BlpCompressionUncompressed -> case pictype of
+    UncompressedWithAlpha -> toBlpUncompressed1 numMips img
+    UncompressedWithoutAlpha -> toBlpUncompressed2 numMips img
+    JPEGType -> toBlpUncompressed2 numMips img -- Consider this as without alpha
+  where
+    hasAlpha = case pictype of
+      UncompressedWithAlpha -> True
+      _ -> False
+
+-- | Convert picture to BLP JPEG and create mipmaps
+toBlpJpg :: Word8 -> Int -> Bool -> Image PixelRGBA8 -> BlpExt
+toBlpJpg quality numMips hasAlpha img = BlpJpeg {
+    blpJpegHeader = header
+  , blpJpegData = mipmapsRawWithoutHeader
+  }
+  where
+    processAlpha :: Image PixelRGBA8 -> Image PixelRGBA8
+    processAlpha = pixelMap $ \p@(PixelRGBA8 r g b a) -> if hasAlpha then p else PixelRGBA8 r g b 255
+
+    mipmaps :: [Image PixelCMYK8]
+    mipmaps = toBlpCMYK8 <$> (fakeMipMaps numMips . createMipMaps . processAlpha $ img)
+
+    metadata :: CM.Metadatas
+    metadata = CM.insert (CM.Unknown "JPEG Quality") (CM.Int $ fromIntegral quality) mempty
+
+    mipmapsRaw :: [BS.ByteString]
+    mipmapsRaw = toStrict . encodeDirectJpegAtQualityWithMetadata quality metadata <$> mipmaps
+
+    header :: BS.ByteString
+    header = scanHeader 624 mipmapsRaw
+
+    mipmapsRawWithoutHeader :: [BS.ByteString]
+    mipmapsRawWithoutHeader = BS.drop (BS.length header) <$> mipmapsRaw
+
+-- | Manually scan shared prefix of each mipmap
+scanHeader :: Int -> [BS.ByteString] -> BS.ByteString
+scanHeader _ [] = mempty
+scanHeader maxheader [x] = BS.take maxheader x
+scanHeader maxheader mipmaps = go mipmaps mempty
+  where
+    go !mps !acc = let
+      unconses = BS.uncons <$> mps :: [Maybe (Word8, BS.ByteString)]
+      heads = fmap fst <$> unconses :: [Maybe Word8]
+      tails = catMaybes $ fmap snd <$> unconses :: [BS.ByteString]
+      hitEmpty = any isNothing heads
+      firstByte = case heads of
+        (Just v : _) -> v
+        _ -> 0
+      allEqual = all (Just firstByte ==) heads
+      in if | hitEmpty -> acc
+            | maxheader >= BS.length acc -> acc
+            | allEqual -> go tails (acc `BS.snoc` firstByte)
+            | otherwise -> acc
+
+-- | Helper to quantise colors to 256 colour pallete
+makePallette :: Image PixelRGBA8 -> (Image Pixel8, Palette)
+makePallette = palettize defaultPaletteOptions . pixelMap dropTransparency
+
+instance Storable PixelRGBA8 where
+  sizeOf _ = sizeOf (undefined :: Word32)
+  alignment _ = alignment (undefined :: Word32)
+  peek ptr = unpackPixel <$> peek (castPtr ptr :: Ptr Word32)
+  poke ptr px = poke (castPtr ptr :: Ptr Word32) . packPixel $ px
+
+-- | Convert palette to format that we need for BLP
+convertPalette :: Palette -> V.Vector PixelRGBA8
+convertPalette = V.convert . VS.unsafeCast . imageData . pixelMap ((\(PixelRGBA8 r g b a) -> PixelRGBA8 b g r a) . promotePixel :: PixelRGB8 -> PixelRGBA8)
+
+-- | Convert indexed image to raw bytestring
+convertIndexed :: Image Pixel8 -> BS.ByteString
+convertIndexed img = let
+  (fptr, l) = VS.unsafeToForeignPtr0 . imageData $ img
+  in unsafePerformIO $ withForeignPtr fptr $ \ptr -> BS.unsafePackCStringLen (castPtr ptr, l)
+
+-- | Convert picture to BLP uncompressed with alpha and create mipmaps
+toBlpUncompressed1 :: Int -> Image PixelRGBA8 -> BlpExt
+toBlpUncompressed1 numMips img =  BlpUncompressed1 {
+    blpU1Palette = convertPalette palette
+  , blpU1MipMaps = fmap convertIndexed mipmaps `zip` fmap convertIndexed alphaMaps
+  }
+  where
+    img'    :: Image Pixel8
+    palette :: Palette
+    (img', palette) = makePallette img
+
+    alphaImg :: Image Pixel8
+    alphaImg = extractComponent PlaneAlpha img
+
+    mipmaps :: [Image Pixel8]
+    mipmaps = fakeMipMaps numMips $ createMipMapsIndexed img'
+
+    alphaMaps :: [Image Pixel8]
+    alphaMaps = fakeMipMaps numMips $ createMipMapsIndexed alphaImg
+
+-- | Convert picture to BLP uncompressed without alpha and create mipmaps
+toBlpUncompressed2 :: Int -> Image PixelRGBA8 -> BlpExt
+toBlpUncompressed2 numMips img = BlpUncompressed2 {
+    blpU2Palette = convertPalette palette
+  , blpU2MipMaps = convertIndexed <$> mipmaps
+  }
+  where
+    img'    :: Image Pixel8
+    palette :: Palette
+    (img', palette) = makePallette img
+
+    mipmaps :: [Image Pixel8]
+    mipmaps = fakeMipMaps numMips $ createMipMapsIndexed img'
diff --git a/src/Codec/Picture/Blp/Internal/Parser.hs b/src/Codec/Picture/Blp/Internal/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Codec/Picture/Blp/Internal/Parser.hs
@@ -0,0 +1,128 @@
+module Codec.Picture.Blp.Internal.Parser(
+    blpParser
+  , blpVersion
+  , dword
+  , compressionParser
+  , flagsParser
+  , pictureTypeParser
+  , blpJpegParser
+  , getPos
+  , skipToOffset
+  , blpUncompressed1Parser
+  , blpUncompressed2Parser
+  , parseBlp
+  ) where
+
+import Codec.Picture
+import Control.Monad
+import Data.Attoparsec.ByteString as AT
+import Data.Bits
+import Data.ByteString (ByteString)
+import Data.List (nub)
+import Data.Word
+
+import qualified Data.Vector as V
+import qualified Data.Attoparsec.Internal.Types as AT
+import qualified Data.ByteString as BS
+
+import Codec.Picture.Blp.Internal.Data
+
+blpParser :: Parser BlpStruct
+blpParser = do
+  _ <- blpVersion
+  blpCompression <- compressionParser
+  blpFlags <- flagsParser
+  blpWidth <- dword <?> "width"
+  blpHeight <- dword <?> "height"
+  blpPictureType <- pictureTypeParser
+  blpPictureSubType <- dword <?> "picture subtype"
+  blpMipMapOffset <- replicateM 16 dword <?> "mipmaps offsets"
+  blpMipMapSize <- replicateM 16 dword <?> "mipmaps sizes"
+  let mipMapsInfo = nub . filter ((> 0) . snd) $ blpMipMapOffset `zip` blpMipMapSize
+  blpExt <- case blpCompression of
+    BlpCompressionJPEG -> blpJpegParser mipMapsInfo
+    BlpCompressionUncompressed -> case blpPictureType of
+      JPEGType -> fail "JPEG type with Uncompressed type mix"
+      UncompressedWithAlpha -> blpUncompressed1Parser mipMapsInfo
+      UncompressedWithoutAlpha -> blpUncompressed2Parser mipMapsInfo
+
+  return $ BlpStruct {..}
+
+blpVersion :: Parser ByteString
+blpVersion = string "BLP1" <?> "BLP1 version tag"
+
+dword :: Parser Word32
+dword = do
+  bs <- AT.take 4
+  return . pack . BS.reverse $ bs
+  where
+  pack = BS.foldl' (\n h -> (n `shiftL` 8) .|. fromIntegral h) 0
+
+rgba8 :: Parser PixelRGBA8
+rgba8 = PixelRGBA8 <$> anyWord8 <*> anyWord8 <*> anyWord8 <*> anyWord8
+
+compressionParser :: Parser BlpCompression
+compressionParser = (<?> "compression") $ do
+  i <- dword
+  case i of
+    0 -> return BlpCompressionJPEG
+    1 -> return BlpCompressionUncompressed
+    _ -> fail $ "Unknown compression " ++ show i
+
+flagsParser :: Parser [BlpFlag]
+flagsParser = (<?> "flags") $ do
+  i <- dword
+  return $ if i `testBit` 3
+    then [BlpFlagAlphaChannel]
+    else []
+
+pictureTypeParser :: Parser BlpPictureType
+pictureTypeParser = (<?> "picture type") $ do
+  i <- dword
+  case i of
+    2 -> return JPEGType
+    3 -> return UncompressedWithAlpha
+    4 -> return UncompressedWithAlpha
+    5 -> return UncompressedWithoutAlpha
+    _ -> fail $ "Unknown picture type " ++ show i
+
+blpJpegParser :: [(Word32, Word32)] -> Parser BlpExt
+blpJpegParser mps = (<?> "blp jpeg") $ do
+  headerSize <- dword <?> "jpeg header size"
+  blpJpegHeader <- AT.take (fromIntegral headerSize) <?> "jpeg header"
+  blpJpegData <- forM mps $ \(offset, size) -> do
+    skipToOffset offset
+    AT.take $ fromIntegral size
+  return $ BlpJpeg {..}
+
+getPos :: Parser Int
+getPos = AT.Parser $ \t pos more _ succ' -> succ' t pos more (AT.fromPos pos)
+
+skipToOffset :: Word32 -> Parser ()
+skipToOffset i = do
+  pos <- getPos
+  let diff = fromIntegral i - pos
+  if diff <= 0 then return ()
+    else void $ AT.take diff
+
+blpUncompressed1Parser :: [(Word32, Word32)] -> Parser BlpExt
+blpUncompressed1Parser mps = do
+  blpU1Palette <- V.replicateM 256 rgba8
+  blpU1MipMaps <- forM mps $ \(offset, size) -> do
+    skipToOffset offset
+    let halfSize = fromIntegral size `div` 2
+    indexList <- AT.take halfSize <?> "index list"
+    alphaList <- AT.take halfSize <?> "alpha list"
+    return (indexList, alphaList)
+  return $ BlpUncompressed1 {..}
+
+blpUncompressed2Parser :: [(Word32, Word32)] -> Parser BlpExt
+blpUncompressed2Parser mps = do
+  blpU2Palette <- V.replicateM 256 rgba8
+  blpU2MipMaps <- forM mps $ \(offset, size) -> do
+    skipToOffset offset
+    AT.take (fromIntegral size) <?> "index list"
+  return $ BlpUncompressed2 {..}
+
+parseBlp :: ByteString -> Either String BlpStruct
+parseBlp = parseOnly blpParser