68 lines
1.8 KiB
Haskell
68 lines
1.8 KiB
Haskell
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
|
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
|
obtain one at https://mozilla.org/MPL/2.0/. -}
|
|
|
|
-- | Generic font types.
|
|
module Graphics.Fountainhead.Type
|
|
( F2Dot14(..)
|
|
, Fixed32(..)
|
|
, FWord
|
|
, UFWord
|
|
, fixed2Double
|
|
, succIntegral
|
|
, ttfEpoch
|
|
) where
|
|
|
|
import Data.Bits ((.>>.), (.&.))
|
|
import Data.Int (Int16, Int32)
|
|
import Data.Word (Word16, Word32)
|
|
import Data.Time (Day(..))
|
|
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
|
|
import Data.Fixed (HasResolution(..))
|
|
|
|
newtype Fixed32 = Fixed32 Word32
|
|
deriving (Eq, Show)
|
|
|
|
instance Num Fixed32
|
|
where
|
|
(Fixed32 x) + (Fixed32 y) = Fixed32 $ x + y
|
|
(Fixed32 x) - (Fixed32 y) = Fixed32 $ x - y
|
|
(Fixed32 x) * (Fixed32 y) = Fixed32 $ div (x * y) 65536
|
|
abs (Fixed32 x) = Fixed32 $ fromIntegral $ abs (fromIntegral x :: Int32)
|
|
signum (Fixed32 x)
|
|
| x == 0 = Fixed32 0
|
|
| (fromIntegral x :: Int32) < 0 = Fixed32 0xffff0000
|
|
| otherwise = Fixed32 0x10000
|
|
fromInteger x = Fixed32 $ fromInteger $ x * 65536
|
|
|
|
instance Ord Fixed32
|
|
where
|
|
compare (Fixed32 x) (Fixed32 y) =
|
|
compare (fromIntegral x :: Int32) (fromIntegral y)
|
|
|
|
instance Real Fixed32
|
|
where
|
|
toRational (Fixed32 x) = toRational (fromIntegral x :: Int32) / 65536.0
|
|
|
|
instance HasResolution Fixed32
|
|
where
|
|
resolution = const 65536
|
|
|
|
newtype F2Dot14 = F2Dot14 Int16
|
|
deriving (Eq, Show)
|
|
|
|
type FWord = Int16
|
|
type UFWord = Word16
|
|
|
|
ttfEpoch :: Day
|
|
ttfEpoch = fromOrdinalDate 1904 1
|
|
|
|
succIntegral :: Integral a => a -> Int
|
|
succIntegral = succ . fromIntegral
|
|
|
|
fixed2Double :: F2Dot14 -> Double
|
|
fixed2Double (F2Dot14 fixed) =
|
|
let mantissa = realToFrac (fixed .>>. 14)
|
|
fraction = realToFrac (fixed .&. 0x3fff) / 16384.0
|
|
in mantissa + fraction
|