module Graphic(module Graphic,MeasuredGraphics,emptyMG,emptyMG',GCtx,Cont(..)) where
import Fudget
import FudgetIO
import EitherUtils(Cont(..))
import Cont(conts)
import MeasuredGraphics(MeasuredGraphics(..),measureString,measurePackedString,emptyMG,emptyMG')
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 =
	(a -> Cont (k i o) MeasuredGraphics)
-> [a] -> Cont (k i o) [MeasuredGraphics]
forall a c b. (a -> Cont c b) -> [a] -> Cont c [b]
conts (a -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
`measureGraphicK` GCtx
gctx) [a]
xs Cont (k i o) [MeasuredGraphics] -> Cont (k i o) [MeasuredGraphics]
forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
mgs ->
	MeasuredGraphics -> k i o
cont ([MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
mgs)

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

instance Graphic a => Graphic [a] where
  measureGraphicK :: [a] -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = [a] -> GCtx -> Cont (k i o) MeasuredGraphics
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 :: (a, b) -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (a
x,b
y) GCtx
gctx MeasuredGraphics -> k i o
cont =
    a -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
x GCtx
gctx Cont (k i o) MeasuredGraphics -> Cont (k i o) MeasuredGraphics
forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
mx ->
    b -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK b
y GCtx
gctx Cont (k i o) MeasuredGraphics -> Cont (k i o) MeasuredGraphics
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 b ho) -> f b ho
measureText a
x = ([Char] -> GCtx -> (MeasuredGraphics -> f b ho) -> f b ho
forall (k :: * -> * -> *) i o.
FudgetIO k =>
[Char] -> GCtx -> Cont (k i o) MeasuredGraphics
measureString([Char] -> GCtx -> (MeasuredGraphics -> f b ho) -> f b ho)
-> (a -> [Char])
-> a
-> GCtx
-> (MeasuredGraphics -> f b ho)
-> f b ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> [Char]
forall a. Show a => a -> [Char]
show) a
x

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

instance (Graphic a,Graphic b) => Graphic (Either a b) where
  measureGraphicK :: Either a b -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = (a -> GCtx -> Cont (k i o) MeasuredGraphics)
-> (b -> GCtx -> Cont (k i o) MeasuredGraphics)
-> Either a b
-> GCtx
-> Cont (k i o) MeasuredGraphics
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK b -> GCtx -> Cont (k i o) MeasuredGraphics
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 :: Maybe a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = (GCtx -> Cont (k i o) MeasuredGraphics)
-> (a -> GCtx -> Cont (k i o) MeasuredGraphics)
-> Maybe a
-> GCtx
-> Cont (k i o) MeasuredGraphics
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MeasuredGraphics -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK (Size -> MeasuredGraphics
emptyMG Size
5)) a -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK

--instance Graphic Void