-- 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 = [FRequest] -> K a b -> F a b
forall a b. [FRequest] -> K a b -> F a b
windowF [FRequest]
startcmds K a b
forall b ho. K b ho
warnK
  where
    startcmds :: [FRequest]
startcmds = [LayoutRequest -> FRequest
layoutRequestCmd (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
size Bool
True Bool
True)]

    warnK :: K b ho
warnK =
	Size -> Int -> (PixmapId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Size -> Int -> (PixmapId -> f b ho) -> f b ho
createPixmap Size
size Int
copyFromParent ((PixmapId -> K b ho) -> K b ho) -> (PixmapId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ PixmapId
gcon ->
	Size -> Int -> (PixmapId -> K b ho) -> K b ho
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
Size -> Int -> (PixmapId -> f b ho) -> f b ho
createPixmap Size
size Int
copyFromParent ((PixmapId -> K b ho) -> K b ho) -> (PixmapId -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ PixmapId
gcoff ->
	PixmapId -> [String] -> (GCtx -> K b ho) -> K b ho
forall (f :: * -> * -> *) i o.
FudgetIO f =>
PixmapId -> [String] -> (GCtx -> f i o) -> f i o
fg PixmapId
gcon [String
bgColor,String
"white"] ((GCtx -> K b ho) -> K b ho) -> (GCtx -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ (GC GCId
bg FontData
_) ->
	PixmapId -> [String] -> (GCtx -> K b ho) -> K b ho
forall (f :: * -> * -> *) i o.
FudgetIO f =>
PixmapId -> [String] -> (GCtx -> f i o) -> f i o
fg PixmapId
gcon [String
"red",String
"black"] ((GCtx -> K b ho) -> K b ho) -> (GCtx -> K b ho) -> K b ho
forall a b. (a -> b) -> a -> b
$ \ (GC GCId
red FontData
_) ->
	FRequest -> K b ho -> K b ho
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) (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
	FRequest -> K b ho -> K b ho
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) (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
	FRequest -> K b ho -> K b ho
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
360Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
64)) (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
	XCommand -> K b ho -> K b ho
forall i o. XCommand -> K i o -> K i o
xcommandK (PixmapId -> PixmapId -> XCommand
SetGCWarningHack PixmapId
gcon PixmapId
gcoff) (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
	XCommand -> K b ho -> K b ho
forall i o. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
gcoff]) (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
	XCommand -> K b ho -> K b ho
forall i o. XCommand -> K i o -> K i o
xcommandK XCommand
ClearWindow (K b ho -> K b ho) -> K b ho -> K b ho
forall a b. (a -> b) -> a -> b
$
	K b ho
forall b ho. K b 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 =
	  PixmapId
-> GCtx
-> [GCAttributes [String] String]
-> (GCtx -> f i o)
-> f i o
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
	    ([[String] -> GCAttributes [String] String
forall a b. a -> GCAttributes a b
GCForeground [String]
colspec]::[GCAttributes [String] String])

    size :: Size
size = Size
10