SHARE
TWEET

Untitled

a guest Oct 10th, 2019 72 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Red [
  2.     Description: {Some quaternion manipulation funcs}
  3.     Date: 21-Sep-2019
  4.     Author: "Toomas Vooglaid"
  5. ]
  6. quaternion: context [
  7.     quaternion!: make typeset! [block! hash! vector!]
  8.     e-pow: function [q][
  9.         sc: x: y: z: none
  10.         set [sc x y z] q
  11.         e': (exp 1) ** sc
  12.         sc: cos v: sqrt (x ** 2) + (y ** 2) + (z ** 2)
  13.         im: (sin v) / v
  14.         reduce [e' * sc e' * x * im e' * y * im e' * z * im]
  15.     ]
  16.     multiply: function [q [integer! float! quaternion!] p [integer! float! quaternion!]][
  17.         case [
  18.             number? q [collect [forall p [keep p/1 * q]]]
  19.             number? p [collect [forall q [keep q/1 * p]]]
  20.             'else [
  21.                 reduce [
  22.                     (q/1 * p/1) - (q/2 * p/2) - (q/3 * p/3) - (q/4 * p/4)
  23.                     (q/1 * p/2) + (q/2 * p/1) + (q/3 * p/4) - (q/4 * p/3)
  24.                     (q/1 * p/3) + (q/3 * p/1) + (q/4 * p/2) - (q/2 * p/4)
  25.                     (q/1 * p/4) + (q/4 * p/1) + (q/2 * p/3) - (q/3 * p/2)
  26.                 ]
  27.             ]
  28.         ]
  29.     ]
  30.     add: func [q [integer! float! quaternion!] p [integer! float! quaternion!]][
  31.         case [
  32.             number? q [head change copy p p/1 + q]
  33.             number? p [head change copy q q/1 + p]
  34.             'else [collect [forall q [keep q/1 + p/(index? q)]]]
  35.         ]
  36.     ]
  37.     negate:     func [q [quaternion!]][collect [forall q [keep 0 - q/1]]]
  38.     conjugate:  func [q [quaternion!]][collect [keep q/1  q: next q  forall q [keep 0 - q/1]]]
  39.     norm:       func [q [quaternion!]][sqrt first multiply q conjugate copy q]
  40.     normalize:  function [q [quaternion!]][n: norm q   collect [forall q [keep q/1 / n]]]
  41.     inverse:    func [q [quaternion!]][(conjugate q) / ((norm q) ** 2)]
  42.     rotate: function [axis [quaternion!] q [quaternion!]][ ; axis: [ang-degrees normalized-vec]
  43.         co: cosine .5 * axis/1
  44.         si: sine .5 * axis/1
  45.         q1: reduce [co si * axis/2 si * axis/3 si * axis/4]
  46.         q2: multiply q1 q
  47.         q3: conjugate q1
  48.         multiply q2 q3
  49.     ]
  50. ]
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top