Files
2026-05-08 18:54:05 -04:00

661 lines
18 KiB
Common Lisp
Vendored
Generated

;;-*-Lisp-*-
(in-package goal)
;; definition for function radmod
(defun radmod ((arg0 float))
"Wrap arg0 to be within (-pi, pi)."
(let ((f0-1 (+ 3.1415925 arg0)))
(if (< 0.0 f0-1)
(+ -3.1415925 (- f0-1 (* (the float (the int (/ f0-1 6.283185))) 6.283185)))
(+ 3.1415925 (- f0-1 (* (the float (the int (/ f0-1 6.283185))) 6.283185)))
)
)
)
;; definition for function deg-
(defun deg- ((arg0 float) (arg1 float))
"Compute arg0-arg1, unwrapped, using rotation units.
Result should be in the range (-180, 180)"
(the float (sar (- (shl (the int arg0) 48) (shl (the int arg1) 48)) 48))
)
;; definition for function deg-diff
(defun deg-diff ((arg0 float) (arg1 float))
"Very similar to the function above, but computes arg1 - arg0 instead."
(the float (sar (- (shl (the int arg1) 48) (shl (the int arg0) 48)) 48))
)
;; definition for function deg-seek
(defun deg-seek ((arg0 float) (arg1 float) (arg2 float))
"Move in toward target by at most max-diff, using rotation units"
(let ((v1-1 (shl (the int arg0) 48))
(a0-2 (shl (the int arg1) 48))
)
(let* ((a1-2 (shl (the int arg2) 48))
(a2-1 (- a0-2 v1-1))
(a3-0 (abs a2-1))
)
(set! a0-2 (cond
((< a3-0 0)
(+ v1-1 a1-2)
)
((>= a1-2 a3-0)
(empty)
a0-2
)
((>= a2-1 0)
(+ v1-1 a1-2)
)
(else
(- v1-1 a1-2)
)
)
)
)
(the float (sar a0-2 48))
)
)
;; definition for function deg-seek-smooth
(defun deg-seek-smooth ((arg0 float) (arg1 float) (arg2 float) (arg3 float))
"Step amount of the way from in to target, by at most max-diff, using rotation units"
(let ((f0-1 (* (deg- arg1 arg0) arg3)))
(if (< arg2 (fabs f0-1))
(set! f0-1 (if (>= f0-1 0.0)
arg2
(- arg2)
)
)
)
(+ arg0 f0-1)
)
)
;; definition for function deg-lerp-clamp
(defun deg-lerp-clamp ((arg0 float) (arg1 float) (arg2 float))
"Map [0, 1] to min-val, max-val, handling wrapping and saturating, using rotation units."
(cond
((>= 0.0 arg2)
arg0
)
((>= arg2 1.0)
arg1
)
(else
(the float (sar (shl (the int (+ arg0 (* arg2 (deg-diff arg0 arg1)))) 48) 48))
)
)
)
;; definition for symbol binary-table, type (array float)
(define binary-table (new 'static 'boxed-array :type float
1.0
0.5
0.25
0.125
0.0625
0.03125
0.015625
0.0078125
0.00390625
0.001953125
0.0009765625
0.00048828125
0.00024414062
0.00012207031
0.000061035156
0.000030517578
0.000015258789
0.0000076293945
0.0000038146973
0.0000019073486
0.0000009536743
0.00000047683716
0.00000023841858
0.00000011920929
0.000000059604645
0.000000029802322
0.000000014901161
0.000000007450581
0.0000000037252903
0.0000000018626451
0.0000000009313226
0.0000000004656613
)
)
;; definition for symbol sincos-table, type (array float)
(define sincos-table (new 'static 'boxed-array :type float
0.7853982
0.4636476
0.24497867
0.124354996
0.06241881
0.031239834
0.015623729
0.007812341
0.0039062302
0.0019531226
0.0009765622
0.0004882812
0.00024414062
0.00012207031
0.000061035156
0.000030517578
0.000015258789
0.0000076293945
0.0000038146973
0.0000019073486
0.0000009536743
0.00000047683716
0.00000023841858
0.00000011920929
0.000000059604645
0.000000029802322
0.000000014901161
0.000000007450581
0.0000000037252903
0.0000000018626451
0.0000000009313226
0.0000000004656613
)
)
;; definition for function sin
(defun sin ((arg0 float))
"Compute the sine of an angle in rotation units. Unwraps it."
(let ((f2-0 (* 0.000095873795 (the float (sar (shl (the int arg0) 48) 48)))))
f2-0
(let* ((f1-4 (* 0.999998 f2-0))
(f0-3 (square f2-0))
(f2-1 (* f2-0 f0-3))
(f1-5 (+ f1-4 (* -0.16666014 f2-1)))
(f2-2 (* f2-1 f0-3))
(f1-6 (+ f1-5 (* 0.008326521 f2-2)))
(f2-3 (* f2-2 f0-3))
(f1-7 (+ f1-6 (* -0.0001956241 f2-3)))
(f0-4 (* f2-3 f0-3))
)
(+ f1-7 (* 0.0000023042373 f0-4))
)
)
)
;; definition for function sin-rad
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for symbol *sin-poly-vec*, type vector
(define *sin-poly-vec*
(new 'static 'vector :data (new 'static 'array float 4 -0.16666014 0.008326521 -0.0001956241 0.0000023042373))
)
;; definition for symbol *sin-poly-vec2*, type vector
(define *sin-poly-vec2* (new 'static 'vector :data (new 'static 'array float 4 0.999998 0.0 0.0 0.0)))
;; definition for function vector-sin-rad!
(defun vector-sin-rad! ((arg0 vector) (arg1 vector))
"Taylor series approximation of sine on all 4 elements in a vector.
Inputs should be in radians, in -pi to pi.
Somehow their coefficients are a little bit off.
Like the first coefficient, which should obviously be 1, is not quite 1."
(rlet ((acc :class vf)
(vf1 :class vf)
(vf10 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(.lvf vf1 (&-> arg1 quad))
(.mul.vf vf3 vf1 vf1)
(.lvf vf10 (&-> *sin-poly-vec2* quad))
(.lvf vf9 (&-> *sin-poly-vec* quad))
(.mul.vf vf4 vf3 vf1)
(.mul.vf vf5 vf3 vf3)
(.mul.x.vf acc vf1 vf10)
(.mul.vf vf6 vf4 vf3)
(.mul.vf vf7 vf5 vf4)
(.add.mul.x.vf acc vf4 vf9 acc)
(.mul.vf vf8 vf6 vf5)
(.add.mul.y.vf acc vf6 vf9 acc)
(.add.mul.z.vf acc vf7 vf9 acc)
(.add.mul.w.vf vf2 vf8 vf9 acc)
(.svf (&-> arg0 quad) vf2)
arg0
)
)
;; definition for function cos-rad
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for symbol *cos-poly-vec*, type vector
(define *cos-poly-vec*
(new 'static 'vector :data (new 'static 'array float 4 -0.49998003 0.041620404 -0.0013636408 0.000020170546))
)
;; definition for function vector-cos-rad!
;; ERROR: Bad vector register dependency: vf2
(defun vector-cos-rad! ((arg0 vector) (arg1 vector))
"Compute the cosine of all 4 vector elements.
Radians, with no wrapping. Uses taylor series with 4 coefficients."
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg1 quad))
(.sub.vf vf2 vf2 vf2)
(.lvf vf9 (&-> *cos-poly-vec* quad))
(.mul.vf vf3 vf1 vf1)
(.add.w.vf acc vf2 vf0)
(.mul.vf vf4 vf3 vf3)
(.add.mul.x.vf acc vf3 vf9 acc)
(.mul.vf vf5 vf4 vf3)
(.add.mul.y.vf acc vf4 vf9 acc)
(.mul.vf vf6 vf4 vf4)
(.add.mul.z.vf acc vf5 vf9 acc)
(.add.mul.w.vf vf2 vf6 vf9 acc)
(.svf (&-> arg0 quad) vf2)
arg0
)
)
;; definition for function vector-sincos-rad!
;; ERROR: Bad vector register dependency: vf14
(defun vector-sincos-rad! ((arg0 vector) (arg1 vector) (arg2 vector))
"Compute the sine and cosine of each element of src, storing it in dst-sin and dst-cos.
This is more efficient than separate calls to sin and cos.
Inputs should be radians in -pi to pi.
TODO - original code contained a bad VF dependency"
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf10 :class vf)
(vf11 :class vf)
(vf12 :class vf)
(vf13 :class vf)
(vf14 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg2 quad))
(.sub.vf vf14 vf14 vf14)
(.lvf vf11 (&-> *sin-poly-vec2* quad))
(.mul.vf vf2 vf1 vf1)
(.lvf vf10 (&-> *sin-poly-vec* quad))
(.lvf vf13 (&-> *cos-poly-vec* quad))
(.mul.x.vf acc vf1 vf11)
(.mul.vf vf3 vf2 vf1)
(.mul.vf vf4 vf2 vf2)
(.mul.vf vf5 vf3 vf2)
(.mul.vf vf6 vf3 vf3)
(.mul.vf vf7 vf4 vf3)
(.mul.vf vf8 vf4 vf4)
(.mul.vf vf9 vf5 vf4)
(.add.mul.x.vf acc vf3 vf10 acc)
(.add.mul.y.vf acc vf5 vf10 acc)
(.add.mul.z.vf acc vf7 vf10 acc)
(.add.mul.w.vf vf12 vf9 vf10 acc)
(.add.w.vf acc vf14 vf0)
(.add.mul.x.vf acc vf2 vf13 acc)
(.add.mul.y.vf acc vf4 vf13 acc)
(.add.mul.z.vf acc vf6 vf13 acc)
(.add.mul.w.vf vf14 vf8 vf13 acc)
(.svf (&-> arg0 quad) vf12)
(.svf (&-> arg1 quad) vf14)
0
)
)
;; definition for function sincos-rad!
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function sincos!
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function vector-rad<-vector-deg!
;; WARN: Return type mismatch float vs none.
(defun vector-rad<-vector-deg! ((out vector) (in vector))
"Convert a vector in rotation units to radians, and unwrap.
Input can be anything, output will be -2pi to pi."
(local-vars (v0-0 float) (v1-1 uint128) (v1-2 uint128) (v1-3 uint128))
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(let ((v1-0 #x38c90fda))
(.lvf vf1 (&-> in quad))
(.ftoi.vf vf1 vf1)
(.mov vf2 v1-0)
)
(.mov v1-1 vf1)
(.pw.sll v1-2 v1-1 16)
(.pw.sra v1-3 v1-2 16)
(.mov vf1 v1-3)
(.itof.vf vf1 vf1)
(.mul.x.vf vf1 vf1 vf2)
(.svf (&-> out quad) vf1)
(.mov v0-0 vf1)
(none)
)
)
;; definition for function vector-rad<-vector-deg/2!
;; WARN: Return type mismatch float vs int.
(defun vector-rad<-vector-deg/2! ((out vector) (in vector))
"Divide the input by two, and then convert from rotation units to radians, unwrapping.
Not sure why this really needs to be separate the from previous function..."
(local-vars (v0-0 float) (v1-1 uint128) (v1-2 uint128) (v1-3 uint128))
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(let ((v1-0 #x38c90fda))
(let ((a2-0 #x3f000000))
(.lvf vf1 (&-> in quad))
(.mov vf2 a2-0)
)
(.mul.x.vf vf1 vf1 vf2)
(.ftoi.vf vf1 vf1)
(.mov vf2 v1-0)
)
(.mov v1-1 vf1)
(.pw.sll v1-2 v1-1 16)
(.pw.sra v1-3 v1-2 16)
(.mov vf1 v1-3)
(.itof.vf vf1 vf1)
(.mul.x.vf vf1 vf1 vf2)
(.svf (&-> out quad) vf1)
(.mov v0-0 vf1)
(the-as int v0-0)
)
)
;; definition for function vector-sincos!
(defun vector-sincos! ((arg0 vector) (arg1 vector) (arg2 vector))
"Compute sine and cosine of each element in a vector, in rotation units"
(let ((s4-0 (new 'stack-no-clear 'vector)))
(vector-rad<-vector-deg! s4-0 arg2)
(vector-sincos-rad! arg0 arg1 s4-0)
)
)
;; definition for function tan-rad
(defun tan-rad ((arg0 float))
"This function appears to be named wrong and actually operates on rotation units."
(/ (sin arg0) (cos arg0))
)
;; definition for function cos
(defun cos ((arg0 float))
"Cosine of rotation units."
(sin (+ 16384.0 arg0))
)
;; definition for function tan
(defun tan ((arg0 float))
"Correctly named tangent of rotation units."
(/ (sin arg0) (cos arg0))
)
;; definition for function atan0
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function atan-series-rad
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function atan-rad
(defun atan-rad ((arg0 float))
"Inverse tangent in radians."
(atan-series-rad (/ (+ -1.0 arg0) (+ 1.0 arg0)))
)
;; definition for function sign-bit
(defun sign-bit ((arg0 int))
"Return 1 if bit 31 is set, otherwise 0."
(local-vars (v1-1 int))
(let ((v1-0 arg0))
(shift-arith-right-32 v1-1 v1-0 31)
)
(logand v1-1 1)
)
;; definition for function sign-float
;; ERROR: function was not converted to expressions. Cannot decompile.
;; definition for function sign
(defun sign ((arg0 float))
"Similar to above, but returns 0 if input is 0.
But is more complicated."
(cond
((< 0.0 arg0)
1.0
)
((< arg0 0.0)
-1.0
)
(else
0.0
)
)
)
;; definition for function atan2-rad
(defun atan2-rad ((arg0 float) (arg1 float))
"Atan for radians."
(cond
((= arg1 0.0)
(* 1.5707963 (sign arg0))
)
((and (< arg0 0.0) (< arg1 0.0))
(let ((f30-1 -3.1415925)
(f0-6 (/ arg0 arg1))
)
(+ f30-1 (atan-series-rad (/ (+ -1.0 f0-6) (+ 1.0 f0-6))))
)
)
((< arg0 0.0)
(let ((f0-14 (- (/ arg0 arg1))))
(- (atan-series-rad (/ (+ -1.0 f0-14) (+ 1.0 f0-14))))
)
)
((< arg1 0.0)
(let ((f30-2 3.1415925)
(f0-22 (- (/ arg0 arg1)))
)
(- f30-2 (atan-series-rad (/ (+ -1.0 f0-22) (+ 1.0 f0-22))))
)
)
(else
(let ((f0-28 (/ arg0 arg1)))
(atan-series-rad (/ (+ -1.0 f0-28) (+ 1.0 f0-28)))
)
)
)
)
;; definition for function atan
(defun atan ((arg0 float) (arg1 float))
"Atan for rotation units. Signs behave like atan.."
(cond
((and (= arg1 0.0) (= arg0 0.0))
0.0
)
((and (< arg1 0.0) (< arg0 0.0))
(+ -32768.0 (atan0 (- arg0) (- arg1)))
)
((< arg0 0.0)
(- (atan0 (- arg0) arg1))
)
((< arg1 0.0)
(- 32768.0 (atan0 arg0 (- arg1)))
)
(else
(atan0 arg0 arg1)
)
)
)
;; definition for function asin
(defun asin ((arg0 float))
"Inverse sine, rotation units."
(let ((gp-0 #f))
0.0
(when (< arg0 0.0)
(set! arg0 (- arg0))
(set! gp-0 #t)
)
(let ((f0-5 (cond
((< 1.0 arg0)
16383.996
)
(else
(let ((f0-8 (sqrtf (- 1.0 (square arg0)))))
(atan0 arg0 f0-8)
)
)
)
)
)
(if gp-0
(- f0-5)
f0-5
)
)
)
)
;; definition for function acos
(defun acos ((arg0 float))
"Inverse cosine. Returns rotation units."
(- 16384.0 (asin arg0))
)
;; definition for function acos-rad
(defun acos-rad ((arg0 float))
"Inverse cosine, radians."
(cond
((>= arg0 0.0)
(let* ((f0-3 (sqrtf (- 1.0 (square arg0))))
(f0-5 (/ (- f0-3 arg0) (+ f0-3 arg0)))
)
(atan-series-rad f0-5)
)
)
(else
(let* ((f0-8 (sqrtf (- 1.0 (square arg0))))
(f0-10 (/ (+ f0-8 arg0) (- f0-8 arg0)))
)
(- 3.1415925 (atan-series-rad f0-10))
)
)
)
)
;; definition for function sinerp
(defun sinerp ((arg0 float) (arg1 float) (arg2 float))
"Map amount to min,max using sine. Kinda weird, usually people use cosine."
(lerp arg0 arg1 (sin (* 16384.0 arg2)))
)
;; definition for function sinerp-clamp
(defun sinerp-clamp ((arg0 float) (arg1 float) (arg2 float))
"Like sinerp, but clamp to min,max."
(cond
((>= 0.0 arg2)
arg0
)
((>= arg2 1.0)
arg1
)
(else
(sinerp arg0 arg1 arg2)
)
)
)
;; definition for function coserp
(defun coserp ((arg0 float) (arg1 float) (arg2 float))
"Weird lerp with cosine (over 90 degrees?)."
(lerp arg0 arg1 (- 1.0 (cos (* 16384.0 arg2))))
)
;; definition for function coserp-clamp
(defun coserp-clamp ((arg0 float) (arg1 float) (arg2 float))
"Weird 90 degree lerp with cosine, clamped to min,max."
(cond
((>= 0.0 arg2)
arg0
)
((>= arg2 1.0)
arg1
)
(else
(coserp arg0 arg1 arg2)
)
)
)
;; definition for function coserp180
(defun coserp180 ((arg0 float) (arg1 float) (arg2 float))
"Classic lerp with cosine."
(lerp arg0 arg1 (* 0.5 (- 1.0 (cos (* 32768.0 arg2)))))
)
;; definition for function coserp180-clamp
(defun coserp180-clamp ((arg0 float) (arg1 float) (arg2 float))
"Classic coserp with saturation."
(cond
((>= 0.0 arg2)
arg0
)
((>= arg2 1.0)
arg1
)
(else
(coserp180 arg0 arg1 arg2)
)
)
)
;; definition for function ease-in-out
(defun ease-in-out ((arg0 int) (arg1 int))
"Weird coserp like mapping from 0 to 1 as progress goes from 0 to total."
(local-vars (v1-0 int))
(cond
((>= arg1 arg0)
1.0
)
((<= arg1 0)
0.0
)
((begin (set! v1-0 (/ arg0 2)) (< v1-0 arg1))
(let ((a0-1 (- arg1 arg0)))
(+ 0.5 (* 0.5 (sin (- 16384.0 (/ (* 16384.0 (the float a0-1)) (the float v1-0))))))
)
)
(else
(- 0.5 (* 0.5 (cos (/ (* 16384.0 (the float arg1)) (the float v1-0)))))
)
)
)