diff --git a/Graphics/Implicit/ExtOpenScad.hs b/Graphics/Implicit/ExtOpenScad.hs index 0b6d53f0..ce33bcbe 100644 --- a/Graphics/Implicit/ExtOpenScad.hs +++ b/Graphics/Implicit/ExtOpenScad.hs @@ -22,19 +22,19 @@ import qualified System.Directory as Dir -- Small wrapper to handle parse errors, etc runOpenscad :: [Char] -> Either Parsec.ParseError (IO (VarLookup, [SymbolicObj2], [SymbolicObj3])) runOpenscad s = - let - initial = defaultObjects - rearrange (_, (varlookup, ovals, _ , _ , _)) = (varlookup, obj2s, obj3s) where - (obj2s, obj3s, _ ) = divideObjs ovals - in case parseProgram "" s of - Left e -> Left e - Right sts -> Right - $ fmap rearrange - $ (\sts -> do - path <- Dir.getCurrentDirectory - State.runStateT sts (initial, [], path, (), () ) - ) - $ Monad.mapM_ runStatementI sts + let + initial = defaultObjects + rearrange (_, (varlookup, ovals, _ , _ , _)) = (varlookup, obj2s, obj3s) where + (obj2s, obj3s, _ ) = divideObjs ovals + in case parseProgram "" s of + Left e -> Left e + Right sts -> Right + $ fmap rearrange + $ (\sts -> do + path <- Dir.getCurrentDirectory + State.runStateT sts (initial, [], path, (), () ) + ) + $ Monad.mapM_ runStatementI sts diff --git a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs index b6db1407..bac03bfa 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/OVal.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/OVal.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE OverlappingInstances, ViewPatterns, RankNTypes, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE OverlappingInstances -#} +#endif +{-# LANGUAGE ViewPatterns, RankNTypes, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-} module Graphics.Implicit.ExtOpenScad.Util.OVal where diff --git a/Graphics/Implicit/ObjectUtil/GetBox2.hs b/Graphics/Implicit/ObjectUtil/GetBox2.hs index 464d0a9a..43ba9b16 100644 --- a/Graphics/Implicit/ObjectUtil/GetBox2.hs +++ b/Graphics/Implicit/ObjectUtil/GetBox2.hs @@ -114,12 +114,12 @@ getDist2 p (Translate2 v obj) = getDist2 (p ^+^ v) obj getDist2 p (Circle r) = magnitude p + r +getDist2 p (PolygonR r points) = + r + maximum [magnitude (p ^-^ p') | p' <- points] + getDist2 (x,y) symbObj = let ((x1,y1), (x2,y2)) = getBox2 symbObj in sqrt ((max (abs (x1 - x)) (abs (x2 - x)))**2 + (max (abs (y1 - y)) (abs (y2 - y)))**2) -getDist2 p (PolygonR r points) = - r + maximum [magnitude (p ^-^ p') | p' <- points] - diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs index 5b7ad2b5..47977c2f 100644 --- a/Graphics/Implicit/Primitives.hs +++ b/Graphics/Implicit/Primitives.hs @@ -193,14 +193,14 @@ rotate3V = Rotate3V pack3 :: ℝ2 -> ℝ -> [SymbolicObj3] -> Maybe SymbolicObj3 pack3 (dx, dy) sep objs = - let - boxDropZ ((a,b,_),(d,e,_)) = ((a,b),(d,e)) - withBoxes :: [(Box2, SymbolicObj3)] - withBoxes = map (\obj -> ( boxDropZ $ getBox3 obj, obj)) objs - in case pack ((0,0),(dx,dy)) sep withBoxes of - (a, []) -> Just $ union $ map (\((x,y),obj) -> translate (x,y,0) obj) a - _ -> Nothing - + let + boxDropZ ((a,b,_),(d,e,_)) = ((a,b),(d,e)) + withBoxes :: [(Box2, SymbolicObj3)] + withBoxes = map (\obj -> ( boxDropZ $ getBox3 obj, obj)) objs + in case pack ((0,0),(dx,dy)) sep withBoxes of + (a, []) -> Just $ union $ map (\((x,y),obj) -> translate (x,y,0) obj) a + _ -> Nothing + -- 2D operations @@ -210,10 +210,10 @@ rotate = Rotate2 pack2 :: ℝ2 -> ℝ -> [SymbolicObj2] -> Maybe SymbolicObj2 pack2 (dx, dy) sep objs = - let - withBoxes :: [(Box2, SymbolicObj2)] - withBoxes = map (\obj -> ( getBox2 obj, obj)) objs - in case pack ((0,0),(dx,dy)) sep withBoxes of - (a, []) -> Just $ union $ map (\((x,y),obj) -> translate (x,y) obj) a - _ -> Nothing + let + withBoxes :: [(Box2, SymbolicObj2)] + withBoxes = map (\obj -> ( getBox2 obj, obj)) objs + in case pack ((0,0),(dx,dy)) sep withBoxes of + (a, []) -> Just $ union $ map (\((x,y),obj) -> translate (x,y) obj) a + _ -> Nothing diff --git a/implicit.cabal b/implicit.cabal index 8292e83c..fc088bd9 100644 --- a/implicit.cabal +++ b/implicit.cabal @@ -39,7 +39,6 @@ Library ghc-options: -O2 -optc-O3 - -threaded -rtsopts -funfolding-use-threshold=16 -fspec-constr-count=10