{-# OPTIONS_GHC -optc-D_LARGEFILE_SOURCE #-}
{-# OPTIONS_GHC -optc-D_LARGEFILE64_SOURCE #-}
{-# OPTIONS_GHC -optc-D_THREAD_SAFE #-}
{-# OPTIONS_GHC -optc-D_REENTRANT #-}
{-# OPTIONS_GHC -optc-DBUILD_DIR="build/debug" #-}
{-# OPTIONS_GHC -optc-DGHC_VERSION=90205 #-}
{-# OPTIONS_GHC -optc-D__APPLE__ #-}
{-# LINE 1 "Ui/Style.hsc" #-}
-- 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

-- | Each event has a display style.
--
-- Actually, to be consistent with Block and Track shouldn't this be called
-- EventConfig?
module Ui.Style (
    Style(..), Font(..), FontFace(..), StyleId(..)
) where
import qualified Data.List as List
import qualified Data.Word as Word

import qualified Ui.Color as Color
import qualified Util.FFI as FFI
import qualified Util.Num as Num
import qualified Util.Serialize as Serialize

import           ForeignC


data Style = Style {
    style_font :: Font
    , style_face :: [FontFace]
    , style_size :: Int
    , style_text_color :: Color.Color
    , style_event_color :: Color.Color
    } deriving (Eq, Show, Read)

data Font = Helvetica | Times | Courier
    deriving (Eq, Show, Read)
data FontFace = Bold | Italic
    deriving (Eq, Show, Read)

-- | To save space, event styles are explicitly shared by storing them in
-- a table.
newtype StyleId = StyleId Word.Word8
    deriving (Serialize.Serialize, Eq, Show, Read)


-- * storable



instance CStorable Style where
    sizeOf _ = (16)
{-# LINE 48 "Ui/Style.hsc" #-}
    alignment = alignment . style_text_color
    peek = error "EventStyle peek unimplemented"
    poke stylep (Style font face size text_color event_color) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) stylep
{-# LINE 52 "Ui/Style.hsc" #-}
            (FFI.c_int (font_code font + face_code face))
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) stylep (FFI.c_nat size)
{-# LINE 54 "Ui/Style.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) stylep text_color
{-# LINE 55 "Ui/Style.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) stylep event_color
{-# LINE 56 "Ui/Style.hsc" #-}

font_code :: Font -> Int
font_code font = case font of
    Helvetica -> 0
{-# LINE 60 "Ui/Style.hsc" #-}
    Times -> 8
{-# LINE 61 "Ui/Style.hsc" #-}
    Courier -> 4
{-# LINE 62 "Ui/Style.hsc" #-}

face_code :: [FontFace] -> Int
face_code = Num.sum . map code . List.nub
    where
    code face = case face of
        Bold -> 1
{-# LINE 68 "Ui/Style.hsc" #-}
        Italic -> 2
{-# LINE 69 "Ui/Style.hsc" #-}