jak-project/goal_src/jak3/engine/common-obs/curves.gc

;;-*-Lisp-*-
(in-package goal)

;; name: curves.gc
;; name in dgo: curves
;; dgos: GAME

(declare-type curve2d basic)
(declare-type curve-color basic)
(declare-type curve-color-fast curve-color)
(declare-type curve2d-piecewise curve2d)
(declare-type curve2d-fast basic)

(define-extern *curve-unity* curve2d-fast)
(define-extern *curve-linear-up* curve2d-fast)
(define-extern *curve-linear-down* curve2d-fast)
(define-extern *curve-linear-up-hold* curve2d-piecewise)
(define-extern *curve-linear-up-down* curve2d-fast)
(define-extern *trail-color-curve-white* curve-color-fast)
(define-extern particle-color-curve-white* curve-color-fast)
(define-extern *trail-color-curve-red* curve-color-fast)

;; DECOMP BEGINS

(deftype float-pair (structure)
  ((first   float)
   (second  float)
   (x       float  :overlay-at first)
   (y       float  :overlay-at second)
   )
  )


(deftype float-pair-array (inline-array-class)
  ((data  float-pair  :inline :dynamic)
   )
  )


(set! (-> float-pair-array heap-base) (the-as uint 16))

(deftype curve2d (basic)
  ()
  (:methods
    (curve2d-method-9 (_type_ float int) float)
    )
  )


(deftype curve-color (basic)
  ()
  (:methods
    (curve-color-method-9 (_type_ float rgbaf int) rgbaf)
    )
  )


(deftype curve2d-piecewise (curve2d)
  ((pts                    float-pair-array)
   (default-loop-behavior  uint64)
   )
  (:methods
    (curve2d-piecewise-method-10 (_type_ int symbol int) none)
    (curve2d-piecewise-method-11 (_type_) none)
    )
  )


(deftype curve2d-fast (curve2d)
  ((xs                 vector  :inline)
   (ys                 vector  :inline)
   (one-over-x-deltas  vector  :inline)
   )
  )


(defun rgbaf-lerp! ((arg0 rgbaf) (arg1 rgbaf) (arg2 rgbaf) (arg3 float))
  (vector-lerp! arg0 arg1 arg2 arg3)
  (set! (-> arg0 w) (lerp (-> arg1 w) (-> arg2 w) arg3))
  arg0
  )

(deftype curve-color-fast (curve-color)
  ((xs                 vector  :inline)
   (ys                 vector  4 :inline)
   (one-over-x-deltas  vector  :inline)
   )
  )


(deftype color-pair (structure)
  ((first   float)
   (second  rgbaf  :inline)
   (x       float          :overlay-at first)
   (y       rgbaf  :inline :overlay-at second)
   )
  )


(deftype color-pair-array (inline-array-class)
  ((data  color-pair  :inline :dynamic)
   )
  )


(set! (-> color-pair-array heap-base) (the-as uint 32))

(deftype curve-color-piecewise (curve-color)
  ((pts                    color-pair-array)
   (default-loop-behavior  uint64)
   )
  (:methods
    (curve-color-piecewise-method-10 (_type_ int symbol uint) none)
    )
  )


(defmethod curve2d-piecewise-method-10 ((this curve2d-piecewise) (arg0 int) (arg1 symbol) (arg2 int))
  (set! (-> this pts) ((method-of-type float-pair-array new) arg1 float-pair-array arg0))
  (set! (-> this default-loop-behavior) (the-as uint (if arg2
                                                         0
                                                         1
                                                         )
                                                )
        )
  0
  (none)
  )

(defmethod curve-color-piecewise-method-10 ((this curve-color-piecewise) (arg0 int) (arg1 symbol) (arg2 uint))
  (set! (-> this pts) ((method-of-type color-pair-array new) arg1 color-pair-array arg0))
  (set! (-> this default-loop-behavior) (the-as uint (if arg2
                                                         0
                                                         1
                                                         )
                                                )
        )
  0
  (none)
  )

(defmethod curve-color-method-9 ((this curve-color-piecewise) (arg0 float) (arg1 rgbaf) (arg2 int))
  (when (or (< 1.0 arg0) (< arg0 0.0))
    (if (= arg2 3)
        (set! arg2 (the-as int (-> this default-loop-behavior)))
        )
    (let ((v1-8 arg2))
      (cond
        ((zero? v1-8)
         (set! arg0 (- arg0 (* (the float (the int (/ arg0 1.0))) 1.0)))
         )
        ((= v1-8 1)
         (set! arg0 (fmax 0.0 (fmin 1.0 arg0)))
         )
        )
      )
    )
  (when (= arg0 0.0)
    (set! (-> arg1 quad) (-> this pts data 0 second quad))
    (return arg1)
    )
  (dotimes (s4-0 (-> this pts length))
    (when (>= (-> this pts data s4-0 first) arg0)
      (let ((a3-4 (lerp-scale 0.0 1.0 arg0 (-> this pts data (+ s4-0 -1) first) (-> this pts data s4-0 first))))
        (return (rgbaf-lerp!
                  arg1
                  (the-as rgbaf (+ (the-as uint (-> this pts data 0 second)) (* (+ s4-0 -1) 32)))
                  (the-as rgbaf (+ (the-as uint (-> this pts data 0 second)) (* s4-0 32)))
                  a3-4
                  )
                )
        )
      )
    )
  (the-as rgbaf #f)
  )

(defmethod curve2d-method-9 ((this curve2d-piecewise) (arg0 float) (arg1 int))
  (when (or (< 1.0 arg0) (< arg0 0.0))
    (if (= arg1 3)
        (set! arg1 (the-as int (-> this default-loop-behavior)))
        )
    (let ((v1-8 arg1))
      (cond
        ((zero? v1-8)
         (set! arg0 (- arg0 (* (the float (the int (/ arg0 1.0))) 1.0)))
         )
        ((= v1-8 1)
         (set! arg0 (fmax 0.0 (fmin 1.0 arg0)))
         )
        )
      )
    )
  (if (= arg0 0.0)
      (return (-> this pts data 0 second))
      )
  (dotimes (v1-18 (-> this pts length))
    (if (>= (-> this pts data v1-18 first) arg0)
        (return (lerp-scale
                  (-> this pts data (+ v1-18 -1) second)
                  (-> this pts data v1-18 second)
                  arg0
                  (-> this pts data (+ v1-18 -1) first)
                  (-> this pts data v1-18 first)
                  )
                )
        )
    )
  0.0
  )

;; WARN: Return type mismatch number vs float.
(defun evaluate-curve-fast ((arg0 curve2d-fast) (arg1 rgbaf) (arg2 rgbaf))
  (local-vars (v0-0 number))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf24 :class vf)
         (vf25 :class vf)
         (vf26 :class vf)
         (vf27 :class vf)
         (vf28 :class vf)
         (vf29 :class vf)
         )
    (init-vf0-vector)
    (let ((a2-1 (new 'stack-no-clear 'vector))
          (v1-0 (new 'stack-no-clear 'vector))
          )
      (.mov vf27 arg1)
      (.lvf vf24 (&-> arg0 xs quad))
      (.lvf vf25 (&-> arg0 ys quad))
      (.lvf vf26 (&-> arg0 one-over-x-deltas quad))
      (.min.w.vf vf27 vf27 vf0)
      (.max.x.vf vf27 vf27 vf0)
      (.add.x.vf vf28 vf24 vf27)
      (.mul.w.vf acc vf25 vf0)
      (.add.mul.vf vf29 vf28 vf26 acc)
      (.svf (&-> a2-1 quad) vf28)
      (.svf (&-> v1-0 quad) vf29)
      (let ((a0-1 (-> a2-1 z))
            (a1-1 (-> a2-1 y))
            )
        (nop!)
        (b! (>= (the-as int a0-1) 0) cfg-3 :delay (set! v0-0 (-> v1-0 z)))
        (b! (>= (the-as int a1-1) 0) cfg-3 :delay (set! v0-0 (-> v1-0 y)))
        )
      (set! v0-0 (-> v1-0 x))
      )
    (label cfg-3)
    (the-as float v0-0)
    )
  )

;; WARN: Return type mismatch number vs float.
(defmethod curve2d-method-9 ((this curve2d-fast) (arg0 float) (arg1 int))
  (local-vars (v0-0 number))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf24 :class vf)
         (vf25 :class vf)
         (vf26 :class vf)
         (vf27 :class vf)
         (vf28 :class vf)
         (vf29 :class vf)
         )
    (init-vf0-vector)
    (let ((a1-1 (new 'stack-no-clear 'vector))
          (v1-0 (new 'stack-no-clear 'vector))
          )
      (let ((a2-1 arg0))
        (.mov vf27 a2-1)
        )
      (.lvf vf24 (&-> this xs quad))
      (.lvf vf25 (&-> this ys quad))
      (.lvf vf26 (&-> this one-over-x-deltas quad))
      (.min.w.vf vf27 vf27 vf0)
      (.max.x.vf vf27 vf27 vf0)
      (.add.x.vf vf28 vf24 vf27)
      (.mul.w.vf acc vf25 vf0)
      (.add.mul.vf vf29 vf28 vf26 acc)
      (.svf (&-> a1-1 quad) vf28)
      (.svf (&-> v1-0 quad) vf29)
      (let ((a0-1 (-> a1-1 z))
            (a1-2 (-> a1-1 y))
            )
        (nop!)
        (b! (>= (the-as int a0-1) 0) cfg-3 :delay (set! v0-0 (-> v1-0 z)))
        (b! (>= (the-as int a1-2) 0) cfg-3 :delay (set! v0-0 (-> v1-0 y)))
        )
      (set! v0-0 (-> v1-0 x))
      )
    (label cfg-3)
    (the-as float v0-0)
    )
  )

(defun evaluate-color-curve-fast ((arg0 curve-color-fast) (arg1 rgbaf) (arg2 rgbaf))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf23 :class vf)
         (vf25 :class vf)
         (vf26 :class vf)
         (vf28 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         )
    (init-vf0-vector)
    (let ((v1-0 (new 'stack-no-clear 'vector)))
      (.mov vf26 arg1)
      (.lvf vf23 (&-> arg0 xs quad))
      (.lvf vf25 (&-> arg0 one-over-x-deltas quad))
      (.max.w.vf vf3 vf0 vf0)
      (.mul.vf acc vf25 vf23)
      (.add.mul.x.vf vf28 vf25 vf26 acc)
      (.svf (&-> v1-0 quad) vf28)
      (let ((a1-1 (-> v1-0 z))
            (v1-1 (-> v1-0 y))
            )
        (b! (>= (the-as int a1-1) 0) cfg-4 :delay (nop!))
        (b! (>= (the-as int v1-1) 0) cfg-3 :delay (nop!))
        )
      )
    (.lvf vf1 (&-> arg0 ys 0 quad))
    (.lvf vf2 (&-> arg0 ys 1 quad))
    (.sub.x.vf vf4 vf3 vf28)
    (.mul.x.vf acc vf2 vf28)
    (.add.mul.x.vf vf5 vf1 vf4 acc)
    (b! #t cfg-5 :delay (.svf (&-> arg2 quad) vf5))
    (label cfg-3)
    (.lvf vf1 (&-> arg0 ys 1 quad))
    (.lvf vf2 (&-> arg0 ys 2 quad))
    (.sub.y.vf vf4 vf3 vf28)
    (.mul.y.vf acc vf2 vf28)
    (.add.mul.y.vf vf5 vf1 vf4 acc)
    (b! #t cfg-5 :delay (.svf (&-> arg2 quad) vf5))
    (label cfg-4)
    (.lvf vf1 (&-> arg0 ys 2 quad))
    (.lvf vf2 (&-> arg0 ys 3 quad))
    (.sub.z.vf vf4 vf3 vf28)
    (.mul.z.vf acc vf2 vf28)
    (.add.mul.z.vf vf5 vf1 vf4 acc)
    (.svf (&-> arg2 quad) vf5)
    (label cfg-5)
    arg2
    )
  )

(defmethod curve-color-method-9 ((this curve-color-fast) (arg0 float) (arg1 rgbaf) (arg2 int))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf23 :class vf)
         (vf25 :class vf)
         (vf26 :class vf)
         (vf28 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         )
    (init-vf0-vector)
    (let ((v1-0 this)
          (f0-0 arg0)
          (a0-1 arg1)
          )
      (let ((a1-1 (new 'stack-no-clear 'rgbaf)))
        (let ((a3-1 f0-0))
          (.mov vf26 a3-1)
          )
        (.lvf vf23 (&-> v1-0 xs quad))
        (.lvf vf25 (&-> v1-0 one-over-x-deltas quad))
        (.max.w.vf vf3 vf0 vf0)
        (.mul.vf acc vf25 vf23)
        (.add.mul.x.vf vf28 vf25 vf26 acc)
        (.svf (&-> a1-1 quad) vf28)
        (let ((a3-2 (-> a1-1 z))
              (a1-2 (-> a1-1 y))
              )
          (b! (>= (the-as int a3-2) 0) cfg-4 :delay (nop!))
          (b! (>= (the-as int a1-2) 0) cfg-3 :delay (nop!))
          )
        )
      (.lvf vf1 (&-> v1-0 ys 0 quad))
      (.lvf vf2 (&-> v1-0 ys 1 quad))
      (.sub.x.vf vf4 vf3 vf28)
      (.mul.x.vf acc vf2 vf28)
      (.add.mul.x.vf vf5 vf1 vf4 acc)
      (b! #t cfg-5 :delay (.svf (&-> a0-1 quad) vf5))
      (label cfg-3)
      (.lvf vf1 (&-> v1-0 ys 1 quad))
      (.lvf vf2 (&-> v1-0 ys 2 quad))
      (.sub.y.vf vf4 vf3 vf28)
      (.mul.y.vf acc vf2 vf28)
      (.add.mul.y.vf vf5 vf1 vf4 acc)
      (b! #t cfg-5 :delay (.svf (&-> a0-1 quad) vf5))
      (label cfg-4)
      (.lvf vf1 (&-> v1-0 ys 2 quad))
      (.lvf vf2 (&-> v1-0 ys 3 quad))
      (.sub.z.vf vf4 vf3 vf28)
      (.mul.z.vf acc vf2 vf28)
      (.add.mul.z.vf vf5 vf1 vf4 acc)
      (.svf (&-> a0-1 quad) vf5)
      )
    (label cfg-5)
    (set! (-> arg1 w) 1.0)
    arg1
    )
  )

;; WARN: Return type mismatch rgba vs int.
(defun rgba<-rgbaf ((arg0 rgba) (arg1 rgbaf))
  (the-as int (copy-and-set-field
                (copy-and-set-field
                  (copy-and-set-field
                    (copy-and-set-field arg0 r (the int (* 128.0 (-> arg1 x))))
                    g
                    (the int (* 128.0 (-> arg1 y)))
                    )
                  b
                  (the int (* 128.0 (-> arg1 z)))
                  )
                a
                (the int (* 128.0 (-> arg1 w)))
                )
          )
  )

(if #t
    (set! *curve-unity* (new 'static 'curve2d-fast
                          :xs (new 'static 'vector :y -1.0 :z -2.0 :w -3.0)
                          :ys (new 'static 'vector :x 1.0 :y 1.0 :z 2.0 :w 3.0)
                          :one-over-x-deltas (new 'static 'vector :y 1.0 :z 1.0 :w 1.0)
                          )
          )
    )

(if #t
    (set! *curve-linear-up* (new 'static 'curve2d-fast
                              :xs (new 'static 'vector :y -1.0 :z -2.0 :w -3.0)
                              :ys (new 'static 'vector :y 1.0 :z 2.0 :w 3.0)
                              :one-over-x-deltas (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0)
                              )
          )
    )

(if #t
    (set! *curve-linear-down* (new 'static 'curve2d-fast
                                :xs (new 'static 'vector :y -1.0 :z -2.0 :w -3.0)
                                :ys (new 'static 'vector :x 1.0 :z 1.0 :w 2.0)
                                :one-over-x-deltas (new 'static 'vector :x -1.0 :y 1.0 :z 1.0 :w 1.0)
                                )
          )
    )

(when (or (zero? *curve-linear-up-hold*) (!= loading-level global))
  (set! *curve-linear-up-hold* (new 'loading-level 'curve2d-piecewise))
  (curve2d-piecewise-method-10 *curve-linear-up-hold* 2 'loading-level (the-as int #f))
  )

(set! (-> *curve-linear-up-hold* pts data 0 first) 0.0)

(set! (-> *curve-linear-up-hold* pts data 0 second) 0.0)

(set! (-> *curve-linear-up-hold* pts data 1 first) 1.0)

(set! (-> *curve-linear-up-hold* pts data 1 second) 1.0)

(if #t
    (set! *curve-linear-up-down* (new 'static 'curve2d-fast
                                   :xs (new 'static 'vector :y -0.5 :z -1.0 :w -2.0)
                                   :ys (new 'static 'vector :y 1.0 :w 1.0)
                                   :one-over-x-deltas (new 'static 'vector :x 2.0 :y -2.0 :z 1.0 :w 1.0)
                                   )
          )
    )

(if #t
    (set! *trail-color-curve-white* (new 'static 'curve-color-fast
                                      :xs (new 'static 'vector :y -1.0 :z -2.0 :w -3.0)
                                      :ys (new 'static 'inline-array vector 4
                                        (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 128.0)
                                        (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 128.0)
                                        (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 128.0)
                                        (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 128.0)
                                        )
                                      :one-over-x-deltas (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0)
                                      )
          )
    )

(if #t
    (set! particle-color-curve-white* (new 'static 'curve-color-fast
                                        :xs (new 'static 'vector :y -1.0 :z -2.0 :w -3.0)
                                        :ys (new 'static 'inline-array vector 4
                                          (new 'static 'vector :x 128.0 :y 128.0 :z 128.0 :w 128.0)
                                          (new 'static 'vector :x 128.0 :y 128.0 :z 128.0 :w 128.0)
                                          (new 'static 'vector :x 128.0 :y 128.0 :z 128.0 :w 128.0)
                                          (new 'static 'vector :x 128.0 :y 128.0 :z 128.0 :w 128.0)
                                          )
                                        :one-over-x-deltas (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0)
                                        )
          )
    )

(if #t
    (set! *trail-color-curve-red* (new 'static 'curve-color-fast
                                    :xs (new 'static 'vector :y -0.2 :z -1.0 :w -2.0)
                                    :ys (new 'static 'inline-array vector 4
                                      (new 'static 'vector :x 1.0 :y 0.3 :w 128.0)
                                      (new 'static 'vector :x 1.0 :w 128.0)
                                      (new 'static 'vector :x 1.0 :w 128.0)
                                      (new 'static 'vector :x 1.0 :w 128.0)
                                      )
                                    :one-over-x-deltas (new 'static 'vector :x 5.0 :y 1.25 :z 1.0 :w 1.0)
                                    )
          )
    )