module Opentype.Fileformat.Types where
import Data.Word
import Data.Int
import Data.Bits
import Data.Binary.Put
import Data.ByteString.Unsafe
import qualified Data.ByteString as Strict
import qualified Data.Map as M
newtype ShortFrac = ShortFrac Int16
type Fixed = Word32
type FWord = Int16
type UFWord = Word16
type GlyphID = Word16
data PlatformID =
UnicodePlatform |
MacintoshPlatform |
MicrosoftPlatform
deriving (Ord, Eq, Show)
type WordMap a = M.Map Word32 a
iLog2 :: Integral a => a -> a
iLog2 = iLog2' 0 where
iLog2' base i
| i > 0 = iLog2' (base+1) (i `quot` 2)
| otherwise = base1
byteAt :: (Bits a, Num a) => a -> Int -> Bool
byteAt flag i = flag .&. 1 `shift` i /= 0
makeFlag :: [Bool] -> Word16
makeFlag l =
fromIntegral $ sum $ zipWith (*) (iterate (*2) 1) $
map fromEnum l
instance Num ShortFrac where
(ShortFrac a) + (ShortFrac b) = ShortFrac $ a + b
(ShortFrac a) (ShortFrac b) = ShortFrac $ a b
(ShortFrac a) * (ShortFrac b) =
ShortFrac $ fromIntegral (((fromIntegral a :: Int32) * (fromIntegral b :: Int32)) `shift` (14))
abs (ShortFrac a) = ShortFrac $ abs a
fromInteger i = ShortFrac $ fromIntegral i `shift` 14
signum (ShortFrac a) = fromIntegral $ signum a
instance Eq ShortFrac where
(ShortFrac a) == (ShortFrac b) = a == b
instance Ord ShortFrac where
compare (ShortFrac a) (ShortFrac b) = compare a b
instance Fractional ShortFrac where
fromRational r =
ShortFrac $ fromIntegral $
floor ((r+2) * 0x4000) (0x8000::Word16)
(ShortFrac a) / (ShortFrac b) =
ShortFrac $ fromIntegral $
((fromIntegral a :: Int32) `shift` 14) `quot` fromIntegral b
instance Show ShortFrac where
show a = show (realToFrac a :: Float)
instance Real ShortFrac where
toRational (ShortFrac a) =
fromIntegral ((fromIntegral a::Word16) + 0x8000) / 0x4000 2
instance RealFrac ShortFrac where
properFraction (ShortFrac a)
| a < 0 && f /= 0 = (i+1, ShortFrac (f))
| otherwise = (i, ShortFrac f)
where i = fromIntegral (((fromIntegral a :: Word16) + 0x8000) `shift` (14)) 2
f = a .&. 0x3fff
putShortFrac :: ShortFrac -> Put
putShortFrac (ShortFrac a) = putInt16be a
putPf :: PlatformID -> Put
putPf UnicodePlatform = putWord16be 0
putPf MacintoshPlatform = putWord16be 1
putPf MicrosoftPlatform = putWord16be 3
toPf :: Word16 -> Either String PlatformID
toPf i =
case i of
0 -> Right UnicodePlatform
1 -> Right MacintoshPlatform
3 -> Right MicrosoftPlatform
j -> Left $ "unknown platformID " ++ show j
index16 :: Strict.ByteString -> Word16 -> Either String Word16
index16 bs i
| Strict.length bs < fromIntegral ((i+1)*2) ||
i < 0 = Left $ "Index " ++ show i ++ " out of Bounds"
| otherwise = Right $ b1 * 256 + b2
where
b1, b2 :: Word16
b1 = fromIntegral $ unsafeIndex bs (fromIntegral $ i*2)
b2 = fromIntegral $ unsafeIndex bs (fromIntegral $ i*2 + 1)
index32 :: Strict.ByteString -> Word32 -> Either String Word32
index32 bs i
| Strict.length bs < fromIntegral ((i+1)*4) ||
i < 0 = Left $ "Index " ++ show i ++ " Out of Bounds"
| otherwise = Right $ b1 `shift` 24 .|. b2 `shift` 16 .|. b3 `shift` 8 .|. b4
where
b1, b2, b3, b4 :: Word32
b1 = fromIntegral $ unsafeIndex bs (fromIntegral $ i*4)
b2 = fromIntegral $ unsafeIndex bs (fromIntegral $ i*4 + 1)
b3 = fromIntegral $ unsafeIndex bs (fromIntegral $ i*4 + 2)
b4 = fromIntegral $ unsafeIndex bs (fromIntegral $ i*4 + 3)