{-# OPTIONS -Wall #-}---------------------------------------------------------------------------------- |-- Module : Wumpus.Basic.Graphic.PrimGraphic-- Copyright : (c) Stephen Tetley 2010-- License : BSD3---- Maintainer : stephen.tetley@gmail.com-- Stability : highly unstable-- Portability : GHC ---- Elementary functions for the Graphic and LocGraphic types.---- The functions here are generally analogeous to the Picture -- API in @Wumpus.Core@, but here they exploit the implicit -- @DrawingContext@.----------------------------------------------------------------------------------moduleWumpus.Basic.Graphic.PrimGraphic(drawGraphic,drawGraphicU,openStroke,closedStroke,filledPath,borderedPath,textline,strokedEllipse,filledEllipse,borderedEllipse,supplyPt,localDrawingContext,localPoint,displace,straightLine,strokedRectangle,filledRectangle,borderedRectangle,strokedCircle,filledCircle,borderedCircle,strokedDisk,filledDisk,borderedDisk)whereimportWumpus.Basic.Graphic.DrawingContextimportWumpus.Basic.Graphic.BaseTypesimportWumpus.Basic.Utils.HListimportWumpus.Core-- package: wumpus-coreimportData.AffineSpace-- package: vector-spaceimportControl.ApplicativedrawGraphic::(Realu,Floatingu,FromPtSizeu)=>DrawingContext->Graphicu->Maybe(Pictureu)drawGraphicctxgf=post$runGraphicctxgfwhereposthf=letxs=toListHhfinifnullxsthenNothingelseJust(framexs)drawGraphicU::(Realu,Floatingu,FromPtSizeu)=>DrawingContext->Graphicu->PictureudrawGraphicUctxgf=post$runGraphicctxgfwhereposthf=letxs=toListHhfinifnullxsthenerrKelseframexserrK=error"drawGraphicU - empty Graphic."-- having the same names is actually not so useful...openStroke::Numu=>PrimPathu->GraphicuopenStrokepp=(\rgbattr->wrapH$ostrokergbattrpp)<$>asksObjprimary_colour<*>asksObjstroke_propsclosedStroke::Numu=>PrimPathu->GraphicuclosedStrokepp=(\rgbattr->wrapH$cstrokergbattrpp)<$>asksObjprimary_colour<*>asksObjstroke_propsfilledPath::Numu=>PrimPathu->GraphicufilledPathpp=(\rgb->wrapH$fillrgbpp)<$>asksObjsecondary_colourborderedPath::Numu=>PrimPathu->GraphicuborderedPathpp=(\frgbattrsrgb->wrapH$fillStrokefrgbattrsrgbpp)<$>asksObjsecondary_colour<*>asksObjstroke_props<*>asksObjprimary_colourtextline::Numu=>String->LocGraphicutextlinessbaseline_left=(\(rgb,attr)->wrapH$textlabelrgbattrssbaseline_left)<$>asksObjtextAttrstrokedEllipse::Numu=>u->u->LocGraphicustrokedEllipsehwhhpt=(\rgbattr->wrapH$strokeEllipsergbattrhwhhpt)<$>asksObjprimary_colour<*>asksObjstroke_propsfilledEllipse::Numu=>u->u->LocGraphicufilledEllipsehwhhpt=(\rgb->wrapH$fillEllipsergbhwhhpt)<$>asksObjsecondary_colourborderedEllipse::Numu=>u->u->LocGraphicuborderedEllipsehwhhpt=(\frgbattrsrgb->wrapH$fillStrokeEllipsefrgbattrsrgbhwhhpt)<$>asksObjsecondary_colour<*>asksObjstroke_props<*>asksObjprimary_colour---------------------------------------------------------------------------------- | Supplying a point to a 'CFGraphic' takes it to a regular -- 'Graphic'.--supplyPt::Point2u->LocGraphicu->GraphicusupplyPtptgf=gfptdisplace::Numu=>u->u->Point2u->Point2udisplacedxdy(P2xy)=P2(x+dx)(y+dy)localDrawingContext::(DrawingContext->DrawingContext)->LocGraphicu->LocGraphiculocalDrawingContextupdimg=\pt->localCtxObjupd(imgpt)localPoint::(Point2u->Point2u)->LocGraphicu->LocGraphiculocalPointupdgf=\pt->gf(updpt)--------------------------------------------------------------------------------straightLine::Fractionalu=>Vec2u->LocGraphicustraightLinev=\pt->openStroke$pathpt[lineTo$pt.+^v]-- | Supplied point is /bottom-left/.--rectangle::Numu=>u->u->Point2u->PrimPathurectanglewhbl=pathbl[lineTobr,lineTotr,lineTotl]wherebr=bl.+^hvecwtr=br.+^vvechtl=bl.+^vvech-- | Supplied point is /bottom left/.--strokedRectangle::Fractionalu=>u->u->LocGraphicustrokedRectanglewh=closedStroke.rectanglewh-- | Supplied point is /bottom left/.--filledRectangle::Fractionalu=>u->u->LocGraphicufilledRectanglewh=filledPath.rectanglewh-- | Supplied point is /bottom left/.--borderedRectangle::Fractionalu=>u->u->LocGraphicuborderedRectanglewh=borderedPath.rectanglewh---------------------------------------------------------------------------------- | Supplied point is center. Circle is drawn with Bezier -- curves. --strokedCircle::Floatingu=>Int->u->LocGraphicustrokedCirclenr=closedStroke.curvedPath.bezierCirclenr-- | Supplied point is center. Circle is drawn with Bezier -- curves. --filledCircle::Floatingu=>Int->u->LocGraphicufilledCirclenr=filledPath.curvedPath.bezierCirclenr-- | Supplied point is center. Circle is drawn with Bezier -- curves. --borderedCircle::Floatingu=>Int->u->LocGraphicuborderedCirclenr=borderedPath.curvedPath.bezierCirclenr-- | 'disk' is drawn with Wumpus-Core\'s @ellipse@ primitive.---- This is a efficient representation of circles using -- PostScript\'s @arc@ or SVG\'s @circle@ in the generated -- output. However, stroked-circles do not draw well after -- non-uniform scaling - the line width is scaled as well as -- the shape.---- For stroked circles that can be scaled, consider making the -- circle from Bezier curves.--strokedDisk::Numu=>u->LocGraphicustrokedDiskradius=strokedEllipseradiusradiusfilledDisk::Numu=>u->LocGraphicufilledDiskradius=filledEllipseradiusradiusborderedDisk::Numu=>u->LocGraphicuborderedDiskradius=borderedEllipseradiusradius