]> gerrit.simantics Code Review - simantics/3d.git/blobdiff - org.simantics.g3d/scl/G3D/Math/Tuple3d.scl
Refactoring of SCL interfaces for g3d.
[simantics/3d.git] / org.simantics.g3d / scl / G3D / Math / Tuple3d.scl
diff --git a/org.simantics.g3d/scl/G3D/Math/Tuple3d.scl b/org.simantics.g3d/scl/G3D/Math/Tuple3d.scl
new file mode 100644 (file)
index 0000000..f777940
--- /dev/null
@@ -0,0 +1,108 @@
+import "JavaBuiltin" as Java
+
+importJava "javax.vecmath.Tuple3d" where
+  // Immutable mapping
+  data Tuple3d
+  
+  @private
+  @JavaName getX
+  getX' :: Tuple3d -> Double
+  @private
+  @JavaName getY
+  getY' :: Tuple3d -> Double
+  @private
+  @JavaName getZ
+  getZ' :: Tuple3d -> Double
+  
+  // Mutable mapping
+  data MTuple3d
+  
+  @JavaName getX
+  getXM :: MTuple3d -> <Proc> Double
+  @JavaName getY
+  getYM :: MTuple3d -> <Proc> Double
+  @JavaName getZ
+  getZM :: MTuple3d -> <Proc> Double
+  
+  setX :: MTuple3d -> Double -> <Proc> ()
+  setY :: MTuple3d -> Double -> <Proc> ()
+  setZ :: MTuple3d -> Double -> <Proc> ()
+  
+  @JavaName add
+  addM :: MTuple3d -> Tuple3d -> <Proc> ()
+  @JavaName add
+  addM2 :: MTuple3d -> Tuple3d -> Tuple3d -> <Proc> ()
+  
+  @JavaName sub
+  subM :: MTuple3d -> Tuple3d -> <Proc> ()
+  @JavaName sub
+  subM2 :: MTuple3d -> Tuple3d -> Tuple3d -> <Proc> ()
+  
+  @JavaName negate
+  negateM :: MTuple3d -> <Proc> ()
+  @JavaName negate
+  negateM2 :: MTuple3d -> Tuple3d -> <Proc> ()
+  
+  @JavaName scale
+  scaleM :: MTuple3d -> Double -> <Proc> ()
+  @JavaName scale
+  scaleM2 :: MTuple3d -> Double -> Tuple3d -> <Proc> ()
+  
+  @private
+  clone :: Tuple3d -> <Proc> a
+
+copyMTuple3d :: Tuple3d -> <Proc> MTuple3d
+copyMTuple3d = Java.unsafeCoerce . clone
+
+@private
+applyMOp :: (MTuple3d -> <Proc> ()) -> Tuple3d -> Tuple3d
+applyMOp f x = runProc let
+  z = copyMTuple3d x
+  f z
+  in freeze z 
+
+freeze :: MTuple3d -> <Proc> Tuple3d
+freeze = Java.unsafeCoerce
+
+addTuple x y = applyMOp (flip addM y) x
+subTuple x y = applyMOp (flip subM y) x
+negateTuple = applyMOp negateM
+scaleTuple x s = applyMOp (flip scaleM s) x
+
+class Tuple3dClass a where
+  asTuple :: a -> Tuple3d
+  asTuple = Java.unsafeCoerce
+  
+  asMTuple :: a -> <Proc> MTuple3d
+  asMTuple x = copyMTuple3d (asTuple x)
+  
+  getX :: a -> Double
+  getX = getX' . asTuple
+  
+  getY :: a -> Double
+  getY = getY' . asTuple
+  
+  getZ :: a -> Double
+  getZ = getZ' . asTuple
+  
+  add :: a -> a -> a
+  add x y = Java.unsafeCoerce $ addTuple (asTuple x) (asTuple y)
+    
+  sub :: a -> a -> a
+  sub x y = Java.unsafeCoerce $ subTuple (asTuple x) (asTuple y)
+  
+  negate :: a -> a
+  negate x = Java.unsafeCoerce $ negateTuple (asTuple x)
+    
+  scale :: a -> Double -> a
+  scale x s = Java.unsafeCoerce $ scaleTuple (asTuple x) s
+
+instance Tuple3dClass Tuple3d where
+  asTuple = id
+  getX = getX'
+  getY = getY'
+  getZ = getZ'
+  add = addTuple
+  sub = subTuple
+  negate = negateTuple
+  scale = scaleTuple