promote ℝ to an instance of a typeclass

Graphics/Implicit/Definitions.hs

@@ -16,12 +16,11 @@
 module Graphics.Implicit.Definitions (
     module F,
     module N,
-    ℝ,
+    module R,
     ℝ2,
     both,
     ℝ3,
     allthree,
-    minℝ,
     (⋅),
     (⋯*),
     (⋯/),
@@ -72,38 +71,29 @@ module Graphics.Implicit.Definitions (
         ExtrudeRotateR,
         ExtrudeRM,
         ExtrudeOnEdgeOf,
-        RotateExtrude),
-    fromℕtoℝ,
-    fromFastℕtoℝ,
-    fromℝtoFloat
+        RotateExtrude)
     )
 where
 
-import Prelude (Show, Double, Either, show, (*), (/), fromIntegral, Float, realToFrac)
+import Prelude (Show, Either, show, (*), (/))
 
 import Data.Maybe (Maybe)
 
 import Data.VectorSpace (Scalar, InnerSpace, (<.>))
 
-import Graphics.Implicit.FastIntUtil as F (Fastℕ(Fastℕ), fromFastℕ, toFastℕ)
+import Graphics.Implicit.RationalUtil as R (ℚ(minℝ, π, sqrt, cbrt, powℝ, powℝℝ, exp, log, cos, sin, tan, asin, acos, atan, sinh, cosh, tanh, atan2, fromℝ, toℝ, normalizeℝ2, normalizeℝ3, powℝ, (%), infty, neginfty), ℝ, fromFastℕtoℝ, fromℕtoℝ, fromℝtoℕ, fromℝtoFloat)
 
 import Graphics.Implicit.IntegralUtil as N (ℕ, fromℕ, toℕ)
 
+import Graphics.Implicit.FastIntUtil as F (Fastℕ(Fastℕ), fromFastℕ, toFastℕ)
+
 import Control.DeepSeq (NFData, rnf)
 
 -- Let's make things a bit nicer. 
 -- Following the math notation ℝ, ℝ², ℝ³...
-type ℝ = Double
 type ℝ2 = (ℝ,ℝ)
 type ℝ3 = (ℝ,ℝ,ℝ)
 
--- | A give up point for dividing ℝs
-minℝ :: ℝ
--- for Doubles.
-minℝ = 0.0000000000000002
--- for Floats.
---minℝ = 0.00000011920928955078125 * 2
-
 -- | apply a function to both items in the provided tuple.
 both :: forall t b. (t -> b) -> (t, t) -> (b, b)
 both f (x,y) = (f x, f y)
@@ -119,23 +109,6 @@ allthree f (x,y,z) = (f x, f y, f z)
 (⋅) = (<.>)
 {-# INLINABLE (⋅) #-}
 
--- Wrap the functions that convert datatypes.
-
--- | Convert from our Integral to our Rational. 
-fromℕtoℝ :: ℕ -> ℝ
-fromℕtoℝ = fromIntegral
-{-# INLINABLE fromℕtoℝ #-}
-
--- | Convert from our Fast Integer (int32) to ℝ.
-fromFastℕtoℝ :: Fastℕ -> ℝ
-fromFastℕtoℝ (Fastℕ a) = fromIntegral a
-{-# INLINABLE fromFastℕtoℝ #-}
-
--- | Convert from our rational to a float, for output to a file.
-fromℝtoFloat :: ℝ -> Float
-fromℝtoFloat = realToFrac
-{-# INLINABLE fromℝtoFloat #-}
-
 -- | add aditional instances to Show, for when we dump the intermediate form of objects.
 --   FIXME: store functions in a dumpable form!
 --   These instances cover functions
@@ -291,4 +264,3 @@ data SymbolicObj3 =
         SymbolicObj2          -- object to extrude
     | ExtrudeOnEdgeOf SymbolicObj2 SymbolicObj2
     deriving Show
-

Graphics/Implicit/Export/RayTrace.hs

@@ -10,15 +10,15 @@ module Graphics.Implicit.Export.RayTrace( Color(Color), average, Camera(Camera),
 import Prelude(Show, RealFrac, Maybe(Just, Nothing), Bool(False, True), (-), (.), ($), (*), (/), min, fromInteger, max, round, fromIntegral, unzip, map, length, sum, maximum, minimum, (>), (+), (<), (==), pred, flip, not, abs, floor, toRational, otherwise)
 
 -- Our number system, and the definition of a 3D object.
-import Graphics.Implicit.Definitions (ℝ, Fastℕ, ℝ2, ℝ3, (⋅), Obj3)
+import Graphics.Implicit.Definitions (ℝ, Fastℕ, ℝ2, ℝ3, (⋅), Obj3, normalizeℝ3, sqrt)
 
 import Codec.Picture (Pixel8)
 
 import Control.Monad (guard, return)
 
 import Control.Arrow ((***))
 
-import Data.VectorSpace (Scalar, magnitude, (^+^), (*^), normalized, (^-^), InnerSpace)
+import Data.VectorSpace (magnitudeSq, (^+^), (*^), (^-^), InnerSpace)
 
 import Data.Cross (cross3)
 
@@ -45,8 +45,8 @@ data Color  = Color Pixel8 Pixel8 Pixel8 Pixel8
 -- Math
 
 -- | The distance traveled by a line segment from the first point to the second point.
-vectorDistance :: ℝ3 -> ℝ3 -> Scalar ℝ3
-vectorDistance a b = magnitude (b-a)
+vectorDistance :: ℝ3 -> ℝ3 -> ℝ
+vectorDistance a b = sqrt $ magnitudeSq (b-a)
 
 -- | Multiply a colour by an intensity.
 colorMult :: Pixel8 -> Color -> Color
@@ -77,13 +77,13 @@ cameraRay (Camera p vx vy f) (x,y) =
     let
         v  = vx `cross3` vy
         p' = p ^+^ f*^v ^+^ x*^vx ^+^ y*^vy
-        n  = normalized (p' ^-^ p)
+        n  = normalizeℝ3 (p' ^-^ p)
     in
         Ray p' n
 
 -- | Create a ray from two points.
 rayFromTo :: ℝ3 -> ℝ3 -> Ray
-rayFromTo p1 p2 = Ray p1 (normalized $ p2 ^-^ p1)
+rayFromTo p1 p2 = Ray p1 (normalizeℝ3 $ p2 ^-^ p1)
 
 rayBounds :: Ray -> (ℝ3, ℝ3) -> ℝ2
 rayBounds ray box =
@@ -153,15 +153,15 @@ traceRay ray@(Ray cameraP cameraV) step box (Scene obj objColor lights defaultCo
             Light lightPos lightIntensity <- lights
             let
                 ray'@(Ray _ v) = rayFromTo p lightPos
-                v' = normalized v
+                v' = normalizeℝ3 v
             guard . not $ intersects ray' ((0, obj p),20) step obj
             let
                 pval = obj p
                 dirDeriv :: ℝ3 -> ℝ
                 dirDeriv v'' = (obj (p ^+^ step*^v'') ^-^ pval)/step
                 deriv = (dirDeriv (1,0,0), dirDeriv (0,1,0), dirDeriv (0,0,1))
-                normal = normalized deriv
-                unitV = normalized v'
+                normal = normalizeℝ3 deriv
+                unitV = normalizeℝ3 v'
                 proj :: InnerSpace v => v -> v -> v
                 proj a' b' = (a'⋅b')*^b'
                 dist  = vectorDistance p lightPos
@@ -175,5 +175,3 @@ traceRay ray@(Ray cameraP cameraV) step box (Scene obj objColor lights defaultCo
             return $ illumination*(3 + 0.3*abs(rV ⋅ cameraV)*abs(rV ⋅ cameraV))
             )
         Nothing   -> defaultColor
-
-

Graphics/Implicit/Export/Render/GetSegs.hs

@@ -4,10 +4,12 @@
 
 module Graphics.Implicit.Export.Render.GetSegs (getSegs) where
 
-import Prelude(Bool(True, False), sqrt, (+), (*), (/=), map, (.), filter, ($), (<=))
+import Prelude(Bool(True, False), (+), (*), (/=), map, (.), filter, ($), (<=))
+
+import Graphics.Implicit.Definitions (ℝ, ℝ2, Obj2, Polyline(Polyline), sqrt)
 
-import Graphics.Implicit.Definitions (ℝ, ℝ2, Obj2, Polyline(Polyline))
 import Graphics.Implicit.Export.Render.RefineSegs (refine)
+
 import Graphics.Implicit.Export.Util (centroid)
 
 import Data.VectorSpace ((^-^))

Graphics/Implicit/Export/Render/RefineSegs.hs

@@ -5,12 +5,13 @@
 -- export one function, which refines polylines.
 module Graphics.Implicit.Export.Render.RefineSegs (refine) where
 
-import Prelude((<), (/), (++), (*), ($), (&&), (-), (+), (.), (>), abs, sqrt, (<=))
+import Prelude((<), (/), (++), (*), ($), (&&), (-), (+), (.), (>), abs, (<=))
+
+import Graphics.Implicit.Definitions (ℝ, ℝ2, Polyline(Polyline), minℝ, Fastℕ, Obj2, (⋅), normalizeℝ2, sqrt)
 
-import Graphics.Implicit.Definitions (ℝ, ℝ2, Polyline(Polyline), minℝ, Fastℕ, Obj2, (⋅))
 import Graphics.Implicit.Export.Util (centroid)
 
-import Data.VectorSpace (normalized, magnitude, (^-^), (^*), (^+^))
+import Data.VectorSpace (magnitudeSq, (^-^), (^*), (^+^))
 
 default (Fastℕ, ℝ)
 
@@ -39,7 +40,7 @@ detail n res obj (Polyline [p1, p2]) | n < 2 =
        then Polyline [p1, p2]
        else
          let
-           normal = (\(a,b) -> (b, -a)) $ normalized (p2 ^-^ p1)
+           normal = (\(a,b) -> (b, -a)) $ normalizeℝ2 (p2 ^-^ p1)
            derivN = -(obj (mid ^-^ (normal ^* (midval/2))) - midval) * (2/midval)
          in
            if abs derivN > 0.5 && abs derivN < 2 && abs (midval/derivN) < 3*res
@@ -54,7 +55,7 @@ detail n res obj (Polyline [p1, p2]) | n < 2 =
                derivY = (obj (mid ^+^ (0, res/100)) - midval)*100/res
                derivNormSq = derivX*derivX + derivY*derivY
              in
-               if abs derivNormSq > 0.09 && abs derivNormSq < 4 && abs (midval/sqrt derivNormSq) < 3*res
+               if abs derivNormSq > 0.09 && abs derivNormSq < 4 && abs (midval/(sqrt derivNormSq)) < 3*res
                then
                  let
                    (dX, dY) = (- derivX*midval/derivNormSq, - derivY*midval/derivNormSq)
@@ -74,7 +75,7 @@ simplify _ = {-simplify3 . simplify2 res . -} simplify1
 
 simplify1 :: Polyline -> Polyline
 simplify1 (Polyline (a:b:c:xs)) =
-    if abs ( ((b ^-^ a) ⋅ (c ^-^ a)) - magnitude (b ^-^ a) * magnitude (c ^-^ a) ) <= minℝ
+    if abs ( ((b ^-^ a) ⋅ (c ^-^ a)) - (sqrt $ magnitudeSq (b ^-^ a)) * (sqrt $ magnitudeSq (c ^-^ a)) ) <= minℝ
     then simplify1 (Polyline (a:c:xs))
     else addPolylines (Polyline [a]) (simplify1 (Polyline (b:c:xs)))
 simplify1 a = a

Graphics/Implicit/Export/Render/TesselateLoops.hs

@@ -6,13 +6,13 @@ module Graphics.Implicit.Export.Render.TesselateLoops (tesselateLoop) where
 
 import Prelude(return, ($), length, (==), zip, init, tail, reverse, (<), (/), null, foldl1, (++), head, (*), abs, (>), (&&), (+), concatMap)
 
-import Graphics.Implicit.Definitions (ℝ, ℕ, Obj3, ℝ3, TriangleMesh(TriangleMesh), (⋅), Triangle(Triangle))
+import Graphics.Implicit.Definitions (ℝ, ℕ, Obj3, ℝ3, TriangleMesh(TriangleMesh), (⋅), Triangle(Triangle), sqrt, normalizeℝ3)
 
 import Graphics.Implicit.Export.Render.Definitions (TriSquare(Tris, Sq))
 
 import Graphics.Implicit.Export.Util (centroid)
 
-import Data.VectorSpace (normalized, (^-^), (^+^), magnitude, (^/), (^*))
+import Data.VectorSpace ((^-^), (^+^), magnitudeSq, (^/), (^*))
 
 import Data.List (genericLength)
 
@@ -25,7 +25,6 @@ tesselateLoop _ _ [] = []
 
 tesselateLoop _ _ [[a,b],[_,c],[_,_]] = [Tris $ TriangleMesh [Triangle (a,b,c)]]
 
-
 {-
    #____#     #____#
    |    |     |    |
@@ -54,8 +53,8 @@ tesselateLoop res obj [as@(_:_:_:_),[_,_], bs@(_:_:_:_), [_,_] ] | length as ==
 
 tesselateLoop _ _ [[a,_],[b,_],[c,_],[d,_]] | centroid [a,c] == centroid [b,d] =
     let
-        b1 = normalized $ a ^-^ b
-        b2 = normalized $ c ^-^ b
+        b1 = normalizeℝ3 $ a ^-^ b
+        b2 = normalizeℝ3 $ c ^-^ b
         b3 = b1 `cross3` b2
     in [Sq (b1,b2,b3) (a ⋅ b3) (a ⋅ b1, c ⋅ b1) (a ⋅ b2, c ⋅ b2) ]
 
@@ -83,7 +82,7 @@ tesselateLoop res obj pathSides = return $ Tris $ TriangleMesh $
         midval = obj mid
         preNormal = foldl1 (^+^)
             [ a `cross3` b | (a,b) <- zip path (tail path ++ [head path]) ]
-        preNormalNorm = magnitude preNormal
+        preNormalNorm = sqrt $ magnitudeSq preNormal
         normal = preNormal ^/ preNormalNorm
         deriv = (obj (mid ^+^ (normal ^* (res/100)) ) ^-^ midval)/res*100
         mid' = mid ^-^ normal ^* (midval/deriv)

Graphics/Implicit/Export/Symbolic/Rebound2.hs

@@ -6,10 +6,12 @@ module Graphics.Implicit.Export.Symbolic.Rebound2 (rebound2) where
 
 import Prelude()
 
-import Graphics.Implicit.Definitions (BoxedObj2, ℝ2)
+import Graphics.Implicit.Definitions (BoxedObj2, ℝ, ℝ2)
 
 import Data.VectorSpace ((^-^), (^+^), (^/))
 
+default (ℝ)
+
 rebound2 :: BoxedObj2 -> BoxedObj2
 rebound2 (obj, (a,b)) =
     let

Graphics/Implicit/Export/Symbolic/Rebound3.hs

@@ -6,10 +6,12 @@ module Graphics.Implicit.Export.Symbolic.Rebound3 (rebound3) where
 
 import Prelude()
 
-import Graphics.Implicit.Definitions(BoxedObj3, ℝ3)
+import Graphics.Implicit.Definitions(BoxedObj3, ℝ, ℝ3)
 
 import Data.VectorSpace((^-^), (^+^), (^/))
 
+default (ℝ)
+
 -- | Slightly stretch the bounding box of an object, in order to
 --   ensure that during mesh generation, there are no problems because
 --   values are right at the edge.

Graphics/Implicit/Export/SymbolicFormats.hs

@@ -8,14 +8,15 @@
 -- output SCAD code, AKA an implicitcad to openscad converter.
 module Graphics.Implicit.Export.SymbolicFormats (scad2, scad3) where
 
-import Prelude(Maybe(Just, Nothing), Either(Left), ($), (.), (*), map, ($!), (-), (/), pi, error, (+), (==), take, floor)
+import Prelude(Maybe(Just, Nothing), Either(Left), ($), (.), (*), map, ($!), (-), (/), error, (+), (==), take, floor)
 
-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.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, (<>), mconcat, fromLazyText, bf)
 
 import Control.Monad.Reader (Reader, runReader, return, fmap, sequence, ask)
 
 import Data.List (intersperse)
+
 import Data.Function (fix)
 
 default (ℝ)
@@ -26,9 +27,9 @@ scad2 res obj = toLazyText $ runReader (buildS2 obj) res
 scad3 :: ℝ -> SymbolicObj3 -> Text
 scad3 res obj = toLazyText $ runReader (buildS3 obj) res
 
--- used by rotate2 and rotate3
+-- | used by rotate2 and rotate3
 rad2deg :: ℝ -> ℝ
-rad2deg r = r * (180/pi)
+rad2deg r = r * 180 / π
 
 -- | Format an openscad call given that all the modified objects are in the Reader monad...
 callToken :: (Text, Text) -> Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
@@ -96,8 +97,8 @@ buildS3 (ExtrudeRM r (Just twist) Nothing Nothing obj (Left height)) | r == 0 =
                         callNaked "linear_extrude" ["height = " <> bf res, "twist = " <> bf (twist (h+res) - twist h)][
                                    buildS2 obj
                                   ]
-                       ] |  h <- take (floor (res / height)) $ fix (\f x -> x : f (x+res)) 0
-            ]
+                        ] |  h <- take (floor (res / height)) $ fix (\f x -> x : f (x+res)) 0
+             ]
 
 -- FIXME: where are RotateExtrude, ExtrudeOnEdgeOf?
 
@@ -114,8 +115,7 @@ buildS3(EmbedBoxedObj3 _) = error "cannot provide roundness when exporting opens
 buildS3 RotateExtrude{} = error "cannot provide roundness when exporting openscad; unsupported in target format."
 buildS3(ExtrudeOnEdgeOf _ _) = error "cannot provide roundness when exporting openscad; unsupported in target format."
 
--- Now the 2D objects/transforms.
-
+-- | Now the 2D objects/transforms.
 buildS2 :: SymbolicObj2 -> Reader ℝ Builder
 
 buildS2 (RectR r (x1,y1) (x2,y2)) | r == 0 = call "translate" [bf x1, bf y1] [