mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-06-22 09:05:44 -04:00
Code Issues Packages Projects Releases Wiki Activity
Files
48cb9bb7871c8d566176ededec42327c3dfd6086
jak-project/goal_src/jak1/engine/debug/anim-tester.gc
T

1714 lines
90 KiB
Common Lisp
Raw Blame History

;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/util/glist-h.gc")
(require "engine/anim/aligner.gc")
;; NOTES - removed one of the 2 inspects
;; - also fixed up a basic file-stream constructor on the stack
(declare-type list-control structure)
(define-extern anim-test-anim-list-handler (function int list-control symbol))
(define-extern anim-test-edit-sequence-list-handler (function int list-control symbol))
(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
(fanimt0)
(fanimt1)
(fanimt2)
(fanimt3)
(fanimt4)
(fanimt5))
;; DECOMP BEGINS
;; this file is debug only
(declare-file (debug))
(deftype list-control (structure)
((listfunc (function int list-control symbol))
(list-owner uint32)
(top int32)
(left int32)
(list glst-list)
(the-node glst-node)
(top-index int32)
(the-index int32)
(the-disp-line int32)
(highlight-index int32)
(current-index int32)
(numlines int32)
(lines-to-disp int32)
(charswide int32)
(highlight-disp-line int32)
(field-id int32)
(xpos int32)
(ypos int32)
(user-info int32)
(user-info-u uint32 :overlay-at user-info)
(return-int int32))
:allow-misaligned)
(deftype list-field (structure)
((left int32)
(width int32)))
(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)
(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 ((arg0 list-control))
(when (< (-> arg0 current-index) 0)
(set! (-> arg0 current-index) 0)
0)
(if (>= (-> arg0 current-index) (glst-num-elements (-> arg0 list))) (set! (-> arg0 current-index) -1))
(when (< (-> arg0 highlight-index) 0)
(set! (-> arg0 highlight-index) 0)
0)
(if (>= (-> arg0 highlight-index) (glst-num-elements (-> arg0 list)))
(set! (-> arg0 highlight-index) (+ (glst-num-elements (-> arg0 list)) -1)))
(set! (-> arg0 the-index) (-> arg0 highlight-index))
(set! (-> arg0 the-node) (glst-get-node-by-index (-> arg0 list) (-> arg0 highlight-index)))
(when (not ((-> arg0 listfunc) 1 arg0))
(set! (-> arg0 the-index) 0)
(let ((v1-12 (-> arg0 list))) "return the start of the list" (set! (-> arg0 the-node) (-> v1-12 head)))
(while (let ((v1-22 (-> arg0 the-node))) "is this node the end of the list. #t = end" (not (not (-> v1-22 next))))
(when ((-> arg0 listfunc) 1 arg0)
(set! (-> arg0 highlight-index) (-> arg0 the-index))
(goto cfg-18))
(+! (-> arg0 the-index) 1)
(let ((v1-20 (-> arg0 the-node))) "return the next node in the list" (set! (-> arg0 the-node) (-> v1-20 next))))
(set! (-> arg0 highlight-index) 0)
0)
(label cfg-18)
(set! (-> arg0 the-index) (-> arg0 highlight-index))
(set! (-> arg0 the-node) (glst-get-node-by-index (-> arg0 list) (-> arg0 the-index)))
((-> arg0 listfunc) 4 arg0)
(let ((s5-2 #f)
(s4-0 #f))
(set! (-> arg0 numlines) 0)
(set! (-> arg0 charswide) 0)
(set! (-> arg0 the-index) 0)
(set! (-> arg0 the-disp-line) 0)
(let ((v1-29 (-> arg0 list))) "return the start of the list" (set! (-> arg0 the-node) (-> v1-29 head)))
(while (let ((v1-52 (-> arg0 the-node))) "is this node the end of the list. #t = end" (not (not (-> v1-52 next))))
(when ((-> arg0 listfunc) 1 arg0)
(if (and (not s5-2) (>= (-> arg0 the-index) (-> arg0 top-index))) (set! s5-2 #t))
(when (and (not s4-0) (>= (-> arg0 the-index) (-> arg0 highlight-index)))
(set! s4-0 #t)
(set! (-> arg0 highlight-disp-line) (-> arg0 the-disp-line)))
((-> arg0 listfunc) 2 arg0)
(if (< (-> arg0 charswide) (-> arg0 return-int)) (set! (-> arg0 charswide) (-> arg0 return-int)))
(if s5-2 (+! (-> arg0 the-disp-line) 1))
(+! (-> arg0 numlines) 1))
(+! (-> arg0 the-index) 1)
(let ((v1-50 (-> arg0 the-node))) "return the next node in the list" (set! (-> arg0 the-node) (-> v1-50 next)))))
(set! (-> arg0 lines-to-disp)
(if (< (-> *DISP_LIST-bank* MAX_LINES) (-> arg0 numlines)) (-> *DISP_LIST-bank* MAX_LINES) (-> arg0 numlines)))
(if (> (-> arg0 lines-to-disp) 0) (-> arg0 lines-to-disp) 1)
(let* ((s4-1 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s5-3 (-> s4-1 base)))
(draw-sprite2d-xy s4-1
(-> arg0 left)
(-> arg0 top)
(+ (* (-> arg0 charswide) (-> *DISP_LIST-bank* CHAR_WIDTH)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
(+ (* (+ (-> arg0 lines-to-disp) 1) (-> *DISP_LIST-bank* TV_SPACING)) (* (-> *DISP_LIST-bank* BORDER_WIDTH) 2))
(new 'static 'rgba :a #x40))
(let ((a3-6 (-> s4-1 base)))
(let ((v1-72 (the-as object (-> s4-1 base))))
(set! (-> (the-as dma-packet v1-72) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-72) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-72) vif1) (new 'static 'vif-tag))
(set! (-> s4-1 base) (&+ (the-as pointer v1-72) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s5-3
(the-as (pointer dma-tag) a3-6))))
(set! (-> arg0 xpos) (+ (-> arg0 left) (-> *DISP_LIST-bank* BORDER_WIDTH)))
(set! (-> arg0 ypos) (+ (-> arg0 top) (-> *DISP_LIST-bank* BORDER_HEIGHT)))
((-> arg0 listfunc) 3 arg0)
(cond
((> (-> arg0 lines-to-disp) 0)
(cond
((< (-> arg0 highlight-disp-line) (-> *DISP_LIST-bank* BORDER_LINES))
(let ((s5-4 (- (-> *DISP_LIST-bank* BORDER_LINES) (-> arg0 highlight-disp-line))))
(set! (-> arg0 the-node) (glst-get-node-by-index (-> arg0 list) (-> arg0 top-index)))
(set! (-> arg0 the-index) (-> arg0 top-index))
(let ((v1-88 (-> arg0 the-node)))
"is this node the start of the list. #t = start"
(when (not (not (-> v1-88 prev)))
(loop
(let ((v1-92 (-> arg0 the-node)))
"return the previous node in the list"
(let ((v1-93 (-> v1-92 prev)))
(let ((a0-41 v1-93)) "is this node the start of the list. #t = start" (if (not (-> a0-41 prev)) (goto cfg-61)))
(set! (-> arg0 the-node) v1-93)))
(+! (-> arg0 the-index) -1)
(when ((-> arg0 listfunc) 1 arg0)
(set! (-> arg0 top-index) (-> arg0 the-index))
(+! s5-4 -1)
(if (<= s5-4 0) (goto cfg-61)))))))
(label cfg-61))
((>= (-> arg0 highlight-disp-line) (- (-> *DISP_LIST-bank* MAX_LINES) (-> *DISP_LIST-bank* BORDER_LINES)))
(let ((s5-5 (- (-> arg0 highlight-disp-line) (- (-> *DISP_LIST-bank* MAX_LINES) (-> *DISP_LIST-bank* BORDER_LINES)))))
(set! (-> arg0 the-node) (glst-get-node-by-index (-> arg0 list) (-> arg0 top-index)))
(set! (-> arg0 the-index) (-> arg0 top-index))
(let ((v1-107 (-> arg0 the-node)))
"is this node the end of the list. #t = end"
(when (not (not (-> v1-107 next)))
(loop
(let ((v1-111 (-> arg0 the-node)))
"return the next node in the list"
(let ((v1-112 (-> v1-111 next)))
(let ((a0-55 v1-112)) "is this node the end of the list. #t = end" (if (not (-> a0-55 next)) (goto cfg-77)))
(set! (-> arg0 the-node) v1-112)))
(+! (-> arg0 the-index) 1)
(when ((-> arg0 listfunc) 1 arg0)
(set! (-> arg0 top-index) (-> arg0 the-index))
(+! s5-5 -1)
(if (<= s5-5 0) (goto cfg-77)))))))))
(label cfg-77)
(set! (-> arg0 the-disp-line) 0)
(set! (-> arg0 the-index) (-> arg0 top-index))
(set! (-> arg0 the-node) (glst-get-node-by-index (-> arg0 list) (-> arg0 top-index)))
(while (let ((v1-135 (-> arg0 the-node)))
"is this node the end of the list. #t = end"
(not (or (not (-> v1-135 next)) (>= (-> arg0 the-disp-line) (-> *DISP_LIST-bank* MAX_LINES)))))
(when ((-> arg0 listfunc) 1 arg0)
(set! (-> arg0 xpos) (+ (-> arg0 left) (-> *DISP_LIST-bank* BORDER_WIDTH)))
(set! (-> arg0 ypos)
(+ (-> arg0 top) (-> *DISP_LIST-bank* BORDER_HEIGHT) (* (+ (-> arg0 the-disp-line) 1) (-> *DISP_LIST-bank* TV_SPACING))))
((-> arg0 listfunc) 0 arg0)
(+! (-> arg0 the-disp-line) 1))
(+! (-> arg0 the-index) 1)
(let ((v1-133 (-> arg0 the-node))) "return the next node in the list" (set! (-> arg0 the-node) (-> v1-133 next)))))
(else
(let* ((s4-2 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s5-6 (-> s4-2 base)))
(draw-string-xy "**NONE**"
s4-2
(+ (-> arg0 left) (-> *DISP_LIST-bank* BORDER_WIDTH))
(+ (-> arg0 top) (-> *DISP_LIST-bank* BORDER_HEIGHT) (-> *DISP_LIST-bank* TV_SPACING))
(font-color menu)
(font-flags shadow kerning))
(let ((a3-12 (-> s4-2 base)))
(let ((v1-147 (the-as object (-> s4-2 base))))
(set! (-> (the-as dma-packet v1-147) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-147) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-147) vif1) (new 'static 'vif-tag))
(set! (-> s4-2 base) (&+ (the-as pointer v1-147) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s5-6
(the-as (pointer dma-tag) a3-12))))))
(none))
(deftype anim-tester-bank (basic)
((ANIM_SPEED float)
(BLEND float)
(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))
(deftype anim-tester (process-drawable)
((flags anim-tester-flags)
(obj-list glst-list :inline)
(current-obj string)
(speed int32)
(list-con list-control :inline)
(pick-con list-control :inline)
(item-field int64)
(inc-delay int32)
(inc-timer int32)
(edit-mode int32)
(old-mode int32)
(anim-speed float)
(anim-gspeed float)
(anim-first float)
(anim-last float))
(:states
anim-tester-process))
(defun anim-tester-num-print ((arg0 basic) (arg1 float))
(cond
((= arg1 -2.0) (format arg0 "max"))
((= arg1 -1.0) (format arg0 "min"))
(else (format arg0 "~f" arg1)))
(none))
(define-perm *anim-tester* (pointer anim-tester) #f)
(deftype anim-test-obj (glst-named-node)
((obj-art-group art-group)
(seq-list glst-list :inline)
(flags int32)
(mesh-geo merc-ctrl)
(joint-geo art-joint-geo)
(list-con list-control :inline)
(parent uint32)
(anim-index int32)
(anim-hindex int32)
(seq-index int32)
(seq-hindex int32))
(:methods
(new (symbol type int string basic) _type_)))
(defun anim-test-obj-init ((arg0 anim-test-obj) (arg1 list-control))
(set! (-> arg0 mesh-geo) #f)
(set! (-> arg0 joint-geo) #f)
(set! (-> arg0 list-con listfunc) anim-test-anim-list-handler)
(set! (-> arg0 list-con left) (-> *ANIM_TESTER-bank* ANIM_LIST_X))
(set! (-> arg0 list-con top) (-> *ANIM_TESTER-bank* ANIM_LIST_Y))
(set! (-> arg0 list-con list) (-> arg0 seq-list))
(set! (-> arg0 list-con list-owner) (the-as uint arg0))
(let ((v1-6 arg1)) (set! (-> arg0 parent) (the-as uint (if v1-6 (-> v1-6 the-node)))))
(none))
(defmethod new anim-test-obj ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string) (arg2 basic))
(let ((t9-0 (method-of-type structure new))
(v1-1 type-to-make))
(-> type-to-make size)
(let ((s4-0 (the-as anim-test-obj (t9-0 allocation v1-1))))
(set! (-> s4-0 obj-art-group) (the-as art-group arg2))
(set! (-> s4-0 privname) arg1)
(glst-init-list! (-> s4-0 seq-list))
s4-0)))
(deftype anim-test-sequence (glst-named-node)
((item-list glst-list :inline)
(playing-item int32)
(flags int32)
(list-con list-control :inline)
(parent anim-test-obj))
(:methods
(new (symbol type int string) _type_)))
(defun anim-test-sequence-init ((arg0 anim-test-sequence) (arg1 anim-test-obj))
(set! (-> arg0 list-con listfunc) anim-test-edit-sequence-list-handler)
(set! (-> arg0 list-con left) (-> *ANIM_TESTER-bank* EDIT_LIST_X))
(set! (-> arg0 list-con top) (-> *ANIM_TESTER-bank* EDIT_LIST_Y))
(set! (-> arg0 list-con list) (-> arg0 item-list))
(set! (-> arg0 list-con list-owner) (the-as uint arg0))
(set! (-> arg0 parent) arg1)
(none))
(defmethod new anim-test-sequence ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
(let ((t9-0 (method-of-type structure new))
(v1-1 type-to-make))
(-> type-to-make size)
(let ((s5-0 (the-as anim-test-sequence (t9-0 allocation v1-1))))
(set! (-> s5-0 privname) arg1)
(glst-init-list! (-> s5-0 item-list))
s5-0)))
(deftype anim-test-seq-item (glst-named-node)
((speed int32)
(blend int32)
(first-frame float)
(last-frame float)
(num-frames float)
(artist-base float)
(flags int32)
(parent anim-test-sequence))
(:methods
(new (symbol type int string) _type_)))
(defmethod new anim-test-seq-item ((allocation symbol) (type-to-make type) (arg0 int) (arg1 string))
(let ((t9-0 (method-of-type structure new))
(v1-1 type-to-make))
(-> type-to-make size)
(let ((v0-0 (t9-0 allocation v1-1)))
(set! (-> (the-as anim-test-seq-item v0-0) privname) arg1)
(set! (-> (the-as anim-test-seq-item v0-0) speed) 100)
(set! (-> (the-as anim-test-seq-item v0-0) blend) 0)
(set! (-> (the-as anim-test-seq-item v0-0) first-frame) -1.0)
(set! (-> (the-as anim-test-seq-item v0-0) last-frame) -2.0)
(the-as anim-test-seq-item v0-0))))
(defun anim-test-seq-item-copy! ((arg0 anim-test-seq-item) (arg1 anim-test-seq-item))
(let ((v1-0 arg0)) (set! (-> v1-0 privname) (-> arg1 privname)))
(set! (-> arg0 speed) (-> arg1 speed))
(set! (-> arg0 blend) (-> arg1 blend))
(set! (-> arg0 first-frame) (-> arg1 first-frame))
(set! (-> arg0 last-frame) (-> arg1 last-frame))
(set! (-> arg0 num-frames) (-> arg1 num-frames))
(set! (-> arg0 artist-base) (-> arg1 artist-base))
(set! (-> arg0 flags) (-> arg1 flags))
(let ((v0-0 (-> arg1 parent))) (set! (-> arg0 parent) v0-0) v0-0))
(defun anim-test-obj-item-valid? ((arg0 anim-test-obj) (arg1 anim-test-seq-item))
(let ((v1-0 (-> arg0 seq-list)))
"return the start of the list"
(let ((s5-0 (the-as anim-test-sequence (-> v1-0 head))))
(while (let ((v1-13 s5-0)) "is this node the end of the list. #t = end" (not (not (-> v1-13 next))))
(when (and (logtest? (-> s5-0 flags) 2) (name= (-> arg1 privname) (-> s5-0 privname)))
(let ((v1-7 (-> s5-0 item-list)))
"return the start of the list"
(let* ((v1-8 (the-as anim-test-seq-item (-> v1-7 head)))
(a0-4 v1-8))
"is this node the end of the list. #t = end"
(when (not (not (-> a0-4 next)))
(set! (-> arg1 num-frames) (-> v1-8 num-frames))
(set! (-> arg1 artist-base) (-> v1-8 artist-base)))))
(return #t))
"return the next node in the list"
(set! s5-0 (the-as anim-test-sequence (-> s5-0 next))))))
#f)
(defun anim-test-obj-remove-invalid ((arg0 anim-test-obj))
(local-vars (v1-19 symbol))
(let ((v1-0 (-> arg0 seq-list)))
"return the start of the list"
(let ((s5-0 (-> v1-0 head)))
(while (let ((v1-25 (the-as anim-test-sequence s5-0)))
"is this node the end of the list. #t = end"
(not (not (-> v1-25 next))))
(let ((v1-1 (the-as anim-test-sequence s5-0)))
"return the next node in the list"
(let ((s4-0 (-> v1-1 next)))
(when (not (logtest? (-> (the-as anim-test-sequence s5-0) flags) 2))
(let ((v1-5 (-> (the-as anim-test-sequence s5-0) item-list)))
"return the start of the list"
(let ((s3-0 (the-as anim-test-seq-item (-> v1-5 head))))
(while (let ((v1-13 s3-0)) "is this node the end of the list. #t = end" (not (not (-> v1-13 next))))
(let ((v1-6 s3-0))
"return the next node in the list"
(let ((s2-0 (the-as anim-test-seq-item (-> v1-6 next))))
(if (and (not (logtest? (-> s3-0 flags) 1)) (not (anim-test-obj-item-valid? arg0 s3-0)))
(glst-remove (-> (the-as anim-test-sequence s5-0) item-list) s3-0))
(set! s3-0 s2-0)))))))
(let ((v1-18 (-> (the-as anim-test-sequence s5-0) item-list)))
"is the list empty, #t = empty"
(if (or (= (-> v1-18 tailpred) v1-18)
(and (= (glst-num-elements (-> (the-as anim-test-sequence s5-0) item-list)) 1)
(begin
(let ((v1-21 #t)
(a0-13 (-> (the-as anim-test-sequence s5-0) item-list)))
"return the start of the list"
(let ((a0-16 (the-as int (logand (-> (the-as anim-test-seq-item (-> a0-13 head)) flags) 1))))
(cmove-#f-zero v1-19 a0-16 v1-21)))
v1-19)))
(glst-remove (-> arg0 seq-list) (the-as anim-test-sequence s5-0))))
(set! s5-0 (the-as anim-test-sequence s4-0)))))))
(let ((v1-30 (-> arg0 seq-list)))
"return the start of the list"
(let ((v1-31 (the-as anim-test-sequence (-> v1-30 head))))
(while (let ((a0-23 v1-31)) "is this node the end of the list. #t = end" (not (not (-> a0-23 next))))
(let ((a0-20 v1-31))
"return the next node in the list"
(let ((a0-21 (-> a0-20 next))) (logand! (-> v1-31 flags) -3) (set! v1-31 (the-as anim-test-sequence a0-21)))))))
#f)
(defbehavior anim-tester-real-post anim-tester ()
(when (logtest? (-> self flags) (anim-tester-flags fanimt0))
(if (logtest? (-> self flags) (anim-tester-flags fanimt5))
(vector-v+! (-> self root trans) (-> self root trans) (-> self root transv)))
(ja-post)
(when (logtest? (-> self flags) (anim-tester-flags fanimt4))
(draw-joint-spheres self)
(debug-print-channels (-> self skel) (the-as symbol *stdcon*))))
(none))
(defbehavior anim-tester-post anim-tester ()
(anim-tester-real-post)
(none))
(defbehavior anim-tester-update-anim-info anim-tester ((arg0 anim-test-seq-item))
(set! (-> self anim-first) (-> arg0 first-frame))
(set! (-> self anim-last) (-> arg0 last-frame))
(set! (-> self anim-gspeed) (* 0.01 (the float (-> self speed))))
(set! (-> self anim-speed) (* (/ (-> self anim-gspeed) 100) (the float (-> arg0 speed))))
(when (< (-> self anim-speed) 0.0)
(set! (-> self anim-first) (-> arg0 last-frame))
(set! (-> self anim-last) (-> arg0 first-frame)))
(set! (-> self anim-gspeed) (fabs (-> self anim-gspeed)))
(set! (-> self anim-speed) (fabs (-> self anim-speed))))
(defbehavior anim-tester-reset anim-tester ()
(let ((v1-0 (-> self obj-list)))
"is the list empty, #t = empty"
(cond
((= (-> v1-0 tailpred) v1-0) (set! (-> self list-con current-index) 0) (set! (-> self current-obj) ""))
(else
(let ((v1-1 (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 v1-1)
(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! v1-1 (the-as anim-test-obj (glst-get-node-by-index (-> self obj-list) (-> self list-con current-index))))
(set! (-> self current-obj) (-> v1-1 privname)))
(cond
((or (not (-> v1-1 joint-geo)) (not (-> v1-1 mesh-geo)))
(format #t "what's this? ~A~%" (-> v1-1 privname))
(format #t "it's missing a joint-geo, or a mesh-geo or a mesh-anim~%"))
(else
(let ((a0-15 (-> v1-1 joint-geo)))
(let ((a1-4 (-> v1-1 mesh-geo)))
(set! (-> self draw art-group) (-> v1-1 obj-art-group))
(set! (-> self draw cur-lod) -1)
(set! (-> self draw jgeo) a0-15)
(set! (-> self draw sink-group) (-> *level* level-default pris-tex-foreground-sink-group))
(set! (-> self draw lod-set lod 0 geo) a1-4))
(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 ((v1-16 (-> (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0) quad))) (set! (-> self draw color-mult quad) v1-16))
(let ((v1-18 (-> (new 'static 'vector) quad))) (set! (-> self draw color-emissive quad) v1-18))
(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 a0-15 *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 ((arg0 string) (arg1 float) (arg2 float) (arg3 font-context))
;; this function does not work
(return (the pointer #f))
(local-vars (sv-16 (function _varargs_ object)))
(let* ((s3-0 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(gp-0 (-> s3-0 base)))
(cond
((= arg1 -1.0)
(let ((s2-1 draw-string-adv)) (format (clear *temp-string*) "~Smin" arg0) (s2-1 *temp-string* s3-0 arg3)))
((= arg1 -2.0)
(let ((s2-2 draw-string-adv)) (format (clear *temp-string*) "~Smax" arg0) (s2-2 *temp-string* s3-0 arg3)))
(else
(let ((s0-0 draw-string-adv))
(set! sv-16 format)
(let ((a0-11 (clear *temp-string*))
(a1-5 "~S~3,,0f")
(a2-5 arg0)
(a3-1 (+ arg1 arg2)))
(sv-16 a0-11 a1-5 a2-5 a3-1))
(s0-0 *temp-string* s3-0 arg3))))
(let ((a3-2 (-> s3-0 base)))
(let ((v1-6 (the-as object (-> s3-0 base))))
(set! (-> (the-as dma-packet v1-6) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-6) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-6) vif1) (new 'static 'vif-tag))
(set! (-> s3-0 base) (&+ (the-as pointer v1-6) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
gp-0
(the-as (pointer dma-tag) a3-2)))))
(defbehavior anim-tester-standard-event-handler anim-tester ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(case arg2
(('reset)
(process-disconnect self)
(logclear! (-> self flags) (anim-tester-flags fanimt0))
(when (!= (-> *anim-tester* 0 edit-mode) 1)
(set! (-> *debug-menu-context* is-hidden) #f)
(set! (-> *anim-tester* 0 edit-mode) 0)
(set! *camera-read-buttons* #t))
(anim-tester-reset)
(go anim-tester-process))
(('change-anim) (go anim-tester-process))
(('pick-object) (set! (-> self edit-mode) 1) (set! *camera-read-buttons* #f) #f)
(('pick-joint-anim) (set! (-> self edit-mode) 2) (set! *camera-read-buttons* #f) #f)
(('pick-sequence) (set! (-> self edit-mode) 3) (set! *camera-read-buttons* #f) #f)
(('edit-sequence) (set! (-> self edit-mode) 4) (set! *camera-read-buttons* #f) #f)
(('save-sequences) (anim-tester-save-all-objects self))))
(defun anim-test-obj-list-handler ((arg0 int) (arg1 list-control))
(let ((s5-0 (-> arg1 the-node))
(v1-0 arg0))
(cond
((zero? v1-0)
(let* ((s3-0 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s4-0 (-> s3-0 base)))
(let ((s2-0 draw-string-xy))
(format (clear *temp-string*)
"~S~S~S"
(if (= (-> arg1 the-index) (-> arg1 highlight-index)) ">" " ")
(if (logtest? (-> (the-as anim-test-obj s5-0) flags) 1) "*" " ")
(-> (the-as anim-test-obj s5-0) privname))
(s2-0 *temp-string*
s3-0
(-> arg1 xpos)
(-> arg1 ypos)
(if (= (-> arg1 the-index) (-> arg1 current-index)) (font-color menu-flag-on) (font-color menu))
(font-flags shadow kerning)))
(let ((a3-2 (-> s3-0 base)))
(let ((v1-8 (the-as object (-> s3-0 base))))
(set! (-> (the-as dma-packet v1-8) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-8) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-8) vif1) (new 'static 'vif-tag))
(set! (-> s3-0 base) (&+ (the-as pointer v1-8) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s4-0
(the-as (pointer dma-tag) a3-2)))))
((= v1-0 1) (return #t))
((= v1-0 4)
(cond
((cpad-pressed? 0 up) (if (> (-> arg1 highlight-index) 0) (+! (-> arg1 highlight-index) -1)))
((cpad-pressed? 0 down)
(if (< (-> arg1 highlight-index) (glst-num-elements (-> arg1 list))) (+! (-> arg1 highlight-index) 1)))
((cpad-pressed? 0 x)
(let ((v1-38 (the-as object (-> arg1 list-owner))))
(set! (-> arg1 current-index) (-> arg1 the-index))
(set! (-> (the-as anim-tester v1-38) current-obj) (-> (the-as anim-test-obj s5-0) 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) 0)
(set! *camera-read-buttons* #t)
(logior! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt2)))))
((= v1-0 2)
(let ((v1-64 (+ (length (-> (the-as anim-test-obj s5-0) privname)) 2)))
(set! v1-64
(cond
((< (-> *ANIM_TESTER-bank* OBJECT_LIST_MIN_WIDTH) v1-64) (empty) v1-64)
(else (-> *ANIM_TESTER-bank* OBJECT_LIST_MIN_WIDTH))))
(set! (-> arg1 return-int) v1-64)))
((= v1-0 3)
(let* ((s4-1 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s5-2 (-> s4-1 base)))
(draw-string-xy "----pick-object---" s4-1 (-> arg1 xpos) (-> arg1 ypos) (font-color menu) (font-flags shadow kerning))
(let ((a3-4 (-> s4-1 base)))
(let ((v1-70 (the-as object (-> s4-1 base))))
(set! (-> (the-as dma-packet v1-70) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-70) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-70) vif1) (new 'static 'vif-tag))
(set! (-> s4-1 base) (&+ (the-as pointer v1-70) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s5-2
(the-as (pointer dma-tag) a3-4)))))))
#f)
(defun anim-test-anim-list-handler ((arg0 int) (arg1 list-control))
(let* ((s5-0 (the-as anim-test-obj (-> arg1 the-node)))
(v1-0 (the-as object (-> s5-0 list-con user-info-u))))
(cond
((zero? arg0)
(let* ((s3-0 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s4-0 (-> s3-0 base)))
(let ((s2-0 draw-string-xy))
(format (clear *temp-string*)
"~S~S"
(if (= (-> arg1 the-index) (-> arg1 highlight-index)) "> " " ")
(-> s5-0 privname))
(s2-0 *temp-string*
s3-0
(-> arg1 xpos)
(-> arg1 ypos)
(if (= (-> arg1 the-index) (-> arg1 current-index)) (font-color menu-flag-on) (font-color menu))
(font-flags shadow kerning)))
(let ((a3-2 (-> s3-0 base)))
(let ((v1-6 (the-as object (-> s3-0 base))))
(set! (-> (the-as dma-packet v1-6) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-6) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-6) vif1) (new 'static 'vif-tag))
(set! (-> s3-0 base) (&+ (the-as pointer v1-6) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s4-0
(the-as (pointer dma-tag) a3-2)))))
((= arg0 1) (return (not (logtest? (-> s5-0 flags) 1))))
((= arg0 4)
(cond
((cpad-pressed? 0 up)
(let ((v1-15 (-> arg1 list)))
"is the list empty, #t = empty"
(when (not (= (-> v1-15 tailpred) v1-15))
(let ((v1-17 (glst-get-node-by-index (-> arg1 list) (-> arg1 highlight-index))))
(loop
"return the previous node in the list"
(set! v1-17 (-> (the-as anim-test-obj v1-17) prev))
(let ((a0-23 (the-as anim-test-obj v1-17)))
"is this node the start of the list. #t = start"
(if (not (-> a0-23 prev)) (goto cfg-25)))
(when (not (logtest? (-> (the-as anim-test-obj v1-17) flags) 1))
(set! (-> arg1 highlight-index) (glst-get-node-index (-> arg1 list) (the-as anim-test-obj v1-17)))
(goto cfg-25))))))
(label cfg-25))
((cpad-pressed? 0 down)
(let ((v1-21 (-> arg1 list)))
"is the list empty, #t = empty"
(when (not (= (-> v1-21 tailpred) v1-21))
(let ((v1-23 (glst-get-node-by-index (-> arg1 list) (-> arg1 highlight-index))))
(loop
"return the next node in the list"
(set! v1-23 (-> (the-as anim-test-obj v1-23) next))
(let ((a0-40 (the-as anim-test-obj v1-23)))
"is this node the end of the list. #t = end"
(if (not (-> a0-40 next)) (goto cfg-39)))
(when (not (logtest? (-> (the-as anim-test-obj v1-23) flags) 1))
(set! (-> arg1 highlight-index) (glst-get-node-index (-> arg1 list) (the-as anim-test-obj v1-23)))
(goto cfg-39))))))
(label cfg-39))
((= (-> arg1 user-info) 1))
(else
(cond
((cpad-pressed? 0 x)
(set! (-> arg1 current-index) (-> arg1 the-index))
(set! (-> (the-as anim-test-obj v1-0) anim-index) (-> arg1 current-index))
(set! (-> (the-as anim-test-obj v1-0) anim-hindex) (-> arg1 highlight-index))
(logand! (-> (the-as anim-test-obj v1-0) flags) -3)
(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) 0)
(set! *camera-read-buttons* #t)
(logior! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt2)))))))
((= arg0 2)
(let ((v1-55 (+ (length (-> s5-0 privname)) 2)))
(set! v1-55
(cond
((< (-> *ANIM_TESTER-bank* ANIM_LIST_MIN_WIDTH) v1-55) (empty) v1-55)
(else (-> *ANIM_TESTER-bank* ANIM_LIST_MIN_WIDTH))))
(set! (-> arg1 return-int) v1-55)))
((= arg0 3)
(let* ((s4-1 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s5-1 (-> s4-1 base)))
(draw-string-xy "----pick-joint-anim----"
s4-1
(-> arg1 xpos)
(-> arg1 ypos)
(font-color menu)
(font-flags shadow kerning))
(let ((a3-4 (-> s4-1 base)))
(let ((v1-62 (the-as object (-> s4-1 base))))
(set! (-> (the-as dma-packet v1-62) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-62) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-62) vif1) (new 'static 'vif-tag))
(set! (-> s4-1 base) (&+ (the-as pointer v1-62) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s5-1
(the-as (pointer dma-tag) a3-4)))))))
#f)
(defun anim-test-sequence-list-handler ((arg0 int) (arg1 list-control))
(let* ((s5-0 (the-as anim-test-sequence (-> arg1 the-node)))
(v1-0 (-> s5-0 parent)))
(cond
((zero? arg0)
(let* ((s3-0 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s4-0 (-> s3-0 base)))
(let ((s2-0 draw-string-xy))
(format (clear *temp-string*)
"~S~S~S"
(if (= (-> arg1 the-index) (-> arg1 highlight-index)) ">" " ")
(if (logtest? (-> s5-0 flags) 4) "*" " ")
(-> s5-0 privname))
(s2-0 *temp-string*
s3-0
(-> arg1 xpos)
(-> arg1 ypos)
(if (= (-> arg1 the-index) (-> arg1 current-index)) (font-color menu-flag-on) (font-color menu))
(font-flags shadow kerning)))
(let ((a3-2 (-> s3-0 base)))
(let ((v1-8 (the-as object (-> s3-0 base))))
(set! (-> (the-as dma-packet v1-8) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-8) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-8) vif1) (new 'static 'vif-tag))
(set! (-> s3-0 base) (&+ (the-as pointer v1-8) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s4-0
(the-as (pointer dma-tag) a3-2)))))
((= arg0 1) (return (logtest? (-> s5-0 flags) 1)))
((= arg0 4)
(cond
((cpad-pressed? 0 up)
(let ((v1-17 (-> arg1 list)))
"is the list empty, #t = empty"
(when (not (= (-> v1-17 tailpred) v1-17))
(let ((v1-19 (glst-get-node-by-index (-> arg1 list) (-> arg1 highlight-index))))
(loop
"return the previous node in the list"
(set! v1-19 (-> (the-as anim-test-sequence v1-19) prev))
(let ((a0-24 (the-as anim-test-sequence v1-19)))
"is this node the start of the list. #t = start"
(if (not (-> a0-24 prev)) (goto cfg-28)))
(when (logtest? (-> (the-as anim-test-sequence v1-19) flags) 1)
(set! (-> arg1 highlight-index) (glst-get-node-index (-> arg1 list) (the-as anim-test-sequence v1-19)))
(goto cfg-28))))))
(label cfg-28))
((cpad-pressed? 0 down)
(let ((v1-23 (-> arg1 list)))
"is the list empty, #t = empty"
(when (not (= (-> v1-23 tailpred) v1-23))
(let ((v1-25 (glst-get-node-by-index (-> arg1 list) (-> arg1 highlight-index))))
(loop
"return the next node in the list"
(set! v1-25 (-> (the-as anim-test-sequence v1-25) next))
(let ((a0-42 (the-as anim-test-sequence v1-25)))
"is this node the end of the list. #t = end"
(if (not (-> a0-42 next)) (goto cfg-42)))
(when (logtest? (-> (the-as anim-test-sequence v1-25) flags) 1)
(set! (-> arg1 highlight-index) (glst-get-node-index (-> arg1 list) (the-as anim-test-sequence v1-25)))
(goto cfg-42))))))
(label cfg-42))
((cpad-pressed? 0 x)
(set! (-> arg1 current-index) (-> arg1 the-index))
(set! (-> v1-0 seq-index) (-> arg1 current-index))
(set! (-> v1-0 seq-hindex) (-> arg1 highlight-index))
(logior! (-> v1-0 flags) 2)
(set! (-> *anim-tester* 0 edit-mode) 4)
(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) 0)
(set! *camera-read-buttons* #t)
(logior! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt2)))))
((= arg0 2)
(let ((v1-57 (+ (length (-> s5-0 privname)) 2)))
(set! v1-57
(cond
((< (-> *ANIM_TESTER-bank* PICK_LIST_MIN_WIDTH) v1-57) (empty) v1-57)
(else (-> *ANIM_TESTER-bank* PICK_LIST_MIN_WIDTH))))
(set! (-> arg1 return-int) v1-57)))
((= arg0 3)
(let* ((s4-1 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s5-1 (-> s4-1 base)))
(draw-string-xy "----pick-sequence---" s4-1 (-> arg1 xpos) (-> arg1 ypos) (font-color menu) (font-flags shadow kerning))
(let ((a3-4 (-> s4-1 base)))
(let ((v1-64 (the-as object (-> s4-1 base))))
(set! (-> (the-as dma-packet v1-64) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-64) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-64) vif1) (new 'static 'vif-tag))
(set! (-> s4-1 base) (&+ (the-as pointer v1-64) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s5-1
(the-as (pointer dma-tag) a3-4)))))))
#f)
(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 ((arg0 float) (arg1 float))
(cond
((cpad-hold? 0 down)
(cond
((= arg0 -2.0) (set! arg0 (+ -1.0 arg1)))
((!= arg0 -1.0) (set! arg0 (+ -1.0 arg0)) (if (< arg0 0.0) (set! arg0 (the-as float -1.0))))))
((cpad-hold? 0 up)
(cond
((= arg0 -1.0) (set! arg0 (the-as float 0.0)))
((!= arg0 -2.0) (set! arg0 (+ 1.0 arg0)) (if (>= arg0 arg1) (set! arg0 (the-as float -2.0)))))))
(the-as float arg0))
(defun anim-tester-pick-item-setup ((arg0 anim-test-seq-item) (arg1 anim-test-sequence))
(let ((gp-0 (-> arg1 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) (-> gp-0 seq-list))
(set! (-> *anim-tester* 0 pick-con list-owner) (the-as uint gp-0))
(set! (-> *anim-tester* 0 pick-con user-info) 1)
(let ((v1-10 (-> gp-0 seq-list)))
"return the start of the list"
(let ((v1-11 (-> v1-10 head)))
(while (let ((a1-16 v1-11)) "is this node the end of the list. #t = end" (not (not (-> a1-16 next))))
"return the next node in the list"
(set! v1-11 (-> v1-11 next)))))
(let ((a1-20 (glst-find-node-by-name (-> gp-0 seq-list) (-> arg0 privname))))
(when a1-20
(set! (-> *anim-tester* 0 pick-con highlight-index) (glst-get-node-index (-> gp-0 seq-list) a1-20))
(set! (-> *anim-tester* 0 pick-con current-index) (-> *anim-tester* 0 pick-con highlight-index)))))
(logior! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3))
(none))
(defun anim-test-seq-mark-as-edited ((arg0 anim-test-sequence))
(logior! (-> arg0 parent flags) 1)
(logior! (-> arg0 flags) 1)
(none))
(defun anim-test-edit-seq-insert-item ((arg0 anim-test-seq-item) (arg1 anim-test-sequence))
(let ((s4-0 (new 'debug 'anim-test-seq-item 1 "")))
(anim-test-seq-item-copy! s4-0 arg0)
(when (logtest? (-> s4-0 flags) 1)
(logand! (-> s4-0 flags) -2)
(logior! (-> s4-0 flags) 4)
(let ((v1-8 s4-0)) (set! (-> v1-8 privname) "--blank--")))
(glst-insert-before (-> arg1 item-list) arg0 s4-0))
(anim-test-seq-mark-as-edited arg1)
(send-event (ppointer->process *anim-tester*) 'change-anim)
(none))
(defun anim-test-edit-sequence-list-handler ((arg0 int) (arg1 list-control))
(local-vars
(sv-192 (function string dma-buffer int int font-color font-flags float))
(sv-208 (function _varargs_ object)))
(let ((gp-0 (-> arg1 the-node))
(s4-0 (the-as object (-> arg1 list-owner)))
(s2-0 (and (logtest? (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3)) (zero? (-> *anim-tester* 0 item-field)))))
(cond
((zero? arg0)
(let ((s3-0 (new 'stack
'font-context
*font-default-matrix*
(-> arg1 xpos)
(-> arg1 ypos)
(the-as float 0.0)
(if (= (-> arg1 the-index) (-> arg1 current-index)) (font-color menu-flag-on) (font-color menu))
(font-flags shadow kerning))))
(when (not s2-0)
(when (= (-> arg1 the-index) (-> arg1 highlight-index))
(let* ((a1-2 (-> anim-test-field-highlight-lw (-> *anim-tester* 0 item-field) left))
(v1-24 (-> anim-test-field-highlight-lw (-> *anim-tester* 0 item-field) width))
(s0-0 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s1-0 (-> s0-0 base)))
(draw-sprite2d-xy s0-0
(+ (* a1-2 (-> *DISP_LIST-bank* CHAR_WIDTH)) 2 (-> arg1 xpos))
(+ (-> arg1 ypos) -1)
(+ (* v1-24 (-> *DISP_LIST-bank* CHAR_WIDTH)) 4)
(+ (-> *DISP_LIST-bank* TV_SPACING) 1)
(new 'static 'rgba :r #xc0 :g #xc0 :a #xff))
(let ((a3-4 (-> s0-0 base)))
(let ((v1-29 (the-as object (-> s0-0 base))))
(set! (-> (the-as dma-packet v1-29) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-29) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-29) vif1) (new 'static 'vif-tag))
(set! (-> s0-0 base) (&+ (the-as pointer v1-29) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s1-0
(the-as (pointer dma-tag) a3-4))))))
(let* ((s0-1 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s1-1 (-> s0-1 base)))
(set! sv-192 draw-string-xy)
(set! sv-208 format)
(let ((a0-18 (clear *temp-string*))
(a1-7 "~S~S~-27S")
(a2-11 (if (= (-> arg1 the-index) (-> arg1 highlight-index)) ">" " "))
(a3-6 (if (= (-> arg1 the-index) (-> (the-as anim-test-sequence s4-0) playing-item)) "*" " "))
(t0-2 (-> (the-as anim-test-seq-item gp-0) privname)))
(sv-208 a0-18 a1-7 a2-11 a3-6 t0-2))
(let ((a0-19 *temp-string*)
(a1-8 s0-1)
(a2-12 (-> arg1 xpos))
(a3-7 (-> arg1 ypos))
(t0-4 (if (= (-> arg1 the-index) (-> arg1 current-index)) 15 12))
(t1-2 3))
(sv-192 a0-19 a1-8 a2-12 a3-7 (the-as font-color t0-4) (the-as font-flags t1-2)))
(let ((a3-8 (-> s0-1 base)))
(let ((v1-44 (the-as object (-> s0-1 base))))
(set! (-> (the-as dma-packet v1-44) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-44) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-44) vif1) (new 'static 'vif-tag))
(set! (-> s0-1 base) (&+ (the-as pointer v1-44) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s1-1
(the-as (pointer dma-tag) a3-8))))
(when (not s2-0)
(let* ((s2-2 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(s4-1 (the-as anim-test-sequence (-> s2-2 base))))
(when (not (logtest? (-> (the-as anim-test-seq-item gp-0) flags) 1))
(let ((v1-57 s3-0)
(a1-13 (+ (-> arg1 xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH))))
(a0-29 (-> arg1 ypos)))
(set! (-> v1-57 origin x) (the float a1-13))
(set! (-> v1-57 origin y) (the float a0-29)))
(cond
((and (< (-> (the-as anim-test-seq-item gp-0) speed) 0) (< -100 (-> (the-as anim-test-seq-item gp-0) speed)))
(let ((s1-2 draw-string-adv))
(let ((s0-2 format)
(a0-33 (clear *temp-string*))
(a1-14 "-0.~1d")
(v1-61 (abs (-> (the-as anim-test-seq-item gp-0) speed))))
(s0-2 a0-33 a1-14 (/ (mod v1-61 100) 10)))
(s1-2 *temp-string* s2-2 s3-0)))
(else
(let ((s1-3 draw-string-adv))
(let ((s0-3 format)
(a0-36 (clear *temp-string*))
(a1-16 "~2d.~1d")
(a2-21 (/ (-> (the-as anim-test-seq-item gp-0) speed) 100))
(v1-64 (abs (-> (the-as anim-test-seq-item gp-0) speed))))
(s0-3 a0-36 a1-16 a2-21 (/ (mod v1-64 100) 10)))
(s1-3 *temp-string* s2-2 s3-0))))
(let ((s1-4 draw-string-adv))
(format (clear *temp-string*) " ~4d" (-> (the-as anim-test-seq-item gp-0) blend))
(s1-4 *temp-string* s2-2 s3-0))
(anim-tester-disp-frame-num " "
(-> (the-as anim-test-seq-item gp-0) first-frame)
(-> (the-as anim-test-seq-item gp-0) artist-base)
s3-0)
(anim-tester-disp-frame-num " "
(-> (the-as anim-test-seq-item gp-0) last-frame)
(-> (the-as anim-test-seq-item gp-0) artist-base)
s3-0)
(let ((s1-5 draw-string-adv))
(format (clear *temp-string*)
" ~S~S~S~S"
(if (logtest? (-> (the-as anim-test-seq-item gp-0) flags) 2) "B" "-")
"-"
"-"
"-")
(s1-5 *temp-string* s2-2 s3-0)))
(let* ((a1-24 (-> anim-test-field-highlight-lw 9 left))
(v1-69 s3-0)
(a1-26 (+ (-> arg1 xpos) (* a1-24 (-> *DISP_LIST-bank* CHAR_WIDTH))))
(a0-47 (-> arg1 ypos)))
(set! (-> v1-69 origin x) (the float a1-26))
(set! (-> v1-69 origin y) (the float a0-47)))
(draw-string-adv "MID" s2-2 s3-0)
(let ((a3-15 (-> s2-2 base)))
(let ((v1-70 (the-as object (-> s2-2 base))))
(set! (-> (the-as dma-packet v1-70) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-70) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-70) vif1) (new 'static 'vif-tag))
(set! (-> s2-2 base) (&+ (the-as pointer v1-70) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
(the-as pointer s4-1)
(the-as (pointer dma-tag) a3-15)))))))
((= arg0 1) (return #t))
((= arg0 4)
(cond
((logtest? (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3))
(let ((v1-88 (-> *anim-tester* 0 item-field)))
(cond
((zero? v1-88)
(cond
((cpad-pressed? 0 x)
(logclear! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3))
(let ((v0-24 (the-as anim-test-obj
(glst-get-node-by-index (-> *anim-tester* 0 pick-con list) (-> *anim-tester* 0 pick-con highlight-index)))))
(when (and v0-24 (let ((v1-101 (&-> v0-24 obj-art-group))) "is the list empty, #t = empty" (not (= (-> v1-101 2) v1-101))))
(let ((v1-103 (&-> v0-24 obj-art-group)))
"return the start of the list"
(let ((a1-30 (-> v1-103 0)))
(anim-test-seq-item-copy! (the-as anim-test-seq-item gp-0) (the-as anim-test-seq-item a1-30))))
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0)))))
((cpad-pressed? 0 square) (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3)))))
((= v1-88 9)
(cond
((not (cpad-hold? 0 x)) (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3)))
((cpad-pressed? 0 up)
(let ((v1-124 (the-as anim-test-seq-item gp-0)))
"return the previous node in the list"
(let* ((s3-1 (-> v1-124 prev))
(v1-125 s3-1))
"is this node the start of the list. #t = start"
(when (not (not (-> v1-125 prev)))
(glst-remove (-> (the-as anim-test-sequence s4-0) item-list) (the-as anim-test-seq-item gp-0))
(glst-insert-before (-> (the-as anim-test-sequence s4-0) item-list) s3-1 (the-as anim-test-seq-item gp-0))
(+! (-> arg1 current-index) -1)
(+! (-> arg1 highlight-index) -1)
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(send-event (ppointer->process *anim-tester*) 'change-anim)))))
((cpad-pressed? 0 down)
(let ((v1-142 (the-as anim-test-seq-item gp-0)))
"return the next node in the list"
(let* ((s3-2 (the-as anim-test-seq-item (-> v1-142 next)))
(v1-143 s3-2))
"is this node the end of the list. #t = end"
(when (and (not (not (-> v1-143 next))) (not (logtest? (-> s3-2 flags) 1)))
(glst-remove (-> (the-as anim-test-sequence s4-0) item-list) (the-as anim-test-seq-item gp-0))
(glst-insert-after (-> (the-as anim-test-sequence s4-0) item-list) s3-2 (the-as anim-test-seq-item gp-0))
(+! (-> arg1 current-index) 1)
(+! (-> arg1 highlight-index) 1)
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(send-event (ppointer->process *anim-tester*) 'change-anim)))))))
((or (= v1-88 1) (= v1-88 2) (= v1-88 3) (= v1-88 4))
(cond
((not (cpad-hold? 0 x)) (logclear! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3)))
((begin
(set! (-> arg1 current-index) (-> arg1 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)
((1)
(cond
((cpad-hold? 0 down)
(+! (-> (the-as anim-test-seq-item gp-0) speed) -10)
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(if (< (-> (the-as anim-test-seq-item gp-0) speed) -300) (set! (-> (the-as anim-test-seq-item gp-0) speed) -300)))
((cpad-hold? 0 up)
(+! (-> (the-as anim-test-seq-item gp-0) speed) 10)
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(if (< 1000 (-> (the-as anim-test-seq-item gp-0) speed)) (set! (-> (the-as anim-test-seq-item gp-0) speed) 1000)))))
((2)
(cond
((cpad-hold? 0 down)
(+! (-> (the-as anim-test-seq-item gp-0) blend) -1)
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(when (< (-> (the-as anim-test-seq-item gp-0) blend) 0)
(set! (-> (the-as anim-test-seq-item gp-0) blend) 0)
0))
((cpad-hold? 0 up)
(+! (-> (the-as anim-test-seq-item gp-0) blend) 1)
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(if (< 9999 (-> (the-as anim-test-seq-item gp-0) blend)) (set! (-> (the-as anim-test-seq-item gp-0) blend) 9999)))))
((3)
(let ((f30-0 (-> (the-as anim-test-seq-item gp-0) first-frame)))
(set! (-> (the-as anim-test-seq-item gp-0) first-frame)
(anim-tester-adjust-frame (-> (the-as anim-test-seq-item gp-0) first-frame)
(-> (the-as anim-test-seq-item gp-0) num-frames)))
(if (!= f30-0 (-> (the-as anim-test-seq-item gp-0) first-frame))
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0)))))
((4)
(let ((f30-1 (-> (the-as anim-test-seq-item gp-0) last-frame)))
(set! (-> (the-as anim-test-seq-item gp-0) last-frame)
(anim-tester-adjust-frame (-> (the-as anim-test-seq-item gp-0) last-frame)
(-> (the-as anim-test-seq-item gp-0) num-frames)))
(if (!= f30-1 (-> (the-as anim-test-seq-item gp-0) last-frame))
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0)))))))
(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 (> (-> arg1 highlight-index) 0) (+! (-> arg1 highlight-index) -1)))
((cpad-pressed? 0 down)
(if (< (the-as int (the-as anim-test-seq-item (-> arg1 highlight-index))) (glst-num-elements (-> arg1 list)))
(+! (-> arg1 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) 11))
(if (= (-> *anim-tester* 0 item-field) 8) (set! (-> *anim-tester* 0 item-field) 5)))
((cpad-pressed? 0 right)
(+! (-> *anim-tester* 0 item-field) 1)
(when (>= (-> *anim-tester* 0 item-field) 12)
(set! (-> *anim-tester* 0 item-field) 0)
0)
(if (= (-> *anim-tester* 0 item-field) 6) (set! (-> *anim-tester* 0 item-field) 9)))
((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) 3)
(logior! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt2)))
((cpad-pressed? 0 x)
(cond
((logtest? (-> (the-as anim-test-seq-item gp-0) flags) 1)
(let ((v1-318 (-> *anim-tester* 0 item-field)))
(if (= v1-318 10) (anim-test-edit-seq-insert-item (the-as anim-test-seq-item gp-0) (the-as anim-test-sequence s4-0)))))
(else
(let ((v1-322 (-> *anim-tester* 0 item-field)))
(cond
((zero? v1-322) (anim-tester-pick-item-setup (the-as anim-test-seq-item gp-0) (the-as anim-test-sequence s4-0)))
((= v1-322 10) (anim-test-edit-seq-insert-item (the-as anim-test-seq-item gp-0) (the-as anim-test-sequence s4-0)))
((= v1-322 11)
(when (not (logtest? (-> (the-as anim-test-seq-item gp-0) flags) 1))
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(glst-remove (-> (the-as anim-test-sequence s4-0) item-list) (the-as anim-test-seq-item gp-0)))
(send-event (ppointer->process *anim-tester*) 'change-anim))
(else
(when (not (logtest? (-> (the-as anim-test-seq-item gp-0) flags) 4))
(case (-> *anim-tester* 0 item-field)
((5)
(anim-test-seq-mark-as-edited (the-as anim-test-sequence s4-0))
(let ((v1-331 (logxor (-> (the-as anim-test-seq-item gp-0) flags) 2)))
(set! (-> (the-as anim-test-seq-item gp-0) flags) v1-331)
v1-331))
((6) (the-as int #f))
((7) (the-as int #f))
((8) (the-as int #f))
(else
(logior! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt3))
(set! (-> *anim-tester* 0 inc-delay) (-> *DISP_LIST-bank* INC_DELAY))
(set! (-> *anim-tester* 0 inc-timer) 0)
0)))))))))))))
((= arg0 2) (set! (-> arg1 return-int) (-> *ANIM_TESTER-bank* EDIT_LIST_MIN_WIDTH)))
((= arg0 3)
(let* ((s3-3 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(gp-2 (-> s3-3 base)))
(let ((s1-6 draw-string-xy))
(format (clear *temp-string*) "--Seq--(~-17S)--" (-> (the-as anim-test-sequence s4-0) privname))
(s1-6 *temp-string* s3-3 (-> arg1 xpos) (-> arg1 ypos) (font-color menu) (font-flags shadow kerning)))
(let ((a3-17 (-> s3-3 base)))
(let ((v1-355 (the-as object (-> s3-3 base))))
(set! (-> (the-as dma-packet v1-355) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-355) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-355) vif1) (new 'static 'vif-tag))
(set! (-> s3-3 base) (&+ (the-as pointer v1-355) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
gp-2
(the-as (pointer dma-tag) a3-17))))
(cond
(s2-0 (display-list-control (-> *anim-tester* 0 pick-con)))
(else
(let* ((s4-2 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(gp-3 (-> s4-2 base)))
(draw-string-xy "-spd-blnd-1st-lst-flgs-mov-"
s4-2
(+ (-> arg1 xpos) (* (-> *ANIM_TESTER-bank* EDIT_STATS_X) (-> *DISP_LIST-bank* CHAR_WIDTH)))
(-> arg1 ypos)
(font-color menu)
(font-flags shadow kerning))
(let ((a3-21 (-> s4-2 base)))
(let ((v1-367 (the-as object (-> s4-2 base))))
(set! (-> (the-as dma-packet v1-367) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-367) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-367) vif1) (new 'static 'vif-tag))
(set! (-> s4-2 base) (&+ (the-as pointer v1-367) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
gp-3
(the-as (pointer dma-tag) a3-21)))))))))
#f)
(defbehavior anim-tester-interface anim-tester ()
(let ((v1-0 (-> self edit-mode)))
(cond
((zero? v1-0)
(when (logtest? (-> *anim-tester* 0 flags) (anim-tester-flags fanimt2))
(logclear! (-> *anim-tester* 0 flags) (anim-tester-flags fanimt2))
(set-master-mode 'menu)))
((= v1-0 1) (display-list-control (-> self list-con)))
((= v1-0 2)
(let ((gp-0 (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
(cond
(gp-0
(set! (-> gp-0 list-con listfunc) anim-test-anim-list-handler)
(set! (-> gp-0 list-con current-index) (-> gp-0 anim-index))
(set! (-> gp-0 list-con highlight-index) (-> gp-0 anim-hindex))
(display-list-control (-> gp-0 list-con))
(set! (-> gp-0 anim-index) (-> gp-0 list-con current-index))
(set! (-> gp-0 anim-hindex) (-> gp-0 list-con highlight-index)))
(else
(let* ((s5-0 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(gp-1 (-> s5-0 base)))
(draw-string-xy "ERROR: current object not found"
s5-0
(-> *ANIM_TESTER-bank* ANIM_LIST_X)
(-> *ANIM_TESTER-bank* ANIM_LIST_Y)
(font-color menu-func-bad)
(font-flags shadow kerning))
(let ((a3-1 (-> s5-0 base)))
(let ((v1-20 (the-as object (-> s5-0 base))))
(set! (-> (the-as dma-packet v1-20) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-20) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-20) vif1) (new 'static 'vif-tag))
(set! (-> s5-0 base) (&+ (the-as pointer v1-20) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
gp-1
(the-as (pointer dma-tag) a3-1))))))))
((= v1-0 3)
(let ((gp-2 (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
(cond
(gp-2
(set! (-> gp-2 list-con listfunc) anim-test-sequence-list-handler)
(set! (-> gp-2 list-con current-index) (-> gp-2 seq-index))
(set! (-> gp-2 list-con highlight-index) (-> gp-2 seq-hindex))
(display-list-control (-> gp-2 list-con))
(set! (-> gp-2 seq-index) (-> gp-2 list-con current-index))
(set! (-> gp-2 seq-hindex) (-> gp-2 list-con highlight-index)))
(else
(let* ((s5-1 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(gp-3 (-> s5-1 base)))
(draw-string-xy "ERROR: current object not found"
s5-1
(-> *ANIM_TESTER-bank* ANIM_LIST_X)
(-> *ANIM_TESTER-bank* ANIM_LIST_Y)
(font-color menu-func-bad)
(font-flags shadow kerning))
(let ((a3-3 (-> s5-1 base)))
(let ((v1-36 (the-as object (-> s5-1 base))))
(set! (-> (the-as dma-packet v1-36) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-36) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-36) vif1) (new 'static 'vif-tag))
(set! (-> s5-1 base) (&+ (the-as pointer v1-36) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
gp-3
(the-as (pointer dma-tag) a3-3))))))))
((= v1-0 4)
(let ((v1-43 (the-as anim-test-obj (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))))
(cond
(v1-43
(let ((v1-44 (the-as anim-test-sequence (glst-get-node-by-index (-> v1-43 seq-list) (-> v1-43 list-con current-index)))))
(cond
(v1-44 (display-list-control (-> v1-44 list-con)))
(else
(let* ((s5-2 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(gp-4 (-> s5-2 base)))
(draw-string-xy "ERROR: current sequence not found"
s5-2
(-> *ANIM_TESTER-bank* EDIT_LIST_X)
(-> *ANIM_TESTER-bank* EDIT_LIST_Y)
(font-color menu-func-bad)
(font-flags shadow kerning))
(let ((a3-5 (-> s5-2 base)))
(let ((v1-51 (the-as object (-> s5-2 base))))
(set! (-> (the-as dma-packet v1-51) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-51) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-51) vif1) (new 'static 'vif-tag))
(set! (-> s5-2 base) (&+ (the-as pointer v1-51) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
gp-4
(the-as (pointer dma-tag) a3-5))))))))
(else
(let* ((s5-3 (-> *display* frames (-> *display* on-screen) frame debug-buf))
(gp-5 (-> s5-3 base)))
(draw-string-xy "ERROR: current object not found"
s5-3
(-> *ANIM_TESTER-bank* EDIT_LIST_X)
(-> *ANIM_TESTER-bank* EDIT_LIST_Y)
(font-color menu-func-bad)
(font-flags shadow kerning))
(let ((a3-7 (-> s5-3 base)))
(let ((v1-62 (the-as object (-> s5-3 base))))
(set! (-> (the-as dma-packet v1-62) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-62) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-62) vif1) (new 'static 'vif-tag))
(set! (-> s5-3 base) (&+ (the-as pointer v1-62) 16)))
(dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
gp-5
(the-as (pointer dma-tag) a3-7))))))))))
(set! (-> self old-mode) (-> self edit-mode))
(none))
(defun anim-tester-get-playing-item ((arg0 anim-test-sequence))
(let ((v0-0 ((the-as (function glst-list int anim-test-seq-item) glst-get-node-by-index) (-> arg0 item-list) (-> arg0 playing-item))))
(let ((s5-0 v0-0)
(s4-0 (-> arg0 playing-item)))
(when (logtest? (-> v0-0 flags) 5)
(loop
(+! s4-0 1)
(if (>= s4-0 (glst-num-elements (-> arg0 item-list))) (set! s4-0 0))
(set! v0-0 ((the-as (function glst-list int anim-test-seq-item) glst-get-node-by-index) (-> arg0 item-list) s4-0))
(when (or (= v0-0 s5-0) (not (logtest? (-> v0-0 flags) 5)))
(set! (-> arg0 playing-item) s4-0)
(return v0-0)))))
v0-0))
(defstate anim-tester-process (anim-tester)
:event anim-tester-standard-event-handler
:enter
(behavior ()
(logior! (-> self flags) (anim-tester-flags fanimt1)))
:trans
(behavior ()
(if (and (not (logtest? (-> self flags) (anim-tester-flags fanimt1))) (= *master-mode* 'menu)) (anim-tester-interface))
(logclear! (-> self flags) (anim-tester-flags fanimt1))
(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 ()
(local-vars (s4-0 glst-node) (s5-1 anim-test-seq-item) (gp-2 anim-test-sequence))
(loop
(logclear! (-> self flags) (anim-tester-flags fanimt0))
(let ((v1-2 (-> self obj-list)))
"is the list empty, #t = empty"
(cond
((= (-> v1-2 tailpred) v1-2)
(format *stdcon* "anim-tester:no objects loaded~%")
(set! (-> self list-con current-index) 0)
(set! (-> self current-obj) "")
(suspend)
0)
((begin
(set! s4-0 (glst-find-node-by-name (-> self obj-list) (-> self current-obj)))
(when (not s4-0)
(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! s4-0 (glst-get-node-by-index (-> self obj-list) (-> self list-con current-index)))
(set! (-> self current-obj) (-> (the-as anim-test-obj s4-0) privname)))
(let ((v1-10 (the-as structure (-> (the-as anim-test-obj s4-0) seq-list))))
"is the list empty, #t = empty"
(= (-> (the-as anim-test-obj v1-10) privname) (the-as glst-list v1-10))))
(format *stdcon* "anim-tester:no anims loaded~%")
(format *stdcon* "displaying without anim not yet implement~%")
(logclear! (-> self flags) (anim-tester-flags fanimt0))
(suspend)
0)
((begin
(if (>= (-> (the-as anim-test-obj s4-0) list-con current-index)
(glst-num-elements (-> (the-as anim-test-obj s4-0) seq-list)))
(set! (-> (the-as anim-test-obj s4-0) list-con current-index)
(+ (glst-num-elements (-> (the-as anim-test-obj s4-0) seq-list)) -1)))
(set! gp-2
(the-as anim-test-sequence
(glst-get-node-by-index (-> (the-as anim-test-obj s4-0) seq-list)
(if (logtest? (-> (the-as anim-test-obj s4-0) flags) 2)
(-> (the-as anim-test-obj s4-0) seq-index)
(-> (the-as anim-test-obj s4-0) anim-index)))))
(let ((v1-18 (-> gp-2 item-list))) "is the list empty, #t = empty" (= (-> v1-18 tailpred) v1-18)))
(format *stdcon* "anim-tester:no items in sequence ~A~%" (-> gp-2 privname))
(format *stdcon* "displaying without anim not yet implement~%")
(suspend)
0)
((begin
(when (>= (-> gp-2 playing-item) (glst-num-elements (-> gp-2 item-list)))
(set! (-> gp-2 playing-item) 0)
0)
(set! s5-1 (anim-tester-get-playing-item gp-2))
s5-1)
(let ((s4-1 (the-as art-joint-anim (lookup-art (-> (the-as anim-test-obj s4-0) obj-art-group) (-> s5-1 privname) art-joint-anim))))
(anim-tester-update-anim-info s5-1)
(cond
(s4-1
(logior! (-> self flags) (anim-tester-flags fanimt0))
(if (nonzero? (-> s5-1 blend))
(ja-channel-push! 1 (the-as time-frame (the int (* (the float (-> s5-1 blend)) (-> self anim-gspeed)))))
(ja-channel-set! 1))
(cond
((= (-> self anim-first) -1.0) (ja :group! s4-1 :num! min))
((= (-> self anim-first) -2.0) (ja :group! s4-1 :num! max))
(else (ja :group! s4-1 :num! (identity (-> self anim-first)))))
(when (nonzero? (-> s5-1 blend))
(while (and (!= (-> self skel root-channel 0) (-> self skel channel)) (logtest? (-> s5-1 flags) 2))
(when (logtest? (-> self flags) (anim-tester-flags fanimt5))
(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 fanimt5))
(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 s5-1)
(let ((v1-73 (= (-> self anim-last) -2.0)))
(cond
((or v1-73 (>= (-> 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)))))))
(+! (-> gp-2 playing-item) 1))
(else (format *stdcon* "anim ~A not found~%" (-> s5-1 privname)) (suspend) 0))))
(else (format *stdcon* "no anims~%") (suspend) 0)))))
:post anim-tester-post)
(defbehavior initialize-anim-tester anim-tester ()
(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!! ((arg0 list-field) (arg1 string))
(cond
((string-get-arg!! *temp-string* arg1)
(cond
((or (string= *temp-string* "max") (string= *temp-string* "MAX")) (set! (-> arg0 left) -2))
((or (string= *temp-string* "min") (string= *temp-string* "MIN")) (set! (-> arg0 left) -1))
(else (set! (-> arg0 left) (string->int *temp-string*))))
#t)
(else #f)))
(defun anim-tester-load-object-seqs ((arg0 anim-tester) (arg1 string))
#f)
(defun anim-tester-save-object-seqs ((arg0 anim-test-obj))
(let ((gp-0 format)
(s4-0 0)
(s3-0 "saving object ~s to ~s~%")
(s2-0 (-> arg0 privname)))
(format (clear *temp-string*) "data/~s.obinf" (-> arg0 privname))
(gp-0 s4-0 s3-0 s2-0 *temp-string*))
;; og:preserve-this hack
(let ((gp-2 (new 'stack 'file-stream (string-format "data/~s.obinf" (-> arg0 privname)) 'write)))
(format gp-2 "major-version 0~%")
(format gp-2 "minor-version 0~%")
(format gp-2 "Object \"~S\" ~d~%" (-> arg0 privname) 0)
(let ((v1-5 (-> arg0 seq-list)))
"return the start of the list"
(let ((s5-1 (-> v1-5 head)))
(while (let ((v1-30 (the-as anim-test-sequence s5-1)))
"is this node the end of the list. #t = end"
(not (not (-> v1-30 next))))
(logand! (-> (the-as anim-test-sequence s5-1) flags) -5)
(format gp-2
" ~S \"~S\" ~d~%"
(if (logtest? (-> (the-as anim-test-sequence s5-1) flags) 1) "Sequence" "Anim")
(-> (the-as anim-test-sequence s5-1) privname)
0)
(let ((v1-11 (-> (the-as anim-test-sequence s5-1) item-list)))
"return the start of the list"
(let ((s4-2 (the-as anim-test-seq-item (-> v1-11 head))))
(while (let ((v1-21 s4-2)) "is this node the end of the list. #t = end" (not (not (-> v1-21 next))))
(when (not (logtest? (-> s4-2 flags) 5))
(format gp-2 " Item \"~S\" ~d ~d " (-> s4-2 privname) (-> s4-2 speed) (-> s4-2 blend))
(anim-tester-num-print gp-2 (-> s4-2 first-frame))
(format gp-2 " ")
(anim-tester-num-print gp-2 (-> s4-2 last-frame))
(format gp-2 " ~S~%" (if (logtest? (-> s4-2 flags) 2) "B" "-")))
"return the next node in the list"
(set! s4-2 (the-as anim-test-seq-item (-> s4-2 next))))))
(format gp-2 " ~S~%" (if (logtest? (-> (the-as anim-test-sequence s5-1) flags) 1) "EndSequence" "EndAnim"))
"return the next node in the list"
(set! s5-1 (-> (the-as anim-test-sequence s5-1) next)))))
(format gp-2 "EndObject~%")
(file-stream-close gp-2)))
(defun anim-tester-save-all-objects ((arg0 anim-tester))
(let ((v1-0 (-> arg0 obj-list)))
"return the start of the list"
(let ((gp-0 (-> v1-0 head)))
(while (let ((v1-9 (the-as anim-test-obj gp-0))) "is this node the end of the list. #t = end" (not (not (-> v1-9 next))))
(when (logtest? (-> (the-as anim-test-obj gp-0) flags) 1)
(logand! (-> (the-as anim-test-obj gp-0) flags) -2)
(anim-tester-save-object-seqs (the-as anim-test-obj gp-0)))
"return the next node in the list"
(set! gp-0 (-> (the-as anim-test-obj gp-0) next)))))
#f)
(defun anim-tester-add-newobj ((arg0 anim-tester) (arg1 string) (arg2 art-group))
(local-vars (sv-96 art-element) (sv-112 art-element) (sv-128 anim-test-obj))
(let ((s2-0 (the-as anim-test-obj #f))
(s5-0 (the-as anim-test-obj #f)))
(let ((s1-0 (the-as art-element #f))
(s0-0 (the-as structure #f)))
(dotimes (s3-0 (-> arg2 length))
(cond
((and (= (-> arg2 data s3-0 type) merc-ctrl) (not s2-0))
(set! sv-96 (-> arg2 data s3-0))
(set! s0-0 (and s2-0 s0-0))
(if s0-0 (anim-test-obj-remove-invalid s2-0))
(anim-tester-load-object-seqs arg0 (-> sv-96 name))
(set! s2-0 (the-as anim-test-obj (glst-find-node-by-name (-> arg0 obj-list) (-> sv-96 name))))
(set! s0-0 (if s2-0 #t #f))
(cond
((the-as symbol s0-0))
(else (set! s2-0 (new 'global 'anim-test-obj 1 (-> sv-96 name) arg2)) (glst-add-tail (-> arg0 obj-list) s2-0)))
(anim-test-obj-init s2-0 (the-as list-control arg0))
(set! (-> s2-0 obj-art-group) arg2)
(set! (-> s2-0 mesh-geo) (the-as merc-ctrl sv-96))
(set! (-> s2-0 joint-geo) (the-as art-joint-geo s1-0))
(if (not s5-0) (set! s5-0 s2-0)))
((= (-> arg2 data s3-0 type) art-joint-geo)
(if (and s2-0 (not (-> s2-0 joint-geo))) (set! (-> s2-0 joint-geo) (the-as art-joint-geo (-> arg2 data s3-0))))
(if (not s1-0) (set! s1-0 (-> arg2 data s3-0))))
((= (-> arg2 data s3-0 type) art-joint-anim)
(when s2-0
(set! sv-112 (-> arg2 data s3-0))
(set! sv-128 (the-as anim-test-obj (glst-find-node-by-name (-> s2-0 seq-list) (-> sv-112 name))))
(when (not sv-128)
(set! sv-128 (the-as anim-test-obj (new 'debug 'anim-test-sequence 1 (-> sv-112 name))))
(glst-add-tail (-> s2-0 seq-list) sv-128)
(anim-test-sequence-init (the-as anim-test-sequence sv-128) s2-0)
(let ((a1-11 (new 'debug 'anim-test-seq-item 1 (-> sv-112 name))))
(glst-add-tail (the-as glst-list (&-> sv-128 obj-art-group)) a1-11)))
(set! (-> sv-128 list-con user-info) (the-as int s2-0))
(set! (-> sv-128 flags) (logior (-> (the-as anim-test-sequence sv-128) flags) 2))
(let ((v1-48 (-> (the-as anim-test-sequence sv-128) item-list)))
"is the list empty, #t = empty"
(when (not (= (-> v1-48 tailpred) v1-48))
(let ((v1-51 (-> (the-as anim-test-sequence sv-128) item-list)))
"return the start of the list"
(let ((v1-52 (-> v1-51 head)))
(set! (-> (the-as anim-test-seq-item v1-52) num-frames) (the float (-> (the-as art-joint-anim sv-112) data 0 length)))
(set! (-> (the-as anim-test-seq-item v1-52) artist-base) (-> (the-as art-joint-anim sv-112) artist-base))
(set! (-> (the-as anim-test-seq-item v1-52) parent) (the-as anim-test-sequence sv-128))))
sv-128))))
(else))))
(if s2-0 (anim-test-obj-remove-invalid s2-0))
(when s5-0
(set! (-> arg0 current-obj) (-> s5-0 privname))
(set! (-> arg0 list-con current-index) (glst-get-node-index (-> arg0 obj-list) s5-0))))
(send-event arg0 'reset #f))
(defun anim-tester-stop ()
(when *anim-tester*
(kill-by-name 'anim-tester *active-pool*)
(set! *anim-tester* (the-as (pointer anim-tester) #f))
#f))
(defun anim-tester-start ()
(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 ((arg0 string))
(let ((s5-0 (load-to-heap-by-name (-> *level* level-default art-group) arg0 #t global 0)))
(cond
(s5-0
(if (not *anim-tester*) (anim-tester-start))
(if *anim-tester* (anim-tester-add-newobj (the-as anim-tester (ppointer->process *anim-tester*)) arg0 s5-0)))
(else (format 0 "ERROR:no object (~A)n" arg0))))
(none))
(defun anim-tester-set-name ((arg0 string))
(cond
((zero? (length arg0)) (format #t "ERROR: no name~%"))
((and *anim-tester*
(let ((v1-6 (-> *anim-tester* 0 obj-list))) "is the list empty, #t = empty" (not (= (-> v1-6 tailpred) v1-6))))
(let ((s3-0 (the-as anim-test-obj (glst-find-node-by-name (-> *anim-tester* 0 obj-list) (-> *anim-tester* 0 current-obj)))))
(cond
(s3-0
(let ((s5-0 (the-as anim-test-sequence (glst-get-node-by-index (-> s3-0 seq-list) (-> s3-0 list-con current-index)))))
(cond
(s5-0
(cond
((logtest? (-> s5-0 flags) 1)
(let ((s4-0 (the-as object (-> s5-0 privname))))
(let ((v1-14 s5-0)) (set! (-> v1-14 privname) ""))
(cond
((glst-find-node-by-name (-> s3-0 seq-list) arg0)
(format #t "ERROR: another sequence is already using that name (~S)~%" arg0)
(set! (-> s5-0 privname) (the-as string s4-0)))
(else (set! s4-0 arg0) (set! (-> s5-0 privname) (the-as string s4-0))))
s4-0))
(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 ((arg0 string))
(cond
((zero? (length arg0)) (format #t "ERROR: no name~%"))
((and *anim-tester*
(let ((v1-6 (-> *anim-tester* 0 obj-list))) "is the list empty, #t = empty" (not (= (-> v1-6 tailpred) v1-6))))
(let ((s5-0 (the-as anim-test-obj (glst-find-node-by-name (-> *anim-tester* 0 obj-list) (-> *anim-tester* 0 current-obj)))))
(cond
(s5-0
(let ((s4-0 (glst-find-node-by-name (-> s5-0 seq-list) arg0)))
(cond
(s4-0
(format #t "ERROR: there is already a sequence with the name ~S~%" arg0)
(set! (-> s5-0 list-con current-index) (glst-get-node-index (-> s5-0 seq-list) s4-0))
(send-event (ppointer->process *anim-tester*) 'edit-sequence))
(else
(let ((gp-1 (new 'global 'anim-test-sequence 1 arg0)))
(glst-add-tail (-> s5-0 seq-list) gp-1)
(set! (-> gp-1 list-con listfunc) anim-test-edit-sequence-list-handler)
(set! (-> gp-1 list-con left) (-> *ANIM_TESTER-bank* EDIT_LIST_X))
(set! (-> gp-1 list-con top) (-> *ANIM_TESTER-bank* EDIT_LIST_Y))
(set! (-> gp-1 list-con list) (-> gp-1 item-list))
(set! (-> gp-1 list-con list-owner) (the-as uint gp-1))
(set! (-> gp-1 parent) s5-0)
(anim-test-seq-mark-as-edited gp-1)
(logior! (-> gp-1 flags) 1)
(set! (-> s5-0 list-con current-index) (glst-get-node-index (-> s5-0 seq-list) gp-1))
(set! (-> s5-0 seq-index) (-> s5-0 list-con current-index))
(set! (-> s5-0 seq-hindex) (-> s5-0 list-con current-index))
(let ((s5-1 (new 'debug 'anim-test-seq-item 1 "**END**")))
(logior! (-> s5-1 flags) 1)
(glst-add-tail (-> gp-1 item-list) s5-1)
(set! (-> s5-1 parent) gp-1)))
(send-event (ppointer->process *anim-tester*) 'edit-sequence)))))
(else (format #t "ERROR:no object selected~%")))))
(else (format #t "ERROR:no object loaded~%")))
(none))
Reference in New Issue View Git Blame Copy Permalink