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) 
-}

--------------------------------------------------------------------------------
-- * Delimiters

data WhichDelim
  = LeftDelim
  | RightDelim
  deriving (Eq,Ord,Show) 

-- | A delimiter type
data Delimiter
  = Paren        -- ^ parentheses (can stretch)
  | Square       -- ^ square brackets (can stretch)
  | Brace        -- ^ curly braces (can stretch)
  | Angle        -- ^ angle brackets
  | Ceil         -- ^ ceiling
  | Floor        -- ^ floor
  | Top          -- ^ top corners
  | Bottom       -- ^ bottom corners
  | Guillemet    -- ^ guillemet or french quote
  | AngleQuote   -- ^ single quillemet or angle quote
  | VertSingle   -- ^ vertical line (can stretch)
  | VertDouble   -- ^ double vertical line  (can stretch)
  | Tortoise     -- ^ tortoise brackets
  deriving (Eq,Ord,Show)

delimiterChars :: Delimiter -> (Char,Char)
delimiterChars 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' )
  Guillemet    -> ( '\x00ab' , '\x00bb' )
  VertSingle   -> ( '\x2223' , '\x2223' )
  VertDouble   -> ( '\x2225' , '\x2225' )
  Tortoise     -> ( '\x27ec' , '\x27ed' )

{-
  , "[[" ~> '\x27e6'
  , "]]" ~> '\x27e7'
  , "{|" ~> '\x2983'
  , "|}" ~> '\x2984'
  , "((" ~> '\x2985'
  , "))" ~> '\x2986'
  , "(|" ~> '\x2987'
  , "|)" ~> '\x2988'
  , "<|" ~> '\x2989'
  , "|>" ~> '\x298a'
  , "[|" ~> '\x27ec'    -- tortoise shell bracket
  , "|]" ~> '\x27ed'    -- tortoise shell bracket
-}

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

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