1   module Interface
    2 
    3 
    4 
    5         (modeller)
    6 
    7   where
    8 
    9   import Init (indicate,labelClassify,labelDefinePoly,unlabelButtons,clearRender,
   10                 clearText,toNoTextRegion,toTextRegion,reset,clearTree)
   11   import Params (Command(..))
   12   import Stdlib (mapcat)
   13   import Euclid (Point(..),mkPolygon,Face,Faces)
   14   import BSPT (BSPT,Status(..),classifyPoint,buildBSPT,area)
   15   import Render (render,drawBSPT,partitionedDraw,drawFaces,prettyPrintBSPT)
   16   import GeomNum 
   17   import Merge (union,intersection,subtract_YORK,complement)
   18   import Interpret (Operation,Operations)
   19 
   20 
   21 
   22 
   23 
   24 
   25 
   26 
   27 
   28 
   29 
   30 
   31 
   32 
   33 
   34 
   35 
   36 
   37 
   38 
   39   modeller :: BSPT -> Operations -> String      
   40   modeller current ((Quit,_):_) = reset
   41   modeller current (operation@(op,_):more) =
   42         indicate op actions ++ modeller newstate more
   43         where 
   44         (actions,newstate) = perform current operation
   45 
   46   perform :: BSPT -> Operation -> ([String],BSPT)
   47   perform current (Partition,_) 
   48         = ([clearRender, partitionedDraw current],
   49                 current)
   50 
   51 
   52 
   53 
   54   perform current (Render,_)
   55         = ([render current], current)
   56 
   57 
   58 
   59 
   60 
   61 
   62 
   63 
   64 
   65 
   66   perform current (Classify,points) 
   67         = ([ labelClassify, toTextRegion, clearText,
   68            (str ++ "\n"), unlabelButtons, toNoTextRegion],
   69            current)
   70         where   
   71         str = mapcat printstatus points
   72         printstatus pt = "Status: "++
   73                          (show (classifyPoint pt current))++"\n"
   74 
   75 
   76 
   77 
   78 
   79 
   80 
   81 
   82   perform current (Area,_) =
   83         ([toTextRegion, "Area (pixels)\n",
   84           show (rnd objArea), toNoTextRegion],
   85           current)
   86         where   
   87         objArea = area current
   88 
   89 
   90 
   91 
   92 
   93 
   94 
   95   perform current (Complement,_) 
   96         = ([clearTree,prettyPrintBSPT btree,clearRender,
   97             drawBSPT btree],
   98             btree) 
   99         where    
  100         btree = complement current
  101 
  102 
  103 
  104 
  105 
  106 
  107 
  108 
  109 
  110 
  111 
  112   perform current (Polygon,operand) 
  113         = ([clearRender, labelDefinePoly, drawFaces polygon, 
  114             "\n", clearTree, grip_stats (prettyPrintBSPT btree),
  115                 clearRender, drawBSPT btree, unlabelButtons],
  116            btree) 
  117         where   
  118         btree = buildBSPT (validate polygon)
  119         polygon = mkPolygon (transform operand)
  120         grip_stats :: String -> String  -- ******** partain **********
  121         grip_stats s = s
  122 
  123 
  124 
  125 
  126 
  127 
  128 
  129   perform current (Null,_) = ([],current)
  130 
  131 
  132 
  133 
  134 
  135 
  136 
  137 
  138 
  139 
  140 
  141 
  142 
  143 
  144 
  145   perform current (cmd,operand) 
  146         = ([ labelDefinePoly, drawFaces polygon,
  147              "\n", clearTree, prettyPrintBSPT btree, 
  148              clearRender, drawBSPT btree, unlabelButtons],
  149              btree) 
  150         where   
  151         btree = boolOp cmd current (buildBSPT (validate polygon))
  152         polygon = mkPolygon(transform operand)
  153 
  154 
  155 
  156 
  157 
  158 
  159   boolOp :: Command -> BSPT -> BSPT -> BSPT
  160   boolOp Union current operand = union current operand 
  161   boolOp Intersect current operand = intersection current operand
  162   boolOp Subtract current operand = subtract_YORK current operand 
  163 
  164 
  165 
  166 
  167   validate :: [a] -> [a]
  168   validate pts = if (length pts<3) then [] else pts      
  169 
  170 
  171 
  172   transform :: [Point] -> [Point]
  173   transform = map trans
  174                   where trans (Pt x y) = Pt (grid x) (grid y)