Area.hs

{-# 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 (Show, Eq, Ord)
numbered [t| SetArea |]
instance Request SetArea where data Occurred SetArea = OccSetArea deriving Show

setArea :: Int -> (Point, Point) -> React s (Singleton SetArea) ()
setArea i (lu, rd) = await (SetAreaReq i lu rd) $ const ()

data GetArea = GetAreaReq Int deriving (Show, Eq, Ord)
numbered [t| GetArea |]

instance Request GetArea where
	data Occurred GetArea = OccGetArea Int Point Point deriving Show

getArea :: Int -> React s (Singleton GetArea) (Point, Point)
getArea i0 = go >>= \(i, a) -> bool (getArea i0) (pure a) (i == i0)
	where
	go = await (GetAreaReq i0) \(OccGetArea i lu rd) -> (i, (lu, rd))