[project @ 1999-11-26 10:29:53 by simonpj]
[nofib.git] / real / bspt / EuclidGMS.lhs
1 > {-# OPTIONS -syslib exts #-}
2 > module EuclidGMS
3
4         Module that provides addition Euclidean operations.
5         Operations here are more application based.
6
7 >               (       Region,mkRegion,getRegion,newRegion,
8 >                       Partition,mkPart,getPart,
9 >                       Location(..),location, flip_YORK,
10 >                       bisect,toBack,section,findVertices,
11 >                       inScreen,renderBorder,
12 >                       -- And the following to reduce imports higher up
13 >                       Point(..),Halfspace(..),Line,Face(..),Faces,space,convert,
14 >                       mkFace,mkPoint,drawSegment,triangleArea, Segment)
15
16 > where
17 > import GeomNum
18 > import Euclid (Point(..),Line,Halfspace(..),Face(..),Faces,Segment,
19 >                mkFace,getMyLine,getSegment,drawSegment,mkPoint,
20 >                space,solve,invert,
21 >                triangleArea,mkPolygon,convert)
22 > import Params (renderTop,renderHeight,renderLeft,windowWidth)
23 > import Stdlib (all_YORK,mkset)
24 > import Int( Num(fromInt) )
25
26
27
28 > type Partition = Face 
29
30 > mkPart :: Region -> Line -> Partition
31 > mkPart region line = Fc (section region line) line
32
33 > getPart :: Partition -> Line
34 > getPart p = getMyLine p
35
36
37         The type Region describes a convex sub_space as the space formed
38         by the intersection of the Rear halfspaces of the lines present
39         in the list representation.
40
41 > data Region = Rg [Face]
42
43 > mkRegion :: [Face] -> Region
44 > mkRegion faces = Rg faces
45
46 > getRegion :: Region -> [Face]
47 > getRegion (Rg faces) = faces
48
49 > newRegion :: Region -> Face -> Region
50 > newRegion (Rg faces) face = Rg (face:faces)
51
52
53         Data type Location is an enumeration of the possible relationships
54         between a line and a face.
55
56 > data Location = Coincident | Intersects | ToTheRear | ToTheFore deriving (Eq)
57
58
59         location: This function returns an indicator to the relationship
60                 between the given Line and Face. Relationship
61                 is determined by the halfspace indicated by space. 
62
63 > location :: Line -> Segment -> Location
64 > location line (p1,p2) = case (locale p1,locale p2) of
65 >                               (Coin,Coin)     -> Coincident
66 >                               (Fore,Rear)     -> Intersects
67 >                               (Rear,Fore)     -> Intersects 
68 >                               (Rear,_)        -> ToTheRear 
69 >                               (_,Rear)        -> ToTheRear
70 >                               (_,_)           -> ToTheFore
71 >                       where 
72 >                       locale = space line
73
74
75         bisect : Returns a pair of faces formed by splitting the given face 
76                  at the point where the line given intersects the face.
77                  The faces are returned as a pair such that the first
78                  element is the section of the original face that lies
79                  in the Rear halfspace of the line given.
80                  Note that it is assumed that the line does indeed intersect 
81                  the face.
82
83 > bisect :: Face -> Line -> (Face,Face)
84 > bisect (Fc (pt1,pt2) line1) line2 = 
85 >               if toBack pt1 line2 then (face1,face2) else (face2,face1) 
86 >               where
87 >               face1 = Fc (pt1,pti) line1
88 >               face2 = Fc (pti,pt2) line1
89 >               pti = solve line1 line2 
90
91
92         flip_YORK : reverse the orientation of a face
93
94 > flip_YORK :: Face -> Face
95 > flip_YORK (Fc (a,b) l) = Fc (b,a) (invert l)
96
97         toBack: Predicate to test that a point does not lie in the
98                  Fore half space of the line given.
99
100 > toBack :: Point -> Line -> Bool
101 > toBack pt line = space line pt /= Fore
102
103
104         inScreen: Predicate to test that a point lies somewhere on the rendering
105                         screen. Note that the rendering screen in implicitly 
106                         defined (by parameters in Params.hs).
107
108 > inScreen :: Point -> Bool
109 > inScreen (Pt x y) = xCoordInRange x && yCoordInRange y
110
111
112         renderBorder: Describes the Rendering screen by the equations of
113                         its borderlines.
114
115 > renderBorder :: Region
116 > renderBorder = mkRegion (mkPolygon [  Pt left top,
117 >                                       Pt right top,
118 >                                       Pt right bottom,
119 >                                       Pt left bottom])
120 >                where
121 >                top = fromIntegral renderTop
122 >                bottom = fromIntegral renderHeight
123 >                left = fromIntegral renderLeft
124 >                right = fromIntegral windowWidth
125
126
127
128   
129         section: Generate the segment of a line that lies in the 
130                         convex region given.  
131
132 > section :: Region -> Line -> Segment
133 > section region line = f x
134 >       where
135 >       x = [x| x <- map (solve line.getPart) (getRegion region), inRegion region x]
136 >       f [pta,ptb] = (pta,ptb)
137 >       f a = f (mkset a)
138
139
140
141  
142         findVertices - obtains the list of vertices bounding a region
143                 The list is genereated by observation that the vertices will
144                 be a subset of those points stored in segments of regions Faces
145                 The list is unordered
146
147 > findVertices :: Region -> [Point]
148 > findVertices region = [pts | pts <- xs ++ ys, inRegion region pts]
149 >       where
150 >       xs = [x | (x,_) <- segments]
151 >       ys = [y | (_,y) <- segments] 
152 >       segments = map getSegment (getRegion region)
153
154
155
156         inRegion - predicate - true if the point given is in the region
157
158 > inRegion :: Region -> Point -> Bool
159 > inRegion region pt = all_YORK (map (toBack pt.getPart) (getRegion region))