-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Codec/Picture/STBIR.chs" #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Codec.Picture.STBIR
( -- * Resize function
  resize
  -- * Options
, Options(..)
, defaultOptions
, Flag
, flag_ALPHA_PREMULTIPLIED
, flag_ALPHA_USES_COLORSPACE
, Edge(..)
, Filter(..)
, Colorspace(..)
, Scale(..)
, Region(..)
  -- * Supported pixel types
, STBIRPixel(..)
, STBIRComponent(..)
, Datatype(..)
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Foreign
import Foreign.C
import Codec.Picture
import Codec.Picture.Types
import qualified Data.Vector.Storable as V
import System.IO.Unsafe (unsafePerformIO)
import Data.Default.Class (Default(..))



newtype Flag = Flag { fromFlag :: CInt }
  deriving (Eq, Ord, Show, Read)

{- |
Set this flag if your texture has premultiplied alpha. Otherwise, `stbir` will
use alpha-weighted resampling (effectively premultiplying, resampling,
then unpremultiplying).
-}
flag_ALPHA_PREMULTIPLIED :: Flag
flag_ALPHA_PREMULTIPLIED = Flag 1 -- c2hs const has problems due to <<

{- |
The specified alpha channel should be handled as gamma-corrected value even
when doing sRGB operations.
-}
flag_ALPHA_USES_COLORSPACE :: Flag
flag_ALPHA_USES_COLORSPACE = Flag 2

data Edge = EDGE_CLAMP
          | EDGE_REFLECT
          | EDGE_WRAP
          | EDGE_ZERO
  deriving (Eq,Ord,Show,Read,Bounded)
instance Enum Edge where
  succ EDGE_CLAMP = EDGE_REFLECT
  succ EDGE_REFLECT = EDGE_WRAP
  succ EDGE_WRAP = EDGE_ZERO
  succ EDGE_ZERO = error "Edge.succ: EDGE_ZERO has no successor"

  pred EDGE_REFLECT = EDGE_CLAMP
  pred EDGE_WRAP = EDGE_REFLECT
  pred EDGE_ZERO = EDGE_WRAP
  pred EDGE_CLAMP = error "Edge.pred: EDGE_CLAMP has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from EDGE_ZERO

  fromEnum EDGE_CLAMP = 1
  fromEnum EDGE_REFLECT = 2
  fromEnum EDGE_WRAP = 3
  fromEnum EDGE_ZERO = 4

  toEnum 1 = EDGE_CLAMP
  toEnum 2 = EDGE_REFLECT
  toEnum 3 = EDGE_WRAP
  toEnum 4 = EDGE_ZERO
  toEnum unmatched = error ("Edge.toEnum: Cannot match " ++ show unmatched)

{-# LINE 55 "src/Codec/Picture/STBIR.chs" #-}


data Filter
  = FILTER_DEFAULT      -- ^ use same filter type that easy-to-use API chooses
  | FILTER_BOX          -- ^ A trapezoid w/1-pixel wide ramps, same result as box for integer scale ratios
  | FILTER_TRIANGLE     -- ^ On upsampling, produces same results as bilinear texture filtering
  | FILTER_CUBICBSPLINE -- ^ The cubic b-spline (aka Mitchell-Netrevalli with B=1,C=0), gaussian-esque
  | FILTER_CATMULLROM   -- ^ An interpolating cubic spline
  | FILTER_MITCHELL     -- ^ Mitchell-Netrevalli filter with B=1\/3, C=1\/3
  deriving (Eq, Ord, Show, Read, Enum, Bounded)

-- the separate types here are because c2hs doesn't let me insert haddocks
data C_Filter = STBIR_FILTER_DEFAULT
              | STBIR_FILTER_BOX
              | STBIR_FILTER_TRIANGLE
              | STBIR_FILTER_CUBICBSPLINE
              | STBIR_FILTER_CATMULLROM
              | STBIR_FILTER_MITCHELL
  deriving (Eq,Ord,Show,Read,Bounded)
instance Enum C_Filter where
  succ STBIR_FILTER_DEFAULT = STBIR_FILTER_BOX
  succ STBIR_FILTER_BOX = STBIR_FILTER_TRIANGLE
  succ STBIR_FILTER_TRIANGLE = STBIR_FILTER_CUBICBSPLINE
  succ STBIR_FILTER_CUBICBSPLINE = STBIR_FILTER_CATMULLROM
  succ STBIR_FILTER_CATMULLROM = STBIR_FILTER_MITCHELL
  succ STBIR_FILTER_MITCHELL = error "C_Filter.succ: STBIR_FILTER_MITCHELL has no successor"

  pred STBIR_FILTER_BOX = STBIR_FILTER_DEFAULT
  pred STBIR_FILTER_TRIANGLE = STBIR_FILTER_BOX
  pred STBIR_FILTER_CUBICBSPLINE = STBIR_FILTER_TRIANGLE
  pred STBIR_FILTER_CATMULLROM = STBIR_FILTER_CUBICBSPLINE
  pred STBIR_FILTER_MITCHELL = STBIR_FILTER_CATMULLROM
  pred STBIR_FILTER_DEFAULT = error "C_Filter.pred: STBIR_FILTER_DEFAULT has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from STBIR_FILTER_MITCHELL

  fromEnum STBIR_FILTER_DEFAULT = 0
  fromEnum STBIR_FILTER_BOX = 1
  fromEnum STBIR_FILTER_TRIANGLE = 2
  fromEnum STBIR_FILTER_CUBICBSPLINE = 3
  fromEnum STBIR_FILTER_CATMULLROM = 4
  fromEnum STBIR_FILTER_MITCHELL = 5

  toEnum 0 = STBIR_FILTER_DEFAULT
  toEnum 1 = STBIR_FILTER_BOX
  toEnum 2 = STBIR_FILTER_TRIANGLE
  toEnum 3 = STBIR_FILTER_CUBICBSPLINE
  toEnum 4 = STBIR_FILTER_CATMULLROM
  toEnum 5 = STBIR_FILTER_MITCHELL
  toEnum unmatched = error ("C_Filter.toEnum: Cannot match " ++ show unmatched)

{-# LINE 69 "src/Codec/Picture/STBIR.chs" #-}


cFilter :: Filter -> CInt
cFilter FILTER_DEFAULT      = fromIntegral $ fromEnum STBIR_FILTER_DEFAULT
cFilter FILTER_BOX          = fromIntegral $ fromEnum STBIR_FILTER_BOX
cFilter FILTER_TRIANGLE     = fromIntegral $ fromEnum STBIR_FILTER_TRIANGLE
cFilter FILTER_CUBICBSPLINE = fromIntegral $ fromEnum STBIR_FILTER_CUBICBSPLINE
cFilter FILTER_CATMULLROM   = fromIntegral $ fromEnum STBIR_FILTER_CATMULLROM
cFilter FILTER_MITCHELL     = fromIntegral $ fromEnum STBIR_FILTER_MITCHELL

data Colorspace = COLORSPACE_LINEAR
                | COLORSPACE_SRGB
  deriving (Enum,Eq,Ord,Show,Read,Bounded)

{-# LINE 83 "src/Codec/Picture/STBIR.chs" #-}


data Datatype = TYPE_UINT8
              | TYPE_UINT16
              | TYPE_UINT32
              | TYPE_FLOAT
  deriving (Enum)

{-# LINE 88 "src/Codec/Picture/STBIR.chs" #-}


-- | Specify scale explicitly for subpixel correctness
data Scale = Scale
  { x_scale :: Float
  , y_scale :: Float
  , x_offset :: Float
  , y_offset :: Float
  } deriving (Eq, Ord, Show, Read)

-- | Specify image source tile using texture coordinates
data Region = Region
  { region_s0 :: Float -- ^ x of top-left corner from 0 to 1
  , region_t0 :: Float -- ^ y of top-left corner from 0 to 1
  , region_s1 :: Float -- ^ x of bottom-right corner from 0 to 1
  , region_t1 :: Float -- ^ y of bottom-right corner from 0 to 1
  } deriving (Eq, Ord, Show, Read)

data Options = Options
  { flags :: [Flag]
  , edgeModeHorizontal :: Edge
  , edgeModeVertical :: Edge
  , filterHorizontal :: Filter
  , filterVertical :: Filter
  , colorspace :: Colorspace
  , transform :: Either Scale Region
  } deriving (Eq, Ord, Show, Read)

-- | These are the options that correspond to the \"Easy-to-use API\".
defaultOptions :: Options
defaultOptions = Options
  { flags = []
  , edgeModeHorizontal = EDGE_CLAMP
  , edgeModeVertical = EDGE_CLAMP
  , filterHorizontal = FILTER_DEFAULT
  , filterVertical = FILTER_DEFAULT
  , colorspace = COLORSPACE_LINEAR
  , transform = Right $ Region 0 0 1 1
  }

instance Default Options where
  def = defaultOptions

class STBIRComponent a where
  stbirType :: a -> Datatype
instance STBIRComponent Word8  where stbirType _ = TYPE_UINT8
instance STBIRComponent Word16 where stbirType _ = TYPE_UINT16
instance STBIRComponent Word32 where stbirType _ = TYPE_UINT32
instance STBIRComponent Float  where stbirType _ = TYPE_FLOAT

noAlpha :: CInt
noAlpha = -1
{-# LINE 139 "src/Codec/Picture/STBIR.chs" #-}


-- | All types currently covered by JP's 'Pixel' are supported.
class (Pixel a, STBIRComponent (PixelBaseComponent a)) => STBIRPixel a where
  alphaIndex :: a -> Maybe Int
instance STBIRPixel PixelRGBA16  where alphaIndex _ = Just 3
instance STBIRPixel PixelRGBA8   where alphaIndex _ = Just 3
instance STBIRPixel PixelCMYK16  where alphaIndex _ = Nothing
instance STBIRPixel PixelCMYK8   where alphaIndex _ = Nothing
instance STBIRPixel PixelYCbCr8  where alphaIndex _ = Nothing
instance STBIRPixel PixelRGBF    where alphaIndex _ = Nothing
instance STBIRPixel PixelRGB16   where alphaIndex _ = Nothing
instance STBIRPixel PixelYCbCrK8 where alphaIndex _ = Nothing
instance STBIRPixel PixelRGB8    where alphaIndex _ = Nothing
instance STBIRPixel PixelYA16    where alphaIndex _ = Just 1
instance STBIRPixel PixelYA8     where alphaIndex _ = Just 1
instance STBIRPixel PixelF       where alphaIndex _ = Nothing
instance STBIRPixel Pixel32      where alphaIndex _ = Nothing
instance STBIRPixel Pixel16      where alphaIndex _ = Nothing
instance STBIRPixel Pixel8       where alphaIndex _ = Nothing

stbir_resize_subpixel :: (Ptr ()) -- ^ const void *input_pixels
 -> (CInt) -- ^ int input_w
 -> (CInt) -- ^ int input_h
 -> (CInt) -- ^ int input_stride_in_bytes
 -> (Ptr ()) -- ^ void *output_pixels
 -> (CInt) -- ^ int output_w
 -> (CInt) -- ^ int output_h
 -> (CInt) -- ^ int output_stride_in_bytes
 -> (Datatype) -- ^ stbir_datatype datatype
 -> (CInt) -- ^ int num_channels
 -> (CInt) -- ^ int alpha_channel
 -> (CInt) -- ^ int flags
 -> (Edge) -- ^ stbir_edge edge_mode_horizontal
 -> (Edge) -- ^ stbir_edge edge_mode_vertical
 -> (Filter) -- ^ stbir_filter filter_horizontal
 -> (Filter) -- ^ stbir_filter filter_vertical
 -> (Colorspace) -- ^ stbir_colorspace space
 -> (Ptr ()) -- ^ void *alloc_context
 -> (CFloat) -- ^ float x_scale
 -> (CFloat) -- ^ float y_scale
 -> (CFloat) -- ^ float x_offset
 -> (CFloat) -- ^ float y_offset
 -> IO ((CInt))
stbir_resize_subpixel a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = id a5} in 
  let {a6' = fromIntegral a6} in 
  let {a7' = fromIntegral a7} in 
  let {a8' = fromIntegral a8} in 
  let {a9' = (fromIntegral . fromEnum) a9} in 
  let {a10' = fromIntegral a10} in 
  let {a11' = fromIntegral a11} in 
  let {a12' = fromIntegral a12} in 
  let {a13' = (fromIntegral . fromEnum) a13} in 
  let {a14' = (fromIntegral . fromEnum) a14} in 
  let {a15' = cFilter a15} in 
  let {a16' = cFilter a16} in 
  let {a17' = (fromIntegral . fromEnum) a17} in 
  let {a18' = id a18} in 
  let {a19' = realToFrac a19} in 
  let {a20' = realToFrac a20} in 
  let {a21' = realToFrac a21} in 
  let {a22' = realToFrac a22} in 
  stbir_resize_subpixel'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' a16' a17' a18' a19' a20' a21' a22' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 184 "src/Codec/Picture/STBIR.chs" #-}


stbir_resize_region :: (Ptr ()) -- ^ const void *input_pixels
 -> (CInt) -- ^ int input_w
 -> (CInt) -- ^ int input_h
 -> (CInt) -- ^ int input_stride_in_bytes
 -> (Ptr ()) -- ^ void *output_pixels
 -> (CInt) -- ^ int output_w
 -> (CInt) -- ^ int output_h
 -> (CInt) -- ^ int output_stride_in_bytes
 -> (Datatype) -- ^ stbir_datatype datatype
 -> (CInt) -- ^ int num_channels
 -> (CInt) -- ^ int alpha_channel
 -> (CInt) -- ^ int flags
 -> (Edge) -- ^ stbir_edge edge_mode_horizontal
 -> (Edge) -- ^ stbir_edge edge_mode_vertical
 -> (Filter) -- ^ stbir_filter filter_horizontal
 -> (Filter) -- ^ stbir_filter filter_vertical
 -> (Colorspace) -- ^ stbir_colorspace space
 -> (Ptr ()) -- ^ void *alloc_context
 -> (CFloat) -- ^ float s0
 -> (CFloat) -- ^ float t0
 -> (CFloat) -- ^ float s1
 -> (CFloat) -- ^ float t1
 -> IO ((CInt))
stbir_resize_region a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = id a5} in 
  let {a6' = fromIntegral a6} in 
  let {a7' = fromIntegral a7} in 
  let {a8' = fromIntegral a8} in 
  let {a9' = (fromIntegral . fromEnum) a9} in 
  let {a10' = fromIntegral a10} in 
  let {a11' = fromIntegral a11} in 
  let {a12' = fromIntegral a12} in 
  let {a13' = (fromIntegral . fromEnum) a13} in 
  let {a14' = (fromIntegral . fromEnum) a14} in 
  let {a15' = cFilter a15} in 
  let {a16' = cFilter a16} in 
  let {a17' = (fromIntegral . fromEnum) a17} in 
  let {a18' = id a18} in 
  let {a19' = realToFrac a19} in 
  let {a20' = realToFrac a20} in 
  let {a21' = realToFrac a21} in 
  let {a22' = realToFrac a22} in 
  stbir_resize_region'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' a16' a17' a18' a19' a20' a21' a22' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 210 "src/Codec/Picture/STBIR.chs" #-}


pixelProperty :: (a -> b) -> Image a -> b
pixelProperty f img = let
  getFakePixel :: Image a -> a
  getFakePixel = undefined
  in f $ getFakePixel img

-- | This function allows access to all \"API levels\" of the C library.
-- Pass 'defaultOptions' to use the easy API, or override whichever options
-- you need.
resize
  :: (STBIRPixel a)
  => Options
  -> Int -- ^ new width
  -> Int -- ^ new height
  -> Image a
  -> Image a
resize opts w' h' img@(Image w h v) = unsafePerformIO $ do
  V.unsafeWith v $ \p -> do
    let comps = pixelProperty componentCount img
    fp <- mallocForeignPtrArray $ w' * h' * comps
    let (cfun, f0, f1, f2, f3) = case transform opts of
          Left  (Scale  a b c d) -> (stbir_resize_subpixel, a, b, c, d)
          Right (Region a b c d) -> (stbir_resize_region  , a, b, c, d)
    res <- withForeignPtr fp $ \p' -> cfun
      (castPtr p)
      (fromIntegral w)
      (fromIntegral h)
      0
      (castPtr p')
      (fromIntegral w')
      (fromIntegral h')
      0
      (pixelProperty (stbirType . pixelOpacity) img)
      (fromIntegral comps)
      (maybe noAlpha fromIntegral $ pixelProperty alphaIndex img)
      (fromIntegral $ foldr (.|.) 0 $ map fromFlag $ flags opts)
      (edgeModeHorizontal opts)
      (edgeModeVertical opts)
      (filterHorizontal opts)
      (filterVertical opts)
      (colorspace opts)
      nullPtr
      (realToFrac f0)
      (realToFrac f1)
      (realToFrac f2)
      (realToFrac f3)
    if res == 0
      then error "Codec.Picture.STBIR.resize returned an error"
      else return $ Image w' h' $ V.unsafeFromForeignPtr0 fp $ w' * h' * comps

foreign import ccall safe "Codec/Picture/STBIR.chs.h stbir_resize_subpixel"
  stbir_resize_subpixel'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CInt)))))))))))))))))))))))

foreign import ccall safe "Codec/Picture/STBIR.chs.h stbir_resize_region"
  stbir_resize_region'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (C2HSImp.CFloat -> (IO C2HSImp.CInt)))))))))))))))))))))))