module HyperGraphicsF where
--import Fudget
--import Defaults(paperColor)
--import InputMsg(inputDone)
import Utils(swap)
--import Xtypes(ColorName)
import Loops(loopThroughRightF)
import SerCompF(mapstateF)
--import Graphic
import Drawing
import DrawingOps
import GraphicsF
import FDefaults
import HbcUtils(assoc)
import Sizing(Sizing(..))
--import GCAttrs() -- instances
import Event(Pressed(..))
--import Maptrace(ctrace) -- debugging
--import SpyF(teeF) -- debugging
--import CompOps((>==<)) -- debugging

hyperGraphicsF :: Drawing d leaf -> F (Either (Drawing d leaf) (d, Drawing d leaf)) d
hyperGraphicsF Drawing d leaf
x = (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> Drawing d leaf
-> F (Either (Drawing d leaf) (d, Drawing d leaf)) d
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' GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
forall a. Customiser a
standard Drawing d leaf
x

{-
hyperGraphicsF' :: (Eq annot,Graphic g) =>
                  Customiser (GraphicsF (Drawing annot g)) ->
                  Drawing annot g ->
		  F (Either (Drawing annot g) (annot,Drawing annot g))
		    annot
-}
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 =
    F (Either
     (GfxEvent DPath) (Either (Drawing d leaf) (d, Drawing d leaf)))
  (Either (GfxCommand DPath (Drawing d leaf)) d)
-> F (GfxCommand DPath (Drawing d leaf)) (GfxEvent DPath)
-> F (Either (Drawing d leaf) (d, Drawing d leaf)) d
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF
	((([(d, DPath)], Drawing d leaf)
 -> Either
      (GfxEvent DPath) (Either (Drawing d leaf) (d, Drawing d leaf))
 -> (([(d, DPath)], Drawing d leaf),
     [Either (GfxCommand DPath (Drawing d leaf)) d]))
-> ([(d, DPath)], Drawing d leaf)
-> F (Either
        (GfxEvent DPath) (Either (Drawing d leaf) (d, Drawing d leaf)))
     (Either (GfxCommand DPath (Drawing d leaf)) d)
forall t a b. (t -> a -> (t, [b])) -> t -> F a b
mapstateF ([(d, DPath)], Drawing d leaf)
-> Either
     (GfxEvent DPath) (Either (Drawing d leaf) (d, Drawing d leaf))
-> (([(d, DPath)], Drawing d leaf),
    [Either (GfxCommand DPath (Drawing d leaf)) d])
forall b leaf.
Eq b =>
([(b, DPath)], Drawing b leaf)
-> Either
     (GfxEvent DPath) (Either (Drawing b leaf) (b, Drawing b leaf))
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
ctrl ([(d, DPath)], Drawing d leaf)
state0)
	({-teeF show "\n" >==<-} (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> F (GfxCommand DPath (Drawing d leaf)) (GfxEvent DPath)
forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxEvent DPath)
graphicsDispF' (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
custom (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> GraphicsF (Drawing d leaf)
-> GraphicsF (Drawing d leaf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
params))
  where
    --tr x = ctrace "hyper" (show x) x -- debugging
    params :: GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
params = Drawing d leaf
-> GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp Drawing d leaf
init (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> GraphicsF (Drawing d leaf)
-> GraphicsF (Drawing d leaf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     [GfxEventMask]
-> GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
forall gfx. [GfxEventMask] -> Customiser (GraphicsF gfx)
setGfxEventMask [GfxEventMask
GfxButtonMask] (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> (GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf))
-> GraphicsF (Drawing d leaf)
-> GraphicsF (Drawing d leaf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
	     Sizing -> GraphicsF (Drawing d leaf) -> GraphicsF (Drawing d leaf)
forall xxx. HasSizing xxx => Sizing -> Customiser xxx
setSizing Sizing
Dynamic
    state0 :: ([(d, DPath)], Drawing d leaf)
state0 = (Drawing d leaf -> [(d, DPath)]
forall a leaf. Drawing a leaf -> [(a, DPath)]
annotPaths Drawing d leaf
init,Drawing d leaf
init)

    ctrl :: ([(b, DPath)], Drawing b leaf)
-> Either
     (GfxEvent DPath) (Either (Drawing b leaf) (b, Drawing b leaf))
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
ctrl state :: ([(b, DPath)], Drawing b leaf)
state@([(b, DPath)]
paths,Drawing b leaf
drawing) = (GfxEvent DPath
 -> (([(b, DPath)], Drawing b leaf),
     [Either (GfxCommand DPath (Drawing b leaf)) b]))
-> (Either (Drawing b leaf) (b, Drawing b leaf)
    -> (([(b, DPath)], Drawing b leaf),
        [Either (GfxCommand DPath (Drawing b leaf)) b]))
-> Either
     (GfxEvent DPath) (Either (Drawing b leaf) (b, Drawing b leaf))
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GfxEvent DPath
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall a.
GfxEvent DPath -> (([(b, DPath)], Drawing b leaf), [Either a b])
input Either (Drawing b leaf) (b, Drawing b leaf)
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall b.
Either (Drawing b leaf) (b, Drawing b leaf)
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
output
      where
        same :: (([(b, DPath)], Drawing b leaf), [a])
same = (([(b, DPath)], Drawing b leaf)
state,[])
        output :: Either (Drawing b leaf) (b, Drawing b leaf)
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
output = (Drawing b leaf
 -> (([(b, DPath)], Drawing b leaf),
     [Either (GfxCommand DPath (Drawing b leaf)) b]))
-> ((b, Drawing b leaf)
    -> (([(b, DPath)], Drawing b leaf),
        [Either (GfxCommand DPath (Drawing b leaf)) b]))
-> Either (Drawing b leaf) (b, Drawing b leaf)
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Drawing b leaf
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall a leaf a b.
Drawing a leaf
-> (([(a, DPath)], Drawing a leaf),
    [Either (GfxCommand [a] (Drawing a leaf)) b])
new (b, Drawing b leaf)
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall b.
(b, Drawing b leaf)
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
newpart
	  where
	    --new d = newpart' d []
	    -- avoid space leak for this common case:
	    new :: Drawing a leaf
-> (([(a, DPath)], Drawing a leaf),
    [Either (GfxCommand [a] (Drawing a leaf)) b])
new Drawing a leaf
d = ((Drawing a leaf -> [(a, DPath)]
forall a leaf. Drawing a leaf -> [(a, DPath)]
annotPaths Drawing a leaf
d,Drawing a leaf
d),[GfxCommand [a] (Drawing a leaf)
-> Either (GfxCommand [a] (Drawing a leaf)) b
forall a b. a -> Either a b
Left (Drawing a leaf -> GfxCommand [a] (Drawing a leaf)
forall gfx a. gfx -> GfxCommand [a] gfx
replaceAllGfx Drawing a leaf
d)])
	    newpart :: (b, Drawing b leaf)
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
newpart (b
a,Drawing b leaf
d) = (DPath
 -> (([(b, DPath)], Drawing b leaf),
     [Either (GfxCommand DPath (Drawing b leaf)) b]))
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
-> [(b, DPath)]
-> b
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall k v r. Eq k => (v -> r) -> r -> [(k, v)] -> k -> r
assoc (Drawing b leaf
-> DPath
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
forall b.
Drawing b leaf
-> DPath
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
newpart' Drawing b leaf
d) (([(b, DPath)], Drawing b leaf),
 [Either (GfxCommand DPath (Drawing b leaf)) b])
forall a. (([(b, DPath)], Drawing b leaf), [a])
same [(b, DPath)]
paths b
a
	    newpart' :: Drawing b leaf
-> DPath
-> (([(b, DPath)], Drawing b leaf),
    [Either (GfxCommand DPath (Drawing b leaf)) b])
newpart' Drawing b leaf
d DPath
path = (([(b, DPath)]
paths',Drawing b leaf
drawing'),[GfxCommand DPath (Drawing b leaf)
-> Either (GfxCommand DPath (Drawing b leaf)) b
forall a b. a -> Either a b
Left (DPath -> Drawing b leaf -> GfxCommand DPath (Drawing b leaf)
forall path gfx. path -> gfx -> GfxCommand path gfx
replaceGfx DPath
path Drawing b leaf
d)])
	      where drawing' :: Drawing b leaf
drawing' = Drawing b leaf -> DPath -> Drawing b leaf -> Drawing b leaf
forall lbl leaf.
Drawing lbl leaf -> DPath -> Drawing lbl leaf -> Drawing lbl leaf
replacePart Drawing b leaf
drawing DPath
path Drawing b leaf
d
	            paths' :: [(b, DPath)]
paths' = Drawing b leaf -> [(b, DPath)]
forall a leaf. Drawing a leaf -> [(a, DPath)]
annotPaths Drawing b leaf
drawing'
			-- Space leak: drawing' isn't used until user clicks
			-- in the window, so the old drawing is retained in
			-- the closure for drawing'

        input :: GfxEvent DPath -> (([(b, DPath)], Drawing b leaf), [Either a b])
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 } ->  [(DPath, (Point, Rect))]
-> (([(b, DPath)], Drawing b leaf), [Either a b])
forall b a.
[(DPath, b)] -> (([(b, DPath)], Drawing b leaf), [Either a b])
mouse [(DPath, (Point, Rect))]
gfxPaths
	      GfxEvent DPath
_ -> (([(b, DPath)], Drawing b leaf), [Either a b])
forall a. (([(b, DPath)], Drawing b leaf), [a])
same
	  where
	    lblPart :: (DPath, b) -> Maybe (Drawing b leaf)
lblPart = Drawing b leaf -> DPath -> Maybe (Drawing b leaf)
forall lbl leaf.
Drawing lbl leaf -> DPath -> Maybe (Drawing lbl leaf)
maybeDrawingPart Drawing b leaf
drawing (DPath -> Maybe (Drawing b leaf))
-> ((DPath, b) -> DPath) -> (DPath, b) -> Maybe (Drawing b leaf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawing b leaf -> DPath -> DPath
forall b leaf. Drawing b leaf -> DPath -> DPath
drawingAnnotPart Drawing b leaf
drawing (DPath -> DPath) -> ((DPath, b) -> DPath) -> (DPath, b) -> DPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DPath, b) -> DPath
forall a b. (a, b) -> a
fst
	    mouse :: [(DPath, b)] -> (([(b, DPath)], Drawing b leaf), [Either a b])
mouse [(DPath, b)]
paths =
	      --ctrace "hyper" (show paths) $
	      case [b
lbl|Just (LabelD b
lbl Drawing b leaf
_)<-((DPath, b) -> Maybe (Drawing b leaf))
-> [(DPath, b)] -> [Maybe (Drawing b leaf)]
forall a b. (a -> b) -> [a] -> [b]
map (DPath, b) -> Maybe (Drawing b leaf)
forall b. (DPath, b) -> Maybe (Drawing b leaf)
lblPart ([(DPath, b)] -> [(DPath, b)]
forall a. [a] -> [a]
reverse [(DPath, b)]
paths)] of
		b
lbl:[b]
_ -> (([(b, DPath)], Drawing b leaf)
state,[b -> Either a b
forall a b. b -> Either a b
Right b
lbl])
{- -- All nodes have unique paths now, so this should not be necessary:
		    Just d ->
		      case annotChildren d of
		        ([],LabelD a _):_ -> (state,[Right a])
			_ -> same
-}
		[b]
_ -> (([(b, DPath)], Drawing b leaf), [Either a b])
forall a. (([(b, DPath)], Drawing b leaf), [a])
same

    annotPaths :: Drawing a leaf -> [(a, DPath)]
annotPaths = ((DPath, a) -> (a, DPath)) -> [(DPath, a)] -> [(a, DPath)]
forall a b. (a -> b) -> [a] -> [b]
map (DPath, a) -> (a, DPath)
forall b a. (b, a) -> (a, b)
swap ([(DPath, a)] -> [(a, DPath)])
-> (Drawing a leaf -> [(DPath, a)])
-> Drawing a leaf
-> [(a, DPath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawing a leaf -> [(DPath, a)]
forall a leaf. Drawing a leaf -> [(DPath, a)]
drawingAnnots