module CompiledGraphics where
import Geometry(Rect(..))
import Utils(number)
import DrawTypes(DrawCommand)
import ResourceIds(GCId,rootGC)
import Rects(overlaps,boundingRect)
import Maptrace(ctrace)
data CompiledGraphics
= CGraphics Rect Cursor [(GCId,[DrawCommand])] [CompiledGraphics]
| CGMark CompiledGraphics
deriving (Int -> CompiledGraphics -> ShowS
[CompiledGraphics] -> ShowS
CompiledGraphics -> String
(Int -> CompiledGraphics -> ShowS)
-> (CompiledGraphics -> String)
-> ([CompiledGraphics] -> ShowS)
-> Show CompiledGraphics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompiledGraphics] -> ShowS
$cshowList :: [CompiledGraphics] -> ShowS
show :: CompiledGraphics -> String
$cshow :: CompiledGraphics -> String
showsPrec :: Int -> CompiledGraphics -> ShowS
$cshowsPrec :: Int -> CompiledGraphics -> ShowS
Show)
type Cursor = Bool
cgLeaf :: Rect -> (Rect -> [(GCId, [DrawCommand])]) -> CompiledGraphics
cgLeaf Rect
r Rect -> [(GCId, [DrawCommand])]
rcmds =
CompiledGraphics
cg
where
cg :: CompiledGraphics
cg = Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
False [(GCId, [DrawCommand])]
cmds []
cmds :: [(GCId, [DrawCommand])]
cmds = Rect -> [(GCId, [DrawCommand])]
rcmds Rect
r
cgMark :: CompiledGraphics -> CompiledGraphics
cgMark = CompiledGraphics -> CompiledGraphics
CGMark
cgCompose :: Rect -> [CompiledGraphics] -> CompiledGraphics
cgCompose Rect
r [CompiledGraphics]
cgs = Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
False [(GCId, [DrawCommand])]
forall a. [(GCId, [a])]
cmds [CompiledGraphics]
cgs
where
cmds :: [(GCId, [a])]
cmds = if [CompiledGraphics] -> Cursor
anyOverlap [CompiledGraphics]
cgs
then String -> [Rect] -> [(GCId, [a])] -> [(GCId, [a])]
forall a1 a2. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"cgoverlap" ((CompiledGraphics -> Rect) -> [CompiledGraphics] -> [Rect]
forall a b. (a -> b) -> [a] -> [b]
map CompiledGraphics -> Rect
cgrect [CompiledGraphics]
cgs) ([(GCId, [a])] -> [(GCId, [a])]) -> [(GCId, [a])] -> [(GCId, [a])]
forall a b. (a -> b) -> a -> b
$
[(GCId
rootGC,[])]
else []
anyOverlap :: [CompiledGraphics] -> Cursor
anyOverlap [] = Cursor
False
anyOverlap (CompiledGraphics
cg:[CompiledGraphics]
cgs) = [Rect] -> Rect -> [CompiledGraphics] -> Cursor
anyOverlaps' [Rect
r] Rect
r [CompiledGraphics]
cgs
where r :: Rect
r = CompiledGraphics -> Rect
cgrect CompiledGraphics
cg
anyOverlaps' :: [Rect] -> Rect -> [CompiledGraphics] -> Cursor
anyOverlaps' [Rect]
rs Rect
bounding [] = Cursor
False
anyOverlaps' [Rect]
rs Rect
bounding (CompiledGraphics
cg:[CompiledGraphics]
cgs) =
Rect
r Rect -> Rect -> Cursor
`overlaps` Rect
bounding Cursor -> Cursor -> Cursor
&& (Rect -> Cursor) -> [Rect] -> Cursor
forall (t :: * -> *) a.
Foldable t =>
(a -> Cursor) -> t a -> Cursor
any (Rect -> Rect -> Cursor
overlaps Rect
r) [Rect]
rs Cursor -> Cursor -> Cursor
||
[Rect] -> Rect -> [CompiledGraphics] -> Cursor
anyOverlaps' (Rect
rRect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
:[Rect]
rs) (Rect -> Rect -> Rect
boundingRect Rect
bounding Rect
r) [CompiledGraphics]
cgs
where r :: Rect
r = CompiledGraphics -> Rect
cgrect CompiledGraphics
cg
cgrect :: CompiledGraphics -> Rect
cgrect (CGMark CompiledGraphics
cg) = CompiledGraphics -> Rect
cgrect CompiledGraphics
cg
cgrect (CGraphics Rect
r Cursor
_ [(GCId, [DrawCommand])]
_ [CompiledGraphics]
_) = Rect
r
cgsize :: CompiledGraphics -> Size
cgsize = Rect -> Size
rectsize(Rect -> Size)
-> (CompiledGraphics -> Rect) -> CompiledGraphics -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CompiledGraphics -> Rect
cgrect
addcursor :: CompiledGraphics -> CompiledGraphics
addcursor (CGMark CompiledGraphics
cg) = CompiledGraphics -> CompiledGraphics
CGMark (CompiledGraphics -> CompiledGraphics
addcursor CompiledGraphics
cg)
addcursor (CGraphics Rect
r Cursor
_ [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
cgs) = Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
True [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
cgs
removecursor :: CompiledGraphics -> CompiledGraphics
removecursor (CGMark CompiledGraphics
cg) = CompiledGraphics -> CompiledGraphics
CGMark (CompiledGraphics -> CompiledGraphics
removecursor CompiledGraphics
cg)
removecursor (CGraphics Rect
r Cursor
_ [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
cgs) = Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
False [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
cgs
hascursor :: CompiledGraphics -> Cursor
hascursor (CGMark CompiledGraphics
cg) = CompiledGraphics -> Cursor
hascursor CompiledGraphics
cg
hascursor (CGraphics Rect
_ Cursor
cur [(GCId, [DrawCommand])]
_ [CompiledGraphics]
_) = Cursor
cur
cgpart :: CompiledGraphics -> [Int] -> CompiledGraphics
cgpart CompiledGraphics
cg [] = CompiledGraphics
cg
cgpart (CGMark CompiledGraphics
cg) (Int
0:[Int]
ps) = CompiledGraphics -> [Int] -> CompiledGraphics
cgpart CompiledGraphics
cg [Int]
ps
cgpart (CGraphics Rect
_ Cursor
_ [(GCId, [DrawCommand])]
_ [CompiledGraphics]
parts) (Int
p:[Int]
ps) =
if Int
pInt -> Int -> Cursor
forall a. Ord a => a -> a -> Cursor
<Int
1Cursor -> Cursor -> Cursor
||Int
pInt -> Int -> Cursor
forall a. Ord a => a -> a -> Cursor
>[CompiledGraphics] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompiledGraphics]
parts then String -> CompiledGraphics
forall a. HasCallStack => String -> a
error String
"bad path in CompiledGraphics.cgpart " else
CompiledGraphics -> [Int] -> CompiledGraphics
cgpart ([CompiledGraphics]
parts [CompiledGraphics] -> Int -> CompiledGraphics
forall a. [a] -> Int -> a
!! ((Int
p::Int)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) [Int]
ps
cgreplace :: CompiledGraphics -> [Int] -> CompiledGraphics -> CompiledGraphics
cgreplace CompiledGraphics
cg [Int]
path CompiledGraphics
new = CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [Int]
path (CompiledGraphics -> CompiledGraphics -> CompiledGraphics
forall a b. a -> b -> a
const CompiledGraphics
new)
cgupdate :: CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [] CompiledGraphics -> CompiledGraphics
f = CompiledGraphics -> CompiledGraphics
f CompiledGraphics
cg
cgupdate (CGMark CompiledGraphics
cg) (Int
0:[Int]
ps) CompiledGraphics -> CompiledGraphics
f = CompiledGraphics -> CompiledGraphics
CGMark (CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [Int]
ps CompiledGraphics -> CompiledGraphics
f)
cgupdate (CGMark CompiledGraphics
cg) [Int]
ps CompiledGraphics -> CompiledGraphics
f =
String -> String -> CompiledGraphics -> CompiledGraphics
forall a1 a2. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"badpath" (String
"(CGMark _) "String -> ShowS
forall a. [a] -> [a] -> [a]
++[Int] -> String
forall a. Show a => a -> String
show [Int]
ps) (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics -> CompiledGraphics
forall a b. (a -> b) -> a -> b
$
CompiledGraphics -> CompiledGraphics
CGMark (CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [Int]
ps CompiledGraphics -> CompiledGraphics
f)
cgupdate CompiledGraphics
cg (Int
0:[Int]
ps) CompiledGraphics -> CompiledGraphics
f =
String
-> (CompiledGraphics, [Int])
-> CompiledGraphics
-> CompiledGraphics
forall a1 a2. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"badpath" (CompiledGraphics
cg,Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ps) (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics -> CompiledGraphics
forall a b. (a -> b) -> a -> b
$
CompiledGraphics -> CompiledGraphics
CGMark (CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg [Int]
ps CompiledGraphics -> CompiledGraphics
f)
cgupdate (CGraphics Rect
r Cursor
cur [(GCId, [DrawCommand])]
dcmds [CompiledGraphics]
parts) (Int
p:[Int]
ps) CompiledGraphics -> CompiledGraphics
f =
Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
cur [(GCId, [DrawCommand])]
dcmds ([CompiledGraphics]
pre[CompiledGraphics] -> [CompiledGraphics] -> [CompiledGraphics]
forall a. [a] -> [a] -> [a]
++CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg' [Int]
ps CompiledGraphics -> CompiledGraphics
fCompiledGraphics -> [CompiledGraphics] -> [CompiledGraphics]
forall a. a -> [a] -> [a]
:[CompiledGraphics]
post)
where pre :: [CompiledGraphics]
pre = Int -> [CompiledGraphics] -> [CompiledGraphics]
forall a. Int -> [a] -> [a]
take (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [CompiledGraphics]
parts
CompiledGraphics
cg':[CompiledGraphics]
post = Int -> [CompiledGraphics] -> [CompiledGraphics]
forall a. Int -> [a] -> [a]
drop ((Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)::Int) [CompiledGraphics]
parts
cgcursors :: CompiledGraphics -> [[Int]]
cgcursors :: CompiledGraphics -> [[Int]]
cgcursors (CGMark CompiledGraphics
cg) = ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (CompiledGraphics -> [[Int]]
cgcursors CompiledGraphics
cg)
cgcursors (CGraphics Rect
_ Cursor
cur [(GCId, [DrawCommand])]
_ [CompiledGraphics]
parts) =
if Cursor
cur
then [][Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
:[[Int]]
partcursors
else [[Int]]
partcursors
where
partcursors :: [[Int]]
partcursors =
((Int, CompiledGraphics) -> [[Int]])
-> [(Int, CompiledGraphics)] -> [[Int]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
n,CompiledGraphics
ps) -> ([Int] -> [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map (Int
nInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (CompiledGraphics -> [[Int]]
cgcursors CompiledGraphics
ps)) (Int -> [CompiledGraphics] -> [(Int, CompiledGraphics)]
forall a. Int -> [a] -> [(Int, a)]
number Int
1 [CompiledGraphics]
parts)
cgGroup :: Int -> Int -> CompiledGraphics -> CompiledGraphics
cgGroup Int
pos Int
len (CGMark CompiledGraphics
cg) = CompiledGraphics -> CompiledGraphics
CGMark (Int -> Int -> CompiledGraphics -> CompiledGraphics
cgGroup Int
pos Int
len CompiledGraphics
cg)
cgGroup Int
pos Int
len (CGraphics Rect
r Cursor
cur [(GCId, [DrawCommand])]
dcmds [CompiledGraphics]
parts) =
Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
cur [(GCId, [DrawCommand])]
dcmds ([CompiledGraphics]
ds1[CompiledGraphics] -> [CompiledGraphics] -> [CompiledGraphics]
forall a. [a] -> [a] -> [a]
++Rect -> [CompiledGraphics] -> CompiledGraphics
cgCompose Rect
r2 [CompiledGraphics]
ds2CompiledGraphics -> [CompiledGraphics] -> [CompiledGraphics]
forall a. a -> [a] -> [a]
:[CompiledGraphics]
ds3)
where
([CompiledGraphics]
ds1,[CompiledGraphics]
ds2a) = Int
-> [CompiledGraphics] -> ([CompiledGraphics], [CompiledGraphics])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [CompiledGraphics]
parts
([CompiledGraphics]
ds2,[CompiledGraphics]
ds3) = Int
-> [CompiledGraphics] -> ([CompiledGraphics], [CompiledGraphics])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
len [CompiledGraphics]
ds2a
r2 :: Rect
r2 = (CompiledGraphics -> Rect -> Rect)
-> Rect -> [CompiledGraphics] -> Rect
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Rect -> Rect -> Rect
boundingRect(Rect -> Rect -> Rect)
-> (CompiledGraphics -> Rect) -> CompiledGraphics -> Rect -> Rect
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CompiledGraphics -> Rect
cgrect) (Size -> Size -> Rect
Rect Size
0 Size
0) [CompiledGraphics]
ds2
cgUngroup :: Int -> CompiledGraphics -> CompiledGraphics
cgUngroup Int
pos (CGMark CompiledGraphics
cg) = CompiledGraphics -> CompiledGraphics
CGMark (Int -> CompiledGraphics -> CompiledGraphics
cgUngroup Int
pos CompiledGraphics
cg)
cgUngroup Int
pos cg :: CompiledGraphics
cg@(CGraphics Rect
r Cursor
cur [(GCId, [DrawCommand])]
dcmds [CompiledGraphics]
parts) =
case Int
-> [CompiledGraphics] -> ([CompiledGraphics], [CompiledGraphics])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [CompiledGraphics]
parts of
([CompiledGraphics]
ds1,CompiledGraphics
d2:[CompiledGraphics]
ds3) ->
case Integer -> CompiledGraphics -> (Integer, CompiledGraphics)
forall a. Num a => a -> CompiledGraphics -> (a, CompiledGraphics)
unmark Integer
0 CompiledGraphics
d2 of
(Integer
m,CGraphics Rect
r2 Cursor
cur2 [(GCId, [DrawCommand])]
dcmds2 [CompiledGraphics]
ds2) ->
Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
cur ([(GCId, [DrawCommand])]
dcmds[(GCId, [DrawCommand])]
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
forall a. [a] -> [a] -> [a]
++[(GCId, [DrawCommand])]
dcmds2) ([CompiledGraphics]
ds1[CompiledGraphics] -> [CompiledGraphics] -> [CompiledGraphics]
forall a. [a] -> [a] -> [a]
++(CompiledGraphics -> CompiledGraphics)
-> [CompiledGraphics] -> [CompiledGraphics]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> CompiledGraphics -> CompiledGraphics
forall t.
(Eq t, Num t) =>
t -> CompiledGraphics -> CompiledGraphics
mark Integer
m) [CompiledGraphics]
ds2[CompiledGraphics] -> [CompiledGraphics] -> [CompiledGraphics]
forall a. [a] -> [a] -> [a]
++[CompiledGraphics]
ds3)
(Integer, CompiledGraphics)
_ -> CompiledGraphics
cg
([CompiledGraphics], [CompiledGraphics])
_ -> CompiledGraphics
cg
where
unmark :: a -> CompiledGraphics -> (a, CompiledGraphics)
unmark a
n (CGMark CompiledGraphics
cg) = a -> CompiledGraphics -> (a, CompiledGraphics)
unmark (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) CompiledGraphics
cg
unmark a
n CompiledGraphics
cg = (a
n,CompiledGraphics
cg)
mark :: t -> CompiledGraphics -> CompiledGraphics
mark t
0 CompiledGraphics
cg = CompiledGraphics
cg
mark t
n CompiledGraphics
cg = t -> CompiledGraphics -> CompiledGraphics
mark (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) (CompiledGraphics -> CompiledGraphics
CGMark CompiledGraphics
cg)