module Defaults(look3d, new3d, edgeWidth, defaultSep,
		paperColor, fgColor, bgColor, inputFg, inputBg,
		shadowColor, shineColor,
		defaultPosition, defaultSize, defaultFont, menuFont,
                buttonFont, labelFont, metaKey) where
import Geometry(pP)
--import ListUtil(chopList,breakAt)
import Utils(segments)
import AuxTypes(Modifiers(..))
import ResourceIds(FontName(..),ColorName(..))
import CmdLineEnv

argFont :: String -> String -> String
argFont = String -> String -> String
argKey :: ( String -> FontName -> FontName)
argColor :: String -> String -> String
argColor = String -> String -> String
argKey :: (String -> ColorName -> ColorName)

buttonFont :: String
buttonFont  = String -> String -> String
argFont String
"buttonfont" String
labelFont
menuFont :: String
menuFont    = String -> String -> String
argFont String
"menufont"   String
labelFont
labelFont :: String
labelFont   = String -> String -> String
argFont String
"labelfont"  String
"variable"
defaultFont :: String
defaultFont = String -> String -> String
argFont String
"font"       String
"fixed"

shineColor :: String
shineColor  = String -> String -> String
argColor String
"shine"   (if Bool
look3d then String
"white" else String
"lightgrey")
shadowColor :: String
shadowColor = String -> String -> String
argColor String
"shadow"  (if Bool
look3d
                                  then if Bool
new3d
				       then String
"grey45"
				       else String
"black"
				  else String
"grey30")
paperColor :: String
paperColor  = String -> String -> String
argColor String
"paper"   String
"white"
inputFg :: String
inputFg     = String -> String -> String
argColor String
"inputfg" String
fgColor
inputBg :: String
inputBg     = String -> String -> String
argColor String
"inputbg" String
paperColor
fgColor :: String
fgColor     = String -> String -> String
argColor String
"fg"      String
"black"
bgColor :: String
bgColor     = String -> String -> String
argColor String
"bg"      String
"grey"

--defaultSep :: Int
defaultSep :: (Num a) => a
defaultSep :: a
defaultSep = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int -> Int
forall p. (Read p, Show p) => String -> p -> p
argReadKey String
"sep" Int
5::Int)

defaultPosition :: Maybe Point
defaultPosition =
    case (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
segments (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'+') (String -> String -> String
argKey String
"geometry" String
"") of
      [String
_, String
x, String
y] -> Point -> Maybe Point
forall a. a -> Maybe a
Just (Int -> Int -> Point
pP (String -> Int
forall a. Read a => String -> a
read String
x) (String -> Int
forall a. Read a => String -> a
read String
y))
      [String]
_ -> Maybe Point
forall a. Maybe a
Nothing

defaultSize :: Maybe Point
defaultSize =
    case (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
segments (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'x') ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'+') (String -> String -> String
argKey String
"geometry" String
"")) of
      [String
x, String
y] -> Point -> Maybe Point
forall a. a -> Maybe a
Just (Int -> Int -> Point
pP (String -> Int
forall a. Read a => String -> a
read String
x) (String -> Int
forall a. Read a => String -> a
read String
y))
      [String]
_ -> Maybe Point
forall a. Maybe a
Nothing

edgeWidth :: Int
edgeWidth :: Int
edgeWidth = String -> Int -> Int
forall p. (Read p, Show p) => String -> p -> p
argReadKey String
"edgew" (if Bool
look3d then Int
2 else Int
4)

look3d :: Bool
look3d = String -> Bool -> Bool
argFlag String
"look3d" Bool
True
new3d :: Bool
new3d = String -> Bool -> Bool
argFlag String
"new3d" Bool
True


-- | This should be modifier corresponding to Meta_L & Meta_R (see xmodmap).
-- It is usually Mod1, but in XQuartz it appears to be Mod2 instead...
metaKey :: Modifiers
metaKey = String -> Modifiers -> Modifiers
forall p. (Read p, Show p) => String -> p -> p
argReadKey String
"metakey" Modifiers
Mod1