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
      [] -> f hi ho -> f hi ho
forall a. a -> a
id
      [(GCId, [DrawCommand])]
cmds -> FRequest -> f hi ho -> f hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (FRequest -> f hi ho -> f hi ho) -> FRequest -> f hi ho -> f hi ho
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])(GCId, [DrawCommand])
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
forall a. a -> [a] -> [a]
:)
       else [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
forall a. a -> a
id)([(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])])
-> ([(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])])
-> [(GCId, [DrawCommand])]
-> [(GCId, [DrawCommand])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ([(GCId, [DrawCommand])]
cmds[(GCId, [DrawCommand])]
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
forall a. [a] -> [a] -> [a]
++) ([(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])])
-> ([(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])])
-> [(GCId, [DrawCommand])]
-> [(GCId, [DrawCommand])]
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 [] = [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
forall a. a -> a
id
    draws (CompiledGraphics
g:[CompiledGraphics]
gs) = CompiledGraphics
-> [(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])]
draw CompiledGraphics
g ([(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])])
-> ([(GCId, [DrawCommand])] -> [(GCId, [DrawCommand])])
-> [(GCId, [DrawCommand])]
-> [(GCId, [DrawCommand])]
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 (([Int] -> Maybe [Int]) -> [[Int]] -> [[Int]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Int] -> Maybe [Int]
forall a. (Eq a, Num a) => [a] -> Maybe [a]
drop0 [[Int]]
changes)
  where drop0 :: [a] -> Maybe [a]
drop0 [] = [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
        drop0 (a
0:[a]
ps) = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ps
	drop0 [a]
_ = Maybe [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
rRect -> Rect -> Cursor
forall a. Eq a => a -> a -> Cursor
/=Rect
or Cursor -> Cursor -> Cursor
|| [] [Int] -> [[Int]] -> 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 ([[Int]] -> Cursor
forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [[Int]]
changes Cursor -> Cursor -> Cursor
|| [(GCId, [DrawCommand])] -> Cursor
forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [(GCId, [DrawCommand])]
cmds Cursor -> Cursor -> Cursor
&& [(GCId, [DrawCommand])] -> Cursor
forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [(GCId, [DrawCommand])]
ocmds)
    then --debugK "Drawing" .
         -- !! test if scrolling is enough
	 Maybe (Drawable, GCId) -> Rect -> Rect -> f hi ho -> f hi ho
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 (f hi ho -> f hi ho) -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
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 [[Int]] -> Cursor
forall (t :: * -> *) a. Foldable t => t a -> Cursor
null [[Int]]
changes
         then --debugK "Pruning" .
	      f hi ho -> f hi ho
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'Int -> Int -> Cursor
forall a. Eq a => a -> a -> Cursor
==Int
i]
	      in ((f hi ho -> f hi ho)
 -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho)
-> (f hi ho -> f hi ho)
-> [f hi ho -> f hi ho]
-> f hi ho
-> f hi ho
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (f hi ho -> f hi ho) -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) f hi ho -> f hi ho
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))<-Int
-> [(CompiledGraphics, CompiledGraphics)]
-> [(Int, (CompiledGraphics, CompiledGraphics))]
forall a. Int -> [a] -> [(Int, a)]
number Int
1 ([CompiledGraphics]
-> [CompiledGraphics] -> [(CompiledGraphics, CompiledGraphics)]
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" .
    CompiledGraphics -> f hi ho -> f hi ho
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]
_) =
      Maybe (Drawable, GCId) -> Rect -> Rect -> f hi ho -> f hi ho
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) (f hi ho -> f hi ho) -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Maybe (Drawable, GCId)
-> Cursor
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
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.
  Cursor -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho
forall a. Cursor -> (a -> a) -> a -> a
ifK (Rect
newrectRect -> Rect -> Cursor
forall a. Eq a => a -> a -> Cursor
/=Rect
oldrect)
      (FRequest -> f hi ho -> f hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (FRequest -> f hi ho -> f hi ho) -> FRequest -> f hi ho -> f hi ho
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 =
  Cursor -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho
forall a. Cursor -> (a -> a) -> a -> a
ifK (Rect
newrectRect -> Rect -> Cursor
forall a. Eq a => a -> a -> Cursor
/=Rect
oldrect)
      (FRequest -> f hi ho -> f hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (FRequest -> f hi ho -> f hi ho) -> FRequest -> f hi ho -> f hi ho
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
       FRequest -> f hi ho -> f hi ho
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)
       FRequest -> f hi ho -> f hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow (Rect -> Cursor -> FRequest
clearArea Rect
r Cursor
False) (f hi ho -> f hi ho) -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawable
-> (GCId, Rect -> [Rect])
-> (Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
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 (Rect -> [Rect] -> [Rect]
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):
       FRequest -> f hi ho -> f hi ho
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)) (f hi ho -> f hi ho) -> (f hi ho -> f hi ho) -> f hi ho -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       Drawable
-> (GCId, Rect -> [Rect])
-> (Rect -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
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 (Rect -> [Rect] -> [Rect]
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 a -> a
forall a. a -> a
id