module MGOps where
import MeasuredGraphics(MeasuredGraphics(..))
import Maptrace(ctrace)
import Utils(anth)

{-
mgPart drawing path =
  case path of
    [] -> drawing
    p:ps -> part drawing
      where
        part drawing =
	  case drawing of
	    LeafM _ _ _     -> error "bad path in mgPart"
	    SpacedM   _  d  -> part d
	    PlacedM   _  d  -> part d
	    ComposedM    ds -> mgPart (ds !! ((p::Int)-1)) ps
-}

{-    
replaceMGPart drawing path new =
  (if any (<1) path
  then ctrace "replaceMGPart" path
  else id) $ replaceMGPart' drawing path new
-}

replaceMGPart :: MeasuredGraphics -> [Int] -> MeasuredGraphics -> MeasuredGraphics
replaceMGPart MeasuredGraphics
drawing [Int]
path MeasuredGraphics
new = MeasuredGraphics
-> [Int]
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
updateMGPart MeasuredGraphics
drawing [Int]
path (MeasuredGraphics -> MeasuredGraphics -> MeasuredGraphics
forall a b. a -> b -> a
const MeasuredGraphics
new)

-- Replacing a part without changing the structure
updateMGPart :: MeasuredGraphics
-> [Int]
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
updateMGPart MeasuredGraphics
drawing [Int]
path MeasuredGraphics -> MeasuredGraphics
f =
  case [Int]
path of
    [] -> MeasuredGraphics -> MeasuredGraphics
f MeasuredGraphics
drawing
    Int
p:[Int]
ps  -> MeasuredGraphics -> MeasuredGraphics
repl MeasuredGraphics
drawing
      where
        err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"bad path in replaceMGPart: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Int] -> [Char]
forall a. Show a => a -> [Char]
show [Int]
path)
	repl0 :: MeasuredGraphics -> MeasuredGraphics
repl0 MeasuredGraphics
d = if Int
pInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0
	          then MeasuredGraphics
-> [Int]
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
updateMGPart MeasuredGraphics
d [Int]
ps MeasuredGraphics -> MeasuredGraphics
f
		  else MeasuredGraphics
forall a. a
err
        repl :: MeasuredGraphics -> MeasuredGraphics
repl MeasuredGraphics
drawing =
	  case MeasuredGraphics
drawing of
	    LeafM LayoutRequest
_ Rect -> [(GCId, [DrawCommand])]
_            -> MeasuredGraphics
forall a. a
err
	    MarkM     GCtx
gctx    MeasuredGraphics
d  -> GCtx -> MeasuredGraphics -> MeasuredGraphics
MarkM GCtx
gctx (MeasuredGraphics -> MeasuredGraphics
repl0 MeasuredGraphics
d)
	    SpacedM   Spacer
spacer  MeasuredGraphics
d  -> Spacer -> MeasuredGraphics -> MeasuredGraphics
SpacedM Spacer
spacer (MeasuredGraphics -> MeasuredGraphics
repl0 MeasuredGraphics
d)
	    PlacedM   Placer
placer  MeasuredGraphics
d  -> Placer -> MeasuredGraphics -> MeasuredGraphics
PlacedM Placer
placer (MeasuredGraphics -> MeasuredGraphics
repl0 MeasuredGraphics
d)
	    ComposedM         [MeasuredGraphics]
ds -> [MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
ds'
              where ds' :: [MeasuredGraphics]
ds' = Int
-> (MeasuredGraphics -> MeasuredGraphics)
-> [MeasuredGraphics]
-> [MeasuredGraphics]
forall a. Int -> (a -> a) -> [a] -> [a]
anth Int
p (\MeasuredGraphics
d->MeasuredGraphics
-> [Int]
-> (MeasuredGraphics -> MeasuredGraphics)
-> MeasuredGraphics
updateMGPart MeasuredGraphics
d [Int]
ps MeasuredGraphics -> MeasuredGraphics
f) [MeasuredGraphics]
ds

-- Changing the structure but not the appearance
groupMGParts :: Int -> Int -> MeasuredGraphics -> MeasuredGraphics
groupMGParts Int
pos Int
len MeasuredGraphics
drawing =
  case MeasuredGraphics
drawing of
    ComposedM [MeasuredGraphics]
ds -> [MeasuredGraphics] -> MeasuredGraphics
ComposedM ([MeasuredGraphics]
ds1[MeasuredGraphics] -> [MeasuredGraphics] -> [MeasuredGraphics]
forall a. [a] -> [a] -> [a]
++[MeasuredGraphics] -> MeasuredGraphics
ComposedM [MeasuredGraphics]
ds2MeasuredGraphics -> [MeasuredGraphics] -> [MeasuredGraphics]
forall a. a -> [a] -> [a]
:[MeasuredGraphics]
ds3)
      where
        ([MeasuredGraphics]
ds1,[MeasuredGraphics]
ds2a) = Int
-> [MeasuredGraphics] -> ([MeasuredGraphics], [MeasuredGraphics])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [MeasuredGraphics]
ds
        ([MeasuredGraphics]
ds2,[MeasuredGraphics]
ds3) = Int
-> [MeasuredGraphics] -> ([MeasuredGraphics], [MeasuredGraphics])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
len [MeasuredGraphics]
ds2a
    MeasuredGraphics
_ -> MeasuredGraphics
drawing

-- Changing the structure but not the appearance
ungroupMGParts :: Int -> MeasuredGraphics -> MeasuredGraphics
ungroupMGParts Int
pos MeasuredGraphics
drawing =
  case MeasuredGraphics
drawing of
    ComposedM [MeasuredGraphics]
ds ->
        case Int
-> [MeasuredGraphics] -> ([MeasuredGraphics], [MeasuredGraphics])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [MeasuredGraphics]
ds of
          ([MeasuredGraphics]
ds1,ComposedM [MeasuredGraphics]
ds2:[MeasuredGraphics]
ds3) -> [MeasuredGraphics] -> MeasuredGraphics
ComposedM ([MeasuredGraphics]
ds1[MeasuredGraphics] -> [MeasuredGraphics] -> [MeasuredGraphics]
forall a. [a] -> [a] -> [a]
++[MeasuredGraphics]
ds2[MeasuredGraphics] -> [MeasuredGraphics] -> [MeasuredGraphics]
forall a. [a] -> [a] -> [a]
++[MeasuredGraphics]
ds3)
          ([MeasuredGraphics], [MeasuredGraphics])
_ -> MeasuredGraphics
drawing
    MeasuredGraphics
_ -> MeasuredGraphics
drawing

parentGctx :: GCtx -> MeasuredGraphics -> [Int] -> GCtx
parentGctx GCtx
gctx MeasuredGraphics
mg [Int]
path =
  case [Int]
path of
    [] -> GCtx
gctx
    Int
0:[Int]
ps ->
      case MeasuredGraphics
mg of
        MarkM GCtx
gctx' MeasuredGraphics
mg' -> GCtx -> MeasuredGraphics -> [Int] -> GCtx
parentGctx GCtx
gctx' MeasuredGraphics
mg' [Int]
ps
	SpacedM Spacer
_   MeasuredGraphics
mg' -> GCtx -> MeasuredGraphics -> [Int] -> GCtx
parentGctx GCtx
gctx MeasuredGraphics
mg' [Int]
ps
	PlacedM Placer
_   MeasuredGraphics
mg' -> GCtx -> MeasuredGraphics -> [Int] -> GCtx
parentGctx GCtx
gctx MeasuredGraphics
mg' [Int]
ps
	MeasuredGraphics
_ -> [Char] -> [Int] -> GCtx -> GCtx
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"badpath" [Int]
path GCtx
gctx -- This is actually an error
    Int
p:[Int]
ps ->
      case MeasuredGraphics
mg of
	ComposedM   [MeasuredGraphics]
mgs ->
	  --{-
	  if Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>[MeasuredGraphics] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MeasuredGraphics]
mgs
	  then [Char] -> [Int] -> GCtx -> GCtx
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"badpath" [Int]
path GCtx
gctx -- This is actually an error
	  else --}
	  GCtx -> MeasuredGraphics -> [Int] -> GCtx
parentGctx GCtx
gctx ([MeasuredGraphics]
mgs[MeasuredGraphics] -> Int -> MeasuredGraphics
forall a. [a] -> Int -> a
!!(Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [Int]
ps
	MeasuredGraphics
_ -> [Char] -> [Int] -> GCtx -> GCtx
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"badpath" [Int]
path GCtx
gctx -- This is actually an error
{-
seqMG mg k =
  case mg of
    LeafM _ _ -> k
    SpacedM _ mg -> seqMG mg k
    PlacedM _ mg -> seqMG mg k
    MarkM _ mg -> seqMG mg k
    ComposedM mgs -> foldr seqMG k mgs


sizeMG mg =
  case mg of
    LeafM _ _ -> 1::Int
    SpacedM _ mg -> 1+sizeMG mg
    PlacedM _ mg -> 1+sizeMG mg
    MarkM _ mg -> 1+sizeMG mg
    ComposedM mgs -> 1+sum (map sizeMG mgs)
-}