module MGOps where
import MeasuredGraphics(MeasuredGraphics(..))
import Maptrace(ctrace)
import Utils(anth)
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)
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
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
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
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
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