{-# LINE 1 "Theora/Encoding.hsc" #-}
{-#LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "Theora/Encoding.hsc" #-}
{-#OPTIONS -fglasgow-exts -logg -ltheora #-}

-- | This module calls the libtheora C library to generate video ogg files from YCbCr images.
--  As explained on <http://theora.org/doc/libtheora-1.0/group__encfuncs.html>, the basic steps
--  for creating a video are the following :
--
--  * create in an 'Info' record
--
--  * call 'encodeAlloc' on it
--
--  * call 'flushHeader' until it returns 'Nothing'
--
--  * For each uncompressed frame, submit it with 'encodeIn', then retrieve potential packets 
-- with 'encodeOut'

module Theora.Encoding (-- * Theora structures and function
                        Info(..),Comment (..),
                        PixelFmt(Pf420,Pf422,Pf444),ColorSpace(..),
                        encodeAlloc,
                        flushHeader,
                        ImgPlane,
                        YCbCrBuffer(..),newYCbCr,
                        encodeIn, encodeOut,
                        -- * Ogg-related functions
                        OggPacket,newOggStreamState,
                        OggPage,streamPacketIn, streamPageOut, streamFlush) where



import Foreign.Storable
import Foreign
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.C.String
import Data.Int


{-# LINE 39 "Theora/Encoding.hsc" #-}

{-# LINE 40 "Theora/Encoding.hsc" #-}

{-| Theora supports 4 different pixel formats, listed in 
  <http://theora.org/doc/Theora.pdf>. YCbCr chroma frames (Cb and Cr) may be resized for
  compression (see <http://en.wikipedia.org/Ycbcr>). The resulting pixel formats
  are as follows :

-}

data PixelFmt=
    Pf420    -- ^Chroma decimation by 2 in both directions
    | PfRsvd
    | Pf422  -- ^Chroma decimation by 2 in the /x/ direction
    | Pf444  -- ^No chroma decimation

instance Enum PixelFmt where
    fromEnum Pf420= 0
{-# LINE 56 "Theora/Encoding.hsc" #-}
    fromEnum PfRsvd= 1
{-# LINE 57 "Theora/Encoding.hsc" #-}
    fromEnum Pf422= 2
{-# LINE 58 "Theora/Encoding.hsc" #-}
    fromEnum Pf444= 3
{-# LINE 59 "Theora/Encoding.hsc" #-}

    toEnum (0)=Pf420
{-# LINE 61 "Theora/Encoding.hsc" #-}
    toEnum (1)=PfRsvd
{-# LINE 62 "Theora/Encoding.hsc" #-}
    toEnum (2)=Pf422
{-# LINE 63 "Theora/Encoding.hsc" #-}
    toEnum (3)=Pf444
{-# LINE 64 "Theora/Encoding.hsc" #-}

data ColorSpace=
    Unspecified
    |ItuRec470M   -- ^A color space designed for NTSC content
    |ItuRec470BG  -- ^A color space designed for PAL/SECAM content
instance Enum ColorSpace where
    fromEnum Unspecified = 0
{-# LINE 71 "Theora/Encoding.hsc" #-}
    fromEnum ItuRec470M = 1
{-# LINE 72 "Theora/Encoding.hsc" #-}
    fromEnum ItuRec470BG = 2
{-# LINE 73 "Theora/Encoding.hsc" #-}

    toEnum (0)=Unspecified
{-# LINE 75 "Theora/Encoding.hsc" #-}
    toEnum (1)=ItuRec470M
{-# LINE 76 "Theora/Encoding.hsc" #-}
    toEnum (2)=ItuRec470BG
{-# LINE 77 "Theora/Encoding.hsc" #-}
    
data Info=Info {frameWidth::Int32,
                frameHeight::Int32,
                picWidth::Int32,
                picHeight::Int32,
                picX::Int32,
                picY::Int32,
                colorSpace::ColorSpace,
                pixelFmt::PixelFmt,
                targetBitRate::CInt,
                quality::CInt,
                keyframeGranuleShift::CInt}
efault= -1
{-# LINE 90 "Theora/Encoding.hsc" #-}
instance Storable Info where
    sizeOf _ = (64)
{-# LINE 92 "Theora/Encoding.hsc" #-}
    alignment _=1
    peek ptr = do
      fw<-((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 95 "Theora/Encoding.hsc" #-}
      fh<-((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 96 "Theora/Encoding.hsc" #-}
      pw<-((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 97 "Theora/Encoding.hsc" #-}
      ph<-((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 98 "Theora/Encoding.hsc" #-}
      px<-((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 99 "Theora/Encoding.hsc" #-}
      py<-((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 100 "Theora/Encoding.hsc" #-}
      cspace<-((\hsc_ptr -> peekByteOff hsc_ptr 44)) ptr
{-# LINE 101 "Theora/Encoding.hsc" #-}
      pfmt<-((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 102 "Theora/Encoding.hsc" #-}
      brate<-((\hsc_ptr -> peekByteOff hsc_ptr 52)) ptr
{-# LINE 103 "Theora/Encoding.hsc" #-}
      qual<-((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
{-# LINE 104 "Theora/Encoding.hsc" #-}
      kframe<-((\hsc_ptr -> peekByteOff hsc_ptr 60)) ptr
{-# LINE 105 "Theora/Encoding.hsc" #-}
      return Info {frameWidth=fw,
                   frameHeight=fh,
                   picWidth=pw,
                   picHeight=ph,
                   picX=px,
                   picY=py,
                   colorSpace=toEnum cspace,
                   pixelFmt=toEnum pfmt,
                   targetBitRate=brate,
                   quality=qual,
                   keyframeGranuleShift=kframe}

    poke ptr (Info fw fh pw ph px py cspace pfmt brate qual kframe)=do
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr fw
{-# LINE 119 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr fh
{-# LINE 120 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr pw
{-# LINE 121 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr ph
{-# LINE 122 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr px
{-# LINE 123 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr py
{-# LINE 124 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 44)) ptr $ fromEnum cspace
{-# LINE 125 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr $ fromEnum pfmt
{-# LINE 126 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 52)) ptr brate
{-# LINE 127 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) ptr qual
{-# LINE 128 "Theora/Encoding.hsc" #-}
                         ((\hsc_ptr -> pokeByteOff hsc_ptr 60)) ptr kframe
{-# LINE 129 "Theora/Encoding.hsc" #-}

data OggPacket=Packet {packet::Ptr CChar,
                       bytes::CLong,
                       bos::CLong,
                       eos::CLong,
                       granulePos::Int64,
                       packetNo::Int64}
            
instance Storable OggPacket where
    sizeOf _= (32)
{-# LINE 139 "Theora/Encoding.hsc" #-}
    alignment _=1
    peek ptr=do
      packet<-((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 142 "Theora/Encoding.hsc" #-}
      bytes<-((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 143 "Theora/Encoding.hsc" #-}
      bos<-((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 144 "Theora/Encoding.hsc" #-}
      eos<-((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 145 "Theora/Encoding.hsc" #-}
      granulePos<-((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 146 "Theora/Encoding.hsc" #-}
      packetNo<-((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 147 "Theora/Encoding.hsc" #-}
      return $ Packet {packet=packet,
                       bytes=bytes,
                       bos=bos,
                       eos=eos,
                       granulePos=granulePos,
                       packetNo=packetNo}
    poke ptr (Packet pack bytes bos eos gpos pno)=do
                              ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr pack
{-# LINE 155 "Theora/Encoding.hsc" #-}
                              ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr bytes
{-# LINE 156 "Theora/Encoding.hsc" #-}
                              ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr bos
{-# LINE 157 "Theora/Encoding.hsc" #-}
                              ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr eos
{-# LINE 158 "Theora/Encoding.hsc" #-}
                              ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr gpos
{-# LINE 159 "Theora/Encoding.hsc" #-}
                              ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr pno
{-# LINE 160 "Theora/Encoding.hsc" #-}
{-                              
instance Show OggPacket where
    show (Packet p b bos eos gran no)=
       unsafePerformIO (peekCStringLen (p,fromIntegral b))
-}

data ThEncCtx
type EncCtx=ForeignPtr ThEncCtx
foreign import ccall "theora/theora.h th_encode_alloc" th_encode_alloc::(Ptr Info)->IO (Ptr ThEncCtx)
foreign import ccall "theora/theora.h th_info_init" th_info_init::(Ptr Info)->IO ()
foreign import ccall "theora/theora.h &th_encode_free" th_encode_free::FunPtr ((Ptr ThEncCtx)->IO())

-- | Makes an encoder ('EncCtx') instance out of an 'Info' record
encodeAlloc::Info->IO (Maybe EncCtx)
encodeAlloc inf=do
  ptr<-alloca (\i->do
                 th_info_init i
                 poke i inf
                 th_encode_alloc i)
  if ptr==nullPtr then return Nothing else
      newForeignPtr th_encode_free ptr >>= (return.Just)


data Comment=Comment {
      user::[String], -- ^Your comments
      vendor::String -- ^Name of the encoder, i.e. your application
    }
instance Storable Comment where
    sizeOf _ = (16)
{-# LINE 189 "Theora/Encoding.hsc" #-}
    alignment _=1
    peek ptr=do
      length<- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 192 "Theora/Encoding.hsc" #-}
      c_userComments<-peekArray length =<< ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 193 "Theora/Encoding.hsc" #-}
      userComments<-mapM (peekCString) c_userComments
      vendor<-((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr >>= peekCString
{-# LINE 195 "Theora/Encoding.hsc" #-}
      return $Comment {user=userComments,
                       vendor=vendor}
    poke ptr comment= do
      -- user_comments
      userComments<-mallocArray (length $ user comment)
      cstrings<-mapM (\str->newCString str) $user comment
      pokeArray userComments cstrings
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr userComments
{-# LINE 203 "Theora/Encoding.hsc" #-}
      -- comments_length
      commentLengths<-mallocArray (length $ user comment)
      pokeArray commentLengths (map length $ user comment)
      ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr commentLengths
{-# LINE 207 "Theora/Encoding.hsc" #-}
      -- length
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr (length $ user comment)
{-# LINE 209 "Theora/Encoding.hsc" #-}
      -- vendor
      ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr =<< (newCString $ vendor comment)
{-# LINE 211 "Theora/Encoding.hsc" #-}

data HeaderPacket=HeaderPacket
foreign import ccall "theora/theora.h th_comment_init" th_comment_init::Ptr Comment->IO()
foreign import ccall "theora/theora.h th_encode_flushheader" th_encode_flushheader::
            (Ptr ThEncCtx)->(Ptr Comment)->(Ptr OggPacket)->IO CInt

-- | Returns the last header packets. This function should be called before
-- encoding actual video.
flushHeader::EncCtx->Comment->IO [OggPacket]
flushHeader enc comment=
            withForeignPtr enc (\encctx->
                                alloca (\ogg->
                                        alloca (\pComment->
                                                do
                                                  th_comment_init pComment
                                                  poke pComment comment
                                                  ret<-th_encode_flushheader encctx pComment ogg
                                                  if ret==0 || ret==efault then return [] else
                                                      do
                                                        tl<-flushHeader enc comment
                                                        peek ogg >>= return.(:tl))))


data ImgPlane=ImgPlane {width::CInt,
                        height::CInt,
                        stride::CInt,
                        img::ForeignPtr CUChar}

instance Storable ImgPlane where
    sizeOf _= (16)
{-# LINE 241 "Theora/Encoding.hsc" #-}
    alignment _=1
    peek ptr=do
      width<-((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 244 "Theora/Encoding.hsc" #-}
      height<-((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 245 "Theora/Encoding.hsc" #-}
      stride<-((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 246 "Theora/Encoding.hsc" #-}
      img<-(((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr) >>= newForeignPtr finalizerFree
{-# LINE 247 "Theora/Encoding.hsc" #-}
      return $ ImgPlane {width=width,
                         height=height,
                         stride=stride,
                         img=img}
    poke ptr (ImgPlane w h s i)=do
                             ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr w
{-# LINE 253 "Theora/Encoding.hsc" #-}
                             ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr h
{-# LINE 254 "Theora/Encoding.hsc" #-}
                             ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr s
{-# LINE 255 "Theora/Encoding.hsc" #-}
                             withForeignPtr i (\img->((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr img)
{-# LINE 256 "Theora/Encoding.hsc" #-}

foreign import ccall "theora/theora.h th_encode_ycbcr_in" th_encode_ycbcr_in::
        (Ptr ThEncCtx)->(Ptr YCbCrBuffer)->IO CInt

-- | 'YCbCrBuffer' is the type of raw YCbCr frames
data YCbCrBuffer=YCbCr {
      y ::ImgPlane, -- ^ the Y plane
      cb::ImgPlane, -- ^ the Cb plane
      cr::ImgPlane  -- ^ the Cr plane
    }

instance Storable YCbCrBuffer where
    sizeOf _= (48)
{-# LINE 269 "Theora/Encoding.hsc" #-}
    alignment _= sizeOf (undefined :: Ptr ImgPlane)
    peek imgPtr=do
      let ptr=castPtr imgPtr
      y<-peek ptr
      cb<-peek (ptr`plusPtr`(sizeOf (undefined :: ImgPlane)))
      cr<-peek (ptr`plusPtr`(2*(sizeOf (undefined :: ImgPlane))))
      return $ YCbCr {y=y,
                      cb=cb,
                      cr=cr}
    poke imgPtr (YCbCr y cb cr)=do
                                let ptr=castPtr imgPtr
                                poke ptr y
                                poke (ptr`plusPtr`(sizeOf (undefined::ImgPlane))) cb
                                poke (ptr`plusPtr`(2*(sizeOf (undefined::ImgPlane)))) cr


-- |Allocate a new YCbCrBuffer object
newYCbCr::Int->Int->PixelFmt->IO YCbCrBuffer
newYCbCr wH hH Pf420=do
  yImg<-newForeignPtr finalizerFree =<< (mallocBytes $ wH*hH)
  cbImg<-newForeignPtr finalizerFree =<< (mallocBytes $ (wH*hH)`quot`4)
  crImg<-newForeignPtr finalizerFree =<< (mallocBytes $ (wH*hH)`quot`4)
  let w=(fromIntegral wH)`quot`2
      h=(fromIntegral hH)`quot`2
      y=ImgPlane {width=fromIntegral wH,
                  height=fromIntegral hH,
                  stride=w,
                  img=yImg}
      cb=ImgPlane{width=w,
                  height=h,
                  stride=w,
                  img=cbImg}
      cr=ImgPlane{width=w,
                  height=h,
                  stride=w,
                  img=crImg}
  return $ YCbCr {y=y,cb=cb,cr=cr}

-- |Submits a frame for encoding
encodeIn::EncCtx->YCbCrBuffer->IO()
encodeIn enc buf=
         withForeignPtr enc (\enc->alloca (\pbuf->do
                                             poke pbuf buf
                                             ret<-th_encode_ycbcr_in enc pbuf
                                             return ()))

foreign import ccall "theora/theora.h th_encode_packetout" th_encode_packetout::
        Ptr ThEncCtx->CInt->Ptr OggPacket->IO CInt

-- |Retrieve all the ready encoded packets
encodeOut::EncCtx->Bool->IO [OggPacket]
encodeOut e last=
          withForeignPtr e (\enc->
                              alloca (\packet->do
                                        res<-th_encode_packetout enc (if last then 1 else 0) packet
                                        if res==0 || res==efault then return [] else do
                                                                                  tl<-encodeOut e last
                                                                                  peek packet >>= (return.(:tl))))
  

data OggPage=OggPage{header::Ptr CChar,
                     headerLen::CLong,
                     body::Ptr CChar,
                     bodyLen::CLong}

instance Storable OggPage where
    sizeOf _= (16)
{-# LINE 336 "Theora/Encoding.hsc" #-}
    alignment _=1
    peek ptr=do
      header<-((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 339 "Theora/Encoding.hsc" #-}
      headerLen<-((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 340 "Theora/Encoding.hsc" #-}
      body<-((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 341 "Theora/Encoding.hsc" #-}
      bodyLen<-((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 342 "Theora/Encoding.hsc" #-}
      return $ OggPage{header=header, headerLen=headerLen, body=body, bodyLen=bodyLen}
    poke ptr x=do
      ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (header x)
{-# LINE 345 "Theora/Encoding.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (headerLen x)
{-# LINE 346 "Theora/Encoding.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr $ body x
{-# LINE 347 "Theora/Encoding.hsc" #-}
      ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr $ bodyLen x
{-# LINE 348 "Theora/Encoding.hsc" #-}


instance Show OggPage where
    show (OggPage hdr hdrl body bodyl)=
        unsafePerformIO (do
                          head<-peekCStringLen (hdr,fromIntegral hdrl)
                          body<-peekCStringLen (body,fromIntegral bodyl)
                          return $ head++body)
data COggStreamState
type OggStreamState=ForeignPtr COggStreamState
instance Storable COggStreamState where
    sizeOf _= (360)
{-# LINE 360 "Theora/Encoding.hsc" #-}
    alignment _=1

foreign import ccall "theora/theora.h ogg_stream_init" ogg_stream_init::
            (Ptr COggStreamState)->CInt->IO CInt
foreign import ccall "theora/theora.h ogg_stream_packetin" ogg_stream_packetin::
            (Ptr COggStreamState)->(Ptr OggPacket)->IO CInt
foreign import ccall "theora/theora.h ogg_stream_pageout" ogg_stream_pageout::
            (Ptr COggStreamState)->(Ptr OggPage)->IO CInt
foreign import ccall "theora/theora.h ogg_stream_flush" ogg_stream_flush::
            (Ptr COggStreamState)->(Ptr OggPage)->IO CInt

-- |Initializes an Ogg container stream
newOggStreamState::Int->IO OggStreamState
newOggStreamState initial=do
  state<-malloc
  success<-ogg_stream_init state $ fromIntegral initial
  newForeignPtr finalizerFree state

-- |Submits an encoded packet into the streams
streamPacketIn::OggStreamState->OggPacket->IO ()
streamPacketIn state packet=
               withForeignPtr state (\s->
                                     alloca(\pack->do
                                              poke pack packet
                                              ogg_stream_packetin s pack
                                              return ()))
-- |Get an outputable Ogg page               
streamPageOut::OggStreamState->IO (Maybe OggPage)
streamPageOut state=
              withForeignPtr state (\s->
                                    alloca(\page->do
                                          result<-ogg_stream_pageout s page
                                          if result==0 then return Nothing else
                                              peek page >>= return.Just))

-- | Retrieve the last pages of the stream
streamFlush::OggStreamState->IO (Maybe OggPage)
streamFlush state=
            withForeignPtr state (\s->
                                  alloca (\page->do
                                            res<-ogg_stream_flush s page
                                            if res==0 then return Nothing else
                                                peek page >>= (return.Just) ))