module DrawCompiledGraphics1(drawK',drawChangesK',GCId) where
import Xtypes
import XDraw(DrawCommand(FillRectangle),clearArea,draw,drawMany,Drawable(..))
import Geometry(growrect,(=.>),Rect(rectsize))
import Utils(number)
import Data.Maybe(mapMaybe)
import CompiledGraphics
import FudgetIO(putLow)
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 =
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 =
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
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
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
f hi ho -> f hi ho
forall a. a -> a
id
else
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]]
_ =
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 =
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]
_) =
if (Cursor -> Cursor
not Cursor
beQuick Cursor -> Cursor -> Cursor
|| Rect -> Point
rectsize Rect
r Point -> Point -> Cursor
=.> Point
400)
then
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
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]
_) =
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