Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge pull request #165 from colah/fix-bugs
Fix bugs
  • Loading branch information
mmachenry committed Jan 25, 2016
2 parents c95b866 + 5f440a4 commit 7d334a6
Show file tree
Hide file tree
Showing 5 changed files with 29 additions and 34 deletions.
2 changes: 1 addition & 1 deletion Graphics/Implicit/Export/Render/RefineSegs.hs
Expand Up @@ -59,7 +59,7 @@ detail n res obj [p1, p2] | n < 2 =

detail _ _ _ x = x

simplify :: Float -> [ℝ2] -> [ℝ2]
simplify :: -> [ℝ2] -> [ℝ2]
simplify _ = {-simplify3 . simplify2 res . -} simplify1

simplify1 :: [ℝ2] -> [ℝ2]
Expand Down
4 changes: 0 additions & 4 deletions Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs
Expand Up @@ -9,10 +9,6 @@ import qualified Data.Maybe as Maybe
import Control.Applicative(Alternative(..))
import Control.Monad (mzero, mplus, MonadPlus, liftM, ap)

instance Alternative ArgParser where
(<|>) = mplus
empty = mzero

instance Functor ArgParser where
fmap = liftM

Expand Down
3 changes: 1 addition & 2 deletions Graphics/Implicit/ObjectUtil/GetBox3.hs
Expand Up @@ -103,14 +103,13 @@ getBox3 (ExtrudeRM _ twist scale translate symbObj eitherh) =
((x1,y1),(x2,y2)) = getBox2 symbObj
(dx,dy) = (x2 - x1, y2 - y1)
(xrange, yrange) = (map (\s -> x1+s*dx) $ range, map (\s -> y1+s*dy) $ range )

h = case eitherh of
Left h -> h
Right hf -> hmax + 0.2*(hmax-hmin)
where
hs = [hf (x,y) | x <- xrange, y <- yrange]
(hmin, hmax) = (minimum hs, maximum hs)
hrange = map (h*) $ range
hrange = map (h*) $ range
sval = case scale of
Nothing -> 1
Just scale' -> maximum $ map (abs . scale') hrange
Expand Down
32 changes: 16 additions & 16 deletions implicit.cabal
Expand Up @@ -152,25 +152,25 @@ executable extopenscad
-- -funfolding-use-threshold=16
-- -fspec-constr-count=10

Executable implicitsnap
--Executable implicitsnap

Main-is: implicitsnap.hs
ghc-options:
-optc-O3
-threaded
-rtsopts
-funfolding-use-threshold=16
-fspec-constr-count=10
-- Main-is: implicitsnap.hs
-- ghc-options:
-- -optc-O3
-- -threaded
-- -rtsopts
-- -funfolding-use-threshold=16
-- -fspec-constr-count=10

Executable Benchmark
--Executable Benchmark

Main-is: Benchmark.hs
ghc-options:
-optc-O3
-threaded
-rtsopts
-funfolding-use-threshold=16
-fspec-constr-count=10
-- Main-is: Benchmark.hs
-- ghc-options:
-- -optc-O3
-- -threaded
-- -rtsopts
-- -funfolding-use-threshold=16
-- -fspec-constr-count=10

test-suite test-implicit
type: exitcode-stdio-1.0
Expand Down
22 changes: 11 additions & 11 deletions programs/extopenscad.hs
Expand Up @@ -207,35 +207,35 @@ run args = do
content <- readFile (inputFile args)

let format =
case () of
_ | Just fmt <- outputFormat args -> Just $ fmt
_ | Just file <- outputFile args -> Just $ guessOutputFormat file
_ -> Nothing
case () of
_ | Just fmt <- outputFormat args -> Just $ fmt
_ | Just file <- outputFile args -> Just $ guessOutputFormat file
_ -> Nothing
putStrLn $ "Processing File."

case runOpenscad content of
case runOpenscad content of
Left err -> putStrLn $ show $ err
Right openscadProgram -> do
s@(_, obj2s, obj3s) <- openscadProgram
let res = maybe (getRes s) id (resolution args)
let basename = fst (splitExtension $ inputFile args)
let posDefExt = case format of
Just f -> Prelude.lookup f (map swap formatExtensions)
Nothing -> Nothing -- We don't know the format -- it will be 2D/3D default
Just f -> Prelude.lookup f (map swap formatExtensions)
Nothing -> Nothing -- We don't know the format -- it will be 2D/3D default
case (obj2s, obj3s) of
([], [obj]) -> do
let output = fromMaybe
(basename ++ "." ++ fromMaybe "stl" posDefExt)
(outputFile args)
(basename ++ "." ++ fromMaybe "stl" posDefExt)
(outputFile args)
putStrLn $ "Rendering 3D object to " ++ output
putStrLn $ "With resolution " ++ show res
putStrLn $ "In box " ++ show (getBox3 obj)
putStrLn $ show obj
export3 format res output obj
([obj], []) -> do
let output = fromMaybe
(basename ++ "." ++ fromMaybe "svg" posDefExt)
(outputFile args)
(basename ++ "." ++ fromMaybe "svg" posDefExt)
(outputFile args)
putStrLn $ "Rendering 2D object to " ++ output
putStrLn $ "With resolution " ++ show res
putStrLn $ "In box " ++ show (getBox2 obj)
Expand Down

0 comments on commit 7d334a6

Please sign in to comment.