module Wumpus.Basic.Kernel.Objects.Connector
(
ConnectorImage
, ConnectorGraphic
, DConnectorImage
, DConnectorGraphic
, ConnectorQuery
, runConnectorImage
, runConnectorQuery
, connect
, promoteConn
, applyConn
, qpromoteConn
, qapplyConn
, zapConnectorQuery
, emptyConnectorImage
)
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.Core
import Control.Applicative
import Data.Monoid
newtype ConnectorImage u a = ConnectorImage {
getConnectorImage :: Point2 u -> Point2 u -> Image u a }
type instance DUnit (ConnectorImage u a) = u
type ConnectorGraphic u = ConnectorImage u (UNil u)
type DConnectorImage a = ConnectorImage Double a
type DConnectorGraphic = ConnectorGraphic Double
newtype ConnectorQuery u a = ConnectorQuery {
getConnectorQuery :: Point2 u -> Point2 u -> Query u a }
instance Functor (ConnectorImage u) where
fmap f ma = ConnectorImage $ \p0 p1 -> fmap f $ getConnectorImage ma p0 p1
instance Functor (ConnectorQuery u) where
fmap f ma = ConnectorQuery $ \p0 p1 -> fmap f $ getConnectorQuery ma p0 p1
instance Applicative (ConnectorImage u) where
pure a = ConnectorImage $ \_ _ -> pure a
mf <*> ma = ConnectorImage $ \p0 p1 ->
getConnectorImage mf p0 p1 <*> getConnectorImage ma p0 p1
instance Applicative (ConnectorQuery u) where
pure a = ConnectorQuery $ \_ _ -> pure a
mf <*> ma = ConnectorQuery $ \p0 p1 ->
getConnectorQuery mf p0 p1 <*> getConnectorQuery ma p0 p1
instance Monad (ConnectorImage u) where
return a = ConnectorImage $ \_ _ -> return a
ma >>= k = ConnectorImage $ \p0 p1 ->
getConnectorImage ma p0 p1 >>= \ans ->
getConnectorImage (k ans) p0 p1
instance Monad (ConnectorQuery u) where
return a = ConnectorQuery $ \_ _ -> return a
ma >>= k = ConnectorQuery $ \p0 p1 ->
getConnectorQuery ma p0 p1 >>= \ans ->
getConnectorQuery (k ans) p0 p1
instance Monoid a => Monoid (ConnectorImage u a) where
mempty = pure mempty
ma `mappend` mb = ConnectorImage $ \p0 p1 ->
getConnectorImage ma p0 p1
`mappend` getConnectorImage mb p0 p1
instance Monoid a => Monoid (ConnectorQuery u a) where
mempty = pure mempty
ma `mappend` mb = ConnectorQuery $ \p0 p1 ->
getConnectorQuery ma p0 p1
`mappend` getConnectorQuery mb p0 p1
instance DrawingCtxM (ConnectorImage u) where
askDC = ConnectorImage $ \_ _ -> askDC
asksDC fn = ConnectorImage $ \_ _ -> asksDC fn
localize upd ma = ConnectorImage $ \p0 p1 ->
localize upd (getConnectorImage ma p0 p1)
instance DrawingCtxM (ConnectorQuery u) where
askDC = ConnectorQuery $ \_ _ -> askDC
asksDC fn = ConnectorQuery $ \_ _ -> asksDC fn
localize upd ma = ConnectorQuery $ \p0 p1 ->
localize upd (getConnectorQuery ma p0 p1)
instance Decorate ConnectorImage where
decorate ma mz = ConnectorImage $ \p0 p1 ->
getConnectorImage ma p0 p1 `decorate`
getConnectorImage mz p0 p1
elaborate ma f = ConnectorImage $ \p0 p1 ->
getConnectorImage ma p0 p1 `elaborate`
(\a -> getConnectorImage (f a) p0 p1)
obliterate ma mz = ConnectorImage $ \p0 p1 ->
getConnectorImage ma p0 p1 `obliterate`
getConnectorImage mz p0 p1
hyperlink xl ma = ConnectorImage $ \p0 p1 ->
hyperlink xl $ getConnectorImage ma p0 p1
runConnectorImage :: Point2 u -> Point2 u
-> DrawingContext -> ConnectorImage u a
-> PrimW u a
runConnectorImage p0 p1 ctx mf = runImage ctx (getConnectorImage mf p0 p1)
runConnectorQuery :: Point2 u -> Point2 u
-> DrawingContext -> ConnectorQuery u a
-> a
runConnectorQuery p0 p1 ctx mf = runQuery ctx (getConnectorQuery mf p0 p1)
connect :: Point2 u -> Point2 u -> ConnectorImage u a -> Image u a
connect p0 p1 mf = getConnectorImage mf p0 p1
promoteConn :: (Point2 u -> Point2 u -> Image u a) -> ConnectorImage u a
promoteConn fn = ConnectorImage $ \p0 p1 -> fn p0 p1
applyConn :: ConnectorImage u a -> Point2 u -> Point2 u -> Image u a
applyConn mf p0 p1 = getConnectorImage mf p0 p1
qpromoteConn :: (Point2 u -> Point2 u -> Query u a) -> ConnectorQuery u a
qpromoteConn fn = ConnectorQuery $ \p0 p1 -> fn p0 p1
qapplyConn :: ConnectorQuery u a -> Point2 u -> Point2 u -> Query u a
qapplyConn mf p0 p1 = getConnectorQuery mf p0 p1
zapConnectorQuery :: ConnectorQuery u a -> Point2 u -> Point2 u -> Image u a
zapConnectorQuery mq p0 p1 = askDC >>= \ctx ->
let a = runConnectorQuery p0 p1 ctx mq in return a
instance UConvert ConnectorImage where
uconvF = uconvConnectorImageF
uconvZ = uconvConnectorImageZ
uconvConnectorImageF :: (InterpretUnit u, InterpretUnit u1, Functor t)
=> ConnectorImage u (t u) -> ConnectorImage u1 (t u1)
uconvConnectorImageF ma = ConnectorImage $ \p0 p1 ->
getFontSize >>= \sz ->
let p0u = uconvertF sz p0
p1u = uconvertF sz p1
in uconvImageF $ getConnectorImage ma p0u p1u
uconvConnectorImageZ :: (InterpretUnit u, InterpretUnit u1)
=> ConnectorImage u a -> ConnectorImage u1 a
uconvConnectorImageZ ma = ConnectorImage $ \p0 p1 ->
getFontSize >>= \sz ->
let p0u = uconvertF sz p0
p1u = uconvertF sz p1
in uconvImageZ $ getConnectorImage ma p0u p1u
emptyConnectorImage :: Monoid a => ConnectorImage u a
emptyConnectorImage = mempty