{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Samples.Event.Area where

import Control.Moffy
import Data.Type.Set
import Data.Bool

type Point = (Double, Double)

data SetArea = SetAreaReq Int Point Point deriving (Int -> SetArea -> ShowS
[SetArea] -> ShowS
SetArea -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetArea] -> ShowS
$cshowList :: [SetArea] -> ShowS
show :: SetArea -> String
$cshow :: SetArea -> String
showsPrec :: Int -> SetArea -> ShowS
$cshowsPrec :: Int -> SetArea -> ShowS
Show, SetArea -> SetArea -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetArea -> SetArea -> Bool
$c/= :: SetArea -> SetArea -> Bool
== :: SetArea -> SetArea -> Bool
$c== :: SetArea -> SetArea -> Bool
Eq, Eq SetArea
SetArea -> SetArea -> Bool
SetArea -> SetArea -> Ordering
SetArea -> SetArea -> SetArea
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SetArea -> SetArea -> SetArea
$cmin :: SetArea -> SetArea -> SetArea
max :: SetArea -> SetArea -> SetArea
$cmax :: SetArea -> SetArea -> SetArea
>= :: SetArea -> SetArea -> Bool
$c>= :: SetArea -> SetArea -> Bool
> :: SetArea -> SetArea -> Bool
$c> :: SetArea -> SetArea -> Bool
<= :: SetArea -> SetArea -> Bool
$c<= :: SetArea -> SetArea -> Bool
< :: SetArea -> SetArea -> Bool
$c< :: SetArea -> SetArea -> Bool
compare :: SetArea -> SetArea -> Ordering
$ccompare :: SetArea -> SetArea -> Ordering
Ord)
numbered [t| SetArea |]
instance Request SetArea where data Occurred SetArea = OccSetArea deriving Int -> Occurred SetArea -> ShowS
[Occurred SetArea] -> ShowS
Occurred SetArea -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurred SetArea] -> ShowS
$cshowList :: [Occurred SetArea] -> ShowS
show :: Occurred SetArea -> String
$cshow :: Occurred SetArea -> String
showsPrec :: Int -> Occurred SetArea -> ShowS
$cshowsPrec :: Int -> Occurred SetArea -> ShowS
Show

setArea :: Int -> (Point, Point) -> React s (Singleton SetArea) ()
setArea :: forall s. Int -> (Point, Point) -> React s (Singleton SetArea) ()
setArea Int
i (Point
lu, Point
rd) = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (Int -> Point -> Point -> SetArea
SetAreaReq Int
i Point
lu Point
rd) forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const ()

data GetArea = GetAreaReq Int deriving (Int -> GetArea -> ShowS
[GetArea] -> ShowS
GetArea -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetArea] -> ShowS
$cshowList :: [GetArea] -> ShowS
show :: GetArea -> String
$cshow :: GetArea -> String
showsPrec :: Int -> GetArea -> ShowS
$cshowsPrec :: Int -> GetArea -> ShowS
Show, GetArea -> GetArea -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetArea -> GetArea -> Bool
$c/= :: GetArea -> GetArea -> Bool
== :: GetArea -> GetArea -> Bool
$c== :: GetArea -> GetArea -> Bool
Eq, Eq GetArea
GetArea -> GetArea -> Bool
GetArea -> GetArea -> Ordering
GetArea -> GetArea -> GetArea
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GetArea -> GetArea -> GetArea
$cmin :: GetArea -> GetArea -> GetArea
max :: GetArea -> GetArea -> GetArea
$cmax :: GetArea -> GetArea -> GetArea
>= :: GetArea -> GetArea -> Bool
$c>= :: GetArea -> GetArea -> Bool
> :: GetArea -> GetArea -> Bool
$c> :: GetArea -> GetArea -> Bool
<= :: GetArea -> GetArea -> Bool
$c<= :: GetArea -> GetArea -> Bool
< :: GetArea -> GetArea -> Bool
$c< :: GetArea -> GetArea -> Bool
compare :: GetArea -> GetArea -> Ordering
$ccompare :: GetArea -> GetArea -> Ordering
Ord)
numbered [t| GetArea |]

instance Request GetArea where
	data Occurred GetArea = OccGetArea Int Point Point deriving Int -> Occurred GetArea -> ShowS
[Occurred GetArea] -> ShowS
Occurred GetArea -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurred GetArea] -> ShowS
$cshowList :: [Occurred GetArea] -> ShowS
show :: Occurred GetArea -> String
$cshow :: Occurred GetArea -> String
showsPrec :: Int -> Occurred GetArea -> ShowS
$cshowsPrec :: Int -> Occurred GetArea -> ShowS
Show

getArea :: Int -> React s (Singleton GetArea) (Point, Point)
getArea :: forall s. Int -> React s (Singleton GetArea) (Point, Point)
getArea Int
i0 = React s (Singleton GetArea) (Int, (Point, Point))
go forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Int
i, (Point, Point)
a) -> forall a. a -> a -> Bool -> a
bool (forall s. Int -> React s (Singleton GetArea) (Point, Point)
getArea Int
i0) (forall (f :: * -> *) a. Applicative f => a -> f a
pure (Point, Point)
a) (Int
i forall a. Eq a => a -> a -> Bool
== Int
i0)
	where
	go :: React s (Singleton GetArea) (Int, (Point, Point))
go = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (Int -> GetArea
GetAreaReq Int
i0) \(OccGetArea Int
i Point
lu Point
rd) -> (Int
i, (Point
lu, Point
rd))