Merge pull request #471 from lepsa/more-primitives

Adding more primitives
Haskell-Things · Jan 6, 2024 · 0c254d9 · 0c254d9
2 parents 80222ec + 82c987e
commit 0c254d9
Show file tree

Hide file tree

Showing 11 changed files with 125,089 additions and 9 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -6,6 +6,7 @@
 * Haskell interface changes
   * `extrude` arguments are now swapped, instead of `extrude obj height` we now have `extrude height obj` [#473](https://github.com/Haskell-Things/ImplicitCAD/issues/473)
   * Added `slice` primitive [#448](https://github.com/Haskell-Things/ImplicitCAD/pull/448)
+  * Added `boxFrame` and `link` primitive [#471](https://github.com/Haskell-Things/ImplicitCAD/pull/471)
 
 * Other changes
   * Fixing `shell` so that it doesn't increase the outside dimentions of objects.

diff --git a/Graphics/Implicit/Canon.hs b/Graphics/Implicit/Canon.hs
@@ -94,6 +94,8 @@ import Graphics.Implicit.Definitions
       , Transform3
       , Torus
       , Ellipsoid
+      , BoxFrame
+      , Link
       )
   , hasZeroComponent
   )
@@ -177,6 +179,8 @@ fmapObj3 f _ _ (Sphere r) = f $ Sphere r
 fmapObj3 f _ _ (Cylinder r1 r2 h) = f $ Cylinder r1 r2 h
 fmapObj3 f _ _ (Torus r1 r2) = f $ Torus r1 r2
 fmapObj3 f _ _ (Ellipsoid a b c) = f $ Ellipsoid a b c
+fmapObj3 f _ _ (BoxFrame b e) = f $ BoxFrame b e
+fmapObj3 f _ _ (Link le r1 r2) = f $ Link le r1 r2
 fmapObj3 f g s (Rotate3 q o) = f $ Rotate3 q (fmapObj3 f g s o)
 fmapObj3 f g s (Transform3 m o) = f $ Transform3 m (fmapObj3 f g s o)
 fmapObj3 f g s (Extrude h o2) = f $ Extrude h (fmapObj2 g f s o2)
@@ -235,6 +239,8 @@ instance EqObj SymbolicObj3 where
   Torus a1 a2 =^= Torus b1 b2 = a1 == b1 && a2 == b2
   Ellipsoid a1 b1 c1 =^= Ellipsoid a2 b2 c2 = a1 == a2 && b1 == b2 && c1 == c2
   Cylinder r1a r2a ha =^= Cylinder r1b r2b hb = r1a == r1b && r2a == r2b && ha == hb
+  BoxFrame b1 e1 =^= BoxFrame b2 e2 = b1 == b2 && e1 == e2
+  Link a1 b1 c1 =^= Link a2 b2 c2 = a1 == a2 && b1 == b2 && c1 == c2
   Rotate3 x a =^= Rotate3 y b = x == y && a =^= b
   Transform3 x a =^= Transform3 y b = x == y && a =^= b
   Extrude x a =^= Extrude y b = x == y && a =^= b
@@ -308,6 +314,7 @@ canon3 :: SymbolicObj3 -> SymbolicObj3
 canon3 (Cube v) | hasZeroComponent v = emptySpace
 canon3 (Sphere 0) = emptySpace
 canon3 (Cylinder 0 _ _) = emptySpace
+canon3 (BoxFrame _ 0) = emptySpace
 canon3 (Extrude 0 _o2) = emptySpace
 canon3 (Torus _ 0) = emptySpace
 canon3 (Ellipsoid 0 _ _) = emptySpace

diff --git a/Graphics/Implicit/Definitions.hs b/Graphics/Implicit/Definitions.hs
@@ -61,6 +61,8 @@ module Graphics.Implicit.Definitions (
         Transform3,
         Torus,
         Ellipsoid,
+        BoxFrame,
+        Link,
         Extrude,
         ExtrudeM,
         ExtrudeOnEdgeOf,
@@ -332,6 +334,8 @@ data SymbolicObj3 =
     | Cylinder ℝ ℝ ℝ --
     | Torus ℝ ℝ
     | Ellipsoid ℝ ℝ ℝ
+    | BoxFrame ℝ3 ℝ -- b e from https://iquilezles.org/articles/distfunctions/
+    | Link ℝ ℝ ℝ -- le r1 r2 from https://iquilezles.org/articles/distfunctions/
     -- Simple transforms
     | Rotate3 (Quaternion ℝ) SymbolicObj3
     | Transform3 (M44 ℝ) SymbolicObj3
@@ -359,6 +363,8 @@ instance Show SymbolicObj3 where
     -- centered.
     Cube sz -> showCon "cube" @| False @| sz
     Sphere d -> showCon "sphere" @| d
+    BoxFrame b e -> showCon "boxFrame" @| b @| e
+    Link le r1 r2 -> showCon "link" @| le @| r1 @| r2
     -- NB: The arguments to 'Cylinder' are backwards compared to 'cylinder' and
     -- 'cylinder2'.
     Cylinder h r1 r2 | r1 == r2 ->

diff --git a/Graphics/Implicit/Export/RayTrace.hs b/Graphics/Implicit/Export/RayTrace.hs
@@ -3,7 +3,7 @@
 -- Copyright 2016, Julia Longtin ([email protected])
 -- Released under the GNU AGPLV3+, see LICENSE
 
-module Graphics.Implicit.Export.RayTrace( Color(Color), average, Camera(Camera), Light(Light), Scene(Scene), traceRay, cameraRay) where
+module Graphics.Implicit.Export.RayTrace( Color(Color), average, Camera(Camera), Light(Light), Scene(Scene), traceRay, cameraRay, vectorDistance) where
 
 import Prelude(Show, RealFrac, Maybe(Just, Nothing), Bool(False, True), (-), (.), ($), (*), (/), min, fromInteger, max, round, fromIntegral, unzip, fmap, length, sum, maximum, minimum, (>), (+), (<), (==), pred, flip, not, abs, floor, toRational, otherwise, pure)
 

diff --git a/Graphics/Implicit/Export/SymbolicFormats.hs b/Graphics/Implicit/Export/SymbolicFormats.hs
@@ -12,7 +12,7 @@ module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where
 
 import Prelude((.), fmap, Either(Left, Right), ($), (*), ($!), (-), (/), pi, error, (+), (==), take, floor, (&&), const, pure, (<>), sequenceA, (<$>))
 
-import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(Shared2, Square, Circle, Polygon, Rotate2, Transform2, Slice), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf, Torus, Ellipsoid), isScaleID, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Outset, Shell, EmbedBoxedObj, WithRounding), quaternionToEuler)
+import Graphics.Implicit.Definitions(ℝ, SymbolicObj2(Shared2, Square, Circle, Polygon, Rotate2, Transform2, Slice), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, BoxFrame, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf, Torus, Ellipsoid, Link), isScaleID, SharedObj(Empty, Full, Complement, UnionR, IntersectR, DifferenceR, Translate, Scale, Mirror, Outset, Shell, EmbedBoxedObj, WithRounding), quaternionToEuler)
 import Graphics.Implicit.Export.TextBuilderUtils(Text, Builder, toLazyText, fromLazyText, bf)
 
 import Control.Monad.Reader (Reader, runReader, ask)
@@ -131,6 +131,14 @@ buildS3 (Torus r1 r2) = callNaked "torus" ["r1 = " <> bf r1, "r2 = " <> bf r2]
 
 buildS3 (Ellipsoid a b c) = callNaked "ellipsoid" ["a = " <> bf a, "b = " <> bf b, "c = " <> bf c] []
 
+buildS3 (BoxFrame (V3 w d h) e) = callNaked "boxFrame"
+  ["w = " <> bf w, "d = " <> bf d, "h = " <> bf h, "e = " <> bf e]
+  []
+
+buildS3 (Link le r1 r2) = callNaked "link"
+  ["le = " <> bf le, "r1 = " <> bf r1, "r2 = " <> bf r2]
+  []
+
 buildS3 (Cylinder h r1 r2) = callNaked "cylinder" [
                               "r1 = " <> bf r1
                              ,"r2 = " <> bf r2

diff --git a/Graphics/Implicit/ObjectUtil/GetBox3.hs b/Graphics/Implicit/ObjectUtil/GetBox3.hs
@@ -12,7 +12,7 @@ import Graphics.Implicit.Definitions
     ( Fastℕ,
       fromFastℕ,
       ExtrudeMScale(C2, C1),
-      SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeOnEdgeOf, ExtrudeM, RotateExtrude, Torus, Ellipsoid),
+      SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeOnEdgeOf, ExtrudeM, RotateExtrude, Torus, Ellipsoid, BoxFrame, Link),
       Box3,
       ℝ,
       fromFastℕtoℝ,
@@ -38,6 +38,12 @@ getBox3 (Torus r1 r2) =
   let r = r1 + r2
   in (V3 (-r) (-r) (-r2), V3 r r r2)
 getBox3 (Ellipsoid a b c) = (V3 (-a) (-b) (-c), V3 a b c)
+getBox3 (BoxFrame b _) = (-b, b)
+getBox3 (Link le r1 r2) =
+  let r = r1 + r2
+      v = V3 (le + r) (r1*2) (r2*2)
+      -- V3 (le+(r*2)) r (r2*2)
+  in (-v, v)
 -- (Rounded) CSG
 -- Simple transforms
 getBox3 (Rotate3 q symbObj) =

diff --git a/Graphics/Implicit/ObjectUtil/GetImplicit3.hs b/Graphics/Implicit/ObjectUtil/GetImplicit3.hs
@@ -6,24 +6,45 @@
 
 module Graphics.Implicit.ObjectUtil.GetImplicit3 (getImplicit3) where
 
-import Prelude (id, (||), (/=), either, round, fromInteger, Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, minimum, ($), sin, pi, (.), Bool(True, False), ceiling, floor, pure, (==), otherwise, (**))
+import Prelude (id, (||), (/=), either, round, fromInteger, Either(Left, Right), abs, (-), (/), (*), sqrt, (+), atan2, max, cos, minimum, ($), sin, pi, (.), Bool(True, False), ceiling, floor, pure, (==), otherwise, (**), min, Num, Applicative)
 
 import Graphics.Implicit.Definitions
-    ( objectRounding, ObjectContext, ℕ, SymbolicObj3(Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeM, ExtrudeOnEdgeOf, RotateExtrude, Shared3, Torus, Ellipsoid), Obj3, ℝ2, ℝ, fromℕtoℝ, toScaleFn )
+    ( objectRounding,
+      ObjectContext,
+      ℕ,
+      SymbolicObj3(Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude,
+                   ExtrudeM, ExtrudeOnEdgeOf, RotateExtrude, Shared3, Torus, Ellipsoid, BoxFrame, Link),
+      Obj3,
+      ℝ2,
+      ℝ,
+      fromℕtoℝ,
+      toScaleFn,
+      ℝ3 )
 
 import Graphics.Implicit.MathUtil ( rmax, rmaximum )
 
 import qualified Data.Either as Either (either)
 
 -- Use getImplicit for handling extrusion of 2D shapes to 3D.
 import Graphics.Implicit.ObjectUtil.GetImplicitShared (getImplicitShared)
-import Linear (V2(V2), V3(V3))
+import Linear (V2(V2), V3(V3), _xy, _z)
 import qualified Linear
 
 import {-# SOURCE #-} Graphics.Implicit.Primitives (getImplicit)
+import Control.Lens ((^.))
 
 default (ℝ)
 
+-- Length similar to the opengl version, needed for some of the shape definitions
+openglLength :: (Linear.Metric f, Num (f ℝ), Applicative f) => f ℝ -> ℝ
+openglLength v = Linear.distance (abs v) $ pure 0
+
+-- Component wise maximum. This is what the opengl language is doing, so we need
+-- it for the function as defined by the blog above.
+-- See "Maximum" http://15462.courses.cs.cmu.edu/fall2019/article/20
+compMax :: ℝ3 -> ℝ3 -> ℝ3
+compMax (V3 a1 b1 c1) (V3 a2 b2 c2) = V3 (max a1 a2) (max b1 b2) (max c1 c2)
+
 -- Get a function that describes the surface of the object.
 getImplicit3 :: ObjectContext -> SymbolicObj3 -> Obj3
 -- Primitives
@@ -39,6 +60,20 @@ getImplicit3 _ (Cylinder h r1 r2) = \(V3 x y z) ->
         θ = atan2 (r2-r1) h
     in
         max (d * cos θ) (abs (z-h/2) - (h/2))
+getImplicit3 _ (BoxFrame b e) = \p' ->
+    let p@(V3 px py pz) = abs p' - b
+        V3 qx qy qz = abs (p + pure e) - pure e
+        -- Splitting out bits from https://iquilezles.org/articles/distfunctions/
+        -- to make it somewhat readable.
+        -- These names don't mean anything, and are just for splitting up the code.
+        x', y', z' :: ℝ
+        x' = openglLength (compMax (V3 px qy qz) (pure 0)) + min (max px (max qy qz)) 0
+        y' = openglLength (compMax (V3 qx py qz) (pure 0)) + min (max qx (max py qz)) 0
+        z' = openglLength (compMax (V3 qx qy pz) (pure 0)) + min (max qx (max qy pz)) 0
+    in min (min x' y') z'
+getImplicit3 _ (Link le r1 r2) = \(V3 px py pz) ->
+    let q = V3 px (max (abs py - le) 0) pz
+    in openglLength (V2 (openglLength (q ^. _xy) - r1) (q ^. _z)) - r2
 -- Simple transforms
 getImplicit3 ctx (Rotate3 q symbObj) =
     getImplicit3 ctx symbObj . Linear.rotate (Linear.conjugate q)
@@ -156,4 +191,3 @@ getImplicit3 ctx (RotateExtrude totalRotation translate rotate symbObj) =
                     (obj rz_pos)
               else obj rz_pos
 getImplicit3 ctx (Shared3 obj) = getImplicitShared ctx obj
-
diff --git a/Graphics/Implicit/Primitives.hs b/Graphics/Implicit/Primitives.hs
@@ -25,6 +25,7 @@ module Graphics.Implicit.Primitives (
                                      getImplicit',
                                      extrude,
                                      extrudeM,
+                                     link,
                                      extrudeOnEdgeOf,
                                      sphere,
                                      cube, rect3,
@@ -50,6 +51,7 @@ module Graphics.Implicit.Primitives (
                                      emptySpace,
                                      fullSpace,
                                      withRounding,
+                                     boxFrame,
                                      _Shared,
                                      pattern Shared,
                                      Object(Space, canonicalize)) where
@@ -87,14 +89,16 @@ import Graphics.Implicit.Definitions (ObjectContext, ℝ, ℝ2, ℝ3, Box2,
                                                    Sphere,
                                                    Cylinder,
                                                    Torus,
+                                                   BoxFrame,
                                                    Rotate3,
                                                    Transform3,
                                                    Extrude,
                                                    ExtrudeM,
                                                    RotateExtrude,
                                                    ExtrudeOnEdgeOf,
                                                    Shared3,
-                                                   Ellipsoid
+                                                   Ellipsoid,
+                                                   Link
                                                   ),
                                       ExtrudeMScale,
                                       defaultObjectContext
@@ -144,6 +148,12 @@ cylinder ::
     -> SymbolicObj3     -- ^ Resulting cylinder
 cylinder r = cylinder2 r r
 
+boxFrame :: ℝ3 -> ℝ -> SymbolicObj3
+boxFrame = BoxFrame
+
+link :: ℝ -> ℝ -> ℝ -> SymbolicObj3
+link = Link
+
 cone ::
     ℝ                   -- ^ Radius of the cylinder
     -> ℝ                -- ^ Height of the cylinder

diff --git a/tests/GoldenSpec/Spec.hs b/tests/GoldenSpec/Spec.hs
@@ -10,7 +10,7 @@ import Graphics.Implicit
 import Graphics.Implicit.Export.OutputFormat (OutputFormat (PNG))
 import Prelude
 import Test.Hspec ( describe, Spec )
-import Graphics.Implicit.Primitives (torus, ellipsoid, cone)
+import Graphics.Implicit.Primitives (torus, ellipsoid, cone, boxFrame, link)
 
 default (Int)
 
@@ -173,6 +173,18 @@ spec = describe "golden tests" $ do
       , translate (V3 0 0 25) $ cone 20 20
       ]
 
+  golden "boxFrame" 2 $
+    union
+      [ boxFrame (V3 20 20 20) 2
+      , translate (V3 0 0 10) $ boxFrame (V3 10 10 10) 2
+      ]
+
+  golden "link" 2 $
+    union
+     [ link 13 20 9
+     , translate (V3 0 0 10 )$ rotate3 (V3 0 (pi/2) 0) $ rotate3 (V3 (pi/2) 0 0) $ link 6.5 10 4.5
+     ]
+
   golden "closing-paths-1" 0.5 $
     extrudeM
       (Left 0)