jak-project/goal_src/jak1/engine/entity/res.gc

;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/geometry/geometry-h.gc")
(require "engine/entity/res-h.gc")
(require "engine/gfx/texture/texture.gc")

#|
Res is a compact property system used primarily by game entities. A res-lump owns
a fixed-capacity table of res-tags followed by a packed data area. Each tag gives
the property's name, element type and count, data offset, and optional key-frame
time. Inline tags store raw scalar or vector elements in the lump; reference tags
store pointers to structures and other objects. A lump can therefore hold unlike
properties, such as a moving platform's vector path and its integer entity ID.

Tags are sorted by name and then key frame. The lookup methods can select the base
sample, require an exact time, or return the two samples bracketing a time for
interpolation. For example, several values of a camera property can be stored at
different key frames and blended as the camera moves between them. A key frame of
-1000000000.0 is the untimed base sample. It remains the fallback before the first
timed sample and is never blended into that sample. The get-property methods
provide the general lookup interface, while get-curve-data! fills a curve from
named control-point and knot properties.

This system grew out of the Crash 2 entity resource system.
|#

(defmacro res-ref? (tag)
  "Return true when tag stores references rather than inline element data."
  `(zero? (-> ,tag inlined?)))

;; DECOMP BEGINS

(defmethod print ((this res-tag))
  (if (res-ref? this)
    (format #t
            "#<res-tag :name ~A :key-frame ~f :elt-type ~A :elt-count ~D>"
            (-> this name)
            (-> this key-frame)
            (-> this elt-type)
            (-> this elt-count))
    (format #t
            "#<res-tag (i) :name ~A :key-frame ~f :elt-type ~A :elt-count ~D>"
            (-> this name)
            (-> this key-frame)
            (-> this elt-type)
            (-> this elt-count)))
  this)

(defmethod length ((this res-tag))
  "Return the property's storage size in bytes: four bytes per reference or the element size for inline data."
  (the int
       (if (res-ref? this)
         (* (-> this elt-count) 4) ;; elements are pointers/references to data.
         (* (-> this elt-count) (-> this elt-type size)))))

(defmethod get-tag-index-data ((this res-lump) (i int))
  "Return the data address for tag index i."
  (declare (inline))
  (&+ (-> this data-base) (-> this tag i data-offset)))

(defmethod get-tag-data ((this res-lump) (tag res-tag))
  "Return the data address described by tag."
  (declare (inline))
  (&+ (-> this data-base) (-> tag data-offset)))

(defmethod new res-lump ((allocation symbol) (type-to-make type) (data-count int) (data-size int))
  "Allocate a res lump with room for data-count tags and data-size bytes of property data."
  (let ((this (object-new allocation
                          type-to-make
                          (the int (+ (-> type-to-make size) (* (1- data-count) (size-of res-tag)) data-size)))))
    (set! (-> this allocated-length) data-count)
    (set! (-> this data-size) data-size)
    (set! (-> this length) 0)
    (set! (-> this data-base) (&-> this tag data-count))
    (set! (-> this data-top) (&-> this tag data-count))
    this))

(defmethod length ((this res-lump))
  "Return the number of occupied property tags."
  (-> this length))

(defmethod asize-of ((this res-lump))
  "Return the lump's allocated size, including its tag table and packed data area."
  (the int
       (+ (-> this type psize) ;; psize is used here, but size is used in the allocation?
          (* (-> this allocated-length) (size-of res-tag))
          (-> this data-size))))

(defmethod inspect ((this res-lump))
  (format #t "[~8x] ~A~%" this (-> this type))
  (format #t "~Textra: ~A~%" (-> this extra))
  (format #t "~Tallocated-length: ~D~%" (-> this allocated-length))
  (format #t "~Tlength: ~D~%" (-> this length))
  (format #t "~Tdata-base: #x~X~%" (-> this data-base))
  (format #t "~Tdata-top: #x~X~%" (-> this data-top))
  (format #t "~Tdata-size: #x~X~%" (-> this data-size))
  (format #t "~Ttag[~D]: @ #x~X~%" (-> this allocated-length) (-> this tag))
  (dotimes (i (-> this length))
    (format #t "~T  [~D] " i)
    (print (-> (-> this tag) i))
    (format #t " @ #x~X" (get-tag-index-data this i))
    (cond
      ((res-ref? (-> this tag i)) (format #t " = ~A~%" (deref basic (get-tag-index-data this i))))
      (else (format #t "~%"))))
  this)

(defmethod lookup-tag-idx ((this res-lump) (name-sym symbol) (mode symbol) (time float))
  "Find the tag indices for property name-sym at time and return them packed as a
   res-tag-pair.
   In base mode, ignore time and repeat the earliest sample index in both halves. In exact
   mode, require an exact key-frame match and repeat that index. In interp mode, repeat an
   exact match or return the nearest lower and upper samples that bracket time.
   The untimed -1000000000.0 sample is a fallback before the first timed sample, not an
   interpolation endpoint. Return a negative packed result when the property or requested
   sample is missing."
  (local-vars (tag-idx int))
  ;; These values are stored in the entity type directly. They might have been part of
  ;; the lump properties in an earlier version.
  (when (or (= name-sym 'id)
            (= name-sym 'aid)
            (= name-sym 'trans)
            (= name-sym 'rot)
            (= name-sym 'nav-mesh)
            (= name-sym 'process-type)
            (= name-sym 'task))
    (crash!))
  ;; check that we are valid.
  (if (or (not this) (zero? this) (<= (-> this length) 0)) (return (the res-tag-pair -1)))
  ;; these are the outputs of the function.
  (let ((hi-tag-idx-out -1)
        (lo-tag-idx-out -1))
    ;; track invalid timestamp point so we avoid using it in interpolation
    (let ((most-recent-invalid-time-idx -1)
          ;; read 8 chars of the name we want
          (type-chars (-> (the-as (pointer uint64) (-> (symbol->string name-sym) data)) 0)))
      ;; now we will do a binary search.  The names are stored in ascending order if you
      ;; treat the first 8 chars as an integer
      ;; min/max are inclusive.
      (let ((max-search (+ (-> this length) -1))
            (min-search 0))
        (while (>= max-search min-search)
          ;; check in the middle of the range to bisect it.
          (let* ((check-idx (+ min-search (/ (- max-search min-search) 2)))
                 ;; subtract the two words.  The sign of this tells us if we are too high or too low
                 (diff (- type-chars (-> (the-as (pointer uint64) (-> (symbol->string (-> (-> this tag) check-idx name)) data)) 0))))
            (cond
              ((zero? diff)
               ;; perfect match! we are done, set the tag-idx and get out of here.
               (set! tag-idx check-idx)
               (goto cfg-32))
              (else
               ;; didn't match. pick the appropriate half of the remaining tags
               (if (< (the-as int diff) 0) (set! max-search (+ check-idx -1)) (set! min-search (+ check-idx 1))))))))
      ;; got to the end of the loop without finding the answer. Set a negative tag
      (set! tag-idx -1)
      (label cfg-32)
      ;; return error if the binary search failed.
      (if (< tag-idx 0) (return (the res-tag-pair tag-idx)))
      ;; if there are multiple tags with the same name and different timesteps, we can't be sure which we ended on.
      ;; this loop brings us to the first tag with the correct name.
      (while (and (> tag-idx 0)
                  (= type-chars (-> (the-as (pointer uint64) (-> (symbol->string (-> (-> this tag) (+ tag-idx -1) name)) data)) 0)))
        (+! tag-idx -1))
      ;; Base mode returns the first sample, ignoring the requested time.
      (if (= mode 'base)
        (begin
          ;; both lo and hi are the same
          (set! lo-tag-idx-out tag-idx)
          (set! hi-tag-idx-out tag-idx)
          (goto cfg-73)))
      ;; Walk every tag sharing the first eight name bytes. Keep an address into
      ;; the packed tag table so the full symbol and key frame can be checked.
      (let ((interp-tag-idx tag-idx)
            (tag-ptr (&-> (-> this tag) tag-idx)))
        ;; loop, until we reach another name or the end of the table
        (while (not (or (>= interp-tag-idx (-> this length))
                        ;; < is correct here because we are incrementing and names get larger
                        (< type-chars (-> (the-as (pointer uint64) (-> (symbol->string (-> tag-ptr 0 name)) data)) 0))))
          (cond
            ;; The checks above only made sure that the first 8 chars were correct.
            ;; This skips items with matching first 8 chars, but differences after that.
            ((!= name-sym (-> tag-ptr 0 name)))
            ;; check for exact match
            ((= (-> tag-ptr 0 key-frame) time)
             ;; in all cases, just return the exact match.
             (begin
               (set! lo-tag-idx-out interp-tag-idx)
               (set! hi-tag-idx-out interp-tag-idx)
               (goto cfg-73)))
            ;; check for being not far enough
            ((and (>= time (-> tag-ptr 0 key-frame)) (!= mode 'exact))
             ;; in all cases, except for exact, we'll want to remember this.
             ;; just in case there are no more tags
             (set! lo-tag-idx-out interp-tag-idx)
             (set! hi-tag-idx-out interp-tag-idx)
             ;; also remember if we hit an invalid one
             (if (= (-> tag-ptr 0 key-frame) -1000000000.0) (set! most-recent-invalid-time-idx interp-tag-idx)))
            ;; check for being too far (passed the time)
            ((< time (-> tag-ptr 0 key-frame))
             (begin
               ;; The untimed base sample is a fallback, not an interpolation
               ;; endpoint. Hold it until the first timed sample is reached.
               (if (and (!= lo-tag-idx-out most-recent-invalid-time-idx) (= mode 'interp)) (set! hi-tag-idx-out interp-tag-idx))
               (goto cfg-73))))
          ;; advance to next tag
          (+! interp-tag-idx 1)
          (set! tag-ptr (&-> tag-ptr 1)))))
    (label cfg-73)
    ;; end: return the tags.
    (the-as res-tag-pair (logior (logand #xffffffff (the-as uint lo-tag-idx-out)) (the-as uint (shl hi-tag-idx-out 32))))))

(defmacro make-res-int-data (interp elt-count buf src-lo src-hi ty)
  "Interpolate an integer array with 12-bit fixed-point weights."
  `(let ((fixed-pt (the int (* 4096.0 ,interp))))
    (dotimes (i ,elt-count)
      (set! (deref ,ty ,buf i) (ash (+ (* (deref ,ty ,src-lo i) (- 4096 fixed-pt)) (* (deref ,ty ,src-hi i) fixed-pt)) -12)))
    buf))

(defmethod make-property-data ((this res-lump) (time float) (tag-pair res-tag-pair) (buf pointer))
  "Return the property data selected by tag-pair at time.
   This handles interpolation of the data."
  (let* ((tag-lo (-> this tag (-> tag-pair lo)))
         (tag-hi (-> this tag (-> tag-pair hi)))
         (elt-count (-> tag-lo elt-count)))
    (cond
      ;; references just return the referenced data directly
      ((res-ref? tag-lo) (get-tag-data this tag-lo))
      ((or (not buf) ;; no storage provided
           (= (-> tag-pair lo) (-> tag-pair hi)) ;; no interp needed
           (!= elt-count (-> tag-hi elt-count))  ;; different length samples: interpolation impossible
           (!= (-> tag-lo elt-type) (-> tag-hi elt-type))) ;; differing types
       (get-tag-data this tag-lo))
      (else
       ;; Interpolation is needed here.
       (let ((interp (/ (- time (-> tag-lo key-frame)) (- (-> tag-hi key-frame) (-> tag-lo key-frame))))
             (src-lo (get-tag-data this tag-lo))
             (src-hi (get-tag-data this tag-hi)))
         (case (-> tag-lo elt-type symbol)
           (('float)
            (dotimes (i elt-count)
              (set! (deref float buf i) (+ (* (deref float src-lo i) (- 1.0 interp)) (* (deref float src-hi i) interp))))
            buf)
           ;; integer interpolation uses 12-bit fractional fixed point
           (('integer 'sinteger 'uinteger 'int64 'uint64) (make-res-int-data interp elt-count buf src-lo src-hi uint64))
           (('int8) (make-res-int-data interp elt-count buf src-lo src-hi int8))
           (('uint8) (make-res-int-data interp elt-count buf src-lo src-hi uint8))
           (('int16) (make-res-int-data interp elt-count buf src-lo src-hi int16))
           (('uint16) (make-res-int-data interp elt-count buf src-lo src-hi uint16))
           (('int32) (make-res-int-data interp elt-count buf src-lo src-hi int32))
           (('uint32) (make-res-int-data interp elt-count buf src-lo src-hi uint32))
           (('vector)
            (rlet ((vf1 :class vf)
                   (vf2 :class vf)
                   (vf3 :class vf)
                   (vf4 :class vf))
              (.mov vf3 interp)
              (.mov vf4 (- 1.0 interp))
              (dotimes (i elt-count)
                (.lvf vf1 (&deref int128 src-lo i))
                (.lvf vf2 (&deref int128 src-hi i))
                (.mul.x.vf vf1 vf1 vf4)
                (.mul.x.vf vf2 vf2 vf3)
                (.add.vf vf1 vf1 vf2)
                (.svf (&deref int128 buf i) vf1)))
            buf)
           (else (get-tag-data this tag-lo))))))))

(defmethod get-property-data ((this res-lump) (name symbol) (mode symbol) (time float) (default pointer) (tag-addr (pointer res-tag)) (buf-addr pointer))
  "Return the address of property name at time, or default if lookup fails.
   mode controls lookup: base ignores time and selects the first sample, exact requires a
   sample at time, and interp selects an exact sample or brackets time for interpolation.
   If tag-addr is nonfalse, write the selected lower res-tag there. If interpolation is
   required, buf-addr must point to enough storage for every element of the result. Exact
   and non-interpolated results point directly into the lump."
  (let ((tag-pair (lookup-tag-idx this name mode time)))
    (cond
      ((< (the-as int tag-pair) 0) (empty))
      (else
       (set! default (make-property-data this time tag-pair buf-addr))
       (if tag-addr (set! (-> tag-addr) (-> this tag (-> tag-pair lo)))))))
  default)

(defmethod get-property-struct ((this res-lump) (name symbol) (mode symbol) (time float) (default structure) (tag-addr (pointer res-tag)) (buf-addr pointer))
  "Return structure property name at time, or default if lookup fails.
   mode controls lookup: base ignores time and selects the first sample, exact requires a
   sample at time, and interp selects an exact sample or brackets time for interpolation.
   Reference tags are dereferenced before returning. If tag-addr is nonfalse, write the
   selected lower res-tag there. buf-addr supplies interpolation storage, although
   structure properties are normally references and therefore are not interpolated."
  (let ((tag-pair (lookup-tag-idx this name mode time)))
    (cond
      ((< (the-as int tag-pair) 0) (empty))
      (else
       (set! default (the-as structure (make-property-data this time tag-pair buf-addr)))
       (let ((tag (-> this tag (-> tag-pair lo))))
         (if tag-addr (set! (-> tag-addr 0) tag))
         (if (res-ref? tag) (set! default (deref structure default)) (empty))))))
  default)

(defmethod get-property-value ((this res-lump) (name symbol) (mode symbol) (time float) (default uint128) (tag-addr (pointer res-tag)) (buf-addr pointer))
  "Return the first scalar element of property name in a 128-bit value, or default if
   lookup or type conversion fails.
   mode controls lookup: base ignores time and selects the first sample, exact requires a
   sample at time, and interp selects an exact sample or brackets time for interpolation.
   Integer values are sign- or zero-extended according to their element type.
   If tag-addr is nonfalse, write the selected lower res-tag there. buf-addr must hold
   the interpolated array when interpolation is required."
  (let ((tag-pair (lookup-tag-idx this name mode time)))
    (cond
      ((< (the-as int tag-pair) 0))
      (else
       (let* ((tag (-> this tag (-> tag-pair lo)))
              (tag-type (-> tag elt-type))
              (data (make-property-data this time tag-pair buf-addr)))
         (if tag-addr (set! (-> tag-addr 0) tag))
         (cond
           ((type-type? tag-type uinteger)
            (case (-> tag elt-type size)
              ((1) (set! default (the-as uint128 (deref uint8 data))))
              ((2) (set! default (the-as uint128 (deref uint16 data))))
              ((4) (set! default (the-as uint128 (deref uint32 data))))
              ((16) (set! default (the-as uint128 (deref uint128 data))))
              (else (set! default (the-as uint128 (deref uint64 data))))))
           ((type-type? tag-type integer)
            (case (-> tag elt-type size)
              ((1) (set! default (the-as uint128 (deref int8 data))))
              ((2) (set! default (the-as uint128 (deref int16 data))))
              ((4) (set! default (the-as uint128 (deref int32 data))))
              ((16) (set! default (the-as uint128 (deref uint128 data))))
              (else (set! default (the-as uint128 (deref uint64 data))))))
           ((type-type? tag-type float) (set! default (the-as uint128 (deref float data))))
           (else))))))
  default)

(defmethod get-property-value-float ((this res-lump) (name symbol) (mode symbol) (time float) (default float) (tag-addr (pointer res-tag)) (buf-addr pointer))
  "Return the first numeric element of property name converted to float, or default if
   lookup or type conversion fails.
   mode controls lookup: base ignores time and selects the first sample, exact requires a
   sample at time, and interp selects an exact sample or brackets time for interpolation.
   Float properties are loaded directly and integer properties are numerically converted
   according to their signedness and width. If tag-addr is nonfalse, write the selected
   lower res-tag there. buf-addr must hold the interpolated array when interpolation is
   required."
  (let ((tag-pair (lookup-tag-idx this name mode time)))
    (cond
      ((< (the-as int tag-pair) 0) (empty))
      (else
       (let* ((tag (-> this tag (-> tag-pair lo)))
              (tag-type (-> tag elt-type))
              (data (make-property-data this time tag-pair buf-addr)))
         (if tag-addr (set! (-> tag-addr 0) tag))
         (cond
           ((type-type? tag-type float) (set! default (deref float data)))
           ((type-type? tag-type uinteger)
            (case (-> tag elt-type size)
              ((1) (set! default (the float (deref uint8 data))))
              ((2) (set! default (the float (deref uint16 data))))
              ((4) (set! default (the float (deref uint32 data))))
              ((16) (set! default (the float (deref uint128 data))))
              (else (set! default (the float (deref uint64 data))))))
           ((type-type? tag-type integer)
            (case (-> tag elt-type size)
              ((1) (set! default (the float (deref int8 data))))
              ((2) (set! default (the float (deref int16 data))))
              ((4) (set! default (the float (deref int32 data))))
              ((16) (set! default (the float (deref uint128 data))))
              (else (set! default (the float (deref uint64 data))))))
           (else (empty)))))))
  default)

(defmethod sort! ((this res-lump))
  "Bubble-sort occupied tags by the first eight name bytes and then by key frame."
  (let ((tags-sorted -1))
    (while (nonzero? tags-sorted)
      (set! tags-sorted 0)
      (let ((i 0)
            (tag-stop (+ (-> this length) -2)))
        (while (>= tag-stop i)
          (let* ((tag1 (-> this tag i))
                 (tag2 (-> this tag (1+ i)))
                 (tag-name1 (deref uint64 (-> (symbol->string (-> tag1 name)) data)))
                 (tag-name2 (deref uint64 (-> (symbol->string (-> tag2 name)) data))))
            (when (or (< tag-name2 tag-name1) (and (= tag-name1 tag-name2) (< (-> tag2 key-frame) (-> tag1 key-frame))))
              (1+! tags-sorted)
              (set! (-> this tag i) tag2)
              (set! (-> this tag (1+ i)) tag1)))
          (1+! i)))))
  this)

(defmethod allocate-data-memory-for-tag! ((this res-lump) (tag res-tag))
  "Reuse an aligned compatible slot or allocate 16-byte-aligned lump storage for tag.
   Install the updated tag, force a zero element count to one, and return false if the tag table or data area is full."
  (local-vars (resource-mem pointer))
  ;; first, look up the tag to see if it already exists in this res-lump
  (let ((tag-pair (lookup-tag-idx this (-> tag name) 'exact (-> tag key-frame))))
    (let ((existing-tag (-> this tag (-> tag-pair lo))))
      ;; If our existing tag is valid, but our key-frame is NaN, then we forget about it.
      (if (and (>= (the-as int tag-pair) 0)
               (!= (-> tag key-frame) (-> tag key-frame)) ;; check for NaN
               )
        (set! tag-pair (new 'static 'res-tag-pair :lo #xffffffff :hi #xffffffff)))
      ;; modify the input to have at least one element
      (if (zero? (-> tag elt-count)) (set! (-> tag elt-count) 1))
      ;; next, we try to find some memory
      (let ((data-size (length tag))) ;; size in bytes to store the data.
        (cond
          ((and (>= (the-as int tag-pair) 0) (>= (the-as uint (length existing-tag)) (the-as uint data-size)))
           ;; we have enough memory in the existing tag.
           ;; so we can just reuse it.
           (set! resource-mem (&+ (-> this data-base) (-> existing-tag data-offset)))
           ;; but we want at least 8 byte alignment. If this fails, allocate with 16-byte alignment from the top.
           (when (nonzero? (logand (the-as int resource-mem) 7))
             (set! resource-mem (logand -16 (&+ (-> this data-top) 15)))
             (set! (-> this data-top) (&+ resource-mem data-size))))
          (else
           ;; the existing tag wasn't there, or it wasn't big enough.
           ;; just allocate new memory.
           (set! resource-mem (logand -16 (&+ (-> this data-top) 15)))
           (set! (-> this data-top) (&+ resource-mem data-size))))
        ;; set our data offset.
        (set! (-> tag data-offset) (&- resource-mem (the-as uint (-> this data-base))))
        ;; check for overflow of the data memory
        ;; this will leave things in a bad state.
        (when (>= (the-as int (&+ resource-mem data-size)) (the-as int (&+ (-> this data-base) (-> this data-size))))
          (format 0
                  "ERROR: attempting to a new tag ~`res-tag`P data of #x~X bytes to ~A, but data memory is full.~%"
                  tag
                  data-size
                  this)
          (return (the-as res-tag #f)))))
    ;; next step is to add us to the list of tags.
    (cond
      ((< (the-as int tag-pair) 0)
       ;; we couldn't reuse an existing tag. Need to allocate another
       (cond
         ((>= (-> this length) (-> this allocated-length))
          ;; but there isn't room for another tag.
          (format 0 "ERROR: attempting to a new tag ~`res-tag`P to ~A, but tag memory is full.~%" tag this)
          (return (the-as res-tag #f)))
         (else
          ;; allocate a new tag and sort, so the binary search works properly.
          (set! (-> this tag (-> this length)) tag)
          (set! (-> this length) (+ (-> this length) 1))
          (sort! this))))
      (else
       ;; reuse the existing tag.
       (set! (-> this tag (-> tag-pair lo)) tag))))
  tag)

(defmethod add-data! ((this res-lump) (tag res-tag) (data pointer))
  "Install tag and copy its inline payload, or store data as a reference.
   A reference tag with more than one element appears to store only the first pointer even
   though its allocated length accounts for the full array."
  ;; get a tag for this lump with memory for the given tag.
  (let ((new-tag (allocate-data-memory-for-tag! this tag)))
    (when new-tag
      ;; get pointer to new tag's memory
      (let* ((lump this)
             (stored-tag new-tag)
             (tag-mem (&+ (-> lump data-base) (-> stored-tag data-offset))))
        (cond
          ((zero? (-> new-tag inlined?))
           ;; Reference properties store the supplied object pointer in their data slot.
           (length new-tag) ;; The computed length is unused; should this copy every reference?
           (set! (-> (the-as (pointer pointer) tag-mem)) data))
          (else
           ;; otherwise, copy the memory.
           (let ((byte-count (length new-tag))) (mem-copy! tag-mem data byte-count)))))))
  this)

(defmethod add-32bit-data! ((this res-lump) (tag res-tag) (value object))
  "Install value as one inline 32-bit property."
  (set! (-> tag inlined?) 1)
  ;; Only the low 32 bits of value are spilled for the inline copy.
  (add-data! this tag (& value)))

(defmethod get-curve-data! ((this res-lump) (curve-target curve) (points-name symbol) (knots-name symbol) (time float))
  "Load exact control-point and knot properties into curve-target at time.
   Return true only when both properties exist, and clamp the reported control-point count to 256."
  (let ((result #f))
    (let* ((points-tag (new 'static 'res-tag))
           (curve-data (get-property-data this points-name 'exact time (the pointer #f) (& points-tag) *res-static-buf*)))
      (when curve-data
        (set! (-> curve-target cverts) (the-as (inline-array vector) curve-data))
        (set! (-> curve-target num-cverts) (the int (-> points-tag elt-count)))
        (when (< MAX_CURVE_CONTROL_POINTS (-> curve-target num-cverts))
          (format 0
                  "ERROR<GMJ>: curve has ~D control points--only ~D are allowed. Increase MAX-CURVE-CONTROL-POINTS or shorten the curve.~%"
                  (-> curve-target num-cverts)
                  MAX_CURVE_CONTROL_POINTS)
          (set! (-> curve-target num-cverts) MAX_CURVE_CONTROL_POINTS))
        (let ((knots-tag (new 'static 'res-tag)))
          (set! curve-data (get-property-data this knots-name 'exact time (the pointer #f) (& knots-tag) *res-static-buf*))
          (when curve-data
            (set! (-> curve-target knots) (the (pointer float) curve-data))
            (set! (-> curve-target num-knots) (the int (-> knots-tag elt-count)))
            (set! result #t)))))
    result))

(define-extern part-group-pointer? (function pointer symbol))

(declare-type nav-mesh basic)

(declare-type collide-mesh basic)

(defmethod mem-usage ((this res-lump) (block memory-usage-block) (flags mem-usage-flags))
  "Add the lump and its referenced objects to the selected memory-usage category."
  ;; get the name and ID
  (let ((mem-use-id (mem-usage-id res))
        (mem-use-name "res"))
    ;; the caller may set flags giving us a more specific category
    (cond
      ((logtest? flags (mem-usage-flags resource-camera)) (set! mem-use-id (mem-usage-id camera)) (set! mem-use-name "camera"))
      ((logtest? flags (mem-usage-flags resource-entity)) (set! mem-use-id (mem-usage-id entity)) (set! mem-use-name "entity"))
      ((logtest? flags (mem-usage-flags resource-ambient)) (set! mem-use-id (mem-usage-id ambient)) (set! mem-use-name "ambient"))
      ((logtest? flags (mem-usage-flags resource-joint-geo)) (set! mem-use-id (mem-usage-id art-joint-geo)) (set! mem-use-name "art-joint-geo")))
    ;; set up the block
    (set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
    (set! (-> block data mem-use-id name) mem-use-name)
    ;; the lump counts as 1 in the count field
    (+! (-> block data mem-use-id count) 1)
    ;; add the size of the lump itself.
    (let ((obj-size (asize-of this)))
      (+! (-> block data mem-use-id used) obj-size)
      (+! (-> block data mem-use-id total) (logand -16 (+ obj-size 15))))
    ;; add the tags
    (dotimes (tag-idx (-> this length))
      (when (zero? (-> this tag tag-idx inlined?))
        (let* ((lump this)
               (tag-index tag-idx)
               (tag-data (the-as basic (-> (the-as (pointer uint32) (&+ (-> lump data-base) (-> lump tag tag-index data-offset)))))))
          ;; ref to non-inline data.  Inline data would have been counted above.
          (when (not (part-group-pointer? (the-as pointer tag-data)))
            (case (-> (the-as basic tag-data) type)
              ((symbol type))
              ((string)
               ;; Strings use the normal object accounting path.
               (set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
               (set! (-> block data mem-use-id name) mem-use-name)
               (+! (-> block data mem-use-id count) 1)
               (let ((object-size (asize-of tag-data)))
                 (+! (-> block data mem-use-id used) object-size)
                 (+! (-> block data mem-use-id total) (logand -16 (+ object-size 15)))))
              ;; these have their own implementation.
              ((nav-mesh collide-mesh) (mem-usage (the-as collide-mesh tag-data) block flags))
              ((array)
               (set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
               (set! (-> block data mem-use-id name) mem-use-name)
               (+! (-> block data mem-use-id count) 1)
               (let ((object-size (asize-of (the-as (array object) tag-data))))
                 (+! (-> block data mem-use-id used) object-size)
                 (+! (-> block data mem-use-id total) (logand -16 (+ object-size 15))))
               ;; call mem usage on all of our children.
               (let ((i 0))
                 (while (< i (-> (the-as array tag-data) length))
                   (let ((element (-> (the-as (array object) tag-data) i)))
                     ((method-of-type (rtype-of element) mem-usage) element block flags))
                   (+! i 1))))
              (else
               ;; Other referenced objects contribute their own allocated size.
               (set! (-> block length) (max (-> block length) (+ mem-use-id 1)))
               (set! (-> block data mem-use-id name) mem-use-name)
               (+! (-> block data mem-use-id count) 1)
               (let ((object-size (asize-of tag-data)))
                 (+! (-> block data mem-use-id used) object-size)
                 (+! (-> block data mem-use-id total) (logand -16 (+ object-size 15)))))))))))
  (the-as res-lump 0))

(define *res-static-buf* (malloc 'global 128))

(defmacro res-lump-data (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time -1000000000.0))
  "Return named packed data, interpolating at time when the property has timed samples."
  `(the-as ,type
          ((method-of-type res-lump get-property-data) ,lump ,name 'interp ,time (the-as pointer #f) ,tag-ptr *res-static-buf*)))

(defmacro res-lump-data-exact (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time 0.0))
  "Return named packed data only when an exact sample exists at time."
  `(the-as ,type
          ((method-of-type res-lump get-property-data) ,lump ,name 'exact ,time (the-as pointer #f) ,tag-ptr *res-static-buf*)))

(defmacro res-lump-struct (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time -1000000000.0) &key (default (the-as structure #f)))
  "Return a named referenced structure, selecting the sample at time or default when absent."
  `(the-as ,type ((method-of-type res-lump get-property-struct) ,lump ,name 'interp ,time ,default ,tag-ptr *res-static-buf*)))

(defmacro res-lump-struct-exact (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (time 0.0))
  "Return a named referenced structure only when an exact sample exists at time."
  `(the-as ,type
          ((method-of-type res-lump get-property-struct) ,lump ,name 'exact ,time (the-as structure #f) ,tag-ptr *res-static-buf*)))

(defmacro res-lump-value (lump name type &key (tag-ptr (the-as (pointer res-tag) #f)) &key (default (the-as uint128 0)) &key (time -1000000000.0))
  "Return a named scalar value at time, or default when lookup fails."
  `(the-as ,type ((method-of-type res-lump get-property-value) ,lump ,name 'interp ,time ,default ,tag-ptr *res-static-buf*)))

(defmacro res-lump-float (lump name &key (tag-ptr (the-as (pointer res-tag) #f)) &key (default 0.0) &key (time -1000000000.0))
  "Return a named numeric value converted to float at time, or default."
  `((method-of-type res-lump get-property-value-float) ,lump ,name 'interp ,time ,default ,tag-ptr *res-static-buf*))