mirror of
https://github.com/open-goal/jak-project
synced 2026-06-24 01:41:29 -04:00
Hat Kid
122de4ecf5
After spending the last month staring at and comparing Jak 3 and Jak 1 versions of a bunch of `target` code for my jetboard mod, I figured this would be a good opportunity to revive this ancient PR #1714 along with some other small misc fixes/improvements. Instead of directly replacing the old fields, I decided to opt for using overlay fields to maintain backwards compatibility with existing manual patches, files without ref tests and mods that might use these fields.
782 lines
37 KiB
Common Lisp
782 lines
37 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/engine/engines.gc")
|
|
(require "engine/gfx/merc/merc-blend-shape.gc")
|
|
(require "engine/game/game-info.gc")
|
|
(require "engine/gfx/foreground/eye-h.gc")
|
|
(require "engine/gfx/shadow/shadow-cpu-h.gc")
|
|
(require "engine/collide/collide-shape-rider.gc")
|
|
(require "engine/load/loader.gc")
|
|
|
|
;; TODO: there are some missing functions here...
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(defun cspace-by-name ((arg0 process-drawable) (arg1 string))
|
|
(let* ((s4-0 (-> arg0 node-list length))
|
|
(s3-0 0)
|
|
(s2-0 (-> arg0 node-list data s3-0)))
|
|
(while (< s3-0 s4-0)
|
|
(if (and (-> s2-0 joint) (name= (-> s2-0 joint name) arg1)) (return s2-0))
|
|
(+! s3-0 1)
|
|
(set! s2-0 (-> arg0 node-list data s3-0))))
|
|
(the-as cspace #f))
|
|
|
|
(defun cspace-index-by-name ((arg0 process-drawable) (arg1 string))
|
|
(let* ((s4-0 0)
|
|
(s3-0 (-> arg0 node-list length))
|
|
(s2-0 0)
|
|
(v1-3 (-> arg0 node-list data s2-0)))
|
|
(while (< s2-0 s3-0)
|
|
(if (and (-> v1-3 joint) (name= (-> v1-3 joint name) arg1)) (return s4-0))
|
|
(+! s4-0 1)
|
|
(+! s2-0 1)
|
|
(set! v1-3 (-> arg0 node-list data s2-0))))
|
|
-1)
|
|
|
|
(defun vector<-cspace! ((arg0 vector) (arg1 cspace))
|
|
(rlet ((Q :class vf)
|
|
(vf0 :class vf)
|
|
(vf2 :class vf))
|
|
(init-vf0-vector)
|
|
(.lvf vf2 (&-> (-> arg1 bone) transform vector 3 quad))
|
|
(.div.vf Q vf0 vf2 :fsf #b11 :ftf #b11)
|
|
;; og:preserve-this ADDED
|
|
;; there's a bug in swamp-blimp where they vector<-cspace!
|
|
;; on some default-initialized-to-zero bones
|
|
;; we have to return 0s for this to avoid NaNs getting everywhere.
|
|
(let ((temp (new-stack-vector0)))
|
|
(.svf (&-> temp quad) vf2)
|
|
(when (= (-> temp w) 0.0)
|
|
(set-vector! arg0 0. 0. 0. 1.)
|
|
(return arg0)))
|
|
(.wait.vf)
|
|
(.mul.vf.xyz vf2 vf2 Q)
|
|
(.nop.vf)
|
|
(.nop.vf)
|
|
(.mov.vf.w vf2 vf0)
|
|
(.svf (&-> arg0 quad) vf2)
|
|
arg0))
|
|
|
|
(defun vector<-cspace+vector! ((arg0 vector) (arg1 cspace) (arg2 vector))
|
|
(vector-matrix*! arg0 arg2 (-> arg1 bone transform)))
|
|
|
|
(defun-debug cspace-children ((arg0 process-drawable) (arg1 int))
|
|
(let ((a3-0 '()))
|
|
(countdown (s4-0 (-> arg0 node-list length))
|
|
(if (= (-> arg0 node-list data s4-0 parent) arg1) (set! a3-0 (cons (-> arg0 node-list data s4-0) a3-0))))
|
|
a3-0))
|
|
|
|
;; ERROR: function was not converted to expressions. Cannot decompile.
|
|
|
|
(defmethod new draw-control ((allocation symbol) (type-to-make type) (arg0 process) (arg1 art-joint-geo))
|
|
(let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
|
(set! (-> v0-0 jgeo) arg1)
|
|
(set! (-> v0-0 process) arg0)
|
|
v0-0))
|
|
|
|
(defmethod lod-set! ((this draw-control) (arg0 int))
|
|
(let ((v1-1 (max 0 (min arg0 (-> this lod-set max-lod)))))
|
|
(set! (-> this desired-lod) v1-1)
|
|
(when (!= (-> this cur-lod) v1-1)
|
|
(set! (-> this mgeo) (-> this lod-set lod v1-1 geo))
|
|
(set! (-> this cur-lod) v1-1)))
|
|
0
|
|
(none))
|
|
|
|
(defmethod lods-assign! ((this draw-control) (arg0 lod-set))
|
|
(mem-copy! (the-as pointer (-> this lod-set)) (the-as pointer arg0) 33)
|
|
(let ((a1-2 (min (-> this cur-lod) (-> this lod-set max-lod)))) (set! (-> this cur-lod) -1) (lod-set! this a1-2))
|
|
0
|
|
(none))
|
|
|
|
(defmethod setup-lods! ((this lod-set) (arg0 skeleton-group) (arg1 art-group) (arg2 entity))
|
|
(let ((s4-0 arg0)
|
|
(s5-0 arg1))
|
|
(let ((v1-0 (-> s5-0 length))
|
|
(s3-0 (-> s4-0 max-lod)))
|
|
(set! (-> this max-lod) s3-0)
|
|
(dotimes (a0-1 (+ s3-0 1))
|
|
(when (or (>= (-> s4-0 mgeo a0-1) v1-0)
|
|
(begin
|
|
(set! arg0 (the-as skeleton-group (-> s5-0 data (-> s4-0 mgeo a0-1))))
|
|
(!= (-> (the-as art-element arg0) type) merc-ctrl)))
|
|
(set! this (the-as lod-set #f))
|
|
(goto cfg-16))
|
|
(set! (-> this lod a0-1 geo) (the-as merc-ctrl arg0))
|
|
(set! (-> this lod a0-1 dist) (-> s4-0 lod-dist a0-1)))
|
|
(if (= (-> this lod s3-0 dist) 4095996000.0)
|
|
(set! (-> this lod s3-0 dist) (res-lump-float arg2 'vis-dist :default 4095996000.0))))
|
|
(let* ((v1-13 (-> s5-0 data (-> s4-0 jgeo)))
|
|
(sv-16 (new 'static 'res-tag))
|
|
(v1-14 (res-lump-data (-> v1-13 extra) 'lod-dist pointer :tag-ptr (& sv-16))))
|
|
(when v1-14
|
|
(dotimes (a0-6 (the-as int (-> sv-16 elt-count)))
|
|
(set! (-> this lod a0-6 dist) (-> (the-as (pointer float) (&+ v1-14 (* a0-6 4)))))))))
|
|
(label cfg-16)
|
|
this)
|
|
|
|
(define *default-skel-template* '((align root #f) (prejoint root cspace<-parented-matrix-joint!)))
|
|
|
|
(defbehavior make-nodes-from-jg process-drawable ((arg0 art-joint-geo) (arg1 pair) (arg2 symbol))
|
|
(let ((gp-0 ((method-of-type cspace-array new) arg2 cspace-array (+ (-> arg0 length) 1))))
|
|
(let ((v0-1 ((method-of-type skeleton new) arg2 skeleton (+ (-> arg0 length) 1))))
|
|
(set! (-> self draw skeleton) v0-1)
|
|
(let ((s4-1 v0-1))
|
|
(when (or (zero? gp-0) (zero? s4-1))
|
|
(go process-drawable-art-error "memory")
|
|
(set! gp-0 (the-as cspace-array #f))
|
|
(goto cfg-16))
|
|
(let ((v1-10 ((method-of-type cspace reset-and-assign-geo!) (-> gp-0 data 0) #f)))
|
|
(set! (-> v1-10 bone) (the-as bone (-> s4-1 bones)))
|
|
(let ((a0-6 (-> gp-0 data)))
|
|
(set! (-> a0-6 0 param0) cspace<-transformq!)
|
|
(set! (-> a0-6 0 param1) (the-as basic (-> self root trans))))
|
|
(set! (-> v1-10 bone cache bone-matrix) (the-as uint 0)))
|
|
0
|
|
(let ((v1-14 (reset-and-assign-geo! (-> gp-0 data 1) #f)))
|
|
(set! (-> v1-14 joint) (-> arg0 data 0))
|
|
(set! (-> v1-14 bone) (-> s4-1 bones 1))
|
|
(set! (-> v1-14 parent) (the-as cspace (-> gp-0 data)))
|
|
(set! (-> v1-14 bone cache bone-matrix) (the-as uint 128)))
|
|
(let ((v1-17 (reset-and-assign-geo! (-> gp-0 data 2) #f)))
|
|
(set! (-> v1-17 joint) (-> arg0 data 1))
|
|
(set! (-> v1-17 bone) (-> s4-1 bones 2))
|
|
(set! (-> v1-17 parent) (the-as cspace (-> gp-0 data)))
|
|
(let ((a1-9 v1-17)) (set! (-> a1-9 param0) cspace<-parented-matrix-joint!) (set! (-> a1-9 param1) self))
|
|
(set! (-> v1-17 bone cache bone-matrix) (the-as uint 256)))
|
|
(let ((s3-0 3))
|
|
(while (< s3-0 (-> gp-0 length))
|
|
(let* ((s1-0 (-> arg0 data (+ s3-0 -1)))
|
|
(s2-0 (if (-> s1-0 parent) (+ (-> s1-0 parent number) 1) 0))
|
|
(v1-29 (reset-and-assign-geo! (-> gp-0 data s3-0) #f)))
|
|
(set! (-> v1-29 joint) s1-0)
|
|
(set! (-> v1-29 bone) (-> s4-1 bones s3-0))
|
|
(set! (-> v1-29 parent) (-> gp-0 data s2-0))
|
|
(set! (-> v1-29 bone cache bone-matrix) (the-as uint (* s3-0 128)))
|
|
(set! (-> v1-29 bone cache parent-matrix) (the-as uint (* s2-0 128))))
|
|
(+! s3-0 1)))))
|
|
(add-connection (-> (if (-> self entity) (-> self entity extra level) (-> *level* level-default))
|
|
foreground-draw-engine
|
|
(-> self draw sink-group merc-sink foreground-texture-page))
|
|
self
|
|
add-process-drawable
|
|
self
|
|
(-> self draw)
|
|
#f)
|
|
(label cfg-16)
|
|
gp-0))
|
|
|
|
;; ERROR: Unsupported inline assembly instruction kind - [cache dxwbin a2, 0]
|
|
;; ERROR: Unsupported inline assembly instruction kind - [cache dxwbin a2, 1]
|
|
(defun fill-skeleton-cache ((arg0 process-drawable))
|
|
(let ((v1-0 (-> arg0 node-list))
|
|
(a0-2 (-> arg0 draw skeleton)))
|
|
(dotimes (a1-0 (-> v1-0 length))
|
|
(let ((a3-0 (-> v1-0 data a1-0))
|
|
(a2-3 (the-as bone-cache (+ (the-as uint (the-as bone-cache (-> a0-2 bones 0 cache))) (* 96 a1-0)))))
|
|
(set! (-> a2-3 bone-matrix) (the-as uint (* a1-0 128)))
|
|
(set! (-> a2-3 frame) (the-as uint 0))
|
|
(let ((t0-3 0))
|
|
(if (and (-> a3-0 parent) (-> a3-0 parent joint)) (set! t0-3 (-> a3-0 parent joint number)))
|
|
(set! (-> a2-3 parent-matrix) (the-as uint (* (+ t0-3 1) 128))))
|
|
(.sync.l)
|
|
;(.cache dxwbin a2-3 0)
|
|
(.sync.l)
|
|
;(.cache dxwbin a2-3 1)
|
|
)
|
|
(.sync.l)
|
|
0))
|
|
0)
|
|
|
|
(defun execute-math-engine ()
|
|
(#when PC_PORT
|
|
(with-dma-buffer-add-bucket ((debug-buf (-> (current-frame) global-buf)) (bucket-id debug-no-zbuf))
|
|
(when *display-actor-counts*
|
|
(draw-string-xy (string-format "M: ~D/~D A: ~D" (-> *matrix-engine* length) MATRIX_ENGINE_AMOUNT (process-count *active-pool*))
|
|
debug-buf
|
|
8
|
|
(- 224 18)
|
|
(font-color default)
|
|
(font-flags shadow kerning)))))
|
|
(let ((gp-0 *matrix-engine*))
|
|
(countdown (s5-0 (-> gp-0 length))
|
|
(let ((a0-1 (handle->process (-> gp-0 s5-0)))) (if a0-1 (do-joint-math! (the-as process-drawable a0-1)))))
|
|
(set! (-> gp-0 length) 0))
|
|
0
|
|
0)
|
|
|
|
(define-extern draw-joint-spheres (function process-drawable symbol))
|
|
|
|
(#when PC_PORT
|
|
(define *display-bones* #f)
|
|
(define *display-joint-names* #f)
|
|
(defun-debug draw-bone-lines ((obj process-drawable))
|
|
"Added in PC port to debug bones"
|
|
(dotimes (i (-> obj node-list length))
|
|
(let ((parent (-> obj node-list data i parent)))
|
|
(when (and parent (nonzero? parent) (-> parent joint) (-> parent parent))
|
|
(let ((child (vector<-cspace! (new-stack-vector0) (-> obj node-list data i))))
|
|
(add-debug-line #t
|
|
(bucket-id debug)
|
|
child
|
|
(vector<-cspace! (new-stack-vector0) parent)
|
|
(new 'static 'rgba :g #xff :a #x40)
|
|
#f
|
|
(the rgba -1))))))))
|
|
|
|
(defmethod do-joint-math! ((obj process-drawable))
|
|
(cond
|
|
((logtest? (-> obj draw status) (draw-status hidden no-anim)))
|
|
((zero? (-> obj skel))
|
|
(matrix<-transformq+trans! (the-as matrix (-> obj draw skeleton bones 3))
|
|
(the-as transformq (-> obj root trans))
|
|
(-> obj draw skeleton bones 0 transform vector 3))
|
|
(set! (-> obj draw origin quad) (-> obj draw skeleton bones 3 transform vector 3 quad)))
|
|
(else
|
|
(let ((s5-0 (-> obj draw mgeo num-joints)))
|
|
(let ((s4-0 (+ s5-0 2)))
|
|
(+ s4-0 1)
|
|
((-> obj skel generate-frame-function)
|
|
(the-as (inline-array vector) (+ 2416 (the-as int (the-as terrain-context (scratchpad-object int)))))
|
|
s4-0
|
|
obj)
|
|
(if (-> obj skel prebind-function)
|
|
((-> obj skel prebind-function) (the-as pointer (+ 2416 (scratchpad-object int))) s4-0 obj)))
|
|
(dotimes (s4-1 1)
|
|
(let* ((v1-25 (-> obj node-list data s4-1))
|
|
(t9-3 (-> v1-25 param0)))
|
|
(if t9-3 ((the-as (function cspace basic basic int) t9-3) v1-25 (-> v1-25 param1) (-> v1-25 param2)))))
|
|
(dotimes (s4-2 2)
|
|
(let* ((a0-15 (-> obj node-list data (+ s4-2 1)))
|
|
(a1-5 (+ (* s4-2 64) 2416 (scratchpad-object int)))
|
|
(t9-4 (-> a0-15 param0)))
|
|
(if t9-4 ((the-as (function cspace pointer none) t9-4) a0-15 (the-as pointer a1-5)))))
|
|
(let ((s4-3 3))
|
|
(dotimes (s3-0 s5-0)
|
|
(let ((a0-17 (-> obj node-list data (+ s3-0 s4-3)))
|
|
(a1-7 (+ (* 48 s3-0) 2544 (scratchpad-object int))))
|
|
(if (-> a0-17 param0)
|
|
((the-as (function cspace matrix none) (-> a0-17 param0)) a0-17 (the-as matrix a1-7))
|
|
(cspace<-parented-transformq-joint! a0-17 (the-as transformq a1-7)))))))
|
|
(if (-> obj skel postbind-function) ((-> obj skel postbind-function) obj))
|
|
(let ((v1-54 (-> obj draw origin-joint-index)))
|
|
(if (zero? v1-54)
|
|
(set! (-> obj draw origin quad)
|
|
(-> (the-as (pointer uint128)
|
|
(+ (the-as uint (-> obj draw skeleton bones 0 transform vector 3)) (* (the-as uint 96) v1-54)))))
|
|
(vector<-cspace! (-> obj draw origin) (-> obj node-list data v1-54))))))
|
|
(#when PC_PORT
|
|
(when *debug-segment*
|
|
(if *display-bones* (draw-bone-lines obj))
|
|
(if *display-joint-names* (draw-joint-spheres obj))))
|
|
0
|
|
(none))
|
|
|
|
(defmethod cleanup-for-death ((this process-drawable))
|
|
(if (type-type? (-> this root type) collide-shape) (clear-collide-with-as (the-as collide-shape (-> this root))))
|
|
(if (nonzero? (-> this skel)) (ja-channel-set! 0))
|
|
(process-entity-status! this (entity-perm-status dead) #t)
|
|
(none))
|
|
|
|
(defun draw-joint-spheres ((arg0 process-drawable))
|
|
(dotimes (s5-0 (-> arg0 node-list length))
|
|
(let ((a2-0 (vector<-cspace! (new-stack-vector0) (-> arg0 node-list data s5-0))))
|
|
(add-debug-sphere #t (bucket-id debug) a2-0 (meters 0.1) (static-rgba 0 #xff 0 #x40))
|
|
(#when PC_PORT
|
|
(add-debug-text-sphere (!= (-> arg0 node-list data s5-0 joint) #f)
|
|
(bucket-id debug)
|
|
a2-0
|
|
(meters 0.1)
|
|
(-> arg0 node-list data s5-0 joint name)
|
|
(static-rgba 0 #xff 0 #x40)))))
|
|
#f)
|
|
|
|
(defmethod deactivate ((this process-drawable))
|
|
(if (nonzero? (-> this part)) (kill-and-free-particles (-> this part)))
|
|
(if (nonzero? (-> this sound)) (stop! (-> this sound)))
|
|
((method-of-type process deactivate) this)
|
|
(none))
|
|
|
|
(defstate process-drawable-art-error (process-drawable)
|
|
:code
|
|
(behavior ((arg0 string))
|
|
(logior! (-> self entity extra perm status) (entity-perm-status bit-1))
|
|
(loop
|
|
(when *display-entity-errors*
|
|
(let ((s5-0 add-debug-text-3d)
|
|
(s4-0 #t)
|
|
(s3-0 68))
|
|
(format (clear *temp-string*) "~2j~s art error for ~s" arg0 (-> self name))
|
|
(s5-0 s4-0 (the-as bucket-id s3-0) *temp-string* (-> self root trans) (font-color red) (the-as vector2h #f))))
|
|
(suspend))
|
|
(none)))
|
|
|
|
(define-extern ja-post (function none :behavior process-drawable))
|
|
|
|
(define-extern anim-loop (function none :behavior process-drawable))
|
|
|
|
(defstate process-drawable-idle (process-drawable)
|
|
:code anim-loop
|
|
:post ja-post)
|
|
|
|
(defmethod initialize-skeleton ((this process-drawable) (arg0 skeleton-group) (arg1 pair))
|
|
(local-vars (s3-0 draw-control))
|
|
(let ((s1-0 (cond
|
|
((= (-> arg0 texture-level) 2) (-> *level* level-default))
|
|
((-> this entity) (-> this entity extra level))
|
|
(else (-> *level* level-default)))))
|
|
(let ((s4-0 (load-to-heap-by-name (-> s1-0 art-group) (-> arg0 art-group-name) #f global (-> arg0 version))))
|
|
(when (or (zero? s4-0) (or (not s4-0) (!= (-> s4-0 type) art-group)))
|
|
(go process-drawable-art-error "art-group")
|
|
(set! s3-0 (the-as draw-control #f))
|
|
(goto cfg-59))
|
|
(let ((sv-16 (-> s4-0 data (-> arg0 jgeo)))
|
|
(sv-20 (-> s4-0 length)))
|
|
(when (or (>= (-> arg0 jgeo) sv-20) (!= (-> sv-16 type) art-joint-geo))
|
|
(go process-drawable-art-error "joint-geo")
|
|
(set! s3-0 (the-as draw-control #f))
|
|
(goto cfg-59))
|
|
(let ((v0-3 (new 'process 'draw-control this (the-as art-joint-geo sv-16)))) (set! (-> this draw) v0-3) (set! s3-0 v0-3))
|
|
(let ((v1-26 s3-0))
|
|
(set! (-> v1-26 status) (draw-status no-skeleton-update))
|
|
(set! (-> v1-26 art-group) s4-0)
|
|
(set! (-> v1-26 jgeo) (the-as art-joint-geo sv-16))
|
|
(set! (-> v1-26 force-lod) -1)
|
|
(set! (-> v1-26 cur-lod) -1)
|
|
(set! (-> v1-26 shadow) #f)
|
|
(set! (-> v1-26 shadow-ctrl) #f)
|
|
(set! (-> v1-26 data-format) (the-as uint 1))
|
|
(set! (-> v1-26 color-mult quad) (-> (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0) quad))
|
|
(set! (-> v1-26 color-emissive quad) (-> (new 'static 'vector) quad))
|
|
(set! (-> v1-26 level-index)
|
|
(the-as uint (-> (if (-> this entity) (-> this entity extra level) (-> *level* level-default)) index)))
|
|
(set! (-> v1-26 longest-edge) (-> arg0 longest-edge))
|
|
(set! (-> v1-26 ripple) #f))
|
|
(set! (-> s3-0 bounds quad) (-> arg0 bounds quad))
|
|
(let ((v1-28 (-> arg0 shadow)))
|
|
(when (and (> v1-28 0) (< v1-28 sv-20))
|
|
(let ((s0-0 (-> s4-0 data v1-28))
|
|
(v1-32 (res-lump-value (-> this entity) 'options uint128)))
|
|
(if (and (not (logtest? #x20000 v1-32)) (= (-> s0-0 type) shadow-geo)) (set! (-> s3-0 shadow) (the-as shadow-geo s0-0))))))
|
|
(if (not (setup-lods! (-> s3-0 lod-set) arg0 s4-0 (-> this entity))) (go process-drawable-art-error "mesh"))
|
|
(let ((v1-43 (res-lump-value (-> sv-16 extra) 'texture-bucket int :default (the-as uint128 1))))
|
|
(let ((a0-39 (if (= (-> arg0 texture-level) 2) 2 (-> s1-0 index))))
|
|
(if (= (the-as uint v1-43) 4) (set! v1-43 2))
|
|
(if (= a0-39 2) (set! v1-43 (-> arg0 sort))))
|
|
(set! (-> s3-0 sink-group) (-> s1-0 foreground-sink-group v1-43)))
|
|
(set! (-> s3-0 dma-add-func) (the-as (function process-drawable draw-control symbol object none) nothing))
|
|
(set! (-> this node-list) (make-nodes-from-jg (the-as art-joint-geo sv-16) arg1 'process))
|
|
(set! (-> s3-0 dma-add-func) dma-add-process-drawable)
|
|
(set! (-> s3-0 shadow-mask) (res-lump-value (-> this entity) 'shadow-mask uint))
|
|
(set! (-> s3-0 light-index) (res-lump-value (-> this entity) 'light-index uint))
|
|
(lod-set! s3-0 0)
|
|
(let ((a2-10 (res-lump-value (-> sv-16 extra) 'joint-channel int :default (the-as uint128 6))))
|
|
(cond
|
|
((> a2-10 0)
|
|
(logior! (-> s3-0 status) (draw-status has-joint-channels))
|
|
(let ((v0-13 (new 'process 'joint-control a2-10)))
|
|
(set! (-> this skel) v0-13)
|
|
(let ((s2-1 v0-13))
|
|
(cond
|
|
((>= (-> arg0 janim) 0)
|
|
(when (or (>= (-> arg0 janim) sv-20) (!= (-> s4-0 data (-> arg0 janim) type) art-joint-anim))
|
|
(go process-drawable-art-error "initial joint-anim")
|
|
(set! s3-0 (the-as draw-control #f))
|
|
(goto cfg-59))
|
|
(ja-channel-set! 1)
|
|
(let ((s1-1 (-> this skel root-channel 0)))
|
|
(joint-control-channel-group-eval! s1-1 (the-as art-joint-anim (-> s4-0 data (-> arg0 janim))) num-func-identity)
|
|
(set! (-> s1-1 frame-num) 0.0)))
|
|
(else (ja-channel-set! 0)))
|
|
(set! (-> s2-1 effect) (new 'process 'effect-control this)))))
|
|
(else
|
|
(set! (-> s3-0 skeleton bones 0 transform vector 3 quad)
|
|
(-> (the-as vector
|
|
(get-property-struct (-> sv-16 extra)
|
|
'trans-offset
|
|
'interp
|
|
-1000000000.0
|
|
*null-vector*
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*))
|
|
quad))))))))
|
|
(let ((gp-1 (the-as collide-shape (-> (the-as collide-shape this) dir-targ x))))
|
|
(if (and gp-1 (nonzero? gp-1) (type-type? (-> gp-1 type) collide-shape)) (find-collision-meshes gp-1)))
|
|
(label cfg-59)
|
|
(none))
|
|
|
|
(defmethod initialize-skeleton-by-name ((this process-drawable) (arg0 string) (arg1 object))
|
|
(let ((s3-0 string->symbol))
|
|
(format (clear *temp-string*) "*~S-sg*" arg0)
|
|
(let ((s3-1 (-> (s3-0 *temp-string*) value)))
|
|
(if (and (nonzero? s3-1) (valid? s3-1 skeleton-group #f #f 0))
|
|
(initialize-skeleton this (the-as skeleton-group s3-1) (the-as pair arg1))
|
|
(go process-drawable-art-error arg0))))
|
|
this)
|
|
|
|
(defmethod apply-alignment ((this process-drawable) (arg0 align-opts) (arg1 transformq) (arg2 vector))
|
|
(when (logtest? arg0 (align-opts adjust-x-vel adjust-y-vel adjust-xz-vel))
|
|
(let* ((body-T-world (quaternion->matrix (new 'stack-no-clear 'matrix) (-> this root quat)))
|
|
(world-T-body (matrix-transpose! (new 'stack-no-clear 'matrix) body-T-world))
|
|
(grav-rt-body (vector-matrix*! (new 'stack-no-clear 'vector) (-> *standard-dynamics* gravity) world-T-body))
|
|
(vel-rt-body (vector-matrix*! (new 'stack-no-clear 'vector) (-> this root transv) world-T-body)))
|
|
(if (logtest? arg0 (align-opts no-gravity)) (set-vector! grav-rt-body 0.0 0.0 0.0 1.0))
|
|
(when (logtest? arg0 (align-opts adjust-x-vel))
|
|
(set! (-> vel-rt-body x)
|
|
(+ (* (-> arg1 trans x) (-> arg2 x) (-> *display* frames-per-second)) (* (-> grav-rt-body x) (seconds-per-frame))))
|
|
(if (not (logtest? arg0 (align-opts adjust-xz-vel keep-other-velocities))) (set! (-> vel-rt-body z) 0.0)))
|
|
(if (and (logtest? arg0 (align-opts adjust-y-vel))
|
|
(not (and (logtest? arg0 (align-opts ignore-y-if-zero)) (= (-> arg1 trans y) 0.0))))
|
|
(set! (-> vel-rt-body y)
|
|
(+ (* (-> arg1 trans y) (-> arg2 y) (-> *display* frames-per-second)) (* (-> grav-rt-body y) (seconds-per-frame)))))
|
|
(when (logtest? arg0 (align-opts adjust-xz-vel))
|
|
(set! (-> vel-rt-body z)
|
|
(+ (* (-> arg1 trans z) (-> arg2 z) (-> *display* frames-per-second)) (* (-> grav-rt-body z) (seconds-per-frame))))
|
|
(if (not (logtest? arg0 (align-opts adjust-x-vel keep-other-velocities))) (set! (-> vel-rt-body x) 0.0)))
|
|
(vector-matrix*! (-> this root transv) vel-rt-body body-T-world)))
|
|
(if (logtest? arg0 (align-opts adjust-quat))
|
|
(quaternion-normalize! (quaternion*! (-> this root quat) (-> this root quat) (-> arg1 quat))))
|
|
(the-as collide-shape (-> this root)))
|
|
|
|
(defbehavior ja-done? process-drawable ((arg0 int))
|
|
(let ((v1-2 (-> self skel root-channel arg0)))
|
|
(cond
|
|
((zero? (-> self skel active-channels)) #t)
|
|
((= (-> v1-2 num-func) num-func-seek!) (= (-> v1-2 frame-num) (-> v1-2 param 0)))
|
|
(else #t))))
|
|
|
|
(defbehavior ja-min? process-drawable ((arg0 int))
|
|
(= (-> self skel root-channel arg0 frame-num) 0.0))
|
|
|
|
(defbehavior ja-max? process-drawable ((arg0 int))
|
|
(let ((v1-2 (-> self skel root-channel arg0)))
|
|
(>= (-> v1-2 frame-num) (the float (+ (-> v1-2 frame-group data 0 length) -1)))))
|
|
|
|
(defbehavior ja-num-frames process-drawable ((arg0 int))
|
|
(+ (-> self skel root-channel arg0 frame-group data 0 length) -1))
|
|
|
|
(defbehavior ja-frame-num process-drawable ((arg0 int))
|
|
(-> self skel root-channel arg0 frame-num))
|
|
|
|
(defbehavior ja-aframe-num process-drawable ((arg0 int))
|
|
(let* ((a0-2 (-> self skel root-channel arg0))
|
|
(v1-2 (-> a0-2 frame-group)))
|
|
(+ (* (-> a0-2 frame-num) (-> v1-2 artist-step)) (if (and v1-2 (nonzero? v1-2)) (-> v1-2 artist-base) 0.0))))
|
|
|
|
(defbehavior ja-aframe process-drawable ((arg0 float) (arg1 int))
|
|
(let ((v1-3 (-> self skel root-channel arg1 frame-group)))
|
|
(/ (- arg0 (if (and v1-3 (nonzero? v1-3)) (-> v1-3 artist-base) 0.0)) (if v1-3 (-> v1-3 artist-step) 1.0))))
|
|
|
|
(defbehavior ja-speed process-drawable ((arg0 int))
|
|
(-> self skel root-channel arg0 frame-group speed))
|
|
|
|
(defbehavior ja-step process-drawable ((arg0 int))
|
|
(-> self skel root-channel arg0 frame-group artist-step))
|
|
|
|
(defbehavior ja-channel-set! process-drawable ((arg0 int))
|
|
(set! (-> self skel active-channels) arg0)
|
|
(set! (-> self skel root-channel) (-> self skel channel))
|
|
(set! (-> self skel blend-index) -1)
|
|
(set! (-> self skel root-channel 0 frame-group) #f)
|
|
(dotimes (v1-6 arg0)
|
|
(set! (-> self skel root-channel v1-6 eval-time) (the-as uint (current-time)))
|
|
(set! (-> self skel root-channel v1-6 group-sub-index) v1-6)
|
|
(set! (-> self skel root-channel v1-6 command) (if (zero? v1-6) 'push 'blend))
|
|
(set! (-> self skel root-channel v1-6 frame-interp) 0.0)
|
|
(set! (-> self skel root-channel v1-6 frame-num) 0.0)
|
|
(set! (-> self skel root-channel v1-6 frame-group) #f)
|
|
(set! (-> self skel root-channel v1-6 num-func) num-func-none)
|
|
(set! (-> self skel root-channel v1-6 group-size) arg0))
|
|
arg0)
|
|
|
|
(defbehavior ja-channel-push! process-drawable ((arg0 int) (arg1 time-frame))
|
|
(cond
|
|
((or (zero? (-> self skel active-channels))
|
|
(zero? arg1)
|
|
(when (>= (+ (-> self skel active-channels) arg0) (-> self skel allocated-length))
|
|
(format 0
|
|
"WARNING: ~A could not do (ja-channel-push ~D) because it has ~D/~D channels.~%"
|
|
self
|
|
arg0
|
|
(-> self skel active-channels)
|
|
(-> self skel allocated-length))
|
|
#t))
|
|
(ja-channel-set! arg0))
|
|
(else
|
|
(when (not (-> self skel root-channel 0 frame-group))
|
|
(set! (-> self skel active-channels)
|
|
(/ (&- (the-as pointer (-> self skel root-channel)) (the-as uint (the-as pointer (-> self skel channel)))) 48))
|
|
(if (zero? (-> self skel active-channels)) (return (ja-channel-set! arg0))))
|
|
(set! (-> self skel root-channel)
|
|
(the-as (inline-array joint-control-channel) (-> self skel channel (-> self skel active-channels))))
|
|
(set! (-> self skel active-channels) (+ arg0 1 (-> self skel active-channels)))
|
|
(dotimes (v1-26 arg0)
|
|
(set! (-> self skel root-channel v1-26 eval-time) (the-as uint (current-time)))
|
|
(set! (-> self skel root-channel v1-26 group-sub-index) v1-26)
|
|
(set! (-> self skel root-channel v1-26 command) (if (zero? v1-26) 'push 'blend))
|
|
(set! (-> self skel root-channel v1-26 frame-interp) 0.0)
|
|
(set! (-> self skel root-channel v1-26 frame-num) 0.0)
|
|
(set! (-> self skel root-channel v1-26 frame-group) #f)
|
|
(set! (-> self skel root-channel v1-26 num-func) num-func-none)
|
|
(set! (-> self skel root-channel v1-26 group-size) arg0))
|
|
(let ((v1-31 (-> self skel root-channel arg0)))
|
|
(set! (-> v1-31 eval-time) (the-as uint (current-time)))
|
|
(set! (-> v1-31 group-sub-index) arg0)
|
|
(set! (-> self skel blend-index) (+ (-> self skel active-channels) -1))
|
|
(set! (-> v1-31 frame-interp) 0.0)
|
|
(set! (-> v1-31 frame-num) 0.0)
|
|
(set! (-> v1-31 frame-group) #f)
|
|
(set! (-> v1-31 group-size) arg0)
|
|
(set! (-> v1-31 param 0) (/ 5.0 (+ 5.0 (the float arg1))))
|
|
(set! (-> v1-31 num-func) num-func-blend-in!)
|
|
(cond
|
|
((= arg0 1) (set! (-> v1-31 command) 'stack1) (set! (-> self skel root-channel 0 command) 'push1))
|
|
(else (set! (-> v1-31 command) 'stack))))
|
|
arg0)))
|
|
|
|
(defbehavior joint-control-reset! process-drawable ((arg0 joint-control) (arg1 joint-control-channel))
|
|
(let* ((v1-2 (the-as joint-control-channel (&- (the-as pointer arg1) (the-as uint (* 48 (-> arg1 group-size))))))
|
|
(s5-0 (/ (&- (the-as pointer v1-2) (the-as uint (the-as pointer (-> arg0 channel)))) 48))
|
|
(s4-0 (/ (&- (the-as pointer arg1) (the-as uint v1-2)) 48)))
|
|
(when (> s5-0 0)
|
|
(if (= (-> v1-2 command) 'push1) (set! (-> v1-2 command) 'push))
|
|
(if (= (-> arg0 root-channel) v1-2)
|
|
(set! (-> arg0 root-channel) (-> arg0 channel))
|
|
(set! (-> arg0 root-channel) (the-as (inline-array joint-control-channel) (-> arg0 root-channel (- (+ s5-0 1))))))
|
|
(qmem-copy<-! (the-as pointer (-> arg0 channel)) (the-as pointer v1-2) (* 48 (- (-> arg0 active-channels) s5-0)))
|
|
(qmem-copy<-! (the-as pointer (-> arg0 channel s4-0))
|
|
(the-as pointer (+ (the-as uint (-> arg0 channel 1)) (* 48 s4-0)))
|
|
(* 48 (+ (- (- -1 s5-0) s4-0) (-> arg0 active-channels))))
|
|
(set! (-> arg0 active-channels) (- (-> arg0 active-channels) (+ s5-0 1)))))
|
|
(none))
|
|
|
|
(defbehavior ja-group-size process-drawable ()
|
|
(if (< (the-as int (-> self skel root-channel)) (the-as int (-> self skel channel (-> self skel active-channels))))
|
|
(-> self skel root-channel 0 group-size)
|
|
0))
|
|
|
|
(defbehavior ja-eval process-drawable ()
|
|
(let ((gp-0 (-> self skel root-channel 0))
|
|
(s5-0 (-> self skel channel (-> self skel active-channels)))
|
|
(s4-0 (current-time)))
|
|
(while (< (the-as int gp-0) (the-as int s5-0))
|
|
(case (-> gp-0 command)
|
|
(('stack 'stack1))
|
|
(else (if (!= (-> gp-0 eval-time) s4-0) (joint-control-channel-eval gp-0))))
|
|
(&+! gp-0 48)))
|
|
0)
|
|
|
|
(defbehavior ja-blend-eval process-drawable ()
|
|
(let ((gp-0 (-> self skel root-channel))
|
|
(s5-0 (the-as joint-control-channel (-> self skel channel)))
|
|
(s4-0 (current-time)))
|
|
(when (and (nonzero? (-> self skel active-channels)) (!= gp-0 s5-0))
|
|
(while (< (the-as int s5-0) (the-as int gp-0))
|
|
(case (-> s5-0 command)
|
|
(('stack 'stack1))
|
|
(else (if (!= (-> s5-0 eval-time) s4-0) (joint-control-channel-eval s5-0))))
|
|
(&+! s5-0 48))))
|
|
0)
|
|
|
|
;; ERROR: Unsupported inline assembly instruction kind - [lw ra, return-from-thread(s7)]
|
|
;; ERROR: Unsupported inline assembly instruction kind - [jr ra]
|
|
(defmethod evaluate-joint-control ((this process-drawable))
|
|
(local-vars (s7-0 none) (ra-0 int))
|
|
(let ((gp-0 (-> this skel)))
|
|
(label cfg-1)
|
|
(let ((s4-0 (-> gp-0 active-channels)))
|
|
(b! (logtest? (-> this draw status) (draw-status hidden)) cfg-27 :delay (empty-form))
|
|
(let ((s3-0 0))
|
|
(b! #t cfg-13 :delay (nop!))
|
|
(label cfg-3)
|
|
(let ((s2-0 (-> gp-0 channel s3-0)))
|
|
(let ((v1-7 (-> s2-0 command)))
|
|
(b! (!= v1-7 'stack) cfg-6 :delay (nop!))
|
|
(joint-control-channel-eval s2-0)
|
|
(b! (!= s4-0 (-> gp-0 active-channels)) cfg-1 :delay (nop!))
|
|
(b! #t cfg-12 :delay (nop!))
|
|
(label cfg-6)
|
|
(b! (!= v1-7 'stack1) cfg-9 :delay (nop!)))
|
|
(joint-control-channel-eval s2-0)
|
|
(b! (!= s4-0 (-> gp-0 active-channels)) cfg-1 :delay (nop!))
|
|
(set! (-> gp-0 channel (+ s3-0 -1) frame-interp) (-> s2-0 frame-interp))
|
|
(b! #t cfg-12 :delay (nop!))
|
|
(label cfg-9)
|
|
(let ((s1-0 (-> s2-0 frame-group)))
|
|
(let ((v1-16 art-joint-anim)) (b! (= (-> s1-0 type) v1-16) cfg-11))
|
|
(go process-drawable-art-error "joint-anim")
|
|
(format 0 "process-drawable::evaluate-joint-control bad for ~A~%" this)
|
|
(break!)
|
|
(nop!)
|
|
0
|
|
(label cfg-11)
|
|
(set! (-> s2-0 frame-num) (fmax 0.0 (fmin (-> s2-0 frame-num) (the float (+ (-> s1-0 data 0 length) -1)))))))
|
|
(label cfg-12)
|
|
(+! s3-0 1)
|
|
(label cfg-13)
|
|
(b! (< s3-0 s4-0) cfg-3))
|
|
(dotimes (v1-26 s4-0)
|
|
(set! (-> gp-0 channel v1-26 frame-interp) (fmax 0.0 (fmin 1.0 (-> gp-0 channel v1-26 frame-interp)))))
|
|
(if (or (zero? s4-0) (not (-> gp-0 root-channel 0 frame-group))) (logior! (-> this draw status) (draw-status no-anim))))
|
|
(if (logtest? (-> this skel status) (janim-status blerc blerc-done)) (merc-blend-shape this))
|
|
(if (logtest? (-> this skel status) (janim-status eye-done eye)) (merc-eye-anim this))
|
|
(label cfg-27)
|
|
(let ((a0-17 (-> gp-0 effect))) (if a0-17 (effect-control-method-9 a0-17))))
|
|
0
|
|
(none))
|
|
|
|
;; WARN: Function ja-post has a return type of none, but the expression builder found a return statement.
|
|
(defbehavior ja-post process-drawable ()
|
|
(when (nonzero? (-> self draw))
|
|
(let ((gp-1 (logtest? (-> self draw status) (draw-status no-skeleton-update))))
|
|
(logclear! (-> self draw status) (draw-status no-anim no-skeleton-update))
|
|
(when (nonzero? (-> self skel))
|
|
(evaluate-joint-control self)
|
|
(when (or (logtest? (-> self skel status) (janim-status inited)) gp-1)
|
|
(do-joint-math! self)
|
|
(if (and gp-1 (type-type? (-> self root type) collide-shape)) (update-transforms! (the-as collide-shape (-> self root))))
|
|
(return #f))))
|
|
;; og:preserve-this added matrix-engine check for PC port
|
|
(if (< (-> *matrix-engine* length) MATRIX_ENGINE_AMOUNT)
|
|
(let ((v1-24 *matrix-engine*)) (set! (-> v1-24 (-> v1-24 length)) (process->handle self)) (+! (-> v1-24 length) 1))))
|
|
0
|
|
(none))
|
|
|
|
(defmethod current-cycle-distance ((this joint-control))
|
|
(cond
|
|
((< (the-as int (-> this root-channel)) (the-as int (-> this channel (-> this active-channels))))
|
|
(let ((s5-0 (-> this root-channel (-> this root-channel 0 group-size)))
|
|
(s4-0 (the-as joint-control-channel (-> this root-channel)))
|
|
(gp-0 (the-as (pointer float) (new 'stack-no-clear 'vector))))
|
|
(while (< (the-as int s4-0) (the-as int s5-0))
|
|
(case (-> s4-0 command)
|
|
(('push) (set! (-> gp-0 0) (-> s4-0 dist)) (set! gp-0 (&-> gp-0 1)))
|
|
(('blend 'push1) (set! (-> gp-0 -1) (lerp (-> gp-0 -1) (-> s4-0 dist) (-> s4-0 frame-interp))))
|
|
(('stack) (set! (-> gp-0 -2) (lerp (-> gp-0 -2) (-> gp-0 -1) (-> s4-0 frame-interp))) (set! gp-0 (&-> gp-0 -1))))
|
|
(&+! s4-0 48))
|
|
(-> gp-0 -1)))
|
|
(else 0.0)))
|
|
|
|
(defbehavior anim-loop process-drawable ()
|
|
(logior! (-> self mask) (process-mask sleep-code))
|
|
(loop
|
|
(nop!)
|
|
(suspend))
|
|
(none))
|
|
|
|
(defbehavior transform-post process-drawable ()
|
|
(ja-post)
|
|
(update-transforms! (the-as collide-shape (-> self root)))
|
|
0)
|
|
|
|
(defbehavior rider-trans process-drawable ()
|
|
(detect-riders! (the-as collide-shape (-> self root)))
|
|
0)
|
|
|
|
(defbehavior rider-post process-drawable ()
|
|
(ja-post)
|
|
(let ((gp-0 (the-as collide-shape (-> self root)))) (update-transforms! gp-0) (pull-riders! gp-0) (do-push-aways! gp-0))
|
|
0)
|
|
|
|
(defbehavior pusher-post process-drawable ()
|
|
(ja-post)
|
|
(let ((gp-0 (the-as collide-shape (-> self root)))) (update-transforms! gp-0) (do-push-aways! gp-0))
|
|
0)
|
|
|
|
(defbehavior process-drawable-delay-player process-drawable ((arg0 time-frame))
|
|
(while (and *target*
|
|
(logtest? (-> *target* control mod-surface flags) (surface-flags jump))
|
|
(not (logtest? (-> *target* control status) (cshape-moving-flags onsurf))))
|
|
(suspend))
|
|
(set-time! (-> self state-time))
|
|
(process-grab? *target*)
|
|
(while (or (-> *setting-control* current talking)
|
|
(-> *setting-control* current spooling)
|
|
(-> *setting-control* current hint)
|
|
(-> *setting-control* current ambient))
|
|
(suspend))
|
|
(while (not (time-elapsed? (-> self state-time) arg0))
|
|
(suspend))
|
|
(process-release? *target*)
|
|
(suspend)
|
|
0)
|
|
|
|
(defbehavior process-drawable-fuel-cell-handler process-drawable ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
|
|
(case arg2
|
|
(('notify)
|
|
(case (-> arg3 param 0)
|
|
(('pickup) (if (type-type? (-> arg0 type) fuel-cell) (process-entity-status! self (entity-perm-status dead) #t)))))))
|
|
|
|
;; WARN: Found some very strange gotos. Check result carefully, this is not well tested.
|
|
(defbehavior process-drawable-birth-fuel-cell process-drawable ((arg0 entity) (arg1 vector) (arg2 symbol))
|
|
(let ((v1-0 arg0)
|
|
(gp-0 (new 'stack-no-clear 'vector)))
|
|
(if (not v1-0) (set! v1-0 (-> self entity)))
|
|
(if arg1 (set! (-> gp-0 quad) (-> arg1 quad)) (set! (-> gp-0 quad) (-> v1-0 extra trans quad)))
|
|
(let ((s5-0 (-> v1-0 extra perm task))
|
|
(s4-0 (new 'static 'fact-info)))
|
|
(set! (-> s4-0 options) (fact-options))
|
|
(if arg2 (set! (-> s4-0 options) (fact-options instant-collect)))
|
|
(when (and (nonzero? s5-0) (not (task-complete? *game-info* s5-0)))
|
|
(label cfg-12)
|
|
(birth-pickup-at-point gp-0 (pickup-type fuel-cell) (the float s5-0) #f self s4-0)
|
|
(when (not (-> self child))
|
|
(suspend)
|
|
(goto cfg-12)))))
|
|
0
|
|
(none))
|
|
|
|
;; this part is debug only
|
|
(when *debug-segment*
|
|
(define *valid-con* (new 'debug 'string #x4000 (the-as string #f))))
|
|
|
|
(defun-debug process-drawable-valid? ((arg0 process-drawable))
|
|
(let ((s5-0 #t))
|
|
(clear *valid-con*)
|
|
(format *valid-con* "~%--- ~A -----------------------------~%" arg0)
|
|
(dotimes (s4-0 (-> arg0 node-list length))
|
|
(let ((s3-0 (-> arg0 node-list data s4-0)))
|
|
(when (-> s3-0 geo)
|
|
(cond
|
|
((valid? (-> s3-0 geo) drawable "cspace geo" #t *valid-con*))
|
|
(else (format *valid-con* "ERROR: ~A has an invalid geo ~A~%" s3-0 (-> s3-0 geo)) (set! s5-0 #f))))))
|
|
(let ((s4-1 (-> arg0 skel active-channels)))
|
|
(when (< (-> arg0 skel allocated-length) s4-1)
|
|
(format *valid-con*
|
|
"ERROR: ~~A has ~D joint channels, but only ~D are allowed~%"
|
|
arg0
|
|
s4-1
|
|
(-> arg0 skel allocated-length))
|
|
(set! s5-0 #f))
|
|
(dotimes (s3-1 s4-1)
|
|
(let ((s2-0 (-> arg0 skel channel s3-1)))
|
|
(case (-> s2-0 command)
|
|
(('stack 'stack1))
|
|
(else
|
|
(set! s5-0
|
|
(cond
|
|
((valid? (-> s2-0 frame-group) art-joint-anim "joint-control frame-group" #t *valid-con*)
|
|
(when (not (and (>= (the int (-> s2-0 frame-num)) 0) (< (the int (-> s2-0 frame-num)) (-> s2-0 frame-group data 0 length))))
|
|
(format *valid-con*
|
|
"ERROR: ~`joint-control-channel`P #~D has an invalid frame-num ~F/~D [0-~D]~%"
|
|
s2-0
|
|
s3-1
|
|
(-> s2-0 frame-num)
|
|
(the int (-> s2-0 frame-num))
|
|
(+ (-> s2-0 frame-group data 0 length) -1))
|
|
(set! s5-0 #f))
|
|
s5-0)
|
|
(else
|
|
(format *valid-con*
|
|
"ERROR: ~`joint-control-channel`P #~D has an invalid frame-group ~A~%"
|
|
s2-0
|
|
s3-1
|
|
(-> s2-0 frame-group))
|
|
#f))))))))
|
|
(when (not s5-0)
|
|
(format *valid-con* "--------------------------------~%~%")
|
|
(format 0 "~S" *valid-con*))
|
|
s5-0))
|