module Wumpus.Basic.Graphic.GraphicTypes
(
PointDisplace
, AdvanceVec
, DrawingInfo
, LocDrawingInfo
, LocThetaDrawingInfo
, Graphic
, LocGraphic
, LocThetaGraphic
, ConnectorGraphic
, DGraphic
, DLocGraphic
, DLocThetaGraphic
, DConnectorGraphic
, Image
, LocImage
, LocThetaImage
, ConnectorImage
, DImage
, DLocImage
, DLocThetaImage
, DConnectorImage
, AdvGraphic
, DAdvGraphic
, BoundedGraphic
, DBoundedGraphic
, BoundedLocGraphic
, DBoundedLocGraphic
, advanceH
, advanceV
, runGraphic
, runLocGraphic
, runImage
, runLocImage
, moveLoc
, at
, extrGraphic
, extrLocGraphic
, fontDeltaGraphic
, fontDeltaImage
, xlinkGraphic
, xlinkImage
, intoImage
, intoLocImage
, intoConnectorImage
, intoLocThetaImage
, makeAdvGraphic
) where
import Wumpus.Basic.Graphic.Base
import Wumpus.Basic.Graphic.ContextFunction
import Wumpus.Basic.Graphic.DrawingContext
import Wumpus.Core
type PointDisplace u = Point2 u -> Point2 u
type AdvanceVec u = Vec2 u
type DrawingInfo a = CF a
type LocDrawingInfo u a = LocCF u a
type LocThetaDrawingInfo u a = LocThetaCF u a
type Graphic u = CF (PrimGraphic u)
type LocGraphic u = LocCF u (PrimGraphic u)
type LocThetaGraphic u = LocThetaCF u (PrimGraphic u)
type ConnectorGraphic u = ConnectorCF u (PrimGraphic u)
type DGraphic = Graphic Double
type DLocGraphic = LocGraphic Double
type DLocThetaGraphic = LocThetaGraphic Double
type DConnectorGraphic = ConnectorGraphic Double
type instance DUnit (Graphic u) = u
type Image u a = CF (a, PrimGraphic u)
type LocImage u a = LocCF u (a,PrimGraphic u)
type LocThetaImage u a = LocThetaCF u (a,PrimGraphic u)
type ConnectorImage u a = ConnectorCF u (a, PrimGraphic u)
type DImage a = Image Double a
type DLocImage a = LocImage Double a
type DLocThetaImage a = LocThetaImage Double a
type DConnectorImage a = ConnectorImage Double a
type instance DUnit (Image u a) = u
type AdvGraphic u = LocImage u (Point2 u)
type DAdvGraphic = AdvGraphic Double
type instance DUnit (AdvGraphic u) = u
type BoundedGraphic u = Image u (BoundingBox u)
type DBoundedGraphic = BoundedGraphic Double
type instance DUnit (BoundedGraphic u) = u
type BoundedLocGraphic u = LocImage u (BoundingBox u)
type DBoundedLocGraphic = BoundedLocGraphic Double
type instance DUnit (BoundedLocGraphic u) = u
instance (Real u, Floating u) => Rotate (Graphic u) where
rotate ang = postpro (rotate ang)
instance (Real u, Floating u) => RotateAbout (Graphic u) where
rotateAbout ang pt = postpro (rotateAbout ang pt)
instance Num u => Scale (Graphic u) where
scale sx sy = postpro (scale sx sy)
instance Num u => Translate (Graphic u) where
translate dx dy = postpro (translate dx dy)
instance (Real u, Floating u, Rotate a, DUnit a ~ u) =>
Rotate (Image u a) where
rotate ang = postpro (\(a,b) -> (rotate ang a, rotate ang b))
instance (Real u, Floating u, RotateAbout a, DUnit a ~ u) =>
RotateAbout (Image u a) where
rotateAbout ang pt =
postpro (\(a,b) -> (rotateAbout ang pt a, rotateAbout ang pt b))
instance (Num u, Scale a, DUnit a ~ u) => Scale (Image u a) where
scale sx sy = postpro (\(a,b) -> (scale sx sy a, scale sx sy b))
instance (Num u, Translate a, DUnit a ~ u) => Translate (Image u a) where
translate dx dy = postpro (\(a,b) -> (translate dx dy a, translate dx dy b))
advanceH :: Num u => AdvanceVec u -> u
advanceH (V2 w _) = w
advanceV :: Num u => AdvanceVec u -> u
advanceV (V2 _ h) = h
runGraphic :: DrawingContext -> Graphic u -> PrimGraphic u
runGraphic ctx df = runCF ctx df
runLocGraphic :: DrawingContext -> Point2 u -> LocGraphic u -> PrimGraphic u
runLocGraphic ctx pt df = runCF ctx (unCF1 pt df)
runImage :: DrawingContext -> Image u a -> (a, PrimGraphic u)
runImage ctx img = runCF ctx img
runLocImage :: DrawingContext -> Point2 u -> LocImage u a -> (a, PrimGraphic u)
runLocImage ctx pt img = runCF ctx (unCF1 pt img)
moveLoc :: (Point2 u -> Point2 u) -> LocCF u a -> LocCF u a
moveLoc = prepro1
infixr 1 `at`
at :: CF (Point2 u -> b) -> Point2 u -> CF b
at = situ1
extrGraphic :: Image u a -> Graphic u
extrGraphic = postpro snd
extrLocGraphic :: LocImage u a -> LocGraphic u
extrLocGraphic = postpro1 snd
metamorphPrim :: (Primitive u -> Primitive u) -> PrimGraphic u -> PrimGraphic u
metamorphPrim f = primGraphic . f . getPrimGraphic
fontDeltaGraphic :: Graphic u -> Graphic u
fontDeltaGraphic df =
drawingCtx `bind` \ctx -> postpro (fun $ font_props ctx) df
where
fun attr = metamorphPrim (fontDeltaContext attr)
fontDeltaImage :: Image u a -> Image u a
fontDeltaImage df =
drawingCtx `bind` \ctx -> postpro (fun $ font_props ctx) df
where
fun attr = \(a,prim) -> (a, metamorphPrim (fontDeltaContext attr) prim)
xlinkGraphic :: XLink -> Graphic u -> Graphic u
xlinkGraphic hypl = postpro (metamorphPrim (xlink hypl))
xlinkImage :: XLink -> Image u a -> Image u a
xlinkImage hypl =
postpro (\(a,prim) -> (a, metamorphPrim (xlink hypl) prim))
intoImage :: CF a -> Graphic u -> Image u a
intoImage = postcomb (,)
intoLocImage :: LocCF u a -> LocGraphic u -> LocImage u a
intoLocImage = postcomb1 (,)
intoConnectorImage :: ConnectorCF u a
-> ConnectorGraphic u
-> ConnectorImage u a
intoConnectorImage = postcomb2 (,)
intoLocThetaImage :: LocThetaCF u a
-> LocThetaGraphic u
-> LocThetaImage u a
intoLocThetaImage = postcomb2 (,)
makeAdvGraphic :: PointDisplace u
-> LocGraphic u
-> AdvGraphic u
makeAdvGraphic pf df = postcomb1 (,) (postpro1 pf locPoint) df