org.simantics.g3d/scl/G3D/Math/Tuple3d.scl

   1 import "JavaBuiltin" as Java
   2
   3 importJava "javax.vecmath.Tuple3d" where
   4   // Immutable mapping
   5   data Tuple3d
   6
   7   @private
   8   @JavaName getX
   9   getX' :: Tuple3d -> Double
  10   @private
  11   @JavaName getY
  12   getY' :: Tuple3d -> Double
  13   @private
  14   @JavaName getZ
  15   getZ' :: Tuple3d -> Double
  16
  17   // Mutable mapping
  18   data MTuple3d
  19
  20   @JavaName getX
  21   getXM' :: MTuple3d -> <Proc> Double
  22   @JavaName getY
  23   getYM' :: MTuple3d -> <Proc> Double
  24   @JavaName getZ
  25   getZM' :: MTuple3d -> <Proc> Double
  26
  27   @JavaName setX
  28   setX' :: MTuple3d -> Double -> <Proc> ()
  29   @JavaName setY
  30   setY' :: MTuple3d -> Double -> <Proc> ()
  31   @JavaName setZ
  32   setZ' :: MTuple3d -> Double -> <Proc> ()
  33
  34   @JavaName add
  35   addM' :: MTuple3d -> Tuple3d -> <Proc> ()
  36   @JavaName add
  37   addM2' :: MTuple3d -> Tuple3d -> Tuple3d -> <Proc> ()
  38
  39   @JavaName sub
  40   subM' :: MTuple3d -> Tuple3d -> <Proc> ()
  41   @JavaName sub
  42   subM2' :: MTuple3d -> Tuple3d -> Tuple3d -> <Proc> ()
  43
  44   @JavaName negate
  45   negateM' :: MTuple3d -> <Proc> ()
  46   @JavaName negate
  47   negateM2' :: MTuple3d -> Tuple3d -> <Proc> ()
  48
  49   @JavaName scale
  50   scaleM' :: MTuple3d -> Double -> <Proc> ()
  51   @JavaName scale
  52   scaleM2' :: MTuple3d -> Double -> Tuple3d -> <Proc> ()
  53
  54   @private
  55   clone :: Tuple3d -> <Proc> a
  56
  57 copyMTuple3d :: Tuple3d -> <Proc> MTuple3d
  58 copyMTuple3d = Java.unsafeCoerce . clone
  59
  60 @private
  61 applyMOp :: (MTuple3d -> <Proc> ()) -> Tuple3d -> Tuple3d
  62 applyMOp f x = runProc let
  63   z = copyMTuple3d x
  64   f z
  65   in freeze z
  66
  67 freeze :: MTuple3d -> <Proc> Tuple3d
  68 freeze = Java.unsafeCoerce
  69
  70 addTuple x y = applyMOp (flip addM' y) x
  71 subTuple x y = applyMOp (flip subM' y) x
  72 negateTuple = applyMOp negateM'
  73 scaleTuple x s = applyMOp (flip scaleM' s) x
  74
  75 class Tuple3dClass a where
  76   asTuple :: a -> Tuple3d
  77   asTuple = Java.unsafeCoerce
  78
  79   getMTuple :: a -> <Proc> MTuple3d
  80   getMTuple x = copyMTuple3d (asTuple x)
  81
  82   getX :: a -> Double
  83   getX = getX' . asTuple
  84
  85   getY :: a -> Double
  86   getY = getY' . asTuple
  87
  88   getZ :: a -> Double
  89   getZ = getZ' . asTuple
  90
  91   add :: a -> a -> a
  92   add x y = Java.unsafeCoerce $ addTuple (asTuple x) (asTuple y)
  93
  94   sub :: a -> a -> a
  95   sub x y = Java.unsafeCoerce $ subTuple (asTuple x) (asTuple y)
  96
  97   negate :: a -> a
  98   negate x = Java.unsafeCoerce $ negateTuple (asTuple x)
  99
 100   scale :: a -> Double -> a
 101   scale x s = Java.unsafeCoerce $ scaleTuple (asTuple x) s
 102
 103 instance Tuple3dClass Tuple3d where
 104   asTuple = id
 105   getX = getX'
 106   getY = getY'
 107   getZ = getZ'
 108   add = addTuple
 109   sub = subTuple
 110   negate = negateTuple
 111   scale = scaleTuple
 112
 113 class MTuple3dClass a where
 114   asMTuple :: a -> <Proc> MTuple3d
 115   asMTuple = Java.unsafeCoerce
 116
 117   getXM :: a -> <Proc> Double
 118   getXM = getXM' . asMTuple
 119
 120   getYM :: a -> <Proc> Double
 121   getYM = getYM' . asMTuple
 122
 123   getZM :: a -> <Proc> Double
 124   getZM = getZM' . asMTuple
 125
 126   setX :: a -> Double -> <Proc> ()
 127   setX x v = setX' (asMTuple x) v
 128
 129   setY :: a -> Double -> <Proc> ()
 130   setY x v = setY' (asMTuple x) v
 131
 132   setZ :: a -> Double -> <Proc> ()
 133   setZ x v = setZ' (asMTuple x) v
 134
 135   addM :: Tuple3dClass b => a -> b -> <Proc> ()
 136   addM x y = addM' (asMTuple x) (asTuple y)
 137
 138   addM2 :: Tuple3dClass b => a -> b -> b -> <Proc> ()
 139   addM2 x y z = addM2' (asMTuple x) (asTuple y) (asTuple z)
 140
 141   subM :: Tuple3dClass b => a -> b -> <Proc> ()
 142   subM x y = subM' (asMTuple x) (asTuple y)
 143
 144   subM2 :: Tuple3dClass b => a -> b -> Tuple3d -> <Proc> ()
 145   subM2 x y z = subM2' (asMTuple x) (asTuple y) (asTuple z)
 146
 147   negateM :: a -> <Proc> ()
 148   negateM x = negateM' (asMTuple x)
 149
 150   negateM2 :: Tuple3dClass b => a -> b -> <Proc> ()
 151   negateM2 x y = negateM2' (asMTuple x) (asTuple y)
 152
 153   scaleM :: a -> Double -> <Proc> ()
 154   scaleM x s = scaleM' (asMTuple x) s
 155
 156   scaleM2 :: Tuple3dClass b => a -> Double -> b -> <Proc> ()
 157   scaleM2 x s y = scaleM2' (asMTuple x) s (asTuple y)