module Wumpus.Basic.Graphic.Drawing
(
Drawing
, DDrawing
, runDrawing
, runDrawingU
, drawTracing
, clipDrawing
, modifyDrawing
, drawingConcat
) where
import Wumpus.Basic.Graphic.ContextFunction
import Wumpus.Basic.Graphic.DrawingContext
import Wumpus.Basic.Graphic.TraceDrawing
import Wumpus.Core
newtype Drawing u = Drawing { getDrawing :: CF (Maybe (Picture u)) }
type DDrawing = Drawing Double
type instance DUnit (Drawing u) = u
runDrawing :: DrawingContext -> Drawing u -> Maybe (Picture u)
runDrawing ctx drw = runCF ctx (getDrawing drw)
runDrawingU :: DrawingContext -> Drawing u -> Picture u
runDrawingU ctx df = maybe fk id $ runDrawing ctx df
where
fk = error "runDrawingU - empty Drawing."
drawTracing :: (Real u, Floating u, FromPtSize u)
=> TraceDrawing u a -> Drawing u
drawTracing mf = Drawing $
drawingCtx >>= \ctx -> return (liftToPictureMb (execTraceDrawing ctx mf) )
clipDrawing :: (Num u, Ord u) => (PrimPath u) -> Drawing u -> Drawing u
clipDrawing cpath = modifyDrawing (clip cpath)
modifyDrawing :: (Picture u -> Picture u) -> Drawing u -> Drawing u
modifyDrawing pf = Drawing . postpro (fmap pf) . getDrawing
instance (Real u, Floating u) => Rotate (Drawing u) where
rotate ang = modifyDrawing (rotate ang)
instance (Real u, Floating u) => RotateAbout (Drawing u) where
rotateAbout r pt = modifyDrawing (rotateAbout r pt)
instance (Num u, Ord u) => Scale (Drawing u) where
scale sx sy = modifyDrawing (scale sx sy)
instance (Num u, Ord u) => Translate (Drawing u) where
translate dx dy = modifyDrawing (translate dx dy)
drawingConcat :: (Picture u -> Picture u -> Picture u)
-> Drawing u -> Drawing u -> Drawing u
drawingConcat op a b = Drawing $ mbpostcomb op (getDrawing a) (getDrawing b)
mbpostcomb :: (a -> a -> a) -> CF (Maybe a) -> CF (Maybe a) -> CF (Maybe a)
mbpostcomb op = postcomb fn
where
fn (Just a) (Just b) = Just $ a `op` b
fn a Nothing = a
fn Nothing b = b