{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Basic.Kernel.Objects.LocThetaImage
-- Copyright   :  (c) Stephen Tetley 2011
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  highly unstable
-- Portability :  GHC 
--
-- LocThetaImage and LocThetaGraphic types - these are functional 
-- types from the DrawingContext, start point and angle of 
-- inclination to a graphic /primitive/.
--
--------------------------------------------------------------------------------

module Wumpus.Basic.Kernel.Objects.LocThetaImage
   (
     LocThetaGraphic
   , LocThetaImage

   , DLocThetaGraphic
   , DLocThetaImage

   , intoLocThetaImage
   , locThetaGraphic_

   , emptyLocThetaGraphic

   , uconvLocThetaImageF
   , uconvLocThetaImageZ

   
   )

   where

import Wumpus.Basic.Kernel.Base.BaseDefs
import Wumpus.Basic.Kernel.Base.ContextFun
import Wumpus.Basic.Kernel.Objects.Basis
-- import Wumpus.Basic.Kernel.Objects.Displacement
import Wumpus.Basic.Kernel.Objects.LocImage

-- import Wumpus.Core                              -- package: wumpus-core

import Control.Applicative


-- | 'LocThetaImage' - function from DrawingContext, start point 
-- and inclination to a polymorphic /answer/ and a graphic 
-- /primitive/ (ImageAns).
--
-- The answer is expected to be a Functor.
--
type LocThetaImage u a = LocThetaQuery u (ImageAns u a)


-- | LocThetaGraphic - function from DrawingContext, start point 
-- and inclination to a graphic /primitive/ (GraphicAns).
--
type LocThetaGraphic u  = LocThetaQuery u (GraphicAns u)


-- | Type specialized version of 'LocThetaImage'.
--
type DLocThetaImage a   = LocThetaImage Double a

-- | Type specialized version of 'LocThetaGraphic'.
--
type DLocThetaGraphic   = LocThetaGraphic Double 




-- | 'intoLocThetaImage' : @ loc_theta_query * loc_theta_graphic -> LocThetaImage @
--
-- /LocTheta/ version of 'intoImage'. 
-- 
-- The 'LocThetaImage' is built as a function from an implicit 
-- start point and angle of inclination to the answer.
--
intoLocThetaImage :: LocThetaQuery u a 
                  -> LocThetaGraphic u 
                  -> LocThetaImage u a
intoLocThetaImage qf ma = 
    promoteR2 $ \a b -> replaceAns <$> apply2R2 qf a b <*> apply2R2 ma a b



-- | /Downcast/ an 'LocThetaImage' to a 'LocThetaGraphic'.
-- 
-- This means forgetting the answer of the Image, replacing it 
-- with @()@.
--
locThetaGraphic_ :: LocThetaImage u a -> LocThetaGraphic u
locThetaGraphic_ = (fmap . fmap . fmap) ignoreAns


-- | 'emptyLocThetaGraphic' : @ LocThetaGraphic @
--
-- Build an empty 'LocThetaGraphic' (i.e. a function 
-- /from Point and Inclination to Graphic/). 
-- 
-- The 'emptyLocThetaGraphic' is treated as a /null primitive/ by 
-- @Wumpus-Core@ and is not drawn, although it does generate a 
-- minimum bounding box at the implicit start point.
-- 
emptyLocThetaGraphic :: InterpretUnit u => LocThetaGraphic u
emptyLocThetaGraphic = lift1R2 emptyLocGraphic




-- | Use this to convert 'LocThetaGraphic' or 'LocThetaImage' 
-- with Functor answer.
--
uconvLocThetaImageF :: (InterpretUnit u, InterpretUnit u1, Functor t) 
                    => LocThetaImage u (t u) -> LocThetaImage u1 (t u1)
uconvLocThetaImageF = uconvR2a szconvAnsF



-- | Use this to convert 'LocThetaImage' with unit-less answer.
--
uconvLocThetaImageZ :: (InterpretUnit u, InterpretUnit u1) 
                    => LocThetaImage u a -> LocThetaImage u1 a
uconvLocThetaImageZ = uconvR2a szconvAnsZ




--------------------------------------------------------------------------------
-- Combining LocThetaImages

{-

infixr 6 `catLTI`
infixr 5 `sepLTI`

-- | Concatenate two LocThetaImages. The start point is /shared/.
--
-- This is just @oplus@.
--
catLTI :: OPlus (t u)
       => LocThetaImage t u -> LocThetaImage t u -> LocThetaImage t u
catLTI = oplus



-- | Concatenate two LocThetaImages, the second LocThetaImage is 
-- displaced /orthonormally/ from the the start point by the 
-- supplied vector (separator). 
--
-- Here, /orthonormally/ means that the x-component of the vector
-- displaces the second LocThetaImage in parallel to the angle
-- of inclination, the y-component of the vector displaces 
-- perpendicular to the incliantion.
--
-- Note - the separator is exactly a displacement of the start
-- point, LocImages have no notion of border so this function
-- can only be used to concatenate to objects side by side if
-- there boundaries are known beforehand.
-- 
-- Consider a PosThetaImage if you need more sophisticated arrangement.
-- 
sepLTI :: (Floating u, OPlus (t u))
       => Vec2 u -> LocThetaImage t u -> LocThetaImage t u 
       -> LocThetaImage t u
sepLTI v g1 g2 = g1 `oplus` moveStartTheta (displaceOrtho v) g2



-- | Concatenate two LocThetaImages, the second LocImage is 
-- displaced parallel to the inclination by the supplied distance. 
--
-- Note - this is exactly a start point displacement. See the 
-- caveat for 'sepLTI'.
-- 
paraSepLTI :: (Floating u, OPlus (t u))
           => u -> LocThetaImage t u -> LocThetaImage t u -> LocThetaImage t u
paraSepLTI u = sepLTI (hvec u)



-- | Concatenate two LocThetaImages, the second LocThetaImage is 
-- displaced perpendicular to the inclination by the supplied 
-- distance.
--
-- Note - this is exactly a start point displacement. See the 
-- caveat for 'sepLTI'.
-- 
perpSepLTI :: (Floating u, OPlus (t u))
       => u -> LocThetaImage t u -> LocThetaImage t u -> LocThetaImage t u
perpSepLTI u = sepLTI (vvec u)


-- | Repeatedly draw a LocThetaImage, moving the start point each time 
-- /orthonormally/ by the supplied vector.
--
-- Note - the first LocThetaImage argument is the /empty/ alternative
-- this is drawn if the repeat count is less than 1.
--
repeatLTI :: (Floating u, OPlus (t u))
          => LocThetaImage t u -> Int -> Vec2 u -> LocThetaImage t u 
          -> LocThetaImage t u
repeatLTI alt i _  _  | i < 1 = alt
repeatLTI _   i v  gf         = promoteR2 $ \start ang -> body start ang
  where
    body start ang = go (i-1) (drawF start) (moveF start)
      where
        drawF pt                = atIncline gf pt ang
        moveF pt                = displaceOrtho v ang pt
        go n acc pt | n < 1     = acc
                    | otherwise = go (n-1) (acc `oplus` drawF pt) (moveF pt)



-- | Repeatedly draw a LocThetaImage, moving parallel to the 
-- inclination each time by the supplied distance.
--
-- Note - this draws the alternative LocThetaImage if the repeat count 
-- is less than 1.
--
paraRepeatLTI :: (Floating u, OPlus (t u))
              => LocThetaImage t u -> Int -> u -> LocThetaImage t u 
              -> LocThetaImage t u
paraRepeatLTI alt i u = repeatLTI alt i (hvec u) 



-- | Repeatedly draw a LocThetaImage, moving perpendicular to the
-- inclination each time by the supplied distance.
--
-- Note - this draws the alternative LocThetaImage if the repeat count 
-- is less than 1.
--
perpRepeatLTI :: (Floating u, OPlus (t u))
          => LocThetaImage t u -> Int -> u -> LocThetaImage t u -> LocThetaImage t u
perpRepeatLTI alt i u = repeatLTI alt i (vvec u) 



-- | Concatenate a list of LocThetaImages, spacing them by moving 
-- the start point /orthonormally/ each time by the supplied 
-- vector.
--
-- Note - this draws the /empty/ alternative if the list is empty.
--
spaceLTI :: (Floating u, OPlus (t u))
         => LocThetaImage t u -> Vec2 u -> [LocThetaImage t u] 
         -> LocThetaImage t u
spaceLTI alt _ []     = alt
spaceLTI _   v (g:gs) = promoteR2 $ \start ang -> body start ang 
  where
    body start ang = go (drawF g start) (moveF start) gs
      where
        drawF gf pt      = atIncline gf pt ang
        moveF pt         = displaceOrtho v ang pt
        go acc _  []     = acc
        go acc pt (f:fs) = go (acc `oplus` drawF f pt) (moveF pt) fs



-- | Concatenate a list of LocThetaImages, spacing them by moving 
-- the start point parallel to the inclination each time by the 
-- supplied distance.
--
-- Note - this draws the /empty/ alternative if the list is empty.
--
paraSpaceLTI :: (Floating u, OPlus (t u))
              => LocThetaImage t u -> u -> [LocThetaImage t u] 
              -> LocThetaImage t u
paraSpaceLTI alt u = spaceLTI alt (hvec u)


-- | Concatenate a list of LocThetaImages, spacing them by moving 
-- the start point perpendicular to the inclination each time by 
-- the supplied distance.
--
-- Note - this draws the /empty/ alternative if the list is empty.
--
perpSpaceLTI :: (Floating u, OPlus (t u))
              => LocThetaImage t u -> u -> [LocThetaImage t u] 
              -> LocThetaImage t u
perpSpaceLTI alt u = spaceLTI alt (vvec u)


-- | Enclose l r x
--
-- Note - the @left@ LocThetaImage is drawn at the start point, the 
-- LocThetaImage @x@ is concatenated with 'sepLTI' then the right 
-- LocThetaImage is concatenated with 'sepLi'.
--
encloseLTI :: (Floating u, OPlus (t u))
           => Vec2 u 
           -> LocThetaImage t u -> LocThetaImage t u -> LocThetaImage t u 
           -> LocThetaImage t u
encloseLTI v lft rht obj = lft `op` obj `op` rht
  where
    op = sepLTI v



-- | Parallel version of 'encloseLTI'.
--
-- Note - the @left@ LocThetaImage is drawn at the start point, the 
-- LocThetaImage @x@ is concatenated with 'sepLTI' then the right 
-- LocThetaImage is concatenated with 'sepLTI'.
--
paraEncloseLTI :: (Floating u, OPlus (t u))
               => u 
               -> LocThetaImage t u -> LocThetaImage t u -> LocThetaImage t u 
               -> LocThetaImage t u
paraEncloseLTI u = encloseLTI (hvec u)



-- | Perpendicular version of 'encloseLTI'.
--
-- Note - the @left@ LocThetaImage is drawn at the start point, the 
-- LocThetaImage @x@ is concatenated with 'sepLTI' then the right 
-- LocThetaImage is concatenated with 'sepLTI'.
--
perpEncloseLTI :: (Floating u, OPlus (t u))
               => u 
               -> LocThetaImage t u -> LocThetaImage t u -> LocThetaImage t u 
               -> LocThetaImage t u
perpEncloseLTI u = encloseLTI (vvec u)



-- | Concatenate a list of LocThetaImages, punctuating with the 
-- separator.
--
-- Note - this draws the /empty/ alternative if the list is empty.
--
punctuateLTI :: (Floating u, OPlus (t u))
             => LocThetaImage t u -> Vec2 u 
             -> LocThetaImage t u -> [LocThetaImage t u] 
             -> LocThetaImage t u
punctuateLTI alt _ _   []     = alt
punctuateLTI _   v sep (g:gs) = go g gs
  where 
    go acc []     = acc
    go acc (f:fs) = go (encloseLTI v acc f sep) fs


-- | Parallel version of 'punctuateLTI'
--
paraPunctuateLTI :: (Floating u, OPlus (t u))
                 => LocThetaImage t u -> u 
                 -> LocThetaImage t u -> [LocThetaImage t u] 
                 -> LocThetaImage t u
paraPunctuateLTI alt u = punctuateLTI alt (hvec u)


-- | Perpendicular version of 'punctuateLTI'
--
perpPunctuateLTI :: (Floating u, OPlus (t u))
                 => LocThetaImage t u -> u 
                 -> LocThetaImage t u -> [LocThetaImage t u] 
                 -> LocThetaImage t u
perpPunctuateLTI alt u = punctuateLTI alt (vvec u)

-}