1   module Euclid
    2 
    3 
    4 
    5 
    6 
    7         (       Point(..),Halfspace(..),Line,
    8                 Face(..),mkFace,getSegment,getMyLine,
    9                 Faces,Segment,eqn,solve,space,
   10                 convert,invert,triangleArea,
   11                 mkPoint,mkPolygon,drawSegment)
   12 
   13   where
   14   import Stdlib (map2,splitAt_YORK,pair,between,numval)
   15   import GeomNum
   16   import MGRlib (line)
   17   import Params (mouseDispx,mouseDispy,gap)
   18   import Char(isDigit)--1.3
   19 
   20 
   21 
   22 
   23 
   24   data Line = Ln Numb Numb Numb deriving (Show{-was:Text-},Eq)
   25 
   26 
   27 
   28 
   29 
   30   data Point = Pt Numb Numb deriving (Eq,Show{-was:Text-})
   31 
   32 
   33 
   34 
   35 
   36   data Halfspace = Fore | Coin | Rear deriving (Eq,Show{-was:Text-})
   37 
   38 
   39 
   40 
   41   data Face = Fc Segment Line deriving (Eq,Show{-was:Text-})
   42 
   43 
   44 
   45 
   46 
   47   type Segment = (Point,Point)
   48 
   49 
   50 
   51   type Faces = [Face]
   52 
   53 
   54 
   55   mkFace :: Segment -> Face
   56   mkFace (x,y) = Fc (x,y) (convert x y)
   57 
   58   getSegment :: Face -> Segment
   59   getSegment (Fc segment _) = segment
   60 
   61   getMyLine :: Face -> Line
   62   getMyLine (Fc _ line) = line
   63 
   64 
   65 
   66 
   67 
   68   space :: Line -> Point -> Halfspace
   69   space line pt = if zerO val then Coin else
   70                   if positive val then Fore
   71                   else Rear
   72                         where val = eqn line pt
   73 
   74 
   75 
   76   eqn :: Line -> Point -> Numb
   77   eqn (Ln a b c) (Pt x y) = a*x + b*y + c
   78 
   79 
   80 
   81 
   82 
   83 
   84 
   85 
   86 
   87   convert :: Point -> Point -> Line
   88   convert (Pt x1 y1) (Pt x2 y2) = Ln (diffy) (-diffx) (diffx*y1-diffy*x1)
   89                                   where 
   90                                         dy=y2-y1
   91                                         dx=x2-x1
   92                                         (diffx,diffy) = ratio dx dy
   93 
   94 
   95 
   96 
   97 
   98   invert :: Line -> Line
   99   invert (Ln a b c) = (Ln (negate a) (negate b) (negate c))
  100 
  101 
  102 
  103 
  104 
  105 
  106   solve :: Line -> Line -> Point
  107   solve (Ln a b c) (Ln d e f) | zerO ((a*e)-(b*d)) = (Pt 0 0)
  108                             | not (zerO a)      = solveAux (Ln a b (-c)) (Ln d e (-f))
  109                             | otherwise         = solveAux (Ln d e (-f)) (Ln a b (-c))
  110 
  111   solveAux :: Line -> Line -> Point
  112   solveAux (Ln a b c) (Ln 0 e f) = (Pt x y) 
  113                                         where y = f/e
  114                                               x = (c-b*y)/a
  115 
  116   solveAux (Ln a b c) (Ln d e f) = solveAux (Ln a b c) (Ln 0 (e-b*g) (f-c*g))
  117                                         where g = d/a   
  118 
  119 
  120 
  121 
  122 
  123   triangleArea :: [Point] -> Numb
  124   triangleArea [p1,p2,p3] = abs ((1/2) * (x1*y2-y1*x2))
  125                                 where 
  126                                 (Pt x1 y1) = minus p2
  127                                 (Pt x2 y2) = minus p3
  128                                 minus x = minusPoint p1 x
  129 
  130 
  131 
  132   minusPoint :: Point -> Point -> Point
  133   minusPoint (Pt x y) (Pt u v) = Pt (u-x) (v-y)
  134 
  135 
  136 
  137 
  138 
  139 
  140 
  141 
  142 
  143   mkPoint :: String -> Point
  144   mkPoint l = if and (map isDigit (a++b)) then
  145                    Pt (fromIntegral (numval a-mouseDispx))
  146                                 (fromIntegral (numval b-mouseDispy))
  147                   else (Pt 0 0) -- Null Point
  148                                           where
  149                                           (a,b)= splitAt_YORK gap l
  150 
  151 
  152 
  153 
  154 
  155 
  156 
  157   mkPolygon :: [Point] -> Faces 
  158   mkPolygon [] = []
  159   mkPolygon (a:l) = map2 f (a:l) (l++[a])
  160                         where f x y = mkFace (x,y)
  161 
  162 
  163 
  164 
  165 
  166 
  167 
  168 
  169 
  170   drawSegment :: Segment -> String
  171   drawSegment ((Pt x1 y1),(Pt x2 y2)) = line (map rnd [x1,y1,x2,y2])
  172 
  173 
  174 
  175 
  176 
  177 
  178   {- UNUSED: (an illegal name, too)
  179   inRange :: [Integer] -> Point -> Bool
  180   inRange [x,y,w,h] (Pt a b) = between (fromInteger x) (fromInteger w) a
  181                                           && between (fromInteger y) (fromInteger h) b
  182   -}