jak-project/goal_src/jak1/engine/debug/anim-tester.gc

;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/util/glist-h.gc")
(require "engine/anim/aligner.gc")

;; The animation tester: an in-game browser for the animations of a loaded art
;; group. `anim-tester-add-object` loads one art group and adds an entry for its
;; mesh, holding every animation in that group. Any animation can be renamed into
;; a "sequence" and then edited into a playlist of items - animation, speed, blend
;; time, first and last frame - which the process plays end to end. Sequences are
;; written back out as text .obinf files.
;;
;; The debug menu drives all of it through events (see default-menu.gc), and the
;; four lists on screen are drawn by the generic list-control below, which calls
;; back into a per-list handler function for measuring, drawing and pad input.

;; NOTES - removed one of the 2 inspects
;; - also fixed up a basic file-stream constructor on the stack

(declare-type list-control structure)

(declare-type anim-tester process-drawable)

(define-extern anim-tester-save-all-objects (function anim-tester symbol))

(defenum anim-tester-flags
  :bitfield #t
  :type int32
  (anim-playing) ;; an animation is set up on the skeleton, so post it
  (just-entered) ;; entered anim-tester-process this frame; skip the menu once
  (return-to-menu) ;; a list closed itself; hand control back to the debug menu
  (editing-field) ;; pad input belongs to the highlighted field, not the list
  (at-show-joint-info) ;; "Show Joint Inf" menu flag
  (at-apply-align) ;; "Apply Align" menu flag
  )

;; The command a list-control passes to its listfunc. display-list-control drives
;; the whole list through these five calls.
(defenum list-control-cmd
  :type int32
  (draw-line 0) ;; draw the current node at (xpos, ypos)
  (visible? 1) ;; #t if the current node belongs in this list
  (measure 2) ;; store the current node's width in characters in return-int
  (draw-title 3) ;; draw the list title, and anything right of the list
  (input 4) ;; consume this frame's pad input
  )

(define-extern anim-test-anim-list-handler (function list-control-cmd list-control symbol))

(define-extern anim-test-edit-sequence-list-handler (function list-control-cmd list-control symbol))

;; Which list the tester is showing. The names are the events that select them.
(defenum anim-tester-edit-mode
  :type int32
  (none 0)
  (pick-object 1)
  (pick-joint-anim 2)
  (pick-sequence 3)
  (edit-sequence 4))

(defenum anim-test-obj-flags
  :bitfield #t
  :type int32
  (edited) ;; sequences were changed; save-sequences will write the file
  (play-sequence) ;; play seq-index out of the sequence list, not anim-index
  )

(defenum anim-test-seq-flags
  :bitfield #t
  :type int32
  (sequence) ;; a named sequence, not a plain animation from the art group
  (anim-present) ;; the matching animation was found in the art group this scan
  (from-file) ;; loaded from data/<object>.obinf, cleared when saved again
  )

(defenum anim-test-item-flags
  :bitfield #t
  :type int32
  (end) ;; the "**END**" row that closes every sequence
  (wait-for-blend) ;; hold the sequence until this item's blend has finished
  (blank) ;; "--blank--" row inserted at the end; not saved, not played
  )

;; Columns of one sequence row, indexed by anim-tester's item-field. The three
;; flag columns after blend-flag are drawn as "-" and skipped when moving left or
;; right; the last three spell out the "MID" column header.
(defenum anim-test-item-field
  :type int64
  (name 0)
  (speed 1)
  (blend 2)
  (first-frame 3)
  (last-frame 4)
  (blend-flag 5)
  (unused-flag-1 6)
  (unused-flag-2 7)
  (unused-flag-3 8)
  (move 9)
  (insert 10)
  (delete 11))

;; DECOMP BEGINS

;; this file is debug only
(declare-file (debug))

;; One scrolling list of glst-nodes on screen. Everything specific to a list
;; lives in its listfunc, which display-list-control calls once per node per
;; command; the fields below are how the two halves talk to each other.
(deftype list-control (structure)
  ((listfunc            (function list-control-cmd list-control symbol))
   (list-owner          uint32) ;; whatever owns the list; the handler knows the type
   (top                 int32) ;; panel position, in pixels
   (left                int32)
   (list                glst-list)
   (the-node            glst-node) ;; node the listfunc is being asked about
   (top-index           int32) ;; index of the first node on screen
   (the-index           int32) ;; index of the-node
   (the-disp-line       int32) ;; screen line the-node would be drawn on
   (highlight-index     int32) ;; index under the cursor
   (current-index       int32) ;; index the handler last accepted with X
   (numlines            int32) ;; visible nodes in the whole list
   (lines-to-disp       int32) ;; visible nodes on screen, at most MAX_LINES
   (charswide           int32) ;; width of the widest visible line, in characters
   (highlight-disp-line int32) ;; screen line of the highlighted node
   (field-id            int32)
   (xpos                int32) ;; where the listfunc should draw, in pixels
   (ypos                int32)
   (user-info           int32) ;; per-list, set by whoever configured the control
   (user-info-u         uint32 :overlay-at user-info)
   (return-int          int32)) ;; the listfunc's answer to a measure command
  :allow-misaligned)

;; Column of a sequence-editor row, in characters from the left of the panel.
(deftype list-field (structure)
  ((left  int32)
   (width int32)))

;; Layout constants shared by every list-control. Sizes are in pixels except
;; MAX_LINES and BORDER_LINES, which are screen lines, and CHAR_WIDTH, which is
;; how wide the code assumes one character of the debug font is.
(deftype DISP_LIST-bank (basic)
  ((TV_SPACING    int32)
   (BORDER_WIDTH  int32)
   (BORDER_HEIGHT int32)
   (MAX_LINES     int32)
   (CHAR_WIDTH    int32)
   (INC_DELAY     int32)
   (BORDER_LINES  int32)
   (CXOFF         int32) ;; the four offsets are left at zero
   (CYOFF         int32)
   (BXOFF         int32)
   (BYOFF         int32)))

(define *DISP_LIST-bank*
  (new 'static
       'DISP_LIST-bank
       :TV_SPACING 8
       :BORDER_WIDTH 4
       :BORDER_HEIGHT 4
       :MAX_LINES 12
       :CHAR_WIDTH 10
       :INC_DELAY 20
       :BORDER_LINES 3))

(defun display-list-control ((ctrl list-control))
  "Draw one list and give it this frame's pad input.

   Both indices are clamped into range first, then the list is walked with
   (list-control-cmd visible?) so a handler can filter nodes out: if the
   highlighted node is filtered out, the highlight moves to the first visible
   node. The visible nodes are measured to size the panel, the panel and title
   are drawn, and top-index is moved until the highlight sits at least
   BORDER_LINES from either edge of the window. Finally up to MAX_LINES rows are
   drawn, or \"**NONE**\" if nothing is visible.

   the-node, the-index and the-disp-line are what a handler reads to find out
   which node it is being asked about."
  (when (< (-> ctrl current-index) 0)
    (set! (-> ctrl current-index) 0)
    0)
  ;; -1 means nothing in this list is selected any more
  (if (>= (-> ctrl current-index) (glst-num-elements (-> ctrl list))) (set! (-> ctrl current-index) -1))
  (when (< (-> ctrl highlight-index) 0)
    (set! (-> ctrl highlight-index) 0)
    0)
  (if (>= (-> ctrl highlight-index) (glst-num-elements (-> ctrl list)))
    (set! (-> ctrl highlight-index) (+ (glst-num-elements (-> ctrl list)) -1)))
  (set! (-> ctrl the-index) (-> ctrl highlight-index))
  (set! (-> ctrl the-node) (glst-get-node-by-index (-> ctrl list) (-> ctrl highlight-index)))
  ;; the highlighted node may be one the handler wants hidden. If so, highlight the
  ;; first visible node instead, or fall back to 0 if the whole list is hidden.
  (when (not ((-> ctrl listfunc) (list-control-cmd visible?) ctrl))
    (set! (-> ctrl the-index) 0)
    (let ((list (-> ctrl list))) "return the start of the list" (set! (-> ctrl the-node) (-> list head)))
    (while (let ((node (-> ctrl the-node))) "is this node the end of the list. #t = end" (not (not (-> node next))))
      (when ((-> ctrl listfunc) (list-control-cmd visible?) ctrl)
        (set! (-> ctrl highlight-index) (-> ctrl the-index))
        (goto cfg-18))
      (+! (-> ctrl the-index) 1)
      (let ((node (-> ctrl the-node))) "return the next node in the list" (set! (-> ctrl the-node) (-> node next))))
    (set! (-> ctrl highlight-index) 0)
    0)
  (label cfg-18)
  (set! (-> ctrl the-index) (-> ctrl highlight-index))
  (set! (-> ctrl the-node) (glst-get-node-by-index (-> ctrl list) (-> ctrl the-index)))
  ((-> ctrl listfunc) (list-control-cmd input) ctrl)
  ;; measure the list: count the visible nodes, find the widest one, and work out
  ;; which screen line the highlight lands on with the current top-index
  (let ((past-top? #f)
        (found-highlight? #f))
    (set! (-> ctrl numlines) 0)
    (set! (-> ctrl charswide) 0)
    (set! (-> ctrl the-index) 0)
    (set! (-> ctrl the-disp-line) 0)
    (let ((list (-> ctrl list))) "return the start of the list" (set! (-> ctrl the-node) (-> list head)))
    (while (let ((node (-> ctrl the-node))) "is this node the end of the list. #t = end" (not (not (-> node next))))
      (when ((-> ctrl listfunc) (list-control-cmd visible?) ctrl)
        (if (and (not past-top?) (>= (-> ctrl the-index) (-> ctrl top-index))) (set! past-top? #t))
        (when (and (not found-highlight?) (>= (-> ctrl the-index) (-> ctrl highlight-index)))
          (set! found-highlight? #t)
          (set! (-> ctrl highlight-disp-line) (-> ctrl the-disp-line)))
        ((-> ctrl listfunc) (list-control-cmd measure) ctrl)
        (if (< (-> ctrl charswide) (-> ctrl return-int)) (set! (-> ctrl charswide) (-> ctrl return-int)))
        (if past-top? (+! (-> ctrl the-disp-line) 1))
        (+! (-> ctrl numlines) 1))
      (+! (-> ctrl the-index) 1)
      (let ((node (-> ctrl the-node))) "return the next node in the list" (set! (-> ctrl the-node) (-> node next)))))
  (set! (-> ctrl lines-to-disp)
        (if (< (-> *DISP_LIST-bank* MAX_LINES) (-> ctrl numlines)) (-> *DISP_LIST-bank* MAX_LINES) (-> ctrl numlines)))
  ;; result unused
  (if (> (-> ctrl lines-to-disp) 0) (-> ctrl lines-to-disp) 1)
  (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-sprite2d-xy dma-buff
                        (-> ctrl left)
                        (-> ctrl top)
                        (+ (* (-> ctrl charswide) (-> *DISP_LIST-bank* CHAR_WIDTH)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
                        (+ (* (+ (-> ctrl lines-to-disp) 1) (-> *DISP_LIST-bank* TV_SPACING)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
                        (new 'static 'rgba :a #x40)))
  (set! (-> ctrl xpos) (+ (-> ctrl left) (-> *DISP_LIST-bank* BORDER_WIDTH)))
  (set! (-> ctrl ypos) (+ (-> ctrl top) (-> *DISP_LIST-bank* BORDER_HEIGHT)))
  ((-> ctrl listfunc) (list-control-cmd draw-title) ctrl)
  (cond
    ((> (-> ctrl lines-to-disp) 0)
     (cond
       ;; the highlight is too close to the top of the window: walk top-index back
       ;; over visible nodes until it is BORDER_LINES down, or the list runs out
       ((< (-> ctrl highlight-disp-line) (-> *DISP_LIST-bank* BORDER_LINES))
        (let ((lines-to-scroll (- (-> *DISP_LIST-bank* BORDER_LINES) (-> ctrl highlight-disp-line))))
          (set! (-> ctrl the-node) (glst-get-node-by-index (-> ctrl list) (-> ctrl top-index)))
          (set! (-> ctrl the-index) (-> ctrl top-index))
          (let ((node (-> ctrl the-node)))
            "is this node the start of the list. #t = start"
            (when (not (not (-> node prev)))
              (loop
                (let ((cur-node (-> ctrl the-node)))
                  "return the previous node in the list"
                  (let ((prev-node (-> cur-node prev)))
                    (let ((prev prev-node)) "is this node the start of the list. #t = start" (if (not (-> prev prev)) (goto cfg-61)))
                    (set! (-> ctrl the-node) prev-node)))
                (+! (-> ctrl the-index) -1)
                (when ((-> ctrl listfunc) (list-control-cmd visible?) ctrl)
                  (set! (-> ctrl top-index) (-> ctrl the-index))
                  (+! lines-to-scroll -1)
                  (if (<= lines-to-scroll 0) (goto cfg-61)))))))
        (label cfg-61))
       ;; and the same the other way, for the bottom of the window
       ((>= (-> ctrl highlight-disp-line) (- (-> *DISP_LIST-bank* MAX_LINES) (-> *DISP_LIST-bank* BORDER_LINES)))
        (let ((lines-to-scroll (- (-> ctrl highlight-disp-line) (- (-> *DISP_LIST-bank* MAX_LINES) (-> *DISP_LIST-bank* BORDER_LINES)))))
          (set! (-> ctrl the-node) (glst-get-node-by-index (-> ctrl list) (-> ctrl top-index)))
          (set! (-> ctrl the-index) (-> ctrl top-index))
          (let ((node (-> ctrl the-node)))
            "is this node the end of the list. #t = end"
            (when (not (not (-> node next)))
              (loop
                (let ((cur-node (-> ctrl the-node)))
                  "return the next node in the list"
                  (let ((next-node (-> cur-node next)))
                    (let ((next next-node)) "is this node the end of the list. #t = end" (if (not (-> next next)) (goto cfg-77)))
                    (set! (-> ctrl the-node) next-node)))
                (+! (-> ctrl the-index) 1)
                (when ((-> ctrl listfunc) (list-control-cmd visible?) ctrl)
                  (set! (-> ctrl top-index) (-> ctrl the-index))
                  (+! lines-to-scroll -1)
                  (if (<= lines-to-scroll 0) (goto cfg-77)))))))))
     (label cfg-77)
     ;; draw from top-index until the window is full or the list ends
     (set! (-> ctrl the-disp-line) 0)
     (set! (-> ctrl the-index) (-> ctrl top-index))
     (set! (-> ctrl the-node) (glst-get-node-by-index (-> ctrl list) (-> ctrl top-index)))
     (while (let ((node (-> ctrl the-node)))
              "is this node the end of the list. #t = end"
              (not (or (not (-> node next)) (>= (-> ctrl the-disp-line) (-> *DISP_LIST-bank* MAX_LINES)))))
       (when ((-> ctrl listfunc) (list-control-cmd visible?) ctrl)
         (set! (-> ctrl xpos) (+ (-> ctrl left) (-> *DISP_LIST-bank* BORDER_WIDTH)))
         (set! (-> ctrl ypos)
               (+ (-> ctrl top) (-> *DISP_LIST-bank* BORDER_HEIGHT) (* (+ (-> ctrl the-disp-line) 1) (-> *DISP_LIST-bank* TV_SPACING))))
         ((-> ctrl listfunc) (list-control-cmd draw-line) ctrl)
         (+! (-> ctrl the-disp-line) 1))
       (+! (-> ctrl the-index) 1)
       (let ((node (-> ctrl the-node))) "return the next node in the list" (set! (-> ctrl the-node) (-> node next)))))
    (else
     (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "**NONE**"
                            dma-buff
                            (+ (-> ctrl left) (-> *DISP_LIST-bank* BORDER_WIDTH))
                            (+ (-> ctrl top) (-> *DISP_LIST-bank* BORDER_HEIGHT) (-> *DISP_LIST-bank* TV_SPACING))
                            (font-color menu)
                            (font-flags shadow kerning)))))
  (none))

;; Where each of the four lists sits, and how narrow it is allowed to get. X, Y
;; and EDIT_STATS_X/EDIT_PICK_X are pixels and characters respectively; the widths
;; are in characters.
(deftype anim-tester-bank (basic)
  ((ANIM_SPEED            float) ;; unused
   (BLEND                 float) ;; unused
   (OBJECT_LIST_X         int32)
   (OBJECT_LIST_Y         int32)
   (OBJECT_LIST_MIN_WIDTH int32)
   (ANIM_LIST_X           int32)
   (ANIM_LIST_Y           int32)
   (ANIM_LIST_MIN_WIDTH   int32)
   (PICK_LIST_X           int32)
   (PICK_LIST_Y           int32)
   (PICK_LIST_MIN_WIDTH   int32)
   (EDIT_LIST_X           int32)
   (EDIT_LIST_Y           int32)
   (EDIT_STATS_X          int32)
   (EDIT_LIST_MIN_WIDTH   int32)
   (EDIT_PICK_X           int32)))

(define *ANIM_TESTER-bank*
  (new 'static
       'anim-tester-bank
       :ANIM_SPEED 1.0
       :BLEND 1.0
       :OBJECT_LIST_X 10
       :OBJECT_LIST_Y 50
       :OBJECT_LIST_MIN_WIDTH 18
       :ANIM_LIST_X 10
       :ANIM_LIST_Y 50
       :ANIM_LIST_MIN_WIDTH 17
       :PICK_LIST_X 10
       :PICK_LIST_Y 50
       :PICK_LIST_MIN_WIDTH 21
       :EDIT_LIST_X 10
       :EDIT_LIST_Y 50
       :EDIT_STATS_X 30
       :EDIT_LIST_MIN_WIDTH 64
       :EDIT_PICK_X 30))

;; The tester process itself. It draws one loaded mesh with one animation channel
;; set, and owns the object list and the animation picker; the per-object and
;; per-sequence lists live on the nodes they belong to.
(deftype anim-tester (process-drawable)
  ((flags       anim-tester-flags)
   (obj-list    glst-list :inline) ;; every loaded art group, as anim-test-obj
   (current-obj string) ;; name of the object being played
   (speed       int32) ;; global playback speed, percent
   (list-con    list-control :inline) ;; the object list
   (pick-con    list-control :inline) ;; the animation picker inside the editor
   (item-field  int64) ;; anim-test-item-field: editor column
   (inc-delay   int32) ;; frames between steps while a value is held
   (inc-timer   int32) ;; frames left before the next step
   (edit-mode   anim-tester-edit-mode)
   (old-mode    anim-tester-edit-mode) ;; edit-mode last frame; written, never read
   (anim-speed  float) ;; frames per frame for the current row
   (anim-gspeed float) ;; speed as a fraction, without the row's own
   (anim-first  float) ;; frame limits for the current row, or the
   (anim-last   float)) ;;   min/max sentinels
  (:states
   anim-tester-process))

(defun anim-tester-num-print ((stream basic) (frame float))
  "Print a frame number to stream for an .obinf file, spelling the two sentinels
   as \"min\" (-1.0) and \"max\" (-2.0)."
  (cond
    ((= frame -2.0) (format stream "max"))
    ((= frame -1.0) (format stream "min"))
    (else (format stream "~f" frame)))
  (none))

(define-perm *anim-tester* (pointer anim-tester) #f)

;; One mesh out of one art group, and everything the tester knows about its
;; animations. privname is the mesh's name, which is what the object list shows.
(deftype anim-test-obj (glst-named-node)
  ((obj-art-group art-group)
   (seq-list      glst-list :inline) ;; anim-test-sequence, one per animation
   (flags         anim-test-obj-flags)
   (mesh-geo      merc-ctrl)
   (joint-geo     art-joint-geo)
   (list-con      list-control :inline) ;; the animation list, and the sequence list
   (parent        uint32) ;; see anim-test-obj-init; never read
   (anim-index    int32) ;; selection and cursor kept across a close,
   (anim-hindex   int32) ;;   for the animation list
   (seq-index     int32) ;; and for the sequence list
   (seq-hindex    int32))
  (:methods
   (new (symbol type int string basic) _type_)))

(defun anim-test-obj-init ((obj anim-test-obj) (parent-ctrl list-control))
  "Point obj's animation list at its own sequence list and place it on screen.
   parent-ctrl is meant to supply the node that owns obj, but every caller passes
   the anim-tester process itself, so parent ends up holding a word out of the
   process header. Nothing reads it."
  (set! (-> obj mesh-geo) #f)
  (set! (-> obj joint-geo) #f)
  (set! (-> obj list-con listfunc) anim-test-anim-list-handler)
  (set! (-> obj list-con left) (-> *ANIM_TESTER-bank* ANIM_LIST_X))
  (set! (-> obj list-con top) (-> *ANIM_TESTER-bank* ANIM_LIST_Y))
  (set! (-> obj list-con list) (-> obj seq-list))
  (set! (-> obj list-con list-owner) (the-as uint obj))
  (let ((ctrl parent-ctrl)) (set! (-> obj parent) (the-as uint (if ctrl (-> ctrl the-node)))))
  (none))

(defmethod new anim-test-obj ((allocation symbol) (type-to-make type) (count int) (name string) (ag basic))
  "Allocate a browser entry for the mesh named name in art group ag, with an
   empty sequence list. count is ignored; every caller passes 1."
  (let ((struct-new (method-of-type structure new))
        (alloc-type type-to-make))
    (-> type-to-make size)
    (let ((obj (the-as anim-test-obj (struct-new allocation alloc-type))))
      (set! (-> obj obj-art-group) (the-as art-group ag))
      (set! (-> obj privname) name)
      (glst-init-list! (-> obj seq-list))
      obj)))

;; One entry of an object's animation list. Every animation in the art group gets
;; one of these holding a single item; naming or editing it turns it into a
;; sequence, which is a playlist of items played end to end.
;;
;; Note that parent lands exactly where list-con's user-info sits in an
;; anim-test-obj, which is how the shared animation-list handler finds the object
;; a picked animation belongs to.
(deftype anim-test-sequence (glst-named-node)
  ((item-list    glst-list :inline) ;; anim-test-seq-item, ending in an **END** row
   (playing-item int32) ;; index of the row being played
   (flags        anim-test-seq-flags)
   (list-con     list-control :inline) ;; the sequence editor
   (parent       anim-test-obj))
  (:methods
   (new (symbol type int string) _type_)))

(defun anim-test-sequence-init ((seq anim-test-sequence) (obj anim-test-obj))
  "Point seq's editor at its own item list, place it on screen and remember the
   object it belongs to."
  (set! (-> seq list-con listfunc) anim-test-edit-sequence-list-handler)
  (set! (-> seq list-con left) (-> *ANIM_TESTER-bank* EDIT_LIST_X))
  (set! (-> seq list-con top) (-> *ANIM_TESTER-bank* EDIT_LIST_Y))
  (set! (-> seq list-con list) (-> seq item-list))
  (set! (-> seq list-con list-owner) (the-as uint seq))
  (set! (-> seq parent) obj)
  (none))

(defmethod new anim-test-sequence ((allocation symbol) (type-to-make type) (count int) (name string))
  "Allocate a sequence named name with an empty item list. count is ignored."
  (let ((struct-new (method-of-type structure new))
        (alloc-type type-to-make))
    (-> type-to-make size)
    (let ((seq (the-as anim-test-sequence (struct-new allocation alloc-type))))
      (set! (-> seq privname) name)
      (glst-init-list! (-> seq item-list))
      seq)))

;; One row of a sequence: play animation privname, at speed, blending in over
;; blend frames, from first-frame to last-frame.
(deftype anim-test-seq-item (glst-named-node)
  ((speed       int32) ;; percent of the tester's speed; negative plays backwards
   (blend       int32) ;; blend length in frames, before the global speed
   (first-frame float) ;; -1.0 means min, -2.0 means max
   (last-frame  float)
   (num-frames  float) ;; length of the animation, refreshed from the art group
   (artist-base float) ;; frame number the animator's first frame had
   (flags       anim-test-item-flags)
   (parent      anim-test-sequence))
  (:methods
   (new (symbol type int string) _type_)))

(defmethod new anim-test-seq-item ((allocation symbol) (type-to-make type) (count int) (name string))
  "Allocate a row that plays animation name at full speed with no blend, from
   its first frame (min) to its last (max). count is ignored."
  (let ((struct-new (method-of-type structure new))
        (alloc-type type-to-make))
    (-> type-to-make size)
    (let ((item (the-as anim-test-seq-item (struct-new allocation alloc-type))))
      (set! (-> item privname) name)
      (set! (-> item speed) 100)
      (set! (-> item blend) 0)
      (set! (-> item first-frame) -1.0)
      (set! (-> item last-frame) -2.0)
      item)))

(defun anim-test-seq-item-copy! ((dst anim-test-seq-item) (src anim-test-seq-item))
  "Copy src onto dst, name and owning sequence included. Returns src's sequence."
  (let ((node dst)) (set! (-> node privname) (-> src privname)))
  (set! (-> dst speed) (-> src speed))
  (set! (-> dst blend) (-> src blend))
  (set! (-> dst first-frame) (-> src first-frame))
  (set! (-> dst last-frame) (-> src last-frame))
  (set! (-> dst num-frames) (-> src num-frames))
  (set! (-> dst artist-base) (-> src artist-base))
  (set! (-> dst flags) (-> src flags))
  (let ((parent-seq (-> src parent))) (set! (-> dst parent) parent-seq) parent-seq))

(defun anim-test-obj-item-valid? ((obj anim-test-obj) (item anim-test-seq-item))
  "Can item still be played? True when one of obj's sequences has the same name
   and was found in the art group during the last scan. As a side effect item's
   num-frames and artist-base are refreshed from that sequence's own first item,
   so a row's frame limits follow a reloaded animation. Returns #f otherwise."
  (let ((seq-list (-> obj seq-list)))
    "return the start of the list"
    (let ((cur-seq (the-as anim-test-sequence (-> seq-list head))))
      (while (let ((sequence-node cur-seq)) "is this node the end of the list. #t = end" (not (not (-> sequence-node next))))
        (when (and (logtest? (-> cur-seq flags) (anim-test-seq-flags anim-present)) (name= (-> item privname) (-> cur-seq privname)))
          (let ((item-list (-> cur-seq item-list)))
            "return the start of the list"
            (let* ((first-item (the-as anim-test-seq-item (-> item-list head)))
                   (item-node first-item))
              "is this node the end of the list. #t = end"
              (when (not (not (-> item-node next)))
                (set! (-> item num-frames) (-> first-item num-frames))
                (set! (-> item artist-base) (-> first-item artist-base)))))
          (return #t))
        "return the next node in the list"
        (set! cur-seq (the-as anim-test-sequence (-> cur-seq next))))))
  #f)

(defun anim-test-obj-remove-invalid ((obj anim-test-obj))
  "Throw away everything in obj that the art group no longer supports: rows whose
   animation has gone, and then any sequence left holding nothing but its **END**
   row. Clears anim-present on every surviving sequence so the next scan of the
   art group can set it again. Always returns #f."
  (local-vars (only-end-item? symbol))
  (let ((seq-list (-> obj seq-list)))
    "return the start of the list"
    (let ((cur-seq (the-as anim-test-sequence (-> seq-list head))))
      (while (let ((sequence-node cur-seq)) "is this node the end of the list. #t = end" (not (not (-> sequence-node next))))
        (let ((cur-node cur-seq))
          "return the next node in the list"
          (let ((next-seq (-> cur-node next)))
            (when (not (logtest? (-> cur-seq flags) (anim-test-seq-flags anim-present)))
              (let ((item-list (-> cur-seq item-list)))
                "return the start of the list"
                (let ((cur-item (the-as anim-test-seq-item (-> item-list head))))
                  (while (let ((item-node cur-item)) "is this node the end of the list. #t = end" (not (not (-> item-node next))))
                    (let ((item-node cur-item))
                      "return the next node in the list"
                      (let ((next-item (the-as anim-test-seq-item (-> item-node next))))
                        (if (and (not (logtest? (-> cur-item flags) (anim-test-item-flags end))) (not (anim-test-obj-item-valid? obj cur-item)))
                          (glst-remove (-> cur-seq item-list) cur-item))
                        (set! cur-item next-item)))))))
            (let ((item-list (-> cur-seq item-list)))
              "is the list empty, #t = empty"
              (if (or (= (-> item-list tailpred) item-list)
                      (and (= (glst-num-elements (-> cur-seq item-list)) 1)
                           (begin
                             (let ((yes? #t)
                                   (list (-> cur-seq item-list)))
                               "return the start of the list"
                               (let ((end-flag (the-as int (logand (-> (the-as anim-test-seq-item (-> list head)) flags) (anim-test-item-flags end)))))
                                 (cmove-#f-zero only-end-item? end-flag yes?)))
                             only-end-item?)))
                (glst-remove (-> obj seq-list) cur-seq)))
            (set! cur-seq (the-as anim-test-sequence next-seq)))))))
  (let ((seq-list (-> obj seq-list)))
    "return the start of the list"
    (let ((cur-seq (the-as anim-test-sequence (-> seq-list head))))
      (while (let ((sequence-node cur-seq)) "is this node the end of the list. #t = end" (not (not (-> sequence-node next))))
        (let ((sequence-node cur-seq))
          "return the next node in the list"
          (let ((next-node (-> sequence-node next)))
            (logclear! (-> cur-seq flags) (anim-test-seq-flags anim-present))
            (set! cur-seq (the-as anim-test-sequence next-node)))))))
  #f)

(defbehavior anim-tester-real-post anim-tester ()
  "Post the skeleton, but only while anim-playing is set: the state code clears
   that flag whenever it could not set an animation up, and the joint state is
   not safe to post then. Also moves the process by its own transv when
   at-apply-align is on, and dumps the joint channels to the console when
   at-show-joint-info is."
  (when (logtest? (-> self flags) (anim-tester-flags anim-playing))
    (if (logtest? (-> self flags) (anim-tester-flags at-apply-align))
      (vector-v+! (-> self root trans) (-> self root trans) (-> self root transv)))
    (ja-post)
    (when (logtest? (-> self flags) (anim-tester-flags at-show-joint-info))
      (draw-joint-spheres self)
      (debug-print-channels (-> self skel) (the-as symbol *stdcon*))))
  (none))

(defbehavior anim-tester-post anim-tester ()
  "Post hook for anim-tester-process."
  (anim-tester-real-post)
  (none))

(defbehavior anim-tester-update-anim-info anim-tester ((item anim-test-seq-item))
  "Recompute this frame's playback rate and frame limits from item. anim-gspeed
   is the tester's own speed as a fraction, anim-speed folds in the row's
   percentage on top of it. A negative rate plays the row backwards, which is
   expressed by swapping first and last and then making both rates positive, so
   the seek! in the state code always counts towards anim-last."
  (set! (-> self anim-first) (-> item first-frame))
  (set! (-> self anim-last) (-> item last-frame))
  (set! (-> self anim-gspeed) (* 0.01 (the float (-> self speed))))
  (set! (-> self anim-speed) (* (/ (-> self anim-gspeed) 100) (the float (-> item speed))))
  (when (< (-> self anim-speed) 0.0)
    (set! (-> self anim-first) (-> item last-frame))
    (set! (-> self anim-last) (-> item first-frame)))
  (set! (-> self anim-gspeed) (fabs (-> self anim-gspeed)))
  (set! (-> self anim-speed) (fabs (-> self anim-speed))))

(defbehavior anim-tester-reset anim-tester ()
  "Rebuild the draw and joint state for the current object.

   The object is the one named by current-obj, or, if that name is not on the
   list, whatever sits at list-con's current-index. Its skeleton and mesh become
   a single LOD selected out to any distance, with a 10-metre bounding sphere so
   it never culls, and a fresh joint animation channel set is posted once.
   Complains to the console and leaves the old draw state alone if the object is
   missing either its joint-geo or its mesh-geo."
  (let ((obj-list (-> self obj-list)))
    "is the list empty, #t = empty"
    (cond
      ((= (-> obj-list tailpred) obj-list) (set! (-> self list-con current-index) 0) (set! (-> self current-obj) ""))
      (else
       (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
         ;; og:preserve-this added this if, sometimes the value is -1 which just crashes the game after here. nice work!
         (if (< (-> self list-con current-index) 0) (set! (-> self list-con current-index) 0))
         (when (not obj)
           (if (>= (-> self list-con current-index) (glst-num-elements (-> self obj-list)))
             (set! (-> self list-con current-index) (+ (glst-num-elements (-> self obj-list)) -1)))
           (set! obj (the-as anim-test-obj (glst-get-node-by-index (-> self obj-list) (-> self list-con current-index))))
           (set! (-> self current-obj) (-> obj privname)))
         (cond
           ((or (not (-> obj joint-geo)) (not (-> obj mesh-geo)))
            (format #t "what's this? ~A~%" (-> obj privname))
            (format #t "it's missing a joint-geo, or a mesh-geo or a mesh-anim~%"))
           (else
            (let ((jgeo (-> obj joint-geo)))
              (let ((mgeo (-> obj mesh-geo)))
                (set! (-> self draw art-group) (-> obj obj-art-group))
                (set! (-> self draw cur-lod) -1)
                (set! (-> self draw jgeo) jgeo)
                (set! (-> self draw sink-group) (-> *level* level-default pris-tex-foreground-sink-group))
                (set! (-> self draw lod-set lod 0 geo) mgeo))
              (set! (-> self draw lod-set lod 0 dist) 4095996000.0)
              (set! (-> self draw bounds w) 40960.0)
              (set! (-> self draw data-format) (the-as uint 1))
              (let ((white-quad (-> (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0) quad)))
                (set! (-> self draw color-mult quad) white-quad))
              (let ((zero-quad (-> (new 'static 'vector) quad))) (set! (-> self draw color-emissive quad) zero-quad))
              (set! (-> self draw secondary-interp) 0.0)
              (set! (-> self draw shadow) #f)
              (set! (-> self draw shadow-ctrl) #f)
              (set! (-> self draw ripple) #f)
              (set! (-> self draw level-index) (the-as uint 2))
              (set! (-> self node-list) (make-nodes-from-jg jgeo *default-skel-template* 'debug)))
            (set! (-> self skel effect) (new 'process 'effect-control self))
            (fill-skeleton-cache self)
            (lod-set! (-> self draw) 0)
            (ja-channel-set! 0)
            (ja-post)))))))
  (none))

(defun anim-tester-disp-frame-num ((prefix string) (frame float) (artist-base float) (ctx font-context))
  "Draw one frame-number column: prefix, then either \"min\"/\"max\" for the two
   sentinels or the frame number with artist-base added, so the number matches
   what the animator saw. Disabled - it returns before drawing anything."
  ;; this function does not work
  (return (the pointer #f))
  (local-vars (fmt-func (function _varargs_ object)))
  (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (cond
        ((= frame -1.0)
         (let ((draw-adv draw-string-adv)) (format (clear *temp-string*) "~Smin" prefix) (draw-adv *temp-string* dma-buff ctx)))
        ((= frame -2.0)
         (let ((draw-adv draw-string-adv)) (format (clear *temp-string*) "~Smax" prefix) (draw-adv *temp-string* dma-buff ctx)))
        (else
         (let ((draw-adv draw-string-adv))
           (format (clear *temp-string*) "~S~3,,0f" prefix (+ frame artist-base))
           (draw-adv *temp-string* dma-buff ctx))))))

(defbehavior anim-tester-standard-event-handler anim-tester ((proc process) (argc int) (message symbol) (block event-message-block))
  "Handle the debug menu's requests.

   'reset re-reads the current object and restarts playback, 'change-anim
   restarts playback with whatever is selected now, the four pick/edit messages
   open one of the lists and take the pad away from the camera, and
   'save-sequences writes every object marked edited."
  (case message
    (('reset)
     (process-disconnect self)
     (logclear! (-> self flags) (anim-tester-flags anim-playing))
     (when (!= (-> *anim-tester* 0 edit-mode) (anim-tester-edit-mode pick-object))
       (set! (-> *debug-menu-context* is-hidden) #f)
       (set! (-> *anim-tester* 0 edit-mode) (anim-tester-edit-mode none))
       (set! *camera-read-buttons* #t))
     (anim-tester-reset)
     (go anim-tester-process))
    (('change-anim) (go anim-tester-process))
    (('pick-object) (set! (-> self edit-mode) (anim-tester-edit-mode pick-object)) (set! *camera-read-buttons* #f) #f)
    (('pick-joint-anim)
     (set! (-> self edit-mode) (anim-tester-edit-mode pick-joint-anim))
     (set! *camera-read-buttons* #f)
     #f)
    (('pick-sequence) (set! (-> self edit-mode) (anim-tester-edit-mode pick-sequence)) (set! *camera-read-buttons* #f) #f)
    (('edit-sequence) (set! (-> self edit-mode) (anim-tester-edit-mode edit-sequence)) (set! *camera-read-buttons* #f) #f)
    (('save-sequences) (anim-tester-save-all-objects self))))

(defun anim-test-obj-list-handler ((cmd list-control-cmd) (ctrl list-control))
  "listfunc for the object list: one row per mesh added by anim-tester-add-object,
   marked with a * while it has unsaved sequence edits. X selects the object and
   re-enters the process on it, square closes the list. Always returns #f apart
   from the visible? command, which accepts every node."
  (let ((obj (the-as anim-test-obj (-> ctrl the-node)))
        (op cmd))
    (cond
      ;; (list-control-cmd draw-line)
      ((zero? op)
       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
                  (format (clear *temp-string*)
                          "~S~S~S"
                          (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
                          (if (logtest? (-> obj flags) (anim-test-obj-flags edited)) "*" " ")
                          (-> obj privname))
                  (draw-xy *temp-string*
                           dma-buff
                           (-> ctrl xpos)
                           (-> ctrl ypos)
                           (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
                           (font-flags shadow kerning)))))
      ((= op (list-control-cmd visible?)) (return #t))
      ((= op (list-control-cmd input))
       (cond
         ((cpad-pressed? 0 up) (if (> (-> ctrl highlight-index) 0) (+! (-> ctrl highlight-index) -1)))
         ;; this lets the highlight sit one past the end for a frame;
         ;; display-list-control pulls it back next time round
         ((cpad-pressed? 0 down)
          (if (< (-> ctrl highlight-index) (glst-num-elements (-> ctrl list))) (+! (-> ctrl highlight-index) 1)))
         ((cpad-pressed? 0 x)
          (let ((tester (the-as object (-> ctrl list-owner))))
            (set! (-> ctrl current-index) (-> ctrl the-index))
            (set! (-> (the-as anim-tester tester) current-obj) (-> obj privname)))
          (send-event (ppointer->process *anim-tester*) 'reset #f))
         ((cpad-pressed? 0 square)
          (logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons square))
          (logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square))
          (set! (-> *debug-menu-context* is-hidden) #f)
          (set! (-> *anim-tester* 0 edit-mode) (anim-tester-edit-mode none))
          (set! *camera-read-buttons* #t)
          (logior! (-> *anim-tester* 0 flags) (anim-tester-flags return-to-menu)))))
      ((= op (list-control-cmd measure))
       (let ((width (+ (length (-> obj privname)) 2)))
         (set! width
               (cond
                 ((< (-> *ANIM_TESTER-bank* OBJECT_LIST_MIN_WIDTH) width) (empty) width)
                 (else (-> *ANIM_TESTER-bank* OBJECT_LIST_MIN_WIDTH))))
         (set! (-> ctrl return-int) width)))
      ((= op (list-control-cmd draw-title))
       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "----pick-object---"
                                dma-buff
                                (-> ctrl xpos)
                                (-> ctrl ypos)
                                (font-color menu)
                                (font-flags shadow kerning))))))
  #f)

(defun anim-test-anim-list-handler ((cmd list-control-cmd) (ctrl list-control))
  "listfunc for the animation list: the entries of one object's sequence list that
   are still plain animations rather than named sequences, so up and down have to
   skip over the sequences. When the control's user-info is 1 this list is the
   picker inside the sequence editor and only moves its highlight; otherwise X
   selects the animation to play and clears the object's play-sequence flag."
  (let* ((seq (the-as anim-test-sequence (-> ctrl the-node)))
         (obj (-> seq parent)))
    (cond
      ;; (list-control-cmd draw-line)
      ((zero? cmd)
       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
                  (format (clear *temp-string*) "~S~S" (if (= (-> ctrl the-index) (-> ctrl highlight-index)) "> " "  ") (-> seq privname))
                  (draw-xy *temp-string*
                           dma-buff
                           (-> ctrl xpos)
                           (-> ctrl ypos)
                           (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
                           (font-flags shadow kerning)))))
      ((= cmd (list-control-cmd visible?)) (return (not (logtest? (-> seq flags) (anim-test-seq-flags sequence)))))
      ((= cmd (list-control-cmd input))
       (cond
         ((cpad-pressed? 0 up)
          (let ((list (-> ctrl list)))
            "is the list empty, #t = empty"
            (when (not (= (-> list tailpred) list))
              (let ((cur-node (the-as anim-test-sequence (glst-get-node-by-index (-> ctrl list) (-> ctrl highlight-index)))))
                (loop
                  "return the previous node in the list"
                  (set! cur-node (the-as anim-test-sequence (-> cur-node prev)))
                  (let ((node cur-node)) "is this node the start of the list. #t = start" (if (not (-> node prev)) (goto cfg-25)))
                  (when (not (logtest? (-> cur-node flags) (anim-test-seq-flags sequence)))
                    (set! (-> ctrl highlight-index) (glst-get-node-index (-> ctrl list) cur-node))
                    (goto cfg-25))))))
          (label cfg-25))
         ((cpad-pressed? 0 down)
          (let ((list (-> ctrl list)))
            "is the list empty, #t = empty"
            (when (not (= (-> list tailpred) list))
              (let ((cur-node (the-as anim-test-sequence (glst-get-node-by-index (-> ctrl list) (-> ctrl highlight-index)))))
                (loop
                  "return the next node in the list"
                  (set! cur-node (the-as anim-test-sequence (-> cur-node next)))
                  (let ((node cur-node)) "is this node the end of the list. #t = end" (if (not (-> node next)) (goto cfg-39)))
                  (when (not (logtest? (-> cur-node flags) (anim-test-seq-flags sequence)))
                    (set! (-> ctrl highlight-index) (glst-get-node-index (-> ctrl list) cur-node))
                    (goto cfg-39))))))
          (label cfg-39))
         ;; a picker inside the sequence editor only moves its highlight
         ((= (-> ctrl user-info) 1))
         (else
          (cond
            ((cpad-pressed? 0 x)
             (set! (-> ctrl current-index) (-> ctrl the-index))
             (set! (-> obj anim-index) (-> ctrl current-index))
             (set! (-> obj anim-hindex) (-> ctrl highlight-index))
             (logclear! (-> obj flags) (anim-test-obj-flags play-sequence))
             (send-event (ppointer->process *anim-tester*) 'change-anim #f))
            ((cpad-pressed? 0 square)
             (logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons square))
             (logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square))
             (set! (-> *debug-menu-context* is-hidden) #f)
             (set! (-> *anim-tester* 0 edit-mode) (anim-tester-edit-mode none))
             (set! *camera-read-buttons* #t)
             (logior! (-> *anim-tester* 0 flags) (anim-tester-flags return-to-menu)))))))
      ((= cmd (list-control-cmd measure))
       (let ((width (+ (length (-> seq privname)) 2)))
         (set! width
               (cond
                 ((< (-> *ANIM_TESTER-bank* ANIM_LIST_MIN_WIDTH) width) (empty) width)
                 (else (-> *ANIM_TESTER-bank* ANIM_LIST_MIN_WIDTH))))
         (set! (-> ctrl return-int) width)))
      ((= cmd (list-control-cmd draw-title))
       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "----pick-joint-anim----"
                                dma-buff
                                (-> ctrl xpos)
                                (-> ctrl ypos)
                                (font-color menu)
                                (font-flags shadow kerning))))))
  #f)

(defun anim-test-sequence-list-handler ((cmd list-control-cmd) (ctrl list-control))
  "listfunc for the sequence list: the named sequences of one object, so up and
   down skip the plain animations. X opens the sequence editor on the highlighted
   one and switches the object over to playing sequences."
  (let* ((seq (the-as anim-test-sequence (-> ctrl the-node)))
         (obj (-> seq parent)))
    (cond
      ;; (list-control-cmd draw-line)
      ((zero? cmd)
       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
                  (format (clear *temp-string*)
                          "~S~S~S"
                          (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
                          (if (logtest? (-> seq flags) (anim-test-seq-flags from-file)) "*" " ")
                          (-> seq privname))
                  (draw-xy *temp-string*
                           dma-buff
                           (-> ctrl xpos)
                           (-> ctrl ypos)
                           (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
                           (font-flags shadow kerning)))))
      ((= cmd (list-control-cmd visible?)) (return (logtest? (-> seq flags) (anim-test-seq-flags sequence))))
      ((= cmd (list-control-cmd input))
       (cond
         ((cpad-pressed? 0 up)
          (let ((list (-> ctrl list)))
            "is the list empty, #t = empty"
            (when (not (= (-> list tailpred) list))
              (let ((cur-node (the-as anim-test-sequence (glst-get-node-by-index (-> ctrl list) (-> ctrl highlight-index)))))
                (loop
                  "return the previous node in the list"
                  (set! cur-node (the-as anim-test-sequence (-> cur-node prev)))
                  (let ((node cur-node)) "is this node the start of the list. #t = start" (if (not (-> node prev)) (goto cfg-28)))
                  (when (logtest? (-> cur-node flags) (anim-test-seq-flags sequence))
                    (set! (-> ctrl highlight-index) (glst-get-node-index (-> ctrl list) cur-node))
                    (goto cfg-28))))))
          (label cfg-28))
         ((cpad-pressed? 0 down)
          (let ((list (-> ctrl list)))
            "is the list empty, #t = empty"
            (when (not (= (-> list tailpred) list))
              (let ((cur-node (the-as anim-test-sequence (glst-get-node-by-index (-> ctrl list) (-> ctrl highlight-index)))))
                (loop
                  "return the next node in the list"
                  (set! cur-node (the-as anim-test-sequence (-> cur-node next)))
                  (let ((node cur-node)) "is this node the end of the list. #t = end" (if (not (-> node next)) (goto cfg-42)))
                  (when (logtest? (-> cur-node flags) (anim-test-seq-flags sequence))
                    (set! (-> ctrl highlight-index) (glst-get-node-index (-> ctrl list) cur-node))
                    (goto cfg-42))))))
          (label cfg-42))
         ((cpad-pressed? 0 x)
          (set! (-> ctrl current-index) (-> ctrl the-index))
          (set! (-> obj seq-index) (-> ctrl current-index))
          (set! (-> obj seq-hindex) (-> ctrl highlight-index))
          (logior! (-> obj flags) (anim-test-obj-flags play-sequence))
          (set! (-> *anim-tester* 0 edit-mode) (anim-tester-edit-mode edit-sequence))
          (send-event (ppointer->process *anim-tester*) 'change-anim #f))
         ((cpad-pressed? 0 square)
          (logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons square))
          (logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square))
          (set! (-> *debug-menu-context* is-hidden) #f)
          (set! (-> *anim-tester* 0 edit-mode) (anim-tester-edit-mode none))
          (set! *camera-read-buttons* #t)
          (logior! (-> *anim-tester* 0 flags) (anim-tester-flags return-to-menu)))))
      ((= cmd (list-control-cmd measure))
       (let ((width (+ (length (-> seq privname)) 2)))
         (set! width
               (cond
                 ((< (-> *ANIM_TESTER-bank* PICK_LIST_MIN_WIDTH) width) (empty) width)
                 (else (-> *ANIM_TESTER-bank* PICK_LIST_MIN_WIDTH))))
         (set! (-> ctrl return-int) width)))
      ((= cmd (list-control-cmd draw-title))
       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "----pick-sequence---"
                                dma-buff
                                (-> ctrl xpos)
                                (-> ctrl ypos)
                                (font-color menu)
                                (font-flags shadow kerning))))))
  #f)

;; Where each editor column starts and how wide it is, in characters. The first
;; is the animation name, then speed, blend, first, last, the four flag letters
;; and the three letters of "MID": move, insert, delete.
(define anim-test-field-highlight-lw
  (new 'static
       'inline-array
       list-field
       12
       (new 'static 'list-field :left 2 :width 20)
       (new 'static 'list-field :left 30 :width 4)
       (new 'static 'list-field :left 35 :width 4)
       (new 'static 'list-field :left 40 :width 3)
       (new 'static 'list-field :left 44 :width 3)
       (new 'static 'list-field :left 48 :width 1)
       (new 'static 'list-field :left 49 :width 1)
       (new 'static 'list-field :left 50 :width 1)
       (new 'static 'list-field :left 51 :width 1)
       (new 'static 'list-field :left 53 :width 1)
       (new 'static 'list-field :left 54 :width 1)
       (new 'static 'list-field :left 55 :width 1)))

(defun anim-tester-adjust-frame ((frame float) (num-frames float))
  "Step a frame limit by one animation frame while the d-pad is held, and return
   it. -1.0 means \"min\" and -2.0 means \"max\": stepping up from min gives frame
   0 and stepping down from max gives the last real frame, while stepping past
   either end saturates back onto the sentinel."
  (cond
    ((cpad-hold? 0 down)
     (cond
       ((= frame -2.0) (set! frame (+ -1.0 num-frames)))
       ((!= frame -1.0) (set! frame (+ -1.0 frame)) (if (< frame 0.0) (set! frame (the-as float -1.0))))))
    ((cpad-hold? 0 up)
     (cond
       ((= frame -1.0) (set! frame (the-as float 0.0)))
       ((!= frame -2.0) (set! frame (+ 1.0 frame)) (if (>= frame num-frames) (set! frame (the-as float -2.0)))))))
  (the-as float frame))

(defun anim-tester-pick-item-setup ((item anim-test-seq-item) (seq anim-test-sequence))
  "Open the animation picker to the right of the sequence editor, highlighting the
   animation item currently plays. user-info 1 tells the shared animation handler
   that this is a picker, and editing-field makes the editor hand it the pad."
  (let ((obj (-> seq parent)))
    (set! (-> *anim-tester* 0 pick-con listfunc) anim-test-anim-list-handler)
    (set! (-> *anim-tester* 0 pick-con left)
          (+ (-> *ANIM_TESTER-bank* EDIT_LIST_X) (* (-> *ANIM_TESTER-bank* EDIT_PICK_X) (-> *DISP_LIST-bank* CHAR_WIDTH))))
    (set! (-> *anim-tester* 0 pick-con top) (-> *ANIM_TESTER-bank* EDIT_LIST_Y))
    (set! (-> *anim-tester* 0 pick-con list) (-> obj seq-list))
    (set! (-> *anim-tester* 0 pick-con list-owner) (the-as uint obj))
    (set! (-> *anim-tester* 0 pick-con user-info) 1)
    ;; walks the sequence list without doing anything with it
    (let ((list (-> obj seq-list)))
      "return the start of the list"
      (let ((cur-node (-> list head)))
        (while (let ((node cur-node)) "is this node the end of the list. #t = end" (not (not (-> node next))))
          "return the next node in the list"
          (set! cur-node (-> cur-node next)))))
    (let ((match (glst-find-node-by-name (-> obj seq-list) (-> item privname))))
      (when match
        (set! (-> *anim-tester* 0 pick-con highlight-index) (glst-get-node-index (-> obj seq-list) match))
        (set! (-> *anim-tester* 0 pick-con current-index) (-> *anim-tester* 0 pick-con highlight-index)))))
  (logior! (-> *anim-tester* 0 flags) (anim-tester-flags editing-field))
  (none))

(defun anim-test-seq-mark-as-edited ((seq anim-test-sequence))
  "Turn seq into a named sequence, if it was not one already, and mark its object
   as needing a save."
  (logior! (-> seq parent flags) (anim-test-obj-flags edited))
  (logior! (-> seq flags) (anim-test-seq-flags sequence))
  (none))

(defun anim-test-edit-seq-insert-item ((item anim-test-seq-item) (seq anim-test-sequence))
  "Insert a copy of item immediately in front of it. Copying the **END** row
   yields a \"--blank--\" placeholder instead, so inserting on the last row appends
   an empty one to fill in."
  (let ((new-item (new 'debug 'anim-test-seq-item 1 "")))
    (anim-test-seq-item-copy! new-item item)
    (when (logtest? (-> new-item flags) (anim-test-item-flags end))
      (logclear! (-> new-item flags) (anim-test-item-flags end))
      (logior! (-> new-item flags) (anim-test-item-flags blank))
      (let ((node new-item)) (set! (-> node privname) "--blank--")))
    (glst-insert-before (-> seq item-list) item new-item))
  (anim-test-seq-mark-as-edited seq)
  (send-event (ppointer->process *anim-tester*) 'change-anim)
  (none))

(defun anim-test-edit-sequence-list-handler ((cmd list-control-cmd) (ctrl list-control))
  "listfunc for the sequence editor: one row per item, with the columns of
   anim-test-item-field and the header \"-spd-blnd-1st-lst-flgs-mov-\".

   Left and right move item-field along the row, skipping the three unimplemented
   flag columns, and the highlighted column is drawn with a blue box behind it.
   X acts on that column: on the name it opens the animation picker, on a number
   it sets editing-field so up and down adjust the value (accelerating while
   held, via inc-delay), on the blend flag it toggles it, and on the last three
   it moves, inserts or deletes the row. The **END** row only accepts an insert."
  (let ((item (the-as anim-test-seq-item (-> ctrl the-node)))
        (seq (the-as anim-test-sequence (-> ctrl list-owner)))
        (picking? (and (logtest? (-> *anim-tester* 0 flags) (anim-tester-flags editing-field)) (zero? (-> *anim-tester* 0 item-field)))))
    (cond
      ;; (list-control-cmd draw-line)
      ((zero? cmd)
       (let ((font-ctx (new 'stack
                            'font-context
                            *font-default-matrix*
                            (-> ctrl xpos)
                            (-> ctrl ypos)
                            (the-as float 0.0)
                            (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
                            (font-flags shadow kerning))))
         (when (not picking?)
           (when (= (-> ctrl the-index) (-> ctrl highlight-index))
             (let* ((field-left (-> anim-test-field-highlight-lw (-> *anim-tester* 0 item-field) left))
                    (field-width (-> anim-test-field-highlight-lw (-> *anim-tester* 0 item-field) width))
                    (dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf))
                    (packet-start (-> dma-buff base)))
               (draw-sprite2d-xy dma-buff
                                 (+ (* field-left (-> *DISP_LIST-bank* CHAR_WIDTH)) 2 (-> ctrl xpos))
                                 (+ (-> ctrl ypos) -1)
                                 (+ (* field-width (-> *DISP_LIST-bank* CHAR_WIDTH)) 4)
                                 (+ (-> *DISP_LIST-bank* TV_SPACING) 1)
                                 (new 'static 'rgba :r #xc0 :g #xc0 :a #xff))
               (let ((packet-end (-> dma-buff base)))
                 (let ((packet (the-as dma-packet (-> dma-buff base))))
                   (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id next)))
                   (set! (-> packet vif0) (new 'static 'vif-tag))
                   (set! (-> packet vif1) (new 'static 'vif-tag))
                   (set! (-> dma-buff base) (&+ (the-as pointer packet) 16)))
                 (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
                                        (bucket-id debug)
                                        packet-start
                                        (the-as (pointer dma-tag) packet-end))))))
         (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
                      (let ((fmt format))
                        (fmt (clear *temp-string*)
                             "~S~S~-27S"
                             (if (= (-> ctrl the-index) (-> ctrl highlight-index)) ">" " ")
                             (if (= (-> ctrl the-index) (-> seq playing-item)) "*" " ")
                             (-> item privname)))
                      (draw-xy *temp-string*
                               dma-buff
                               (-> ctrl xpos)
                               (-> ctrl ypos)
                               (if (= (-> ctrl the-index) (-> ctrl current-index)) (font-color menu-flag-on) (font-color menu))
                               (font-flags shadow kerning))))
         (when (not picking?)
           (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (when (not (logtest? (-> item flags) (anim-test-item-flags end)))
                          (set-origin! font-ctx
                                       (+ (-> ctrl xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH)))
                                       (-> ctrl ypos))
                          (cond
                            ((and (< (-> item speed) 0) (< -100 (-> item speed)))
                             (let ((draw-adv draw-string-adv))
                               (let ((fmt format)
                                     (str (clear *temp-string*))
                                     (fmt-str "-0.~1d")
                                     (speed (abs (-> item speed))))
                                 (fmt str fmt-str (/ (mod speed 100) 10)))
                               (draw-adv *temp-string* dma-buff font-ctx)))
                            (else
                             (let ((draw-adv draw-string-adv))
                               (let ((fmt format)
                                     (str (clear *temp-string*))
                                     (fmt-str "~2d.~1d")
                                     (whole-speed (/ (-> item speed) 100))
                                     (speed (abs (-> item speed))))
                                 (fmt str fmt-str whole-speed (/ (mod speed 100) 10)))
                               (draw-adv *temp-string* dma-buff font-ctx))))
                          (let ((draw-adv draw-string-adv))
                            (format (clear *temp-string*) " ~4d" (-> item blend))
                            (draw-adv *temp-string* dma-buff font-ctx))
                          (anim-tester-disp-frame-num " " (-> item first-frame) (-> item artist-base) font-ctx)
                          (anim-tester-disp-frame-num " " (-> item last-frame) (-> item artist-base) font-ctx)
                          (let ((draw-adv draw-string-adv))
                            (format (clear *temp-string*)
                                    " ~S~S~S~S"
                                    (if (logtest? (-> item flags) (anim-test-item-flags wait-for-blend)) "B" "-")
                                    "-"
                                    "-"
                                    "-")
                            (draw-adv *temp-string* dma-buff font-ctx))) (let* ((field-left (-> anim-test-field-highlight-lw 9 left))
                               (ctx font-ctx)
                               (x (+ (-> ctrl xpos) (* field-left (-> *DISP_LIST-bank* CHAR_WIDTH))))
                               (y (-> ctrl ypos)))
                          (set! (-> ctx origin x) (the float x))
                          (set! (-> ctx origin y) (the float y))) (draw-string-adv "MID" dma-buff font-ctx)))))
      ((= cmd (list-control-cmd visible?)) (return #t))
      ((= cmd (list-control-cmd input))
       (cond
         ((logtest? (-> *anim-tester* 0 flags) (anim-tester-flags editing-field))
          (let ((field (-> *anim-tester* 0 item-field)))
            (cond
              ;; the name column
              ((zero? field)
               (cond
                 ((cpad-pressed? 0 x)
                  (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags editing-field))
                  (let ((picked-seq (the-as anim-test-sequence
                                            (glst-get-node-by-index (-> *anim-tester* 0 pick-con list) (-> *anim-tester* 0 pick-con highlight-index)))))
                    (when (and picked-seq
                               (let ((list (-> picked-seq item-list))) "is the list empty, #t = empty" (not (= (-> list tailpred) list))))
                      (let ((list (-> picked-seq item-list)))
                        "return the start of the list"
                        (let ((first-item (-> list head))) (anim-test-seq-item-copy! item (the-as anim-test-seq-item first-item))))
                      (anim-test-seq-mark-as-edited seq))))
                 ((cpad-pressed? 0 square) (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags editing-field)))))
              ((= field (anim-test-item-field move))
               (cond
                 ((not (cpad-hold? 0 x)) (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags editing-field)))
                 ((cpad-pressed? 0 up)
                  (let ((node item))
                    "return the previous node in the list"
                    (let* ((prev-item (-> node prev))
                           (prev-node prev-item))
                      "is this node the start of the list. #t = start"
                      (when (not (not (-> prev-node prev)))
                        (glst-remove (-> seq item-list) item)
                        (glst-insert-before (-> seq item-list) prev-item item)
                        (+! (-> ctrl current-index) -1)
                        (+! (-> ctrl highlight-index) -1)
                        (anim-test-seq-mark-as-edited seq)
                        (send-event (ppointer->process *anim-tester*) 'change-anim)))))
                 ((cpad-pressed? 0 down)
                  (let ((node item))
                    "return the next node in the list"
                    (let* ((next-item (the-as anim-test-seq-item (-> node next)))
                           (next-node next-item))
                      "is this node the end of the list. #t = end"
                      (when (and (not (not (-> next-node next))) (not (logtest? (-> next-item flags) (anim-test-item-flags end))))
                        (glst-remove (-> seq item-list) item)
                        (glst-insert-after (-> seq item-list) next-item item)
                        (+! (-> ctrl current-index) 1)
                        (+! (-> ctrl highlight-index) 1)
                        (anim-test-seq-mark-as-edited seq)
                        (send-event (ppointer->process *anim-tester*) 'change-anim)))))))
              ((or (= field (anim-test-item-field speed))
                   (= field (anim-test-item-field blend))
                   (= field (anim-test-item-field first-frame))
                   (= field (anim-test-item-field last-frame)))
               (cond
                 ((not (cpad-hold? 0 x)) (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags editing-field)))
                 ((begin
                    (set! (-> ctrl current-index) (-> ctrl the-index))
                    (<= (-> *anim-tester* 0 inc-timer) 0))
                  (if (> (-> *anim-tester* 0 inc-delay) 0) (+! (-> *anim-tester* 0 inc-delay) -1))
                  (set! (-> *anim-tester* 0 inc-timer) (-> *anim-tester* 0 inc-delay))
                  (case (-> *anim-tester* 0 item-field)
                    (((anim-test-item-field speed))
                     (cond
                       ((cpad-hold? 0 down)
                        (+! (-> item speed) -10)
                        (anim-test-seq-mark-as-edited seq)
                        (if (< (-> item speed) -300) (set! (-> item speed) -300)))
                       ((cpad-hold? 0 up)
                        (+! (-> item speed) 10)
                        (anim-test-seq-mark-as-edited seq)
                        (if (< 1000 (-> item speed)) (set! (-> item speed) 1000)))))
                    (((anim-test-item-field blend))
                     (cond
                       ((cpad-hold? 0 down)
                        (+! (-> item blend) -1)
                        (anim-test-seq-mark-as-edited seq)
                        (when (< (-> item blend) 0)
                          (set! (-> item blend) 0)
                          0))
                       ((cpad-hold? 0 up)
                        (+! (-> item blend) 1)
                        (anim-test-seq-mark-as-edited seq)
                        (if (< 9999 (-> item blend)) (set! (-> item blend) 9999)))))
                    (((anim-test-item-field first-frame))
                     (let ((old-first (-> item first-frame)))
                       (set! (-> item first-frame) (anim-tester-adjust-frame (-> item first-frame) (-> item num-frames)))
                       (if (!= old-first (-> item first-frame)) (anim-test-seq-mark-as-edited seq))))
                    (((anim-test-item-field last-frame))
                     (let ((old-last (-> item last-frame)))
                       (set! (-> item last-frame) (anim-tester-adjust-frame (-> item last-frame) (-> item num-frames)))
                       (if (!= old-last (-> item last-frame)) (anim-test-seq-mark-as-edited seq))))))
                 (else (+! (-> *anim-tester* 0 inc-timer) -1)))
               (when (or (cpad-pressed? 0 down) (cpad-pressed? 0 up))
                 (set! (-> *anim-tester* 0 inc-delay) (-> *DISP_LIST-bank* INC_DELAY))
                 (set! (-> *anim-tester* 0 inc-timer) 0)
                 0)))))
         (else
          (cond
            ((cpad-pressed? 0 up) (if (> (-> ctrl highlight-index) 0) (+! (-> ctrl highlight-index) -1)))
            ((cpad-pressed? 0 down)
             (if (< (-> ctrl highlight-index) (glst-num-elements (-> ctrl list))) (+! (-> ctrl highlight-index) 1)))
            ((cpad-pressed? 0 left)
             (+! (-> *anim-tester* 0 item-field) -1)
             (if (< (-> *anim-tester* 0 item-field) 0) (set! (-> *anim-tester* 0 item-field) (the-as int (anim-test-item-field delete))))
             (if (= (-> *anim-tester* 0 item-field) (anim-test-item-field unused-flag-3))
               (set! (-> *anim-tester* 0 item-field) (the-as int (anim-test-item-field blend-flag)))))
            ((cpad-pressed? 0 right)
             (+! (-> *anim-tester* 0 item-field) 1)
             (when (>= (-> *anim-tester* 0 item-field) 12)
               (set! (-> *anim-tester* 0 item-field) (the-as int (anim-test-item-field name)))
               0)
             (if (= (-> *anim-tester* 0 item-field) (anim-test-item-field unused-flag-1))
               (set! (-> *anim-tester* 0 item-field) (the-as int (anim-test-item-field move)))))
            ((cpad-pressed? 0 square)
             (logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons square))
             (logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons square))
             (set! (-> *anim-tester* 0 edit-mode) (anim-tester-edit-mode pick-sequence))
             (logior! (-> *anim-tester* 0 flags) (anim-tester-flags return-to-menu)))
            ((cpad-pressed? 0 x)
             (cond
               ((logtest? (-> item flags) (anim-test-item-flags end))
                (let ((field (-> *anim-tester* 0 item-field)))
                  (if (= field (anim-test-item-field insert)) (anim-test-edit-seq-insert-item item seq))))
               (else
                (let ((field (-> *anim-tester* 0 item-field)))
                  (cond
                    ;; the name column: open the animation picker
                    ((zero? field) (anim-tester-pick-item-setup item seq))
                    ((= field (anim-test-item-field insert)) (anim-test-edit-seq-insert-item item seq))
                    ((= field (anim-test-item-field delete))
                     (when (not (logtest? (-> item flags) (anim-test-item-flags end)))
                       (anim-test-seq-mark-as-edited seq)
                       (glst-remove (-> seq item-list) item))
                     (send-event (ppointer->process *anim-tester*) 'change-anim))
                    (else
                     (when (not (logtest? (-> item flags) (anim-test-item-flags blank)))
                       (case (-> *anim-tester* 0 item-field)
                         (((anim-test-item-field blend-flag))
                          (anim-test-seq-mark-as-edited seq)
                          (let ((new-flags (logxor (-> item flags) (anim-test-item-flags wait-for-blend))))
                            (set! (-> item flags) new-flags)
                            new-flags))
                         (((anim-test-item-field unused-flag-1)) (the-as int #f))
                         (((anim-test-item-field unused-flag-2)) (the-as int #f))
                         (((anim-test-item-field unused-flag-3)) (the-as int #f))
                         (else
                          (logior! (-> *anim-tester* 0 flags) (anim-tester-flags editing-field))
                          (set! (-> *anim-tester* 0 inc-delay) (-> *DISP_LIST-bank* INC_DELAY))
                          (set! (-> *anim-tester* 0 inc-timer) 0)
                          0)))))))))))))
      ((= cmd (list-control-cmd measure)) (set! (-> ctrl return-int) (-> *ANIM_TESTER-bank* EDIT_LIST_MIN_WIDTH)))
      ((= cmd (list-control-cmd draw-title))
       (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((draw-xy draw-string-xy))
                  (format (clear *temp-string*) "--Seq--(~-17S)--" (-> seq privname))
                  (draw-xy *temp-string* dma-buff (-> ctrl xpos) (-> ctrl ypos) (font-color menu) (font-flags shadow kerning))))
       (cond
         (picking? (display-list-control (-> *anim-tester* 0 pick-con)))
         (else
          (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "-spd-blnd-1st-lst-flgs-mov-"
                                      dma-buff
                                      (+ (-> ctrl xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH)))
                                      (-> ctrl ypos)
                                      (font-color menu)
                                      (font-flags shadow kerning))))))))
  #f)

(defbehavior anim-tester-interface anim-tester ()
  "Draw whichever list edit-mode selects, then remember it in old-mode. Prints an
   error where the list would go if the object or sequence it needs is gone."
  (let ((mode (-> self edit-mode)))
    (cond
      ;; (anim-tester-edit-mode none)
      ((zero? mode)
       (when (logtest? (-> *anim-tester* 0 flags) (anim-tester-flags return-to-menu))
         (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags return-to-menu))
         (set-master-mode 'menu)))
      ((= mode (anim-tester-edit-mode pick-object)) (display-list-control (-> self list-con)))
      ((= mode (anim-tester-edit-mode pick-joint-anim))
       (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
         (cond
           (obj
            (set! (-> obj list-con listfunc) anim-test-anim-list-handler)
            (set! (-> obj list-con current-index) (-> obj anim-index))
            (set! (-> obj list-con highlight-index) (-> obj anim-hindex))
            (display-list-control (-> obj list-con))
            (set! (-> obj anim-index) (-> obj list-con current-index))
            (set! (-> obj anim-hindex) (-> obj list-con highlight-index)))
           (else
            (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current object not found"
                                          dma-buff
                                          (-> *ANIM_TESTER-bank* ANIM_LIST_X)
                                          (-> *ANIM_TESTER-bank* ANIM_LIST_Y)
                                          (font-color menu-func-bad)
                                          (font-flags shadow kerning)))))))
      ((= mode (anim-tester-edit-mode pick-sequence))
       (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
         (cond
           (obj
            (set! (-> obj list-con listfunc) anim-test-sequence-list-handler)
            (set! (-> obj list-con current-index) (-> obj seq-index))
            (set! (-> obj list-con highlight-index) (-> obj seq-hindex))
            (display-list-control (-> obj list-con))
            (set! (-> obj seq-index) (-> obj list-con current-index))
            (set! (-> obj seq-hindex) (-> obj list-con highlight-index)))
           (else
            (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current object not found"
                                          dma-buff
                                          (-> *ANIM_TESTER-bank* ANIM_LIST_X)
                                          (-> *ANIM_TESTER-bank* ANIM_LIST_Y)
                                          (font-color menu-func-bad)
                                          (font-flags shadow kerning)))))))
      ((= mode (anim-tester-edit-mode edit-sequence))
       (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
         (cond
           (obj
            (let ((seq (the-as anim-test-sequence (glst-get-node-by-index (-> obj seq-list) (-> obj list-con current-index)))))
              (cond
                (seq (display-list-control (-> seq list-con)))
                (else
                 (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current sequence not found"
                                                    dma-buff
                                                    (-> *ANIM_TESTER-bank* EDIT_LIST_X)
                                                    (-> *ANIM_TESTER-bank* EDIT_LIST_Y)
                                                    (font-color menu-func-bad)
                                                    (font-flags shadow kerning)))))))
           (else
            (with-dma-buffer-add-bucket ((dma-buff (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy "ERROR: current object not found"
                                          dma-buff
                                          (-> *ANIM_TESTER-bank* EDIT_LIST_X)
                                          (-> *ANIM_TESTER-bank* EDIT_LIST_Y)
                                          (font-color menu-func-bad)
                                          (font-flags shadow kerning)))))))))
  (set! (-> self old-mode) (-> self edit-mode))
  (none))

(defun anim-tester-get-playing-item ((seq anim-test-sequence))
  "Return the row seq should play now, advancing playing-item past the **END** and
   \"--blank--\" rows and wrapping at the end of the list. Gives up and returns the
   unplayable row it started from if the whole list is unplayable."
  (let ((item ((the-as (function glst-list int anim-test-seq-item) glst-get-node-by-index) (-> seq item-list) (-> seq playing-item))))
    (let ((first-item item)
          (index (-> seq playing-item)))
      (when (logtest? (-> item flags) (anim-test-item-flags end blank))
        (loop
          (+! index 1)
          (if (>= index (glst-num-elements (-> seq item-list))) (set! index 0))
          (set! item ((the-as (function glst-list int anim-test-seq-item) glst-get-node-by-index) (-> seq item-list) index))
          (when (or (= item first-item) (not (logtest? (-> item flags) (anim-test-item-flags end blank))))
            (set! (-> seq playing-item) index)
            (return item)))))
    item))

;; Play the selected animation or sequence, over and over. Each pass round the
;; loop re-reads the selection, because the lists can change it at any time, and
;; complains to *stdcon* and waits a frame if there is nothing to play.
(defstate anim-tester-process (anim-tester)
  :event anim-tester-standard-event-handler
  :enter
    (behavior ()
      (logior! (-> self flags) (anim-tester-flags just-entered)))
  :trans
    (behavior ()
      (if (and (not (logtest? (-> self flags) (anim-tester-flags just-entered))) (= *master-mode* 'menu)) (anim-tester-interface))
      (logclear! (-> self flags) (anim-tester-flags just-entered))
      (when (!= *master-mode* 'menu)
        (debug-print-channels (-> self skel) (the-as symbol *stdcon*))
        (add-debug-x #t (bucket-id debug-no-zbuf) (-> self root trans) (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80))))
  :code
    (behavior ()
      ;; obj, seq and item are the object, sequence and row being played; the cond
      ;; below picks them up one level at a time, so a failure at any level falls
      ;; through to the message for that level.
      (local-vars (obj anim-test-obj) (item anim-test-seq-item) (seq anim-test-sequence))
      (loop
        (logclear! (-> self flags) (anim-tester-flags anim-playing))
        (let ((obj-list (-> self obj-list)))
          "is the list empty, #t = empty"
          (cond
            ((= (-> obj-list tailpred) obj-list)
             (format *stdcon* "anim-tester:no objects loaded~%")
             (set! (-> self list-con current-index) 0)
             (set! (-> self current-obj) "")
             (suspend)
             0)
            ((begin
               (set! obj (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj))))
               (when (not obj)
                 (if (>= (-> self list-con current-index) (glst-num-elements (-> self obj-list)))
                   (set! (-> self list-con current-index) (+ (glst-num-elements (-> self obj-list)) -1)))
                 (set! obj (the-as anim-test-obj (glst-get-node-by-index (-> self obj-list) (-> self list-con current-index))))
                 (set! (-> self current-obj) (-> obj privname)))
               (let ((seq-list (-> obj seq-list))) "is the list empty, #t = empty" (= (-> seq-list tailpred) seq-list)))
             (format *stdcon* "anim-tester:no anims loaded~%")
             (format *stdcon* "displaying without anim not yet implement~%")
             (logclear! (-> self flags) (anim-tester-flags anim-playing))
             (suspend)
             0)
            ((begin
               (if (>= (-> obj list-con current-index) (glst-num-elements (-> obj seq-list)))
                 (set! (-> obj list-con current-index) (+ (glst-num-elements (-> obj seq-list)) -1)))
               (set! seq
                     (the-as anim-test-sequence
                             (glst-get-node-by-index (-> obj seq-list)
                                                     (if (logtest? (-> obj flags) (anim-test-obj-flags play-sequence)) (-> obj seq-index) (-> obj anim-index)))))
               (let ((item-list (-> seq item-list))) "is the list empty, #t = empty" (= (-> item-list tailpred) item-list)))
             (format *stdcon* "anim-tester:no items in sequence ~A~%" (-> seq privname))
             (format *stdcon* "displaying without anim not yet implement~%")
             (suspend)
             0)
            ((begin
               (when (>= (-> seq playing-item) (glst-num-elements (-> seq item-list)))
                 (set! (-> seq playing-item) 0)
                 0)
               (set! item (anim-tester-get-playing-item seq))
               item)
             (let ((anim (the-as art-joint-anim (lookup-art (-> obj obj-art-group) (-> item privname) art-joint-anim))))
               (anim-tester-update-anim-info item)
               (cond
                 (anim
                  (logior! (-> self flags) (anim-tester-flags anim-playing))
                  ;; a row with a blend length pushes a channel so the previous
                  ;; animation blends out; the length scales with the global speed
                  (if (nonzero? (-> item blend))
                    (ja-channel-push! 1 (the-as time-frame (the int (* (the float (-> item blend)) (-> self anim-gspeed)))))
                    (ja-channel-set! 1))
                  (cond
                    ((= (-> self anim-first) -1.0) (ja :group! anim :num! min))
                    ((= (-> self anim-first) -2.0) (ja :group! anim :num! max))
                    (else (ja :group! anim :num! (identity (-> self anim-first)))))
                  ;; wait-for-blend holds the sequence here until the pushed
                  ;; channel has finished blending in
                  (when (nonzero? (-> item blend))
                    (while (and (!= (-> self skel root-channel 0) (-> self skel channel))
                                (logtest? (-> item flags) (anim-test-item-flags wait-for-blend)))
                      (when (logtest? (-> self flags) (anim-tester-flags at-apply-align))
                        (compute-alignment! (-> self align))
                        (align! (-> self align)
                                (align-opts adjust-x-vel adjust-y-vel adjust-xz-vel keep-other-velocities adjust-quat)
                                (the-as float 1.0)
                                (the-as float 1.0)
                                (the-as float 1.0)))
                      (suspend)))
                  (until (ja-done? 0)
                    (when (logtest? (-> self flags) (anim-tester-flags at-apply-align))
                      (compute-alignment! (-> self align))
                      (align! (-> self align)
                              (align-opts adjust-x-vel adjust-y-vel adjust-xz-vel keep-other-velocities adjust-quat)
                              (the-as float 1.0)
                              (the-as float 1.0)
                              (the-as float 1.0)))
                    (suspend)
                    (anim-tester-update-anim-info item)
                    ;; seek towards anim-last, which is either the end of the
                    ;; animation, frame 0, or a real frame number
                    (let ((to-max? (= (-> self anim-last) -2.0)))
                      (cond
                        ((or to-max? (>= (-> self anim-last) (-> self anim-first)))
                         (if (= (-> self anim-last) -2.0)
                           (ja :num! (seek! max (-> self anim-speed)))
                           (ja :num! (seek! (-> self anim-last) (-> self anim-speed)))))
                        ((= (-> self anim-last) -1.0) (ja :num! (seek! 0.0 (-> self anim-speed))))
                        (else (ja :num! (seek! (-> self anim-last) (-> self anim-speed)))))))
                  (+! (-> seq playing-item) 1))
                 (else (format *stdcon* "anim ~A not found~%" (-> item privname)) (suspend) 0))))
            (else (format *stdcon* "no anims~%") (suspend) 0)))))
  :post anim-tester-post)

(defbehavior initialize-anim-tester anim-tester ()
  "Set up the tester process: an empty object list, the object list control, a
   24-channel joint control and an align control, and a position 10 metres in
   front of the camera. Clears the menu process mask so the tester keeps running
   while the debug menu is up."
  (glst-init-list! (-> self obj-list))
  (logclear! (-> self mask) (process-mask menu))
  (set! (-> self speed) 100)
  (set! (-> self current-obj) "")
  (set! (-> self root) (new 'process 'trsqv))
  (set! (-> self draw) (new 'process 'draw-control self (the-as art-joint-geo #f)))
  (set! (-> self draw dma-add-func) dma-add-process-drawable)
  (set! (-> self skel) (new 'process 'joint-control 24))
  (set! (-> self align) (new 'process 'align-control self))
  (set! (-> self list-con listfunc) anim-test-obj-list-handler)
  (set! (-> self list-con left) (-> *ANIM_TESTER-bank* OBJECT_LIST_X))
  (set! (-> self list-con top) (-> *ANIM_TESTER-bank* OBJECT_LIST_Y))
  (set! (-> self list-con list) (-> self obj-list))
  (set! (-> self list-con list-owner) (the-as uint self))
  (quaternion-identity! (-> self root quat))
  (vector-identity! (-> self root scale))
  (position-in-front-of-camera! (-> self root trans) (the-as float 40960.0) (the-as float 4096.0))
  (set! (-> self event-hook) anim-tester-standard-event-handler)
  (anim-tester-reset)
  (go anim-tester-process)
  (none))

(defun anim-tester-string-get-frame!! ((out list-field) (str string))
  "Parse the next argument of str as a frame number into (-> out left), accepting
   \"min\" and \"max\" in either case as the -1 and -2 sentinels. Returns #f, leaving
   out alone, when str holds no argument."
  (cond
    ((string-get-arg!! *temp-string* str)
     (cond
       ((or (string= *temp-string* "max") (string= *temp-string* "MAX")) (set! (-> out left) -2))
       ((or (string= *temp-string* "min") (string= *temp-string* "MIN")) (set! (-> out left) -1))
       (else (set! (-> out left) (string->int *temp-string*))))
     #t)
    (else #f)))

(defun anim-tester-load-object-seqs ((tester anim-tester) (name string))
  "Read data/<name>.obinf back into tester. Not implemented: it returns #f, so
   from-file is never set and edited sequences do not survive a restart."
  #f)

(defun anim-tester-save-object-seqs ((obj anim-test-obj))
  "Write obj's sequences to data/<object>.obinf as text: one Anim or Sequence
   block per entry of the sequence list, one Item line per row inside it, and the
   whole thing wrapped in Object/EndObject. The **END** and \"--blank--\" rows are
   skipped, and from-file is cleared on everything written."
  (let ((fmt format)
        (dest 0)
        (fmt-str "saving object ~s to ~s~%")
        (name (-> obj privname)))
    (format (clear *temp-string*) "data/~s.obinf" (-> obj privname))
    (fmt dest fmt-str name *temp-string*))
  ;; og:preserve-this hack
  (let ((file (new 'stack 'file-stream (string-format "data/~s.obinf" (-> obj privname)) 'write)))
    (format file "major-version 0~%")
    (format file "minor-version 0~%")
    (format file "Object \"~S\" ~d~%" (-> obj privname) 0)
    (let ((seq-list (-> obj seq-list)))
      "return the start of the list"
      (let ((cur-seq (the-as anim-test-sequence (-> seq-list head))))
        (while (let ((sequence-node cur-seq)) "is this node the end of the list. #t = end" (not (not (-> sequence-node next))))
          (logclear! (-> cur-seq flags) (anim-test-seq-flags from-file))
          (format file
                  "  ~S \"~S\" ~d~%"
                  (if (logtest? (-> cur-seq flags) (anim-test-seq-flags sequence)) "Sequence" "Anim")
                  (-> cur-seq privname)
                  0)
          (let ((item-list (-> cur-seq item-list)))
            "return the start of the list"
            (let ((cur-item (the-as anim-test-seq-item (-> item-list head))))
              (while (let ((item-node cur-item)) "is this node the end of the list. #t = end" (not (not (-> item-node next))))
                (when (not (logtest? (-> cur-item flags) (anim-test-item-flags end blank)))
                  (format file "    Item \"~S\" ~d ~d " (-> cur-item privname) (-> cur-item speed) (-> cur-item blend))
                  (anim-tester-num-print file (-> cur-item first-frame))
                  (format file " ")
                  (anim-tester-num-print file (-> cur-item last-frame))
                  (format file " ~S~%" (if (logtest? (-> cur-item flags) (anim-test-item-flags wait-for-blend)) "B" "-")))
                "return the next node in the list"
                (set! cur-item (the-as anim-test-seq-item (-> cur-item next))))))
          (format file "  ~S~%" (if (logtest? (-> cur-seq flags) (anim-test-seq-flags sequence)) "EndSequence" "EndAnim"))
          "return the next node in the list"
          (set! cur-seq (the-as anim-test-sequence (-> cur-seq next))))))
    (format file "EndObject~%")
    (file-stream-close file)))

(defun anim-tester-save-all-objects ((tester anim-tester))
  "Write out every object marked edited and clear the flag. Always returns #f."
  (let ((obj-list (-> tester obj-list)))
    "return the start of the list"
    (let ((cur-obj (the-as anim-test-obj (-> obj-list head))))
      (while (let ((node cur-obj)) "is this node the end of the list. #t = end" (not (not (-> node next))))
        (when (logtest? (-> cur-obj flags) (anim-test-obj-flags edited))
          (logclear! (-> cur-obj flags) (anim-test-obj-flags edited))
          (anim-tester-save-object-seqs cur-obj))
        "return the next node in the list"
        (set! cur-obj (the-as anim-test-obj (-> cur-obj next))))))
  #f)

(defun anim-tester-add-newobj ((tester anim-tester) (name string) (ag art-group))
  "Add the contents of art group ag to the object list.

   The group is scanned in order. Its first merc-ctrl becomes the object, named
   after that element; its first art-joint-geo becomes the object's skeleton; and
   every art-joint-anim becomes one of the object's sequences, holding a single
   row whose length and artist-base come from the animation itself. One group
   therefore yields one object, however many meshes it holds.

   A sequence already on the list is kept and only marked anim-present, so
   reloading a group preserves hand-built playlists; whatever is left unmarked
   afterwards is dropped by anim-test-obj-remove-invalid. Selects the object and
   restarts the tester on it. name is unused - the names come out of ag."
  (let ((obj (the-as anim-test-obj #f))
        (first-obj (the-as anim-test-obj #f)))
    (let ((jgeo-elt (the-as art-element #f))
          (found? (the-as structure #f)))
      (dotimes (idx (-> ag length))
        (cond
          ((and (= (-> ag data idx type) merc-ctrl) (not obj))
           (let ((mesh-elt (-> ag data idx)))
             (set! found? (and obj found?))
             (if found? (anim-test-obj-remove-invalid obj))
             (anim-tester-load-object-seqs tester (-> mesh-elt name))
             (set! obj (the-as anim-test-obj (glst-find-node-by-name (-> tester obj-list) (-> mesh-elt name))))
             (set! found? (if obj #t #f))
             (cond
               ((the-as symbol found?))
               (else (set! obj (new 'global 'anim-test-obj 1 (-> mesh-elt name) ag)) (glst-add-tail (-> tester obj-list) obj)))
             (anim-test-obj-init obj (the-as list-control tester))
             (set! (-> obj obj-art-group) ag)
             (set! (-> obj mesh-geo) (the-as merc-ctrl mesh-elt)))
           (set! (-> obj joint-geo) (the-as art-joint-geo jgeo-elt))
           (if (not first-obj) (set! first-obj obj)))
          ((= (-> ag data idx type) art-joint-geo)
           (if (and obj (not (-> obj joint-geo))) (set! (-> obj joint-geo) (the-as art-joint-geo (-> ag data idx))))
           (if (not jgeo-elt) (set! jgeo-elt (-> ag data idx))))
          ((= (-> ag data idx type) art-joint-anim)
           (when obj
             (let* ((anim-elt (-> ag data idx))
                    (seq (the-as anim-test-sequence (glst-find-node-by-name (-> obj seq-list) (-> anim-elt name)))))
               (when (not seq)
                 (set! seq (new 'debug 'anim-test-sequence 1 (-> anim-elt name)))
                 (glst-add-tail (-> obj seq-list) seq)
                 (anim-test-sequence-init seq obj)
                 (let ((item (new 'debug 'anim-test-seq-item 1 (-> anim-elt name)))) (glst-add-tail (-> seq item-list) item)))
               (set! (-> seq parent) obj)
               (set! (-> seq flags) (logior (-> seq flags) (anim-test-seq-flags anim-present)))
               (let ((item-list (-> seq item-list)))
                 "is the list empty, #t = empty"
                 (when (not (= (-> item-list tailpred) item-list))
                   (let ((list (-> seq item-list)))
                     "return the start of the list"
                     (let ((first-item (the-as anim-test-seq-item (-> list head))))
                       (set! (-> first-item num-frames) (the float (-> (the-as art-joint-anim anim-elt) data 0 length)))
                       (set! (-> first-item artist-base) (-> (the-as art-joint-anim anim-elt) artist-base))
                       (set! (-> first-item parent) seq)))
                   seq)))))
          (else))))
    (if obj (anim-test-obj-remove-invalid obj))
    (when first-obj
      (set! (-> tester current-obj) (-> first-obj privname))
      (set! (-> tester list-con current-index) (glst-get-node-index (-> tester obj-list) first-obj))))
  (send-event tester 'reset #f))

(defun anim-tester-stop ()
  "Kill the tester process, if it is running."
  (when *anim-tester*
    (kill-by-name 'anim-tester *active-pool*)
    (set! *anim-tester* (the-as (pointer anim-tester) #f))
    #f))

(defun anim-tester-start ()
  "Restart the tester with an empty object list and point the orbit camera at it."
  (anim-tester-stop)
  (set! *anim-tester* (process-spawn anim-tester :init initialize-anim-tester :from *16k-dead-pool*))
  (set! *camera-orbit-target* *anim-tester*)
  (send-event *camera* 'change-state cam-orbit 0)
  #f)

(defun anim-tester-add-object ((name string))
  "Load art group name into the global heap and add it to the tester, starting the
   tester first if it is not running. Prints an error if the group is not found."
  (let ((ag (load-to-heap-by-name (-> *level* level-default art-group) name #t global 0)))
    (cond
      (ag
       (if (not *anim-tester*) (anim-tester-start))
       (if *anim-tester* (anim-tester-add-newobj (the-as anim-tester (ppointer->process *anim-tester*)) name ag)))
      (else (format 0 "ERROR:no object (~A)n" name))))
  (none))

(defun anim-tester-set-name ((name string))
  "Rename the selected sequence of the selected object to name. Refuses names that
   another sequence of the same object already uses, and only works on a named
   sequence, not on a plain animation."
  (cond
    ((zero? (length name)) (format #t "ERROR: no name~%"))
    ((and *anim-tester*
          (let ((obj-list (-> *anim-tester* 0 obj-list)))
            "is the list empty, #t = empty"
            (not (= (-> obj-list tailpred) obj-list))))
     (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> *anim-tester* 0 obj-list) (-> *anim-tester* 0 current-obj)))))
       (cond
         (obj
          (let ((seq (the-as anim-test-sequence (glst-get-node-by-index (-> obj seq-list) (-> obj list-con current-index)))))
            (cond
              (seq
               (cond
                 ((logtest? (-> seq flags) (anim-test-seq-flags sequence))
                  (let ((old-name (the-as object (-> seq privname))))
                    (let ((node seq)) (set! (-> node privname) ""))
                    (cond
                      ((glst-find-node-by-name (-> obj seq-list) name)
                       (format #t "ERROR: another sequence is already using that name (~S)~%" name)
                       (set! (-> seq privname) (the-as string old-name)))
                      (else (set! old-name name) (set! (-> seq privname) (the-as string old-name))))
                    old-name))
                 (else (format #t "ERROR: no sequence selected~%"))))
              (else (format #t "ERROR: no sequence selected~%")))))
         (else (format #t "ERROR:no object selected~%")))))
    (else (format #t "ERROR:no object loaded~%"))))

(defun anim-tester-add-sequence ((name string))
  "Create an empty named sequence on the selected object and open the editor on
   it. If the name is already taken the existing sequence is opened instead. A new
   sequence starts with just its **END** row."
  (cond
    ((zero? (length name)) (format #t "ERROR: no name~%"))
    ((and *anim-tester*
          (let ((obj-list (-> *anim-tester* 0 obj-list)))
            "is the list empty, #t = empty"
            (not (= (-> obj-list tailpred) obj-list))))
     (let ((obj (the-as anim-test-obj (glst-find-node-by-name (-> *anim-tester* 0 obj-list) (-> *anim-tester* 0 current-obj)))))
       (cond
         (obj
          (let ((existing (glst-find-node-by-name (-> obj seq-list) name)))
            (cond
              (existing
               (format #t "ERROR: there is already a sequence with the name ~S~%" name)
               (set! (-> obj list-con current-index) (glst-get-node-index (-> obj seq-list) existing))
               (send-event (ppointer->process *anim-tester*) 'edit-sequence))
              (else
               (let ((seq (new 'global 'anim-test-sequence 1 name)))
                 (glst-add-tail (-> obj seq-list) seq)
                 (set! (-> seq list-con listfunc) anim-test-edit-sequence-list-handler)
                 (set! (-> seq list-con left) (-> *ANIM_TESTER-bank* EDIT_LIST_X))
                 (set! (-> seq list-con top) (-> *ANIM_TESTER-bank* EDIT_LIST_Y))
                 (set! (-> seq list-con list) (-> seq item-list))
                 (set! (-> seq list-con list-owner) (the-as uint seq))
                 (set! (-> seq parent) obj)
                 (anim-test-seq-mark-as-edited seq)
                 (logior! (-> seq flags) (anim-test-seq-flags sequence))
                 (set! (-> obj list-con current-index) (glst-get-node-index (-> obj seq-list) seq))
                 (set! (-> obj seq-index) (-> obj list-con current-index))
                 (set! (-> obj seq-hindex) (-> obj list-con current-index))
                 (let ((end-item (new 'debug 'anim-test-seq-item 1 "**END**")))
                   (logior! (-> end-item flags) (anim-test-item-flags end))
                   (glst-add-tail (-> seq item-list) end-item)
                   (set! (-> end-item parent) seq)))
               (send-event (ppointer->process *anim-tester*) 'edit-sequence)))))
         (else (format #t "ERROR:no object selected~%")))))
    (else (format #t "ERROR:no object loaded~%")))
  (none))