{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Basic.Kernel.Base.Anchors
-- Copyright   :  (c) Stephen Tetley 2010
-- License     :  BSD3
--
-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>
-- Stability   :  highly unstable
-- Portability :  GHC
--
-- Anchor points on shapes, bounding boxes, etc.
--
-- Anchors are addressable positions, an examplary use is taking
-- anchors on node shapes to get the start and end points for 
-- connectors in a network (graph) diagram.
-- 
-- \*\* WARNING \*\* - The API here needs some thought as to a
-- good balance of the type classes - in a nutshell \"are corners 
-- better than cardinals\". Originally I tried to follow how I 
-- understand the TikZ anchors to work, but this is perhaps not 
-- ideal for dividing into type-classes.
--
--------------------------------------------------------------------------------

module Wumpus.Basic.Kernel.Base.Anchors
  ( 

  -- * Anchors
    CenterAnchor(..)
  , ApexAnchor(..)
  , CardinalAnchor(..)
  , CardinalAnchor2(..)
  , RadialAnchor(..)
  , TopCornerAnchor(..)
  , BottomCornerAnchor(..)
  , SideMidpointAnchor(..)


  -- * Extended anchor points
  , projectAnchor

  , radialConnectorPoints

  ) where

import Wumpus.Core                      -- package: wumpus-core

import Data.AffineSpace                 -- package: vector-space


-- | Center of an object.
--
class CenterAnchor t where
  center :: DUnit t ~ u => t -> Point2 u


-- | Apex of an object.
--
class ApexAnchor t where
  apex :: DUnit t ~ u => t -> Point2 u


-- | Cardinal (compass) positions on an object. 
-- 
-- Note - in TikZ cardinal anchors are not necessarily at the
-- equivalent radial position, for instance reactangle north-east
-- is the top-right corner whether or not this is incident at 
-- 45deg.
--
-- Wumpus generally follows the TikZ convention.
--
class CardinalAnchor t where
  north :: DUnit t ~ u => t -> Point2 u
  south :: DUnit t ~ u => t -> Point2 u
  east  :: DUnit t ~ u => t -> Point2 u
  west  :: DUnit t ~ u => t -> Point2 u

--
-- Note - a design change is probably in order where the cardinals 
-- should /always/ represent their true cardinal position.
--
-- If this change is made, it is worthwhile having cardinals as
-- classes (rather than making them derived operations on 
-- RadialAnchor) as classes allow for more efficient 
-- implementations usually by trigonometry.
-- 


-- | Secondary group of cardinal (compass) positions on an object. 
-- 
-- It seems possible that for some objects defining the primary
-- compass points (north, south,...) will be straight-forward 
-- whereas defining the secondary compass points may be 
-- problematic, hence the compass points are split into two 
-- classes.
--
class CardinalAnchor2 t where
  northeast :: DUnit t ~ u => t -> Point2 u
  southeast :: DUnit t ~ u => t -> Point2 u
  southwest :: DUnit t ~ u => t -> Point2 u
  northwest :: DUnit t ~ u => t -> Point2 u


-- | Anchor on a border that can be addressed by an angle.
--
-- The angle is counter-clockwise from the right-horizontal, i.e.
-- 0 is /east/.
--
class RadialAnchor t where
  radialAnchor :: DUnit t ~ u => Radian -> t -> Point2 u


-- | Anchors at the top left and right corners of a shape.
--
-- For some shapes (Rectangle) the TikZ convention appears to be
-- have cardinals as the corner anchors, but this doesn\'t seem
-- to be uniform. Wumpus will need to reconsider anchors at some 
-- point...
--
class TopCornerAnchor t where
  topLeftCorner  :: DUnit t ~ u => t -> Point2 u
  topRightCorner :: DUnit t ~ u => t -> Point2 u


-- | Anchors at the bottom left and right corners of a shape.
--
class BottomCornerAnchor t where
  bottomLeftCorner  :: DUnit t ~ u => t -> Point2 u
  bottomRightCorner :: DUnit t ~ u => t -> Point2 u


-- | Anchors in the center of a side.
-- 
-- Sides are addressable by index. Following TikZ, side 1 is 
-- expected to be the top of the shape. If the shape has an apex 
-- instead of a side then side 1 is expected to be the first side 
-- left of the apex.
-- 
-- Implementations are also expected to modulo the side number, 
-- rather than throw an out-of-bounds error.
--
class SideMidpointAnchor t where
  sideMidpoint :: DUnit t ~ u => Int -> t -> Point2 u



--------------------------------------------------------------------------------

-- | 'projectAnchor' : @ extract_func * dist * object -> Point @
-- 
-- Derive a anchor by projecting a line from the center of an 
-- object through the intermediate anchor (produced by the 
-- extraction function). The final answer point is located along
-- the projected line at the supplied distance @dist@.
-- 
-- E.g. take the north of a rectangle and project it 10 units 
-- further on:
--  
-- > projectAnchor north 10 my_rect
--
-- If the distance is zero the answer with be whatever point the 
-- the extraction function produces.
--
-- If the distance is negative the answer will be along the 
-- projection line, between the center and the intermediate anchor.
--
-- If the distance is positive the anchor will be extend outwards 
-- from the intermediate anchor.
--
projectAnchor :: (Real u, Floating u, u ~ DUnit t, CenterAnchor t) 
              => (t -> Point2 u) -> u -> t -> Point2 u
projectAnchor f d a = p1 .+^ (avec ang d)
  where
    p1  = f a
    v   = pvec (center a) p1
    ang = vdirection v
     


--------------------------------------------------------------------------------

-- | 'radialConnectorPoints' : @ object_a * object_b -> (Point_a, Point_b) @
--
-- Find the radial connectors points for objects @a@ and @b@ along
-- the line joining their centers.
--
radialConnectorPoints :: ( Real u, Floating u
                         , CenterAnchor t1, RadialAnchor t1
                         , CenterAnchor t2, RadialAnchor t2
                         , u ~ DUnit t1, DUnit t1 ~ DUnit t2 ) 
                      => t1 -> t2 -> (Point2 u, Point2 u) 
radialConnectorPoints a b = (radialAnchor theta a, radialAnchor (theta+pi) b)
  where
    theta = vdirection $ pvec (center a) (center b)
    

--------------------------------------------------------------------------------
-- Instances 

instance Fractional u => CenterAnchor (BoundingBox u) where
  center (BBox (P2 xl ylo) (P2 xr yhi)) = P2 x y 
     where
       x = xl+0.5*(xr-xl)
       y = ylo+0.5*(yhi-ylo)
       

instance Fractional u => CardinalAnchor (BoundingBox u) where
  north (BBox (P2 xl _  ) (P2 xr yhi)) = P2 (xl+0.5*(xr-xl)) yhi
  south (BBox (P2 xl ylo) (P2 xr _  )) = P2 (xl+0.5*(xr-xl)) ylo
  east  (BBox (P2 _  ylo) (P2 xr yhi)) = P2 xr (ylo+0.5*(yhi-ylo))
  west  (BBox (P2 xl ylo) (P2 _  yhi)) = P2 xl (ylo+0.5*(yhi-ylo))


instance Fractional u => CardinalAnchor2 (BoundingBox u) where
  northeast (BBox _ ur)                 = ur
  southeast (BBox (P2 _ ylo) (P2 xr _)) = P2 xr ylo
  southwest (BBox ll _)                 = ll
  northwest (BBox (P2 xl _) (P2 _ yhi)) = P2 xl yhi