module FixedDrawing where
import Graphic
import MeasuredGraphics(MeasuredGraphics(..),measureImageString)
import GCtx(GCtx(..))
import ResourceIds(GCId)
import LayoutRequest
import Geometry(Rect(..),Size(..))
import Command(DrawCommand)
import Drawcmd(move)
--import EitherUtils(Cont(..))

data FixedDrawing = FixD Size [DrawCommand] deriving Int -> FixedDrawing -> ShowS
[FixedDrawing] -> ShowS
FixedDrawing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixedDrawing] -> ShowS
$cshowList :: [FixedDrawing] -> ShowS
show :: FixedDrawing -> String
$cshow :: FixedDrawing -> String
showsPrec :: Int -> FixedDrawing -> ShowS
$cshowsPrec :: Int -> FixedDrawing -> ShowS
Show

instance Graphic FixedDrawing where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
FixedDrawing -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (FixD Size
s [DrawCommand]
dcmds) (GC GCId
gc FontData
_) MeasuredGraphics -> k i o
k =
      MeasuredGraphics -> k i o
k (LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
s Bool
True Bool
True) Rect -> [(GCId, [DrawCommand])]
drawit)
    where
      drawit :: Rect -> [(GCId, [DrawCommand])]
drawit (Rect Size
p Size
_) = [(GCId
gc,forall a. Move a => Size -> a -> a
move Size
p [DrawCommand]
dcmds)]

data FixedColorDrawing = FixCD Size [(GCId,[DrawCommand])] deriving Int -> FixedColorDrawing -> ShowS
[FixedColorDrawing] -> ShowS
FixedColorDrawing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixedColorDrawing] -> ShowS
$cshowList :: [FixedColorDrawing] -> ShowS
show :: FixedColorDrawing -> String
$cshow :: FixedColorDrawing -> String
showsPrec :: Int -> FixedColorDrawing -> ShowS
$cshowsPrec :: Int -> FixedColorDrawing -> ShowS
Show

instance Graphic FixedColorDrawing where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
FixedColorDrawing -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (FixCD Size
s [(GCId, [DrawCommand])]
gcdcmds) GCtx
_ MeasuredGraphics -> k i o
k =
      MeasuredGraphics -> k i o
k (LayoutRequest
-> (Rect -> [(GCId, [DrawCommand])]) -> MeasuredGraphics
LeafM (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
s Bool
True Bool
True) Rect -> [(GCId, [DrawCommand])]
drawit)
    where
      drawit :: Rect -> [(GCId, [DrawCommand])]
drawit (Rect Size
p Size
_) =
        if Size
pforall a. Eq a => a -> a -> Bool
==Size
0
	then [(GCId, [DrawCommand])]
gcdcmds
	else [(GCId
gc,forall a. Move a => Size -> a -> a
move Size
p [DrawCommand]
dcmds)|(GCId
gc,[DrawCommand]
dcmds)<-[(GCId, [DrawCommand])]
gcdcmds]


newtype ImageString = ImageString String

instance Graphic ImageString where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
ImageString -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (ImageString String
s) = forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
String -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureImageString String
s