-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | A Symbol is a bit of text enclosed in ``s, such as `sharp`.  When
    rendered, it's turned into a special graphic that may be made up of
    multiple glyphs from different fonts.  The intent is to be able to write
    symbols in plain ascii but have them rendered in an attractive way on the
    score.

    Symbols are rendered at the UI level and are generally static, so instead
    of sending the symbol data over every time I want to draw one, the UI
    level maintains a mapping between symbol names and data on how to render
    them.

    This module is split from "Ui.SymbolC" so importers can avoid
    a C dependency.
-}
module Ui.Symbol where
import Data.Text (Text)


symbol :: Text -> [Glyph] -> Symbol
symbol :: Text -> [Glyph] -> Symbol
symbol Text
name = Text -> Bool -> [Glyph] -> Symbol
Symbol Text
name Bool
False

-- | Make a simple symbol with only text.
simple :: Text -> Text -> Symbol
simple :: Text -> Text -> Symbol
simple Text
name Text
chars = Text -> Bool -> [Glyph] -> Symbol
Symbol Text
name Bool
True [Text -> Glyph
glyph Text
chars]

glyph :: Text -> Glyph
glyph :: Text -> Glyph
glyph Text
text = Glyph
    { glyph_text :: Text
glyph_text = Text
text
    , glyph_font :: Maybe Font
glyph_font = forall a. Maybe a
Nothing
    , glyph_size :: Int
glyph_size = Int
0
    , glyph_align :: (Double, Double)
glyph_align = (Double
0, Double
0)
    , glyph_rotate :: Int
glyph_rotate = Int
0
    }

size :: Int -> Glyph -> Glyph
size :: Int -> Glyph -> Glyph
size Int
n Glyph
g = Glyph
g { glyph_size :: Int
glyph_size = Int
n }

glyph_at :: Int -> (Double, Double) -> Glyph -> Glyph
glyph_at :: Int -> (Double, Double) -> Glyph -> Glyph
glyph_at Int
size (Double, Double)
align Glyph
glyph = Glyph
glyph { glyph_size :: Int
glyph_size = Int
size, glyph_align :: (Double, Double)
glyph_align = (Double, Double)
align }

type Font = String

-- | A Symbol has a name and a list of the Glyphs that make it up.
--
-- If the bounding box is not given, it will be inferred from the first glyph.
-- The bounding box will be scaled by the eventual font size.  Don't pass an
-- empty glyphs list.
data Symbol = Symbol {
    Symbol -> Text
name :: Text
    -- | Turn on absolute y placement, disabling automatic y placement.  If
    -- the glyphs have descenders and you want them to actually descend, turn
    -- this on.
    , Symbol -> Bool
absolute_y :: Bool
    , Symbol -> [Glyph]
glyphs :: [Glyph]
    } deriving (Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> Font
forall a.
(Int -> a -> ShowS) -> (a -> Font) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> Font
$cshow :: Symbol -> Font
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show)

data Glyph = Glyph {
    -- | Unicode characters that make up the glyph.
    Glyph -> Text
glyph_text :: Text
    , Glyph -> Maybe Font
glyph_font :: Maybe Font
    -- | Relative size.  This is added to the font size when the glyph is
    -- drawn.
    , Glyph -> Int
glyph_size :: Int
    -- | This is scaled by the font size and added to the position of the
    -- glyph.  In a symbol with only one glyph, automatic y placement will
    -- defeat a y value here unless you set 'sym_absolute_y'.
    , Glyph -> (Double, Double)
glyph_align :: (Double, Double)
    -- | Rotate the glyph in degrees.
    , Glyph -> Int
glyph_rotate :: Int
    } deriving (Int -> Glyph -> ShowS
[Glyph] -> ShowS
Glyph -> Font
forall a.
(Int -> a -> ShowS) -> (a -> Font) -> ([a] -> ShowS) -> Show a
showList :: [Glyph] -> ShowS
$cshowList :: [Glyph] -> ShowS
show :: Glyph -> Font
$cshow :: Glyph -> Font
showsPrec :: Int -> Glyph -> ShowS
$cshowsPrec :: Int -> Glyph -> ShowS
Show)