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)