moduleSifflet.Data.Geometry(Position(..),positionDelta,positionDistance,positionDistanceSquared,positionCloseEnough,Circle(..),pointInCircle,Size(..),BBox(..),bbX,bbY,bbWidth,bbSetWidth,bbHeight,bbPosition,bbSize,bbToRect,bbFromRect,bbCenter,bbLeft,bbXCenter,bbRight,bbTop,bbYCenter,bbBottom,bbMerge,bbMergeList,pointInBB,Widen(widen),Translate(..))whereimportData.TreeasTimportGraphics.UI.Gtk(Rectangle(Rectangle))-- A Position may be interpreted either absolutely, as a point (x, y);-- or relatively, as an offset (dx, dy)dataPosition=Position{posX::Double,posY::Double}-- x, yderiving(Eq,Read,Show)positionDelta::Position->Position->(Double,Double)positionDelta(Positionx1y1)(Positionx2y2)=(x2-x1,y2-y1)positionDistance::Position->Position->DoublepositionDistancep1p2=sqrt(positionDistanceSquaredp1p2)positionDistanceSquared::Position->Position->DoublepositionDistanceSquared(Positionx1y1)(Positionx2y2)=(x1-x2)**2+(y1-y2)**2positionCloseEnough::Position->Position->Double->BoolpositionCloseEnoughp1p2radius=-- Essentially asks if p1 and p2 are nearly intersecting,-- i.e., if p1 is within a circle with center p2 and the given radiuspositionDistanceSquaredp1p2<=radius**2dataCircle=Circle{circleCenter::Position,circleRadius::Double}deriving(Eq,Read,Show)pointInCircle::Position->Circle->BoolpointInCirclepoint(Circlecenterradius)=positionCloseEnoughpointcenterradiusdataSize=Size{sizeW::Double,sizeH::Double}-- width, heightderiving(Eq,Read,Show)-- | BBox x y width height; (x, y) is the top left cornerdataBBox=BBoxDoubleDoubleDoubleDoublederiving(Eq,Read,Show)-- | BBox accessors and utilitiesbbX,bbY,bbWidth,bbHeight::BBox->DoublebbX(BBoxx_y_w_h)=xbbY(BBox_xy_w_h)=ybbWidth(BBox_x_yw_h)=wbbHeight(BBox_x_y_wh)=hbbPosition::BBox->PositionbbPosition(BBoxxy_w_h)=PositionxybbSize::BBox->SizebbSize(BBox_x_ywh)=SizewhbbCenter::BBox->PositionbbCenter(BBoxxywh)=Position(x+w/2)(y+h/2)bbSetWidth::BBox->Double->BBoxbbSetWidth(BBoxxy_wh)nwidth=BBoxxynwidthhbbLeft,bbXCenter,bbRight::BBox->DoublebbLeft=bbXbbXCenter(BBoxx_yw_h)=x+w/2bbRight(BBoxx_yw_h)=x+wbbTop,bbYCenter,bbBottom::BBox->DoublebbTop=bbYbbYCenter(BBox_xy_wh)=y+h/2bbBottom(BBox_xy_wh)=y+hbbToRect::BBox->RectanglebbToRect(BBoxxywh)=Rectangle(roundx)(roundy)(roundw)(roundh)bbFromRect::Rectangle->BBoxbbFromRect(Rectanglexywh)=BBox(fromIntegralx)(fromIntegraly)(fromIntegralw)(fromIntegralh)-- | Form a new BBox which encloses two bboxesbbMerge::BBox->BBox->BBoxbbMergebb1bb2=letf1!f2=f1(f2bb1)(f2bb2)bottom=max!bbBottom-- i.e., max (bbBottom bb1) (bbBottom bb2)top=min!bbTopleft=min!bbLeftright=max!bbRightinBBoxlefttop(right-left)(bottom-top)bbMergeList::[BBox]->BBoxbbMergeList[]=error"bbMergeList: empty list"bbMergeList(b:bs)=foldlbbMergebbs-- Test whether a point (e.g., from mouse click) is within a-- bounding boxpointInBB::Position->BBox->BoolpointInBB(Positionxy)(BBoxx1y1wh)=x>=x1&&x<=x1+w&&y>=y1&&y<=y1+hclassWidenawhere-- | Make an object have at least a specified minimum width;-- does nothing if it's already at least that widewiden::a->Double->ainstanceWidenBBoxwherewidenbb@(BBoxxywh)minWidth=ifw>=minWidththenbbelseBBoxxyminWidthh-- | A Translate is a thing that can be repositioned by-- delta x and delta yclassTranslateawheretranslate::Double-- ^ delta X->Double-- ^ delta Y->a-- ^ thing in old position->a-- ^ thing in new positioninstance(Translatee)=>Translate[e]wheretranslatedxdy=map(translatedxdy)instance(Translatee)=>Translate(Treee)wheretranslatedxdyt=T.Node(translatedxdy(rootLabelt))(translatedxdy(subForestt))instanceTranslateBBoxwheretranslatedxdy(BBoxxywh)=BBox(x+dx)(y+dy)whinstanceTranslatePositionwheretranslatedxdy(Positionxy)=Position(x+dx)(y+dy)instanceTranslateCirclewheretranslatedxdy(Circlecenterradius)=Circle(translatedxdycenter)radius