Merge branch 'master' of http://github.com/colah/ImplicitCAD

Graphics/Implicit/Definitions.hs

@@ -72,7 +72,7 @@ data SymbolicObj2 =
 	| IntersectR2 ℝ [SymbolicObj2]
 	-- Simple transforms
 	| Translate2 ℝ2 SymbolicObj2
-	| Scale2 ℝ SymbolicObj2
+	| Scale2 ℝ2 SymbolicObj2
 	| Rotate2 ℝ SymbolicObj2
 	-- Boundary mods
 	| Outset2 ℝ SymbolicObj2
@@ -95,7 +95,7 @@ data SymbolicObj3 =
 	| DifferenceR3 ℝ [SymbolicObj3]
 	-- Some simple transofrms
 	| Translate3 ℝ3 SymbolicObj3
-	| Scale3 ℝ SymbolicObj3
+	| Scale3 ℝ3 SymbolicObj3
 	| Rotate3 (ℝ,ℝ,ℝ) SymbolicObj3
 	-- Some boundary based transforms
 	| Outset3 ℝ SymbolicObj3

Graphics/Implicit/Export/SymbolicObj2.hs

@@ -44,15 +44,15 @@ symbolicGetContour _ (RectR 0 (x1,y1) (x2,y2)) = [[ (x1,y1), (x2,y1), (x2,y2), (
 symbolicGetContour res (Circle r) = [[ ( r*cos(2*pi*m/n), r*sin(2*pi*m/n) ) | m <- [0.. n] ]] where
 	n = max 5 (fromIntegral $ ceiling $ 2*pi*r/res)
 symbolicGetContour res (Translate2 v obj) = map (map (S.+ v) ) $ symbolicGetContour res obj
-symbolicGetContour res (Scale2 s obj) = map (map (S.* s)) $ symbolicGetContour res obj
+symbolicGetContour res (Scale2 s obj) = map (map (S.⋯* s)) $ symbolicGetContour res obj
 symbolicGetContour res obj = case rebound2 (getImplicit2 obj, getBox2 obj) of
 	(obj, (a,b)) -> getContour a b (res,res) obj
 
 
 symbolicGetContourMesh :: ℝ ->  SymbolicObj2 -> [(ℝ2,ℝ2,ℝ2)]
 symbolicGetContourMesh res (Translate2 v obj) = map (\(a,b,c) -> (a S.+ v, b S.+ v, c S.+ v) )  $
 	symbolicGetContourMesh res obj
-symbolicGetContourMesh res (Scale2 s obj) = map (\(a,b,c) -> (a S.* s, b S.* s, c S.* s) )  $
+symbolicGetContourMesh res (Scale2 s obj) = map (\(a,b,c) -> (a S.⋯* s, b S.⋯* s, c S.⋯* s) )  $
 	symbolicGetContourMesh res obj
 symbolicGetContourMesh _ (RectR 0 (x1,y1) (x2,y2)) = [((x1,y1), (x2,y1), (x2,y2)), ((x2,y2), (x1,y2), (x1,y1)) ]
 symbolicGetContourMesh res (Circle r) = 

Graphics/Implicit/Export/SymbolicObj3.hs

@@ -47,7 +47,7 @@ symbolicGetMesh res (Scale3 s obj) =
 		mesh :: [(ℝ3, ℝ3, ℝ3)]
 		mesh = symbolicGetMesh res obj
 		scaleTriangle :: (ℝ3, ℝ3, ℝ3) -> (ℝ3, ℝ3, ℝ3)
-		scaleTriangle (a,b,c) = (s S.* a, s S.* b, s S.* c)
+		scaleTriangle (a,b,c) = (s S.⋯* a, s S.⋯* b, s S.⋯* c)
 	in map scaleTriangle  mesh
 
 -- A couple triangles make a cube...

Graphics/Implicit/ExtOpenScad/Primitives.hs

@@ -271,15 +271,15 @@ scale = moduleWithSuite "scale" $ \suite -> do
 
 	v <- argument "v"
 		`doc` "vector or scalar to scale by"
-	case v of
-		{-OList ((ONum x):(ONum y):(ONum z):[]) -> 
-			getAndTransformSuiteObjs suite (Prim.translate (x,y) ) (Prim.translate (x,y,z))
-		OList ((ONum x):(ONum y):[]) -> 
-			getAndTransformSuiteObjs suite (Prim.translate (x,y) ) (Prim.translate (x,y,0.0))
-		OList ((ONum x):[]) -> 
-			getAndTransformSuiteObjs suite (Prim.translate (x,0.0) ) (Prim.translate (x,0.0,0.0)-}
-		ONum s ->
-			getAndTransformSuiteObjs suite (Prim.scale s) (Prim.scale s)
+	caseOType v $
+		( \(x,y,z)-> 
+			getAndTransformSuiteObjs suite (Prim.scale (x,y) ) (Prim.scale (x,y,z)) 
+		) <||> ( \(x,y) -> 
+			getAndTransformSuiteObjs suite (Prim.scale (x,y) ) (Prim.scale (x,y,1.0)) 
+		) <||> ( \ x -> 
+			getAndTransformSuiteObjs suite (Prim.scale (x,x) ) (Prim.scale (x,x,x))
+		) <||> (\ _  -> noChange)
+
 
 extrude = moduleWithSuite "linear_extrude" $ \suite -> do
 	example "extrude(10) square(5);"

Graphics/Implicit/ObjectUtil/GetBox2.hs

@@ -79,7 +79,7 @@ getBox2 (Scale2 s symbObj) =
 	let
 		(a,b) = getBox2 symbObj
 	in
-		(s*a, s*b)
+		(s ⋯* a, s ⋯* b)
 
 getBox2 (Rotate2 θ symbObj) = 
 	let

Graphics/Implicit/ObjectUtil/GetBox3.hs

@@ -80,7 +80,7 @@ getBox3 (Scale3 s symbObj) =
 	let
 		(a,b) = getBox3 symbObj
 	in
-		(s*a, s*b)
+		(s ⋯* a, s ⋯* b)
 
 getBox3 (Outset3 d symbObj) =
 	let

Graphics/Implicit/ObjectUtil/GetImplicit2.hs

@@ -84,11 +84,22 @@ getImplicit2 (Translate2 v symbObj) =
 	in
 		\p -> obj (p-v)
 
-getImplicit2 (Scale2 s symbObj) =
+--getImplicit2 :: SymbolicObj2 -> (ℝ2 -> ℝ)
+--getImplicit2 (Scale2 (sx,sy)@s symbObj) =
+--	let
+--		obj = getImplicit2 symbObj
+--	in
+--		\p -> s * obj (p/s)
+--		\(x,y) -> max s * obj (x/s, y/s)
+--		\p -> (max sx sy) * obj (p / s)
+--Originally: \ℝ2 -> ℝ * (ℝ2 -> ℝ)(ℝ2 / ℝ)
+--Now:        \ℝ2 -> ℝ2 * (ℝ2 -> ℝ)(ℝ2 .../ ℝ2)
+
+getImplicit2 (Scale2 s@(sx,sy) symbObj) =
 	let
 		obj = getImplicit2 symbObj
 	in
-		\p -> s * obj (p/s)
+		\p -> (max sx sy) * obj (p ⋯/ s)
 
 getImplicit2 (Rotate2 θ symbObj) = 
 	let

Graphics/Implicit/ObjectUtil/GetImplicit3.hs

@@ -73,11 +73,17 @@ getImplicit3 (Translate3 v symbObj) =
 	in
 		\p -> obj (p-v)
 
-getImplicit3 (Scale3 s symbObj) =
+getImplicit3 (Scale3 s@(sx,sy,sz) symbObj) =
 	let
 		obj = getImplicit3 symbObj
 	in
-		\p -> s * obj (p/s)
+		\p -> (maximum [sx, sy, sz]) * obj (p ⋯/ s)
+
+--getImplicit3 (Scale3 s symbObj) =
+--	let
+--		obj = getImplicit3 symbObj
+--	in
+--		\p -> s ⋯* obj (p ⋯/ s)
 
 getImplicit3 (Outset3 d symbObj) =
 	let

Graphics/Implicit/Primitives.hs

@@ -73,7 +73,7 @@ class Object obj vec | obj -> vec where
 
 	-- | Scale an object
 	scale :: 
-		ℝ       -- ^ Amount to scale by
+		vec     -- ^ Amount to scale by
 		-> obj  -- ^ Object to scale
 		-> obj  -- ^ Resulting scaled object	
 

Graphics/Implicit/SaneOperators.hs

@@ -36,6 +36,13 @@ class Normable a where
 class InnerProductSpace a where
 	(⋅) :: a -> a -> ℝ
 
+class ComponentWiseMultiplicative a b c | a b -> c where
+	(⋯*) :: a -> b -> c
+	infixl 7 ⋯*
+
+class ComponentWiseMultiplicativeInvertable a where
+	componentWiseMultiplicativeInverse :: a -> a
+
 -- * I should be able to create instances for all Num instances,
 -- but Haskell's type checker doesn't seem to play nice with them.
 
@@ -163,4 +170,26 @@ instance InnerProductSpace ℝ3 where
 	(a1, a2, a3) ⋅ (b1, b2, b3) = a1*b1 + a2*b2+a3*b3
 
 
+-- ComponentWiseMultiplicative Instances
+
+instance ComponentWiseMultiplicativeInvertable ℝ where
+	componentWiseMultiplicativeInverse a = 1 P./ a
+
+instance ComponentWiseMultiplicativeInvertable ℝ2 where
+	componentWiseMultiplicativeInverse (a, b) = (1 P./ a, 1 P./ b)
+
+instance ComponentWiseMultiplicativeInvertable ℝ3 where
+	componentWiseMultiplicativeInverse (a, b, c) = (1 P./ a, 1 P./ b, 1 P./ c)
+
+instance ComponentWiseMultiplicative ℝ ℝ ℝ where
+	a ⋯* x = a*x
+
+instance ComponentWiseMultiplicative ℝ2 ℝ2 ℝ2 where
+	(a,b) ⋯* (x,y) = (a*x,b*y)
+
+instance ComponentWiseMultiplicative ℝ3 ℝ3 ℝ3 where
+	(a,b,c) ⋯* (x,y,z) = (a*x,b*y,c*z)
 
+(⋯/) :: (ComponentWiseMultiplicative a b c) => (ComponentWiseMultiplicativeInvertable b) => a -> b -> c
+x ⋯/ y = x ⋯* (componentWiseMultiplicativeInverse y)
+infixl 7 ⋯/