module Wumpus.Basic.Kernel.Objects.LocThetaImage
(
LocThetaGraphic
, LocThetaImage
, DLocThetaGraphic
, DLocThetaImage
, LocThetaQuery
, runLocThetaImage
, runLocThetaQuery
, promoteLocTheta
, applyLocTheta
, qpromoteLocTheta
, qapplyLocTheta
, zapLocThetaQuery
, emptyLocThetaImage
, incline
, atIncline
)
where
import Wumpus.Basic.Kernel.Base.BaseDefs
import Wumpus.Basic.Kernel.Base.DrawingContext
import Wumpus.Basic.Kernel.Base.QueryDC
import Wumpus.Basic.Kernel.Objects.Basis
import Wumpus.Basic.Kernel.Objects.LocImage
import Wumpus.Core
import Control.Applicative
import Data.Monoid
newtype LocThetaImage u a = LocThetaImage {
getLocThetaImage :: Point2 u -> Radian -> Image u a }
type instance DUnit (LocThetaImage u a) = u
type LocThetaGraphic u = LocThetaImage u (UNil u)
type DLocThetaImage a = LocThetaImage Double a
type DLocThetaGraphic = LocThetaGraphic Double
newtype LocThetaQuery u a = LocThetaQuery {
getLocThetaQuery :: Point2 u -> Radian -> Query u a }
instance Functor (LocThetaImage u) where
fmap f ma = LocThetaImage $ \pt ang ->
fmap f $ getLocThetaImage ma pt ang
instance Functor (LocThetaQuery u) where
fmap f ma = LocThetaQuery $ \pt ang ->
fmap f $ getLocThetaQuery ma pt ang
instance Applicative (LocThetaImage u) where
pure a = LocThetaImage $ \_ _ -> pure a
mf <*> ma = LocThetaImage $ \pt ang ->
getLocThetaImage mf pt ang <*> getLocThetaImage ma pt ang
instance Applicative (LocThetaQuery u) where
pure a = LocThetaQuery $ \_ _ -> pure a
mf <*> ma = LocThetaQuery $ \pt ang ->
getLocThetaQuery mf pt ang <*> getLocThetaQuery ma pt ang
instance Monad (LocThetaImage u) where
return a = LocThetaImage $ \_ _ -> return a
ma >>= k = LocThetaImage $ \pt ang ->
getLocThetaImage ma pt ang >>= \ans ->
getLocThetaImage (k ans) pt ang
instance Monad (LocThetaQuery u) where
return a = LocThetaQuery $ \_ _ -> return a
ma >>= k = LocThetaQuery $ \pt ang ->
getLocThetaQuery ma pt ang >>= \ans ->
getLocThetaQuery (k ans) pt ang
instance Monoid a => Monoid (LocThetaImage u a) where
mempty = pure mempty
ma `mappend` mb = LocThetaImage $ \pt ang ->
getLocThetaImage ma pt ang
`mappend` getLocThetaImage mb pt ang
instance Monoid a => Monoid (LocThetaQuery u a) where
mempty = pure mempty
ma `mappend` mb = LocThetaQuery $ \pt ang ->
getLocThetaQuery ma pt ang
`mappend` getLocThetaQuery mb pt ang
instance DrawingCtxM (LocThetaImage u) where
askDC = LocThetaImage $ \_ _ -> askDC
asksDC fn = LocThetaImage $ \_ _ -> asksDC fn
localize upd ma = LocThetaImage $ \pt ang ->
localize upd (getLocThetaImage ma pt ang)
instance DrawingCtxM (LocThetaQuery u) where
askDC = LocThetaQuery $ \_ _ -> askDC
asksDC fn = LocThetaQuery $ \_ _ -> asksDC fn
localize upd ma = LocThetaQuery $ \pt ang ->
localize upd (getLocThetaQuery ma pt ang)
instance Decorate LocThetaImage where
decorate ma mz = LocThetaImage $ \pt ang ->
getLocThetaImage ma pt ang `decorate`
getLocThetaImage mz pt ang
elaborate ma f = LocThetaImage $ \pt ang ->
getLocThetaImage ma pt ang `elaborate`
(\a -> getLocThetaImage (f a) pt ang)
obliterate ma mz = LocThetaImage $ \pt ang ->
getLocThetaImage ma pt ang `obliterate`
getLocThetaImage mz pt ang
hyperlink xl ma = LocThetaImage $ \pt ang ->
hyperlink xl $ getLocThetaImage ma pt ang
runLocThetaImage :: Point2 u -> Radian -> DrawingContext
-> LocThetaImage u a
-> PrimW u a
runLocThetaImage pt incl ctx mf = runImage ctx (getLocThetaImage mf pt incl)
runLocThetaQuery :: Point2 u -> Radian -> DrawingContext
-> LocThetaQuery u a
-> a
runLocThetaQuery pt incl ctx mf = runQuery ctx (getLocThetaQuery mf pt incl)
promoteLocTheta :: (Point2 u -> Radian -> Image u a) -> LocThetaImage u a
promoteLocTheta k = LocThetaImage $ \pt ang -> k pt ang
applyLocTheta :: LocThetaImage u a -> Point2 u -> Radian -> Image u a
applyLocTheta mq pt ang = getLocThetaImage mq pt ang
qpromoteLocTheta :: (Point2 u -> Radian -> Query u a) -> LocThetaQuery u a
qpromoteLocTheta k = LocThetaQuery $ \pt ang -> k pt ang
qapplyLocTheta :: LocThetaQuery u a -> Point2 u -> Radian -> Query u a
qapplyLocTheta mq pt ang = getLocThetaQuery mq pt ang
zapLocThetaQuery :: LocThetaQuery u a -> Point2 u -> Radian -> Image u a
zapLocThetaQuery mq pt ang = askDC >>= \ctx ->
let a = runLocThetaQuery pt ang ctx mq in return a
instance UConvert LocThetaImage where
uconvF = uconvLocThetaImageF
uconvZ = uconvLocThetaImageZ
uconvLocThetaImageF :: (InterpretUnit u, InterpretUnit u1, Functor t)
=> LocThetaImage u (t u) -> LocThetaImage u1 (t u1)
uconvLocThetaImageF ma = LocThetaImage $ \pt ang ->
getFontSize >>= \sz ->
let ptu = uconvertF sz pt
in uconvF $ getLocThetaImage ma ptu ang
uconvLocThetaImageZ :: (InterpretUnit u, InterpretUnit u1)
=> LocThetaImage u a -> LocThetaImage u1 a
uconvLocThetaImageZ ma = LocThetaImage $ \pt ang ->
getFontSize >>= \sz ->
let ptu = uconvertF sz pt
in uconvZ $ getLocThetaImage ma ptu ang
emptyLocThetaImage :: Monoid a => LocThetaImage u a
emptyLocThetaImage = mempty
infixr 1 `incline`
incline :: LocThetaImage u a -> Radian -> LocImage u a
incline ma incl = promoteLoc $ \pt -> getLocThetaImage ma pt incl
atIncline :: LocThetaImage u a -> Point2 u -> Radian -> Image u a
atIncline ma pt incl = getLocThetaImage ma pt incl