module ContDynF where

import Fudget
--import Xtypes
import Command
import FRequest
--import LayoutRequest(LayoutRequest)
--import Geometry
--import Message
import Spops(getSP,putSP,walkSP,pullSP)
import Path(here)
--import Direction
import Cont
--import Dynforkmerge
--import NullF(getMessageF,putMessageF)
--import LayoutDir

contDynF :: F a b -> Cont (F a d) b
contDynF :: forall a b d. F a b -> Cont (F a d) b
contDynF (F FSP a b
sp) = forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap (forall a b d. FSP a b -> Cont (FSP a d) b
contDynFSP FSP a b
sp)

contDynFSP :: FSP a b -> Cont (FSP a d) b
contDynFSP :: forall a b d. FSP a b -> Cont (FSP a d) b
contDynFSP FSP a b
f b -> FSP a d
c = ([Message TCommand b], FSP a b) -> FSP a d
cdf (forall {a1} {a2}. SP a1 a2 -> ([a2], SP a1 a2)
pullSP FSP a b
f)
  where cdf :: ([Message TCommand b], FSP a b) -> FSP a d
cdf ([Message TCommand b]
outf,FSP a b
f') = FSP a b -> [Message TCommand b] -> FSP a d
out FSP a b
f' [Message TCommand b]
outf 
        out :: FSP a b -> [Message TCommand b] -> FSP a d
out FSP a b
f' [] = forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \FEvent a
msg -> ([Message TCommand b], FSP a b) -> FSP a d
cdf (forall {a1} {a2}. SP a1 a2 -> a1 -> ([a2], SP a1 a2)
walkSP FSP a b
f' FEvent a
msg)
        out FSP a b
f' (Message TCommand b
x:[Message TCommand b]
xs) = case Message TCommand b
x of
	   High b
msg -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Message a b
Low (Path
here,XCommand -> FRequest
XCmd XCommand
DestroyWindow)) forall a b. (a -> b) -> a -> b
$ b -> FSP a d
c b
msg
	   Low TCommand
cmd -> forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Message a b
Low TCommand
cmd) forall a b. (a -> b) -> a -> b
$ FSP a b -> [Message TCommand b] -> FSP a d
out FSP a b
f' [Message TCommand b]
xs