• API
• FAQ
• Tools
• Archive
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.
Not a member of Pastebin yet?