{-# OPTIONS -Wall #-}---------------------------------------------------------------------------------- |-- Module : Wumpus.Basic.Kernel.Objects.Bounded-- Copyright : (c) Stephen Tetley 2010-- License : BSD3---- Maintainer : stephen.tetley@gmail.com-- Stability : highly unstable-- Portability : GHC ---- Bounded versions of Graphic and LocGraphic.---- Bounded meaning they are actually Images that return the -- bounding box of the Graphic.----------------------------------------------------------------------------------moduleWumpus.Basic.Kernel.Objects.Bounded(-- * Bounded graphic / loc graphicBoundedGraphic,DBoundedGraphic,BoundedLocGraphic,DBoundedLocGraphic,BoundedLocThetaGraphic,DBoundedLocThetaGraphic,emptyBoundedLocGraphic,emptyBoundedLocThetaGraphic,centerOrthoBBox,illustrateBoundedGraphic,illustrateBoundedLocGraphic,illustrateBoundedLocThetaGraphic,bbrectangle)whereimportWumpus.Basic.Kernel.Base.BaseDefsimportWumpus.Basic.Kernel.Base.ContextFunimportWumpus.Basic.Kernel.Base.DrawingContextimportWumpus.Basic.Kernel.Base.UpdateDCimportWumpus.Basic.Kernel.Objects.BaseObjectsimportWumpus.Basic.Kernel.Objects.DrawingPrimitivesimportWumpus.Basic.Kernel.Objects.GraphicimportWumpus.Core-- package: wumpus-coreimportControl.Applicative---------------------------------------------------------------------------------- | Graphic with a bounding box.-- typeBoundedGraphicu=Imageu(BoundingBoxu)typeDBoundedGraphic=BoundedGraphicDouble-- | LocGraphic with a bounding box.--typeBoundedLocGraphicu=LocImageu(BoundingBoxu)typeDBoundedLocGraphic=BoundedLocGraphicDouble-- | LocThetaGraphic with a bounding box.---- Note the size of bounding box for the \"same\" shape will vary -- according to the rotation. A bounding box is always -- orthonormal (?) to the x- and y-axes.--typeBoundedLocThetaGraphicu=LocThetaImageu(BoundingBoxu)typeDBoundedLocThetaGraphic=BoundedLocThetaGraphicDouble-- | 'centerOrthoBBox' : @ theta * bbox -> BBox @-- -- Rotate a bounding box by @theta@ about its center. Take the -- new bounding box.---- Remember that bounding boxes are always orthonormal rectangles,-- so the dimensions as well as the positions may change under -- rotation. --centerOrthoBBox::(Realu,Floatingu)=>Radian->BoundingBoxu->BoundingBoxucenterOrthoBBoxthetabb=traceBoundary$map(rotateAboutthetactr)pswhereps=boundaryCornerListbbctr=boundaryCenterbb-- | 'emptyBoundedLocGraphic' : @ BoundedLocGraphic @---- Build an empty 'BoundedLocGraphic'.-- -- The 'emptyBoundedLocGraphic' is treated as a /null primitive/ -- by @Wumpus-Core@ and is not drawn, although it does generate-- the minimum bounding box with both the bottom-left and -- upper-right corners at the implicit start point.--emptyBoundedLocGraphic::Numu=>BoundedLocGraphicuemptyBoundedLocGraphic=intoLocImagefnemptyLocGraphicwherefn=promoteR1$\pt->pure(BBoxptpt)-- | 'emptyBoundedLocThetaGraphic' : @ BoundedLocThetaGraphic @---- Build an empty 'BoundedLocThetaGraphic'.-- -- The 'emptyBoundedLocThetaGraphic' is treated as a /null primitive/ -- by @Wumpus-Core@ and is not drawn, although it does generate-- the minimum bounding box with both the bottom-left and -- upper-right corners at the implicit start point (the implicit -- inclination can be ignored).--emptyBoundedLocThetaGraphic::Numu=>BoundedLocThetaGraphicuemptyBoundedLocThetaGraphic=lift1R2emptyBoundedLocGraphic---------------------------------------------------------------------------------- -- This is a common pattern so needs a name...illustrateBoundedGraphic::Fractionalu=>BoundedGraphicu->BoundedGraphicuillustrateBoundedGraphicmf=mf>>=\(bb,g1)->bbrectanglebb>>=\(_,g0)->return(bb,g0`oplus`g1)illustrateBoundedLocGraphic::Fractionalu=>BoundedLocGraphicu->BoundedLocGraphicuillustrateBoundedLocGraphicmf=promoteR1$\pt->illustrateBoundedGraphic$apply1R1mfptillustrateBoundedLocThetaGraphic::Fractionalu=>BoundedLocThetaGraphicu->BoundedLocThetaGraphicuillustrateBoundedLocThetaGraphicmf=promoteR2$\pttheta->illustrateBoundedGraphic$apply2R2mfpttheta-- bbrectangle::Fractionalu=>BoundingBoxu->Graphicubbrectangle(BBoxp1@(P2llxlly)p2@(P2urxury))|llx==urx&&lly==ury=emptyLocGraphic`at`p1|otherwise=localizedrawing_props$rect1`oplus`crosswheredrawing_props=capRound.dashPattern(Dash0[(1,2)])rect1=strokedRectangle(urx-llx)(ury-lly)`at`p1cross=straightLineGraphicp1p2`oplus`straightLineGraphic(P2llxury)(P2urxlly)