module PixmapGen where
import Graphic
import MeasuredGraphics(MeasuredGraphics(..))
import GCtx(GCtx(..))
--import Command
--import Event
import DrawTypes
import Geometry(Rect(..),Size,origin)
import Xtypes
import FudgetIO
import NullF() -- instances, for hbc
import LayoutRequest(plainLayout)
import Gc
--import EitherUtils(Cont(..))
--import Io(appendChanK)
--import Pixmap(readBitmapFile)
--import Maybe(maybeToList)
--import ContinuationIO(stderr)

data PixmapImage = PixmapImage Size PixmapId

instance Graphic PixmapImage where
    measureGraphicK :: PixmapImage -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (PixmapImage Size
size PixmapId
pixmap) (GC GCId
gc FontData
_) MeasuredGraphics -> k i o
k =
      GCId -> [GCAttributes Pixel FontId] -> (GCId -> k i o) -> k i o
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
GCId -> [GCAttributes Pixel FontId] -> (GCId -> f b ho) -> f b ho
wCreateGC GCId
gc [Bool -> GCAttributes Pixel FontId
forall a b. Bool -> GCAttributes a b
GCGraphicsExposures Bool
False] ((GCId -> k i o) -> k i o) -> (GCId -> k i o) -> k i o
forall a b. (a -> b) -> a -> b
$ \ GCId
gc' ->
      let r :: Rect
r = Size -> Size -> Rect
Rect Size
origin Size
size
	  ll :: LayoutRequest
ll = Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
size Bool
True Bool
True
	  drawit :: Rect -> [(GCId, [DrawCommand])]
drawit (Rect Size
p Size
_) = [(GCId
gc,[Drawable -> Rect -> Size -> DrawCommand
CopyArea (PixmapId -> Drawable
Pixmap PixmapId
pixmap) Rect
r Size
p])]
      in MeasuredGraphics -> k i o
k (LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM LayoutRequest
ll Rect -> [(GCId, [DrawCommand])]
drawit)

---

class PixmapGen a where
  convToPixmapK :: FudgetIO c => a -> Cont (c i o) PixmapImage

measureImageK :: a -> GCtx -> (MeasuredGraphics -> c i o) -> c i o
measureImageK a
a GCtx
gctx MeasuredGraphics -> c i o
k =
  a -> Cont (c i o) PixmapImage
forall a (c :: * -> * -> *) i o.
(PixmapGen a, FudgetIO c) =>
a -> Cont (c i o) PixmapImage
convToPixmapK a
a Cont (c i o) PixmapImage -> Cont (c i o) PixmapImage
forall a b. (a -> b) -> a -> b
$ \ PixmapImage
pmi ->
  PixmapImage -> GCtx -> (MeasuredGraphics -> c i o) -> c i o
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK PixmapImage
pmi GCtx
gctx MeasuredGraphics -> c i o
k

--This is not allowed in Haskell...
--instance PixmapGen a => Graphic a where  measureGraphicsK = measureImageK

instance PixmapGen PixmapImage where
  convToPixmapK :: PixmapImage -> Cont (c i o) PixmapImage
convToPixmapK PixmapImage
pmi PixmapImage -> c i o
k = PixmapImage -> c i o
k PixmapImage
pmi