module BitmapF (bitmapButtonF, bitmapDispF, bitmapDispBorderF) where
import AllFudgets

windowKernel :: FilePath -> K BitmapReturn ho
windowKernel FilePath
filename =
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> FilePath -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap FilePath
"black" forall a b. (a -> b) -> a -> b
$ \Pixel
fg ->
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
ColormapId -> FilePath -> Cont (f hi ho) Pixel
allocNamedColorPixel ColormapId
defaultColormap FilePath
"white" forall a b. (a -> b) -> a -> b
$ \Pixel
bg ->
  forall {a} {i} {o}. (Show a, ColorGen a) => a -> K i o -> K i o
changeBackPixel FilePath
"white" forall a b. (a -> b) -> a -> b
$
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
rootGC [forall a b. GCFunction -> GCAttributes a b
GCFunction GCFunction
GXcopy,
                    forall a b. a -> GCAttributes a b
GCForeground Pixel
fg,
                    forall a b. a -> GCAttributes a b
GCBackground Pixel
bg,
                    forall a b. Bool -> GCAttributes a b
GCGraphicsExposures Bool
False] forall a b. (a -> b) -> a -> b
$ \GCId
drawGC ->
  let displayImage :: Size -> PixmapId -> K BitmapReturn ho
displayImage Size
size PixmapId
bitmapid =
        forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Size -> Int -> (PixmapId -> f hi ho) -> f hi ho
createPixmap Size
size Int
copyFromParent (\PixmapId
pixmapid ->
          forall {b} {a}. [KCommand b] -> K a b -> K a b
putsK [forall a b. a -> Message a b
Low (PixmapId -> GCId -> Drawable -> Rect -> Size -> Int -> FRequest
pmCopyPlane PixmapId
pixmapid GCId
drawGC (PixmapId -> Drawable
Pixmap PixmapId
bitmapid) 
                    (Size -> Size -> Rect
Rect (Int -> Int -> Size
Point Int
0 Int
0) Size
size) (Int -> Int -> Size
Point Int
0 Int
0) Int
0),
                forall {b}. XCommand -> Message FRequest b
lxcmd ([WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
pixmapid]),
                forall {b}. XCommand -> Message FRequest b
lxcmd (PixmapId -> XCommand
FreePixmap PixmapId
bitmapid),
                forall {b}. XCommand -> Message FRequest b
lxcmd (PixmapId -> XCommand
FreePixmap PixmapId
pixmapid),
                forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
size Bool
True Bool
True)),
                forall {b}. XCommand -> Message FRequest b
lxcmd XCommand
ClearWindow] 
               K BitmapReturn ho
displayproc)
      lxcmd :: XCommand -> Message FRequest b
lxcmd = forall a b. a -> Message a b
Low forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCommand -> FRequest
XCmd
      displayproc :: K BitmapReturn ho
displayproc =
        forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK (\KEvent BitmapReturn
msg ->
          case KEvent BitmapReturn
msg of
            Low (XEvt (Expose Rect
_ Int
0)) -> forall {i} {o}. XCommand -> K i o -> K i o
xcommandK XCommand
ClearWindow K BitmapReturn ho
displayproc 
            High BitmapReturn
BitmapBad -> forall a. HasCallStack => FilePath -> a
error (FilePath
"Invalid bitmap file")
            High (BitmapReturn Size
size Maybe Size
_ PixmapId
bitmapid) -> Size -> PixmapId -> K BitmapReturn ho
displayImage Size
size PixmapId
bitmapid
            KEvent BitmapReturn
_ -> K BitmapReturn ho
displayproc)
  in forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FilePath -> (BitmapReturn -> f hi ho) -> f hi ho
readBitmapFile FilePath
filename (\BitmapReturn
bmr ->
       case BitmapReturn
bmr of
         BitmapReturn
BitmapBad -> forall a. HasCallStack => FilePath -> a
error (FilePath
"Invalid bitmap file " forall a. [a] -> [a] -> [a]
++ FilePath
filename)
         BitmapReturn Size
size Maybe Size
_ PixmapId
bitmapid -> forall {ho}. Size -> PixmapId -> K BitmapReturn ho
displayImage Size
size PixmapId
bitmapid)

bitmapDispF :: FilePath -> F BitmapReturn a
bitmapDispF :: forall a. FilePath -> F BitmapReturn a
bitmapDispF FilePath
filename =
  let wattrs :: [WindowAttributes]
wattrs = [BackingStore -> WindowAttributes
CWBackingStore BackingStore
WhenMapped, [EventMask] -> WindowAttributes
CWEventMask [EventMask
ExposureMask]]
      kernelF :: F BitmapReturn b
kernelF =  forall a b. [FRequest] -> K a b -> F a b
windowF ([XCommand -> FRequest
XCmd forall a b. (a -> b) -> a -> b
$ [WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs])
                         (forall {ho}. FilePath -> K BitmapReturn ho
windowKernel FilePath
filename)
  in forall {a} {b}. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aCenter Alignment
aCenter forall {b}. F BitmapReturn b
kernelF

bitmapDispBorderF :: Int -> FilePath -> F BitmapReturn a
bitmapDispBorderF :: forall a. Int -> FilePath -> F BitmapReturn a
bitmapDispBorderF Int
width FilePath
filename =
  let wattrs :: [WindowAttributes]
wattrs = [BackingStore -> WindowAttributes
CWBackingStore BackingStore
WhenMapped, [EventMask] -> WindowAttributes
CWEventMask [EventMask
ExposureMask]]
      kernelF :: F BitmapReturn b
kernelF = forall a b. [FRequest] -> K a b -> F a b
windowF [XCommand -> FRequest
XCmd ([WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wattrs),
                         XCommand -> FRequest
XCmd ([WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
width])]
                         (forall {ho}. FilePath -> K BitmapReturn ho
windowKernel FilePath
filename)
  in forall {a} {b}. Int -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Int
0 Alignment
aCenter Alignment
aCenter forall {b}. F BitmapReturn b
kernelF

bitmapButtonF :: [(ModState, FilePath)] -> FilePath -> F BitmapReturn Click
bitmapButtonF [(ModState, FilePath)]
keys FilePath
filename =
  let kernelF :: F BitmapReturn a
kernelF = forall a. Int -> FilePath -> F BitmapReturn a
bitmapDispBorderF Int
0 FilePath
filename 
  in forall {a} {b}. Either a b -> b
fromRight forall a b e. (a -> b) -> F e a -> F e b
>^=< (forall {a} {b}.
[(ModState, FilePath)] -> F a b -> F a (Either b Click)
pushButtonF [(ModState, FilePath)]
keys forall {b}. F BitmapReturn b
kernelF)