> module EuclidGMS
Module that provides addition Euclidean operations.
Operations here are more application based.
> ( Region,mkRegion,getRegion,newRegion,
> Partition,mkPart,getPart,
> Location(..),location, flip_YORK,
> bisect,toBack,section,findVertices,
> inScreen,renderBorder,
> -- And the following to reduce imports higher up
> Point(..),Halfspace(..),Line,Face(..),Faces,space,convert,
> mkFace,mkPoint,drawSegment,triangleArea, Segment)
> where
> import GeomNum
> import Euclid (Point(..),Line,Halfspace(..),Face(..),Faces,Segment,
> mkFace,getMyLine,getSegment,drawSegment,mkPoint,
> space,solve,invert,
> triangleArea,mkPolygon,convert)
> import Params (renderTop,renderHeight,renderLeft,windowWidth)
> import Stdlib (all_YORK,mkset)
> type Partition = Face
> mkPart :: Region -> Line -> Partition
> mkPart region line = Fc (section region line) line
> getPart :: Partition -> Line
> getPart p = getMyLine p
The type Region describes a convex sub_space as the space formed
by the intersection of the Rear halfspaces of the lines present
in the list representation.
> data Region = Rg [Face]
> mkRegion :: [Face] -> Region
> mkRegion faces = Rg faces
> getRegion :: Region -> [Face]
> getRegion (Rg faces) = faces
> newRegion :: Region -> Face -> Region
> newRegion (Rg faces) face = Rg (face:faces)
Data type Location is an enumeration of the possible relationships
between a line and a face.
> data Location = Coincident | Intersects | ToTheRear | ToTheFore deriving (Eq)
location: This function returns an indicator to the relationship
between the given Line and Face. Relationship
is determined by the halfspace indicated by space.
> location :: Line -> Segment -> Location
> location line (p1,p2) = case (locale p1,locale p2) of
> (Coin,Coin) -> Coincident
> (Fore,Rear) -> Intersects
> (Rear,Fore) -> Intersects
> (Rear,_) -> ToTheRear
> (_,Rear) -> ToTheRear
> (_,_) -> ToTheFore
> where
> locale = space line
bisect : Returns a pair of faces formed by splitting the given face
at the point where the line given intersects the face.
The faces are returned as a pair such that the first
element is the section of the original face that lies
in the Rear halfspace of the line given.
Note that it is assumed that the line does indeed intersect
the face.
> bisect :: Face -> Line -> (Face,Face)
> bisect (Fc (pt1,pt2) line1) line2 =
> if toBack pt1 line2 then (face1,face2) else (face2,face1)
> where
> face1 = Fc (pt1,pti) line1
> face2 = Fc (pti,pt2) line1
> pti = solve line1 line2
flip_YORK : reverse the orientation of a face
> flip_YORK :: Face -> Face
> flip_YORK (Fc (a,b) l) = Fc (b,a) (invert l)
toBack: Predicate to test that a point does not lie in the
Fore half space of the line given.
> toBack :: Point -> Line -> Bool
> toBack pt line = space line pt /= Fore
inScreen: Predicate to test that a point lies somewhere on the rendering
screen. Note that the rendering screen in implicitly
defined (by parameters in Params.hs).
> inScreen :: Point -> Bool
> inScreen (Pt x y) = xCoordInRange x && yCoordInRange y
renderBorder: Describes the Rendering screen by the equations of
its borderlines.
> renderBorder :: Region
> renderBorder = mkRegion (mkPolygon [ Pt left top,
> Pt right top,
> Pt right bottom,
> Pt left bottom])
> where
> top = fromIntegral renderTop
> bottom = fromIntegral renderHeight
> left = fromIntegral renderLeft
> right = fromIntegral windowWidth
section: Generate the segment of a line that lies in the
convex region given.
> section :: Region -> Line -> Segment
> section region line = f x
> where
> x = [x| x <- map (solve line.getPart) (getRegion region), inRegion region x]
> f [pta,ptb] = (pta,ptb)
> f a = f (mkset a)
findVertices - obtains the list of vertices bounding a region
The list is genereated by observation that the vertices will
be a subset of those points stored in segments of regions Faces
The list is unordered
> findVertices :: Region -> [Point]
> findVertices region = [pts | pts <- xs ++ ys, inRegion region pts]
> where
> xs = [x | (x,_) <- segments]
> ys = [y | (_,y) <- segments]
> segments = map getSegment (getRegion region)
inRegion - predicate - true if the point given is in the region
> inRegion :: Region -> Point -> Bool
> inRegion region pt = all_YORK (map (toBack pt.getPart) (getRegion region))
|