Adding link

Adding a link primitive and tests

Graphics/Implicit/Canon.hs

@@ -90,7 +90,7 @@ import Graphics.Implicit.Definitions
       , RotateExtrude
       , Shared3
       , Sphere
-      , Transform3, BoxFrame
+      , Transform3, BoxFrame, Link
       )
   , hasZeroComponent
   )
@@ -172,6 +172,7 @@ fmapObj3 f _ _ (Cube v) = f $ Cube v
 fmapObj3 f _ _ (Sphere r) = f $ Sphere r
 fmapObj3 f _ _ (Cylinder r1 r2 h) = f $ Cylinder r1 r2 h
 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 o2 h) = f $ Extrude (fmapObj2 g f s o2) h
@@ -228,6 +229,7 @@ instance EqObj SymbolicObj3 where
   Sphere a =^= Sphere b = a == b
   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 a x =^= Extrude b y = x == y && a =^= b

Graphics/Implicit/Definitions.hs

@@ -59,6 +59,7 @@ module Graphics.Implicit.Definitions (
         Rotate3,
         Transform3,
         BoxFrame,
+        Link,
         Extrude,
         ExtrudeM,
         ExtrudeOnEdgeOf,
@@ -326,6 +327,7 @@ data SymbolicObj3 =
     | Sphere ℝ -- radius
     | Cylinder ℝ ℝ ℝ --
     | 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
@@ -354,6 +356,7 @@ instance Show SymbolicObj3 where
     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 ->

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), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, BoxFrame, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf), 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), SymbolicObj3(Shared3, Cube, Sphere, Cylinder, BoxFrame, Rotate3, Transform3, Extrude, ExtrudeM, RotateExtrude, ExtrudeOnEdgeOf, 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,10 @@ 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

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, BoxFrame),
+      SymbolicObj3(Shared3, Cube, Sphere, Cylinder, Rotate3, Transform3, Extrude, ExtrudeOnEdgeOf, ExtrudeM, RotateExtrude, BoxFrame, Link),
       Box3,
       ℝ,
       fromFastℕtoℝ,
@@ -35,6 +35,11 @@ getBox3 (Cube size) = (pure 0, size)
 getBox3 (Sphere r) = (pure (-r), pure r)
 getBox3 (Cylinder h r1 r2) = (V3 (-r) (-r) 0, V3 r r h ) where r = max r1 r2
 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) =

Graphics/Implicit/ObjectUtil/GetImplicit3.hs

@@ -6,14 +6,14 @@
 
 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, min)
+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, BoxFrame),
+                   ExtrudeM, ExtrudeOnEdgeOf, RotateExtrude, Shared3, BoxFrame, Link),
       Obj3,
       ℝ2,
       ℝ,
@@ -27,13 +27,24 @@ 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
@@ -52,19 +63,15 @@ getImplicit3 _ (BoxFrame b e) = \p' ->
         V3 qx qy qz = abs (p + pure e) - pure e
         -- Splitting out bits from https://iquilezles.org/articles/distfunctions/
         -- to make it somewhat readable.
-        length :: ℝ3 -> ℝ
-        length 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)
         -- These names don't mean anything, and are just for splitting up the code.
         x', y', z' :: ℝ
-        x' = length (compMax (V3 px qy qz) (pure 0)) + min (max px (max qy qz)) 0
-        y' = length (compMax (V3 qx py qz) (pure 0)) + min (max qx (max py qz)) 0
-        z' = length (compMax (V3 qx qy pz) (pure 0)) + min (max qx (max qy pz)) 0
+        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)
@@ -181,5 +188,4 @@ getImplicit3 ctx (RotateExtrude totalRotation translate rotate symbObj) =
                     (abs (θvirt - (totalRotation / 2)) - (totalRotation / 2))
                     (obj rz_pos)
               else obj rz_pos
-getImplicit3 ctx (Shared3 obj) = getImplicitShared ctx obj
-
+getImplicit3 ctx (Shared3 obj) = getImplicitShared ctx obj

Graphics/Implicit/Primitives.hs

@@ -25,6 +25,7 @@ module Graphics.Implicit.Primitives (
                                      getImplicit',
                                      extrude,
                                      extrudeM,
+                                     link,
                                      extrudeOnEdgeOf,
                                      sphere,
                                      cube, rect3,
@@ -91,7 +92,7 @@ import Graphics.Implicit.Definitions (ObjectContext, ℝ, ℝ2, ℝ3, Box2,
                                                    ExtrudeM,
                                                    RotateExtrude,
                                                    ExtrudeOnEdgeOf,
-                                                   Shared3
+                                                   Shared3, Link
                                                   ),
                                       ExtrudeMScale,
                                       defaultObjectContext
@@ -144,6 +145,9 @@ cylinder r = cylinder2 r r
 boxFrame :: ℝ3 -> ℝ -> SymbolicObj3
 boxFrame = BoxFrame
 
+link :: ℝ -> ℝ -> ℝ -> SymbolicObj3
+link = Link
+
 cone ::
     ℝ                   -- ^ Radius of the cylinder
     -> ℝ                -- ^ Height of the cylinder

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, boxFrame)
+import Graphics.Implicit.Primitives (torus, ellipsoid, cone, boxFrame, link)
 
 default (Int)
 
@@ -179,6 +179,12 @@ spec = describe "golden tests" $ do
       , 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)