Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

API change: CSG operations take lists.

  • Loading branch information...
commit a671d0595f27a8b15d2ea04e2d6789507c325910 1 parent 04cd08c
@colah authored
View
1  Graphics/Implicit.hs
@@ -11,7 +11,6 @@ module Graphics.Implicit(
complement,
union, intersect, difference,
unionR, intersectR, differenceR,
- unionL, intersectL, differenceL,
shell,
slice,
bubble,
View
26 Graphics/Implicit/MathUtil.hs
@@ -4,18 +4,27 @@
module Graphics.Implicit.MathUtil (rmax, rmin, rmaximum, rminimum) where
import Data.List
+import Graphics.Implicit.Definitions
-- | Rounded Maximum
-- Consider max(x,y) = 0, the generated curve
-- has a square-like corner. We replace it with a
-- quarter of a circle
-
+rmax ::
+ ℝ -- ^ radius
+ -> ℝ -- ^ first number to round maximum
+ -> ℝ -- ^ second number to round maximum
+ -> ℝ -- ^ resulting number
rmax r x y = if abs (x-y) < r
then y - r*sin(pi/4-asin((x-y)/r/sqrt 2)) + r
else max x y
-- | Rounded minimum
-
+rmin ::
+ ℝ -- ^ radius
+ -> ℝ -- ^ first number to round minimum
+ -> ℝ -- ^ second number to round minimum
+ -> ℝ -- ^ resulting number
rmin r x y = if abs (x-y) < r
then y + r*sin(pi/4+asin((x-y)/r/sqrt 2)) - r
else min x y
@@ -25,6 +34,12 @@ rmin r x y = if abs (x-y) < r
-- The implementation is to take the maximum two
-- and rmax those.
+rmaximum ::
+ ℝ -- ^ radius
+ -> [ℝ] -- ^ numbers to take round maximum
+ -> ℝ -- ^ resulting number
+rmaximum _ (a:[]) = a
+rmaximum r (a:b:[]) = rmax r a b
rmaximum r l =
let
tops = reverse $ sort l
@@ -32,7 +47,12 @@ rmaximum r l =
rmax r (tops !! 0) (tops !! 1)
-- | Like rmin but on a list.
-
+rminimum ::
+ ℝ -- ^ radius
+ -> [ℝ] -- ^ numbers to take round minimum
+ -> ℝ -- ^ resulting number
+rminimum r (a:[]) = a
+rminimum r (a:b:[]) = rmin r a b
rminimum r l =
let
tops = sort l
View
45 Graphics/Implicit/Operations.hs
@@ -9,7 +9,6 @@ module Graphics.Implicit.Operations (
complement,
union, intersect, difference,
unionR, intersectR, differenceR,
- unionL, intersectL, differenceL,
shell,
slice,
bubble,
@@ -52,53 +51,43 @@ shell w a = \p -> abs (a p) - w/(2.0::ℝ)
-- | Rounded union
unionR ::
- ℝ -- ^ The radius of rounding
- -> (a -> ℝ) -- ^ First object to union
- -> (a -> ℝ) -- ^ Second object to union
+ ℝ -- ^ The radius of rounding
+ -> [a -> ℝ] -- ^ objects to union
-> (a -> ℝ) -- ^ Resulting object
-unionR r a b = \p -> rmin r (a p) (b p)
+unionR r objs = \p -> rminimum r $ map ($p) objs
-- | Rounded minimum
-intersectR :: -- ^ The radius of rounding
- -> (a -> ℝ) -- ^ First object to intersect
- -> (a -> ℝ) -- ^ Second object to intersect
+intersectR ::
+ -- ^ The radius of rounding
+ -> [a -> ℝ] -- ^ Objects to intersect
-> (a -> ℝ) -- ^ Resulting object
-intersectR r a b = \p -> rmax r (a p) (b p)
+intersectR r objs = \p -> rmaximum r $ map ($p) objs
-- | Rounded difference
-differenceR :: -- ^ The radius of rounding
- -> (a -> ℝ) -- ^ First object
- -> (a -> ℝ) -- ^ Object to cut out of the first object
+differenceR ::
+ -- ^ The radius of rounding
+ -> [a -> ℝ] -- ^ Objects to difference
-> (a -> ℝ) -- ^ Resulting object
-differenceR r a b = \p -> rmax r (a p) (- b p)
+differenceR r (x:xs) = \p -> rmaximum r $ (x p) :(map (negate . ($p)) xs)
-- | Union a list of objects
-unionL ::
+union ::
[a -> ℝ] -- ^ List of objects to union
-> (a -> ℝ) -- ^ The object resulting from the union
-unionL objs = \p -> minimum $ map ($p) objs
+union objs = \p -> minimum $ map ($p) objs
-- | Intersect a list of objects
-intersectL ::
+intersect ::
[a -> ℝ] -- ^ List of objects to intersect
-> (a -> ℝ) -- ^ The object resulting from the intersection
-intersectL objs = \p -> maximum $ map ($p) objs
+intersect objs = \p -> maximum $ map ($p) objs
-- | Difference a list of objects
-differenceL ::
+difference ::
[a -> ℝ] -- ^ List of objects to difference
-> (a -> ℝ) -- ^ The object resulting from the difference
-differenceL (obj:objs) = \p -> maximum $ map ($p) $ obj:(map complement objs)
-
-
-
-
-union a b = unionL [a,b]
-(∪) a b = union a b
-intersect a b = intersectL [a,b]
-(∩) a b = intersect a b
-difference a b = differenceL [a,b]
+difference (obj:objs) = \p -> maximum $ map ($p) $ obj:(map complement objs)
-- | Slice a 3D objects at a given z value to make a 2D object.
slice ::
View
18 README.md
@@ -26,9 +26,9 @@ A simple 2D example:
```haskell
import Graphics.Implicit
-out = union
- (square 80)
- (translate (40,40) (circle 30) )
+out = union [
+ square 80,
+ translate (40,40) (circle 30) ]
writeSVG (-100,-100) (100,100) 2 "test.svg" out
```
@@ -41,9 +41,9 @@ A rounded union:
```haskell
import Graphics.Implicit
-out = unionR 14
- (square 80)
- (translate (40,40) (circle 30) )
+out = unionR 14 [
+ square 80,
+ translate (40,40) (circle 30) ]
writeSVG (-100,-100) (100,100) 2 "test.svg" out
```
@@ -55,9 +55,9 @@ A simple 3D example:
```haskell
import Graphics.Implicit
-out = union
- (cube 40)
- (translate (20,20,20) (sphere 15) )
+out = union [
+ cube 40,
+ translate (20,20,20) (sphere 15) ]
writeSTL (-50,-50,-50) (50,50,50) 1 "test.stl" out
```
Please sign in to comment.
Something went wrong with that request. Please try again.