module Codec.Container.Ogg.Chain (
OggChain (..),
chainScan,
chainAddSkeleton
) where
import qualified Data.ByteString.Lazy as L
import Data.Maybe
import Codec.Container.Ogg.ContentType
import Codec.Container.Ogg.Granulepos
import Codec.Container.Ogg.Track
import Codec.Container.Ogg.Page
import Codec.Container.Ogg.Packet
import Codec.Container.Ogg.Serial
import Codec.Container.Ogg.Skeleton
data OggChain =
OggChain {
chainTracks :: [OggTrack],
chainPages :: [OggPage],
chainPackets :: [OggPacket]
}
chainScan :: L.ByteString -> [OggChain]
chainScan d
| L.null d = []
| otherwise = chain : chainScan rest
where chain = OggChain tracks pages packets
(tracks, pages, rest) = pageScan d
packets = pagesToPackets pages
chainAddSkeleton :: OggChain -> IO OggChain
chainAddSkeleton chain = do
serialno <- genSerial
return $ chainAddSkeleton' serialno chain
chainAddSkeleton' :: Serial -> OggChain -> OggChain
chainAddSkeleton' serialno (OggChain tracks _ packets) = OggChain nt ng np
where
nt = skelTrack : tracks
ng = packetsToPages np
np = fh : concat [ixBoss, ixFisbones, ixHdrs, [sEOS], ixD]
skelTrack = (newTrack serialno){trackType = Just skeleton}
fh = fisheadToPacket skelTrack emptyFishead
fbs = map (fisboneToPacket skelTrack) $ tracksToFisbones tracks
(boss, rest) = span packetBOS packets
ixBoss = map (incPageIx 1) boss
(hdrs, d) = splitAt totHeaders rest
totHeaders = sum $ map trackHeaders tracks
ixHdrs = map (incPageIx (1 + length fbs)) hdrs
ixD = map (incPageIx (2 + length fbs)) d
ixFisbones = zipWith setPageIx [1+(length tracks)..] fbs
sEOS = (uncutPacket L.empty skelTrack sEOSgp){packetEOS = True}
sEOSgp = Granulepos (Just 0)
setPageIx :: Int -> OggPacket -> OggPacket
setPageIx ix p@(OggPacket _ _ _ _ _ (Just [oldSegment])) =
p{packetSegments = Just [newSegment]}
where
newSegment = oldSegment{segmentPageIx = ix}
setPageIx _ _ = error "setPageIx used on non-uncut page"
incPageIx :: Int -> OggPacket -> OggPacket
incPageIx ixd p@(OggPacket _ _ _ _ _ (Just segments)) =
p{packetSegments = Just (map incSegIx segments)}
where
incSegIx :: OggSegment -> OggSegment
incSegIx s@(OggSegment _ oix _) = s{segmentPageIx = oix + ixd}
incPageIx _ p = p