module HyperGraphicsF where
import Utils(swap)
import Loops(loopThroughRightF)
import SerCompF(mapstateF)
import Drawing
import DrawingOps
import GraphicsF
import FDefaults
import HbcUtils(assoc)
import Sizing(Sizing(..))
import Event(Pressed(..))
hyperGraphicsF :: Drawing d leaf -> F (Either (Drawing d leaf) (d, Drawing d leaf)) d
hyperGraphicsF Drawing d leaf
x = forall {d} {leaf}.
(Eq d, Graphic leaf) =>
(GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> Drawing d leaf
-> F (Either (Drawing d leaf) (d, Drawing d leaf)) d
hyperGraphicsF' forall a. Customiser a
standard Drawing d leaf
x
hyperGraphicsF' :: (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> Drawing d leaf
-> F (Either (Drawing d leaf) (d, Drawing d leaf)) d
hyperGraphicsF' GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
custom Drawing d leaf
init =
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF
(forall {t} {a} {b}. (t -> a -> (t, [b])) -> t -> F a b
mapstateF forall {lbl} {leaf}.
Eq lbl =>
([(lbl, DPath)], Drawing lbl leaf)
-> Either
(GfxEvent DPath)
(Either (Drawing lbl leaf) (lbl, Drawing lbl leaf))
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) lbl])
ctrl ([(d, DPath)], Drawing d leaf)
state0)
( forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxEvent DPath)
graphicsDispF' (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
custom forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
params))
where
params :: GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
params = forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp Drawing d leaf
init forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {gfx}. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [GfxEventMask
GfxButtonMask] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Dynamic
state0 :: ([(d, DPath)], Drawing d leaf)
state0 = (forall {a} {leaf}. Drawing a leaf -> [(a, DPath)]
annotPaths Drawing d leaf
init,Drawing d leaf
init)
ctrl :: ([(lbl, DPath)], Drawing lbl leaf)
-> Either
(GfxEvent DPath)
(Either (Drawing lbl leaf) (lbl, Drawing lbl leaf))
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) lbl])
ctrl state :: ([(lbl, DPath)], Drawing lbl leaf)
state@([(lbl, DPath)]
paths,Drawing lbl leaf
drawing) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}.
GfxEvent DPath
-> (([(lbl, DPath)], Drawing lbl leaf), [Either a lbl])
input forall {b}.
Either (Drawing lbl leaf) (lbl, Drawing lbl leaf)
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) b])
output
where
same :: (([(lbl, DPath)], Drawing lbl leaf), [a])
same = (([(lbl, DPath)], Drawing lbl leaf)
state,[])
output :: Either (Drawing lbl leaf) (lbl, Drawing lbl leaf)
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) b])
output = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {leaf} {a} {b}.
Drawing a leaf
-> (([(a, DPath)], Drawing a leaf),
[Either (GfxCommand [a] (Drawing a leaf)) b])
new forall {b}.
(lbl, Drawing lbl leaf)
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) b])
newpart
where
new :: Drawing a leaf
-> (([(a, DPath)], Drawing a leaf),
[Either (GfxCommand [a] (Drawing a leaf)) b])
new Drawing a leaf
d = ((forall {a} {leaf}. Drawing a leaf -> [(a, DPath)]
annotPaths Drawing a leaf
d,Drawing a leaf
d),[forall a b. a -> Either a b
Left (forall {gfx} {a}. gfx -> GfxCommand [a] gfx
replaceAllGfx Drawing a leaf
d)])
newpart :: (lbl, Drawing lbl leaf)
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) b])
newpart (lbl
a,Drawing lbl leaf
d) = forall k v r. Eq k => (v -> r) -> r -> [(k, v)] -> k -> r
assoc (forall {b}.
Drawing lbl leaf
-> DPath
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) b])
newpart' Drawing lbl leaf
d) forall {a}. (([(lbl, DPath)], Drawing lbl leaf), [a])
same [(lbl, DPath)]
paths lbl
a
newpart' :: Drawing lbl leaf
-> DPath
-> (([(lbl, DPath)], Drawing lbl leaf),
[Either (GfxCommand DPath (Drawing lbl leaf)) b])
newpart' Drawing lbl leaf
d DPath
path = (([(lbl, DPath)]
paths',Drawing lbl leaf
drawing'),[forall a b. a -> Either a b
Left (forall {path} {gfx}. path -> gfx -> GfxCommand path gfx
replaceGfx DPath
path Drawing lbl leaf
d)])
where drawing' :: Drawing lbl leaf
drawing' = forall {lbl} {leaf}.
Drawing lbl leaf -> DPath -> Drawing lbl leaf -> Drawing lbl leaf
replacePart Drawing lbl leaf
drawing DPath
path Drawing lbl leaf
d
paths' :: [(lbl, DPath)]
paths' = forall {a} {leaf}. Drawing a leaf -> [(a, DPath)]
annotPaths Drawing lbl leaf
drawing'
input :: GfxEvent DPath
-> (([(lbl, DPath)], Drawing lbl leaf), [Either a lbl])
input GfxEvent DPath
msg =
case GfxEvent DPath
msg of
GfxButtonEvent { gfxType :: forall path. GfxEvent path -> Pressed
gfxType=Pressed
Pressed, gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=[(DPath, (Point, Rect))]
gfxPaths } -> forall {b} {a}.
[(DPath, b)]
-> (([(lbl, DPath)], Drawing lbl leaf), [Either a lbl])
mouse [(DPath, (Point, Rect))]
gfxPaths
GfxEvent DPath
_ -> forall {a}. (([(lbl, DPath)], Drawing lbl leaf), [a])
same
where
lblPart :: (DPath, b) -> Maybe (Drawing lbl leaf)
lblPart = forall {lbl} {leaf}.
Drawing lbl leaf -> DPath -> Maybe (Drawing lbl leaf)
maybeDrawingPart Drawing lbl leaf
drawing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {leaf}. Drawing t leaf -> DPath -> DPath
drawingAnnotPart Drawing lbl leaf
drawing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
mouse :: [(DPath, b)]
-> (([(lbl, DPath)], Drawing lbl leaf), [Either a lbl])
mouse [(DPath, b)]
paths =
case [lbl
lbl|Just (LabelD lbl
lbl Drawing lbl leaf
_)<-forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (DPath, b) -> Maybe (Drawing lbl leaf)
lblPart (forall a. [a] -> [a]
reverse [(DPath, b)]
paths)] of
lbl
lbl:[lbl]
_ -> (([(lbl, DPath)], Drawing lbl leaf)
state,[forall a b. b -> Either a b
Right lbl
lbl])
[lbl]
_ -> forall {a}. (([(lbl, DPath)], Drawing lbl leaf), [a])
same
annotPaths :: Drawing a leaf -> [(a, DPath)]
annotPaths = forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. (b, a) -> (a, b)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {leaf}. Drawing a leaf -> [(DPath, a)]
drawingAnnots