module DrawCompiledGraphics1(drawK',drawChangesK',GCId) where
--import Fudget
import Xtypes
import XDraw(DrawCommand(FillRectangle),clearArea,draw,drawMany,Drawable(..))
import Geometry(growrect,(=.>),Rect(rectsize))
--import Message
--import NullF(putsK,putK)
import Utils(number)
--import EitherUtils(mapfilter)
import Data.Maybe(mapMaybe)
import CompiledGraphics
--import Rects
--import Maptrace(ctrace) -- debug
--import Io(echoK) -- debug
import FudgetIO(putLow)

--tr x = seq x $ ctrace "drawtrace" x x
--trLow = Low . tr
--trLow = tr . Low
--maptrLow = map trLow
--debugK = echoK

--drawK = drawK' MyWindow
drawK' :: Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
drawK' Drawable
d (GCId
higc,Rect -> [t]
hiR) t -> [Rect]
clip CompiledGraphics
cg =
    case CompiledGraphics
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draw CompiledGraphics
cg [] of
      [] -> forall a. a -> a
id
      [(GCId, [DrawCommand])]
cmds -> forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow forall a b. (a -> b) -> a -> b
$ Drawable -> [(GCId, [DrawCommand])] -> FRequest
drawMany Drawable
d [(GCId, [DrawCommand])]
cmds
  where
    draw :: CompiledGraphics
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draw (CGMark CompiledGraphics
cg) = CompiledGraphics
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draw CompiledGraphics
cg
    draw (CGraphics Rect
r Cursor
cur [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
gs) =
      (if Cursor
cur
       then ((GCId
higc,[Rect -> DrawCommand
FillRectangle Rect
cr | t
hr<-Rect -> [t]
hiR Rect
r,Rect
cr<-t -> [Rect]
clip t
hr])forall a. a -> [a] -> [a]
:)
       else forall a. a -> a
id)forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ([(GCId, [DrawCommand])]
cmdsforall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [CompiledGraphics]
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draws [CompiledGraphics]
gs
    draws :: [CompiledGraphics]
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draws [] = forall a. a -> a
id
    draws (CompiledGraphics
g:[CompiledGraphics]
gs) = CompiledGraphics
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draw CompiledGraphics
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CompiledGraphics]
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draws [CompiledGraphics]
gs

drawChangesK' :: Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc  (CGMark CompiledGraphics
cg) (CGMark CompiledGraphics
ocg) [[Int]]
changes =
    --debugK (show [ ps | ps<-changes, take 1 ps/=[0]]) .
    Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc CompiledGraphics
cg CompiledGraphics
ocg (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (Eq a, Num a) => [a] -> Maybe [a]
drop0 [[Int]]
changes)
  where drop0 :: [a] -> Maybe [a]
drop0 [] = forall a. a -> Maybe a
Just []
        drop0 (a
0:[a]
ps) = forall a. a -> Maybe a
Just [a]
ps
	drop0 [a]
_ = forall a. Maybe a
Nothing

drawChangesK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc  cg :: CompiledGraphics
cg@(CGraphics Rect
r  Cursor
_ [(GCId, [DrawCommand])]
cmds [CompiledGraphics]
cgs )
                          ocg :: CompiledGraphics
ocg@(CGraphics Rect
or Cursor
_ [(GCId, [DrawCommand])]
ocmds [CompiledGraphics]
ocgs) [[Int]]
changes =
    --debugK (unwords ["Changes:",show changes,"or",show or,"nr",show r]) .
    if Rect
rforall a. Eq a => a -> a -> Cursor
/=Rect
or Cursor -> Cursor -> Cursor
|| [] forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Cursor
`elem` [[Int]]
changes
       -- Hack for overlapping parts:
       Cursor -> Cursor -> Cursor
|| Cursor -> Cursor
not (forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [[Int]]
changes Cursor -> Cursor -> Cursor
|| forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [(GCId, [DrawCommand])]
cmds Cursor -> Cursor -> Cursor
&& forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [(GCId, [DrawCommand])]
ocmds)
    then --debugK "Drawing" .
         -- !! test if scrolling is enough
	 forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Maybe (Drawable, GCId) -> Rect -> Rect -> f hi ho -> f hi ho
eraseOldK Maybe (Drawable, GCId)
d Rect
r Rect
or forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
reDrawK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc CompiledGraphics
cg
    else if forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [[Int]]
changes
         then --debugK "Pruning" .
	      forall a. a -> a
id
	 else --debugK "Descending" .
	      let changes' :: Int -> [[Int]]
changes' Int
i= [ [Int]
p | Int
i':[Int]
p <- [[Int]]
changes, Int
i'forall a. Eq a => a -> a -> Cursor
==Int
i]
	      in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id [Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc CompiledGraphics
cg CompiledGraphics
ocg (Int -> [[Int]]
changes' Int
i) |
				(Int
i,(CompiledGraphics
cg,CompiledGraphics
ocg))<-forall a. Int -> [a] -> [(Int, a)]
number Int
1 (forall a b. [a] -> [b] -> [(a, b)]
zip [CompiledGraphics]
cgs [CompiledGraphics]
ocgs)]
drawChangesK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc  CompiledGraphics
cg CompiledGraphics
ogc [[Int]]
_ =
    --debugK "drawNewK" .
    forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
CompiledGraphics -> f hi ho -> f hi ho
drawNewK CompiledGraphics
cg
  where
    drawNewK :: CompiledGraphics -> f hi ho -> f hi ho
drawNewK (CGMark CompiledGraphics
cg) = CompiledGraphics -> f hi ho -> f hi ho
drawNewK CompiledGraphics
cg
    drawNewK cg :: CompiledGraphics
cg@(CGraphics Rect
r Cursor
_ [(GCId, [DrawCommand])]
_ [CompiledGraphics]
_) =
      forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Maybe (Drawable, GCId) -> Rect -> Rect -> f hi ho -> f hi ho
eraseOldK Maybe (Drawable, GCId)
d Rect
r (CompiledGraphics -> Rect
cgrect CompiledGraphics
ogc) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
reDrawK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc CompiledGraphics
cg

eraseOldK :: Maybe (Drawable, GCId) -> Rect -> Rect -> f hi ho -> f hi ho
eraseOldK Maybe (Drawable, GCId)
Nothing Rect
newrect Rect
oldrect =
  -- It's enough to clear the part of oldrect that is outside newrect.
  forall {a}. Cursor -> (a -> a) -> a -> a
ifK (Rect
newrectforall a. Eq a => a -> a -> Cursor
/=Rect
oldrect)
      (forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow forall a b. (a -> b) -> a -> b
$ Rect -> Cursor -> FRequest
clearArea (Rect -> Point -> Rect
growrect Rect
oldrect Point
1) Cursor
False)
eraseOldK (Just (Drawable
d,GCId
cleargc)) Rect
newrect Rect
oldrect =
  forall {a}. Cursor -> (a -> a) -> a -> a
ifK (Rect
newrectforall a. Eq a => a -> a -> Cursor
/=Rect
oldrect)
      (forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow forall a b. (a -> b) -> a -> b
$ Drawable -> GCId -> DrawCommand -> FRequest
draw Drawable
d GCId
cleargc (Rect -> DrawCommand
FillRectangle (Rect -> Point -> Rect
growrect Rect
oldrect Point
1)))

reDrawK' :: Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
reDrawK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc (CGMark CompiledGraphics
cg) = Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
reDrawK' Maybe (Drawable, GCId)
d Cursor
beQuick (GCId, Rect -> [Rect])
higc CompiledGraphics
cg
reDrawK' Maybe (Drawable, GCId)
Nothing Cursor
beQuick (GCId, Rect -> [Rect])
higc cg :: CompiledGraphics
cg@(CGraphics Rect
r Cursor
_ [(GCId, [DrawCommand])]
_ [CompiledGraphics]
_) =
  -- When drawing directly in a window:
  if (Cursor -> Cursor
not Cursor
beQuick Cursor -> Cursor -> Cursor
|| Rect -> Point
rectsize Rect
r Point -> Point -> Cursor
=.> Point
400) -- heuristic
  then -- for big areas: wait for exposure event and draw only the
       -- visible part
       forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (Rect -> Cursor -> FRequest
clearArea Rect
r Cursor
True)
  else -- for small areas: draw everything immediately (reduced flicker)
       forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (Rect -> Cursor -> FRequest
clearArea Rect
r Cursor
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> * -> *} {t} {hi} {ho}.
FudgetIO f =>
Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
drawK' Drawable
MyWindow (GCId, Rect -> [Rect])
higc (forall a. a -> [a] -> [a]
:[]) CompiledGraphics
cg
reDrawK' (Just (Drawable
d,GCId
cleargc)) Cursor
beQuick (GCId, Rect -> [Rect])
higc cg :: CompiledGraphics
cg@(CGraphics Rect
r Cursor
_ [(GCId, [DrawCommand])]
_ [CompiledGraphics]
_) =
       -- For drawing in a back buffer or a pixmap (assumes d/=MyWindow):
       forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (Drawable -> GCId -> DrawCommand -> FRequest
draw Drawable
d GCId
cleargc (Rect -> DrawCommand
FillRectangle Rect
r)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall {f :: * -> * -> *} {t} {hi} {ho}.
FudgetIO f =>
Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
drawK' Drawable
d (GCId, Rect -> [Rect])
higc (forall a. a -> [a] -> [a]
:[]) CompiledGraphics
cg

ifK :: Cursor -> (a -> a) -> a -> a
ifK Cursor
b a -> a
k = if Cursor
b then a -> a
k else forall a. a -> a
id