module OnOffDispF where
import CompOps((>=^<),(>^^=<))
import NullF(F)
import Spops(nullSP)
--import Xtypes
import ResourceIds() -- synonym ColorName, for hbc
import Geometry(Point(..))
import MeasuredGraphics(emptyMG)
import GraphicsF(graphicsDispF',GfxCommand(..),setGfxEventMask)
import FDefaults
import GCAttrs
--import Drawing( ) -- instances
import Graphic( )
import Defaults(bgColor, fgColor)
import CmdLineEnv(argKey)
import Sizing(Sizing(..))

onOffDispF :: Bool -> F Bool nothing
onOffDispF :: forall nothing. Bool -> F Bool nothing
onOffDispF Bool
start = forall a b. SP a b
nullSP forall a b e. SP a b -> F e a -> F e b
>^^=< forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' GraphicsF MeasuredGraphics -> GraphicsF MeasuredGraphics
custom forall c d e. F c d -> (e -> c) -> F e d
>=^< forall {path} {gfx}. Bool -> GfxCommand path gfx
pre
  where
    custom :: GraphicsF MeasuredGraphics -> GraphicsF MeasuredGraphics
custom = forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp (Size -> MeasuredGraphics
emptyMG Size
dsize) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {gfx}. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Static forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     forall {xxx} {p}.
(HasBgColorSpec xxx, Show p, ColorGen p) =>
p -> Customiser xxx
setBgColor (Bool -> [Char]
color Bool
start)
    color :: Bool -> [Char]
color Bool
on = if Bool
on then [Char]
onColor else [Char]
offColor
    dsize :: Size
dsize = Int -> Int -> Size
Point Int
7 Int
7
    --pre :: Bool -> GfxCommand Bool -- resolving overloading...
    pre :: Bool -> GfxCommand path gfx
pre = forall path gfx. ColorSpec -> GfxCommand path gfx
ChangeGfxBg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Show a, ColorGen a) => a -> ColorSpec
colorSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char]
color

offColor :: [Char]
offColor = [Char] -> [Char] -> [Char]
argKey [Char]
"toggleoff" [Char]
bgColor
onColor :: [Char]
onColor  = [Char] -> [Char] -> [Char]
argKey [Char]
"toggleon" [Char]
fgColor