{-# LANGUAGE DeriveFunctor #-}
module Drawing(Drawing(..),labelD,placedD,atomicD,DPath(..),up,GCSpec) where
import Graphic
import MeasuredGraphics(MeasuredGraphics(..),DPath(..),up)
import NullF()
import GCtx(GCSpec(..),wCreateGCtx)
import Placers2(overlayP)
import LayoutRequest
import GCAttrs(ColorSpec,FontSpec)
import Xtypes(GCAttributes)
data Drawing lbl leaf
= AtomicD leaf
| LabelD lbl (Drawing lbl leaf)
| AttribD GCSpec (Drawing lbl leaf)
| SpacedD Spacer (Drawing lbl leaf)
| PlacedD Placer (Drawing lbl leaf)
| ComposedD Int [Drawing lbl leaf]
| CreateHardAttribD GCtx [GCAttributes ColorSpec FontSpec] (GCtx ->
Drawing lbl leaf)
deriving (Int -> Drawing lbl leaf -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall lbl leaf.
(Show leaf, Show lbl) =>
Int -> Drawing lbl leaf -> ShowS
forall lbl leaf.
(Show leaf, Show lbl) =>
[Drawing lbl leaf] -> ShowS
forall lbl leaf.
(Show leaf, Show lbl) =>
Drawing lbl leaf -> String
showList :: [Drawing lbl leaf] -> ShowS
$cshowList :: forall lbl leaf.
(Show leaf, Show lbl) =>
[Drawing lbl leaf] -> ShowS
show :: Drawing lbl leaf -> String
$cshow :: forall lbl leaf.
(Show leaf, Show lbl) =>
Drawing lbl leaf -> String
showsPrec :: Int -> Drawing lbl leaf -> ShowS
$cshowsPrec :: forall lbl leaf.
(Show leaf, Show lbl) =>
Int -> Drawing lbl leaf -> ShowS
Show,forall a b. a -> Drawing lbl b -> Drawing lbl a
forall a b. (a -> b) -> Drawing lbl a -> Drawing lbl b
forall lbl a b. a -> Drawing lbl b -> Drawing lbl a
forall lbl a b. (a -> b) -> Drawing lbl a -> Drawing lbl b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Drawing lbl b -> Drawing lbl a
$c<$ :: forall lbl a b. a -> Drawing lbl b -> Drawing lbl a
fmap :: forall a b. (a -> b) -> Drawing lbl a -> Drawing lbl b
$cfmap :: forall lbl a b. (a -> b) -> Drawing lbl a -> Drawing lbl b
Functor)
labelD :: lbl -> Drawing lbl leaf -> Drawing lbl leaf
labelD = forall lbl leaf. lbl -> Drawing lbl leaf -> Drawing lbl leaf
LabelD
placedD :: Placer -> Drawing lbl leaf -> Drawing lbl leaf
placedD = forall lbl leaf. Placer -> Drawing lbl leaf -> Drawing lbl leaf
PlacedD
atomicD :: leaf -> Drawing lbl leaf
atomicD = forall lbl leaf. leaf -> Drawing lbl leaf
AtomicD
instance Graphic leaf => Graphic (Drawing annot leaf) where
measureGraphicK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
Drawing annot leaf -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = forall {a} {k :: * -> * -> *} {lbl} {i} {o}.
(Graphic a, FudgetIO k) =>
Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK
measureGraphicListK :: forall (k :: * -> * -> *) i o.
FudgetIO k =>
[Drawing annot leaf] -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicListK = forall {a} {k :: * -> * -> *} {lbl} {i} {o}.
(Graphic a, FudgetIO k) =>
Placer
-> [Drawing lbl a] -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawListK Placer
overlayP
drawK :: Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK Drawing lbl a
d GCtx
gctx MeasuredGraphics -> k i o
k =
case Drawing lbl a
d of
AtomicD a
x -> forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
x GCtx
gctx MeasuredGraphics -> k i o
k
LabelD lbl
_ Drawing lbl a
d -> Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK Drawing lbl a
d GCtx
gctx (MeasuredGraphics -> k i o
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCtx -> MeasuredGraphics -> MeasuredGraphics
MarkM GCtx
gctx)
AttribD GCSpec
gcspec Drawing lbl a
d ->
forall {f :: * -> * -> *} {i} {o}.
FudgetIO f =>
GCtx -> GCSpec -> (GCtx -> f i o) -> f i o
wCreateGCtx' GCtx
gctx GCSpec
gcspec forall a b. (a -> b) -> a -> b
$ \ GCtx
gctx' ->
Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK Drawing lbl a
d GCtx
gctx' (MeasuredGraphics -> k i o
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCtx -> MeasuredGraphics -> MeasuredGraphics
MarkM GCtx
gctx')
SpacedD Spacer
spacer Drawing lbl a
d ->
Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK Drawing lbl a
d GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
g ->
MeasuredGraphics -> k i o
k (Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM Spacer
spacer MeasuredGraphics
g)
PlacedD Placer
placer Drawing lbl a
d ->
Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK Drawing lbl a
d GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
g ->
MeasuredGraphics -> k i o
k (Placer -> MeasuredGraphics -> MeasuredGraphics
PlacedM Placer
placer MeasuredGraphics
g)
ComposedD Int
n [Drawing lbl a]
ds ->
GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> k i o) -> k i o
drawsK GCtx
gctx (forall a. Int -> [a] -> [a]
take Int
n [Drawing lbl a]
ds) forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
gs ->
MeasuredGraphics -> k i o
k ([MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
gs)
CreateHardAttribD GCtx
templ [GCAttributes ColorSpec FontSpec]
attrs GCtx -> Drawing lbl a
d ->
forall {a1} {f :: * -> * -> *} {a2} {i} {o}.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
wCreateGCtx GCtx
templ [GCAttributes ColorSpec FontSpec]
attrs forall a b. (a -> b) -> a -> b
$ \GCtx
tx ->
Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK (GCtx -> Drawing lbl a
d GCtx
tx) GCtx
gctx MeasuredGraphics -> k i o
k
drawListK :: Placer
-> [Drawing lbl a] -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawListK Placer
placer [Drawing lbl a]
ds GCtx
gctx MeasuredGraphics -> k i o
k =
forall {a} {k :: * -> * -> *} {lbl} {i} {o}.
(Graphic a, FudgetIO k) =>
GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> k i o) -> k i o
drawsK GCtx
gctx [Drawing lbl a]
ds forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
gs ->
MeasuredGraphics -> k i o
k (Placer -> MeasuredGraphics -> MeasuredGraphics
PlacedM Placer
placer forall a b. (a -> b) -> a -> b
$ [MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
gs)
drawsK :: GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> k i o) -> k i o
drawsK GCtx
gctx [] [MeasuredGraphics] -> k i o
k = [MeasuredGraphics] -> k i o
k []
drawsK GCtx
gctx (Drawing lbl a
d:[Drawing lbl a]
ds) [MeasuredGraphics] -> k i o
k =
Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK Drawing lbl a
d GCtx
gctx forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
g ->
GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> k i o) -> k i o
drawsK GCtx
gctx [Drawing lbl a]
ds forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
gs ->
[MeasuredGraphics] -> k i o
k (MeasuredGraphics
gforall a. a -> [a] -> [a]
:[MeasuredGraphics]
gs)
wCreateGCtx' :: GCtx -> GCSpec -> (GCtx -> f i o) -> f i o
wCreateGCtx' GCtx
gctx GCSpec
gcspec GCtx -> f i o
k =
case GCSpec
gcspec of
HardGC GCtx
gctx' -> GCtx -> f i o
k GCtx
gctx'
SoftGC [GCAttributes ColorSpec FontSpec]
gcattrs -> forall {a1} {f :: * -> * -> *} {a2} {i} {o}.
(ColorGen a1, FudgetIO f, FontGen a2, Show a1, Show a2) =>
GCtx -> [GCAttributes a1 a2] -> (GCtx -> f i o) -> f i o
wCreateGCtx GCtx
gctx [GCAttributes ColorSpec FontSpec]
gcattrs GCtx -> f i o
k