module Data.ByteString.IsoBaseFileFormat.Boxes.FullBox
(FullBox(), fullBox, closedFullBox, BoxVersion, BoxFlags(..), Versioned(..)) where
import Data.ByteString.IsoBaseFileFormat.Boxes.Box
import Data.ByteString.IsoBaseFileFormat.Boxes.BoxFields
data FullBox version t where
FullBox ::
BoxVersion version -> BoxFlags 24 -> t -> FullBox version t
instance (KnownNat version,IsBoxContent t) => IsBoxContent (FullBox version t) where
boxSize (FullBox _ f c) = 1 + boxSize f + boxSize c
boxBuilder (FullBox v f c) = boxBuilder v <> boxBuilder f <> boxBuilder c
fullBox
:: (IsBoxType' t,ValidBoxes t ts,BoxContent t ~ FullBox version c)
=> BoxVersion version -> BoxFlags 24 -> c -> Boxes ts -> Box' t
fullBox version fs cnt = Box' (FullBox version fs cnt)
closedFullBox
:: (IsBoxType' t,ValidBoxes t '[],BoxContent t ~ FullBox version c)
=> BoxVersion version -> BoxFlags 24 -> c -> Box' t
closedFullBox version fs cnt = closedBox (FullBox version fs cnt)
type BoxVersion v = Template (U8 "fullbox-version") v
data Versioned v0 v1 (version :: Nat) where
V0 :: IsBoxContent v0 => v0 -> Versioned v0 v1 0
V1 :: IsBoxContent v1 => v1 -> Versioned v0 v1 1
instance IsBoxContent (Versioned v0 v1 version) where
boxSize (V0 c) = boxSize c
boxSize (V1 c) = boxSize c
boxBuilder (V0 c) = boxBuilder c
boxBuilder (V1 c) = boxBuilder c
newtype BoxFlags bits =
BoxFlags Integer
deriving (Eq,Show,Num)
boxFlagBitMask :: KnownNat bits
=> BoxFlags bits -> Integer
boxFlagBitMask px = 2 ^ natVal px 1
cropBits :: KnownNat bits
=> BoxFlags bits -> BoxFlags bits
cropBits f@(BoxFlags b) = BoxFlags (b .&. boxFlagBitMask f)
instance KnownNat bits => IsBoxContent (BoxFlags bits) where
boxSize f =
let minBytes = fromInteger $ natVal f `div` 8
modBytes = fromInteger $ natVal f `mod` 8
in BoxSize $ minBytes + signum modBytes
boxBuilder f@(BoxFlags b) =
let bytes =
let (BoxSize bytes') = boxSize f
in fromIntegral bytes'
wordSeq n
| n <= bytes =
word8 (fromIntegral (shiftR b ((bytes n) * 8) .&. 255)) <>
wordSeq (n + 1)
| otherwise = mempty
in wordSeq 1
instance KnownNat bits => Bits (BoxFlags bits) where
(.&.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r
(.|.) (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ l .&. r
xor (BoxFlags l) (BoxFlags r) = cropBits $ BoxFlags $ xor l r
complement (BoxFlags x) = cropBits $ BoxFlags $ complement x
shift (BoxFlags x) = cropBits . BoxFlags . shift x
rotateL = error "TODO rotateL"
rotateR = error "TODO rotateR"
bitSize = fromInteger . natVal
bitSizeMaybe = Just . fromInteger . natVal
isSigned _ = False
testBit f n =
let (BoxFlags b) = cropBits f
in testBit b n
bit = cropBits . BoxFlags . bit
popCount f =
let (BoxFlags b) = cropBits f
in popCount b
zeroBits = BoxFlags 0