1 module EuclidGMS 2 3 4 5 6 ( Region,mkRegion,getRegion,newRegion, 7 Partition,mkPart,getPart, 8 Location(..),location, flip_YORK, 9 bisect,toBack,section,findVertices, 10 inScreen,renderBorder, 11 -- And the following to reduce imports higher up 12 Point(..),Halfspace(..),Line,Face(..),Faces,space,convert, 13 mkFace,mkPoint,drawSegment,triangleArea, Segment) 14 15 where 16 import GeomNum 17 import Euclid (Point(..),Line,Halfspace(..),Face(..),Faces,Segment, 18 mkFace,getMyLine,getSegment,drawSegment,mkPoint, 19 space,solve,invert, 20 triangleArea,mkPolygon,convert) 21 import Params (renderTop,renderHeight,renderLeft,windowWidth) 22 import Stdlib (all_YORK,mkset) 23 24 25 26 type Partition = Face 27 28 mkPart :: Region -> Line -> Partition 29 mkPart region line = Fc (section region line) line 30 31 getPart :: Partition -> Line 32 getPart p = getMyLine p 33 34 35 36 37 38 39 data Region = Rg [Face] 40 41 mkRegion :: [Face] -> Region 42 mkRegion faces = Rg faces 43 44 getRegion :: Region -> [Face] 45 getRegion (Rg faces) = faces 46 47 newRegion :: Region -> Face -> Region 48 newRegion (Rg faces) face = Rg (face:faces) 49 50 51 52 53 54 data Location = Coincident | Intersects | ToTheRear | ToTheFore deriving (Eq) 55 56 57 58 59 60 61 location :: Line -> Segment -> Location 62 location line (p1,p2) = case (locale p1,locale p2) of 63 (Coin,Coin) -> Coincident 64 (Fore,Rear) -> Intersects 65 (Rear,Fore) -> Intersects 66 (Rear,_) -> ToTheRear 67 (_,Rear) -> ToTheRear 68 (_,_) -> ToTheFore 69 where 70 locale = space line 71 72 73 74 75 76 77 78 79 80 81 bisect :: Face -> Line -> (Face,Face) 82 bisect (Fc (pt1,pt2) line1) line2 = 83 if toBack pt1 line2 then (face1,face2) else (face2,face1) 84 where 85 face1 = Fc (pt1,pti) line1 86 face2 = Fc (pti,pt2) line1 87 pti = solve line1 line2 88 89 90 91 92 flip_YORK :: Face -> Face 93 flip_YORK (Fc (a,b) l) = Fc (b,a) (invert l) 94 95 96 97 98 toBack :: Point -> Line -> Bool 99 toBack pt line = space line pt /= Fore 100 101 102 103 104 105 106 inScreen :: Point -> Bool 107 inScreen (Pt x y) = xCoordInRange x && yCoordInRange y 108 109 110 111 112 113 renderBorder :: Region 114 renderBorder = mkRegion (mkPolygon [ Pt left top, 115 Pt right top, 116 Pt right bottom, 117 Pt left bottom]) 118 where 119 top = fromIntegral renderTop 120 bottom = fromIntegral renderHeight 121 left = fromIntegral renderLeft 122 right = fromIntegral windowWidth 123 124 125 126 127 128 129 130 section :: Region -> Line -> Segment 131 section region line = f x 132 where 133 x = [x| x <- map (solve line.getPart) (getRegion region), inRegion region x] 134 f [pta,ptb] = (pta,ptb) 135 f a = f (mkset a) 136 137 138 139 140 141 142 143 144 145 findVertices :: Region -> [Point] 146 findVertices region = [pts | pts <- xs ++ ys, inRegion region pts] 147 where 148 xs = [x | (x,_) <- segments] 149 ys = [y | (_,y) <- segments] 150 segments = map getSegment (getRegion region) 151 152 153 154 155 156 inRegion :: Region -> Point -> Bool 157 inRegion region pt = all_YORK (map (toBack pt.getPart) (getRegion region))