module Data.ByteString.IsoBaseFileFormat.Boxes.VisualSampleEntry where
import Data.ByteString.IsoBaseFileFormat.Box
import Data.ByteString.IsoBaseFileFormat.Util.BoxFields
import Data.ByteString.IsoBaseFileFormat.Boxes.Handler
import Data.ByteString.IsoBaseFileFormat.ReExports
import qualified Data.Text as T
newtype VideoSampleEntry c where
VideoSampleEntry
:: U16 "pre_defined"
:+ Constant (U16 "reserved") 0
:+ U16 "width"
:+ U16 "height"
:+ Template (U32 "horizresolution") 0x00480000
:+ Template (U32 "vertresolution") 0x00480000
:+ Constant (U32 "reserved") 0
:+ Template (U16 "frame_count") 1
:+ FixSizeText 32 "compressorname"
:+ Template (U16 "depth") 0x0018
:+ Template (I16 "pre_defined") 65535
:+ Maybe (Box CleanAperture)
:+ Maybe (Box PixelAspectRatio)
:+ [Box SomeColourInformation]
:+ c
-> VideoSampleEntry c
deriving (IsBoxContent, Default)
type instance GetHandlerType (VideoSampleEntry c) = 'VideoTrack
type instance BoxTypeSymbol (VideoSampleEntry c) = BoxTypeSymbol c
instance IsBoxContent [Box SomeColourInformation] where
boxSize = sum . fmap boxSize
boxBuilder = fold . fmap boxBuilder
cleanAperture :: CleanAperture -> Box CleanAperture
cleanAperture = Box
newtype CleanAperture where
CleanAperture
:: U32 "cleanApertureWidthN"
:+ U32 "cleanApertureWidthD"
:+ U32 "cleanApertureHeightN"
:+ U32 "cleanApertureHeightD"
:+ U32 "horizOffN"
:+ U32 "horizOffD"
:+ U32 "vertOffN"
:+ U32 "vertOffD"
-> CleanAperture
deriving (Default, IsBoxContent)
type instance BoxTypeSymbol CleanAperture = "clap"
instance IsBox CleanAperture
pixelAspectRatio :: PixelAspectRatio -> Box PixelAspectRatio
pixelAspectRatio = Box
newtype PixelAspectRatio where
PixelAspectRatio
:: U32 "hSpacing"
:+ U32 "vSpacing"
-> PixelAspectRatio
deriving (Default, IsBoxContent)
type instance BoxTypeSymbol PixelAspectRatio = "pasp"
instance IsBox PixelAspectRatio
colourInformation
:: ColourType p -> ColourInformation p
colourInformation = ColourInformation . (Constant :+)
onScreenColourInformation
:: ColourType 'OnScreenColours -> ColourInformation 'OnScreenColours
onScreenColourInformation = colourInformation
restrictedICCProfileColourInformation
:: ColourType 'RestrictedICCProfile -> ColourInformation 'RestrictedICCProfile
restrictedICCProfileColourInformation = colourInformation
unrestrictedICCProfileColourInformation
:: ColourType 'UnrestrictedICCProfile -> ColourInformation 'UnrestrictedICCProfile
unrestrictedICCProfileColourInformation = colourInformation
type instance BoxTypeSymbol SomeColourInformation = "pasp"
instance IsBox SomeColourInformation
data SomeColourInformation where
SomeColourInformation
:: forall (profile :: ColourTypeProfile)
. IsBoxContent (ColourInformation profile)
=> !(ColourInformation profile)
-> SomeColourInformation
instance IsBoxContent SomeColourInformation where
boxSize (SomeColourInformation c) = boxSize c
boxBuilder (SomeColourInformation c) = boxBuilder c
newtype ColourInformation (profile :: ColourTypeProfile) where
ColourInformation
:: Constant (U32Text "colour_type") (ColourTypeCode profile)
:+ ColourType profile
-> ColourInformation profile
deriving instance
(Default (ColourType profile))
=> Default (ColourInformation profile)
deriving instance
(KnownSymbol (ColourTypeCode profile),IsBoxContent (ColourType profile))
=> IsBoxContent (ColourInformation profile)
data ColourTypeProfile =
OnScreenColours |
RestrictedICCProfile |
UnrestrictedICCProfile
type family
ColourType (p :: ColourTypeProfile) where
ColourType 'OnScreenColours =
U16 "colour_primaries"
:+ U16 "transfer_characteristics"
:+ U16 "matrix_coefficients"
:+ FullRangeFlag
ColourType 'RestrictedICCProfile =
T.Text
ColourType 'UnrestrictedICCProfile =
T.Text
data FullRangeFlag = IsFullRange | IsNotFullRange
instance IsBoxContent FullRangeFlag where
boxSize _ = 1
boxBuilder IsFullRange = word8 128
boxBuilder IsNotFullRange = word8 0
instance Default FullRangeFlag where
def = IsFullRange
type family
ColourTypeCode (p :: ColourTypeProfile) :: Symbol where
ColourTypeCode 'OnScreenColours = "nclx"
ColourTypeCode 'RestrictedICCProfile = "rICC"
ColourTypeCode 'UnrestrictedICCProfile = "prof"