-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/ZBar/Foreign.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | See [zbar](http://zbar.sourceforge.net/index.html) documentation for how to use the C API.
module ZBar.Foreign ( -- * Types
                      ZbarColor (..)
                    , ZbarSymbolType (..)
                    , ZbarError (..)
                    , ZbarConfig (..)
                    -- * Type synonyms
                    , ZbarSymbolPtr
                    , ZbarSymbolSetPtr
                    , ZbarImagePtr
                    , ZbarProcessorPtr
                    , ZbarVideoPtr
                    , ZbarWindowPtr
                    , ZbarImageScannerPtr
                    , ZbarScannerPtr
                    , ZbarDecoderPtr
                    -- * Abstract Types
                    , ZbarSymbol
                    , ZbarSymbolSet
                    , ZbarImage
                    , ZbarProcessor
                    , ZbarVideo
                    , ZbarWindow
                    , ZbarImageScanner
                    , ZbarScanner
                    , ZbarDecoder
                    -- * Callback types
                    , ZbarImageCleanupHandlerT
                    , ZbarImageDataHandlerT
                    , ZbarDecoderHandlerT
                    -- * Callbacks
                    , mkCleanupCallback
                    , mkDataCallback
                    , mkDecoderCallback
                    -- * Functions
                    , zbarVersion
                    , zbarSetVerbosity
                    , zbarIncreaseVerbosity
                    , zbarGetSymbolName
                    , zbarGetAddonName
                    , zbarParseConfig
                    , zbarSymbolRef
                    , zbarSymbolGetType
                    , zbarSymbolGetData
                    , zbarSymbolGetDataLength
                    , zbarSymbolGetQuality
                    , zbarSymbolGetCount
                    , zbarSymbolGetLocSize
                    , zbarSymbolGetLocX
                    , zbarSymbolGetLocY
                    , zbarSymbolNext
                    , zbarSymbolGetComponents
                    , zbarSymbolFirstComponent
                    , zbarSymbolXml
                    , zbarSymbolSetRef
                    , zbarSymbolSetGetSize
                    , zbarSymbolSetFirstSymbol
                    , zbarImageCreate
                    , zbarImageDestroy
                    , zbarImageRef
                    , zbarImageConvert
                    , zbarImageConvertResize
                    , zbarImageGetFormat
                    , zbarImageGetSequence
                    , zbarImageGetWidth
                    , zbarImageGetHeight
                    , zbarImageGetData
                    , zbarImageGetDataLength
                    , zbarImageGetSymbols
                    , zbarImageSetSymbols
                    , zbarImageFirstSymbol
                    , zbarImageSetFormat
                    , zbarImageSetSequence
                    , zbarImageSetSize
                    , zbarImageSetData
                    , zbarImageFreeData
                    , zbarImageSetUserdata
                    , zbarImageGetUserdata
                    , zbarImageWrite
                    , zbarImageRead
                    , zbarProcessorCreate
                    , zbarProcessorDestroy
                    , zbarProcessorInit
                    , zbarProcessorRequestSize
                    , zbarProcessorRequestInterface
                    , zbarProcessorRequestIomode
                    , zbarProcessorForceFormat
                    , zbarProcessorSetDataHandler
                    , zbarProcessorSetUserdata
                    , zbarProcessorGetUserdata
                    , zbarProcessorSetConfig
                    , zbarProcessorParseConfig
                    , zbarProcessorIsVisible
                    , zbarProcessorSetVisible
                    , zbarProcessorSetActive
                    , zbarProcessorGetResults
                    , zbarProcessorUserWait
                    , zbarProcessOne
                    , zbarProcessImage
                    , zbarProcessorErrorSpew
                    , zbarProcessorErrorString
                    , zbarProcessorGetErrorCode
                    , zbarVideoCreate
                    , zbarVideoGetFd
                    , zbarVideoRequestSize
                    , zbarVideoRequestInterface
                    , zbarVideoRequestIomode
                    , zbarVideoGetWidth
                    , zbarVideoGetHeight
                    , zbarVideoInit
                    , zbarVideoEnable
                    , zbarVideoNextImage
                    , zbarVideoErrorSpew
                    , zbarVideoErrorString
                    , zbarVideoGetErrorCode
                    , zbarWindowCreate
                    , zbarWindowDestroy
                    , zbarWindowAttach
                    , zbarWindowGetOverlay
                    , zbarWindowSetOverlay
                    , zbarWindowDraw
                    , zbarWindowRedraw
                    , zbarWindowResize
                    , zbarWindowErrorSpew
                    , zbarWindowErrorString
                    , zbarWindowGetErrorCode
                    , zbarNegotiateFormat
                    , zbarImageScannerCreate
                    , zbarImageScannerDestroy
                    , zbarImageScannerSetDataHandler
                    , zbarImageScannerSetConfig
                    , zbarImageScannerParseConfig
                    , zbarImageScannerEnableCache
                    , zbarImageScannerRecycleImage
                    , zbarImageScannerGetResults
                    , zbarScanImage
                    , zbarDecoderCreate
                    , zbarDecoderDestroy
                    , zbarDecoderSetConfig
                    , zbarDecoderParseConfig
                    , zbarDecoderReset
                    , zbarDecoderNewScan
                    , zbarDecodeWidth
                    , zbarDecoderGetColor
                    , zbarDecoderGetData
                    , zbarDecoderGetDataLength
                    , zbarDecoderGetType
                    , zbarDecoderSetHandler
                    , zbarDecoderSetUserdata
                    , zbarDecoderGetUserdata
                    , zbarScannerCreate
                    , zbarScannerDestroy
                    , zbarScannerReset
                    , zbarScannerNewScan
                    , zbarScannerFlush
                    , zbarScanY
                    , zbarScanRgb24
                    , zbarScannerGetWidth
                    , zbarScannerGetEdge
                    , zbarScannerGetColor
                    ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Control.Exception (Exception)
import Data.Typeable (Typeable)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt, CUChar, CUInt, CULong)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (castFunPtr, castPtr, FunPtr, Ptr)
import Foreign.Storable (peek)



data ZbarColor = ZbarSpace
               | ZbarBar
  deriving (Eq)
instance Enum ZbarColor where
  succ ZbarSpace = ZbarBar
  succ ZbarBar = error "ZbarColor.succ: ZbarBar has no successor"

  pred ZbarBar = ZbarSpace
  pred ZbarSpace = error "ZbarColor.pred: ZbarSpace 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 ZbarBar

  fromEnum ZbarSpace = 0
  fromEnum ZbarBar = 1

  toEnum 0 = ZbarSpace
  toEnum 1 = ZbarBar
  toEnum unmatched = error ("ZbarColor.toEnum: Cannot match " ++ show unmatched)

{-# LINE 175 "src/ZBar/Foreign.chs" #-}

data ZbarSymbolType = ZbarNone
                    | ZbarPartial
                    | ZbarEan8
                    | ZbarUpce
                    | ZbarIsbn10
                    | ZbarUpca
                    | ZbarEan13
                    | ZbarIsbn13
                    | ZbarI25
                    | ZbarCode39
                    | ZbarPdf417
                    | ZbarQrcode
                    | ZbarCode128
                    | ZbarSymbol
                    | ZbarAddon2
                    | ZbarAddon5
                    | ZbarAddon
  deriving (Eq)
instance Enum ZbarSymbolType where
  succ ZbarNone = ZbarPartial
  succ ZbarPartial = ZbarEan8
  succ ZbarEan8 = ZbarUpce
  succ ZbarUpce = ZbarIsbn10
  succ ZbarIsbn10 = ZbarUpca
  succ ZbarUpca = ZbarEan13
  succ ZbarEan13 = ZbarIsbn13
  succ ZbarIsbn13 = ZbarI25
  succ ZbarI25 = ZbarCode39
  succ ZbarCode39 = ZbarPdf417
  succ ZbarPdf417 = ZbarQrcode
  succ ZbarQrcode = ZbarCode128
  succ ZbarCode128 = ZbarSymbol
  succ ZbarSymbol = ZbarAddon2
  succ ZbarAddon2 = ZbarAddon5
  succ ZbarAddon5 = ZbarAddon
  succ ZbarAddon = error "ZbarSymbolType.succ: ZbarAddon has no successor"

  pred ZbarPartial = ZbarNone
  pred ZbarEan8 = ZbarPartial
  pred ZbarUpce = ZbarEan8
  pred ZbarIsbn10 = ZbarUpce
  pred ZbarUpca = ZbarIsbn10
  pred ZbarEan13 = ZbarUpca
  pred ZbarIsbn13 = ZbarEan13
  pred ZbarI25 = ZbarIsbn13
  pred ZbarCode39 = ZbarI25
  pred ZbarPdf417 = ZbarCode39
  pred ZbarQrcode = ZbarPdf417
  pred ZbarCode128 = ZbarQrcode
  pred ZbarSymbol = ZbarCode128
  pred ZbarAddon2 = ZbarSymbol
  pred ZbarAddon5 = ZbarAddon2
  pred ZbarAddon = ZbarAddon5
  pred ZbarNone = error "ZbarSymbolType.pred: ZbarNone 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 ZbarAddon

  fromEnum ZbarNone = 0
  fromEnum ZbarPartial = 1
  fromEnum ZbarEan8 = 8
  fromEnum ZbarUpce = 9
  fromEnum ZbarIsbn10 = 10
  fromEnum ZbarUpca = 12
  fromEnum ZbarEan13 = 13
  fromEnum ZbarIsbn13 = 14
  fromEnum ZbarI25 = 25
  fromEnum ZbarCode39 = 39
  fromEnum ZbarPdf417 = 57
  fromEnum ZbarQrcode = 64
  fromEnum ZbarCode128 = 128
  fromEnum ZbarSymbol = 255
  fromEnum ZbarAddon2 = 512
  fromEnum ZbarAddon5 = 1280
  fromEnum ZbarAddon = 1792

  toEnum 0 = ZbarNone
  toEnum 1 = ZbarPartial
  toEnum 8 = ZbarEan8
  toEnum 9 = ZbarUpce
  toEnum 10 = ZbarIsbn10
  toEnum 12 = ZbarUpca
  toEnum 13 = ZbarEan13
  toEnum 14 = ZbarIsbn13
  toEnum 25 = ZbarI25
  toEnum 39 = ZbarCode39
  toEnum 57 = ZbarPdf417
  toEnum 64 = ZbarQrcode
  toEnum 128 = ZbarCode128
  toEnum 255 = ZbarSymbol
  toEnum 512 = ZbarAddon2
  toEnum 1280 = ZbarAddon5
  toEnum 1792 = ZbarAddon
  toEnum unmatched = error ("ZbarSymbolType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 176 "src/ZBar/Foreign.chs" #-}

data ZbarError = ZbarOk
               | ZbarErrNomem
               | ZbarErrInternal
               | ZbarErrUnsupported
               | ZbarErrInvalid
               | ZbarErrSystem
               | ZbarErrLocking
               | ZbarErrBusy
               | ZbarErrXdisplay
               | ZbarErrXproto
               | ZbarErrClosed
               | ZbarErrWinapi
               | ZbarErrNum
  deriving (Show,Typeable)
instance Enum ZbarError where
  succ ZbarOk = ZbarErrNomem
  succ ZbarErrNomem = ZbarErrInternal
  succ ZbarErrInternal = ZbarErrUnsupported
  succ ZbarErrUnsupported = ZbarErrInvalid
  succ ZbarErrInvalid = ZbarErrSystem
  succ ZbarErrSystem = ZbarErrLocking
  succ ZbarErrLocking = ZbarErrBusy
  succ ZbarErrBusy = ZbarErrXdisplay
  succ ZbarErrXdisplay = ZbarErrXproto
  succ ZbarErrXproto = ZbarErrClosed
  succ ZbarErrClosed = ZbarErrWinapi
  succ ZbarErrWinapi = ZbarErrNum
  succ ZbarErrNum = error "ZbarError.succ: ZbarErrNum has no successor"

  pred ZbarErrNomem = ZbarOk
  pred ZbarErrInternal = ZbarErrNomem
  pred ZbarErrUnsupported = ZbarErrInternal
  pred ZbarErrInvalid = ZbarErrUnsupported
  pred ZbarErrSystem = ZbarErrInvalid
  pred ZbarErrLocking = ZbarErrSystem
  pred ZbarErrBusy = ZbarErrLocking
  pred ZbarErrXdisplay = ZbarErrBusy
  pred ZbarErrXproto = ZbarErrXdisplay
  pred ZbarErrClosed = ZbarErrXproto
  pred ZbarErrWinapi = ZbarErrClosed
  pred ZbarErrNum = ZbarErrWinapi
  pred ZbarOk = error "ZbarError.pred: ZbarOk 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 ZbarErrNum

  fromEnum ZbarOk = 0
  fromEnum ZbarErrNomem = 1
  fromEnum ZbarErrInternal = 2
  fromEnum ZbarErrUnsupported = 3
  fromEnum ZbarErrInvalid = 4
  fromEnum ZbarErrSystem = 5
  fromEnum ZbarErrLocking = 6
  fromEnum ZbarErrBusy = 7
  fromEnum ZbarErrXdisplay = 8
  fromEnum ZbarErrXproto = 9
  fromEnum ZbarErrClosed = 10
  fromEnum ZbarErrWinapi = 11
  fromEnum ZbarErrNum = 12

  toEnum 0 = ZbarOk
  toEnum 1 = ZbarErrNomem
  toEnum 2 = ZbarErrInternal
  toEnum 3 = ZbarErrUnsupported
  toEnum 4 = ZbarErrInvalid
  toEnum 5 = ZbarErrSystem
  toEnum 6 = ZbarErrLocking
  toEnum 7 = ZbarErrBusy
  toEnum 8 = ZbarErrXdisplay
  toEnum 9 = ZbarErrXproto
  toEnum 10 = ZbarErrClosed
  toEnum 11 = ZbarErrWinapi
  toEnum 12 = ZbarErrNum
  toEnum unmatched = error ("ZbarError.toEnum: Cannot match " ++ show unmatched)

{-# LINE 177 "src/ZBar/Foreign.chs" #-}

data ZbarConfig = ZbarCfgEnable
                | ZbarCfgAddCheck
                | ZbarCfgEmitCheck
                | ZbarCfgAscii
                | ZbarCfgNum
                | ZbarCfgMinLen
                | ZbarCfgMaxLen
                | ZbarCfgPosition
                | ZbarCfgXDensity
                | ZbarCfgYDensity
instance Enum ZbarConfig where
  succ ZbarCfgEnable = ZbarCfgAddCheck
  succ ZbarCfgAddCheck = ZbarCfgEmitCheck
  succ ZbarCfgEmitCheck = ZbarCfgAscii
  succ ZbarCfgAscii = ZbarCfgNum
  succ ZbarCfgNum = ZbarCfgMinLen
  succ ZbarCfgMinLen = ZbarCfgMaxLen
  succ ZbarCfgMaxLen = ZbarCfgPosition
  succ ZbarCfgPosition = ZbarCfgXDensity
  succ ZbarCfgXDensity = ZbarCfgYDensity
  succ ZbarCfgYDensity = error "ZbarConfig.succ: ZbarCfgYDensity has no successor"

  pred ZbarCfgAddCheck = ZbarCfgEnable
  pred ZbarCfgEmitCheck = ZbarCfgAddCheck
  pred ZbarCfgAscii = ZbarCfgEmitCheck
  pred ZbarCfgNum = ZbarCfgAscii
  pred ZbarCfgMinLen = ZbarCfgNum
  pred ZbarCfgMaxLen = ZbarCfgMinLen
  pred ZbarCfgPosition = ZbarCfgMaxLen
  pred ZbarCfgXDensity = ZbarCfgPosition
  pred ZbarCfgYDensity = ZbarCfgXDensity
  pred ZbarCfgEnable = error "ZbarConfig.pred: ZbarCfgEnable 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 ZbarCfgYDensity

  fromEnum ZbarCfgEnable = 0
  fromEnum ZbarCfgAddCheck = 1
  fromEnum ZbarCfgEmitCheck = 2
  fromEnum ZbarCfgAscii = 3
  fromEnum ZbarCfgNum = 4
  fromEnum ZbarCfgMinLen = 32
  fromEnum ZbarCfgMaxLen = 33
  fromEnum ZbarCfgPosition = 128
  fromEnum ZbarCfgXDensity = 256
  fromEnum ZbarCfgYDensity = 257

  toEnum 0 = ZbarCfgEnable
  toEnum 1 = ZbarCfgAddCheck
  toEnum 2 = ZbarCfgEmitCheck
  toEnum 3 = ZbarCfgAscii
  toEnum 4 = ZbarCfgNum
  toEnum 32 = ZbarCfgMinLen
  toEnum 33 = ZbarCfgMaxLen
  toEnum 128 = ZbarCfgPosition
  toEnum 256 = ZbarCfgXDensity
  toEnum 257 = ZbarCfgYDensity
  toEnum unmatched = error ("ZbarConfig.toEnum: Cannot match " ++ show unmatched)

{-# LINE 178 "src/ZBar/Foreign.chs" #-}


instance Exception ZbarError where

zbarVersion :: ((CUInt), (CUInt))
zbarVersion =
  C2HSImp.unsafePerformIO $
  alloca $ \a1' ->
  alloca $ \a2' ->
  zbarVersion'_ a1' a2' >>
  peek  a1'>>= \a1'' ->
  peek  a2'>>= \a2'' ->
  return (a1'', a2'')

{-# LINE 182 "src/ZBar/Foreign.chs" #-}

zbarSetVerbosity :: (CInt) -> IO ()
zbarSetVerbosity a1 =
  let {a1' = fromIntegral a1} in
  zbarSetVerbosity'_ a1' >>
  return ()

{-# LINE 183 "src/ZBar/Foreign.chs" #-}

zbarIncreaseVerbosity :: IO ()
zbarIncreaseVerbosity =
  zbarIncreaseVerbosity'_ >>
  return ()

{-# LINE 184 "src/ZBar/Foreign.chs" #-}

zbarGetSymbolName :: (ZbarSymbolType) -> (String)
zbarGetSymbolName a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = (fromIntegral . fromEnum) a1} in
  zbarGetSymbolName'_ a1' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 185 "src/ZBar/Foreign.chs" #-}

zbarGetAddonName :: (ZbarSymbolType) -> (String)
zbarGetAddonName a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = (fromIntegral . fromEnum) a1} in
  zbarGetAddonName'_ a1' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 186 "src/ZBar/Foreign.chs" #-}


-- abstract/opaque types
data ZbarSymbol
data ZbarSymbolSet
data ZbarImage
data ZbarProcessor
data ZbarVideo
data ZbarWindow
data ZbarImageScanner
data ZbarDecoder
data ZbarScanner

type ZbarSymbolPtr = C2HSImp.Ptr (ZbarSymbol)
{-# LINE 199 "src/ZBar/Foreign.chs" #-}

type ZbarSymbolSetPtr = C2HSImp.Ptr (ZbarSymbolSet)
{-# LINE 200 "src/ZBar/Foreign.chs" #-}

type ZbarImagePtr = C2HSImp.Ptr (ZbarImage)
{-# LINE 201 "src/ZBar/Foreign.chs" #-}

type ZbarProcessorPtr = C2HSImp.Ptr (ZbarProcessor)
{-# LINE 202 "src/ZBar/Foreign.chs" #-}

type ZbarVideoPtr = C2HSImp.Ptr (ZbarVideo)
{-# LINE 203 "src/ZBar/Foreign.chs" #-}

type ZbarWindowPtr = C2HSImp.Ptr (ZbarWindow)
{-# LINE 204 "src/ZBar/Foreign.chs" #-}

type ZbarImageScannerPtr = C2HSImp.Ptr (ZbarImageScanner)
{-# LINE 205 "src/ZBar/Foreign.chs" #-}

type ZbarDecoderPtr = C2HSImp.Ptr (ZbarDecoder)
{-# LINE 206 "src/ZBar/Foreign.chs" #-}

type ZbarScannerPtr = C2HSImp.Ptr (ZbarScanner)
{-# LINE 207 "src/ZBar/Foreign.chs" #-}


zbarParseConfig :: (String) -> (Ptr ZbarSymbolType) -> (Ptr ZbarConfig) -> (Ptr CInt) -> IO ((Bool))
zbarParseConfig a1 a2 a3 a4 =
  C2HSImp.withCString a1 $ \a1' ->
  let {a2' = castPtr a2} in
  let {a3' = castPtr a3} in
  let {a4' = id a4} in
  zbarParseConfig'_ a1' a2' a3' a4' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 209 "src/ZBar/Foreign.chs" #-}


zbarSymbolRef :: (ZbarSymbolPtr) -> (CInt) -> IO ()
zbarSymbolRef a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarSymbolRef'_ a1' a2' >>
  return ()

{-# LINE 211 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetType :: (ZbarSymbolPtr) -> IO ((ZbarSymbolType))
zbarSymbolGetType a1 =
  let {a1' = id a1} in
  zbarSymbolGetType'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 212 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetData :: (ZbarSymbolPtr) -> IO ((CString))
zbarSymbolGetData a1 =
  let {a1' = id a1} in
  zbarSymbolGetData'_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 213 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetDataLength :: (ZbarSymbolPtr) -> IO ((CUInt))
zbarSymbolGetDataLength a1 =
  let {a1' = id a1} in
  zbarSymbolGetDataLength'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 214 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetQuality :: (ZbarSymbolPtr) -> IO ((CInt))
zbarSymbolGetQuality a1 =
  let {a1' = id a1} in
  zbarSymbolGetQuality'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 215 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetCount :: (ZbarSymbolPtr) -> IO ((CInt))
zbarSymbolGetCount a1 =
  let {a1' = id a1} in
  zbarSymbolGetCount'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 216 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetLocSize :: (ZbarSymbolPtr) -> IO ((CUInt))
zbarSymbolGetLocSize a1 =
  let {a1' = id a1} in
  zbarSymbolGetLocSize'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 217 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetLocX :: (ZbarSymbolPtr) -> (CUInt) -> IO ((CInt))
zbarSymbolGetLocX a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarSymbolGetLocX'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 218 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetLocY :: (ZbarSymbolPtr) -> (CUInt) -> IO ((CInt))
zbarSymbolGetLocY a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarSymbolGetLocY'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 219 "src/ZBar/Foreign.chs" #-}

zbarSymbolNext :: (ZbarSymbolPtr) -> IO ((ZbarSymbolPtr))
zbarSymbolNext a1 =
  let {a1' = id a1} in
  zbarSymbolNext'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 220 "src/ZBar/Foreign.chs" #-}

zbarSymbolGetComponents :: (ZbarSymbolPtr) -> IO ((ZbarSymbolSetPtr))
zbarSymbolGetComponents a1 =
  let {a1' = id a1} in
  zbarSymbolGetComponents'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 221 "src/ZBar/Foreign.chs" #-}

zbarSymbolFirstComponent :: (ZbarSymbolPtr) -> IO ((ZbarSymbolPtr))
zbarSymbolFirstComponent a1 =
  let {a1' = id a1} in
  zbarSymbolFirstComponent'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 222 "src/ZBar/Foreign.chs" #-}

zbarSymbolXml :: (ZbarSymbolPtr) -> (Ptr (Ptr a)) -> (Ptr CUInt) -> IO ((Ptr a))
zbarSymbolXml a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = castPtr a2} in
  let {a3' = id a3} in
  zbarSymbolXml'_ a1' a2' a3' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 223 "src/ZBar/Foreign.chs" #-}


zbarSymbolSetRef :: (ZbarSymbolSetPtr) -> (CInt) -> IO ()
zbarSymbolSetRef a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarSymbolSetRef'_ a1' a2' >>
  return ()

{-# LINE 225 "src/ZBar/Foreign.chs" #-}

zbarSymbolSetGetSize :: (ZbarSymbolSetPtr) -> IO ((CInt))
zbarSymbolSetGetSize a1 =
  let {a1' = id a1} in
  zbarSymbolSetGetSize'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 226 "src/ZBar/Foreign.chs" #-}

zbarSymbolSetFirstSymbol :: (ZbarSymbolSetPtr) -> IO ((ZbarSymbolPtr))
zbarSymbolSetFirstSymbol a1 =
  let {a1' = id a1} in
  zbarSymbolSetFirstSymbol'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 227 "src/ZBar/Foreign.chs" #-}


type ZbarImageCleanupHandlerT = ZbarImagePtr -> IO ()
type ZbarImageDataHandlerT a = ZbarImagePtr -> Ptr a -> IO ()
type ZbarDecoderHandlerT = ZbarDecoderPtr -> IO ()

foreign import ccall "wrapper" mkCleanupCallback :: ZbarImageCleanupHandlerT -> IO (FunPtr ZbarImageCleanupHandlerT)
foreign import ccall "wrapper" mkDataCallback :: ZbarImageDataHandlerT a -> IO (FunPtr (ZbarImageDataHandlerT a))
foreign import ccall "wrapper" mkDecoderCallback :: ZbarDecoderHandlerT -> IO (FunPtr ZbarDecoderHandlerT)

zbarImageCreate :: IO ((ZbarImagePtr))
zbarImageCreate =
  zbarImageCreate'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 237 "src/ZBar/Foreign.chs" #-}

zbarImageDestroy :: (ZbarImagePtr) -> IO ()
zbarImageDestroy a1 =
  let {a1' = id a1} in
  zbarImageDestroy'_ a1' >>
  return ()

{-# LINE 238 "src/ZBar/Foreign.chs" #-}

zbarImageRef :: (ZbarImagePtr) -> (CInt) -> IO ()
zbarImageRef a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarImageRef'_ a1' a2' >>
  return ()

{-# LINE 239 "src/ZBar/Foreign.chs" #-}

zbarImageConvert :: (ZbarImagePtr) -> (CULong) -> IO ((ZbarImagePtr))
zbarImageConvert a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarImageConvert'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 240 "src/ZBar/Foreign.chs" #-}

zbarImageConvertResize :: (ZbarImagePtr) -> (CULong) -> (CUInt) -> (CUInt) -> IO ((ZbarImagePtr))
zbarImageConvertResize a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  zbarImageConvertResize'_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 241 "src/ZBar/Foreign.chs" #-}

zbarImageGetFormat :: (ZbarImagePtr) -> IO ((CULong))
zbarImageGetFormat a1 =
  let {a1' = id a1} in
  zbarImageGetFormat'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 242 "src/ZBar/Foreign.chs" #-}

zbarImageGetSequence :: (ZbarImagePtr) -> IO ((CUInt))
zbarImageGetSequence a1 =
  let {a1' = id a1} in
  zbarImageGetSequence'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 243 "src/ZBar/Foreign.chs" #-}

zbarImageGetWidth :: (ZbarImagePtr) -> IO ((CUInt))
zbarImageGetWidth a1 =
  let {a1' = id a1} in
  zbarImageGetWidth'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 244 "src/ZBar/Foreign.chs" #-}

zbarImageGetHeight :: (ZbarImagePtr) -> IO ((CUInt))
zbarImageGetHeight a1 =
  let {a1' = id a1} in
  zbarImageGetHeight'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 245 "src/ZBar/Foreign.chs" #-}

zbarImageGetData :: (ZbarImagePtr) -> IO ((Ptr a))
zbarImageGetData a1 =
  let {a1' = id a1} in
  zbarImageGetData'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 246 "src/ZBar/Foreign.chs" #-}

zbarImageGetDataLength :: (ZbarImagePtr) -> IO ((CUInt))
zbarImageGetDataLength a1 =
  let {a1' = id a1} in
  zbarImageGetDataLength'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 247 "src/ZBar/Foreign.chs" #-}

zbarImageGetSymbols :: (ZbarImagePtr) -> IO ((ZbarSymbolSetPtr))
zbarImageGetSymbols a1 =
  let {a1' = id a1} in
  zbarImageGetSymbols'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 248 "src/ZBar/Foreign.chs" #-}

zbarImageSetSymbols :: (ZbarImagePtr) -> (ZbarSymbolSetPtr) -> IO ()
zbarImageSetSymbols a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarImageSetSymbols'_ a1' a2' >>
  return ()

{-# LINE 249 "src/ZBar/Foreign.chs" #-}

zbarImageFirstSymbol :: (ZbarImagePtr) -> IO ((ZbarSymbolPtr))
zbarImageFirstSymbol a1 =
  let {a1' = id a1} in
  zbarImageFirstSymbol'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 250 "src/ZBar/Foreign.chs" #-}

zbarImageSetFormat :: (ZbarImagePtr) -> (CULong) -> IO ()
zbarImageSetFormat a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarImageSetFormat'_ a1' a2' >>
  return ()

{-# LINE 251 "src/ZBar/Foreign.chs" #-}

zbarImageSetSequence :: (ZbarImagePtr) -> (CUInt) -> IO ()
zbarImageSetSequence a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarImageSetSequence'_ a1' a2' >>
  return ()

{-# LINE 252 "src/ZBar/Foreign.chs" #-}

zbarImageSetSize :: (ZbarImagePtr) -> (CUInt) -> (CUInt) -> IO ()
zbarImageSetSize a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  zbarImageSetSize'_ a1' a2' a3' >>
  return ()

{-# LINE 253 "src/ZBar/Foreign.chs" #-}

zbarImageSetData :: (ZbarImagePtr) -> (Ptr a) -> (CULong) -> (FunPtr ZbarImageCleanupHandlerT) -> IO ()
zbarImageSetData a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = castPtr a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = id a4} in
  zbarImageSetData'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 254 "src/ZBar/Foreign.chs" #-}

zbarImageFreeData :: (ZbarImagePtr) -> IO ()
zbarImageFreeData a1 =
  let {a1' = id a1} in
  zbarImageFreeData'_ a1' >>
  return ()

{-# LINE 255 "src/ZBar/Foreign.chs" #-}

zbarImageSetUserdata :: (ZbarImagePtr) -> (Ptr a) -> IO ()
zbarImageSetUserdata a1 a2 =
  let {a1' = id a1} in
  let {a2' = castPtr a2} in
  zbarImageSetUserdata'_ a1' a2' >>
  return ()

{-# LINE 256 "src/ZBar/Foreign.chs" #-}

zbarImageGetUserdata :: (ZbarImagePtr) -> IO ((Ptr a))
zbarImageGetUserdata a1 =
  let {a1' = id a1} in
  zbarImageGetUserdata'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 257 "src/ZBar/Foreign.chs" #-}

zbarImageWrite :: (ZbarImagePtr) -> (String) -> IO ((CInt))
zbarImageWrite a1 a2 =
  let {a1' = id a1} in
  C2HSImp.withCString a2 $ \a2' ->
  zbarImageWrite'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 258 "src/ZBar/Foreign.chs" #-}

zbarImageRead :: (String) -> IO ((ZbarImagePtr))
zbarImageRead a1 =
  C2HSImp.withCString a1 $ \a1' ->
  zbarImageRead'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 259 "src/ZBar/Foreign.chs" #-}


zbarProcessorCreate :: (Bool) -> IO ((ZbarProcessorPtr))
zbarProcessorCreate a1 =
  let {a1' = C2HSImp.fromBool a1} in
  zbarProcessorCreate'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 261 "src/ZBar/Foreign.chs" #-}

zbarProcessorDestroy :: (ZbarProcessorPtr) -> IO ()
zbarProcessorDestroy a1 =
  let {a1' = id a1} in
  zbarProcessorDestroy'_ a1' >>
  return ()

{-# LINE 262 "src/ZBar/Foreign.chs" #-}

zbarProcessorInit :: (ZbarProcessorPtr) -> (CString) -> (Bool) -> IO ((CInt))
zbarProcessorInit a1 a2 a3 =
  let {a1' = id a1} in
  (flip ($)) a2 $ \a2' ->
  let {a3' = C2HSImp.fromBool a3} in
  zbarProcessorInit'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 263 "src/ZBar/Foreign.chs" #-}

zbarProcessorRequestSize :: (ZbarProcessorPtr) -> (CUInt) -> (CUInt) -> IO ((CInt))
zbarProcessorRequestSize a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  zbarProcessorRequestSize'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 264 "src/ZBar/Foreign.chs" #-}

zbarProcessorRequestInterface :: (ZbarProcessorPtr) -> (CInt) -> IO ((CInt))
zbarProcessorRequestInterface a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessorRequestInterface'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 265 "src/ZBar/Foreign.chs" #-}

zbarProcessorRequestIomode :: (ZbarProcessorPtr) -> (CInt) -> IO ((CInt))
zbarProcessorRequestIomode a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessorRequestIomode'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 266 "src/ZBar/Foreign.chs" #-}

zbarProcessorForceFormat :: (ZbarProcessorPtr) -> (CULong) -> (CULong) -> IO ((CInt))
zbarProcessorForceFormat a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  zbarProcessorForceFormat'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 267 "src/ZBar/Foreign.chs" #-}

zbarProcessorSetDataHandler :: (ZbarProcessorPtr) -> (FunPtr (ZbarImageDataHandlerT a)) -> (Ptr a) -> IO ((FunPtr (ZbarImageDataHandlerT a)))
zbarProcessorSetDataHandler a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = castFunPtr a2} in
  let {a3' = castPtr a3} in
  zbarProcessorSetDataHandler'_ a1' a2' a3' >>= \res ->
  let {res' = castFunPtr res} in
  return (res')

{-# LINE 268 "src/ZBar/Foreign.chs" #-}

zbarProcessorSetUserdata :: (ZbarProcessorPtr) -> (Ptr a) -> IO ()
zbarProcessorSetUserdata a1 a2 =
  let {a1' = id a1} in
  let {a2' = castPtr a2} in
  zbarProcessorSetUserdata'_ a1' a2' >>
  return ()

{-# LINE 269 "src/ZBar/Foreign.chs" #-}

zbarProcessorGetUserdata :: (ZbarProcessorPtr) -> IO ((Ptr a))
zbarProcessorGetUserdata a1 =
  let {a1' = id a1} in
  zbarProcessorGetUserdata'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 270 "src/ZBar/Foreign.chs" #-}

zbarProcessorSetConfig :: (ZbarProcessorPtr) -> (ZbarSymbolType) -> (ZbarConfig) -> (CInt) -> IO ((Bool))
zbarProcessorSetConfig a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = (fromIntegral . fromEnum) a2} in
  let {a3' = (fromIntegral . fromEnum) a3} in
  let {a4' = fromIntegral a4} in
  zbarProcessorSetConfig'_ a1' a2' a3' a4' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 271 "src/ZBar/Foreign.chs" #-}

zbarProcessorParseConfig :: (ZbarProcessorPtr) -> (String) -> IO ((Bool))
zbarProcessorParseConfig a1 a2 =
  let {a1' = id a1} in
  C2HSImp.withCString a2 $ \a2' ->
  zbarProcessorParseConfig'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 272 "src/ZBar/Foreign.chs" #-}

zbarProcessorIsVisible :: (ZbarProcessorPtr) -> IO ((CInt))
zbarProcessorIsVisible a1 =
  let {a1' = id a1} in
  zbarProcessorIsVisible'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 273 "src/ZBar/Foreign.chs" #-}

zbarProcessorSetVisible :: (ZbarProcessorPtr) -> (CInt) -> IO ((CInt))
zbarProcessorSetVisible a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessorSetVisible'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 274 "src/ZBar/Foreign.chs" #-}

zbarProcessorSetActive :: (ZbarProcessorPtr) -> (CInt) -> IO ((CInt))
zbarProcessorSetActive a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessorSetActive'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 275 "src/ZBar/Foreign.chs" #-}

zbarProcessorGetResults :: (ZbarProcessorPtr) -> IO ((ZbarSymbolSetPtr))
zbarProcessorGetResults a1 =
  let {a1' = id a1} in
  zbarProcessorGetResults'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 276 "src/ZBar/Foreign.chs" #-}

zbarProcessorUserWait :: (ZbarProcessorPtr) -> (CInt) -> IO ((CInt))
zbarProcessorUserWait a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessorUserWait'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 277 "src/ZBar/Foreign.chs" #-}

zbarProcessOne :: (ZbarProcessorPtr) -> (CInt) -> IO ((CInt))
zbarProcessOne a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessOne'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 278 "src/ZBar/Foreign.chs" #-}

zbarProcessImage :: (ZbarProcessorPtr) -> (ZbarImagePtr) -> IO ((CInt))
zbarProcessImage a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarProcessImage'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 279 "src/ZBar/Foreign.chs" #-}

zbarProcessorErrorSpew :: (ZbarProcessorPtr) -> (CInt) -> IO ((CInt))
zbarProcessorErrorSpew a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessorErrorSpew'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 280 "src/ZBar/Foreign.chs" #-}

zbarProcessorErrorString :: (ZbarProcessorPtr) -> (CInt) -> IO ((String))
zbarProcessorErrorString a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarProcessorErrorString'_ a1' a2' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 281 "src/ZBar/Foreign.chs" #-}

zbarProcessorGetErrorCode :: (ZbarProcessorPtr) -> IO ((ZbarError))
zbarProcessorGetErrorCode a1 =
  let {a1' = id a1} in
  zbarProcessorGetErrorCode'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 282 "src/ZBar/Foreign.chs" #-}


zbarVideoCreate :: IO ((ZbarVideoPtr))
zbarVideoCreate =
  zbarVideoCreate'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 284 "src/ZBar/Foreign.chs" #-}

zbarVideoGetFd :: (ZbarVideoPtr) -> IO ((CInt))
zbarVideoGetFd a1 =
  let {a1' = id a1} in
  zbarVideoGetFd'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 285 "src/ZBar/Foreign.chs" #-}

zbarVideoRequestSize :: (ZbarVideoPtr) -> (CUInt) -> (CUInt) -> IO ((CInt))
zbarVideoRequestSize a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  zbarVideoRequestSize'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 286 "src/ZBar/Foreign.chs" #-}

zbarVideoRequestInterface :: (ZbarVideoPtr) -> (CInt) -> IO ((CInt))
zbarVideoRequestInterface a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarVideoRequestInterface'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 287 "src/ZBar/Foreign.chs" #-}

zbarVideoRequestIomode :: (ZbarVideoPtr) -> (CInt) -> IO ((CInt))
zbarVideoRequestIomode a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarVideoRequestIomode'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 288 "src/ZBar/Foreign.chs" #-}

zbarVideoGetWidth :: (ZbarVideoPtr) -> IO ((CInt))
zbarVideoGetWidth a1 =
  let {a1' = id a1} in
  zbarVideoGetWidth'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 289 "src/ZBar/Foreign.chs" #-}

zbarVideoGetHeight :: (ZbarVideoPtr) -> IO ((CInt))
zbarVideoGetHeight a1 =
  let {a1' = id a1} in
  zbarVideoGetHeight'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 290 "src/ZBar/Foreign.chs" #-}

zbarVideoInit :: (ZbarVideoPtr) -> (CULong) -> IO ((CInt))
zbarVideoInit a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarVideoInit'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 291 "src/ZBar/Foreign.chs" #-}

zbarVideoEnable :: (ZbarVideoPtr) -> (CInt) -> IO ((CInt))
zbarVideoEnable a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarVideoEnable'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 292 "src/ZBar/Foreign.chs" #-}

zbarVideoNextImage :: (ZbarVideoPtr) -> IO ((ZbarImagePtr))
zbarVideoNextImage a1 =
  let {a1' = id a1} in
  zbarVideoNextImage'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 293 "src/ZBar/Foreign.chs" #-}

zbarVideoErrorSpew :: (ZbarVideoPtr) -> (CInt) -> IO ((CInt))
zbarVideoErrorSpew a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarVideoErrorSpew'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 294 "src/ZBar/Foreign.chs" #-}

zbarVideoErrorString :: (ZbarVideoPtr) -> (CInt) -> IO ((String))
zbarVideoErrorString a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarVideoErrorString'_ a1' a2' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 295 "src/ZBar/Foreign.chs" #-}

zbarVideoGetErrorCode :: (ZbarVideoPtr) -> IO ((ZbarError))
zbarVideoGetErrorCode a1 =
  let {a1' = id a1} in
  zbarVideoGetErrorCode'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 296 "src/ZBar/Foreign.chs" #-}


zbarWindowCreate :: IO ((ZbarWindowPtr))
zbarWindowCreate =
  zbarWindowCreate'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 298 "src/ZBar/Foreign.chs" #-}

zbarWindowDestroy :: (ZbarWindowPtr) -> IO ()
zbarWindowDestroy a1 =
  let {a1' = id a1} in
  zbarWindowDestroy'_ a1' >>
  return ()

{-# LINE 299 "src/ZBar/Foreign.chs" #-}

zbarWindowAttach :: (ZbarWindowPtr) -> (Ptr a) -> (CULong) -> IO ((CInt))
zbarWindowAttach a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = castPtr a2} in
  let {a3' = fromIntegral a3} in
  zbarWindowAttach'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 300 "src/ZBar/Foreign.chs" #-}

zbarWindowSetOverlay :: (ZbarWindowPtr) -> (CInt) -> IO ()
zbarWindowSetOverlay a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarWindowSetOverlay'_ a1' a2' >>
  return ()

{-# LINE 301 "src/ZBar/Foreign.chs" #-}

zbarWindowGetOverlay :: (ZbarWindowPtr) -> IO ((CInt))
zbarWindowGetOverlay a1 =
  let {a1' = id a1} in
  zbarWindowGetOverlay'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 302 "src/ZBar/Foreign.chs" #-}

zbarWindowDraw :: (ZbarWindowPtr) -> (ZbarImagePtr) -> IO ((CInt))
zbarWindowDraw a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarWindowDraw'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 303 "src/ZBar/Foreign.chs" #-}

zbarWindowRedraw :: (ZbarWindowPtr) -> IO ((CInt))
zbarWindowRedraw a1 =
  let {a1' = id a1} in
  zbarWindowRedraw'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 304 "src/ZBar/Foreign.chs" #-}

zbarWindowResize :: (ZbarWindowPtr) -> (CInt) -> (CInt) -> IO ((CInt))
zbarWindowResize a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  zbarWindowResize'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 305 "src/ZBar/Foreign.chs" #-}

zbarWindowErrorSpew :: (ZbarWindowPtr) -> (CInt) -> IO ((CInt))
zbarWindowErrorSpew a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarWindowErrorSpew'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 306 "src/ZBar/Foreign.chs" #-}

zbarWindowErrorString :: (ZbarWindowPtr) -> (CInt) -> IO ((String))
zbarWindowErrorString a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarWindowErrorString'_ a1' a2' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 307 "src/ZBar/Foreign.chs" #-}

zbarWindowGetErrorCode :: (ZbarWindowPtr) -> IO ((ZbarError))
zbarWindowGetErrorCode a1 =
  let {a1' = id a1} in
  zbarWindowGetErrorCode'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 308 "src/ZBar/Foreign.chs" #-}


zbarNegotiateFormat :: (ZbarVideoPtr) -> (ZbarWindowPtr) -> IO ((CInt))
zbarNegotiateFormat a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarNegotiateFormat'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 310 "src/ZBar/Foreign.chs" #-}


zbarImageScannerCreate :: IO ((ZbarImageScannerPtr))
zbarImageScannerCreate =
  zbarImageScannerCreate'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 312 "src/ZBar/Foreign.chs" #-}

zbarImageScannerDestroy :: (ZbarImageScannerPtr) -> IO ()
zbarImageScannerDestroy a1 =
  let {a1' = id a1} in
  zbarImageScannerDestroy'_ a1' >>
  return ()

{-# LINE 313 "src/ZBar/Foreign.chs" #-}

zbarImageScannerSetDataHandler :: (ZbarImageScannerPtr) -> (FunPtr (ZbarImageDataHandlerT a)) -> (Ptr a) -> IO ((FunPtr (ZbarImageDataHandlerT a)))
zbarImageScannerSetDataHandler a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = castFunPtr a2} in
  let {a3' = castPtr a3} in
  zbarImageScannerSetDataHandler'_ a1' a2' a3' >>= \res ->
  let {res' = castFunPtr res} in
  return (res')

{-# LINE 319 "src/ZBar/Foreign.chs" #-}

zbarImageScannerSetConfig :: (ZbarImageScannerPtr) -> (ZbarSymbolType) -> (ZbarConfig) -> (CInt) -> IO ((CInt))
zbarImageScannerSetConfig a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = (fromIntegral . fromEnum) a2} in
  let {a3' = (fromIntegral . fromEnum) a3} in
  let {a4' = fromIntegral a4} in
  zbarImageScannerSetConfig'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 326 "src/ZBar/Foreign.chs" #-}

zbarImageScannerParseConfig :: (ZbarImageScannerPtr) -> (String) -> IO ((CInt))
zbarImageScannerParseConfig a1 a2 =
  let {a1' = id a1} in
  C2HSImp.withCString a2 $ \a2' ->
  zbarImageScannerParseConfig'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 327 "src/ZBar/Foreign.chs" #-}

zbarImageScannerEnableCache :: (ZbarImageScannerPtr) -> (Bool) -> IO ()
zbarImageScannerEnableCache a1 a2 =
  let {a1' = id a1} in
  let {a2' = C2HSImp.fromBool a2} in
  zbarImageScannerEnableCache'_ a1' a2' >>
  return ()

{-# LINE 328 "src/ZBar/Foreign.chs" #-}

zbarImageScannerRecycleImage :: (ZbarImageScannerPtr) -> (ZbarImagePtr) -> IO ()
zbarImageScannerRecycleImage a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarImageScannerRecycleImage'_ a1' a2' >>
  return ()

{-# LINE 329 "src/ZBar/Foreign.chs" #-}

zbarImageScannerGetResults :: (ZbarImageScannerPtr) -> IO ((ZbarSymbolSetPtr))
zbarImageScannerGetResults a1 =
  let {a1' = id a1} in
  zbarImageScannerGetResults'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 330 "src/ZBar/Foreign.chs" #-}

zbarScanImage :: (ZbarImageScannerPtr) -> (ZbarImagePtr) -> IO ((CInt))
zbarScanImage a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarScanImage'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 331 "src/ZBar/Foreign.chs" #-}


zbarDecoderCreate :: IO ()
zbarDecoderCreate =
  zbarDecoderCreate'_ >>
  return ()

{-# LINE 333 "src/ZBar/Foreign.chs" #-}

zbarDecoderDestroy :: (ZbarDecoderPtr) -> IO ()
zbarDecoderDestroy a1 =
  let {a1' = id a1} in
  zbarDecoderDestroy'_ a1' >>
  return ()

{-# LINE 334 "src/ZBar/Foreign.chs" #-}

zbarDecoderSetConfig :: (ZbarDecoderPtr) -> (ZbarSymbolType) -> (ZbarConfig) -> (CInt) -> IO ((CInt))
zbarDecoderSetConfig a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = (fromIntegral . fromEnum) a2} in
  let {a3' = (fromIntegral . fromEnum) a3} in
  let {a4' = fromIntegral a4} in
  zbarDecoderSetConfig'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 335 "src/ZBar/Foreign.chs" #-}

zbarDecoderParseConfig :: (ZbarDecoderPtr) -> (String) -> IO ((CInt))
zbarDecoderParseConfig a1 a2 =
  let {a1' = id a1} in
  C2HSImp.withCString a2 $ \a2' ->
  zbarDecoderParseConfig'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 336 "src/ZBar/Foreign.chs" #-}

zbarDecoderReset :: (ZbarDecoderPtr) -> IO ()
zbarDecoderReset a1 =
  let {a1' = id a1} in
  zbarDecoderReset'_ a1' >>
  return ()

{-# LINE 337 "src/ZBar/Foreign.chs" #-}

zbarDecoderNewScan :: (ZbarDecoderPtr) -> IO ()
zbarDecoderNewScan a1 =
  let {a1' = id a1} in
  zbarDecoderNewScan'_ a1' >>
  return ()

{-# LINE 338 "src/ZBar/Foreign.chs" #-}

zbarDecodeWidth :: (ZbarDecoderPtr) -> (CUInt) -> IO ((ZbarSymbolType))
zbarDecodeWidth a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarDecodeWidth'_ a1' a2' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 339 "src/ZBar/Foreign.chs" #-}

zbarDecoderGetColor :: (ZbarDecoderPtr) -> IO ((ZbarColor))
zbarDecoderGetColor a1 =
  let {a1' = id a1} in
  zbarDecoderGetColor'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 340 "src/ZBar/Foreign.chs" #-}

zbarDecoderGetData :: (ZbarDecoderPtr) -> IO ((Ptr a))
zbarDecoderGetData a1 =
  let {a1' = id a1} in
  zbarDecoderGetData'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 341 "src/ZBar/Foreign.chs" #-}

zbarDecoderGetDataLength :: (ZbarDecoderPtr) -> IO ((CUInt))
zbarDecoderGetDataLength a1 =
  let {a1' = id a1} in
  zbarDecoderGetDataLength'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 342 "src/ZBar/Foreign.chs" #-}

zbarDecoderGetType :: (ZbarDecoderPtr) -> IO ((ZbarSymbolType))
zbarDecoderGetType a1 =
  let {a1' = id a1} in
  zbarDecoderGetType'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 343 "src/ZBar/Foreign.chs" #-}

zbarDecoderSetHandler :: (ZbarDecoderPtr) -> (FunPtr ZbarDecoderHandlerT) -> IO ((FunPtr ZbarDecoderHandlerT))
zbarDecoderSetHandler a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarDecoderSetHandler'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 344 "src/ZBar/Foreign.chs" #-}

zbarDecoderSetUserdata :: (ZbarDecoderPtr) -> (Ptr a) -> IO ()
zbarDecoderSetUserdata a1 a2 =
  let {a1' = id a1} in
  let {a2' = castPtr a2} in
  zbarDecoderSetUserdata'_ a1' a2' >>
  return ()

{-# LINE 345 "src/ZBar/Foreign.chs" #-}

zbarDecoderGetUserdata :: (ZbarDecoderPtr) -> IO ((Ptr a))
zbarDecoderGetUserdata a1 =
  let {a1' = id a1} in
  zbarDecoderGetUserdata'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 346 "src/ZBar/Foreign.chs" #-}


zbarScannerCreate :: (ZbarDecoderPtr) -> IO ((ZbarScannerPtr))
zbarScannerCreate a1 =
  let {a1' = id a1} in
  zbarScannerCreate'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 348 "src/ZBar/Foreign.chs" #-}

zbarScannerDestroy :: (ZbarScannerPtr) -> IO ()
zbarScannerDestroy a1 =
  let {a1' = id a1} in
  zbarScannerDestroy'_ a1' >>
  return ()

{-# LINE 349 "src/ZBar/Foreign.chs" #-}

zbarScannerReset :: (ZbarScannerPtr) -> IO ((ZbarSymbolType))
zbarScannerReset a1 =
  let {a1' = id a1} in
  zbarScannerReset'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 350 "src/ZBar/Foreign.chs" #-}

zbarScannerNewScan :: (ZbarScannerPtr) -> IO ((ZbarSymbolType))
zbarScannerNewScan a1 =
  let {a1' = id a1} in
  zbarScannerNewScan'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 351 "src/ZBar/Foreign.chs" #-}

zbarScannerFlush :: (ZbarScannerPtr) -> IO ((ZbarSymbolType))
zbarScannerFlush a1 =
  let {a1' = id a1} in
  zbarScannerFlush'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 352 "src/ZBar/Foreign.chs" #-}

zbarScanY :: (ZbarScannerPtr) -> (CInt) -> IO ((ZbarSymbolType))
zbarScanY a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  zbarScanY'_ a1' a2' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 353 "src/ZBar/Foreign.chs" #-}

zbarScanRgb24 :: (ZbarScannerPtr) -> (Ptr CUChar) -> IO ((ZbarSymbolType))
zbarScanRgb24 a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  zbarScanRgb24'_ a1' a2' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 354 "src/ZBar/Foreign.chs" #-}

zbarScannerGetWidth :: (ZbarScannerPtr) -> IO ((CUInt))
zbarScannerGetWidth a1 =
  let {a1' = id a1} in
  zbarScannerGetWidth'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 355 "src/ZBar/Foreign.chs" #-}

zbarScannerGetEdge :: (ZbarScannerPtr) -> (CUInt) -> (CInt) -> IO ((CUInt))
zbarScannerGetEdge a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  zbarScannerGetEdge'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 356 "src/ZBar/Foreign.chs" #-}

zbarScannerGetColor :: (ZbarScannerPtr) -> IO ((ZbarColor))
zbarScannerGetColor a1 =
  let {a1' = id a1} in
  zbarScannerGetColor'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 357 "src/ZBar/Foreign.chs" #-}


foreign import ccall safe "ZBar/Foreign.chs.h zbar_version"
  zbarVersion'_ :: ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_set_verbosity"
  zbarSetVerbosity'_ :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_increase_verbosity"
  zbarIncreaseVerbosity'_ :: (IO ())

foreign import ccall safe "ZBar/Foreign.chs.h zbar_get_symbol_name"
  zbarGetSymbolName'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_get_addon_name"
  zbarGetAddonName'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_parse_config"
  zbarParseConfig'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_ref"
  zbarSymbolRef'_ :: ((ZbarSymbolPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_type"
  zbarSymbolGetType'_ :: ((ZbarSymbolPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_data"
  zbarSymbolGetData'_ :: ((ZbarSymbolPtr) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_data_length"
  zbarSymbolGetDataLength'_ :: ((ZbarSymbolPtr) -> (IO C2HSImp.CUInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_quality"
  zbarSymbolGetQuality'_ :: ((ZbarSymbolPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_count"
  zbarSymbolGetCount'_ :: ((ZbarSymbolPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_loc_size"
  zbarSymbolGetLocSize'_ :: ((ZbarSymbolPtr) -> (IO C2HSImp.CUInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_loc_x"
  zbarSymbolGetLocX'_ :: ((ZbarSymbolPtr) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_loc_y"
  zbarSymbolGetLocY'_ :: ((ZbarSymbolPtr) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_next"
  zbarSymbolNext'_ :: ((ZbarSymbolPtr) -> (IO (ZbarSymbolPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_get_components"
  zbarSymbolGetComponents'_ :: ((ZbarSymbolPtr) -> (IO (ZbarSymbolSetPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_first_component"
  zbarSymbolFirstComponent'_ :: ((ZbarSymbolPtr) -> (IO (ZbarSymbolPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_xml"
  zbarSymbolXml'_ :: ((ZbarSymbolPtr) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_set_ref"
  zbarSymbolSetRef'_ :: ((ZbarSymbolSetPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_set_get_size"
  zbarSymbolSetGetSize'_ :: ((ZbarSymbolSetPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_symbol_set_first_symbol"
  zbarSymbolSetFirstSymbol'_ :: ((ZbarSymbolSetPtr) -> (IO (ZbarSymbolPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_create"
  zbarImageCreate'_ :: (IO (ZbarImagePtr))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_destroy"
  zbarImageDestroy'_ :: ((ZbarImagePtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_ref"
  zbarImageRef'_ :: ((ZbarImagePtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_convert"
  zbarImageConvert'_ :: ((ZbarImagePtr) -> (C2HSImp.CULong -> (IO (ZbarImagePtr))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_convert_resize"
  zbarImageConvertResize'_ :: ((ZbarImagePtr) -> (C2HSImp.CULong -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO (ZbarImagePtr))))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_format"
  zbarImageGetFormat'_ :: ((ZbarImagePtr) -> (IO C2HSImp.CULong))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_sequence"
  zbarImageGetSequence'_ :: ((ZbarImagePtr) -> (IO C2HSImp.CUInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_width"
  zbarImageGetWidth'_ :: ((ZbarImagePtr) -> (IO C2HSImp.CUInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_height"
  zbarImageGetHeight'_ :: ((ZbarImagePtr) -> (IO C2HSImp.CUInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_data"
  zbarImageGetData'_ :: ((ZbarImagePtr) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_data_length"
  zbarImageGetDataLength'_ :: ((ZbarImagePtr) -> (IO C2HSImp.CULong))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_symbols"
  zbarImageGetSymbols'_ :: ((ZbarImagePtr) -> (IO (ZbarSymbolSetPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_set_symbols"
  zbarImageSetSymbols'_ :: ((ZbarImagePtr) -> ((ZbarSymbolSetPtr) -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_first_symbol"
  zbarImageFirstSymbol'_ :: ((ZbarImagePtr) -> (IO (ZbarSymbolPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_set_format"
  zbarImageSetFormat'_ :: ((ZbarImagePtr) -> (C2HSImp.CULong -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_set_sequence"
  zbarImageSetSequence'_ :: ((ZbarImagePtr) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_set_size"
  zbarImageSetSize'_ :: ((ZbarImagePtr) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO ()))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_set_data"
  zbarImageSetData'_ :: ((ZbarImagePtr) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> ((C2HSImp.FunPtr ((ZbarImagePtr) -> (IO ()))) -> (IO ())))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_free_data"
  zbarImageFreeData'_ :: ((ZbarImagePtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_set_userdata"
  zbarImageSetUserdata'_ :: ((ZbarImagePtr) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_get_userdata"
  zbarImageGetUserdata'_ :: ((ZbarImagePtr) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_write"
  zbarImageWrite'_ :: ((ZbarImagePtr) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_read"
  zbarImageRead'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (ZbarImagePtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_create"
  zbarProcessorCreate'_ :: (C2HSImp.CInt -> (IO (ZbarProcessorPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_destroy"
  zbarProcessorDestroy'_ :: ((ZbarProcessorPtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_init"
  zbarProcessorInit'_ :: ((ZbarProcessorPtr) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_request_size"
  zbarProcessorRequestSize'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_request_interface"
  zbarProcessorRequestInterface'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_request_iomode"
  zbarProcessorRequestIomode'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_force_format"
  zbarProcessorForceFormat'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_set_data_handler"
  zbarProcessorSetDataHandler'_ :: ((ZbarProcessorPtr) -> ((C2HSImp.FunPtr ((ZbarImagePtr) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.FunPtr ((ZbarImagePtr) -> ((C2HSImp.Ptr ()) -> (IO ()))))))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_set_userdata"
  zbarProcessorSetUserdata'_ :: ((ZbarProcessorPtr) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_get_userdata"
  zbarProcessorGetUserdata'_ :: ((ZbarProcessorPtr) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_set_config"
  zbarProcessorSetConfig'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_parse_config"
  zbarProcessorParseConfig'_ :: ((ZbarProcessorPtr) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_is_visible"
  zbarProcessorIsVisible'_ :: ((ZbarProcessorPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_set_visible"
  zbarProcessorSetVisible'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_set_active"
  zbarProcessorSetActive'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_get_results"
  zbarProcessorGetResults'_ :: ((ZbarProcessorPtr) -> (IO (ZbarSymbolSetPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_user_wait"
  zbarProcessorUserWait'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_process_one"
  zbarProcessOne'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_process_image"
  zbarProcessImage'_ :: ((ZbarProcessorPtr) -> ((ZbarImagePtr) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_error_spew"
  zbarProcessorErrorSpew'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_error_string"
  zbarProcessorErrorString'_ :: ((ZbarProcessorPtr) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_processor_get_error_code"
  zbarProcessorGetErrorCode'_ :: ((ZbarProcessorPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_create"
  zbarVideoCreate'_ :: (IO (ZbarVideoPtr))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_get_fd"
  zbarVideoGetFd'_ :: ((ZbarVideoPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_request_size"
  zbarVideoRequestSize'_ :: ((ZbarVideoPtr) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_request_interface"
  zbarVideoRequestInterface'_ :: ((ZbarVideoPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_request_iomode"
  zbarVideoRequestIomode'_ :: ((ZbarVideoPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_get_width"
  zbarVideoGetWidth'_ :: ((ZbarVideoPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_get_height"
  zbarVideoGetHeight'_ :: ((ZbarVideoPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_init"
  zbarVideoInit'_ :: ((ZbarVideoPtr) -> (C2HSImp.CULong -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_enable"
  zbarVideoEnable'_ :: ((ZbarVideoPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_next_image"
  zbarVideoNextImage'_ :: ((ZbarVideoPtr) -> (IO (ZbarImagePtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_error_spew"
  zbarVideoErrorSpew'_ :: ((ZbarVideoPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_error_string"
  zbarVideoErrorString'_ :: ((ZbarVideoPtr) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_video_get_error_code"
  zbarVideoGetErrorCode'_ :: ((ZbarVideoPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_create"
  zbarWindowCreate'_ :: (IO (ZbarWindowPtr))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_destroy"
  zbarWindowDestroy'_ :: ((ZbarWindowPtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_attach"
  zbarWindowAttach'_ :: ((ZbarWindowPtr) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_set_overlay"
  zbarWindowSetOverlay'_ :: ((ZbarWindowPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_get_overlay"
  zbarWindowGetOverlay'_ :: ((ZbarWindowPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_draw"
  zbarWindowDraw'_ :: ((ZbarWindowPtr) -> ((ZbarImagePtr) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_redraw"
  zbarWindowRedraw'_ :: ((ZbarWindowPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_resize"
  zbarWindowResize'_ :: ((ZbarWindowPtr) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_error_spew"
  zbarWindowErrorSpew'_ :: ((ZbarWindowPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_error_string"
  zbarWindowErrorString'_ :: ((ZbarWindowPtr) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_window_get_error_code"
  zbarWindowGetErrorCode'_ :: ((ZbarWindowPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_negotiate_format"
  zbarNegotiateFormat'_ :: ((ZbarVideoPtr) -> ((ZbarWindowPtr) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_create"
  zbarImageScannerCreate'_ :: (IO (ZbarImageScannerPtr))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_destroy"
  zbarImageScannerDestroy'_ :: ((ZbarImageScannerPtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_set_data_handler"
  zbarImageScannerSetDataHandler'_ :: ((ZbarImageScannerPtr) -> ((C2HSImp.FunPtr ((ZbarImagePtr) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.FunPtr ((ZbarImagePtr) -> ((C2HSImp.Ptr ()) -> (IO ()))))))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_set_config"
  zbarImageScannerSetConfig'_ :: ((ZbarImageScannerPtr) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_parse_config"
  zbarImageScannerParseConfig'_ :: ((ZbarImageScannerPtr) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_enable_cache"
  zbarImageScannerEnableCache'_ :: ((ZbarImageScannerPtr) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_recycle_image"
  zbarImageScannerRecycleImage'_ :: ((ZbarImageScannerPtr) -> ((ZbarImagePtr) -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_image_scanner_get_results"
  zbarImageScannerGetResults'_ :: ((ZbarImageScannerPtr) -> (IO (ZbarSymbolSetPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scan_image"
  zbarScanImage'_ :: ((ZbarImageScannerPtr) -> ((ZbarImagePtr) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_create"
  zbarDecoderCreate'_ :: (IO (ZbarDecoderPtr))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_destroy"
  zbarDecoderDestroy'_ :: ((ZbarDecoderPtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_set_config"
  zbarDecoderSetConfig'_ :: ((ZbarDecoderPtr) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_parse_config"
  zbarDecoderParseConfig'_ :: ((ZbarDecoderPtr) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_reset"
  zbarDecoderReset'_ :: ((ZbarDecoderPtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_new_scan"
  zbarDecoderNewScan'_ :: ((ZbarDecoderPtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decode_width"
  zbarDecodeWidth'_ :: ((ZbarDecoderPtr) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_get_color"
  zbarDecoderGetColor'_ :: ((ZbarDecoderPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_get_data"
  zbarDecoderGetData'_ :: ((ZbarDecoderPtr) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_get_data_length"
  zbarDecoderGetDataLength'_ :: ((ZbarDecoderPtr) -> (IO C2HSImp.CUInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_get_type"
  zbarDecoderGetType'_ :: ((ZbarDecoderPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_set_handler"
  zbarDecoderSetHandler'_ :: ((ZbarDecoderPtr) -> ((C2HSImp.FunPtr ((ZbarDecoderPtr) -> (IO ()))) -> (IO (C2HSImp.FunPtr ((ZbarDecoderPtr) -> (IO ()))))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_set_userdata"
  zbarDecoderSetUserdata'_ :: ((ZbarDecoderPtr) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_decoder_get_userdata"
  zbarDecoderGetUserdata'_ :: ((ZbarDecoderPtr) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_create"
  zbarScannerCreate'_ :: ((ZbarDecoderPtr) -> (IO (ZbarScannerPtr)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_destroy"
  zbarScannerDestroy'_ :: ((ZbarScannerPtr) -> (IO ()))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_reset"
  zbarScannerReset'_ :: ((ZbarScannerPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_new_scan"
  zbarScannerNewScan'_ :: ((ZbarScannerPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_flush"
  zbarScannerFlush'_ :: ((ZbarScannerPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scan_y"
  zbarScanY'_ :: ((ZbarScannerPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scan_rgb24"
  zbarScanRgb24'_ :: ((ZbarScannerPtr) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_get_width"
  zbarScannerGetWidth'_ :: ((ZbarScannerPtr) -> (IO C2HSImp.CUInt))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_get_edge"
  zbarScannerGetEdge'_ :: ((ZbarScannerPtr) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (IO C2HSImp.CUInt))))

foreign import ccall safe "ZBar/Foreign.chs.h zbar_scanner_get_color"
  zbarScannerGetColor'_ :: ((ZbarScannerPtr) -> (IO C2HSImp.CInt))