Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Red [
- Description: {Some quaternion manipulation funcs}
- Date: 21-Sep-2019
- Author: "Toomas Vooglaid"
- ]
- quaternion: context [
- quaternion!: make typeset! [block! hash! vector!]
- e-pow: function [q][
- sc: x: y: z: none
- set [sc x y z] q
- e': (exp 1) ** sc
- sc: cos v: sqrt (x ** 2) + (y ** 2) + (z ** 2)
- im: (sin v) / v
- reduce [e' * sc e' * x * im e' * y * im e' * z * im]
- ]
- multiply: function [q [integer! float! quaternion!] p [integer! float! quaternion!]][
- case [
- number? q [collect [forall p [keep p/1 * q]]]
- number? p [collect [forall q [keep q/1 * p]]]
- 'else [
- reduce [
- (q/1 * p/1) - (q/2 * p/2) - (q/3 * p/3) - (q/4 * p/4)
- (q/1 * p/2) + (q/2 * p/1) + (q/3 * p/4) - (q/4 * p/3)
- (q/1 * p/3) + (q/3 * p/1) + (q/4 * p/2) - (q/2 * p/4)
- (q/1 * p/4) + (q/4 * p/1) + (q/2 * p/3) - (q/3 * p/2)
- ]
- ]
- ]
- ]
- add: func [q [integer! float! quaternion!] p [integer! float! quaternion!]][
- case [
- number? q [head change copy p p/1 + q]
- number? p [head change copy q q/1 + p]
- 'else [collect [forall q [keep q/1 + p/(index? q)]]]
- ]
- ]
- negate: func [q [quaternion!]][collect [forall q [keep 0 - q/1]]]
- conjugate: func [q [quaternion!]][collect [keep q/1 q: next q forall q [keep 0 - q/1]]]
- norm: func [q [quaternion!]][sqrt first multiply q conjugate copy q]
- normalize: function [q [quaternion!]][n: norm q collect [forall q [keep q/1 / n]]]
- inverse: func [q [quaternion!]][(conjugate q) / ((norm q) ** 2)]
- rotate: function [axis [quaternion!] q [quaternion!]][ ; axis: [ang-degrees normalized-vec]
- co: cosine .5 * axis/1
- si: sine .5 * axis/1
- q1: reduce [co si * axis/2 si * axis/3 si * axis/4]
- q2: multiply q1 q
- q3: conjugate q1
- multiply q2 q3
- ]
- ]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement