```{-# LANGUAGE FlexibleInstances #-}

module Pianola.Geometry (
Interval,
Point1d,
inside1d,
before1d,
after1d,
Point2d,
Dimensions2d,
mid,
Geometrical (..),
sameLevelRightOf
) where

import Prelude hiding (catch,(.),id)
import Control.Category

type Interval = (Int,Int)

type Point1d = Int

inside1d :: Interval -> Point1d -> Bool
inside1d (x1,x2) u = x1 <= u && u <= x2

before1d :: Interval -> Point1d -> Bool
before1d (x1,_) x = x <= x1

after1d :: Interval -> Point1d -> Bool
after1d (_,x2) x = x2 <= x

-- | (x,y)
type Point2d = (Int,Int)

-- | (width,height)
type Dimensions2d = (Int,Int)

mid :: Interval -> Point1d
mid (x1,x2) = div (x1+x2) 2

-- | Class of objects with rectangular shape and located in a two-dimensional
-- plane.
class Geometrical g where
-- | Position of the north-west corner.
nwcorner :: g -> Point2d

dimensions :: g -> Dimensions2d

width :: g -> Int
width = fst . dimensions

height :: g -> Int
height = snd . dimensions

minX :: g -> Int
minX = fst . nwcorner

midX :: g -> Int
midX = mid . yband

minY :: g -> Int
minY = snd . nwcorner

midY :: g -> Int
midY = mid . yband

xband :: g -> Interval
xband g =
let gminX = minX g
in (gminX, gminX + (fst . dimensions) g)

yband :: g -> Interval
yband g =
let gminY = minY g
in (gminY, gminY + (snd . dimensions) g)

area :: g -> Int
area g = width g * height g

midpoint :: g -> Point2d
midpoint g = (midX g, midY g)

-- | True if the second object is roughly at the same height and to the right
-- of the first object.
sameLevelRightOf :: (Geometrical g1, Geometrical g2) => g1 -> g2 -> Bool
sameLevelRightOf ref c =
inside1d (yband c) (midY ref) && after1d (xband ref) (minX c)
```