htanks/src/Transformable.hs

{-# LANGUAGE TypeOperators, TypeSynonymInstances #-}

module Transformable ( Coord
                     , Vector3
                     , TransformMap
                     , Transform(..)
                     , ReversibleTransform(..)
                     , Transformable(..)
                     , (><)
                     , (>:<)
                     ) where

import Data.LinearMap

type Coord = Double

type Vector3 = (Coord, Coord, Coord)
type TransformMap = Vector3 :-* Vector3

class Transformable a where
  transform :: TransformMap -> a -> a

class Transform a where
  toMap :: a -> TransformMap

class Transform a => ReversibleTransform a where
  toMap' :: a -> TransformMap

instance Transformable Vector3 where
  transform = lapply

instance Transform TransformMap where
  toMap = id

instance Transformable TransformMap where
  transform = (*.*)

(><) :: (Transform t, Transformable a) => t -> a -> a
t >< a = transform (toMap t) a

(>:<) :: (ReversibleTransform t, Transformable a) => t -> a -> a
t >:< a = transform (toMap' t) a