{-# LANGUAGE CPP #-}
module HyperGraphicsF2(
  module HyperGraphicsF2,
  GfxCommand(..),GfxChange(..),GfxEvent(..),replaceGfx,highlightGfx
 ) where
import AllFudgets
import Data.Maybe(fromJust,mapMaybe)
import HbcUtils(mapFst)
import qualified Data.Map as Map
--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 ListUtil(assoc)
--import Sizing(Sizing(..))
--import GCAttrs() -- instances
--import Event(Pressed(..))
--import Maptrace(ctrace) -- debugging
--import SpyF(teeF) -- debugging
--import CompOps((>==<)) -- debugging

#include "../hsrc/exists.h"

hyperGraphicsF2 :: Drawing k leaf -> F (GfxCommand k (Drawing k leaf)) (GfxEvent k)
hyperGraphicsF2 Drawing k leaf
x = forall {leaf} {k}.
(Graphic leaf, Ord k) =>
(GraphicsF (Drawing k leaf) -> GraphicsF (Drawing k leaf))
-> Drawing k leaf -> F (GfxCommand k (Drawing k leaf)) (GfxEvent k)
hyperGraphicsF2' forall a. Customiser a
standard Drawing k leaf
x

hyperGraphicsF2' :: (GraphicsF (Drawing k leaf) -> GraphicsF (Drawing k leaf))
-> Drawing k leaf -> F (GfxCommand k (Drawing k leaf)) (GfxEvent k)
hyperGraphicsF2' GraphicsF (Drawing k leaf) -> GraphicsF (Drawing k leaf)
custom Drawing k 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 {leaf}.
(Map k [Int], Drawing k leaf)
-> Either (GfxEvent [Int]) (GfxCommand k (Drawing k leaf))
-> ((Map k [Int], Drawing k leaf),
    [Either (GfxCommand [Int] (Drawing k leaf)) (GfxEvent k)])
ctrl (Map k [Int], Drawing k leaf)
state0)
	({-teeF show "\n" >==<-} forall gfx.
Graphic gfx =>
Customiser (GraphicsF gfx) -> F (GfxFCmd gfx) (GfxEvent [Int])
graphicsDispF' (GraphicsF (Drawing k leaf) -> GraphicsF (Drawing k leaf)
custom forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphicsF (Drawing k leaf) -> GraphicsF (Drawing k leaf)
params))
  where
    --tr x = ctrace "hyper" (show x) x -- debugging
    params :: GraphicsF (Drawing k leaf) -> GraphicsF (Drawing k leaf)
params = forall (xxx :: * -> *) a.
HasInitDisp xxx =>
a -> Customiser (xxx a)
setInitDisp Drawing k 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 :: (Map k [Int], Drawing k leaf)
state0 = (forall {leaf}. Drawing k leaf -> Map k [Int]
annotPaths Drawing k leaf
init,Drawing k leaf
init)

    ctrl :: (Map k [Int], Drawing k leaf)
-> Either (GfxEvent [Int]) (GfxCommand k (Drawing k leaf))
-> ((Map k [Int], Drawing k leaf),
    [Either (GfxCommand [Int] (Drawing k leaf)) (GfxEvent k)])
ctrl state :: (Map k [Int], Drawing k leaf)
state@(Map k [Int]
paths,Drawing k leaf
drawing) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}.
GfxEvent [Int]
-> ((Map k [Int], Drawing k leaf), [Either a (GfxEvent k)])
gfxEvent forall {b}.
GfxCommand k (Drawing k leaf)
-> ((Map k [Int], Drawing k leaf),
    [Either (GfxCommand [Int] (Drawing k leaf)) b])
gfxCommand
      where
        same :: ((Map k [Int], Drawing k leaf), [a])
same = ((Map k [Int], Drawing k leaf)
state,[])
	lbl2path :: k -> [Int]
lbl2path k
lbl = forall a. HasCallStack => Maybe a -> a
fromJust (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
lbl Map k [Int]
paths)

        gfxCommand :: GfxCommand k (Drawing k leaf)
-> ((Map k [Int], Drawing k leaf),
    [Either (GfxCommand [Int] (Drawing k leaf)) b])
gfxCommand GfxCommand k (Drawing k leaf)
lcmd =
	    case forall {a} {path} {gfx}.
(a -> path) -> GfxCommand a gfx -> GfxCommand path gfx
mapGfxCommandPath k -> [Int]
lbl2path GfxCommand k (Drawing k leaf)
lcmd of
	      cmd :: GfxCommand [Int] (Drawing k leaf)
cmd@(ChangeGfx [([Int], GfxChange (Drawing k leaf))]
changes) -> (forall {t :: * -> *}.
Foldable t =>
t ([Int], GfxChange (Drawing k leaf))
-> (Map k [Int], Drawing k leaf)
changeState [([Int], GfxChange (Drawing k leaf))]
changes,[forall a b. a -> Either a b
Left GfxCommand [Int] (Drawing k leaf)
cmd])
	      GfxCommand [Int] (Drawing k leaf)
cmd -> ((Map k [Int], Drawing k leaf)
state,[forall a b. a -> Either a b
Left GfxCommand [Int] (Drawing k leaf)
cmd])
	  where
	    changeState :: t ([Int], GfxChange (Drawing k leaf))
-> (Map k [Int], Drawing k leaf)
changeState t ([Int], GfxChange (Drawing k leaf))
changes = (Map k [Int]
paths',Drawing k leaf
drawing')
	      where
	        drawing' :: Drawing k leaf
drawing' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {lbl} {leaf}.
([Int], GfxChange (Drawing lbl leaf))
-> Drawing lbl leaf -> Drawing lbl leaf
replace Drawing k leaf
drawing t ([Int], GfxChange (Drawing k leaf))
changes

		replace :: ([Int], GfxChange (Drawing lbl leaf))
-> Drawing lbl leaf -> Drawing lbl leaf
replace ([Int]
path,GfxReplace (Bool
_,Just Drawing lbl leaf
d)) Drawing lbl leaf
drawing =
                    forall {lbl} {leaf}.
Drawing lbl leaf -> [Int] -> Drawing lbl leaf -> Drawing lbl leaf
replacePart Drawing lbl leaf
drawing [Int]
path Drawing lbl leaf
d
                replace ([Int]
path,GfxReplace (Bool, Maybe (Drawing lbl leaf))
_) Drawing lbl leaf
drawing = Drawing lbl leaf
drawing
                replace ([Int]
path,GfxGroup Int
from Int
count) Drawing lbl leaf
drawing =
                    forall {lbl} {leaf}.
Drawing lbl leaf
-> [Int]
-> (Drawing lbl leaf -> Drawing lbl leaf)
-> Drawing lbl leaf
updatePart Drawing lbl leaf
drawing [Int]
path (forall {lbl} {leaf}.
Int -> Int -> Drawing lbl leaf -> Drawing lbl leaf
groupParts Int
from Int
count)
                replace ([Int]
path,GfxUngroup Int
pos) Drawing lbl leaf
drawing =
                    forall {lbl} {leaf}.
Drawing lbl leaf
-> [Int]
-> (Drawing lbl leaf -> Drawing lbl leaf)
-> Drawing lbl leaf
updatePart Drawing lbl leaf
drawing [Int]
path (forall {lbl} {leaf}. Int -> Drawing lbl leaf -> Drawing lbl leaf
ungroupParts Int
pos)

		paths' :: Map k [Int]
paths' = forall {leaf}. Drawing k leaf -> Map k [Int]
annotPaths Drawing k 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'

        gfxEvent :: GfxEvent [Int]
-> ((Map k [Int], Drawing k leaf), [Either a (GfxEvent k)])
gfxEvent GfxEvent [Int]
msg = ((Map k [Int], Drawing k leaf)
state,[forall a b. b -> Either a b
Right GfxEvent k
msg'])
	  where
	    msg' :: GfxEvent k
msg' = forall {t} {path}. (t -> Maybe path) -> GfxEvent t -> GfxEvent path
mapGfxEventPath [Int] -> Maybe k
path2lbl GfxEvent [Int]
msg

        path2lbl :: [Int] -> Maybe k
path2lbl [Int]
path = do let part :: [Int]
part = forall {t} {leaf}. Drawing t leaf -> [Int] -> [Int]
drawingAnnotPart Drawing k leaf
drawing [Int]
path
			   LabelD k
a Drawing k leaf
_ <- forall {lbl} {leaf}.
Drawing lbl leaf -> [Int] -> Maybe (Drawing lbl leaf)
maybeDrawingPart Drawing k leaf
drawing [Int]
part
			   forall (m :: * -> *) a. Monad m => a -> m a
return k
a

    annotPaths :: Drawing k leaf -> Map k [Int]
annotPaths = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> [([Int], a)]
drawingAnnots

mouseClicksSP :: SP (GfxEvent b) b
mouseClicksSP = forall {t} {b}. (t -> Maybe b) -> SP t b
mapFilterSP forall {a}. GfxEvent a -> Maybe a
isMouseClick

isMouseClick :: GfxEvent a -> Maybe a
isMouseClick GfxEvent a
msg =
    case GfxEvent a
msg of
      GfxButtonEvent { gfxType :: forall path. GfxEvent path -> Pressed
gfxType=Pressed
Pressed, gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=(a
path,(Point, Rect)
_):[(a, (Point, Rect))]
_ } -> forall a. a -> Maybe a
Just a
path
      GfxEvent a
_ -> forall a. Maybe a
Nothing

---

mapGfxCommandPath :: (a -> path) -> GfxCommand a gfx -> GfxCommand path gfx
mapGfxCommandPath a -> path
f GfxCommand a gfx
cmd =
    case GfxCommand a gfx
cmd of
      ChangeGfx [(a, GfxChange gfx)]
changes -> forall path gfx. [(path, GfxChange gfx)] -> GfxCommand path gfx
ChangeGfx (forall {t} {a} {b}. (t -> a) -> [(t, b)] -> [(a, b)]
mapFst a -> path
f [(a, GfxChange gfx)]
changes)
      ShowGfx a
path (Maybe Alignment, Maybe Alignment)
a -> forall path gfx.
path -> (Maybe Alignment, Maybe Alignment) -> GfxCommand path gfx
ShowGfx (a -> path
f a
path) (Maybe Alignment, Maybe Alignment)
a
      GetGfxPlaces [a]
paths -> forall path gfx. [path] -> GfxCommand path gfx
GetGfxPlaces (forall a b. (a -> b) -> [a] -> [b]
map a -> path
f [a]
paths)
      -- _ -> cmd -- Operationally, the rest is the same as this line.
      ChangeGfxBg ColorSpec
c -> forall path gfx. ColorSpec -> GfxCommand path gfx
ChangeGfxBg ColorSpec
c
      ChangeGfxBgPixmap PixmapId
pm Bool
b -> forall path gfx. PixmapId -> Bool -> GfxCommand path gfx
ChangeGfxBgPixmap PixmapId
pm Bool
b
#ifdef USE_EXIST_Q
      ChangeGfxBgGfx bg
gfx -> forall path gfx bg. Graphic bg => bg -> GfxCommand path gfx
ChangeGfxBgGfx bg
gfx
#endif
      ChangeGfxCursor CursorId
cursor -> forall path gfx. CursorId -> GfxCommand path gfx
ChangeGfxCursor CursorId
cursor
      ChangeGfxFontCursor Int
shape -> forall path gfx. Int -> GfxCommand path gfx
ChangeGfxFontCursor Int
shape
      BellGfx Int
n -> forall path gfx. Int -> GfxCommand path gfx
BellGfx Int
n


mapGfxEventPath :: (t -> Maybe path) -> GfxEvent t -> GfxEvent path
mapGfxEventPath t -> Maybe path
f GfxEvent t
event =
  case GfxEvent t
event of
    GfxButtonEvent Int
t ModState
s Pressed
ty Button
b [(t, (Point, Rect))]
ps -> forall path.
Int
-> ModState
-> Pressed
-> Button
-> [(path, (Point, Rect))]
-> GfxEvent path
GfxButtonEvent Int
t ModState
s Pressed
ty Button
b (forall {b}. [(t, b)] -> [(path, b)]
mapPaths [(t, (Point, Rect))]
ps)
    GfxMotionEvent Int
t ModState
s [(t, (Point, Rect))]
ps   -> forall path.
Int -> ModState -> [(path, (Point, Rect))] -> GfxEvent path
GfxMotionEvent Int
t ModState
s (forall {b}. [(t, b)] -> [(path, b)]
mapPaths [(t, (Point, Rect))]
ps)
    GfxKeyEvent Int
t ModState
m KeySym
k KeySym
l     -> forall path. Int -> ModState -> KeySym -> KeySym -> GfxEvent path
GfxKeyEvent Int
t ModState
m KeySym
k KeySym
l
    GfxFocusEvent Bool
b         -> forall path. Bool -> GfxEvent path
GfxFocusEvent Bool
b
    GfxPlaces [Rect]
rs            -> forall path. [Rect] -> GfxEvent path
GfxPlaces [Rect]
rs
    GfxResized Point
s            -> forall path. Point -> GfxEvent path
GfxResized Point
s
  where
    -- mapPats :: [(a,(Point,Rect))] -> [(b,(Point,Rect))]
    mapPaths :: [(t, b)] -> [(path, b)]
mapPaths = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. (t, b) -> Maybe (path, b)
f'
    -- f' :: (a,(Point,Rect)) -> Maybe (b,(Point,Rect))
    f' :: (t, b) -> Maybe (path, b)
f' (t
path,b
place) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\path
p->(path
p,b
place)) (t -> Maybe path
f t
path)

-- nullPath = null . gfxPaths -- would be ok if gfxPaths was a total function
nullPath :: GfxEvent path -> Bool
nullPath = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {path}. GfxEvent path -> Maybe [(path, (Point, Rect))]
gfxEventPaths

gfxEventPaths :: GfxEvent path -> Maybe [(path, (Point, Rect))]
gfxEventPaths GfxEvent path
event =
  case GfxEvent path
event of
    -- enumerate all constructors that have a path argument:
    GfxButtonEvent {gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=[(path, (Point, Rect))]
ps} -> forall a. a -> Maybe a
Just [(path, (Point, Rect))]
ps
    GfxMotionEvent {gfxPaths :: forall path. GfxEvent path -> [(path, (Point, Rect))]
gfxPaths=[(path, (Point, Rect))]
ps}  -> forall a. a -> Maybe a
Just [(path, (Point, Rect))]
ps
    GfxEvent path
_ -> forall a. Maybe a
Nothing

isGfxButtonEvent :: GfxEvent path -> Maybe Button
isGfxButtonEvent (GfxButtonEvent {gfxType :: forall path. GfxEvent path -> Pressed
gfxType=Pressed
Pressed,gfxButton :: forall path. GfxEvent path -> Button
gfxButton=Button
b}) = forall a. a -> Maybe a
Just Button
b
isGfxButtonEvent GfxEvent path
_ = forall a. Maybe a
Nothing