Common.hs

-- | Common data types and functions

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 !Double !Double !Double
  deriving (Eq,Ord,Show)

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

tripleToCol :: (Double,Double,Double) -> 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)
-}

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

data VAlign
  = AlignBottom
  | AlignTop
  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)

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 = (+)

--------------------------------------------------------------------------------
-- * Brackets

data Bracket
  = Paren
  | Square
  | Brace
  | Angle        -- 2329 / 232a
  | Ceil         -- 2308 / 2309
  | Floor        -- 230a / 230b
  | Top          -- 231c / 231d
  | Bottom       -- 231e / 231f
  | AngleQuote   -- 2039 / 203a
  | FrenchQuote  -- 00ab / 00bb
  deriving (Eq,Ord,Show)

bracketChars :: Bracket -> (Char,Char)
bracketChars b = case b of
  Paren        -> ( '(' , ')' )
  Square       -> ( '[' , ']' )
  Brace        -> ( '{' , '}' )
  Angle        -> ( '\x2329' , '\x232a' )
  Ceil         -> ( '\x2308' , '\x2309' )
  Floor        -> ( '\x230a' , '\x230b' )
  Top          -> ( '\x231c' , '\x231d' )
  Bottom       -> ( '\x231e' , '\x231f' )
  AngleQuote   -> ( '\x2039' , '\x203a' )
  FrenchQuote  -> ( '\x00ab' , '\x00bb' )

--------------------------------------------------------------------------------
-- * 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,[])

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