{-# 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
[Drawing lbl leaf] -> ShowS
Drawing lbl leaf -> String
(Int -> Drawing lbl leaf -> ShowS)
-> (Drawing lbl leaf -> String)
-> ([Drawing lbl leaf] -> ShowS)
-> Show (Drawing lbl leaf)
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,a -> Drawing lbl b -> Drawing lbl a
(a -> b) -> Drawing lbl a -> Drawing lbl b
(forall a b. (a -> b) -> Drawing lbl a -> Drawing lbl b)
-> (forall a b. a -> Drawing lbl b -> Drawing lbl a)
-> Functor (Drawing lbl)
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
<$ :: a -> Drawing lbl b -> Drawing lbl a
$c<$ :: forall lbl a b. a -> Drawing lbl b -> Drawing lbl a
fmap :: (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 = lbl -> Drawing lbl leaf -> Drawing lbl leaf
forall lbl leaf. lbl -> Drawing lbl leaf -> Drawing lbl leaf
LabelD
placedD :: Placer -> Drawing lbl leaf -> Drawing lbl leaf
placedD = Placer -> Drawing lbl leaf -> Drawing lbl leaf
forall lbl leaf. Placer -> Drawing lbl leaf -> Drawing lbl leaf
PlacedD
atomicD :: leaf -> Drawing lbl leaf
atomicD = leaf -> Drawing lbl leaf
forall lbl leaf. leaf -> Drawing lbl leaf
AtomicD

instance Graphic leaf => Graphic (Drawing annot leaf) where
  measureGraphicK :: Drawing annot leaf -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK = Drawing annot leaf -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (f :: * -> * -> *) lbl i o.
(Graphic a, FudgetIO f) =>
Drawing lbl a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawK
  measureGraphicListK :: [Drawing annot leaf] -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicListK = Placer
-> [Drawing annot leaf] -> GCtx -> Cont (k i o) MeasuredGraphics
forall a (f :: * -> * -> *) lbl i o.
(Graphic a, FudgetIO f) =>
Placer
-> [Drawing lbl a] -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawListK Placer
overlayP  -- or autoP ??


drawK :: Drawing lbl a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawK Drawing lbl a
d GCtx
gctx{-@(GC gc fs)-} MeasuredGraphics -> f i o
k =
  case Drawing lbl a
d of
    AtomicD a
x -> a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
forall a (k :: * -> * -> *) i o.
(Graphic a, FudgetIO k) =>
a -> GCtx -> Cont (k i o) MeasuredGraphics
measureGraphicK a
x GCtx
gctx MeasuredGraphics -> f i o
k
    LabelD lbl
_ Drawing lbl a
d -> Drawing lbl a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawK Drawing lbl a
d GCtx
gctx (MeasuredGraphics -> f i o
k (MeasuredGraphics -> f i o)
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
-> f i o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GCtx -> MeasuredGraphics -> MeasuredGraphics
MarkM GCtx
gctx)
    AttribD GCSpec
gcspec Drawing lbl a
d ->
      GCtx -> GCSpec -> (GCtx -> f i o) -> f i o
forall (f :: * -> * -> *) i o.
FudgetIO f =>
GCtx -> GCSpec -> (GCtx -> f i o) -> f i o
wCreateGCtx' GCtx
gctx GCSpec
gcspec ((GCtx -> f i o) -> f i o) -> (GCtx -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ GCtx
gctx' ->
      Drawing lbl a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawK Drawing lbl a
d GCtx
gctx' (MeasuredGraphics -> f i o
k (MeasuredGraphics -> f i o)
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
-> f i o
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 -> f i o) -> f i o
drawK Drawing lbl a
d GCtx
gctx ((MeasuredGraphics -> f i o) -> f i o)
-> (MeasuredGraphics -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
g ->
      MeasuredGraphics -> f i o
k (Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM Spacer
spacer MeasuredGraphics
g)
    PlacedD Placer
placer Drawing lbl a
d ->
      Drawing lbl a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawK Drawing lbl a
d GCtx
gctx ((MeasuredGraphics -> f i o) -> f i o)
-> (MeasuredGraphics -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
g ->
      MeasuredGraphics -> f 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] -> f i o) -> f i o
drawsK GCtx
gctx (Int -> [Drawing lbl a] -> [Drawing lbl a]
forall a. Int -> [a] -> [a]
take Int
n [Drawing lbl a]
ds) (([MeasuredGraphics] -> f i o) -> f i o)
-> ([MeasuredGraphics] -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
gs ->
      MeasuredGraphics -> f i o
k ([MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
gs)
    CreateHardAttribD GCtx
templ [GCAttributes ColorSpec FontSpec]
attrs GCtx -> Drawing lbl a
d ->
      GCtx
-> [GCAttributes ColorSpec FontSpec] -> (GCtx -> f i o) -> f i o
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 ((GCtx -> f i o) -> f i o) -> (GCtx -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \GCtx
tx ->
      Drawing lbl a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawK (GCtx -> Drawing lbl a
d GCtx
tx) GCtx
gctx MeasuredGraphics -> f 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 -> f i o) -> f i o
drawListK Placer
placer [Drawing lbl a]
ds GCtx
gctx MeasuredGraphics -> f i o
k =
  GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> f i o) -> f i o
forall a (f :: * -> * -> *) lbl i o.
(Graphic a, FudgetIO f) =>
GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> f i o) -> f i o
drawsK GCtx
gctx [Drawing lbl a]
ds (([MeasuredGraphics] -> f i o) -> f i o)
-> ([MeasuredGraphics] -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
gs ->
  MeasuredGraphics -> f i o
k (Placer -> MeasuredGraphics -> MeasuredGraphics
PlacedM Placer
placer (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics -> MeasuredGraphics
forall a b. (a -> b) -> a -> b
$ [MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
gs)

drawsK :: GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> f i o) -> f i o
drawsK GCtx
gctx [] [MeasuredGraphics] -> f i o
k = [MeasuredGraphics] -> f i o
k []
drawsK GCtx
gctx (Drawing lbl a
d:[Drawing lbl a]
ds) [MeasuredGraphics] -> f i o
k =
  Drawing lbl a -> GCtx -> (MeasuredGraphics -> f i o) -> f i o
drawK Drawing lbl a
d GCtx
gctx ((MeasuredGraphics -> f i o) -> f i o)
-> (MeasuredGraphics -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ MeasuredGraphics
g ->
  GCtx -> [Drawing lbl a] -> ([MeasuredGraphics] -> f i o) -> f i o
drawsK GCtx
gctx [Drawing lbl a]
ds (([MeasuredGraphics] -> f i o) -> f i o)
-> ([MeasuredGraphics] -> f i o) -> f i o
forall a b. (a -> b) -> a -> b
$ \ [MeasuredGraphics]
gs ->
  [MeasuredGraphics] -> f i o
k (MeasuredGraphics
gMeasuredGraphics -> [MeasuredGraphics] -> [MeasuredGraphics]
forall 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 -> GCtx
-> [GCAttributes ColorSpec FontSpec] -> (GCtx -> f i o) -> f i o
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