{-# LANGUAGE CPP #-}
module DDisplayF(--HasInitDisp(..),
		 setSpacer,
		 DisplayF,
                 displayF,displayF',--displayF'',
                 intDispF,intDispF',--intDispF'',
                 labelF,labelF' --,labelF''
		) where
import FDefaults
import GraphicsF(graphicsDispF',replaceAllGfx,setGfxEventMask)--GfxCommand
import Graphic
import Drawing() -- instances
import DrawingUtils(spacedD,g)--vboxD,blankD,hardAttribD,
import GCAttrs --(ColorSpec,colorSpec) -- + instances
--import GCtx(GCtx(..),wCreateGCtx,rootGCtx)
--import EitherUtils(mapEither)
--import FudgetIO
--import Fudget
import NullF(F)
--import Xtypes
import ResourceIds() -- synonym ColorName, for hbc
import Defaults(defaultFont,labelFont,paperColor,fgColor,bgColor)
import CmdLineEnv(argKeyList)
import CompOps((>=^^<),(>=^<),(>^^=<))
import CompSP(idLeftSP)
import Spops(nullSP)
import SpEither(filterRightSP)
import Alignment(aRight,aLeft,aCenter)
--import AlignF(noStretchF)
--import LoadFont(safeLoadQueryFont)
--import Font(string_box_size)
import Spacers(marginS,compS,hAlignS)--minSizeS,noStretchS,
import LayoutRequest(Spacer)
import Sizing(Sizing(..))
import CondLayout(alignFixedS')
--import Maybe(fromMaybe)

#include "defaults.h"

newtype DisplayF a = Pars [Pars a]

data Pars a
  = BorderWidth Int
  | FgColorSpec ColorSpec
  | BgColorSpec ColorSpec
  | FontSpec FontSpec
--  | Align Alignment
  | Spacer Spacer
  | Margin Int
  | InitDisp a
  | InitSize a
  | Sizing Sizing
  | Stretchable (Bool,Bool)
-- Don't forget to adjust instance Functor DisplayF above if you add stuff here!

type StringDisplayF = DisplayF String

parameter_instance1(BorderWidth,DisplayF)
parameter_instance1(FgColorSpec,DisplayF)
parameter_instance1(BgColorSpec,DisplayF)
parameter_instance1(FontSpec,DisplayF)
--parameter_instance1(Align,DisplayF)
parameter_instance1(Margin,DisplayF)

parameter_instance(InitDisp,DisplayF)
setSpacer :: Spacer -> Customiser (DisplayF a)
parameter(Spacer)
parameter_instance(InitSize,DisplayF)
parameter_instance1(Stretchable,DisplayF)
parameter_instance1(Sizing,DisplayF)

-- For backwards compatibility:
instance HasAlign (DisplayF a) where
  setAlign :: Alignment -> Customiser (DisplayF a)
setAlign Alignment
align (Pars [Pars a]
ps) = [Pars a] -> DisplayF a
forall a. [Pars a] -> DisplayF a
Pars (Spacer -> Pars a
forall a. Spacer -> Pars a
Spacer (Alignment -> Alignment -> Spacer
alignFixedS' Alignment
align Alignment
aCenter)Pars a -> [Pars a] -> [Pars a]
forall a. a -> [a] -> [a]
:[Pars a]
ps)

labelDisplayF :: Graphic g => F g void -- because of monomorphism restriction
labelDisplayF :: F g void
labelDisplayF = Customiser (DisplayF g) -> F g void
forall a b. Graphic a => Customiser (DisplayF a) -> F a b
labelDisplayF' Customiser (DisplayF g)
forall a. Customiser a
standard
labelDisplayF' :: Customiser (DisplayF a) -> F a b
labelDisplayF' Customiser (DisplayF a)
pm = PF (DisplayF a) a b -> F a b
forall p a b. PF p a b -> F a b
noPF (PF (DisplayF a) a b -> F a b) -> PF (DisplayF a) a b -> F a b
forall a b. (a -> b) -> a -> b
$ Customiser (DisplayF a) -> PF (DisplayF a) a b
forall g void.
Graphic g =>
Customiser (DisplayF g) -> PF (DisplayF g) g void
labelDisplayF'' Customiser (DisplayF a)
pm

labelDisplayF''
  :: Graphic g => Customiser (DisplayF g) -> PF (DisplayF g) g void
labelDisplayF'' :: Customiser (DisplayF g) -> PF (DisplayF g) g void
labelDisplayF'' Customiser (DisplayF g)
pmod = 
    SP GfxFEvent void
forall a b. SP a b
nullSP SP GfxFEvent void
-> F (GfxFCmd (Drawing Any Gfx)) GfxFEvent
-> F (GfxFCmd (Drawing Any Gfx)) void
forall a b e. SP a b -> F e a -> F e b
>^^=<
    Customiser (GraphicsF (Drawing Any Gfx))
-> F (GfxFCmd (Drawing Any Gfx)) GfxFEvent
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' Customiser (GraphicsF (Drawing Any Gfx))
forall lbl.
GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
custom F (GfxFCmd (Drawing Any Gfx)) void
-> (g -> GfxFCmd (Drawing Any Gfx)) -> F g void
forall c d e. F c d -> (e -> c) -> F e d
>=^<
    g -> GfxFCmd (Drawing Any Gfx)
forall a lbl. g -> GfxCommand [a] (Drawing lbl Gfx)
pre F g void
-> SP (Either (Customiser (DisplayF g)) g) g
-> PF (DisplayF g) g void
forall c d e. F c d -> SP e c -> F e d
>=^^<
    SP (Either (Customiser (DisplayF g)) g) g
forall a1 b. SP (Either a1 b) b
filterRightSP
  where
    custom :: GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
custom =
     	(GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (g
    -> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> Maybe g
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall a. Customiser a
id (Drawing lbl Gfx
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp (Drawing lbl Gfx
 -> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (g -> Drawing lbl Gfx)
-> g
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Drawing lbl Gfx
forall lbl. g -> Drawing lbl Gfx
draw) Maybe g
initDisp (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	(GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (g
    -> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> Maybe g
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall a. Customiser a
id (Drawing lbl Gfx
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall (xxx :: * -> *) a.
HasInitSize xxx =>
a -> Customiser (xxx a)
setInitSize (Drawing lbl Gfx
 -> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (g -> Drawing lbl Gfx)
-> g
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Drawing lbl Gfx
forall lbl. g -> Drawing lbl Gfx
draw) Maybe g
initSize (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	[GfxEventMask]
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall gfx. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [] (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sizing
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
sizing (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	Int -> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
borderWidth (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorSpec
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx. HasBgColorSpec xxx => ColorSpec -> Customiser xxx
setBgColorSpec ColorSpec
bgColor (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	FontSpec
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont FontSpec
font (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorSpec
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx. HasFgColorSpec xxx => ColorSpec -> Customiser xxx
setFgColorSpec ColorSpec
fgColor (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> (GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx))
-> GraphicsF (Drawing lbl Gfx)
-> GraphicsF (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	(Bool, Bool)
-> GraphicsF (Drawing lbl Gfx) -> GraphicsF (Drawing lbl Gfx)
forall xxx. HasStretchable xxx => (Bool, Bool) -> Customiser xxx
setStretchable (Bool, Bool)
stretch
    pre :: g -> GfxCommand [a] (Drawing lbl Gfx)
pre = Drawing lbl Gfx -> GfxCommand [a] (Drawing lbl Gfx)
forall gfx a. gfx -> GfxCommand [a] gfx
replaceAllGfx (Drawing lbl Gfx -> GfxCommand [a] (Drawing lbl Gfx))
-> (g -> Drawing lbl Gfx) -> g -> GfxCommand [a] (Drawing lbl Gfx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Drawing lbl Gfx
forall lbl. g -> Drawing lbl Gfx
draw 
    draw :: g -> Drawing lbl Gfx
draw = Drawing lbl Gfx -> Drawing lbl Gfx
forall lbl leaf. Drawing lbl leaf -> Drawing lbl leaf
marginD (Drawing lbl Gfx -> Drawing lbl Gfx)
-> (g -> Drawing lbl Gfx) -> g -> Drawing lbl Gfx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g
    marginD :: Drawing lbl leaf -> Drawing lbl leaf
marginD = Spacer -> Drawing lbl leaf -> Drawing lbl leaf
forall lbl leaf. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD (Int -> Spacer
marginS Int
margin Spacer -> Spacer -> Spacer
`compS` Spacer
spacer)

    margin :: Int
margin = DisplayF g -> Int
forall xxx. HasMargin xxx => xxx -> Int
getMargin DisplayF g
ps
    borderWidth :: Int
borderWidth = DisplayF g -> Int
forall xxx. HasBorderWidth xxx => xxx -> Int
getBorderWidth DisplayF g
ps
    bgColor :: ColorSpec
bgColor = DisplayF g -> ColorSpec
forall xxx. HasBgColorSpec xxx => xxx -> ColorSpec
getBgColorSpec DisplayF g
ps
    fgColor :: ColorSpec
fgColor = DisplayF g -> ColorSpec
forall xxx. HasFgColorSpec xxx => xxx -> ColorSpec
getFgColorSpec DisplayF g
ps
    font :: FontSpec
font = DisplayF g -> FontSpec
forall xxx. HasFontSpec xxx => xxx -> FontSpec
getFontSpec DisplayF g
ps
    spacer :: Spacer
spacer = DisplayF g -> Spacer
forall a. DisplayF a -> Spacer
getSpacer DisplayF g
ps
    stretch :: (Bool, Bool)
stretch = DisplayF g -> (Bool, Bool)
forall xxx. HasStretchable xxx => xxx -> (Bool, Bool)
getStretchable DisplayF g
ps
    sizing :: Sizing
sizing = DisplayF g -> Sizing
forall xxx. HasSizing xxx => xxx -> Sizing
getSizing DisplayF g
ps
    initSize :: Maybe g
initSize = DisplayF g -> Maybe g
forall (xxx :: * -> *) a. HasInitSize xxx => xxx a -> Maybe a
getInitSizeMaybe DisplayF g
ps
    initDisp :: Maybe g
initDisp = DisplayF g -> Maybe g
forall (xxx :: * -> *) a. HasInitDisp xxx => xxx a -> Maybe a
getInitDispMaybe DisplayF g
ps
    ps :: DisplayF g
ps = Customiser (DisplayF g)
pmod ([Pars g] -> DisplayF g
forall a. [Pars a] -> DisplayF a
Pars [Int -> Pars g
forall a. Int -> Pars a
Margin Int
4,Int -> Pars g
forall a. Int -> Pars a
BorderWidth Int
0,
                     ColorSpec -> Pars g
forall a. ColorSpec -> Pars a
FgColorSpec ColorSpec
dispfg, ColorSpec -> Pars g
forall a. ColorSpec -> Pars a
BgColorSpec ColorSpec
dispbg,
		     FontSpec -> Pars g
forall a. FontSpec -> Pars a
FontSpec (FontName -> FontSpec
forall a. (Show a, FontGen a) => a -> FontSpec
fontSpec FontName
defaultFont),
		     Spacer -> Pars g
forall a. Spacer -> Pars a
Spacer (Alignment -> Alignment -> Spacer
alignFixedS' Alignment
aLeft Alignment
aCenter),
		     (Bool, Bool) -> Pars g
forall a. (Bool, Bool) -> Pars a
Stretchable (Bool
False,Bool
False),
		     Sizing -> Pars g
forall a. Sizing -> Pars a
Sizing Sizing
Dynamic{-,InitSize "",InitDisp ""-}])

displayF :: Graphic g => F g void -- because of monomorphism restriction
displayF :: F g void
displayF = Customiser (DisplayF g) -> F g void
forall a b. Graphic a => Customiser (DisplayF a) -> F a b
displayF' Customiser (DisplayF g)
forall a. Customiser a
standard
displayF' :: Customiser (DisplayF a) -> F a b
displayF' Customiser (DisplayF a)
custom = PF (DisplayF a) a b -> F a b
forall p a b. PF p a b -> F a b
noPF (PF (DisplayF a) a b -> F a b) -> PF (DisplayF a) a b -> F a b
forall a b. (a -> b) -> a -> b
$ Customiser (DisplayF a) -> PF (DisplayF a) a b
forall g void.
Graphic g =>
Customiser (DisplayF g) -> PF (DisplayF g) g void
displayF'' Customiser (DisplayF a)
custom

displayF'' :: Graphic g => Customiser (DisplayF g) -> PF (DisplayF g) g void
displayF'' :: Customiser (DisplayF g) -> PF (DisplayF g) g void
displayF'' Customiser (DisplayF g)
pmod = Customiser (DisplayF g) -> PF (DisplayF g) g void
forall g void.
Graphic g =>
Customiser (DisplayF g) -> PF (DisplayF g) g void
labelDisplayF'' Customiser (DisplayF g)
pmod'
  where
    pmod' :: Customiser (DisplayF g)
pmod' = Customiser (DisplayF g)
pmod Customiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            --setInitSize "XXXXX" .
	    Int -> Customiser (DisplayF g)
forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
1 Customiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	    (Bool, Bool) -> Customiser (DisplayF g)
forall xxx. HasStretchable xxx => (Bool, Bool) -> Customiser xxx
setStretchable (Bool
True,Bool
False) Customiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	    Spacer -> Customiser (DisplayF g)
forall a. Spacer -> Customiser (DisplayF a)
setSpacer (Alignment -> Spacer
hAlignS Alignment
aLeft) Customiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	    Sizing -> Customiser (DisplayF g)
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Growing


labelF :: g -> F a b
labelF g
lbl = Customiser (DisplayF g) -> g -> F a b
forall g a b. Graphic g => Customiser (DisplayF g) -> g -> F a b
labelF' Customiser (DisplayF g)
forall a. Customiser a
standard g
lbl
labelF' :: Customiser (DisplayF g) -> g -> F a b
labelF' Customiser (DisplayF g)
pm = PF (DisplayF g) a b -> F a b
forall p a b. PF p a b -> F a b
noPF (PF (DisplayF g) a b -> F a b)
-> (g -> PF (DisplayF g) a b) -> g -> F a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Customiser (DisplayF g) -> g -> PF (DisplayF g) a b
forall g a b.
Graphic g =>
Customiser (DisplayF g) -> g -> PF (DisplayF g) a b
labelF'' Customiser (DisplayF g)
pm

labelF'' :: Graphic g => Customiser (DisplayF g) -> g -> PF (DisplayF g) a b
labelF'' :: Customiser (DisplayF g) -> g -> PF (DisplayF g) a b
labelF'' Customiser (DisplayF g)
pmod g
lbl = Customiser (DisplayF g) -> PF (DisplayF g) g b
forall g void.
Graphic g =>
Customiser (DisplayF g) -> PF (DisplayF g) g void
labelDisplayF'' Customiser (DisplayF g)
pmod' PF (DisplayF g) g b
-> SP
     (Either (Customiser (DisplayF g)) a)
     (Either (Customiser (DisplayF g)) g)
-> PF (DisplayF g) a b
forall c d e. F c d -> SP e c -> F e d
>=^^< SP a g
-> SP
     (Either (Customiser (DisplayF g)) a)
     (Either (Customiser (DisplayF g)) g)
forall a1 b a2. SP a1 b -> SP (Either a2 a1) (Either a2 b)
idLeftSP SP a g
forall a b. SP a b
nullSP
  where
   pmod' :: Customiser (DisplayF g)
pmod' = Customiser (DisplayF g)
pmodCustomiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	   g -> Customiser (DisplayF g)
forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp g
lblCustomiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (ColorSpec -> Customiser (DisplayF g)
forall xxx a.
(HasFgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setFgColor ColorSpec
lblfg::(Customiser (DisplayF g)))Customiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	   ColorSpec -> Customiser (DisplayF g)
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> Customiser xxx
setBgColor ColorSpec
lblbgCustomiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	   FontName -> Customiser (DisplayF g)
forall xxx a.
(HasFontSpec xxx, Show a, FontGen a) =>
a -> Customiser xxx
setFont FontName
labelFontCustomiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	   Int -> Customiser (DisplayF g)
forall xxx. HasMargin xxx => Int -> Customiser xxx
setMargin Int
0 Customiser (DisplayF g)
-> Customiser (DisplayF g) -> Customiser (DisplayF g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	   Sizing -> Customiser (DisplayF g)
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Static

-- cu works around a deficiency in the type inference algorithm.
-- cu x y = id x y :: (Customiser (DisplayF a))

intDispF :: F Int b
intDispF = Customiser (DisplayF Int) -> F Int b
forall b. Customiser (DisplayF Int) -> F Int b
intDispF' Customiser (DisplayF Int)
forall a. Customiser a
standard
intDispF' :: Customiser (DisplayF Int) -> F Int b
intDispF' = PF (DisplayF Int) Int b -> F Int b
forall p a b. PF p a b -> F a b
noPF (PF (DisplayF Int) Int b -> F Int b)
-> (Customiser (DisplayF Int) -> PF (DisplayF Int) Int b)
-> Customiser (DisplayF Int)
-> F Int b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Customiser (DisplayF Int) -> PF (DisplayF Int) Int b
forall a. Customiser (DisplayF Int) -> PF (DisplayF Int) Int a
intDispF''
intDispF'' :: Customiser (DisplayF Int) -> PF (DisplayF Int) Int a
intDispF'' :: Customiser (DisplayF Int) -> PF (DisplayF Int) Int a
intDispF'' Customiser (DisplayF Int)
pm = Customiser (DisplayF Int) -> PF (DisplayF Int) Int a
forall g void.
Graphic g =>
Customiser (DisplayF g) -> PF (DisplayF g) g void
displayF'' (Int -> Customiser (DisplayF Int)
pm' Int
0) -- >=^< mapEither id show
  where pm' :: Int -> Customiser (DisplayF Int)
pm' Int
x = Customiser (DisplayF Int)
pmCustomiser (DisplayF Int)
-> Customiser (DisplayF Int) -> Customiser (DisplayF Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Alignment -> Customiser (DisplayF Int)
forall xxx. HasAlign xxx => Alignment -> Customiser xxx
setAlign Alignment
aRight
                  Customiser (DisplayF Int)
-> Customiser (DisplayF Int) -> Customiser (DisplayF Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Customiser (DisplayF Int)
forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp Int
x
		  Customiser (DisplayF Int)
-> Customiser (DisplayF Int) -> Customiser (DisplayF Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Customiser (DisplayF Int)
forall (xxx :: * -> *) a.
HasInitSize xxx =>
a -> Customiser (xxx a)
setInitSize ((-Int
forall a. Bounded a => a
maxBound) Int -> Int -> Int
forall a. a -> a -> a
`asTypeOf` Int
x)
--	 	  .forgetInitDisp -- should be built into setInitDisp
                  Customiser (DisplayF Int)
-> Customiser (DisplayF Int) -> Customiser (DisplayF Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Sizing -> Customiser (DisplayF Int)
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Static::(Customiser (DisplayF Int)))
		  Customiser (DisplayF Int)
-> Customiser (DisplayF Int) -> Customiser (DisplayF Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool, Bool) -> Customiser (DisplayF Int)
forall xxx. HasStretchable xxx => (Bool, Bool) -> Customiser xxx
setStretchable (Bool
False,Bool
False)

dispbg :: ColorSpec
dispbg = [FontName] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (FontName -> [FontName] -> [FontName]
argKeyList FontName
"dispbg" [FontName
paperColor,FontName
"white"])
dispfg :: ColorSpec
dispfg = [FontName] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (FontName -> [FontName] -> [FontName]
argKeyList FontName
"dispfg" [FontName
fgColor,FontName
"black"])

lblbg :: ColorSpec
lblbg = [FontName] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (FontName -> [FontName] -> [FontName]
argKeyList FontName
"lblbg" [FontName
bgColor,FontName
"white"])
lblfg :: ColorSpec
lblfg = [FontName] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec (FontName -> [FontName] -> [FontName]
argKeyList FontName
"lblfg" [FontName
fgColor,FontName
"black"])

{-
forgetInitDisp :: DisplayF a -> DisplayF b
forgetInitDisp (Pars ps) = Pars (forget ps)
  where
    forget ps =
      case ps of
	[] -> []
	BorderWidth i:ps -> BorderWidth i:forget ps
	FgColor c:ps -> FgColor c:forget ps
	BgColor c:ps -> BgColor c:forget ps
	Font f:ps -> Font f:forget ps
	Align a:ps -> Align a:forget ps
	Margin i:ps -> Margin i:forget ps
	InitDisp x:ps -> forget ps
	InitSize s:ps -> InitSize s:forget ps
	Sizing s:ps -> Sizing s:forget ps
	Stretchable bb:ps -> Stretchable bb:forget ps
    
-}

{-
instance Functor DisplayF where
  map f (Pars ps) = Pars (map (mapPars f) ps)
    where
      mapPars f p =
	case p of
	  BorderWidth i -> BorderWidth i
	  FgColor c -> FgColor c
	  BgColor c -> BgColor c
	  Font f -> Font f
	  Align a -> Align a
	  Margin i -> Margin i
	  InitDisp x -> InitDisp (f x)
	  InitSize s -> InitSize s
	  Sizing s -> Sizing s
	  Stretchable bb -> Stretchable bb
-}