mirror of
https://github.com/Haskell-Things/ImplicitCAD.git
synced 2024-11-04 01:26:48 +03:00
more applicative coding style.
This commit is contained in:
Julia Longtin
parent
8528cc416f
commit
6c1e0565bc
@ -12,11 +12,11 @@ object2 = squarePipe (10,10,10) 1 100
|
||||
squarePipe :: ℝ3 -> ℝ -> ℝ -> SymbolicObj3
|
||||
squarePipe (x,y,z) diameter precision =
|
||||
union
|
||||
$ ((\start-> translate start
|
||||
$ rect3R 0 (0,0,0) (diameter,diameter,diameter)
|
||||
)
|
||||
<$>
|
||||
zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100])
|
||||
((\start-> translate start
|
||||
$ rect3R 0 (0,0,0) (diameter,diameter,diameter)
|
||||
)
|
||||
<$>
|
||||
zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100])
|
||||
(fmap (\n->(fromIntegral n/precision)*y) [0..100])
|
||||
(fmap (\n->(fromIntegral n/precision)*z) [0..100]))
|
||||
|
||||
|
||||
@ -96,7 +96,7 @@ dxf2 plines = toLazyText $ dxf2Header <> dxf2Tables <> dxf2Blocks <> dxf2Entitie
|
||||
" 8\n" <> "0\n" <>
|
||||
" 6\n" <> "CONTINUOUS\n" <>
|
||||
" 66\n" <> "1\n" <>
|
||||
" 62\n" <> (buildInt $ length singlePolyline) <> "\n" <>
|
||||
" 62\n" <> buildInt (length singlePolyline) <> "\n" <>
|
||||
" 10\n" <> "0.0\n" <>
|
||||
" 20\n" <> "0.0\n" <>
|
||||
" 30\n" <> "0.0000\n" <>
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
-- export getContour and getMesh, which returns the edge of a 2D object, or the surface of a 3D object, respectively.
|
||||
module Graphics.Implicit.Export.Render (getMesh, getContour) where
|
||||
|
||||
import Prelude(ceiling, ($), (+), (*), max, div, tail, fmap, reverse, (.), foldMap, min, Int, (<>))
|
||||
import Prelude(ceiling, ($), (+), (*), max, div, tail, fmap, reverse, (.), foldMap, min, Int, (<>), (<$>))
|
||||
|
||||
import Graphics.Implicit.Definitions (ℝ, ℕ, Fastℕ, ℝ2, ℝ3, TriangleMesh, Obj2, Obj3, Polyline(Polyline), (⋯/), both, allthree, fromℕtoℝ, fromℕ)
|
||||
|
||||
@ -129,21 +129,21 @@ getMesh p1@(x1,y1,z1) p2 res@(xres,yres,zres) obj =
|
||||
|
||||
-- (2) Calculate segments for each side
|
||||
segsZ = [[[
|
||||
fmap (injZ z0) $ getSegs (x0,y0) (x1',y1') (obj **$ z0) (objX0Y0Z0, objX1Y0Z0, objX0Y1Z0, objX1Y1Z0) (midA0, midA1, midB0, midB1)
|
||||
injZ z0 <$> getSegs (x0,y0) (x1',y1') (obj **$ z0) (objX0Y0Z0, objX1Y0Z0, objX0Y1Z0, objX1Y1Z0) (midA0, midA1, midB0, midB1)
|
||||
| x0<-pXs | x1'<-tail pXs |midB0<-mX'' | midB1<-mX'T | midA0<-mY'' | midA1<-tail mY'' | objX0Y0Z0<-objY0Z0 | objX1Y0Z0<- tail objY0Z0 | objX0Y1Z0<-objY1Z0 | objX1Y1Z0<-tail objY1Z0
|
||||
]| y0<-pYs | y1'<-tail pYs |mX'' <-mX' | mX'T <-tail mX' | mY'' <-mY' | objY0Z0 <-objZ0 | objY1Z0 <-tail objZ0
|
||||
]| z0<-pZs |mX' <-midsX | mY' <-midsY | objZ0 <-objV
|
||||
] `using` parBuffer (max 1 $ div (fromℕ nz) forcesteps) rdeepseq
|
||||
|
||||
segsY = [[[
|
||||
fmap (injY y0) $ getSegs (x0,z0) (x1',z1') (obj *$* y0) (objX0Y0Z0, objX1Y0Z0, objX0Y0Z1, objX1Y0Z1) (midA0, midA1, midB0, midB1)
|
||||
injY y0 <$> getSegs (x0,z0) (x1',z1') (obj *$* y0) (objX0Y0Z0, objX1Y0Z0, objX0Y0Z1, objX1Y0Z1) (midA0, midA1, midB0, midB1)
|
||||
| x0<-pXs | x1'<-tail pXs | midB0<-mB'' | midB1<-mBT' | midA0<-mA'' | midA1<-tail mA'' | objX0Y0Z0<-objY0Z0 | objX1Y0Z0<-tail objY0Z0 | objX0Y0Z1<-objY0Z1 | objX1Y0Z1<-tail objY0Z1
|
||||
]| y0<-pYs | mB'' <-mB' | mBT' <-mBT | mA'' <-mA' | objY0Z0 <-objZ0 | objY0Z1 <-objZ1
|
||||
]| z0<-pZs | z1'<-tail pZs | mB' <-midsX | mBT <-tail midsX | mA' <-midsZ | objZ0 <-objV | objZ1 <-tail objV
|
||||
] `using` parBuffer (max 1 $ div (fromℕ ny) forcesteps) rdeepseq
|
||||
|
||||
segsX = [[[
|
||||
fmap (injX x0) $ getSegs (y0,z0) (y1',z1') (obj $** x0) (objX0Y0Z0, objX0Y1Z0, objX0Y0Z1, objX0Y1Z1) (midA0, midA1, midB0, midB1)
|
||||
injX x0 <$> getSegs (y0,z0) (y1',z1') (obj $** x0) (objX0Y0Z0, objX0Y1Z0, objX0Y0Z1, objX0Y1Z1) (midA0, midA1, midB0, midB1)
|
||||
| x0<-pXs | midB0<-mB'' | midB1<-mBT' | midA0<-mA'' | midA1<-mA'T | objX0Y0Z0<-objY0Z0 | objX0Y1Z0<-objY1Z0 | objX0Y0Z1<-objY0Z1 | objX0Y1Z1<- objY1Z1
|
||||
]| y0<-pYs | y1'<-tail pYs | mB'' <-mB' | mBT' <-mBT | mA'' <-mA' | mA'T <-tail mA' | objY0Z0 <-objZ0 | objY1Z0 <-tail objZ0 | objY0Z1 <-objZ1 | objY1Z1 <-tail objZ1
|
||||
]| z0<-pZs | z1'<-tail pZs | mB' <-midsY | mBT <-tail midsY | mA' <-midsZ | objZ0 <- objV | objZ1 <- tail objV
|
||||
|
||||
@ -11,7 +11,7 @@
|
||||
-- output SCAD code, AKA an implicitcad to openscad converter.
|
||||
module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where
|
||||
|
||||
import Prelude(Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, fmap)
|
||||
import Prelude(Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, fmap, (<$>))
|
||||
|
||||
import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(RectR, Circle, PolygonR, Complement2, UnionR2, DifferenceR2, IntersectR2, Translate2, Scale2, Rotate2, Outset2, Shell2, EmbedBoxedObj2), SymbolicObj3(Rect3R, Sphere, Cylinder, Complement3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3, Rotate3V, Outset3, Shell3, ExtrudeR, ExtrudeRotateR, ExtrudeRM, EmbedBoxedObj3, RotateExtrude, ExtrudeOnEdgeOf))
|
||||
import Graphics.Implicit.Export.TextBuilderUtils(Text, Builder, toLazyText, fromLazyText, bf)
|
||||
@ -39,7 +39,7 @@ callToken :: (Text, Text) -> Builder -> [Builder] -> [Reader a Builder] -> Reade
|
||||
callToken cs name args [] = pure $ name <> buildArgs cs args <> ";"
|
||||
callToken cs name args [obj] = fmap ((name <> buildArgs cs args) <>) obj
|
||||
callToken cs name args objs = do
|
||||
objs' <- fmap (foldMap (<> "\n")) $ sequenceA objs
|
||||
objs' <- foldMap (<> "\n") <$> sequenceA objs
|
||||
pure $! name <> buildArgs cs args <> "{\n" <> objs' <> "}\n"
|
||||
|
||||
buildArgs :: (Text, Text) -> [Builder] -> Builder
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
|
||||
module Graphics.Implicit.Export.SymbolicObj2 (symbolicGetOrientedContour, symbolicGetContour, symbolicGetContourMesh) where
|
||||
|
||||
import Prelude(fmap, ($), (-), (/), (+), (>), (*), reverse, cos, pi, sin, max, ceiling)
|
||||
import Prelude(fmap, ($), (-), (/), (+), (>), (*), reverse, cos, pi, sin, max, ceiling, (<$>))
|
||||
|
||||
import Graphics.Implicit.Definitions (ℝ, ℝ2, Fastℕ, SymbolicObj2(RectR, Circle, Translate2, Scale2), Polyline(Polyline), Polytri(Polytri), (⋯*), fromFastℕtoℝ)
|
||||
|
||||
@ -23,7 +23,7 @@ import Graphics.Implicit.Export.Render (getContour)
|
||||
import Data.VectorSpace ((^/), magnitude)
|
||||
|
||||
symbolicGetOrientedContour :: ℝ -> SymbolicObj2 -> [Polyline]
|
||||
symbolicGetOrientedContour res symbObj = fmap orient $ symbolicGetContour res symbObj
|
||||
symbolicGetOrientedContour res symbObj = orient <$> symbolicGetContour res symbObj
|
||||
where
|
||||
obj = getImplicit2 symbObj
|
||||
-- FIXME: cowardly case handling.
|
||||
@ -56,10 +56,10 @@ appOpPolyline :: (ℝ2 -> ℝ2) -> Polyline -> Polyline
|
||||
appOpPolyline op (Polyline xs) = Polyline $ fmap op xs
|
||||
|
||||
symbolicGetContourMesh :: ℝ -> SymbolicObj2 -> [Polytri]
|
||||
symbolicGetContourMesh res (Translate2 v obj) = fmap (\(Polytri (a,b,c)) -> Polytri (a + v, b + v, c + v) ) $
|
||||
symbolicGetContourMesh res obj
|
||||
symbolicGetContourMesh res (Scale2 s@(a,b) obj) = fmap (\(Polytri (c,d,e)) -> Polytri (c ⋯* s, d ⋯* s, e ⋯* s) ) $
|
||||
symbolicGetContourMesh (res/sc) obj where sc = max a b
|
||||
symbolicGetContourMesh res (Translate2 v obj) = (\(Polytri (a,b,c)) -> Polytri (a + v, b + v, c + v)) <$>
|
||||
symbolicGetContourMesh res obj
|
||||
symbolicGetContourMesh res (Scale2 s@(a,b) obj) = (\(Polytri (c,d,e)) -> Polytri (c ⋯* s, d ⋯* s, e ⋯* s)) <$>
|
||||
symbolicGetContourMesh (res/sc) obj where sc = max a b
|
||||
symbolicGetContourMesh _ (RectR 0 (x1,y1) (x2,y2)) = [Polytri ((x1,y1), (x2,y1), (x2,y2)), Polytri ((x2,y2), (x1,y2), (x1,y1)) ]
|
||||
-- FIXME: magic number.
|
||||
symbolicGetContourMesh res (Circle r) =
|
||||
|
||||
@ -78,7 +78,7 @@ cleanupTris tris =
|
||||
|
||||
-- | Generate an STL file is ASCII format.
|
||||
stl :: TriangleMesh -> Text
|
||||
stl triangles = toLazyText $ stlHeader <> (foldMap triangle $ unmesh $ cleanupTris triangles) <> stlFooter
|
||||
stl triangles = toLazyText $ stlHeader <> foldMap triangle (unmesh $ cleanupTris triangles) <> stlFooter
|
||||
where
|
||||
stlHeader :: Builder
|
||||
stlHeader = "solid ImplictCADExport\n"
|
||||
@ -107,7 +107,7 @@ float32LE = writeStorable . LE
|
||||
|
||||
-- | Generate an STL file in it's binary format.
|
||||
binaryStl :: TriangleMesh -> ByteString
|
||||
binaryStl triangles = toLazyByteString $ header <> lengthField <> (foldMap triangle $ unmesh $ cleanupTris triangles)
|
||||
binaryStl triangles = toLazyByteString $ header <> lengthField <> foldMap triangle (unmesh $ cleanupTris triangles)
|
||||
where header = fromByteString $ replicate 80 0
|
||||
lengthField = fromWord32le $ toEnum $ length $ unmesh $ cleanupTris triangles
|
||||
triangle (Triangle (a,b,c)) = normalV (a,b,c) <> point a <> point b <> point c <> fromWord16le 0
|
||||
|
||||
@ -191,8 +191,8 @@ data SourcePosition = SourcePosition
|
||||
deriving (Eq)
|
||||
|
||||
instance Show SourcePosition where
|
||||
show (SourcePosition line col []) = "line " <> show ((fromFastℕ line) :: Int) <> ", column " <> show ((fromFastℕ col) :: Int)
|
||||
show (SourcePosition line col filePath) = "line " <> show ((fromFastℕ line) :: Int) <> ", column " <> show ((fromFastℕ col) :: Int) <> ", file " <> filePath
|
||||
show (SourcePosition line col []) = "line " <> show (fromFastℕ line :: Int) <> ", column " <> show (fromFastℕ col :: Int)
|
||||
show (SourcePosition line col filePath) = "line " <> show (fromFastℕ line :: Int) <> ", column " <> show (fromFastℕ col :: Int) <> ", file " <> filePath
|
||||
|
||||
-- | The types of messages the execution engine can send back to the application.
|
||||
data MessageType = TextOut -- text intetionally output by the ExtOpenScad program.
|
||||
|
||||
@ -69,7 +69,7 @@ patMatch _ _ = Nothing
|
||||
|
||||
-- | Construct a VarLookup from the given Pattern and OVal, if possible.
|
||||
matchPat :: Pattern -> OVal -> Maybe VarLookup
|
||||
matchPat pat val = VarLookup . fromList . zip (fmap Symbol $ patVars pat) <$> patMatch pat val
|
||||
matchPat pat val = VarLookup . fromList . zip (Symbol <$> patVars pat) <$> patMatch pat val
|
||||
|
||||
-- | The entry point from StateC. evaluates an expression, pureing the result, and moving any error messages generated into the calling StateC.
|
||||
evalExpr :: SourcePosition -> Expr -> StateC OVal
|
||||
|
||||
@ -11,7 +11,7 @@
|
||||
|
||||
module Graphics.Implicit.ExtOpenScad.Eval.Statement (runStatementI) where
|
||||
|
||||
import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left, Right), (.), ($), show, pure, (<>), reverse, fst, snd, readFile, filter, length, (&&), (==), (/=), fmap, notElem, elem, not, zip, init, last, null, String, (*>))
|
||||
import Prelude(Maybe(Just, Nothing), Bool(True, False), Either(Left, Right), (.), ($), show, pure, (<>), reverse, fst, snd, readFile, filter, length, (&&), (==), (/=), fmap, notElem, elem, not, zip, init, last, null, String, (*>), (<$>))
|
||||
|
||||
import Graphics.Implicit.ExtOpenScad.Definitions (
|
||||
Statement(Include, (:=), If, NewModule, ModuleCall, DoNothing),
|
||||
@ -195,22 +195,22 @@ runStatementI (StatementI sourcePos (ModuleCall (Symbol name) argsExpr suite)) =
|
||||
valUnnamed = unnamedParameters argsExpr
|
||||
mapFromUnnamed :: [(Symbol, Expr)]
|
||||
mapFromUnnamed = zip notMappedNotDefaultable valUnnamed
|
||||
missingNotDefaultable = filter (`notElem` (mappedDefaulted <> mappedNotDefaulted <> (fmap fst mapFromUnnamed))) valNotDefaulted
|
||||
missingNotDefaultable = filter (`notElem` (mappedDefaulted <> mappedNotDefaulted <> fmap fst mapFromUnnamed)) valNotDefaulted
|
||||
extraUnnamed = filter (`notElem` (valDefaulted <> valNotDefaulted)) $ namedParameters argsExpr
|
||||
parameterReport = "Passed " <>
|
||||
(if (null valNamed && null valUnnamed) then "no parameters" else "" ) <>
|
||||
(if null valNamed && null valUnnamed then "no parameters" else "" ) <>
|
||||
(if not (null valNamed) then show (length valNamed) <> (if length valNamed == 1 then " named parameter" else " named parameters") else "" ) <>
|
||||
(if not (null valNamed) && not (null valUnnamed) then ", and " else "") <>
|
||||
(if not (null valUnnamed) then show (length valUnnamed) <> (if length valUnnamed == 1 then " un-named parameter." else " un-named parameters.") else ".") <>
|
||||
(if not (null missingNotDefaultable) then
|
||||
(if length missingNotDefaultable == 1
|
||||
then " Couldn't match one parameter: " <> showSymbol (last missingNotDefaultable)
|
||||
else " Couldn't match " <> show (length missingNotDefaultable) <> " parameters: " <> intercalate ", " (fmap showSymbol $ init missingNotDefaultable) <> " and " <> showSymbol (last missingNotDefaultable) <> "."
|
||||
else " Couldn't match " <> show (length missingNotDefaultable) <> " parameters: " <> intercalate ", " (showSymbol <$> init missingNotDefaultable) <> " and " <> showSymbol (last missingNotDefaultable) <> "."
|
||||
) else "") <>
|
||||
(if not (null extraUnnamed) then
|
||||
(if length extraUnnamed == 1
|
||||
then " Had one extra parameter: " <> showSymbol (last extraUnnamed)
|
||||
else " Had " <> show (length extraUnnamed) <> " extra parameters. They are:" <> intercalate ", " (fmap showSymbol $ init extraUnnamed) <> " and " <> showSymbol (last extraUnnamed) <> "."
|
||||
else " Had " <> show (length extraUnnamed) <> " extra parameters. They are:" <> intercalate ", " (showSymbol <$> init extraUnnamed) <> " and " <> showSymbol (last extraUnnamed) <> "."
|
||||
) else "")
|
||||
showSymbol :: Symbol -> String
|
||||
showSymbol (Symbol sym) = show sym
|
||||
|
||||
@ -11,7 +11,7 @@
|
||||
module Graphics.Implicit.ExtOpenScad.Util.ArgParser (argument, doc, defaultTo, example, test, eulerCharacteristic, argMap) where
|
||||
|
||||
-- imported twice, once qualified. null from Data.Map conflicts with null from Prelude.
|
||||
import Prelude(String, Maybe(Just, Nothing), ($), (<>), show, error, return, fmap, snd, filter, (.), fst, foldl1, not, (&&))
|
||||
import Prelude(String, Maybe(Just, Nothing), ($), (<>), show, error, return, fmap, snd, filter, (.), fst, foldl1, not, (&&), (<$>))
|
||||
import qualified Prelude as P (null)
|
||||
|
||||
import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch, APTerminator, APFailIf, APExample), OVal (OError), TestInvariant(EulerCharacteristic), Symbol, VarLookup(VarLookup))
|
||||
@ -82,8 +82,8 @@ argMap ::
|
||||
-> ArgParser a -- ^ ArgParser to apply them to
|
||||
-> (Maybe a, [String]) -- ^ (result, error messages)
|
||||
argMap args = argMap2 unnamedArgs (VarLookup $ fromList namedArgs) where
|
||||
unnamedArgs = fmap snd $ filter (isNothing . fst) args
|
||||
namedArgs = fmap (first fromJust) $ filter (isJust . fst) args
|
||||
unnamedArgs = snd <$> filter (isNothing . fst) args
|
||||
namedArgs = first fromJust <$> filter (isJust . fst) args
|
||||
|
||||
argMap2 :: [OVal] -> VarLookup -> ArgParser a -> (Maybe a, [String])
|
||||
argMap2 unnamedArgs namedArgs (APBranch branches) =
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
|
||||
module Graphics.Implicit.ObjectUtil.GetImplicit3 (getImplicit3) where
|
||||
|
||||
import Prelude (Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, fmap, minimum, ($), (**), sin, pi, (.), Bool(True, False), ceiling, floor, pure, error, head, tail, (>), (&&), (<), (==), otherwise)
|
||||
import Prelude (Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, fmap, minimum, ($), (**), sin, pi, (.), Bool(True, False), ceiling, floor, pure, error, head, tail, (>), (&&), (<), (==), otherwise, (<$>))
|
||||
|
||||
import Graphics.Implicit.Definitions (ℝ, ℕ, ℝ2, ℝ3, (⋯/), Obj3,
|
||||
SymbolicObj3(Shell3, UnionR3, IntersectR3, DifferenceR3, Translate3, Scale3, Rotate3,
|
||||
@ -49,25 +49,21 @@ getImplicit3 (Complement3 symbObj) =
|
||||
in
|
||||
\p -> - obj p
|
||||
getImplicit3 (UnionR3 r symbObjs) =
|
||||
let
|
||||
objs = fmap getImplicit3 symbObjs
|
||||
in
|
||||
\p -> rminimum r $ fmap ($p) objs
|
||||
\p -> rminimum r $ fmap ($p) $ getImplicit3 <$> symbObjs
|
||||
|
||||
getImplicit3 (IntersectR3 r symbObjs) =
|
||||
let
|
||||
objs = fmap getImplicit3 symbObjs
|
||||
in
|
||||
\p -> rmaximum r $ fmap ($p) objs
|
||||
\p -> rmaximum r $ fmap ($p) $ getImplicit3 <$> symbObjs
|
||||
|
||||
getImplicit3 (DifferenceR3 r symbObjs) =
|
||||
let
|
||||
tailObjs = fmap getImplicit3 $ tail symbObjs
|
||||
tailObjs = getImplicit3 <$> tail symbObjs
|
||||
headObj = getImplicit3 $ head symbObjs
|
||||
complement :: Obj3 -> ℝ3 -> ℝ
|
||||
complement obj' p = - obj' p
|
||||
in
|
||||
\p -> do
|
||||
let
|
||||
maxTail = rmaximum r $ fmap ($p) $ fmap complement tailObjs
|
||||
maxTail = rmaximum r $ fmap ($p) $ complement <$> tailObjs
|
||||
if maxTail > -minℝ && maxTail < minℝ
|
||||
then rmax r (headObj p) minℝ
|
||||
else rmax r (headObj p) maxTail
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
|
||||
-- Let's be explicit about where things come from :)
|
||||
|
||||
import Prelude (($), (*), (/), String, IO, cos, pi, fmap, zip3, Either(Left, Right), fromIntegral, (<>))
|
||||
import Prelude (($), (*), (/), String, IO, cos, pi, fmap, zip3, Either(Left, Right), fromIntegral, (<>), (<$>))
|
||||
|
||||
-- Use criterion for benchmarking. see <http://www.serpentine.com/criterion/>
|
||||
import Criterion.Main (Benchmark, bgroup, bench, nf, nfAppIO, defaultMain)
|
||||
@ -48,12 +48,13 @@ object2 = squarePipe (10,10,10) 1 100
|
||||
squarePipe :: (ℝ,ℝ,ℝ) -> ℝ -> ℝ -> SymbolicObj3
|
||||
squarePipe (x,y,z) diameter precision =
|
||||
union
|
||||
$ fmap (\start-> translate start
|
||||
((\start-> translate start
|
||||
$ rect3R 0 (0,0,0) (diameter,diameter,diameter)
|
||||
)
|
||||
$ zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100::Fastℕ])
|
||||
<$>
|
||||
zip3 (fmap (\n->(fromIntegral n/precision)*x) [0..100::Fastℕ])
|
||||
(fmap (\n->(fromIntegral n/precision)*y) [0..100::Fastℕ])
|
||||
(fmap (\n->(fromIntegral n/precision)*z) [0..100::Fastℕ])
|
||||
(fmap (\n->(fromIntegral n/precision)*z) [0..100::Fastℕ]))
|
||||
|
||||
-- | A third 3d object to benchmark.
|
||||
object3 :: SymbolicObj3
|
||||
|
||||
@ -349,7 +349,7 @@ run rawargs = do
|
||||
_ -> hPutStr stderr "ERROR: File contains a mixture of 2D and 3D objects, what do you want to render?\n"
|
||||
|
||||
-- | Always display our warnings, errors, and other non-textout messages on stderr.
|
||||
hPutStr stderr $ unlines $ fmap show $ filter (not . isTextOut) messages
|
||||
hPutStr stderr $ unlines $ show <$> filter (not . isTextOut) messages
|
||||
|
||||
let textOutHandler =
|
||||
case () of
|
||||
@ -357,7 +357,7 @@ run rawargs = do
|
||||
_ | rawEcho args -> textOutBare
|
||||
_ -> show
|
||||
|
||||
hPutStr hMessageOutput $ unlines $ fmap textOutHandler $ filter isTextOut messages
|
||||
hPutStr hMessageOutput $ unlines $ textOutHandler <$> filter isTextOut messages
|
||||
|
||||
-- | The entry point. Use the option parser then run the extended OpenScad code.
|
||||
main :: IO ()
|
||||
|
||||
@ -36,7 +36,7 @@ infixr 1 -->
|
||||
-- | Types
|
||||
|
||||
-- | An even smaller wrapper which runs a program, and only returns the generated messages. for the test suite.
|
||||
getOpenscadMessages :: ScadOpts -> [String] -> String -> IO ([Message])
|
||||
getOpenscadMessages :: ScadOpts -> [String] -> String -> IO [Message]
|
||||
getOpenscadMessages scadOpts constants source = do
|
||||
(_, _, _, messages) <- runOpenscad scadOpts constants source
|
||||
return messages
|
||||
|
||||
Loading…
Reference in New Issue
Block a user