Common.hs

-- | Common data types and functions

{-# LANGUAGE FlexibleInstances, PatternSynonyms #-}
module Graphics.Rendering.MiniTypeset.Common where

--------------------------------------------------------------------------------
-- * Font-related things

-- | Basic variations in a typeface (font family)
data BasicStyle
  = Regular
  | Bold
  | Italic
  | BoldItalic
  deriving (Eq,Ord,Show)

-- | Font height in pixels
newtype Height
  = Height Int
  deriving (Eq,Ord,Show) 

--------------------------------------------------------------------------------
-- * Colors

data Col 
  = Col !Float !Float !Float
  deriving (Eq,Ord,Show)

colToTriple :: Col -> (Float,Float,Float)
colToTriple (Col r g b) = (r,g,b)

tripleToCol :: (Float,Float,Float) -> Col
tripleToCol (r,g,b) = Col r g b

{-
black, white, red, green, blue, yellow, cyan, magenta :: Col
black   = Col 0 0 0
white   = Col 1 1 1
red     = Col 1 0 0 
green   = Col 0 1 0
blue    = Col 0 0 1
yellow  = Col 1 1 0
cyan    = Col 0 1 1 
magenta = Col 1 0 1
-}

--------------------------------------------------------------------------------
-- * Alignment

{-
data LeftRight
  = OnLeft
  | OnRight
  deriving (Eq,Ord,Show)
-}

-- | Horizontal alignment
data HAlign
  = AlignLeft
  | AlignRight
  deriving (Eq,Ord,Show) 

-- | Vertical alignment
data VAlign
  = AlignTop
  | AlignBottom
  deriving (Eq,Ord,Show) 

{-
pattern AlignLeft  = AlignLeft'  0
pattern AlignRight = AlignRight' 0

pattern AlignTop    = AlignTop'    0
pattern AlignBottom = AlignBottom' 0

data HAlign
  = AlignLeft'  !Double      -- ^ the number is an extra horizontal offset
  | AlignRight' !Double
  deriving (Eq,Ord,Show) 

data VAlign
  = AlignTop'    !Double     -- ^ the number is an extra vertical offset
  | AlignBottom' !Double
  deriving (Eq,Ord,Show) 
-}

--------------------------------------------------------------------------------
-- * Positions

-- | A position. We use screen-space coordinates here 
-- (so the top-left corner of the screen is the origin, and the vertical coordinate increases downwards).
--
-- It is monomorphic so that GHC can optimize it better.
data Pos 
  = Pos !Double !Double
  deriving (Eq,Ord,Show) 

posToPair :: Pos -> (Double,Double)
posToPair (Pos x y) = (x,y)

pairToPos :: (Double,Double) -> Pos
pairToPos (x,y) = (Pos x y) 

instance Num Pos where
  (+) (Pos x y) (Pos u v) = Pos (x+u) (y+v)
  (-) (Pos x y) (Pos u v) = Pos (x-u) (y-v)
  negate (Pos x y) = Pos (negate x) (negate y)
  (*) = error "Pos/Num/*: does not make sense"
  fromInteger n = if n == 0 
    then Pos 0 0 
    else error "Pos/Num/fromInteger: does not make sense"
  abs (Pos x y) = Pos (abs x) (abs y)
  signum = error "Pos/Num/signum: does not make sense"

{-
data Pos a 
  = Pos !a !a
  deriving (Eq,Ord,Show) 

posToPair :: Pos a -> (a,a)
posToPair (Pos x y) = (x,y)

instance Num a => Num (Pos a) where
-}

class Translate a where
  translate :: Pos -> a -> a

instance Translate Pos where
  translate = (+)

instance Translate (Double,Double) where
  translate (Pos x y) (u,v) = (x+u, y+v)

--------------------------------------------------------------------------------
-- * Margins

-- | A margin definition
data Margin = Margin
  { _leftMargin   :: !Double
  , _rightMargin  :: !Double
  , _topMargin    :: !Double
  , _bottomMargin :: !Double
  }
  deriving (Eq,Ord,Show)

--------------------------------------------------------------------------------
-- * misc utility

mapAccumM :: Monad m => (a -> b -> m (a, c)) -> a -> [b] -> m (a, [c])
mapAccumM f x0 ys = go x0 ys where
  go !x (y:ys) = do { (x',z) <- f x y ; (x'',zs) <- go x' ys ; return (x'',z:zs) }
  go !x []     = return (x,[])

--------------------------------------------------------------------------------