-- If you get a type error when compiling this with HBC, try removing -O.
module GcWarningF where
import Dlayout(windowF)
import Command(XCommand(ClearWindow,ChangeWindowAttributes,SetGCWarningHack))
import DrawInPixmap
import LayoutRequest
import Geometry(Rect(..))
import Xtypes
import FudgetIO
import FRequest(layoutRequestCmd)
import Xcommand
import NullF(nullK)
--import ResourceIds
import Pixmap(createPixmap)
import GCtx(GCtx(..),pmCreateGCtx,rootGCtx)
--import GCAttrs
import Defaults(bgColor)

-- Garbage Collection Warning Fudget

gcWarningF :: F a b
gcWarningF = forall a b. [FRequest] -> K a b -> F a b
windowF [FRequest]
startcmds forall {hi} {ho}. K hi ho
warnK
  where
    startcmds :: [FRequest]
startcmds = [LayoutRequest -> FRequest
layoutRequestCmd (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
size Bool
True Bool
True)]

    warnK :: K hi ho
warnK =
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Size -> Int -> (PixmapId -> f hi ho) -> f hi ho
createPixmap Size
size Int
copyFromParent forall a b. (a -> b) -> a -> b
$ \ PixmapId
gcon ->
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Size -> Int -> (PixmapId -> f hi ho) -> f hi ho
createPixmap Size
size Int
copyFromParent forall a b. (a -> b) -> a -> b
$ \ PixmapId
gcoff ->
	forall {f :: * -> * -> *} {i} {o}.
FudgetIO f =>
PixmapId -> [String] -> (GCtx -> f i o) -> f i o
fg PixmapId
gcon [String
bgColor,String
"white"] forall a b. (a -> b) -> a -> b
$ \ (GC GCId
bg FontData
_) ->
	forall {f :: * -> * -> *} {i} {o}.
FudgetIO f =>
PixmapId -> [String] -> (GCtx -> f i o) -> f i o
fg PixmapId
gcon [String
"red",String
"black"] forall a b. (a -> b) -> a -> b
$ \ (GC GCId
red FontData
_) ->
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (PixmapId -> GCId -> Rect -> FRequest
pmFillRectangle PixmapId
gcon GCId
bg Rect
r) forall a b. (a -> b) -> a -> b
$
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (PixmapId -> GCId -> Rect -> FRequest
pmFillRectangle PixmapId
gcoff GCId
bg Rect
r) forall a b. (a -> b) -> a -> b
$
	forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (PixmapId -> GCId -> Rect -> Int -> Int -> FRequest
pmFillArc PixmapId
gcon GCId
red Rect
r Int
0 (Int
360forall a. Num a => a -> a -> a
*Int
64)) forall a b. (a -> b) -> a -> b
$
	forall {i} {o}. XCommand -> K i o -> K i o
xcommandK (PixmapId -> PixmapId -> XCommand
SetGCWarningHack PixmapId
gcon PixmapId
gcoff) forall a b. (a -> b) -> a -> b
$
	forall {i} {o}. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
gcoff]) forall a b. (a -> b) -> a -> b
$
	forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
ClearWindow forall a b. (a -> b) -> a -> b
$
	forall {hi} {ho}. K hi ho
nullK
      where
	r :: Rect
r = Size -> Size -> Rect
Rect Size
0 Size
size
	fg :: PixmapId -> [String] -> (GCtx -> f i o) -> f i o
fg PixmapId
pm [String]
colspec =
	  forall {a1} {f :: * -> * -> *} {a2} {i} {o}.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
PixmapId
-> GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
pmCreateGCtx PixmapId
pm GCtx
rootGCtx
	    ([forall a b. a -> GCAttributes a b
GCForeground [String]
colspec]::[GCAttributes [String] String])

    size :: Size
size = Size
10