Parameters.hs

{-# Language ExistentialQuantification, TypeFamilies, DeriveDataTypeable #-}

-----------------------------------------------------------------------------
--
-- Module      :  Graphics.Forms.Parameters
-- Copyright   :
-- License     :  AllRightsReserved
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- | Module for parameters for editors
--  Setting of parameters: ("Name", ParaString "Hello") `setPara` defaultParameters
-- Getting parameters getPara "Name" paras
--
-----------------------------------------------------------------------------

module Graphics.Forms.Parameters (
    defaultParams,
    (<<<),
    getPara,
    getParaS,
    ParaType(..),
    Parameters
) where

import Base
import Graphics.Pane

import Graphics.UI.Gtk (Packing, ShadowType)
import Graphics.UI.Gtk.General.Enums (Packing(..), ShadowType(..))
import Data.Typeable (Typeable)

-- ParaName "Hallo" <<< defaultParams
--          selector

-- setPara :: Selector alpha => alpha => (ValueType alpha) => Parameters -> Parameters

type Parameters = [Para ParaType]

-- type Parameters = forall alpha . (Selector alpha) [(alpha, ValueType alpha)]



-- | A generalised attribute with independent get and set types.
data Para alpha = Para
    {paName   :: String,
     paValue  :: alpha}
     deriving Show

infixr 9 <<<

(<<<) :: (String, ParaType) -> Parameters -> Parameters
(<<<) (name,newValue)  paras =
    case [ para | para <- paras, paName para == name] of
        [p] -> p{paValue = newValue} : [ para | para <- paras, paName para /=  name]
        _   -> error $ "Parameters >> Cant find parameter " ++ name

getPara :: String -> Parameters -> ParaType
getPara name paras =
    case [ para | para <- paras, paName para == name] of
        [p] -> paValue p
        _   -> error $ "Parameters >> Cant find parameter " ++ name

getParaS :: String -> Parameters -> String
getParaS name paras = case getPara name paras of
                    ParaString s -> s
                    _ -> error "Parameters>>Not a string"

data StringSel = Name | StockId | Synopsis
    deriving (Eq, Ord, Show, Typeable)

instance Selector StringSel where
    type ValueType StringSel = String


data ParaType  =
    ParaString String
    | ParaAlign (Float,Float,Float,Float)
    | ParaPadding (Int,Int,Int,Int)
    | ParaSize (Int,Int)
    | ParaPos (Float,Float)
    | ParaBool Bool
    | ParaHori HorizontalAlign
    | ParaDir Direction
    | ParaShadow ShadowType
    | ParaPack Packing
    deriving(Eq,Show)

data HorizontalAlign =   StartHorizontal | StopHorizontal | Keep
    deriving (Eq,Show)

--data StringPara = ParaName | ParaStockId | ParaSynopsis
--    deriving (Eq,Ord,Show,Typeable)
--
--instance Selector StringPara where
--    type ValueType = String
--


defaultParams :: Parameters
defaultParams =
    [   Para "Name"            (ParaString "")
    ,   Para "StockId"         (ParaString "")
    ,   Para "Synopsis"        (ParaString "")
    ,   Para "Sensitivity"     (ParaBool True)
-- For boxes
    ,   Para "VBoxHomogeneous" (ParaBool False)
    ,   Para "HBoxHomogeneous" (ParaBool True)
    ,   Para "VPack"           (ParaPack PackNatural)
    ,   Para "HPack"           (ParaPack PackGrow)
-- For fields
    ,   Para "OuterAlignment"  (ParaAlign (0.0, 0.0, 1, 1))
    ,   Para "OuterPadding"    (ParaPadding (5, 5, 5, 5))
-- the label
    ,   Para "ShowLabel"       (ParaBool True)
    ,   Para "LabelAlign"      (ParaPos (0.5, 0.0))
    ,   Para "Shadow"          (ParaShadow ShadowNone)
-- the inner alignment
    ,   Para "InnerAlignment"  (ParaAlign (0.0, 0.0, 1, 1))
    ,   Para "InnerPadding"    (ParaPadding (5, 5, 5, 5))

-- for the field
    ,   Para "MinSize"         (ParaSize (-1,-1))

-- for special widgets
    ,   Para "Direction"       (ParaDir Horizontal)
    ,   Para "MultiSel"        (ParaBool True)


--    ,   Para "Horizontal"      (ParaHori Keep)
    ]