jak-project/goal_src/jak1/engine/camera/camera.gc

;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/engine/engines.gc")
(require "engine/entity/res.gc")
(require "engine/camera/cam-debug-h.gc")
(require "engine/geometry/geometry.gc")
(require "engine/game/main-h.gc")
(require "engine/util/smush-control-h.gc")
(require "engine/entity/entity-h.gc")
(require "engine/math/vector.gc")
(require "kernel/gstate.gc")
(require "engine/camera/cam-interface-h.gc")

;; DECOMP BEGINS

(define *cam-res-string* (new 'global 'string 64 (the-as string #f)))

(defun cam-slave-get-vector-with-offset ((source-actor entity-actor) (out vector) (prop-name symbol))
  "Read property from actor, using its live
   translation or rotation for the matching property names, add an optional property-offset vector,
   and write out. Return true when a value was available."
  (local-vars (base-value structure))
  (cond
    ((= prop-name 'trans) (set! base-value (-> source-actor trans)))
    ((= prop-name 'rot) (set! base-value (-> source-actor quat)))
    (else (set! base-value (res-lump-struct source-actor prop-name structure))))
  (let ((struct-getter (method-of-type res-lump get-property-struct)))
    (format (clear *res-key-string*) "~S~S" prop-name '-offset)
    (let ((offset-value (struct-getter source-actor
                                       (string->symbol *res-key-string*)
                                       'interp
                                       -1000000000.0
                                       #f
                                       (the-as (pointer res-tag) #f)
                                       *res-static-buf*)))
      (cond
        ((and base-value offset-value) (vector+! out (the-as vector base-value) (the-as vector offset-value)) #t)
        ((the-as vector base-value) (vector-copy! out (the-as vector base-value)) #t)
        (else #f)))))

(defun cam-slave-get-flags ((source-entity entity) (prop-name symbol))
  "Read property's base flag word, set bits from property-on,
   clear bits from property-off, and return the combined value."
  (let ((base-flags (res-lump-value source-entity prop-name uint128))
        (value-getter (method-of-type res-lump get-property-value))
        (source-copy source-entity))
    (format (clear *res-key-string*) "~S~S" prop-name '-on)
    (let ((set-flags (value-getter source-copy
                                   (string->symbol *res-key-string*)
                                   'interp
                                   -1000000000.0
                                   (the-as uint128 0)
                                   (the-as (pointer res-tag) #f)
                                   *res-static-buf*))
          (clear-getter (method-of-type res-lump get-property-value)))
      (format (clear *res-key-string*) "~S~S" prop-name '-off)
      (let ((clear-flags (clear-getter source-entity
                                       (string->symbol *res-key-string*)
                                       'interp
                                       -1000000000.0
                                       (the-as uint128 0)
                                       (the-as (pointer res-tag) #f)
                                       *res-static-buf*)))
        (logclear (logior base-flags set-flags) clear-flags)))))

(defun cam-slave-get-float ((source-entity entity) (prop-name symbol) (default-value float))
  "Read property from entity with default-value, add the
   interpolated property-offset value, and return the result."
  (let ((base-value (res-lump-float source-entity prop-name :default default-value))
        (float-getter (method-of-type res-lump get-property-value-float)))
    (format (clear *res-key-string*) "~S~S" prop-name '-offset)
    (+ base-value
       (float-getter source-entity
                     (string->symbol *res-key-string*)
                     'interp
                     -1000000000.0
                     0.0
                     (the-as (pointer res-tag) #f)
                     *res-static-buf*))))

(defun cam-slave-get-fov ((source-entity entity))
  "Read fov plus fov-offset from entity. A zero base fov uses the
   64-degree default before applying the offset."
  (let ((base-fov (res-lump-float source-entity 'fov))
        (float-getter (method-of-type res-lump get-property-value-float)))
    (format (clear *res-key-string*) "~S~S" 'fov '-offset)
    (let ((fov-offset (float-getter source-entity
                                    (string->symbol *res-key-string*)
                                    'interp
                                    -1000000000.0
                                    0.0
                                    (the-as (pointer res-tag) #f)
                                    *res-static-buf*)))
      (if (= base-fov 0.0) (+ 11650.845 fov-offset) (+ base-fov fov-offset)))))

(defun cam-slave-get-intro-step ((source-entity entity))
  "Read intro-time plus intro-time-offset and return the
   normalized increment for one 60 Hz frame. A non-positive duration uses the 1/240 fallback."
  (let ((base-duration (res-lump-float source-entity 'intro-time))
        (float-getter (method-of-type res-lump get-property-value-float)))
    (format (clear *res-key-string*) "~S~S" 'intro-time '-offset)
    (let ((duration (+ base-duration
                       (float-getter source-entity
                                     (string->symbol *res-key-string*)
                                     'interp
                                     -1000000000.0
                                     0.0
                                     (the-as (pointer res-tag) #f)
                                     *res-static-buf*))))
      (if (>= 0.0 duration) 0.004166667 (/ 0.016666668 duration)))))

(defun cam-slave-get-interp-time ((source-entity entity))
  "Read interpTime plus interpTime-offset from entity and
   return zero when the combined duration is at most one millisecond."
  (let ((base-duration (res-lump-float source-entity 'interpTime))
        (float-getter (method-of-type res-lump get-property-value-float)))
    (format (clear *res-key-string*) "~S~S" 'interpTime '-offset)
    (let ((duration (+ base-duration
                       (float-getter source-entity
                                     (string->symbol *res-key-string*)
                                     'interp
                                     -1000000000.0
                                     0.0
                                     (the-as (pointer res-tag) #f)
                                     *res-static-buf*))))
      (if (>= 0.001 duration) (set! duration 0.0))
      duration)))

(defun cam-slave-get-rot ((source-actor entity-actor) (out-matrix matrix))
  "Convert actor's rotation to out-matrix after composing an optional
   rot-offset quaternion."
  (let ((struct-getter (method-of-type res-lump get-property-struct))
        (source-copy source-actor))
    (format (clear *res-key-string*) "~S~S" 'rot '-offset)
    (let ((rotation-offset (struct-getter source-copy
                                          (string->symbol *res-key-string*)
                                          'interp
                                          -1000000000.0
                                          #f
                                          (the-as (pointer res-tag) #f)
                                          *res-static-buf*)))
      (cond
        (rotation-offset
         (let ((combined-rotation (new 'stack-no-clear 'quaternion)))
           (quaternion*! combined-rotation (the-as quaternion rotation-offset) (-> source-actor quat))
           (quaternion-normalize! combined-rotation)
           (quaternion->matrix out-matrix combined-rotation)))
        (else (quaternion->matrix out-matrix (-> source-actor quat))))))
  out-matrix)

(defun cam-state-from-entity ((source-entity entity))
  "Select the camera state described by entity: circular for a
   pivot, standoff for align data, spline for a camera path, the base string mode for positive
   stringMaxLength, or fixed otherwise. Return false for no entity."
  (let ((camera-path (new 'stack 'curve)))
    (the-as state
            (cond
              ((not source-entity) (the-as (state camera-slave) #f))
              ((res-lump-struct source-entity 'pivot structure) cam-circular)
              ((res-lump-struct source-entity 'align structure) cam-standoff-read-entity)
              ((get-curve-data! source-entity camera-path 'campath 'campath-k -1000000000.0) cam-spline)
              ((< 0.0 (cam-slave-get-float source-entity 'stringMaxLength 0.0)) *camera-base-mode*)
              (else cam-fixed-read-entity)))))

(defun parameter-ease-none ((value object))
  "Return value unchanged."
  value)

(defun parameter-ease-clamp ((t float))
  "Clamp t to 0..1."
  (cond
    ((>= t 1.0) (set! t 1.0))
    ((>= 0.0 t) (set! t 0.0)))
  t)

(defun parameter-ease-lerp-clamp ((t float))
  "Clamp t to 0..1 and apply a continuous piecewise-linear
   ease with shallow endpoint slopes and a steeper middle."
  (cond
    ((>= t 1.0) 1.0)
    ((>= 0.0 t) 0.0)
    ((>= 0.25 t) (/ t 2))
    ((>= t 0.75) (- 1.0 (* 0.5 (- 1.0 t))))
    (else (+ 0.125 (* 1.5 (+ -0.25 t))))))

(defun parameter-ease-sqrt-clamp ((t float))
  "Clamp t to 0..1 and apply the symmetric square-root
   shaping curve."
  (cond
    ((>= t 1.0) 1.0)
    ((>= 0.0 t) 0.0)
    ((>= 0.5 t) (* 0.5 (- 1.0 (sqrtf (- 1.0 (* 2.0 t))))))
    (else (* 0.5 (+ 1.0 (sqrtf (+ -1.0 (* 2.0 t))))))))

(defun fourth-power ((x float))
  "Return x to the fourth power."
  (square (square x)))

(defun third-power ((x float))
  "Return x to the third power."
  (* x x x))

(defun parameter-ease-sqr-clamp ((t float))
  "Clamp t to 0..1 and apply a symmetric quadratic
   ease-in/ease-out curve."
  (cond
    ((>= t 1.0) 1.0)
    ((>= 0.0 t) 0.0)
    ((>= 0.5 t) (* 0.5 (square (* 2.0 t))))
    (else (- 1.0 (* 0.5 (square (* 2.0 (- 1.0 t))))))))

(defun parameter-ease-sin-clamp ((t float))
  "Clamp t to 0..1 and apply a half-cosine ease with zero
   slope at both endpoints."
  (cond
    ((>= t 1.0) 1.0)
    ((>= 0.0 t) 0.0)
    (else (+ 0.5 (* 0.5 (sin (* 182.04445 (+ -90.0 (* 180.0 t)))))))))

(defmethod setup-from-entity! ((this cam-index) (prop-name symbol) (source-entity entity) (cam-pos vector) (fallback-curve curve))
  "Read the two endpoint vectors from entity data or
   fallback-curve and prepare their spherical, radial, or linear
   parameterization."
  (format (clear *cam-res-string*) "~S-flags" prop-name)
  (set! (-> this flags) (the-as cam-index-options (cam-slave-get-flags source-entity (string->symbol *res-key-string*))))
  (let ((points-data (res-lump-data source-entity prop-name pointer))
        (struct-getter (method-of-type res-lump get-property-struct)))
    (format (clear *res-key-string*) "~S~S" prop-name '-offset)
    (let ((offset-vec (struct-getter source-entity
                                     (string->symbol *res-key-string*)
                                     'interp
                                     -1000000000.0
                                     #f
                                     (the-as (pointer res-tag) #f)
                                     *res-static-buf*)))
      (cond
        (points-data
         (cond
           (offset-vec
            (vector+! (-> this vec 0) (the-as vector (&+ points-data 0)) (the-as vector offset-vec))
            (vector+! (-> this vec 1) (the-as vector (&+ points-data 16)) (the-as vector offset-vec)))
           (else
            (set! (-> this vec 0 quad) (-> (the-as (pointer uint128) (&+ points-data 0))))
            (set! (-> this vec 1 quad) (-> (the-as (pointer uint128) (&+ points-data 16)))))))
        (fallback-curve
         (vector-copy! (-> this vec 0) (-> fallback-curve cverts 0))
         (vector-copy! (-> this vec 1) (-> fallback-curve cverts (+ (-> fallback-curve num-cverts) -1))))
        (else (return #f)))))
  (let ((tmp-vec (new-stack-vector0)))
    0.0
    (cond
      ((logtest? (-> this flags) (cam-index-options SPHERICAL))
       (vector-! tmp-vec (-> this vec 1) cam-pos)
       (set! (-> this vec 1 w) (vector-length tmp-vec))
       (vector-! tmp-vec (-> this vec 0) cam-pos)
       (set! (-> this vec 1 x) (vector-length tmp-vec))
       (set! (-> this vec 1 w) (- (-> this vec 1 w) (-> this vec 1 x)))
       (vector-copy! (-> this vec 0) cam-pos))
      ((logtest? (-> this flags) (cam-index-options RADIAL))
       (vector-! tmp-vec (-> this vec 1) cam-pos)
       (set! (-> this vec 1 w) (vector-length tmp-vec))
       (vector-! tmp-vec (-> this vec 0) cam-pos)
       (set! (-> this vec 1 x) (vector-length tmp-vec))
       (set! (-> this vec 1 w) (- (-> this vec 1 w) (-> this vec 1 x)))
       (vector-copy! (-> this vec 0) cam-pos))
      (else
       (vector-! (-> this vec 1) (-> this vec 1) (-> this vec 0))
       (set! (-> this vec 1 w) (vector-normalize-ret-len! (-> this vec 1) 1.0)))))
  #t)

(defmethod point->parameter ((this cam-index) (pos vector))
  "Project a world point onto this index and return its
   normalized position."
  (let ((delta (new-stack-vector0)))
    0.0
    (vector-! delta pos (-> this vec 0))
    (cond
      ((logtest? (-> this flags) (cam-index-options SPHERICAL))
       (vector-flatten! delta delta (-> *camera* local-down))
       (/ (- (vector-length delta) (-> this vec 1 x)) (-> this vec 1 w)))
      ((logtest? (-> this flags) (cam-index-options RADIAL))
       (/ (- (vector-length delta) (-> this vec 1 x)) (-> this vec 1 w)))
      (else (/ (vector-dot delta (-> this vec 1)) (-> this vec 1 w))))))

;; The tracking spline is a fixed pool of 32 breadcrumbs. used-point and
;; free-point are index-based linked lists over the same array, and -134250495
;; terminates either list. Each used point stores the normalized direction and
;; length of its segment to next. A sampler is therefore just a point index and
;; a fractional position within that point's outgoing segment.
;;
;; New target positions are appended at end-point. The live head advances as
;; the camera catches up, returning old slots to the free list. If all slots are
;; occupied, the straightest interior point is removed first; the segment is
;; rebuilt across the gap so the trail loses as little shape as possible.
;;
;; Camera motion is filtered in arc-length space. follow-update! advances at a
;; rate based on the remaining trail, takes 64 equally spaced samples across an
;; adaptive window, and averages them. The result glides along bends instead of
;; cutting directly from one frame's target position to the next.

(defmethod reset! ((this tracking-spline) (start-pos vector))
  "Reset the trail to start-pos and rebuild the free chain over the
   remaining slots."
  (vector-copy! (-> this point 0 position) start-pos)
  (set! (-> this point 0 next) -134250495)
  (set! (-> this summed-len) 0.0)
  (set! (-> this free-point) 1)
  (set! (-> this used-point) 0)
  (set! (-> this partial-point) 0.0)
  (set! (-> this end-point) 0)
  (set! (-> this next-to-last-point) -134250495)
  (set! (-> this max-move) 0.0)
  (set! (-> this sample-len) 0.0)
  (set! (-> this used-count) 1)
  (vector-copy! (-> this old-position) start-pos)
  (let ((i 1)) (while (!= i 31) (set! (-> this point i next) (+ i 1)) (+! i 1)) (set! (-> this point i next) -134250495))
  0
  (none))

(defmethod delete-point! ((this tracking-spline) (pt int))
  "Remove the point after pt, return its slot to the free
   chain, and reconnect the surrounding segment."
  (let ((next-pt (-> this point pt next)))
    (cond
      ((= next-pt -134250495))
      ((= (-> this point next-pt next) -134250495))
      (else
       (set! (-> this point pt next) (-> this point next-pt next))
       (set! (-> this summed-len) (- (-> this summed-len) (-> this point next-pt tp-length)))
       (set! (-> this point next-pt next) (-> this free-point))
       (set! (-> this free-point) next-pt)
       (+! (-> this point next-pt incarnation) 1)
       (let ((after-pt (-> this point pt next)))
         (set! (-> this summed-len) (- (-> this summed-len) (-> this point pt tp-length)))
         (vector-! (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 pt)))
                   (-> this point after-pt position)
                   (-> this point pt position)))
       (set! (-> this point pt tp-length)
             (vector-normalize-ret-len! (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 pt))) 1.0))
       (+! (-> this summed-len) (-> this point pt tp-length))
       (+! (-> this used-count) -1))))
  0
  (none))

(defmethod advance-used-point! ((this tracking-spline) (sampler tracking-spline-sampler))
  "Advance the used-chain head to sampler, freeing the
   points passed and updating the trail length."
  (let ((cur-pt (-> this used-point)))
    (set! (-> this partial-point) (-> sampler partial-pt))
    (when (= (-> this next-to-last-point) cur-pt)
      (set! (-> this summed-len) (-> this point cur-pt tp-length))
      (if (= (-> sampler cur-pt) (-> this end-point)) (set! (-> this partial-point) 0.99999)))
    (when (!= (-> sampler cur-pt) cur-pt)
      (while (and (!= (-> this point cur-pt next) (-> sampler cur-pt)) (!= (-> this point cur-pt next) (-> this next-to-last-point)))
        (set! (-> this summed-len) (- (-> this summed-len) (-> this point cur-pt tp-length)))
        (+! (-> this point cur-pt incarnation) 1)
        (+! (-> this used-count) -1)
        (set! cur-pt (-> this point cur-pt next)))
      (set! (-> this summed-len) (- (-> this summed-len) (-> this point cur-pt tp-length)))
      (+! (-> this point cur-pt incarnation) 1)
      (+! (-> this used-count) -1)
      (set! (-> this point cur-pt next) (-> this free-point))
      (set! (-> this free-point) (-> this used-point))
      (set! (-> this used-point) (-> sampler cur-pt))
      (cond
        ((= (-> sampler cur-pt) (-> this end-point)) (set! (-> this partial-point) 0.0) (set! (-> this summed-len) 0.0))
        ((= (-> sampler cur-pt) (-> this next-to-last-point))
         (set! (-> this summed-len) (-> this point (-> this next-to-last-point) tp-length))))))
  0
  (none))

(defmethod prune-most-collinear! ((this tracking-spline))
  "Free the interior point whose removal changes the
   trail direction least."
  (let ((sampler (new 'stack-no-clear 'tracking-spline-sampler)))
    (let ((sample-pos (new 'stack-no-clear 'tracking-point)))
      (set! (-> sampler cur-pt) (-> this used-point))
      (set! (-> sampler partial-pt) (-> this partial-point))
      (sample-point! this (-> this sample-len) (-> sample-pos position) sampler))
    (if (or (= (-> sampler cur-pt) (-> this end-point))
            (= (-> sampler cur-pt) (-> this next-to-last-point))
            (= (-> this point (-> sampler cur-pt) next) (-> this next-to-last-point)))
      (set! (-> sampler cur-pt) (-> this used-point)))
    (let ((cur-pt (-> this point (-> sampler cur-pt) next)))
      (when (!= cur-pt -134250495)
        (let ((next-pt (-> this point cur-pt next))
              (best-pt cur-pt)
              (best-dot -2.0))
          0.0
          (while (not (or (= next-pt -134250495) (= next-pt (-> this end-point))))
            (let ((dot (vector-dot (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 cur-pt)))
                                   (the-as vector (+ (the-as uint (the-as vector (-> this point 0 direction))) (* 48 next-pt))))))
              (when (>= dot best-dot)
                (set! best-dot dot)
                (set! best-pt cur-pt)))
            (set! cur-pt next-pt)
            (set! next-pt (-> this point cur-pt next)))
          (if (< -2.0 best-dot) (delete-point! this best-pt))))))
  0
  (none))

;; This pass uses segment-length * (1 + direction-dot) as its score.
;; Short segments and reversals have the smallest score; budget controls how
;; aggressively those interior samples are removed.
(defmethod prune-shallow-points! ((this tracking-spline) (budget float))
  "Remove interior points whose length-weighted bend
   is below budget."
  (let ((sampler (new 'stack-no-clear 'tracking-spline-sampler)))
    (let ((sample-pos (new 'stack-no-clear 'vector)))
      (set! (-> sampler cur-pt) (-> this used-point))
      (set! (-> sampler partial-pt) (-> this partial-point))
      (sample-point! this (-> this sample-len) sample-pos sampler))
    (let ((cur-pt (-> this point (-> sampler cur-pt) next)))
      (when (!= cur-pt -134250495)
        (let ((next-pt (-> this point cur-pt next)))
          (while (not (or (= next-pt -134250495)
                          (= (-> this point next-pt next) -134250495)
                          (= (-> this point next-pt next) (-> this end-point))
                          (= (-> this point next-pt next) (-> this next-to-last-point))))
            (if (< (* (-> this point cur-pt tp-length)
                      (+ 1.0
                         (vector-dot (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 cur-pt)))
                                     (the-as vector (+ (the-as uint (the-as vector (-> this point 0 direction))) (* 48 next-pt))))))
                   budget)
              (delete-point! this cur-pt)
              (set! cur-pt next-pt))
            (set! next-pt (-> this point cur-pt next)))))))
  0
  (none))

(defmethod add-point! ((this tracking-spline) (new-pos vector) (min-dist float) (prune-budget float) (can-prune symbol))
  "Append new-pos when it is at least min-dist from the tail,
   optionally pruning the trail to obtain a free slot."
  (let ((free-pt (-> this free-point))
        (tail-pt (-> this end-point)))
    (vector-! (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 tail-pt)))
              new-pos
              (-> this point tail-pt position))
    (set! (-> this point tail-pt tp-length)
          (vector-normalize-ret-len! (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 tail-pt))) 1.0))
    (if (< (-> this point tail-pt tp-length) min-dist) (return 0))
    (when (and can-prune (= free-pt -134250495))
      (prune-most-collinear! this)
      (set! free-pt (-> this free-point)))
    (cond
      ((= free-pt -134250495) (format 0 "ERROR <GMJ>: pos spline overflow~%"))
      (else
       (+! (-> this summed-len) (-> this point tail-pt tp-length))
       (set! (-> this free-point) (-> this point free-pt next))
       (set! (-> this point tail-pt next) free-pt)
       (set! (-> this end-point) free-pt)
       (set! (-> this next-to-last-point) tail-pt)
       (set! (-> this point free-pt next) -134250495)
       (vector-copy! (-> this point free-pt position) new-pos)
       (+! (-> this used-count) 1)
       (if (< 0.0 prune-budget) (prune-shallow-points! this prune-budget)))))
  0)

(defmethod accumulate-sample! ((this tracking-spline) (arc-len float) (out-pos vector) (sampler tracking-spline-sampler))
  "Walk arc-len forward from sampler and add the sampled
   trail position to out-pos."
  (local-vars (advanced float))
  (when (not sampler)
    (set! sampler (new 'stack-no-clear 'tracking-spline-sampler))
    (set! (-> sampler cur-pt) (-> this used-point))
    (set! (-> sampler partial-pt) (-> this partial-point)))
  0.0
  (loop
    (cond
      ((= (-> sampler cur-pt) (-> this end-point))
       (set! (-> sampler partial-pt) 0.0)
       (vector+! out-pos out-pos (-> this point (-> sampler cur-pt) position))
       (return out-pos))
      ((begin
         (set! advanced (+ (-> sampler partial-pt) (/ arc-len (-> this point (-> sampler cur-pt) tp-length))))
         (< advanced 1.0))
       (set! (-> sampler partial-pt) advanced)
       (let ((sample-pos (new 'stack-no-clear 'vector)))
         (let ((next-pt (-> this point (-> sampler cur-pt) next)))
           (vector-lerp! sample-pos (-> this point (-> sampler cur-pt) position) (-> this point next-pt position) advanced))
         (vector+! out-pos out-pos sample-pos))
       (return out-pos))
      (else
       (let ((remaining-segment (* (- 1.0 (-> sampler partial-pt)) (-> this point (-> sampler cur-pt) tp-length))))
         (set! arc-len (- arc-len remaining-segment)))
       (set! (-> sampler partial-pt) 0.0)
       (set! (-> sampler cur-pt) (-> this point (-> sampler cur-pt) next)))))
  (the-as vector #f))

(defmethod sample-point! ((this tracking-spline) (arc-len float) (out-pos vector) (sampler tracking-spline-sampler))
  "Clear out-pos and sample the trail arc-len forward from
   sampler."
  (vector-reset! out-pos)
  (accumulate-sample! this arc-len out-pos sampler)
  out-pos)

(defmethod apply-trail-correction! ((this tracking-spline) (move vector) (stop-pt int))
  "Bias move along the changes in trail direction before
   stop-pt. The correction is strongest on short, curved trails and fades as the recorded path
   becomes straighter."
  (let ((trail-dir (new 'stack-no-clear 'vector)))
    (vector-! trail-dir (-> this point (-> this used-point) position) (-> this point (-> this end-point) position))
    (let* ((chord-len (vector-length trail-dir))
           (span-boost-raw (* 0.33333334 (- 1.5 (/ chord-len METER_LENGTH)))))
      0.0
      (let* ((span-boost (fmax 0.0 span-boost-raw))
             (correction-scale (+ 0.3 span-boost))
             (chord-to-arc (cond
                             ((< (-> *CAMERA-bank* min-detectable-velocity) (-> this summed-len))
                              (vector-float*! trail-dir trail-dir (/ 1.0 chord-len))
                              (/ chord-len (-> this summed-len)))
                             (else (vector-reset! trail-dir) 0.0)))
             (straightness-bias (+ -0.2 chord-to-arc))
             (straightness-scale (* 2.0 straightness-bias))
             (alignment-weight (fmin 1.0 (fmax 0.05 straightness-scale)))
             (cur-pt (-> this used-point))
             (seg-dir (new 'stack-no-clear 'vector)))
        (while (and (!= cur-pt (-> this end-point)) (!= cur-pt (-> this next-to-last-point)) (!= cur-pt stop-pt))
          (let ((next-pt (-> this point cur-pt next)))
            (vector-! seg-dir
                      (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 next-pt)))
                      (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 cur-pt))))
            (let* ((segment-len (vector-normalize-ret-len! seg-dir 1.0))
                   (half-segment-len (/ segment-len 2))
                   (correction (* (fmin 1.0 half-segment-len) correction-scale (vector-dot move seg-dir))))
              (let ((forward-dot (vector-dot seg-dir trail-dir)))
                (cond
                  ((>= 0.0 forward-dot))
                  (else (set! correction (* correction (fmax 0.0 (- 0.75 (fabs (* alignment-weight forward-dot)))))))))
              (cond
                ((< correction 0.0)
                 (if (and *debug-segment* *display-camera-marks*)
                   (camera-line-rel-len (-> this point next-pt position)
                                        seg-dir
                                        (* -40.96 correction)
                                        (-> (new 'static 'inline-array qword 1 (new 'static 'qword :data (new 'static 'array uint32 4 #xff #xff #x0 #x80)))
                                            0
                                            vector4w)))
                 (vector--float*! move move seg-dir correction))
                ((and *debug-segment* *display-camera-marks*)
                 (camera-line-rel-len (-> this point next-pt position)
                                      seg-dir
                                      (* 40.96 correction)
                                      (-> (new 'static 'inline-array qword 1 (new 'static 'qword :data (new 'static 'array uint32 4 #x80 #x80 #x0 #x80)))
                                          0
                                          vector4w)))))
            (set! cur-pt next-pt))))))
  0
  (none))

(defmethod follow-update! ((this tracking-spline) (pos vector) (accel float) (max-speed float))
  "Advance the trail follower toward pos using accel and
   max-speed. Average 64 evenly spaced samples over the adaptive sample window, apply the
   trail-direction correction, and return the smoothed position."
  (let ((cur-pt (-> this used-point))
        (partial (-> this partial-point)))
    (let ((trail-len (-> this summed-len)))
      0.0
      0.0
      (let* ((remaining-len (- trail-len (* partial (-> this point cur-pt tp-length))))
             (desired-speed (/ remaining-len 10))
             (speed-step (* (fmin accel (- desired-speed (-> this max-move))) (-> *display* time-adjust-ratio))))
        (set! (-> this max-move) (fmin max-speed (+ (-> this max-move) speed-step)))))
    (set! (-> this max-move) (fmax 0.4096 (-> this max-move)))
    (let ((updated-trail-len (-> this summed-len)))
      0.0
      (let* ((updated-remaining-len (- updated-trail-len (* partial (-> this point cur-pt tp-length))))
             (sample-len-step (fmin 204.8 (- updated-remaining-len (-> this sample-len)))))
        (set! (-> this sample-len) (fmin 16384.0 (+ (-> this sample-len) sample-len-step)))))
    (let ((sampler (new 'stack-no-clear 'tracking-spline-sampler)))
      (set! (-> sampler cur-pt) cur-pt)
      (set! (-> sampler partial-pt) partial)
      (sample-point! this (* (-> this max-move) (-> *display* time-adjust-ratio)) pos sampler)
      (advance-used-point! this sampler)
      (dotimes (i 63)
        (accumulate-sample! this (/ (-> this sample-len) 64) pos sampler))
      (vector-float*! pos pos 0.015625)
      (let ((cursor-pt (-> sampler cur-pt)))
        (set! (-> this debug-last-point) cursor-pt)
        (let ((delta (new 'stack-no-clear 'vector)))
          (vector-copy! (-> this debug-old-position) (-> this old-position))
          (vector-copy! (-> this debug-out-position) pos)
          (vector-! delta pos (-> this old-position))
          (apply-trail-correction! this delta cursor-pt)
          (vector+! pos (-> this old-position) delta)))))
  (vector-copy! (-> this old-position) pos)
  pos)

(defmethod trim-to-length! ((this tracking-spline) (max-len float))
  "Drop the oldest trail segments until its live length is
   no greater than max-len."
  (when (< max-len (-> this summed-len))
    (let ((sampler (new 'stack-no-clear 'tracking-spline-sampler)))
      (let ((tmp-pos (new 'stack-no-clear 'vector)))
        (set! (-> sampler cur-pt) (-> this used-point))
        (set! (-> sampler partial-pt) 0.0)
        (sample-point! this (- (-> this summed-len) max-len) tmp-pos sampler))
      (advance-used-point! this sampler)))
  0
  (none))

(defmethod validate! ((this tracking-spline))
  "Recount the used and free chains and correct their counters if
   they disagree with the lists."
  (let ((cur-pt (-> this used-point))
        (live-count 0)
        (live-mask 0))
    (while (!= cur-pt -134250495)
      (set! live-mask (logior live-mask (ash 1 cur-pt)))
      (+! live-count 1)
      (set! cur-pt (-> this point cur-pt next)))
    (when (!= live-count (-> this used-count))
      (if *debug-segment* (format 0 "ERROR<GMJ>: tracking spline used count ~D actual ~D~%" (-> this used-count) live-count))
      (set! (-> this used-count) live-count))
    (let ((free-pt (-> this free-point))
          (free-count 0))
      (while (!= free-pt -134250495)
        (+! free-count 1)
        (set! free-pt (-> this point free-pt next)))
      (when (!= free-count (- 32 (-> this used-count)))
        (if *debug-segment*
          (format 0 "ERROR<GMJ>: tracking spline free count ~D actual ~D~%" (- 32 (-> this used-count)) free-count))
        (set! (-> this free-point) -134250495)
        (dotimes (i 32)
          (when (not (logtest? live-mask 1))
            (set! (-> this point i next) (-> this free-point))
            (set! (-> this free-point) i))
          (set! live-mask (shr live-mask 1))))))
  0
  (none))

(defbehavior cam-slave-init-vars camera-slave ()
  "Reset the camera slave's state. Preserve the active camera
   transform, rotation, field of view, and velocity when available; otherwise use the standard
   defaults."
  (cond
    (*camera*
     (set! (-> self options) (-> *camera* slave-options))
     (set! (-> self change-event-from) (the-as (pointer process-drawable) (-> *camera* changer))))
    (else
     (set! (-> self options) (the-as uint 0))
     (set! (-> self change-event-from) (the-as (pointer process-drawable) #f))))
  (cond
    (*camera-combiner*
     (vector-copy! (-> self trans) (-> *camera-combiner* trans))
     (matrix-copy! (-> self tracking inv-mat) (-> *camera-combiner* inv-camera-rot))
     (when *camera-init-mat*
       (matrix-copy! (-> self tracking inv-mat) *camera-init-mat*))
     (set! (-> self fov) (-> *camera-combiner* fov))
     (vector-copy! (-> self velocity) (-> *camera-combiner* velocity)))
    (else
     (vector-reset! (-> self trans))
     (matrix-identity! (-> self tracking inv-mat))
     (set! (-> self fov) 11650.845)
     (vector-reset! (-> self velocity))))
  (set! (-> self time-dist-too-far) (the-as uint 0))
  (set! (-> self intro-t) 1.0)
  (set! (-> self intro-t-step) 0.0)
  (set! (-> self spline-exists) #f)
  (set! (-> self los-state) (slave-los-state none))
  (set! (-> self enter-has-run) #f)
  (set! (-> self cam-entity) #f)
  (set! (-> self tracking no-follow) #f)
  (init-cam-float-seeker (-> self tracking tilt-adjust) (-> *CAMERA-bank* default-tilt-adjust) 9.102222 91.022224 0.25)
  (set! (-> self tracking follow-blend) 1.0)
  (set! (-> self have-phony-joystick) #f)
  (set! (-> self string-val-locked) #f)
  (init-cam-float-seeker (-> self tracking point-of-interest-blend) 0.0 0.005 0.02 0.125)
  (init-cam-float-seeker (-> self tracking underwater-blend) 0.0 0.007 0.03 0.125)
  (set! (-> self tracking use-point-of-interest) #f)
  (reset! (-> self position-spline) (-> self trans))
  (none))

(defun cam-slave-go ((next-state state))
  "Reinitialize the camera slave and immediately enter next-state."
  (with-pp
    (cam-slave-init-vars)
    (let ((enter-fn (the-as (function object) enter-state))) (set! (-> pp next-state) next-state) (enter-fn))
    0
    (none)))

(defbehavior cam-slave-init camera-slave ((initial-state state) (camera-entity entity))
  "Initialize a camera slave for initial-state and optional
   camera-entity, notify the camera master when needed, run the state's enter function, and make
   initial-state current."
  (stack-size-set! (-> self main-thread) 512)
  (change-to-last-brother self)
  (if (and (nonzero? camera-slave-debug) *debug-segment*) (add-connection *debug-engine* self camera-slave-debug self #f #f))
  (cam-slave-init-vars)
  (let ((voicebox-state 'cam-voicebox)
        (call-arg (the-as basic (-> initial-state name))))
    (cond
      ((= (the-as symbol call-arg) voicebox-state))
      (camera-entity (set! (-> self cam-entity) camera-entity))
      (else
       (let ((activation-event (new 'stack-no-clear 'event-message-block)))
         (set! (-> activation-event from) self)
         (set! (-> activation-event num-params) 1)
         (set! (-> activation-event message) 'slave-activated)
         (set! (-> activation-event param 0) (the-as uint self))
         (let ((send-event-fn send-event-function))
           (set! call-arg *camera*)
           (send-event-fn (the-as camera-master call-arg) activation-event)))))
    (let ((state-enter-fn (the-as (function object object) (-> initial-state enter))))
      (if state-enter-fn (state-enter-fn (the-as symbol call-arg))))
    (set! (-> self enter-has-run) #t)
    (set! (-> self event-hook) (-> initial-state event))
    (let ((enter-state-fn (the-as (function object object) enter-state)))
      (set! (-> self next-state) initial-state)
      (enter-state-fn (the-as symbol call-arg))))
  0
  (none))

(defbehavior cam-standard-event-handler camera-slave ((sender process) (event-id int) (event-type symbol) (message event-message-block))
  "Handle camera state changes, point-of-interest
   activation, and immediate rotation updates after a teleport."
  (case event-type
    (('go)
     (let ((next-state-value (-> message param 0))
           (enter-state-fn (the-as (function object) enter-state)))
       (set! (-> self next-state) (the-as state next-state-value))
       (enter-state-fn)))
    (('change-state 'change-state-no-go)
     (let ((next-state (the-as object (-> message param 0))))
       (cam-slave-init-vars)
       (let ((state-enter-fn (the-as (function object) (-> (the-as state next-state) enter))))
         (if state-enter-fn (state-enter-fn)))
       (set! (-> self enter-has-run) #t)
       (set! (-> self event-hook) (-> (the-as state next-state) event))
       (when (= event-type 'change-state)
         (let ((enter-state-fn (the-as (function object) enter-state)))
           (set! (-> self next-state) (the-as state next-state))
           (enter-state-fn)))))
    (('point-of-interest)
     (cond
       ((-> message param 0)
        (set! (-> self tracking use-point-of-interest) #t)
        (vector-copy! (-> self tracking point-of-interest) (the-as vector (-> message param 0)))
        (set! (-> self tracking point-of-interest-blend target) 1.0))
       (else (set! (-> self tracking use-point-of-interest) #f) (set! (-> self tracking point-of-interest-blend target) 0.0))))
    (('teleport)
     (cam-calc-follow! (-> self tracking) (-> self trans) #f)
     (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #f))))

(defbehavior cam-curve-pos camera-slave ((pos vector) (tangent vector) (path curve) (use-follow-point? symbol))
  "Add the active intro and camera-path offsets to pos. When tangent is
   supplied, estimate the intro direction into it. use-follow-point? selects the slave follow point
   instead of the camera master's adjusted target when indexing the path."
  (let ((curve-offset (new-stack-vector0)))
    0.0
    (let ((tangent-sample (new-stack-vector0)))
      (if tangent (set! (-> tangent w) 0.0))
      (when (< (-> self intro-t) 1.0)
        (+! (-> self intro-t) (* (-> self intro-t-step) (-> *display* time-adjust-ratio)))
        (if (< 1.0 (-> self intro-t)) (set! (-> self intro-t) 1.0))
        (curve-get-pos! curve-offset (parameter-ease-sin-clamp (-> self intro-t)) (-> self intro-curve))
        (vector+! curve-offset curve-offset (-> self intro-offset))
        (vector+! pos pos curve-offset)
        (cond
          ((not tangent))
          ((< (-> self intro-t) 0.5)
           (curve-get-pos! tangent-sample (+ 0.0001 (parameter-ease-sin-clamp (-> self intro-t))) (-> self intro-curve))
           (vector+! tangent-sample tangent-sample (-> self intro-offset))
           (vector-! tangent tangent-sample curve-offset)
           (set! (-> tangent w) 1.0))
          (else
           (curve-get-pos! tangent-sample (+ -0.0001 (parameter-ease-sin-clamp (-> self intro-t))) (-> self intro-curve))
           (vector+! tangent-sample tangent-sample (-> self intro-offset))
           (vector-! tangent curve-offset tangent-sample)
           (set! (-> tangent w) 1.0)))))
    (cond
      ((not (-> self spline-exists)))
      ((= (-> self spline-follow-dist) 0.0)
       (let ((spline-t (if use-follow-point?
                         (point->parameter (-> self index) (-> self tracking follow-pt))
                         (point->parameter (-> self index) (-> *camera* tpos-curr-adj)))))
         (curve-get-pos! curve-offset spline-t (-> self spline-curve)))
       (vector+! curve-offset curve-offset (-> self spline-offset))
       (vector+! pos pos curve-offset))
      (else
       (let ((reference-pos (new 'stack-no-clear 'vector)))
         (curve-length (-> self spline-curve))
         (if use-follow-point?
           (vector-copy! reference-pos (-> self tracking follow-pt))
           (vector-copy! reference-pos (-> *camera* tpos-curr-adj)))
         (set! (-> self spline-tt)
               (curve-closest-point (-> self spline-curve) reference-pos (-> self spline-tt) 1024.0 10 (-> self spline-follow-dist))))
       (curve-get-pos! curve-offset (-> self spline-tt) (-> self spline-curve))
       (vector+! curve-offset curve-offset (-> self spline-offset))
       (vector+! pos pos curve-offset))))
  pos)

(defbehavior cam-curve-setup camera-slave ((camera-pos vector))
  "Load the camera and intro curves from the slave's entity, prepare
   their endpoint offsets and camera index, and initialize intro timing."
  (when (get-curve-data! (-> self cam-entity) (-> self spline-curve) 'campath 'campath-k -1000000000.0)
    (curve-get-pos! (-> self spline-offset) 0.0 (-> self spline-curve))
    (vector-negate! (-> self spline-offset) (-> self spline-offset))
    (setup-from-entity! (-> self index) 'campoints (-> self cam-entity) camera-pos (-> self spline-curve))
    (set! (-> self spline-exists) #t))
  (cond
    ((get-curve-data! (-> self cam-entity) (-> self intro-curve) 'intro 'intro-k -1000000000.0)
     (curve-get-pos! (-> self intro-offset) 1.0 (-> self intro-curve))
     (vector-negate! (-> self intro-offset) (-> self intro-offset))
     (set! (-> self intro-t) 0.0)
     (set! (-> self intro-t-step) (cam-slave-get-intro-step (-> self cam-entity)))
     (set! (-> self outro-exit-value) (cam-slave-get-float (-> self cam-entity) 'intro-exitValue 0.0))
     (if (= (-> self outro-exit-value) 0.0) (set! (-> self outro-exit-value) 0.5)))
    (else (set! (-> self intro-t) 1.0) (set! (-> self intro-t-step) 0.0)))
  (if (nonzero? (-> *camera* no-intro)) (set! (-> self intro-t) 1.0))
  0
  (none))

(defun cam-calc-follow! ((tracker cam-rotation-tracker) (camera-pos vector) (smooth? symbol))
  "Update tracker's camera aim point from camera-pos. The ordinary
   path leads in the target's facing direction according to view angle and camera distance, then
   optionally smooths that offset. The long-look mode uses a larger speed- and heading-dependent
   lead with a quartic transition."
  ;; The long-look option aims as much as eight meters ahead along the target's
  ;; facing direction. Speed sets the base lead, and the angle between target
  ;; facing and the camera-to-target line reduces it through turns. follow-blend
  ;; eases this offset in with a fourth-power ramp over roughly 60 frames.
  ;;
  ;; The ordinary path leads by 0.5 to 2 meters. It gives full lead while the
  ;; target faces away from the camera and smoothly removes the lead as the
  ;; target turns toward it. The distance ramp begins at five meters and
  ;; reaches full strength at sixteen meters from the target.
  (cond
    (smooth?
     (update! (-> tracker tilt-adjust) 0.0)
     (update! (-> tracker point-of-interest-blend) 0.0)
     (update! (-> tracker underwater-blend) 0.0))
    (else
     (jump-to-target! (-> tracker tilt-adjust) 0.0)
     (jump-to-target! (-> tracker point-of-interest-blend) 0.0)
     (jump-to-target! (-> tracker underwater-blend) 0.0)))
  (cond
    ((send-event *camera* 'slave-option? #x4000)
     (let ((target-facing-flat (new 'stack-no-clear 'vector))
           (target-from-camera-flat (new 'stack-no-clear 'vector))
           (target-speed (vector-vector-distance (-> *camera* tpos-curr-adj) (-> *camera* tpos-old-adj)))
           (desired-offset (new 'stack-no-clear 'vector)))
       (vector-flatten! target-facing-flat (-> *camera* tgt-face-mat vector 2) (-> *camera* local-down))
       (vector-normalize! target-facing-flat 1.0)
       (vector-! target-from-camera-flat (-> *camera* tpos-curr-adj) camera-pos)
       (vector-flatten! target-from-camera-flat target-from-camera-flat (-> *camera* local-down))
       (vector-normalize! target-from-camera-flat 1.0)
       (vector-float*! desired-offset (-> *camera* tgt-face-mat vector 2) 32768.0)
       (let* ((lead-scale (lerp-clamp 0.7 0.4 (parameter-ease-sin-clamp (* 0.00081380206 (+ -409.6 target-speed)))))
              (view-facing-angle (acos (vector-dot target-from-camera-flat target-facing-flat)))
              (clamped-angle (fmax 1820.4445 view-facing-angle)))
         (if (< clamped-angle 8192.0)
           (vector-float*! desired-offset
                           desired-offset
                           (+ lead-scale
                              (* (/ (- 1.0 lead-scale) (- 1.0 (cos 32768.0))) (+ (- (cos 32768.0)) (cos (* 5.142857 (- 8192.0 clamped-angle)))))))))
       (cond
         ((< (-> *camera* ease-t) 1.0))
         ((< (-> tracker follow-blend) 1.0)
          (let ((blend-factor (square (square (-> tracker follow-blend)))))
            (vector-! desired-offset desired-offset (-> tracker follow-off))
            (vector-float*! desired-offset desired-offset blend-factor))
          (+! (-> tracker follow-blend) (/ (-> *display* time-adjust-ratio) 60))
          (vector+! (-> tracker follow-off) (-> tracker follow-off) desired-offset))
         (else (vector-copy! (-> tracker follow-off) desired-offset))))
     (vector+! (-> tracker follow-pt) (-> *camera* tpos-curr-adj) (-> tracker follow-off))
     (vector--float*! (-> tracker follow-pt)
                      (-> tracker follow-pt)
                      (-> *camera* local-down)
                      (+ 12288.0 (-> *camera* target-height))))
    (else
     0.0
     (let ((normal-offset (new-stack-vector0)))
       (set! (-> tracker follow-blend) 0.0)
       (cond
         ((-> tracker no-follow) (vector-reset! normal-offset))
         (else
          (vector-! normal-offset (-> *camera* tpos-curr-adj) camera-pos)
          (vector-normalize! normal-offset 1.0)
          (let* ((facing-dot (vector-dot (-> *camera* tgt-rot-mat vector 2) normal-offset))
                 (behind-weight (cond
                                  ((< facing-dot 0.0) 1.0)
                                  (else
                                   (let* ((facing-dot-squared (square facing-dot))
                                          (side-weight (- 1.0 facing-dot-squared)))
                                     (* side-weight (square side-weight)))))))
            (vector-! normal-offset camera-pos (-> *camera* tpos-curr-adj))
            (vector-flatten! normal-offset normal-offset (-> *camera* local-down))
            (let* ((distance-factor (* 0.000022194603 (+ -20480.0 (vector-length normal-offset))))
                   (distance-upper (fmin 1.0 distance-factor))
                   (distance-weight (fmax 0.0 distance-upper)))
              (vector-float*! normal-offset (-> *camera* tgt-rot-mat vector 2) (* (lerp 2048.0 8192.0 distance-weight) behind-weight))))))
       (if smooth?
         (vector-seek-3d-smooth! (-> tracker follow-off) normal-offset (* 20480.0 (seconds-per-frame)) 0.05)
         (set! (-> tracker follow-off quad) (-> normal-offset quad))))
     (vector+! (-> tracker follow-pt) (-> *camera* tpos-curr-adj) (-> tracker follow-off))
     (vector--float*! (-> tracker follow-pt) (-> tracker follow-pt) (-> *camera* local-down) (-> *camera* target-height))))
  (-> tracker follow-pt))

(defun mat-remove-z-rot ((camera-matrix matrix) (local-down vector))
  "Remove roll from camera-matrix by aligning its up axis with the
   direction opposite local-down while preserving its forward axis."
  (let ((desired-up (new-stack-vector0)))
    0.0
    0.0
    (let ((roll-correction (new-stack-matrix0)))
      (vector-negate! desired-up local-down)
      (vector-flatten! desired-up desired-up (-> camera-matrix vector 2))
      (vector-normalize! desired-up 1.0)
      (let ((up-dot (vector-dot (-> camera-matrix vector 1) desired-up)))
        (when (< up-dot 0.99999)
          (vector-cross! desired-up (-> camera-matrix vector 1) desired-up)
          (let ((signed-sine (vector-length desired-up)))
            (if (< 0.0 (vector-dot desired-up (-> camera-matrix vector 2))) (set! signed-sine (- signed-sine)))
            (matrix-axis-sin-cos! roll-correction (-> camera-matrix vector 2) signed-sine up-dot))
          (matrix*! camera-matrix camera-matrix roll-correction)))))
  camera-matrix)

;; Orientation follows distance as well as time. Below 0.25 meter there is no
;; distance contribution; it reaches full strength at 0.75 meter. The relative
;; quaternion is shortened to the permitted angular step before it is composed
;; with the current orientation, avoiding jitter nearby without making large
;; camera moves turn sluggishly.
(defun slave-matrix-blend-2 ((current-matrix matrix) (options-bits float) (aim-vector vector) (target-matrix matrix))
  "Rotate current-matrix toward target-matrix by a frame-rate-
   adjusted quaternion step. The step grows with aim-vector distance; options-bits bit 2 selects
   full three-dimensional rather than local-down-flattened distance."
  (let ((distance-work (new-stack-vector0))
        (current-rotation (new-stack-quaternion0)))
    (let ((target-rotation (new-stack-quaternion0))
          (delta-rotation (new-stack-quaternion0)))
      0.0
      (let* ((aim-distance (cond
                             ((logtest? (the-as int options-bits) 4) (vector-length aim-vector))
                             (else (vector-flatten! distance-work aim-vector (-> *camera* local-down)) (vector-length distance-work))))
             (distance-weight (* 0.00048828125 (+ -1024.0 aim-distance))))
        (cond
          ((< distance-weight 0.0) (set! distance-weight 0.0))
          ((< 1.0 distance-weight) (set! distance-weight 1.0)))
        (let ((turn-step (* 364.0889 (-> *display* time-adjust-ratio) distance-weight)))
          (matrix->quaternion current-rotation current-matrix)
          (matrix->quaternion target-rotation target-matrix)
          (quaternion-conjugate! delta-rotation current-rotation)
          (quaternion*! delta-rotation delta-rotation target-rotation)
          (quaternion-normalize! delta-rotation)
          (if (< (-> delta-rotation w) 0.0) (quaternion-negate! delta-rotation delta-rotation))
          (let ((turn-angle (acos (-> delta-rotation w))))
            (if (< (* (/ (-> *display* time-adjust-ratio) 4) turn-angle) turn-step)
              (set! turn-step (* (/ (-> *display* time-adjust-ratio) 4) turn-angle)))
            (cond
              ((< (-> delta-rotation w) 0.9999999)
               (quaternion-float*! delta-rotation delta-rotation (/ (sin turn-step) (sin turn-angle)))
               (set! (-> delta-rotation w) (cos turn-step)))
              (else (quaternion-identity! delta-rotation))))))
      (quaternion*! current-rotation current-rotation delta-rotation))
    (quaternion-normalize! current-rotation)
    (quaternion->matrix current-matrix current-rotation)))

(defun vector-into-frustum-nosmooth! ((camera-matrix matrix) (camera-pos vector) (fov float))
  "Rotate camera-matrix just enough to keep the target's
   horizontal position, feet, and head inside the camera safe frame at fov. This applies
   the immediate framing correction; later matrix blending supplies temporal smoothing."
  ;; The safe frame uses 0.8 * tan(fov / 2) horizontally and
  ;; 0.525 * tan(fov / 2) vertically. First correct the horizontal target
  ;; center, then test the target's foot and head heights. The vertical tests
  ;; include pitch-off before applying their respective height offsets.
  ;; Corrections rotate exactly to the violated edge; slave-matrix-blend-2
  ;; smooths the resulting orientation afterward.
  (rlet ((vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf))
    (init-vf0-vector)
    (let ((correction-matrix (new-stack-matrix0)))
      (let ((target-dir (new-stack-vector0))
            (frustum-edge (new-stack-vector0)))
        0.0
        0.0
        (let ((vertical-dot-limit 1.0)
              (rotate-up? #t))
          (vector-! target-dir (-> *camera* tpos-curr) camera-pos)
          (vector-flatten! target-dir target-dir (-> camera-matrix vector 1))
          (vector-normalize! target-dir 1.0)
          (let ((horizontal-target-dot (vector-dot target-dir (-> camera-matrix vector 0))))
            (let ((horizontal-edge frustum-edge))
              (let ((right-axis-base (-> camera-matrix vector))
                    (horizontal-scale (* 0.8 (tan (/ fov 2)))))
                (.lvf vf1 (&-> right-axis-base 0 quad))
                (let ((horizontal-scale-bits horizontal-scale)) (.mov vf2 horizontal-scale-bits)))
              (.add.x.vf.w vf1 vf0 vf0)
              (.mul.x.vf.xyz vf1 vf1 vf2)
              (.svf (&-> horizontal-edge quad) vf1))
            (vector+! frustum-edge frustum-edge (-> camera-matrix vector 2))
            (vector-normalize! frustum-edge 1.0)
            (let ((horizontal-edge-dot (vector-dot frustum-edge (-> camera-matrix vector 0))))
              (when (< horizontal-edge-dot (fabs horizontal-target-dot))
                (if (< horizontal-target-dot 0.0)
                  (vector--float*! frustum-edge frustum-edge (-> camera-matrix vector 0) (* 2.0 horizontal-edge-dot)))
                (matrix-from-two-vectors! correction-matrix frustum-edge target-dir)
                (vector-matrix*! (-> camera-matrix vector 2) (-> camera-matrix vector 2) correction-matrix)
                (vector-cross! (-> camera-matrix vector 0) (-> camera-matrix vector 1) (-> camera-matrix vector 2)))))
          (vector-! target-dir (-> *camera* tpos-curr) (-> *camera* pitch-off))
          (vector-! target-dir target-dir camera-pos)
          (vector--float*! target-dir target-dir (-> *camera* local-down) (-> *camera* foot-offset))
          (vector-flatten! target-dir target-dir (-> camera-matrix vector 0))
          (vector-normalize! target-dir 1.0)
          (let ((foot-dot (vector-dot target-dir (-> camera-matrix vector 1))))
            (let ((vertical-edge frustum-edge))
              (let ((up-axis (-> camera-matrix vector 1))
                    (vertical-scale (* 0.525 (tan (/ fov 2)))))
                (.lvf vf1 (&-> up-axis quad))
                (let ((vertical-scale-bits vertical-scale)) (.mov vf2 vertical-scale-bits)))
              (.add.x.vf.w vf1 vf0 vf0)
              (.mul.x.vf.xyz vf1 vf1 vf2)
              (.svf (&-> vertical-edge quad) vf1))
            (vector+! frustum-edge frustum-edge (-> camera-matrix vector 2))
            (vector-normalize! frustum-edge 1.0)
            (let ((foot-edge-dot (vector-dot frustum-edge (-> camera-matrix vector 1))))
              (when (and (< foot-dot 0.0) (< foot-edge-dot (- foot-dot)))
                (vector--float*! frustum-edge frustum-edge (-> camera-matrix vector 1) (* 2.0 foot-edge-dot))
                (set! vertical-dot-limit (vector-dot frustum-edge target-dir)))))
          (vector-! target-dir (-> *camera* tpos-curr) (-> *camera* pitch-off))
          (vector-! target-dir target-dir camera-pos)
          (vector--float*! target-dir target-dir (-> *camera* local-down) (-> *camera* head-offset))
          (vector-flatten! target-dir target-dir (-> camera-matrix vector 0))
          (vector-normalize! target-dir 1.0)
          (let ((head-dot (vector-dot target-dir (-> camera-matrix vector 1))))
            (vector-float*! frustum-edge (-> camera-matrix vector 1) (* 0.525 (tan (/ fov 2))))
            (vector+! frustum-edge frustum-edge (-> camera-matrix vector 2))
            (vector-normalize! frustum-edge 1.0)
            (let ((head-edge-dot (vector-dot frustum-edge (-> camera-matrix vector 1))))
              (cond
                ((and (< 0.0 head-dot) (< head-edge-dot head-dot))
                 (set! vertical-dot-limit (vector-dot frustum-edge target-dir))
                 (set! rotate-up? #f))
                ((< vertical-dot-limit 0.0)
                 (let ((opposite-head-dot (- (vector-dot frustum-edge target-dir))))
                   (if (< opposite-head-dot vertical-dot-limit) (set! vertical-dot-limit opposite-head-dot)))))))
          (let ((correction-angle (if rotate-up? (- (acos vertical-dot-limit)) (acos vertical-dot-limit))))
            (matrix-axis-angle! correction-matrix (-> camera-matrix vector 0) correction-angle))))
      (vector-matrix*! (-> camera-matrix vector 2) (-> camera-matrix vector 2) correction-matrix))
    (vector-cross! (-> camera-matrix vector 1) (-> camera-matrix vector 2) (-> camera-matrix vector 0))))

(defun slave-set-rotation! ((tracker cam-rotation-tracker) (camera-pos vector) (options-bits float) (fov float) (smooth? symbol))
  "Build tracker's inverse camera rotation from its follow point,
   optional point of interest and tilt; keep the target in frame, optionally blend toward the new
   orientation, and remove roll. options-bits is a raw cam-slave-options word carried in a float."
  ;; Start from the follow point and blend toward a point of interest without
  ;; changing the aim-vector length. The tilt guard leaves 15 degrees of room
  ;; before either vertical pole so the pitch adjustment cannot flip the view.
  ;; Underwater framing narrows the effective field of view as far as one
  ;; quarter, then the safe-frame correction, optional orientation blend, and
  ;; final roll removal produce the inverse camera rotation.
  (local-vars (forward-down-dot float) (tilt-matrix matrix))
  (rlet ((vf0 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         (vf6 :class vf))
    (init-vf0-vector)
    (let ((aim-vector (new-stack-vector0))
          (target-matrix (new-stack-matrix0)))
      (let ((tilt-angle (-> tracker tilt-adjust value)))
        (cond
          ((< 0.0001 (-> tracker point-of-interest-blend value))
           (let ((point-of-interest-vector (new 'stack-no-clear 'vector)))
             0.0
             (vector-! aim-vector (-> tracker follow-pt) camera-pos)
             (let ((aim-distance (vector-length aim-vector)))
               (vector-! point-of-interest-vector (-> tracker point-of-interest) camera-pos)
               (vector-normalize! point-of-interest-vector (* aim-distance (-> tracker point-of-interest-blend value)))
               (let ((blended-aim-out aim-vector))
                 (let ((base-aim aim-vector)) (.mov.vf.w vf6 vf0) (.lvf vf4 (&-> base-aim quad)))
                 (.lvf vf5 (&-> point-of-interest-vector quad))
                 (.add.vf.xyz vf6 vf4 vf5)
                 (.svf (&-> blended-aim-out quad) vf6))
               (vector-normalize! aim-vector aim-distance))))
          (else (vector-! aim-vector (-> tracker follow-pt) camera-pos)))
        (forward-down->inv-matrix target-matrix aim-vector (-> *camera* local-down))
        (when (!= tilt-angle 0.0)
          0.0
          0.0
          (set! tilt-matrix (new 'stack-no-clear 'matrix))
          (let ((aim-direction (new 'stack-no-clear 'vector)))
            (vector-normalize-copy! aim-direction aim-vector 1.0)
            (let* ((down-axis (-> *camera* local-down))) (set! forward-down-dot (vector-dot aim-direction down-axis))))
          (let* ((down-dot forward-down-dot)
                 (vertical-angle (acos (fabs down-dot))))
            (cond
              ((< 0.0 tilt-angle)
               (set! tilt-angle
                     (if (< 0.0 down-dot)
                       (fmin tilt-angle (fmax 0.0 (+ -2730.6667 vertical-angle)))
                       (fmin tilt-angle (fmax 0.0 (- 32768.0 (+ 2730.6667 vertical-angle)))))))
              ((< tilt-angle 0.0)
               (set! tilt-angle
                     (if (< 0.0 down-dot)
                       (fmax tilt-angle (- (fmax 0.0 (- 32768.0 (+ 2730.6667 vertical-angle)))))
                       (fmax tilt-angle (- (fmax 0.0 (+ -2730.6667 vertical-angle)))))))))
          (matrix-rotate-x! tilt-matrix tilt-angle)
          (matrix*! target-matrix tilt-matrix target-matrix)))
      (if (and (= (-> *camera* under-water) 2) *target* (!= (-> *target* next-state name) 'target-swim-up))
        (set! (-> tracker underwater-blend target) 1.0)
        (set! (-> tracker underwater-blend target) 0.0))
      (vector-into-frustum-nosmooth! target-matrix camera-pos (lerp-clamp fov (/ fov 4) (-> tracker underwater-blend value)))
      (cond
        (smooth? (slave-matrix-blend-2 (-> tracker inv-mat) options-bits aim-vector target-matrix))
        (else
         (matrix-copy! (-> tracker inv-mat) target-matrix))))
    (mat-remove-z-rot (-> tracker inv-mat) (-> *camera* local-down))
    0
    (none)))

(defun v-slrp2! ((out vector) (from-vector vector) (to-vector vector) (t float) (plane-normal vector) (max-angle float))
  "Spherically interpolate from-vector toward to-vector by t while
   interpolating their lengths separately and limiting the angular step to max-angle. When
   plane-normal is supplied, rotate within that plane and interpolate the normal component
   separately."
  ;; Direction and magnitude are handled separately so the vector follows an
  ;; angular arc without the length collapse of a linear vector blend. With a
  ;; plane normal, only the in-plane direction rotates; the component on the
  ;; normal is restored and interpolated independently.
  (local-vars
    (direction-dot float)
    (to-length float)
    (from-length float)
    (angle-limit float)
    (to-direction vector)
    (rotation-matrix matrix))
  (set! angle-limit max-angle)
  (let ((from-direction (new-stack-vector0)))
    (set! to-direction (new 'stack-no-clear 'vector))
    (set! (-> to-direction quad) (the-as uint128 0))
    1.0
    1.0
    (let ((rotation-axis (new-stack-vector0)))
      0.0
      1.0
      (set! rotation-matrix (new 'stack-no-clear 'matrix))
      (set! (-> rotation-matrix vector 0 quad) (the-as uint128 0))
      (set! (-> rotation-matrix vector 1 quad) (the-as uint128 0))
      (set! (-> rotation-matrix vector 2 quad) (the-as uint128 0))
      (set! (-> rotation-matrix vector 3 quad) (the-as uint128 0))
      (cond
        ((< 1.0 t) (set! t 1.0))
        ((< t 0.0) (set! t 0.0)))
      (cond
        (plane-normal
         (vector-flatten! from-direction from-vector plane-normal)
         (vector-flatten! to-direction to-vector plane-normal)
         (set! from-length (vector-normalize-ret-len! from-direction 1.0))
         (set! to-length (vector-normalize-ret-len! to-direction 1.0))
         (vector-normalize! (vector-cross! rotation-axis to-direction from-direction) 1.0)
         (let ((axis-side (vector-dot plane-normal rotation-axis)))
           (vector-normalize-copy! rotation-axis plane-normal 1.0)
           (if (< axis-side 0.0) (vector-negate! rotation-axis rotation-axis))))
        (else
         (set! (-> from-direction quad) (-> from-vector quad))
         (vector-copy! to-direction to-vector)
         (set! from-length (vector-normalize-ret-len! from-direction 1.0))
         (set! to-length (vector-normalize-ret-len! to-direction 1.0))
         (vector-normalize! (vector-cross! rotation-axis to-vector from-vector) 1.0)))
      (let ((acos-fn acos))
        (let* ((from-direction-copy from-direction)) (set! direction-dot (vector-dot from-direction-copy to-direction)))
        (let* ((angle (acos-fn direction-dot))
               (step-angle (* t angle)))
          (when (< angle-limit step-angle)
            (set! step-angle angle-limit)
            (set! t (/ angle-limit angle)))
          (let ((cos-angle (cos step-angle)))
            (matrix-axis-sin-cos! rotation-matrix rotation-axis (sqrtf (- 1.0 (square cos-angle))) cos-angle))))
      (vector-matrix*! out from-direction rotation-matrix)
      (vector-normalize! out (lerp from-length to-length t))
      (when plane-normal
        (vector+float*! out out rotation-axis (vector-dot from-vector rotation-axis))
        (vector+float*! out
                        out
                        rotation-axis
                        (* t (vector-dot (vector-! (new-stack-vector0) to-vector from-vector) rotation-axis))))))
  out)

(defun v-slrp3! ((out vector) (from-vector vector) (to-vector vector) (plane-normal vector) (max-angle float))
  "Spherically interpolate from-vector toward to-vector by no more than
   max-angle, using the required angular fraction and interpolating length separately. An optional
   plane-normal constrains the rotation plane."
  (local-vars (direction-dot float) (to-length float) (from-length float) (angle-limit float) (to-direction vector))
  (set! angle-limit max-angle)
  (let ((from-direction (new-stack-vector0)))
    (set! to-direction (new 'stack-no-clear 'vector))
    (set! (-> to-direction quad) (the-as uint128 0))
    0.0
    0.0
    (let ((rotation-axis (new-stack-vector0))
          (fraction 1.0))
      0.0
      (let ((rotation-matrix (new-stack-matrix0)))
        (cond
          (plane-normal
           (vector-flatten! from-direction from-vector plane-normal)
           (vector-flatten! to-direction to-vector plane-normal)
           (set! from-length (vector-normalize-ret-len! from-direction 1.0))
           (set! to-length (vector-normalize-ret-len! to-direction 1.0))
           (vector-normalize! (vector-cross! rotation-axis to-direction from-direction) 1.0)
           (let ((axis-side (vector-dot plane-normal rotation-axis)))
             (vector-normalize-copy! rotation-axis plane-normal 1.0)
             (if (< axis-side 0.0) (vector-negate! rotation-axis rotation-axis))))
          (else
           (set! (-> from-direction quad) (-> from-vector quad))
           (vector-copy! to-direction to-vector)
           (set! from-length (vector-normalize-ret-len! from-direction 1.0))
           (set! to-length (vector-normalize-ret-len! to-direction 1.0))
           (vector-normalize! (vector-cross! rotation-axis to-vector from-vector) 1.0)))
        (let ((acos-fn acos))
          (let* ((from-direction-copy from-direction)) (set! direction-dot (vector-dot from-direction-copy to-direction)))
          (let ((angle (acos-fn direction-dot)))
            (when (< angle-limit angle)
              (set! fraction (/ angle-limit angle))
              (set! angle angle-limit))
            (let ((cos-angle (cos angle)))
              (matrix-axis-sin-cos! rotation-matrix rotation-axis (sqrtf (- 1.0 (square cos-angle))) cos-angle))))
        (vector-matrix*! out from-direction rotation-matrix))
      (vector-normalize! out (lerp from-length to-length fraction))
      (when plane-normal
        (vector+float*! out out rotation-axis (vector-dot from-vector rotation-axis))
        (vector+float*! out
                        out
                        rotation-axis
                        (* fraction (vector-dot (vector-! (new-stack-vector0) to-vector from-vector) rotation-axis))))))
  out)