{-# 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) -}