module Swf.Bin where
import Data.Word
import Data.Int
import Data.Bits
import GHC.Base
import GHC.Word
import GHC.Float
import Numeric
type SwfString = String
type SwfLanguageCode = Int
type SwfRGB = (SwfU8, SwfU8, SwfU8)
type SwfRGBA = (SwfU8, SwfU8, SwfU8, SwfU8)
data SwfRect = SwfRect SwfSB SwfSB SwfSB SwfSB
| SwfRectS SwfU8 SwfSB SwfSB SwfSB SwfSB
deriving Show
type SwfU32 = Word32
type SwfU16 = Word16
type SwfU8 = Word8
type SwfUB = Word32
type SwfSB = Int32
type SwfBool = Bool
type SwfFloat = Float
type SwfDouble = Double
class NBits a where
nBits :: a -> Word8
instance NBits Word8 where
nBits = nuBits
instance NBits Word16 where
nBits = nuBits
instance NBits Word32 where
nBits = nuBits
instance NBits Int8 where
nBits = nsBits
instance NBits Int16 where
nBits = nsBits
instance NBits Int32 where
nBits = nsBits
instance NBits Int where
nBits = nsBits
nuBits :: (Ord a, Bits a) => a -> Word8
nuBits n = fromIntegral (length [n | y <- [0 .. 31], n `shiftR` y > 0 ])
nsBits :: (Ord a, Bits a) => a -> Word8
nsBits n
| n > 0 = fromIntegral (1 + length [n | y <- [0 .. 31], n `shiftR` y > 0 ])
| n == 0 = 1
| n < 0 = fromIntegral (1 + (length [n | y <- [0 .. 31], n `shiftR` y < 1 ]))
addBits :: (Integral a, Ord a, Bits a) => ([Word8], Int) -> (a, Int) -> ([Word8], Int)
addBits (bytes,0) (word, nbits)
| nbits < 8 = ((fromIntegral (word `shiftL` (8 nbits)):bytes), (8 nbits))
| nbits == 8 = (fromIntegral word:bytes, 0)
| otherwise = ((fromIntegral (word `shiftR` (nbits 8)):bytes), 0) `addBits` (word, (nbits 8))
addBits ((hd:tl),emptyCount) (word, nbits)
| nbits < emptyCount = ((((fromIntegral ((word .&. (bitMask nbits)) `shiftL` (emptyCount nbits))) .|. hd):tl),
(emptyCount nbits))
| nbits == emptyCount = ((((fromIntegral (word .&. (bitMask nbits))) .|. hd):tl), 0)
| otherwise = ((((fromIntegral ((word `shiftR` (nbits emptyCount))) .&. (bitMask emptyCount)) .|. hd):tl), 0) `addBits` (word, (nbits emptyCount))
where
bitMask n = ((1 `shiftL` n) 1)
finalizeBits :: ([Word8],Int) -> [Word8]
finalizeBits (bytes, _) = reverse bytes
class Has a where
has :: a -> Word8
instance Has (Maybe a) where
has Nothing = 0
has (Just _) = 1
instance Has SwfBool where
has False = 0
has True = 1
class SwfBin a where
toBin :: a -> [Word8]
class SwfBinPartial a where
toBinP :: Word8 -> Word8 -> ([Word8],Int) -> a -> ([Word8],Int)
instance SwfBin Word8 where
toBin w8 = [w8]
instance SwfBin Word16 where
toBin w16 = [ fromIntegral (w16 .&. 0xff)
, fromIntegral ((w16 `shiftR` 8) .&. 0xff)
]
instance SwfBin Word32 where
toBin w32 = [ fromIntegral (w32 .&. 0xff)
, fromIntegral ((w32 `shiftR` 8) .&. 0xff)
, fromIntegral ((w32 `shiftR` 16) .&. 0xff)
, fromIntegral ((w32 `shiftR` 24) .&. 0xff)
]
instance SwfBin Word64 where
toBin w64 = [ fromIntegral (w64 .&. 0xff)
, fromIntegral ((w64 `shiftR` 8) .&. 0xff)
, fromIntegral ((w64 `shiftR` 16) .&. 0xff)
, fromIntegral ((w64 `shiftR` 24) .&. 0xff)
, fromIntegral ((w64 `shiftR` 32) .&. 0xff)
, fromIntegral ((w64 `shiftR` 40) .&. 0xff)
, fromIntegral ((w64 `shiftR` 48) .&. 0xff)
, fromIntegral ((w64 `shiftR` 56) .&. 0xff)
]
instance SwfBin Int where
toBin w32 = [ fromIntegral (w32 .&. 0xff)
, fromIntegral ((w32 `shiftR` 8) .&. 0xff)
, fromIntegral ((w32 `shiftR` 16) .&. 0xff)
, fromIntegral ((w32 `shiftR` 24) .&. 0xff)
]
instance SwfBin Float where
toBin (F# f) = toBin (W32# (unsafeCoerce# f))
instance SwfBin Double where
toBin (D# d) = toBin (W64# (unsafeCoerce# d))
instance SwfBin Char where
toBin char = [(fromIntegral . fromEnum) char]
instance SwfBin a => SwfBin [a] where
toBin str = (concatMap toBin str) ++ [0]
instance (SwfBin a, SwfBin b) => SwfBin (a,b) where
toBin (x, y) = toBin x ++ toBin y
instance (SwfBin a, SwfBin b, SwfBin c) => SwfBin (a,b,c) where
toBin (w, x, y) = toBin w ++ toBin x ++ toBin y
instance (SwfBin a, SwfBin b, SwfBin c, SwfBin d) => SwfBin (a,b,c,d) where
toBin (w, x, y, z) = toBin w ++ toBin x ++ toBin y ++ toBin z
instance (SwfBin a, SwfBin b, SwfBin c, SwfBin d, SwfBin e) => SwfBin (a,b,c,d,e) where
toBin (v, w, x, y, z) = toBin v ++ toBin w ++ toBin x ++ toBin y ++ toBin z
instance (SwfBin a) => SwfBin (Maybe a) where
toBin Nothing = []
toBin (Just x) = toBin x