module Graphic(module Graphic,MeasuredGraphics,emptyMG,emptyMG',GCtx,Cont(..)) where
--import Fudget
import FudgetIO
import EitherUtils(Cont(..))
import Cont(conts)
import MeasuredGraphics(MeasuredGraphics(..),measureString,emptyMG,emptyMG') --,measurePackedString
import GCtx(GCtx)
--import PackedString(PackedString)
import Geometry() -- instance Num Point

class Graphic a where
  measureGraphicK :: FudgetIO k => a -> GCtx -> Cont (k i o) MeasuredGraphics
  measureGraphicListK :: FudgetIO k => [a] -> GCtx -> Cont (k i o) MeasuredGraphics
  -- Default method for lists:
  measureGraphicListK [a]
xs GCtx
gctx MeasuredGraphics -> k i o
cont =
	forall a c b. (a -> Cont c b) -> [a] -> Cont c [b]
conts (forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
`measureGraphicK` GCtx
gctx) [a]
xs forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
mgs ->
	MeasuredGraphics -> k i o
cont ([MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
mgs)

instance Graphic MeasuredGraphics where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
MeasuredGraphics -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK MeasuredGraphics
cgfx GCtx
gctx MeasuredGraphics -> k i o
c = MeasuredGraphics -> k i o
c MeasuredGraphics
cgfx

instance Graphic Char where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Char -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK Char
c = forall (k :: * -> * -> *) i o.
FudgetIO k =>
[Char] -> GCtx -> Cont (k i o) MeasuredGraphics
measureString [Char
c]
  measureGraphicListK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
[Char] -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicListK = forall (k :: * -> * -> *) i o.
FudgetIO k =>
[Char] -> GCtx -> Cont (k i o) MeasuredGraphics
measureString

instance Graphic a => Graphic [a] where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
[a] -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
[a] -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicListK

instance (Graphic a,Graphic b) => Graphic (a,b) where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
(a, b) -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (a
x,b
y) GCtx
gctx MeasuredGraphics -> k i o
cont =
    forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
x GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
mx ->
    forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK b
y GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
my ->
    MeasuredGraphics -> k i o
cont ([MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics
mx,MeasuredGraphics
my])

measureText :: a -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureText a
x = (forall (k :: * -> * -> *) i o.
FudgetIO k =>
[Char] -> GCtx -> Cont (k i o) MeasuredGraphics
measureStringforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> [Char]
show) a
x

-- instance Text a => Graphics a where measureGraphicK = measureText
instance Graphic Int          where measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Int -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall {f :: * -> * -> *} {a} {hi} {ho}.
(FudgetIO f, Show a) =>
a -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureText
instance Graphic Integer      where measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Integer -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall {f :: * -> * -> *} {a} {hi} {ho}.
(FudgetIO f, Show a) =>
a -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureText
instance Graphic Bool         where measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Bool -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall {f :: * -> * -> *} {a} {hi} {ho}.
(FudgetIO f, Show a) =>
a -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureText
instance Graphic Float        where measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Float -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall {f :: * -> * -> *} {a} {hi} {ho}.
(FudgetIO f, Show a) =>
a -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureText
instance Graphic Double       where measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Double -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall {f :: * -> * -> *} {a} {hi} {ho}.
(FudgetIO f, Show a) =>
a -> GCtx -> (MeasuredGraphics -> f hi ho) -> f hi ho
measureText
--instance Graphic PackedString where measureGraphicK = measurePackedString

instance (Graphic a,Graphic b) => Graphic (Either a b) where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Either a b -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK

instance Graphic a => Graphic (Maybe a) where
  measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Maybe a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (Size -> MeasuredGraphics
emptyMG Size
5)) forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK

--instance Graphic Void