Point.hs

{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecursiveDo, TypeFamilies, OverloadedStrings, RecordWildCards,UndecidableInstances, PackageImports, TemplateHaskell #-}

module MarXup.Diagram.Point where

import MarXup.Diagram.Layout
import Data.Traversable
import Data.Foldable
import Data.Algebra
import Control.Applicative
import Data.List (transpose)
import Prelude hiding (sum,mapM_,mapM,concatMap,maximum,minimum)

infix 4 .=.
----------------
-- Points 
-- | A point in 2d space
data Point' a = Point {xpart :: a, ypart :: a}
  deriving (Eq,Show)

instance Traversable Point' where
  traverse f (Point x y) = Point <$> f x <*> f y

instance Foldable Point' where
  foldMap = foldMapDefault

instance Functor Point' where
  fmap = fmapDefault

  
type Point = Point' Expr
instance Group a => Num (Point' a) where
  negate = neg
  (+) = (^+^)
  (-) = (^-^)

instance Group v => Group (Point' v) where
  zero = Point zero zero
  Point x1 y1 ^+^ Point x2 y2 = Point (x1 ^+^ x2) (y1 ^+^ y2)
  neg (Point x y) = Point (neg x) (neg y)

instance Module Constant v => Module Constant (Point' v) where
  k *^ Point x y = Point (k *^ x) (k *^ y)

-- | Orthogonal norm of a vector
orthonorm :: Point -> Diagram Expr
orthonorm (Point x y) =
  (+) <$> absoluteValue x <*> absoluteValue y

-- | Orthogonal distance between points.
orthoDist :: Point -> Point -> Diagram Expr
orthoDist p q = orthonorm (q-p)

-- | Rotate a vector 90 degres in the trigonometric direction.
rotate90, rotate180 :: Point -> Point
rotate90 (Point x y) = Point (negate y) x

rotate180 = rotate90 . rotate90

xdiff,ydiff :: Point -> Point -> Expr
xdiff p q = xpart (q - p)
ydiff p q = ypart (q - p)

-----------------
-- Point constraints

(.=.),northOf,southOf,westOf,eastOf :: Point -> Point -> Diagram ()
Point x1 y1 .=. Point x2 y2 = do
  x1 === x2
  y1 === y2

northOf (Point _ y1) (Point _ y2) = y2 <== y1
southOf = flip northOf
westOf (Point x1 _) (Point x2 _) = x1 <== x2
eastOf = flip westOf

alignHoriz,alignVert :: [Point] -> Diagram ()
alignHoriz = align ypart
alignVert = align xpart

align :: (a -> Expr) -> [a] -> Diagram ()
align _ [] = return ()
align f (p:ps) = forM_ ps $ \p' -> f p === f p'

alignMatrix :: [[Point]] -> Dia
alignMatrix ls = do
  forM_ ls alignHoriz
  forM_ (transpose ls) alignVert

---------------------
-- Point objectives

southwards, northwards, westwards, eastwards :: Point -> Diagram ()
southwards (Point _ y) = minimize y
westwards (Point x _) = minimize x
northwards = southwards . negate
eastwards = westwards . negate