module CompiledGraphics where
import Geometry(Rect(..))
import Utils(number)
import DrawTypes(DrawCommand)
import ResourceIds(GCId,rootGC)
import Rects(overlaps,boundingRect)
import Maptrace(ctrace)

{-
--Version 1:
data CompiledGraphics = CGraphics Rect GCtx [DrawCommand] [CompiledGraphics]
-}

{-
--Version 2:
data CompiledGraphics = CGraphics Rect [XCommand] [CompiledGraphics]
       -- The only XCommand used is Draw MyWindow some_GC some_DrawCommand
-}

{-
--Version 3:
data CompiledGraphics = CGraphics Rect Cursor [XCommand] [CompiledGraphics]
       -- The only XCommand used is Draw MyWindow some_GC some_DrawCommand
-}

{-
--Version 4:
data CompiledGraphics
  = CGraphics Rect Cursor [XCommand] [CompiledGraphics]
       -- The only XCommand used is Draw MyWindow some_GC some_DrawCommand
  | CGMark CompiledGraphics -- path preserving dummy nodes
-}

--Version 5:
data CompiledGraphics
  = CGraphics Rect Cursor [(GCId,[DrawCommand])] [CompiledGraphics]
  | CGMark CompiledGraphics -- path preserving dummy nodes
  deriving (Int -> CompiledGraphics -> ShowS
[CompiledGraphics] -> ShowS
CompiledGraphics -> String
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 =
    --ctrace "gctrace" cmds $
    CompiledGraphics
cg
  where
    cg :: CompiledGraphics
cg = Rect
-> Cursor
-> [(GCId, [DrawCommand])]
-> [CompiledGraphics]
-> CompiledGraphics
CGraphics Rect
r Cursor
False  [(GCId, [DrawCommand])]
cmds []
    --cmds = (map (Draw MyWindow gc) (f r))
    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 forall {a}. [(GCId, [a])]
cmds [CompiledGraphics]
cgs
  where
    cmds :: [(GCId, [a])]
cmds = if [CompiledGraphics] -> Cursor
anyOverlap [CompiledGraphics]
cgs
	   then forall {a1} {a2}. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"cgoverlap" (forall a b. (a -> b) -> [a] -> [b]
map CompiledGraphics -> Rect
cgrect [CompiledGraphics]
cgs) forall a b. (a -> b) -> a -> b
$
		[(GCId
rootGC,[])] --trick coding to force all subtrees to be redrawn
	   else []

    -- This is O(n^2) in general, but the bounding rect makes it O(n) for
    -- linear placers. It may also help somewhat for tables...
    -- Sorting the rectangles can cut down the complexity too...
    -- Better to let the placers tell if they produce overlapping parts...
    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
&& 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
rforall 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
rectsizeforall 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) -- hmm!!
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) -- hmm!!
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 -- hmm!!
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
pforall a. Ord a => a -> a -> Cursor
<Int
1Cursor -> Cursor -> Cursor
||Int
pforall a. Ord a => a -> a -> Cursor
>forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompiledGraphics]
parts then forall a. HasCallStack => String -> a
error String
"bad path in CompiledGraphics.cgpart " else
  CompiledGraphics -> [Int] -> CompiledGraphics
cgpart ([CompiledGraphics]
parts forall a. [a] -> Int -> a
!! ((Int
p::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 (forall a b. a -> b -> a
const CompiledGraphics
new)

{-
cgupdate cg ps f =
  (if any (<1) ps
  then ctrace "cgupdate" ps
  else id) $ cgupdate' cg ps f
-}

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 =
   forall {a1} {a2}. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"badpath" (String
"(CGMark _) "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show [Int]
ps) 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 =
   forall {a1} {a2}. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"badpath" (CompiledGraphics
cg,Int
0forall a. a -> [a] -> [a]
:[Int]
ps) 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]
preforall a. [a] -> [a] -> [a]
++CompiledGraphics
-> [Int]
-> (CompiledGraphics -> CompiledGraphics)
-> CompiledGraphics
cgupdate CompiledGraphics
cg' [Int]
ps CompiledGraphics -> CompiledGraphics
fforall a. a -> [a] -> [a]
:[CompiledGraphics]
post)
  where pre :: [CompiledGraphics]
pre = forall a. Int -> [a] -> [a]
take (Int
pforall a. Num a => a -> a -> a
-Int
1) [CompiledGraphics]
parts
        CompiledGraphics
cg':[CompiledGraphics]
post = forall a. Int -> [a] -> [a]
drop ((Int
pforall a. Num a => a -> a -> a
-Int
1)::Int) [CompiledGraphics]
parts

cgcursors :: CompiledGraphics -> [[Int]]
cgcursors :: CompiledGraphics -> [[Int]]
cgcursors (CGMark CompiledGraphics
cg) = forall a b. (a -> b) -> [a] -> [b]
map (Int
0forall a. a -> [a] -> [a]
:) (CompiledGraphics -> [[Int]]
cgcursors CompiledGraphics
cg)
cgcursors (CGraphics Rect
_ Cursor
cur [(GCId, [DrawCommand])]
_ [CompiledGraphics]
parts) =
    if Cursor
cur
    then []forall a. a -> [a] -> [a]
:[[Int]]
partcursors
    else [[Int]]
partcursors
  where
    partcursors :: [[Int]]
partcursors =
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
n,CompiledGraphics
ps) -> forall a b. (a -> b) -> [a] -> [b]
map (Int
nforall a. a -> [a] -> [a]
:) (CompiledGraphics -> [[Int]]
cgcursors CompiledGraphics
ps)) (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) -- hmm!!
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]
ds1forall a. [a] -> [a] -> [a]
++Rect -> [CompiledGraphics] -> CompiledGraphics
cgCompose Rect
r2 [CompiledGraphics]
ds2forall a. a -> [a] -> [a]
:[CompiledGraphics]
ds3)
  where
    ([CompiledGraphics]
ds1,[CompiledGraphics]
ds2a) = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
posforall a. Num a => a -> a -> a
-Int
1) [CompiledGraphics]
parts
    ([CompiledGraphics]
ds2,[CompiledGraphics]
ds3) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
len [CompiledGraphics]
ds2a
    r2 :: Rect
r2 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Rect -> Rect -> Rect
boundingRectforall 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) -- hmm!!
cgUngroup Int
pos cg :: CompiledGraphics
cg@(CGraphics Rect
r Cursor
cur [(GCId, [DrawCommand])]
dcmds [CompiledGraphics]
parts) =
    case forall a. Int -> [a] -> ([a], [a])
splitAt (Int
posforall a. Num a => a -> a -> a
-Int
1) [CompiledGraphics]
parts of
      ([CompiledGraphics]
ds1,CompiledGraphics
d2:[CompiledGraphics]
ds3) ->
        case 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])]
dcmdsforall a. [a] -> [a] -> [a]
++[(GCId, [DrawCommand])]
dcmds2) ([CompiledGraphics]
ds1forall a. [a] -> [a] -> [a]
++forall a b. (a -> b) -> [a] -> [b]
map (forall {t}.
(Eq t, Num t) =>
t -> CompiledGraphics -> CompiledGraphics
mark Integer
m) [CompiledGraphics]
ds2forall a. [a] -> [a] -> [a]
++[CompiledGraphics]
ds3)
          (Integer, CompiledGraphics)
_ -> CompiledGraphics
cg -- hmm!!

      ([CompiledGraphics], [CompiledGraphics])
_ -> CompiledGraphics
cg -- hmm!!
  where
    unmark :: a -> CompiledGraphics -> (a, CompiledGraphics)
unmark a
n (CGMark CompiledGraphics
cg) = a -> CompiledGraphics -> (a, CompiledGraphics)
unmark (a
nforall 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
nforall a. Num a => a -> a -> a
-t
1) (CompiledGraphics -> CompiledGraphics
CGMark CompiledGraphics
cg)