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 :: Bool -> F Bool nothing
onOffDispF Bool
start = SP GfxFEvent nothing
forall a b. SP a b
nullSP SP GfxFEvent nothing
-> F (GfxFCmd MeasuredGraphics) GfxFEvent
-> F (GfxFCmd MeasuredGraphics) nothing
forall a b e. SP a b -> F e a -> F e b
>^^=< Customiser (GraphicsF MeasuredGraphics)
-> F (GfxFCmd MeasuredGraphics) GfxFEvent
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) GfxFEvent
graphicsDispF' Customiser (GraphicsF MeasuredGraphics)
custom F (GfxFCmd MeasuredGraphics) nothing
-> (Bool -> GfxFCmd MeasuredGraphics) -> F Bool nothing
forall c d e. F c d -> (e -> c) -> F e d
>=^< Bool -> GfxFCmd MeasuredGraphics
forall path gfx. Bool -> GfxCommand path gfx
pre
  where
    custom :: Customiser (GraphicsF MeasuredGraphics)
custom = MeasuredGraphics -> Customiser (GraphicsF MeasuredGraphics)
forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp (Size -> MeasuredGraphics
emptyMG Size
dsize) Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GfxEventMask] -> Customiser (GraphicsF MeasuredGraphics)
forall gfx. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [] Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     Sizing -> Customiser (GraphicsF MeasuredGraphics)
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Static Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Customiser (GraphicsF MeasuredGraphics)
forall xxx. HasBorderWidth xxx => Int -> Customiser xxx
setBorderWidth Int
0 Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
-> Customiser (GraphicsF MeasuredGraphics)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     [Char] -> Customiser (GraphicsF MeasuredGraphics)
forall xxx a.
(HasBgColorSpec xxx, Show a, ColorGen a) =>
a -> 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 = ColorSpec -> GfxCommand path gfx
forall path gfx. ColorSpec -> GfxCommand path gfx
ChangeGfxBg (ColorSpec -> GfxCommand path gfx)
-> (Bool -> ColorSpec) -> Bool -> GfxCommand path gfx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ColorSpec
forall a. (Show a, ColorGen a) => a -> ColorSpec
colorSpec ([Char] -> ColorSpec) -> (Bool -> [Char]) -> Bool -> 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