{-# LANGUAGE DeriveFunctor #-}
module Drawing(Drawing(..),labelD,placedD,atomicD,DPath(..),up,GCSpec) where
import Graphic
import MeasuredGraphics(MeasuredGraphics(..),DPath(..),up)
--import FudgetIO
import NullF() -- instances, for hbc
import GCtx(GCSpec(..),wCreateGCtx)
import Placers2(overlayP)
import LayoutRequest
--import EitherUtils(Cont(..))
import GCAttrs(ColorSpec,FontSpec)
import Xtypes(GCAttributes)
--import Geometry() -- Show instances

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]   -- ^ Int=how many visible components
  | 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  -- or autoP ??


drawK :: Drawing lbl a -> GCtx -> (MeasuredGraphics -> k i o) -> k i o
drawK Drawing lbl a
d GCtx
gctx{-@(GC gc fs)-} 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 ->
      -- take the n visible components, remaining parts are invisible.
      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
{-
  where
    replaceFontK fs gcattrs k = font gcattrs (k fs) (\fid -> queryFont fid k)
    font [] kdef _ = kdef
    font (GCFont fid:gcattrs) _ kfont = kfont fid
    font (_:gcattrs) kdef kfont = font gcattrs kdef kfont
-}

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