Files
water111 637990314b wip: better stack var support (#4222)
Closes #736

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2026-04-19 00:14:44 +02:00

970 lines
34 KiB
Common Lisp
Vendored
Generated

;;-*-Lisp-*-
(in-package goal)
;; definition for method 3 of type load-dir
;; INFO: Used lq/sq
(defmethod inspect ((this load-dir))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tlevel: ~A~%" (-> this lev))
(format #t "~Tallocated-length: ~D~%" (-> this string-array allocated-length))
(format #t "~Tlength: ~D~%" (-> this string-array length))
(dotimes (s5-0 (-> this string-array length))
(format
#t
"~T [~D] ~S ~A (~D bytes)~%"
s5-0
(-> this string-array s5-0)
(-> this data-array s5-0)
(mem-size (-> this data-array s5-0) #f 0)
)
)
this
)
;; definition for method 8 of type load-dir
;; INFO: Return type mismatch symbol vs load-dir.
(defmethod mem-usage ((this load-dir) (usage memory-usage-block) (flags int))
(set! (-> usage length) (max 82 (-> usage length)))
(set! (-> usage data 81 name) "array")
(+! (-> usage data 81 count) 1)
(let ((v1-6 (asize-of this)))
(+! (-> usage data 81 used) v1-6)
(+! (-> usage data 81 total) (logand -16 (+ v1-6 15)))
)
(set! (-> usage length) (max 82 (-> usage length)))
(set! (-> usage data 81 name) "array")
(set! (-> usage data 81 count) (-> usage data 81 count))
(let ((v1-15 (asize-of (-> this string-array))))
(+! (-> usage data 81 used) v1-15)
(+! (-> usage data 81 total) (logand -16 (+ v1-15 15)))
)
(set! (-> usage length) (max 82 (-> usage length)))
(set! (-> usage data 81 name) "array")
(set! (-> usage data 81 count) (-> usage data 81 count))
(let ((v1-24 (asize-of (-> this data-array))))
(+! (-> usage data 81 used) v1-24)
(+! (-> usage data 81 total) (logand -16 (+ v1-24 15)))
)
(dotimes (s3-0 (-> this data-array length))
(mem-usage (-> this data-array s3-0) usage flags)
)
(the-as load-dir #f)
)
;; definition for method 9 of type load-dir-art-group
(defmethod load-to-heap-by-name ((this load-dir-art-group) (art-name string) (do-reload symbol) (heap kheap) (version int))
(let ((s5-0 (-> this string-array)))
(dotimes (s3-0 (-> s5-0 length))
(when (string= art-name (-> s5-0 s3-0))
(when do-reload
(let ((v1-4 (art-group-load-check art-name heap version)))
(if v1-4
(set! (-> this art-group-array s3-0) v1-4)
)
)
)
(return (-> this art-group-array s3-0))
)
)
(let ((v0-2 (art-group-load-check art-name heap version)))
(when v0-2
(set! (-> s5-0 (-> s5-0 length)) art-name)
(set! (-> this art-group-array (-> s5-0 length)) v0-2)
(+! (-> s5-0 length) 1)
(+! (-> this art-group-array length) 1)
)
v0-2
)
)
)
;; definition for method 10 of type load-dir-art-group
(defmethod set-loaded-art ((this load-dir-art-group) (arg0 art-group))
(let ((s4-0 (-> this string-array)))
(dotimes (s3-0 (-> s4-0 length))
(when (string= (-> arg0 name) (-> s4-0 s3-0))
(set! (-> this art-group-array s3-0) arg0)
(set! arg0 (-> this art-group-array s3-0))
(goto cfg-7)
)
)
(set! (-> s4-0 (-> s4-0 length)) (-> arg0 name))
(set! (-> this art-group-array (-> s4-0 length)) arg0)
(+! (-> s4-0 length) 1)
)
(+! (-> this art-group-array length) 1)
(label cfg-7)
arg0
)
;; definition for function drawable-load
(defun drawable-load ((arg0 drawable) (arg1 kheap))
(local-vars (sp-0 pointer))
(cond
((type-type? (-> arg0 type) string)
(the-as none sp-0)
(if (< (the-as uint sp-0) (the-as uint *stack-top*))
(set! sp-0 (&+ *kernel-sp* -1024))
)
(let ((s5-1 (the-as drawable (loado (the-as string arg0) arg1))))
(if (and s5-1 (type-type? (-> s5-1 type) drawable))
(login s5-1)
)
)
)
((type-type? (-> arg0 type) drawable)
(login arg0)
)
)
)
;; definition for function art-load
(defun art-load ((arg0 string) (arg1 kheap))
(local-vars (sp-0 pointer))
(the-as none sp-0)
(if (< (the-as uint sp-0) (the-as uint *stack-top*))
(set! sp-0 (&+ *kernel-sp* -1024))
)
(let ((s5-0 (loado arg0 arg1)))
(if (type-type? (-> (the-as art s5-0) type) art)
(login (the-as art s5-0))
(the-as art #f)
)
)
)
;; definition for function art-group-load-check
(defun art-group-load-check ((arg0 string) (arg1 kheap) (arg2 int))
(local-vars (sp-0 pointer))
(when *debug-segment*
(the-as none sp-0)
(if (< (the-as uint sp-0) (the-as uint *stack-top*))
(set! sp-0 (&+ *kernel-sp* -1024))
)
(let ((s3-1 (the-as art-group (loado (make-file-name (file-kind art-group) arg0 arg2 #f) arg1))))
(cond
((not s3-1)
(format 0 "ERROR: art-group ~A is not a valid file.~%" arg0)
(the-as art-group #f)
)
((not (type-type? (-> s3-1 type) art-group))
(format 0 "ERROR: art-group ~A is not a art-group.~%" arg0)
(the-as art-group #f)
)
((not (file-info-correct-version? (-> s3-1 info) (file-kind art-group) arg2))
(the-as art-group #f)
)
(else
(login s3-1)
)
)
)
)
)
;; definition for method 9 of type external-art-buffer
(defmethod set-pending-file ((this external-art-buffer) (arg0 string) (arg1 int) (arg2 handle) (arg3 float))
(set! (-> this pending-load-file) arg0)
(set! (-> this pending-load-file-part) arg1)
(set! (-> this pending-load-file-owner) arg2)
(set! (-> this pending-load-file-priority) arg3)
0
)
;; definition for method 15 of type external-art-buffer
(defmethod unlock! ((this external-art-buffer))
(set! (-> this locked?) #f)
#f
)
;; definition for method 11 of type external-art-buffer
(defmethod inactive? ((this external-art-buffer))
(!= (-> this status) 'active)
)
;; definition for method 12 of type external-art-buffer
(defmethod file-status ((this external-art-buffer) (arg0 string) (arg1 int))
(when (and (name= (-> this pending-load-file) arg0) (= (-> this pending-load-file-part) arg1))
(if (and (name= (-> this load-file) arg0) (= (-> this load-file-part) arg1))
(-> this status)
'pending
)
)
)
;; definition for method 13 of type art-group
(defmethod link-art! ((this art-group))
(when this
(countdown (s5-0 (-> this length))
(let* ((art-elt (-> this data s5-0))
(janim (if (and (nonzero? art-elt) (type-type? (-> art-elt type) art-joint-anim))
(the-as art-joint-anim art-elt)
)
)
(success #f)
)
(when janim
(let ((s3-1 3))
(while (begin (label cfg-22) (nonzero? s3-1))
(+! s3-1 -1)
(let ((janim-group (art-group-get-by-name (-> *level* level s3-1) (-> janim master-art-group-name))))
(when janim-group
(cond
((and (< (-> janim master-art-group-index) (-> janim-group length))
(not (-> janim-group data (-> janim master-art-group-index)))
)
(set! (-> janim-group data (-> janim master-art-group-index)) janim)
(set! success #t)
)
(else
(countdown (a0-14 (-> janim-group length))
(when (not (-> janim-group data a0-14))
(set! (-> janim-group data a0-14) janim)
(set! success #t)
(goto cfg-22)
)
)
)
)
)
)
)
)
(if (not success)
(format 0 "ERROR: ~A could not find a master slot to link for ~A.~%" (-> this name) janim)
)
)
)
)
)
this
)
;; definition for method 14 of type art-group
(defmethod unlink-art! ((this art-group))
(when this
(countdown (s5-0 (-> this length))
(let* ((art-elt (-> this data s5-0))
(janim (if (and (nonzero? art-elt) (type-type? (-> art-elt type) art-joint-anim))
(the-as art-joint-anim art-elt)
)
)
(success #f)
)
(when janim
(let ((s2-0 3))
(while (begin (label cfg-16) (nonzero? s2-0))
(+! s2-0 -1)
(let ((janim-group (art-group-get-by-name (-> *level* level s2-0) (-> janim master-art-group-name))))
(when janim-group
(countdown (a0-5 (-> janim-group length))
(when (= janim (-> janim-group data a0-5))
(set! (-> janim-group data a0-5) #f)
(set! success #t)
(goto cfg-16)
)
)
)
)
)
)
(if (not success)
(format 0 "ERROR: ~A could not find a master slot to unlink for ~A.~%" (-> this name) janim)
)
)
)
)
)
0
)
;; definition for method 13 of type external-art-buffer
(defmethod link-file ((this external-art-buffer) (arg0 art-group))
(when arg0
(link-art! arg0)
(set! (-> this art-group) arg0)
)
arg0
)
;; definition for method 14 of type external-art-buffer
(defmethod unlink-file ((this external-art-buffer) (arg0 art-group))
(when arg0
(unlink-art! arg0)
(set! (-> this art-group) #f)
)
0
)
;; definition for method 10 of type external-art-buffer
;; WARN: Found some very strange gotos. Check result carefully, this is not well tested.
(defmethod update ((this external-art-buffer))
(when (or (not (name= (-> this pending-load-file) (-> this load-file)))
(!= (-> this pending-load-file-part) (-> this load-file-part))
)
(when (not (handle->process (-> this pending-load-file-owner)))
(set! (-> this pending-load-file) #f)
(set! (-> this pending-load-file-part) -1)
(set! (-> this pending-load-file-owner) (the-as handle #f))
(set! (-> this pending-load-file-priority) 100000000.0)
)
(when (= (-> this status) 'initialize)
(let ((v1-11 (-> this heap)))
(set! (-> v1-11 base) (the-as pointer (+ #x84000 (* #x3dc00 (-> this index)))))
(set! (-> v1-11 current) (-> v1-11 base))
(set! (-> v1-11 top-base) (&+ (-> v1-11 base) #x3dc00))
(set! (-> v1-11 top) (-> v1-11 top-base))
)
(set! (-> this status) 'inactive)
)
(cond
((-> this load-file)
(if (= (-> this status) 'loading)
(str-load-cancel)
)
(set! (-> this load-file) #f)
(set! (-> this load-file-part) -1)
(set! (-> this load-file-owner) (the-as handle #f))
(set! (-> this load-file-priority) 100000000.0)
)
(else
(set! (-> this load-file) (-> this pending-load-file))
(set! (-> this load-file-part) (-> this pending-load-file-part))
(set! (-> this load-file-owner) (-> this pending-load-file-owner))
(set! (-> this load-file-priority) (-> this pending-load-file-priority))
)
)
)
(label cfg-18)
(cond
((-> this load-file)
(case (-> this status)
(('active 'reserved)
)
(('error)
(set! (-> this status) 'inactive)
(set! (-> this load-file) #f)
(set! (-> this load-file-part) -1)
(set! (-> this load-file-owner) (the-as handle #f))
(set! (-> this load-file-priority) 100000000.0)
(set! (-> this pending-load-file) #f)
(set! (-> this pending-load-file-part) -1)
(set! (-> this pending-load-file-owner) (the-as handle #f))
(set! (-> this pending-load-file-priority) 100000000.0)
(set! (-> this art-group) #f)
)
(('inactive)
(let ((v1-28 (-> this heap)))
(set! (-> v1-28 current) (-> v1-28 base))
)
(cond
((string= (-> this load-file) "reserved")
(cond
((-> *art-control* reserve-buffer)
(format 0 "ERROR: trying double reserve ~A when ~A is reserved~%" this (-> *art-control* reserve-buffer))
)
(else
(set! (-> this status) 'reserved)
(set! (-> *art-control* reserve-buffer) this)
)
)
)
((and (!= (-> *level* loading-level) (-> *level* level-default)) (< 81920.0 (-> this load-file-priority)))
)
((str-load (-> this load-file) (-> this load-file-part) (logand -64 (&+ (-> this heap current) 63)) #x3fc00)
(set! (-> this status) 'loading)
)
)
)
(('loading)
(case (str-load-status (&-> this len))
(('error)
(set! (-> this status) 'error)
)
(('busy)
)
(else
(set! (-> this buf) (logand -64 (&+ (-> this heap current) 63)))
(set! (-> this status) 'loaded)
(goto cfg-18)
)
)
)
(('loaded)
(let ((a0-37 (-> this buf)))
(set! (-> this art-group)
(the-as art-group (link a0-37 (-> this load-file data) (-> this len) (-> this heap) 0))
)
)
(let ((s4-0 (-> this art-group))
(s3-0 (-> this load-file))
)
(cond
((not s4-0)
(format 0 "ERROR: art-group ~A part ~D is not a valid file.~%" s3-0 (-> this load-file-part))
(set! (-> this status) 'error)
)
((not (type-type? (-> s4-0 type) art-group))
(format 0 "ERROR: art-group ~A part ~D is not a art-group.~%" s3-0 (-> this load-file-part))
(set! (-> this status) 'error)
)
((not (file-info-correct-version? (-> s4-0 info) (file-kind art-group) 0))
(set! (-> this status) 'error)
)
(else
(login s4-0)
(set! (-> this status) 'locked)
)
)
)
)
(('locked)
(when (and (not (-> this locked?)) (handle->process (-> this load-file-owner)))
(link-file this (-> this art-group))
(set! (-> this other locked?) #t)
(set! (-> this status) 'active)
(goto cfg-18)
)
)
)
)
(else
(case (-> this status)
(('initialize)
)
(('reserved)
(cond
((= (-> *art-control* reserve-buffer) this)
(set! (-> *art-control* reserve-buffer) #f)
(set! (-> this status) 'inactive)
)
(else
(format 0 "ERROR: trying tro free ~A when ~A is reserved~%" this (-> *art-control* reserve-buffer))
)
)
)
(('active)
(unlink-file this (-> this art-group))
(let ((v1-70 (-> this heap)))
(set! (-> v1-70 current) (-> v1-70 base))
)
(set! (-> this art-group) #f)
(set! (-> this status) 'inactive)
(when (-> this other locked?)
(unlock! (-> this other))
(update (-> this other))
)
)
(else
(let ((v1-79 (-> this heap)))
(set! (-> v1-79 current) (-> v1-79 base))
)
(set! (-> this art-group) #f)
(set! (-> this status) 'inactive)
)
)
)
)
0
)
;; definition for symbol *preload-spool-anims*, type symbol
(define *preload-spool-anims* #t)
;; definition for method 12 of type external-art-control
(defmethod file-status ((this external-art-control) (arg0 string) (arg1 int))
(dotimes (s3-0 2)
(let ((v1-3 (file-status (-> this buffer s3-0) arg0 arg1)))
(if v1-3
(return v1-3)
)
)
)
#f
)
;; definition for method 9 of type external-art-control
(defmethod update ((this external-art-control) (arg0 symbol))
(if (nonzero? (-> this reserve-buffer-count))
(spool-push this "reserved" 0 *dproc* (if (-> this reserve-buffer)
-110.0
-0.5
)
)
)
(dotimes (v1-5 2)
(set! (-> this buffer v1-5 frame-lock) #f)
)
(dotimes (v1-8 3)
(set! (-> this rec v1-8 index) (the-as int #f))
)
(dotimes (s4-0 2)
(let ((s3-0 (-> this rec s4-0)))
(when (-> s3-0 name)
(dotimes (s2-0 2)
(when (and (file-status (-> this buffer s2-0) (-> s3-0 name) (-> s3-0 parts))
(not (-> this buffer s2-0 frame-lock))
)
(set! (-> this buffer s2-0 frame-lock) #t)
(set! (-> s3-0 index) (the-as int (-> this buffer s2-0)))
(set! (-> this buffer s2-0 pending-load-file-owner) (-> s3-0 owner))
(set! (-> this buffer s2-0 load-file-owner) (-> s3-0 owner))
(set! (-> this buffer s2-0 pending-load-file-priority) (-> s3-0 priority))
(set! (-> this buffer s2-0 load-file-priority) (-> s3-0 priority))
(goto cfg-24)
)
)
)
)
(label cfg-24)
)
(dotimes (s4-1 2)
(let ((s3-1 (-> this rec s4-1)))
(when (and (-> s3-1 name) (not (-> s3-1 buf2)))
(if (and (not *preload-spool-anims*) (>= (-> s3-1 priority) 0.0))
(goto cfg-46)
)
(dotimes (s2-1 2)
(when (not (-> this buffer s2-1 frame-lock))
(set! (-> this buffer s2-1 frame-lock) #t)
(set-pending-file (-> this buffer s2-1) (-> s3-1 name) (-> s3-1 parts) (-> s3-1 owner) (-> s3-1 priority))
(set! (-> s3-1 index) (the-as int (-> this buffer s2-1)))
(goto cfg-46)
)
)
)
)
(label cfg-46)
)
(when (not (-> this reserve-buffer))
(let ((s4-2 (-> this rec 0 buf2)))
(if (and s4-2
(-> s4-2 locked?)
(not (string= (-> s4-2 pending-load-file) "reserved"))
(not (string= (-> s4-2 other pending-load-file) "reserved"))
)
(set-pending-file (-> s4-2 other) (the-as string #f) -1 (the-as handle #f) 100000000.0)
)
)
)
(dotimes (s4-3 2)
(update (-> this buffer s4-3))
)
(let ((s4-4 (the-as spool-anim #f)))
(countdown (s3-2 3)
(if (and (-> this rec s3-2 name) (not (name= (-> this rec s3-2 name) (-> this active-stream))))
(set! s4-4 (the-as spool-anim (-> this rec)))
)
)
(if (and (-> this preload-stream name) (or (not s4-4) (< (-> this preload-stream priority) (-> s4-4 priority))))
(set! s4-4 (-> this preload-stream))
)
(cond
(s4-4
(mem-copy! (&-> this last-preload-stream type) (&-> s4-4 type) 44)
(str-play-queue (-> s4-4 name))
)
(else
(set! (-> this last-preload-stream name) #f)
(set! (-> this last-preload-stream owner) (the-as handle #f))
)
)
)
(when (and arg0 *display-art-control*)
(dotimes (s5-1 3)
(let ((t9-10 format)
(a0-29 *stdcon*)
(a1-9 "rec ~d ~S ~D ~f ~A~%")
(a2-5 s5-1)
(a3-3 (-> this rec s5-1 name))
(t0-3 (-> this rec s5-1 parts))
(t1-0 (-> this rec s5-1 priority))
(v1-123 (handle->process (-> this rec s5-1 owner)))
)
(t9-10 a0-29 a1-9 a2-5 a3-3 t0-3 t1-0 (if v1-123
(-> v1-123 name)
)
)
)
)
(dotimes (s5-2 2)
(let ((t9-11 format)
(a0-30 *stdcon*)
(a1-10 "buf ~d ~C ~S ~D ~A ~A~%")
(a2-6 s5-2)
(a3-4 (if (-> this buffer s5-2 locked?)
108
32
)
)
(t0-4 (-> this buffer s5-2 pending-load-file))
(t1-1 (-> this buffer s5-2 pending-load-file-part))
(t2-5 (-> this buffer s5-2 status))
(v1-144 (handle->process (-> this buffer s5-2 pending-load-file-owner)))
)
(t9-11 a0-30 a1-10 a2-6 a3-4 t0-4 t1-1 t2-5 (if v1-144
(-> v1-144 name)
)
)
)
)
(format *stdcon* " a: ~S~%" (-> this active-stream))
(let ((t9-13 format)
(a0-32 *stdcon*)
(a1-12 " p: ~S ~A~%")
(a2-8 (-> this preload-stream name))
(v1-149 (handle->process (-> this preload-stream owner)))
)
(t9-13 a0-32 a1-12 a2-8 (if v1-149
(-> v1-149 name)
)
)
)
(let ((t9-14 format)
(a0-33 *stdcon*)
(a1-13 " q: ~S ~A~%")
(a2-9 (-> this last-preload-stream name))
(v1-152 (handle->process (-> this last-preload-stream owner)))
)
(t9-14 a0-33 a1-13 a2-9 (if v1-152
(-> v1-152 name)
)
)
)
)
0
)
;; definition for method 15 of type external-art-control
(defmethod none-reserved? ((this external-art-control))
(zero? (-> this reserve-buffer-count))
)
;; definition for method 13 of type external-art-control
(defmethod reserve-alloc ((this external-art-control))
(set! (-> this reserve-buffer-count) 1)
(if (-> this reserve-buffer)
(-> this reserve-buffer heap)
)
)
;; definition for method 14 of type external-art-control
(defmethod reserve-free ((this external-art-control) (arg0 kheap))
(cond
((zero? (-> this reserve-buffer-count))
(format 0 "ERROR: illegal attempt to free a buffer #x~X which had not been reserved (none reserved).~%" arg0)
)
((not (-> this reserve-buffer))
(set! (-> this reserve-buffer-count) 0)
0
)
((= (-> this reserve-buffer heap) arg0)
(set-pending-file (-> this reserve-buffer) (the-as string #f) -1 (the-as handle #f) 100000000.0)
(update (-> this reserve-buffer))
(set! (-> this reserve-buffer-count) 0)
0
)
(else
(format 0 "ERROR: illegal attempt to free a buffer #x~X which had not been reserved (buffer unknown).~%" arg0)
)
)
0
)
;; definition for method 10 of type external-art-control
(defmethod clear-rec ((this external-art-control))
(cond
((!= *master-mode* 'game)
(dotimes (s5-0 3)
(when (name= (-> this rec s5-0 name) "reserved")
(let ((v1-5 s5-0))
(cond
((zero? v1-5)
(mem-copy! (&+ (the-as pointer (-> this rec)) -4) (&-> this rec 1 type) 44)
(mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) 44)
)
((= v1-5 1)
(mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) 44)
)
)
)
(set! (-> this rec 2 type) spool-anim)
(set! (-> this rec 2 name) #f)
(set! (-> this rec 2 priority) 100000000.0)
(set! (-> this rec 2 owner) (the-as handle #f))
)
)
)
(else
(dotimes (v1-19 3)
(set! (-> this rec v1-19 type) spool-anim)
(set! (-> this rec v1-19 name) #f)
(set! (-> this rec v1-19 priority) 100000000.0)
(set! (-> this rec v1-19 owner) (the-as handle #f))
)
(set! (-> this preload-stream type) spool-anim)
(set! (-> this preload-stream name) #f)
(set! (-> this preload-stream priority) 100000000.0)
(set! (-> this preload-stream owner) (the-as handle #f))
)
)
0
)
;; definition for method 16 of type external-art-control
(defmethod try-preload-stream ((this external-art-control) (arg0 string) (arg1 int) (arg2 process) (arg3 float))
(when (and (= arg3 -99.0) arg2)
(let ((a0-2 (target-pos 0)))
(set! arg3 (vector-vector-distance a0-2 (-> (the-as process-drawable arg2) root trans)))
)
)
(when (not (and (-> this preload-stream name) (>= arg3 (-> this preload-stream priority))))
(set! (-> this preload-stream name) arg0)
(set! (-> this preload-stream parts) arg1)
(set! (-> this preload-stream priority) arg3)
(set! (-> this preload-stream owner) (process->handle arg2))
)
0
)
;; definition for method 11 of type external-art-control
(defmethod spool-push ((this external-art-control) (arg0 string) (arg1 int) (arg2 process) (arg3 float))
(when (and (= arg3 -99.0) arg2)
(let ((a0-2 (target-pos 0)))
(set! arg3 (vector-vector-distance a0-2 (-> (the-as process-drawable arg2) root trans)))
)
)
(cond
((and (= arg1 (-> this rec 0 parts)) (name= arg0 (-> this rec 0 name)))
(if (>= arg3 (-> this rec 0 priority))
(return (the-as int #f))
)
(mem-copy! (&-> this rec 0 type) (&-> this rec 1 type) 44)
(mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) 44)
(set! (-> this rec 2 name) #f)
(set! (-> this rec 2 owner) (the-as handle #f))
)
((and (= arg1 (-> this rec 1 parts)) (name= arg0 (-> this rec 1 name)))
(if (>= arg3 (-> this rec 1 priority))
(return (the-as int #f))
)
(mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) 44)
(set! (-> this rec 2 name) #f)
(set! (-> this rec 2 owner) (the-as handle #f))
)
((and (= arg1 (-> this rec 2 parts)) (name= arg0 (-> this rec 2 name)))
(if (>= arg3 (-> this rec 2 priority))
(return (the-as int #f))
)
(set! (-> this rec 2 name) #f)
(set! (-> this rec 2 owner) (the-as handle #f))
)
)
(cond
((< arg3 (-> this rec 0 priority))
(mem-copy! (&-> this rec 2 type) (&-> this rec 1 type) 44)
(mem-copy! (&-> this rec 1 type) (&-> this rec 0 type) 44)
(set! (-> this rec 0 name) arg0)
(set! (-> this rec 0 parts) arg1)
(set! (-> this rec 0 priority) arg3)
(set! (-> this rec 0 owner) (process->handle arg2))
)
((< arg3 (-> this rec 1 priority))
(mem-copy! (&-> this rec 2 type) (&-> this rec 1 type) 44)
(set! (-> this rec 1 name) arg0)
(set! (-> this rec 1 parts) arg1)
(set! (-> this rec 1 priority) arg3)
(set! (-> this rec 1 owner) (process->handle arg2))
)
((< arg3 (-> this rec 2 priority))
(set! (-> this rec 2 name) arg0)
(set! (-> this rec 2 parts) arg1)
(set! (-> this rec 2 priority) arg3)
(set! (-> this rec 2 owner) (process->handle arg2))
)
)
0
)
;; definition for function ja-play-spooled-anim
;; WARN: Stack slot offset 24 signed mismatch
;; WARN: Stack slot offset 24 signed mismatch
;; WARN: Stack slot offset 24 signed mismatch
;; WARN: Stack slot offset 24 signed mismatch
;; WARN: Stack slot offset 24 signed mismatch
(defbehavior ja-play-spooled-anim process-drawable ((arg0 spool-anim) (arg1 art-joint-anim) (arg2 art-joint-anim) (arg3 (function process-drawable symbol)))
(local-vars (v0-39 int))
(let ((spool-part 0))
(let ((sv-24 -17.0))
(let ((old-skel-status (-> self skel status)))
)
(let ((sv-32 -2)
(sv-40 0)
(sv-48 0)
(sv-56 0)
(spool-sound (new-sound-id))
)
(backup-load-state-and-set-cmds *load-state* (-> arg0 command-list))
(set-setting! 'spooling (process->ppointer self) 0.0 0)
(logior! (-> self skel status) (janim-status inited drawn done))
(kill-current-level-hint '() '() 'die)
(level-hint-surpress!)
(apply-settings *setting-control*)
(when (or (handle->process (-> *art-control* spool-lock)) (!= *master-mode* 'game))
(cond
(arg1
(when (!= (ja-group) arg1)
(ja-channel-push! 1 (seconds 0.05))
(ja :group! arg1 :num! min)
)
)
(else
(ja-channel-set! 0)
)
)
(while (or (handle->process (-> *art-control* spool-lock)) (!= *master-mode* 'game))
(format #t "WARNING: ---------------------> loader stall on lock~%")
(if (arg3 self)
(goto cfg-88)
)
(spool-push *art-control* (-> arg0 name) spool-part self -9.0)
(suspend)
(if arg1
(ja :num! (loop!))
)
)
)
(set! (-> *art-control* spool-lock) (process->handle self))
(set! sv-48 (the-as int (current-time)))
(while (< spool-part (-> arg0 parts))
(spool-push *art-control* (-> arg0 name) spool-part self -20.0)
(update *art-control* #f)
(spool-push *art-control* (-> arg0 name) spool-part self -20.0)
(when (!= (file-status *art-control* (-> arg0 name) spool-part) 'active)
(cond
(arg1
(when (!= (ja-group) arg1)
(ja-channel-set! 1)
(ja :group! arg1 :num! min)
)
)
(else
(ja-channel-set! 0)
)
)
(while (!= (file-status *art-control* (-> arg0 name) spool-part) 'active)
(if (arg3 self)
(goto cfg-88)
)
(spool-push *art-control* (-> arg0 name) spool-part self -20.0)
(format #t "WARNING: ---------------------> loader stall on art ~S ~D~%" (-> arg0 name) spool-part)
(suspend)
(if arg1
(ja :num! (loop!))
)
)
)
(spool-push *art-control* (-> arg0 name) spool-part self -20.0)
(let ((s2-4 (the-as art-joint-anim (lookup-art (-> self draw art-group) (-> arg0 name) art-joint-anim))))
(cond
(s2-4
(ja-channel-set! 1)
(ja-no-eval :group! s2-4 :num! (seek!) :frame-num 0.0)
(when (zero? spool-part)
(str-play-async (-> arg0 name) spool-sound)
(set! (-> *art-control* active-stream) (-> arg0 name))
)
(let* ((f30-0 (* 0.05859375 (-> s2-4 speed)))
(f28-0 (+ sv-24 (/ (the float (+ (-> s2-4 data 0 length) -1)) f30-0)))
)
(let ((sv-72 (current-str-pos spool-sound)))
(set! sv-40 (the-as int (current-time)))
(until (>= (the float v0-39) f28-0)
(if (= (-> self skel root-channel 0) (-> self skel channel))
(logior! (-> self skel status) (janim-status spool))
)
(if (or (arg3 self)
(and (<= sv-72 0) (time-elapsed? (the-as time-frame sv-40) (seconds 4)))
(and (< 300 sv-56) (<= sv-72 0))
)
(goto cfg-88)
)
(spool-push *art-control* (-> arg0 name) spool-part self -20.0)
(if (< (+ spool-part 1) (-> arg0 parts))
(spool-push *art-control* (-> arg0 name) (+ spool-part 1) self -10.0)
(logclear! (-> self skel status) (janim-status done))
)
(execute-commands-up-to *load-state* (ja-aframe-num 0))
(cond
((and (< sv-32 sv-72) (= (current-str-id) spool-sound))
(+! sv-56 (- (current-time) (-> *display* old-base-frame-counter)))
(set! sv-40 (the-as int (current-time)))
)
(else
0
)
)
(set! sv-32 sv-72)
(set! sv-48 (the-as int (current-time)))
(suspend)
(let ((f0-14 (* (- (the float (current-str-pos spool-sound)) sv-24) f30-0)))
(ja-no-eval :num! (seek!) :frame-num f0-14)
)
(set! v0-39 (current-str-pos spool-sound))
(set! sv-72 v0-39)
)
)
(set! sv-24 f28-0)
)
(logclear! (-> self skel status) (janim-status spool))
)
(else
(format 0 "ERROR: <asg> ~A in spool anim loop for ~A ~D, but not loaded.~" self (-> arg0 name) spool-part)
(goto cfg-88)
)
)
)
(+! spool-part 1)
)
)
)
(+! spool-part -1)
(label cfg-88)
(ja-abort-spooled-anim arg0 arg2 spool-part)
)
0
)
;; definition for function ja-abort-spooled-anim
(defbehavior ja-abort-spooled-anim process-drawable ((arg0 spool-anim) (arg1 art-joint-anim) (arg2 int))
(restore-load-state-and-cleanup *load-state*)
(str-play-stop (-> arg0 name))
(set! (-> *art-control* active-stream) #f)
(logclear! (-> self skel status) (janim-status drawn done))
(if (not (logtest? (-> self skel status) (janim-status inited)))
(logclear! (-> self skel status) (janim-status inited))
)
(remove-setting! 'spooling)
(cond
((and arg1 (>= arg2 0))
(ja-channel-push! 1 (seconds 0.1))
(set! (-> self skel root-channel 0 frame-group) arg1)
(while (!= (-> self skel root-channel 0) (-> self skel channel))
(spool-push *art-control* (-> arg0 name) arg2 self -20.0)
(suspend)
(ja :num! (seek!))
)
)
(else
(ja-channel-set! 0)
)
)
(set! (-> *art-control* spool-lock) (the-as handle #f))
0
)
;; failed to figure out what this is:
(if (zero? *art-control*)
(set! *art-control* (new 'global 'external-art-control))
)