module TimerF(timerF,Tick(..)) where
import Fudget
import FudgetIO
import FRequest
import Srequest(sIO,sIOsucc,select)
--import Message(Message(..))
import NullF
import Sockets
--import Xtypes
import DialogueIO hiding (IOError)

data Tick = Tick deriving (Int -> Tick -> ShowS
[Tick] -> ShowS
Tick -> String
(Int -> Tick -> ShowS)
-> (Tick -> String) -> ([Tick] -> ShowS) -> Show Tick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tick] -> ShowS
$cshowList :: [Tick] -> ShowS
show :: Tick -> String
$cshow :: Tick -> String
showsPrec :: Int -> Tick -> ShowS
$cshowsPrec :: Int -> Tick -> ShowS
Show,Tick -> Tick -> Bool
(Tick -> Tick -> Bool) -> (Tick -> Tick -> Bool) -> Eq Tick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tick -> Tick -> Bool
$c/= :: Tick -> Tick -> Bool
== :: Tick -> Tick -> Bool
$c== :: Tick -> Tick -> Bool
Eq)

--timerF :: F (Maybe (Int,Int)) Tick
timerF :: F (Maybe (Int, Int)) Tick
timerF =  Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
forall a. Maybe a
Nothing
  where
    f :: Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
oTno =
      Cont (F (Maybe (Int, Int)) Tick) (KEvent (Maybe (Int, Int)))
forall a b. Cont (F a b) (KEvent a)
getMessageFu Cont (F (Maybe (Int, Int)) Tick) (KEvent (Maybe (Int, Int)))
-> Cont (F (Maybe (Int, Int)) Tick) (KEvent (Maybe (Int, Int)))
forall a b. (a -> b) -> a -> b
$ \ KEvent (Maybe (Int, Int))
msg ->
      let same :: F (Maybe (Int, Int)) Tick
same = Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
oTno
	  settimer :: Int -> Int -> F (Maybe (Int, Int)) Tick
settimer Int
int Int
first = case Maybe Timer
oTno of
	    Just _ -> F (Maybe (Int, Int)) Tick
same
	    Maybe Timer
Nothing ->
	      SocketRequest
-> (SocketResponse -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
SocketRequest -> (SocketResponse -> f b ho) -> f b ho
sIO (Int -> Int -> SocketRequest
CreateTimer Int
int Int
first) ((SocketResponse -> F (Maybe (Int, Int)) Tick)
 -> F (Maybe (Int, Int)) Tick)
-> (SocketResponse -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$ \ (Timer Timer
tno) ->
	      -- error handling?!
	      [Descriptor]
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [Timer -> Descriptor
TimerDe Timer
tno] (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
	      Maybe Timer -> F (Maybe (Int, Int)) Tick
f (Timer -> Maybe Timer
forall a. a -> Maybe a
Just Timer
tno)
	  removetimer :: F (Maybe (Int, Int)) Tick
removetimer = case Maybe Timer
oTno of
		Just tno -> SocketRequest
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
SocketRequest -> f b ho -> f b ho
sIOsucc (Timer -> SocketRequest
DestroyTimer Timer
tno) (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
			    [Descriptor]
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [] (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
			    Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
forall a. Maybe a
Nothing
		Maybe Timer
Nothing -> F (Maybe (Int, Int)) Tick
same
      in case KEvent (Maybe (Int, Int))
msg of
	   High (Just (Int
interval, Int
first)) -> Int -> Int -> F (Maybe (Int, Int)) Tick
settimer Int
interval Int
first
	   High Maybe (Int, Int)
Nothing -> F (Maybe (Int, Int)) Tick
removetimer
	   Low (DResp (AsyncInput (Descriptor
_, AEvent
TimerAlarm))) ->
	     Tick -> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh Tick
Tick (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
	     F (Maybe (Int, Int)) Tick
same