mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-06-10 04:54:31 -04:00
Code Issues Packages Projects Releases Wiki Activity
Files
ci/flag-asm-diff
jak-project/goal_src/jak1/engine/debug/anim-tester.gc
T
Tyler Wilding c162c66118 g/j1: Cleanup all main issues in the formatter and format all of goal_src/jak1 (#3535) 
This PR does two main things:
1. Work through the main low-hanging fruit issues in the formatter
keeping it from feeling mature and usable
2. Iterate and prove that point by formatting all of the Jak 1 code
base. **This has removed around 100K lines in total.**
- The decompiler will now format it's results for jak 1 to keep things
from drifting back to where they were. This is controlled by a new
config flag `format_code`.

How am I confident this hasn't broken anything?:
- I compiled the entire project and stored it's `out/jak1/obj` files
separately
- I then recompiled the project after formatting and wrote a script that
md5's each file and compares it (`compare-compilation-outputs.py`
- The results (eventually) were the same:

![Screenshot 2024-05-25
132900](https://github.com/open-goal/jak-project/assets/13153231/015e6f20-8d19-49b7-9951-97fa88ddc6c2)
> This proves that the only difference before and after is non-critical
whitespace for all code/macros that is actually in use.

I'm still aware of improvements that could be made to the formatter, as
well as general optimization of it's performance. But in general these
are for rare or non-critical situations in my opinion and I'll work
through them before doing Jak 2. The vast majority looks great and is
working properly at this point. Those known issues are the following if
you are curious:

![image](https://github.com/open-goal/jak-project/assets/13153231/0edfaba1-6d36-40f5-ab23-0642209867c4)
2024-06-05 22:17:31 -04:00

1705 lines
90 KiB
Common Lisp
Raw Permalink 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) (* 0.01 (-> self anim-gspeed) (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