module BitmapDrawing where
import Graphic
import MeasuredGraphics(MeasuredGraphics(..))
import GCtx(GCtx(..))
--import Command
import Event(BitmapReturn(..))
import DrawTypes
import Geometry(Rect(..),origin)
import Xtypes
--import FudgetIO
import NullF() -- instances, for hbc
import LayoutRequest(refpLayout,plainLayout)
import Gc
import StdIoUtil(echoStderrK)
import Pixmap(readBitmapFile)
import Data.Maybe(maybeToList)
--import ContinuationIO(stderr)

data BitmapFile = BitmapFile String

instance Graphic BitmapFile where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
BitmapFile -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (BitmapFile String
filename) (GC GCId
gc FontData
_) MeasuredGraphics -> k i o
k =
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
String -> (BitmapReturn -> f hi ho) -> f hi ho
readBitmapFile String
filename forall a b. (a -> b) -> a -> b
$ \ BitmapReturn
bmret ->
    case BitmapReturn
bmret of
      BitmapReturn Size
size Maybe Size
optrefp PixmapId
pixmap ->
          forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
GCId -> GCAttributeList -> (GCId -> f hi ho) -> f hi ho
wCreateGC GCId
gc [forall a b. Bool -> GCAttributes a b
GCGraphicsExposures Bool
False] forall a b. (a -> b) -> a -> b
$ \ GCId
gc' ->
          MeasuredGraphics -> k i o
k (LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM LayoutRequest
ll (forall {a}. a -> Rect -> [(a, [DrawCommand])]
drawit GCId
gc'))
	where r :: Rect
r = Size -> Size -> Rect
Rect Size
origin Size
size
              ll :: LayoutRequest
ll = Size -> Bool -> Bool -> [Size] -> LayoutRequest
refpLayout Size
size Bool
True Bool
True (forall a. Maybe a -> [a]
maybeToList Maybe Size
optrefp)
	      drawit :: a -> Rect -> [(a, [DrawCommand])]
drawit a
gc (Rect Size
p Size
_) = [(a
gc,[Drawable -> Rect -> Size -> Int -> DrawCommand
CopyPlane (PixmapId -> Drawable
Pixmap PixmapId
pixmap) Rect
r Size
p Int
0])]
      BitmapReturn
_ ->
          forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
String -> f hi ho -> f hi ho
echoStderrK (String
"Failed to load bitmap "forall a. [a] -> [a] -> [a]
++String
filename) forall a b. (a -> b) -> a -> b
$
          MeasuredGraphics -> k i o
k (LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM LayoutRequest
ll Rect -> [(GCId, [DrawCommand])]
drawit)
	where ll :: LayoutRequest
ll = Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
20 Bool
False Bool
False
	      drawit :: Rect -> [(GCId, [DrawCommand])]
drawit Rect
r = [(GCId
gc,[Rect -> DrawCommand
FillRectangle Rect
r])]