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))