mirror of
https://github.com/Haskell-Things/ImplicitCAD.git
synced 2024-09-11 04:55:41 +03:00
comments and spacing changes, and use an integral for counting sides of a polygon, instead of doubles. also, add a tester for polygons.
This commit is contained in:
parent
604041dd22
commit
085248ff78
10
Examples/example14.escad
Normal file
10
Examples/example14.escad
Normal file
@ -0,0 +1,10 @@
|
||||
// example7.escad -- A twisted rounded extrusion of the rounded union of 5 hexagonical solids.
|
||||
linear_extrude (height = 40, center=true, twist=90, r=5){
|
||||
union ( r = 8) {
|
||||
circle (10,$fn=6);
|
||||
translate ([22,0]) circle (10,$fn=6);
|
||||
translate ([0,22]) circle (10,$fn=6);
|
||||
translate ([-22,0]) circle (10,$fn=6);
|
||||
translate ([0,-22]) circle (10,$fn=6);
|
||||
}
|
||||
}
|
@ -2,7 +2,7 @@
|
||||
-- Copyright 2016, Julia Longtin (julial@turinglace.com)
|
||||
-- Released under the GNU AGPLV3+, see LICENSE
|
||||
|
||||
-- Idealy, we'd like to parse openscad code, with some improvements, for backwards compatability.
|
||||
-- Idealy, we'd like to parse a superset of openscad code, with some improvements.
|
||||
|
||||
-- This file provides primitive objects for the openscad parser.
|
||||
|
||||
@ -12,9 +12,9 @@
|
||||
-- Export one set containing all of the primitive object's patern matches.
|
||||
module Graphics.Implicit.ExtOpenScad.Primitives (primitives) where
|
||||
|
||||
import Prelude(String, IO, Either(Left, Right), Bool(False), Maybe(Just, Nothing), Fractional, ($), return, either, id, (-), (==), (&&), (<), fromIntegral, (*), cos, sin, pi, (/), (>), const, uncurry, realToFrac, fmap, fromInteger, round, (/=), (||), not, null, map, (++), putStrLn)
|
||||
import Prelude(String, IO, Either(Left, Right), Bool(False), Maybe(Just, Nothing), Fractional, ($), return, either, id, (-), (==), (&&), (<), (*), cos, sin, pi, (/), (>), const, uncurry, realToFrac, fmap, fromInteger, round, (/=), (||), not, null, map, (++), putStrLn)
|
||||
|
||||
import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3)
|
||||
import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, ℕ, SymbolicObj2, SymbolicObj3, fromℕtoℝ)
|
||||
|
||||
import Graphics.Implicit.ExtOpenScad.Definitions (OVal (OObj2, OObj3), ArgParser)
|
||||
|
||||
@ -22,7 +22,7 @@ import Graphics.Implicit.ExtOpenScad.Util.ArgParser (doc, defaultTo, argument, e
|
||||
|
||||
import Graphics.Implicit.ExtOpenScad.Util.OVal (caseOType, divideObjs, (<||>))
|
||||
|
||||
-- note the use of a qualified import, so we don't have the functions in this file conflict with what we're importing.
|
||||
-- Note the use of a qualified import, so we don't have the functions in this file conflict with what we're importing.
|
||||
import qualified Graphics.Implicit.Primitives as Prim (sphere, rect3R, rectR, translate, circle, polygonR, extrudeR, cylinder2, union, unionR, intersect, intersectR, difference, differenceR, rotate, rotate3V, rotate3, scale, extrudeR, extrudeRM, rotateExtrude, shell, pack3, pack2)
|
||||
|
||||
import Data.Maybe (isNothing)
|
||||
@ -32,11 +32,11 @@ import Control.Monad (mplus)
|
||||
import Data.VectorSpace (VectorSpace, Scalar, (*^))
|
||||
import GHC.Real (RealFrac)
|
||||
|
||||
-- The only thing exported here. basically, a list of ... ?
|
||||
primitives :: [(String, [OVal] -> ArgParser (IO [OVal]) )]
|
||||
-- | The only thing exported here. basically, a list of functions, which accept OVal arguments and retrun an ArgParser ?
|
||||
primitives :: [(String, [OVal] -> ArgParser (IO [OVal]))]
|
||||
primitives = [ sphere, cube, square, cylinder, circle, polygon, union, difference, intersect, translate, scale, rotate, extrude, pack, shell, rotateExtrude, unit ]
|
||||
|
||||
-- sphere is a module without a suite.
|
||||
-- | sphere is a module without a suite.
|
||||
-- this means that the parser will look for this like
|
||||
-- sphere(args...);
|
||||
sphere :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
@ -56,16 +56,13 @@ sphere = moduleWithoutSuite "sphere" $ do
|
||||
|
||||
cube :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
cube = moduleWithoutSuite "cube" $ do
|
||||
|
||||
-- examples
|
||||
example "cube(size = [2,3,4], center = true, r = 0.5);"
|
||||
example "cube(4);"
|
||||
|
||||
-- arguments shared between forms
|
||||
r :: ℝ <- argument "r"
|
||||
`doc` "radius of rounding"
|
||||
`defaultTo` 0
|
||||
|
||||
-- arguments (two forms)
|
||||
((x1,x2), (y1,y2), (z1,z2)) <-
|
||||
do
|
||||
@ -79,7 +76,7 @@ cube = moduleWithoutSuite "cube" $ do
|
||||
`doc` "should center? (non-intervals)"
|
||||
`defaultTo` False
|
||||
let
|
||||
toInterval' :: Fractional t => t -> (t, t)
|
||||
toInterval' :: ℝ -> (ℝ, ℝ)
|
||||
toInterval' = toInterval center
|
||||
return (either toInterval' id x,
|
||||
either toInterval' id y,
|
||||
@ -92,28 +89,23 @@ cube = moduleWithoutSuite "cube" $ do
|
||||
`defaultTo` False
|
||||
let (x,y, z) = either (\w -> (w,w,w)) id size
|
||||
return (toInterval center x, toInterval center y, toInterval center z)
|
||||
|
||||
-- Tests
|
||||
test "cube(4);"
|
||||
`eulerCharacteristic` 2
|
||||
test "cube(size=[2,3,4]);"
|
||||
`eulerCharacteristic` 2
|
||||
|
||||
addObj3 $ Prim.rect3R r (x1, y1, z1) (x2, y2, z2)
|
||||
|
||||
square :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
square = moduleWithoutSuite "square" $ do
|
||||
|
||||
-- examples
|
||||
example "square(x=[-2,2], y=[-1,5]);"
|
||||
example "square(size = [3,4], center = true, r = 0.5);"
|
||||
example "square(4);"
|
||||
|
||||
-- arguments shared between forms
|
||||
r :: ℝ <- argument "r"
|
||||
`doc` "radius of rounding"
|
||||
`defaultTo` 0
|
||||
|
||||
-- arguments (two forms)
|
||||
((x1,x2), (y1,y2)) <-
|
||||
do
|
||||
@ -125,7 +117,7 @@ square = moduleWithoutSuite "square" $ do
|
||||
`doc` "should center? (non-intervals)"
|
||||
`defaultTo` False
|
||||
let
|
||||
toInterval' :: Fractional t => t -> (t, t)
|
||||
toInterval' :: ℝ -> (ℝ, ℝ)
|
||||
toInterval' = toInterval center
|
||||
return (either toInterval' id x,
|
||||
either toInterval' id y)
|
||||
@ -137,22 +129,18 @@ square = moduleWithoutSuite "square" $ do
|
||||
`defaultTo` False
|
||||
let (x,y) = either (\w -> (w,w)) id size
|
||||
return (toInterval center x, toInterval center y)
|
||||
|
||||
-- Tests
|
||||
test "square(2);"
|
||||
`eulerCharacteristic` 0
|
||||
test "square(size=[2,3]);"
|
||||
`eulerCharacteristic` 0
|
||||
|
||||
addObj2 $ Prim.rectR r (x1, y1) (x2, y2)
|
||||
|
||||
cylinder :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
cylinder = moduleWithoutSuite "cylinder" $ do
|
||||
|
||||
example "cylinder(r=10, h=30, center=true);"
|
||||
example "cylinder(r1=4, r2=6, h=10);"
|
||||
example "cylinder(r=5, h=10, $fn = 6);"
|
||||
|
||||
-- arguments
|
||||
r :: ℝ <- argument "r"
|
||||
`defaultTo` 1
|
||||
@ -166,19 +154,17 @@ cylinder = moduleWithoutSuite "cylinder" $ do
|
||||
r2 :: ℝ <- argument "r2"
|
||||
`defaultTo` 1
|
||||
`doc` "top radius; overrides r"
|
||||
fn :: ℕ <- argument "$fn"
|
||||
sides :: ℕ <- argument "$fn"
|
||||
`defaultTo` (-1)
|
||||
`doc` "number of sides, for making prisms"
|
||||
center :: Bool <- argument "center"
|
||||
`defaultTo` False
|
||||
`doc` "center cylinder with respect to z?"
|
||||
|
||||
-- Tests
|
||||
test "cylinder(r=10, h=30, center=true);"
|
||||
`eulerCharacteristic` 0
|
||||
test "cylinder(r=5, h=10, $fn = 6);"
|
||||
`eulerCharacteristic` 0
|
||||
|
||||
let
|
||||
(h1, h2) = either (toInterval center) id h
|
||||
dh = h2 - h1
|
||||
@ -187,49 +173,36 @@ cylinder = moduleWithoutSuite "cylinder" $ do
|
||||
if h1 == 0
|
||||
then id
|
||||
else Prim.translate (0,0,h1)
|
||||
|
||||
-- The result is a computation state modifier that adds a 3D object,
|
||||
-- based on the args.
|
||||
addObj3 $ if r1 == 1 && r2 == 1
|
||||
then let
|
||||
obj2 = if fn < 0 then Prim.circle r else Prim.polygonR 0 $
|
||||
let
|
||||
sides :: ℝ
|
||||
sides = fromIntegral fn
|
||||
in [(r*cos θ, r*sin θ )| θ <- [2*pi*n/sides | n <- [0.0 .. sides - 1.0]]]
|
||||
obj2 = if sides < 0 then Prim.circle r else Prim.polygonR 0 $
|
||||
[(r*cos θ, r*sin θ )| θ <- [2*pi*(fromℕtoℝ n)/(fromℕtoℝ sides) | n <- [0 .. sides - 1]]]
|
||||
obj3 = Prim.extrudeR 0 obj2 dh
|
||||
in shift obj3
|
||||
else shift $ Prim.cylinder2 r1 r2 dh
|
||||
|
||||
circle :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
circle = moduleWithoutSuite "circle" $ do
|
||||
|
||||
example "circle(r=10); // circle"
|
||||
example "circle(r=5, $fn=6); //hexagon"
|
||||
|
||||
-- Arguments
|
||||
r :: ℝ <- argument "r"
|
||||
`doc` "radius of the circle"
|
||||
fn :: ℕ <- argument "$fn"
|
||||
sides :: ℕ <- argument "$fn"
|
||||
`doc` "if defined, makes a regular polygon with n sides instead of a circle"
|
||||
`defaultTo` (-1)
|
||||
|
||||
test "circle(r=10);"
|
||||
`eulerCharacteristic` 0
|
||||
|
||||
addObj2 $ if fn < 3
|
||||
addObj2 $ if sides < 3
|
||||
then Prim.circle r
|
||||
else Prim.polygonR 0 $
|
||||
let
|
||||
sides :: ℝ
|
||||
sides = fromIntegral fn
|
||||
in [(r*cos θ, r*sin θ )| θ <- [2*pi*n/sides | n <- [0.0 .. sides - 1.0]]]
|
||||
[(r*cos θ, r*sin θ )| θ <- [2*pi*(fromℕtoℝ n)/(fromℕtoℝ sides) | n <- [0 .. sides - 1]]]
|
||||
|
||||
polygon :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
polygon = moduleWithoutSuite "polygon" $ do
|
||||
|
||||
example "polygon ([(0,0), (0,10), (10,0)]);"
|
||||
|
||||
points :: [ℝ2] <- argument "points"
|
||||
`doc` "vertices of the polygon"
|
||||
paths :: [ℕ] <- argument "paths"
|
||||
@ -242,7 +215,6 @@ polygon = moduleWithoutSuite "polygon" $ do
|
||||
[] -> addObj2 $ Prim.polygonR r points
|
||||
_ -> return $ return []
|
||||
|
||||
|
||||
union :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
union = moduleWithSuite "union" $ \children -> do
|
||||
r :: ℝ <- argument "r"
|
||||
@ -272,10 +244,8 @@ difference = moduleWithSuite "difference" $ \children -> do
|
||||
|
||||
translate :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
translate = moduleWithSuite "translate" $ \children -> do
|
||||
|
||||
example "translate ([2,3]) circle (4);"
|
||||
example "translate ([5,6,7]) sphere(5);"
|
||||
|
||||
(x,y,z) <-
|
||||
do
|
||||
x :: ℝ <- argument "x"
|
||||
@ -293,7 +263,6 @@ translate = moduleWithSuite "translate" $ \children -> do
|
||||
Left x -> (x,0,0)
|
||||
Right (Left (x,y) ) -> (x,y,0)
|
||||
Right (Right (x,y,z)) -> (x,y,z)
|
||||
|
||||
return $ return $
|
||||
objMap (Prim.translate (x,y)) (Prim.translate (x,y,z)) children
|
||||
|
||||
@ -308,7 +277,6 @@ rotate = moduleWithSuite "rotate" $ \children -> do
|
||||
v <- argument "v"
|
||||
`defaultTo` (0, 0, 1)
|
||||
`doc` "Vector to rotate around if a is a single angle"
|
||||
|
||||
-- caseOType matches depending on whether size can be coerced into
|
||||
-- the right object. See Graphics.Implicit.ExtOpenScad.Util
|
||||
-- Entries must be joined with the operator <||>
|
||||
@ -324,17 +292,14 @@ rotate = moduleWithSuite "rotate" $ \children -> do
|
||||
|
||||
scale :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
scale = moduleWithSuite "scale" $ \children -> do
|
||||
|
||||
example "scale(2) square(5);"
|
||||
example "scale([2,3]) square(5);"
|
||||
example "scale([2,3,4]) cube(5);"
|
||||
v <- argument "v"
|
||||
`doc` "vector or scalar to scale by"
|
||||
|
||||
let
|
||||
scaleObjs stretch2 stretch3 =
|
||||
objMap (Prim.scale stretch2) (Prim.scale stretch3) children
|
||||
|
||||
return $ return $ case v of
|
||||
Left x -> scaleObjs (x,1) (x,1,1)
|
||||
Right (Left (x,y)) -> scaleObjs (x,y) (x,y,1)
|
||||
@ -343,7 +308,6 @@ scale = moduleWithSuite "scale" $ \children -> do
|
||||
extrude :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
extrude = moduleWithSuite "linear_extrude" $ \children -> do
|
||||
example "linear_extrude(10) square(5);"
|
||||
|
||||
height :: Either ℝ (ℝ -> ℝ -> ℝ) <- argument "height" `defaultTo` Left 1
|
||||
`doc` "height to extrude to..."
|
||||
center :: Bool <- argument "center" `defaultTo` False
|
||||
@ -356,7 +320,6 @@ extrude = moduleWithSuite "linear_extrude" $ \children -> do
|
||||
`doc` "translate according to this funciton as we extrude..."
|
||||
r :: ℝ <- argument "r" `defaultTo` 0
|
||||
`doc` "round the top?"
|
||||
|
||||
let
|
||||
heightn = case height of
|
||||
Left h -> h
|
||||
@ -365,21 +328,17 @@ extrude = moduleWithSuite "linear_extrude" $ \children -> do
|
||||
height' = case height of
|
||||
Right f -> Right $ uncurry f
|
||||
Left a -> Left a
|
||||
|
||||
shiftAsNeeded :: SymbolicObj3 -> SymbolicObj3
|
||||
shiftAsNeeded =
|
||||
if center
|
||||
then Prim.translate (0,0,-heightn/2.0)
|
||||
else id
|
||||
|
||||
funcify :: (VectorSpace a, Fractional (Scalar a)) => Either a (ℝ -> a) -> ℝ -> a
|
||||
funcify (Left val) h = realToFrac (h/heightn) *^ val
|
||||
funcify (Right f ) h = f h
|
||||
|
||||
twist' = fmap funcify twist
|
||||
scale' = fmap funcify scaleArg
|
||||
translate' = fmap funcify translateArg
|
||||
|
||||
return $ return $ obj2UpMap (
|
||||
\obj -> case height of
|
||||
Left constHeight | isNothing twist && isNothing scaleArg && isNothing translateArg ->
|
||||
@ -391,13 +350,11 @@ extrude = moduleWithSuite "linear_extrude" $ \children -> do
|
||||
rotateExtrude :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
rotateExtrude = moduleWithSuite "rotate_extrude" $ \children -> do
|
||||
example "rotate_extrude() translate(20) circle(10);"
|
||||
|
||||
totalRot :: ℝ <- argument "a" `defaultTo` 360
|
||||
`doc` "angle to sweep"
|
||||
r :: ℝ <- argument "r" `defaultTo` 0
|
||||
translateArg :: Either ℝ2 (ℝ -> ℝ2) <- argument "translate" `defaultTo` Left (0,0)
|
||||
rotateArg :: Either ℝ (ℝ -> ℝ ) <- argument "rotate" `defaultTo` Left 0
|
||||
|
||||
let
|
||||
is360m :: RealFrac a => a -> Bool
|
||||
is360m n = 360 * fromInteger (round $ n / 360) /= n
|
||||
@ -405,11 +362,8 @@ rotateExtrude = moduleWithSuite "rotate_extrude" $ \children -> do
|
||||
|| either ( /= (0,0)) (\f -> f 0 /= f totalRot) translateArg
|
||||
|| either is360m (\f -> is360m (f 0 - f totalRot)) rotateArg
|
||||
capM = if cap then Just r else Nothing
|
||||
|
||||
return $ return $ obj2UpMap (Prim.rotateExtrude totalRot capM translateArg rotateArg) children
|
||||
|
||||
|
||||
|
||||
{-
|
||||
rotateExtrudeStatement :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
rotateExtrudeStatement = moduleWithSuite "rotate_extrude" $ \suite -> do
|
||||
@ -426,21 +380,17 @@ shell :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
shell = moduleWithSuite "shell" $ \children -> do
|
||||
w :: ℝ <- argument "w"
|
||||
`doc` "width of the shell..."
|
||||
|
||||
return $ return $ objMap (Prim.shell w) (Prim.shell w) children
|
||||
|
||||
-- Not a permanent solution! Breaks if can't pack.
|
||||
pack :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
pack = moduleWithSuite "pack" $ \children -> do
|
||||
|
||||
example "pack ([45,45], sep=2) { circle(10); circle(10); circle(10); circle(10); }"
|
||||
|
||||
-- arguments
|
||||
size :: ℝ2 <- argument "size"
|
||||
`doc` "size of 2D box to pack objects within"
|
||||
sep :: ℝ <- argument "sep"
|
||||
`doc` "mandetory space between objects"
|
||||
|
||||
-- The actual work...
|
||||
return $
|
||||
let (obj2s, obj3s, others) = divideObjs children
|
||||
@ -458,13 +408,10 @@ pack = moduleWithSuite "pack" $ \children -> do
|
||||
|
||||
unit :: (String, [OVal] -> ArgParser (IO [OVal]))
|
||||
unit = moduleWithSuite "unit" $ \children -> do
|
||||
|
||||
example "unit(\"inch\") {..}"
|
||||
|
||||
-- arguments
|
||||
name :: String <- argument "unit"
|
||||
`doc` "the unit you wish to work in"
|
||||
|
||||
let
|
||||
mmRatio :: Fractional a => String -> Maybe a
|
||||
mmRatio "inch" = Just 25.4
|
||||
@ -482,7 +429,6 @@ unit = moduleWithSuite "unit" $ \children -> do
|
||||
mmRatio "um" = mmRatio "µm"
|
||||
mmRatio "nm" = Just 0.0000001
|
||||
mmRatio _ = Nothing
|
||||
|
||||
-- The actual work...
|
||||
return $ case mmRatio name of
|
||||
Nothing -> do
|
||||
@ -491,7 +437,6 @@ unit = moduleWithSuite "unit" $ \children -> do
|
||||
Just r ->
|
||||
return $ objMap (Prim.scale (r,r)) (Prim.scale (r,r,r)) children
|
||||
|
||||
|
||||
---------------
|
||||
|
||||
(<|>) :: ArgParser a -> ArgParser a -> ArgParser a
|
||||
|
Loading…
Reference in New Issue
Block a user