mirror of
https://github.com/open-goal/jak-project
synced 2026-08-06 09:54:10 -04:00
water111
803 lines
41 KiB
Common Lisp
803 lines
41 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/load/loader-h.gc")
|
|
(require "engine/anim/joint.gc")
|
|
(require "engine/load/load-dgo.gc")
|
|
(require "engine/sound/gsound.gc")
|
|
(require "engine/game/task/hint-control-h.gc")
|
|
(require "engine/common-obs/process-drawable-h.gc")
|
|
(require "engine/game/game-info-h.gc")
|
|
|
|
;; note: changed for high fps
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(defmethod inspect ((this load-dir))
|
|
"Print all the stuff in a 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 (i (-> this string-array length))
|
|
(format #t
|
|
"~T [~D] ~S ~A (~D bytes)~%"
|
|
i
|
|
(-> this string-array i)
|
|
(-> this data-array i)
|
|
(mem-size (-> this data-array i) #f (mem-usage-flags))))
|
|
this)
|
|
|
|
(defmethod mem-usage ((this load-dir) (usage memory-usage-block) (flags mem-usage-flags))
|
|
"Account for the directory and both parallel arrays in the array memory category, then add
|
|
the memory owned by every loaded data object. Pass flags through to each child."
|
|
(mem-usage-add! usage array 1 (asize-of this))
|
|
(mem-usage-add! usage array 0 (asize-of (-> this string-array)))
|
|
(mem-usage-add! usage array 0 (asize-of (-> this data-array)))
|
|
(dotimes (i (-> this data-array length))
|
|
(mem-usage (-> this data-array i) usage flags))
|
|
(the-as load-dir #f))
|
|
|
|
(defmethod load-to-heap-by-name ((this load-dir-art-group) (art-name string) (do-reload symbol) (heap kheap) (version int))
|
|
"Return the art group named art-name from this directory. If it is already present, reload
|
|
and replace it only when do-reload is true and the new debug load succeeds. Otherwise load,
|
|
validate, and append a new entry. Return #f when a new load fails."
|
|
;; see if we already have it.
|
|
(let ((name-array (-> this string-array)))
|
|
(dotimes (i (-> name-array length))
|
|
(when (string= art-name (-> name-array i))
|
|
(when do-reload
|
|
;; we have it, reload it if requested
|
|
(let ((reloaded-group (art-group-load-check art-name heap version)))
|
|
(if reloaded-group (set! (-> this art-group-array i) reloaded-group))))
|
|
(return (-> this art-group-array i))))
|
|
;; The name isn't present, so try to add it.
|
|
(let ((new-group (art-group-load-check art-name heap version)))
|
|
(when new-group
|
|
(set! (-> name-array (-> name-array length)) art-name)
|
|
(set! (-> this art-group-array (-> name-array length)) new-group)
|
|
(+! (-> name-array length) 1)
|
|
(+! (-> this art-group-array length) 1))
|
|
new-group)))
|
|
|
|
(defmethod set-loaded-art ((this load-dir-art-group) (group art-group))
|
|
"Insert an already loaded group. Replace the group with the same name when present;
|
|
otherwise append its name and pointer to the parallel arrays."
|
|
(let ((name-array (-> this string-array)))
|
|
(dotimes (i (-> name-array length))
|
|
(when (string= (-> group name) (-> name-array i))
|
|
(set! (-> this art-group-array i) group)
|
|
(return (-> this art-group-array i))))
|
|
(set! (-> name-array (-> name-array length)) (-> group name))
|
|
(set! (-> this art-group-array (-> name-array length)) group)
|
|
(+! (-> name-array length) 1))
|
|
(set! (-> this art-group-array length) (+ (-> this art-group-array length) 1))
|
|
group)
|
|
|
|
(#unless PC_PORT
|
|
(defun drawable-load ((source drawable) (heap kheap))
|
|
"Load and log in a drawable when source is a filename, or log in source directly when it is
|
|
already a drawable. The EE path moves low-stack loads to the protected kernel stack. Return #f
|
|
for an invalid object."
|
|
(cond
|
|
((type-type? (-> source type) string)
|
|
(with-sp (protect sp
|
|
(if (< sp *stack-top*) (set! sp (&+ *kernel-sp* -1024)))
|
|
(let ((loaded-drawable (the-as drawable (loado (the-as string source) heap))))
|
|
(if (and loaded-drawable (type-type? (-> loaded-drawable type) drawable)) (login loaded-drawable))))))
|
|
((type-type? (-> source type) drawable) (login source)))))
|
|
|
|
(#when PC_PORT
|
|
(defun drawable-load ((source drawable) (heap kheap))
|
|
"Load and log in a drawable when source is a filename, or log in source directly when it is
|
|
already a drawable. The EE path moves low-stack loads to the protected kernel stack. Return #f
|
|
for an invalid object."
|
|
(cond
|
|
((type-type? (-> source type) string)
|
|
(let ((loaded-drawable (the-as drawable (loado (the-as string source) heap))))
|
|
(if (and loaded-drawable (type-type? (-> loaded-drawable type) drawable)) (login loaded-drawable))))
|
|
((type-type? (-> source type) drawable) (login source)))))
|
|
|
|
(#unless PC_PORT
|
|
(defun art-load ((name string) (heap kheap))
|
|
"Load name into heap, verify that the result is art, and log it in. The EE path moves low-stack
|
|
loads to the protected kernel stack; return #f when the loaded object is not art."
|
|
(with-sp (protect sp
|
|
(if (< sp *stack-top*) (set! sp (&+ *kernel-sp* -1024)))
|
|
(let ((loaded-art (the-as art (loado name heap))))
|
|
(if (type-type? (-> loaded-art type) art) (login loaded-art) (the-as art #f)))))))
|
|
|
|
(#when PC_PORT
|
|
(defun art-load ((name string) (heap kheap))
|
|
"Load name into heap, verify that the result is art, and log it in. The EE path moves low-stack
|
|
loads to the protected kernel stack; return #f when the loaded object is not art."
|
|
(let ((loaded-art (the-as art (loado name heap))))
|
|
(if (type-type? (-> loaded-art type) art) (login loaded-art) (the-as art #f)))))
|
|
|
|
(#unless PC_PORT
|
|
(defun art-group-load-check ((name string) (heap kheap) (version int))
|
|
"In a debug build, load the versioned art-group file into heap, validate its type and file
|
|
version, and log it in. Return #f when debug memory is unavailable or any validation fails."
|
|
(when *debug-segment*
|
|
(with-sp (protect sp
|
|
(if (< sp *stack-top*) (set! sp (&+ *kernel-sp* -1024)))
|
|
(let ((loaded-group (the-as art-group (loado (make-file-name (file-kind art-group) name version #f) heap))))
|
|
(cond
|
|
((not loaded-group) (format 0 "ERROR: art-group ~A is not a valid file.~%" name) (the-as art-group #f))
|
|
((not (type-type? (-> loaded-group type) art-group))
|
|
(format 0 "ERROR: art-group ~A is not a art-group.~%" name)
|
|
(the-as art-group #f))
|
|
((not (file-info-correct-version? (-> loaded-group info) (file-kind art-group) version))
|
|
;; file-info-correct-version? prints the detailed error.
|
|
(the-as art-group #f))
|
|
(else (login loaded-group)))))))))
|
|
|
|
(#when PC_PORT
|
|
(defun art-group-load-check ((name string) (heap kheap) (version int))
|
|
"In a debug build, load the versioned art-group file into heap, validate its type and file
|
|
version, and log it in. Return #f when debug memory is unavailable or any validation fails."
|
|
(when *debug-segment*
|
|
(let ((loaded-group (the-as art-group (loado (make-file-name (file-kind art-group) name version #f) heap))))
|
|
(cond
|
|
((not loaded-group) (format 0 "ERROR: art-group ~A is not a valid file.~%" name) (the-as art-group #f))
|
|
((not (type-type? (-> loaded-group type) art-group))
|
|
(format 0 "ERROR: art-group ~A is not a art-group.~%" name)
|
|
(the-as art-group #f))
|
|
((not (file-info-correct-version? (-> loaded-group info) (file-kind art-group) version))
|
|
;; file-info-correct-version? prints the detailed error.
|
|
(the-as art-group #f))
|
|
(else (login loaded-group)))))))
|
|
|
|
(defmethod set-pending-file ((this external-art-buffer) (name string) (part int) (owner handle) (priority float))
|
|
"Set the file part, owning process handle, and priority that this buffer should service on
|
|
its next update."
|
|
(set! (-> this pending-load-file) name)
|
|
(set! (-> this pending-load-file-part) part)
|
|
(set! (-> this pending-load-file-owner) owner)
|
|
(set! (-> this pending-load-file-priority) priority)
|
|
0)
|
|
|
|
(defmethod unlock! ((this external-art-buffer))
|
|
"Clear the inter-buffer activation lock."
|
|
(declare (inline))
|
|
(set! (-> this locked?) #f)
|
|
#f)
|
|
|
|
(defmethod inactive? ((this external-art-buffer))
|
|
"Return true unless this buffer currently has an active, linked art group."
|
|
(declare (inline))
|
|
(!= (-> this status) 'active))
|
|
|
|
(defmethod file-status ((this external-art-buffer) (name string) (part int))
|
|
"Return this buffer's state for the requested name and part. Return pending when it is queued
|
|
but not yet the current load, and #f when it is not requested by this buffer."
|
|
(when (and (name= (-> this pending-load-file) name) (= (-> this pending-load-file-part) part))
|
|
;; the file is at least wanting to load
|
|
(if (and (name= (-> this load-file) name) (= (-> this load-file-part) part))
|
|
(-> this status) ;; file is loaded or loading
|
|
'pending ;; file has not started loading yet.
|
|
)))
|
|
|
|
(defmethod link-art! ((this art-group))
|
|
"Install every joint animation in this group into a resident master art group. Search level
|
|
slots 2 through 0, prefer the animation's authored index when it is valid and empty, and
|
|
otherwise use an empty slot. Print an error for an animation that cannot be linked."
|
|
(when this
|
|
(countdown (i (-> this length))
|
|
(let* ((art-elt (-> this data i))
|
|
(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
|
|
;; a countdown with a label right at the start
|
|
(let ((level-index 3))
|
|
(while (begin
|
|
(label cfg-22)
|
|
(nonzero? level-index))
|
|
;; loop over levels, looking for the master art group for this joint animation.
|
|
(+! level-index -1)
|
|
(let ((janim-group (art-group-get-by-name (-> *level* level level-index) (-> janim master-art-group-name))))
|
|
(when janim-group
|
|
(cond
|
|
((and (< (-> janim master-art-group-index) (-> janim-group length)) ;; index is valid
|
|
(not (-> janim-group data (-> janim master-art-group-index))) ;; doesn't already have it loaded
|
|
)
|
|
;; link!
|
|
(set! (-> janim-group data (-> janim master-art-group-index)) janim)
|
|
(set! success #t))
|
|
(else
|
|
;; if the specified index is no good, just try looking for somewhere else.
|
|
(countdown (slot-index (-> janim-group length))
|
|
(when (not (-> janim-group data slot-index))
|
|
;; found an empty one!
|
|
(set! (-> janim-group data slot-index) 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)
|
|
|
|
(defmethod unlink-art! ((this art-group))
|
|
"Remove this group's joint animations from matching resident master art groups in level slots
|
|
2 through 0. Print an error for an animation that was not linked anywhere."
|
|
(when this
|
|
(countdown (i (-> this length))
|
|
(let* ((art-elt (-> this data i))
|
|
(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 ((level-index 3))
|
|
(while (begin
|
|
(label cfg-16)
|
|
(nonzero? level-index))
|
|
(+! level-index -1)
|
|
(let ((janim-group (art-group-get-by-name (-> *level* level level-index) (-> janim master-art-group-name))))
|
|
(when janim-group
|
|
(countdown (slot-index (-> janim-group length))
|
|
(when (= janim (-> janim-group data slot-index))
|
|
(set! (-> janim-group data slot-index) #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)
|
|
|
|
(defmethod link-file ((this external-art-buffer) (group art-group))
|
|
"Link group's joint animations into their resident master groups and make it this buffer's
|
|
active art group."
|
|
(when group
|
|
(link-art! group)
|
|
(set! (-> this art-group) group))
|
|
group)
|
|
|
|
(defmethod unlink-file ((this external-art-buffer) (group art-group))
|
|
"Unlink group's joint animations and clear this buffer's active art-group pointer."
|
|
(when group
|
|
(unlink-art! group)
|
|
(set! (-> this art-group) #f))
|
|
0)
|
|
|
|
(defmethod update ((this external-art-buffer))
|
|
"Advance this buffer's streaming state. Adopt changed pending requests, cancel displaced
|
|
loads, initialize the fixed spool heap, start and poll the aligned STR transfer, link and
|
|
validate the resulting art group, serialize activation with the other buffer, and unload data
|
|
whose request was cleared. Requests whose owner no longer exists are discarded."
|
|
(when (or (not (name= (-> this pending-load-file) (-> this load-file)))
|
|
(!= (-> this pending-load-file-part) (-> this load-file-part)))
|
|
;; we're loading a different file, or a different part of a file
|
|
(unless (handle->process (-> this pending-load-file-owner))
|
|
;; nobody owns the loading file so we can discard it
|
|
(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) SPOOL_PRIORITY_LOWEST))
|
|
(when (= (-> this status) 'initialize)
|
|
;; we need to initialize the heap
|
|
(let ((buffer-heap (-> this heap)))
|
|
;; Scary: this is a hard coded address that points to the kernel memory.
|
|
;; it turns out the kernel doesn't need this. So we can use it!
|
|
(set! (-> buffer-heap base) (the-as pointer (+ #x84000 (* SPOOL_HEAP_SIZE (-> this index)))))
|
|
(set! (-> buffer-heap current) (-> buffer-heap base))
|
|
(set! (-> buffer-heap top-base) (&+ (-> buffer-heap base) SPOOL_HEAP_SIZE))
|
|
(set! (-> buffer-heap top) (-> buffer-heap top-base)))
|
|
(set! (-> this status) 'inactive)
|
|
;; heap is now allocated, but there is no data to use
|
|
)
|
|
(cond
|
|
((-> this load-file)
|
|
;; the buffer is working on a file
|
|
(if (= (-> this status) 'loading)
|
|
;; something else is already loading, cancel that because we want something else
|
|
(str-load-cancel))
|
|
;; now nothing is loaded!
|
|
(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) SPOOL_PRIORITY_LOWEST)
|
|
;; on the next time through, we will set the actual load file.
|
|
)
|
|
(else
|
|
;; we have officially chosen to load this file
|
|
(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)
|
|
;; something is being worked on
|
|
(case (-> this status)
|
|
(('active 'reserved)
|
|
;; file is loaded and usable (or reserved)
|
|
)
|
|
(('error)
|
|
;; oops an error happened. make this buffer unusable now.
|
|
(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) SPOOL_PRIORITY_LOWEST)
|
|
(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) SPOOL_PRIORITY_LOWEST)
|
|
(set! (-> this art-group) #f))
|
|
(('inactive)
|
|
;; no usable data here, fill the buffer
|
|
(kheap-reset (-> this heap))
|
|
(cond
|
|
((string= (-> this load-file) "reserved") ;; we want to reserve this buffer for something (not loading an str file)
|
|
(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) ;; this buffer is reserved
|
|
)))
|
|
((and (!= (-> *level* loading-level) (-> *level* level-default)) (< (meters 20) (-> this load-file-priority)))
|
|
;; unused cond
|
|
)
|
|
((str-load (-> this load-file) (-> this load-file-part) (the pointer (align64 (-> this heap current))) #x3fc00) ;; try to start load
|
|
;; load has started!!
|
|
(set! (-> this status) 'loading))))
|
|
(('loading)
|
|
;; loading...
|
|
(case (str-load-status (&-> this len))
|
|
(('error)
|
|
;; something went wrong. oh well.
|
|
(set! (-> this status) 'error))
|
|
(('busy)
|
|
;; loading. we have nothing to do.
|
|
)
|
|
(else
|
|
;; done!!
|
|
;; not sure it is a good idea to assume that this is a success...
|
|
(set! (-> this buf) (the pointer (align64 (-> this heap current))))
|
|
(set! (-> this status) 'loaded)
|
|
(goto cfg-18) ;; go back and check status again!
|
|
)))
|
|
(('loaded)
|
|
;; file is loaded. link it and see if we're good
|
|
(let ((file-data (-> this buf)))
|
|
(set! (-> this art-group)
|
|
(the-as art-group (link (the-as pointer file-data) (-> this load-file data) (-> this len) (-> this heap) 0))))
|
|
(let ((loaded-group (-> this art-group))
|
|
(file-name (-> this load-file)))
|
|
(cond
|
|
((not loaded-group)
|
|
(format 0 "ERROR: art-group ~A part ~D is not a valid file.~%" file-name (-> this load-file-part))
|
|
(set! (-> this status) 'error))
|
|
((not (type-type? (-> loaded-group type) art-group))
|
|
(format 0 "ERROR: art-group ~A part ~D is not a art-group.~%" file-name (-> this load-file-part))
|
|
(set! (-> this status) 'error))
|
|
((not (file-info-correct-version? (-> loaded-group info) (file-kind art-group) 0))
|
|
;;(format 0 "ERROR: art-group ~A part ~D is the wrong version.~%" file-name (-> this load-file-part))
|
|
(set! (-> this status) 'error))
|
|
(else
|
|
(login loaded-group)
|
|
(set! (-> this status) 'locked) ;; make file ready to be used
|
|
))))
|
|
(('locked)
|
|
;; this buffer is locked and needs to be unlocked before it can be used.
|
|
;; only one buffer can be active at a time. The other buffer is locked to prevent it from activating.
|
|
(when (and (not (-> this locked?)) (handle->process (-> this load-file-owner)))
|
|
;; we want to be used, unlock this buffer and lock the other just in case.
|
|
(link-file this (-> this art-group))
|
|
(set! (-> this other locked?) #t) ;; prevent it from becoming active
|
|
(set! (-> this status) 'active)
|
|
(goto cfg-18)))))
|
|
(else
|
|
;; we want to get rid of the file!
|
|
(case (-> this status)
|
|
(('initialize)
|
|
;; this was done earlier
|
|
)
|
|
(('reserved)
|
|
;; this buffer is reserved
|
|
(cond
|
|
((= (-> *art-control* reserve-buffer) this) ;; yep it's this one!
|
|
(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)
|
|
;; buffer is in use. not anymore!
|
|
(unlink-file this (-> this art-group))
|
|
(let ((buffer-heap (-> this heap))) (set! (-> buffer-heap current) (-> buffer-heap base)))
|
|
(set! (-> this art-group) #f)
|
|
(set! (-> this status) 'inactive)
|
|
;; if the other is locked due to us, unlock it, then update it so it activates.
|
|
(when (-> this other locked?)
|
|
(unlock! (-> this other))
|
|
(update (-> this other))))
|
|
(else
|
|
;; some other scenario, just get rid of the whole thing.
|
|
(let ((buffer-heap (-> this heap))) (set! (-> buffer-heap current) (-> buffer-heap base)))
|
|
(set! (-> this art-group) #f)
|
|
(set! (-> this status) 'inactive)))))
|
|
0)
|
|
|
|
;; start loading a spooled anim if we think one is about to be used, e.g. when approaching a fuel cell or npc
|
|
;; (some processes may want to wait for the stream to be preloaded, which won't happen with this disabled)
|
|
(define *preload-spool-anims* #t)
|
|
|
|
(defmethod file-status ((this external-art-control) (name string) (part int))
|
|
"Return the first buffer state for name and part, or #f when neither buffer is servicing the
|
|
request."
|
|
(dotimes (i 2)
|
|
(awhen (file-status (-> this buffer i) name part)
|
|
(return it)))
|
|
#f)
|
|
|
|
(defmethod update ((this external-art-control) (debug-print symbol))
|
|
"Assign the two streaming buffers to the highest-priority eligible requests, retain buffers
|
|
already serving those requests, advance both buffer state machines, and queue the best
|
|
animation stream for audio preloading. Print request and buffer state when debug-print is true
|
|
and loader display is enabled."
|
|
;; if somebody wants a reserve buffer, they will set this to 1.
|
|
(if (nonzero? (-> this reserve-buffer-count))
|
|
(spool-push this "reserved" 0 *dproc* (if (-> this reserve-buffer) -110.0 -0.5)))
|
|
;; frame-lock will get set to #t if something is assigned to this buffer in this update.
|
|
(dotimes (i 2)
|
|
(set! (-> this buffer i frame-lock) #f))
|
|
;; buffers assigned from this call to update
|
|
(dotimes (i 3)
|
|
(set! (-> this rec i buf2) #f))
|
|
;; update existing buffers from their recs
|
|
(dotimes (request-index 2)
|
|
(let ((request (-> this rec request-index)))
|
|
(when (-> request name)
|
|
;; iterate over the two buffers
|
|
(dotimes (buffer-index 2)
|
|
(when (and (file-status (-> this buffer buffer-index) (-> request name) (-> request parts)) ;; this buffer holds the file for the rec
|
|
(not (-> this buffer buffer-index frame-lock))) ;; and nothing has frame-locked this buffer
|
|
;; so we frame lock it to prevent it from being kicked out
|
|
(set! (-> this buffer buffer-index frame-lock) #t)
|
|
;; remember what buffer
|
|
(set! (-> request buf2) (-> this buffer buffer-index))
|
|
;; update owner and priority.
|
|
(set! (-> this buffer buffer-index pending-load-file-owner) (-> request owner))
|
|
(set! (-> this buffer buffer-index load-file-owner) (-> request owner))
|
|
(set! (-> this buffer buffer-index pending-load-file-priority) (-> request priority))
|
|
(set! (-> this buffer buffer-index load-file-priority) (-> request priority))
|
|
(goto cfg-24)))))
|
|
(label cfg-24))
|
|
;; preload recs
|
|
;; iterate over recs
|
|
(dotimes (request-index 2)
|
|
(let ((request (-> this rec request-index)))
|
|
;; rec wants to load something, but doesn't have a buffer already
|
|
(when (and (-> request name) (not (-> request buf2)))
|
|
;; skip if we aren't preloading, or have a positive priority.
|
|
(if (and (not *preload-spool-anims*) (>= (-> request priority) 0.0))
|
|
;; not in use, move on
|
|
(goto cfg-46))
|
|
;; search for a buffer for preloading
|
|
(dotimes (buffer-index 2)
|
|
;; can't steal one that's already assigned
|
|
(when (not (-> this buffer buffer-index frame-lock))
|
|
;; do the assignment!
|
|
(set! (-> this buffer buffer-index frame-lock) #t)
|
|
(set-pending-file (-> this buffer buffer-index)
|
|
(-> request name)
|
|
(-> request parts)
|
|
(-> request owner)
|
|
(-> request priority))
|
|
(set! (-> request buf2) (-> this buffer buffer-index))
|
|
(goto cfg-46)))))
|
|
(label cfg-46))
|
|
;; A locked top request cannot activate while the other buffer remains in use. Unless either
|
|
;; buffer is reserved, clear the other request so its update unloads it and releases the lock.
|
|
(when (not (-> this reserve-buffer))
|
|
(let ((highest-buffer (-> this rec 0 buf2))) ;; top priority buffer
|
|
(if (and highest-buffer
|
|
(-> highest-buffer locked?)
|
|
(not (string= (-> highest-buffer pending-load-file) "reserved"))
|
|
(not (string= (-> highest-buffer other pending-load-file) "reserved")))
|
|
(set-pending-file (-> highest-buffer other) (the-as string #f) -1 (the-as handle #f) SPOOL_PRIORITY_LOWEST))))
|
|
;; update the buffers
|
|
(dotimes (i 2)
|
|
(update (-> this buffer i)))
|
|
;; Choose the animation stream to preload.
|
|
(let ((preload (the-as spool-anim #f)))
|
|
(countdown (i 3)
|
|
(if (and (-> this rec i name) (not (name= (-> this rec i name) (-> this active-stream))))
|
|
(set! preload (the-as spool-anim (-> this rec)))))
|
|
(if (and (-> this preload-stream name) (or (not preload) (< (-> this preload-stream priority) (-> preload priority))))
|
|
(set! preload (-> this preload-stream)))
|
|
(cond
|
|
(preload (mem-copy! (&-> this last-preload-stream type) (&-> preload type) 44) (str-play-queue (-> preload name)))
|
|
(else (set! (-> this last-preload-stream name) #f) (set! (-> this last-preload-stream owner) (the-as handle #f)))))
|
|
(when (and debug-print *display-art-control*)
|
|
(dotimes (i 3)
|
|
(format *stdcon*
|
|
"rec ~d ~S ~D ~f ~A~%"
|
|
i
|
|
(-> this rec i name)
|
|
(-> this rec i parts)
|
|
(-> this rec i priority)
|
|
(handle->name (-> this rec i owner))))
|
|
(dotimes (i 2)
|
|
(format *stdcon*
|
|
"buf ~d ~C ~S ~D ~A ~A~%"
|
|
i
|
|
(if (-> this buffer i locked?) #\l #\\s)
|
|
(-> this buffer i pending-load-file)
|
|
(-> this buffer i pending-load-file-part)
|
|
(-> this buffer i status)
|
|
(handle->name (-> this buffer i pending-load-file-owner))))
|
|
(format *stdcon* " a: ~S~%" (-> this active-stream))
|
|
(format *stdcon* " p: ~S ~A~%" (-> this preload-stream name) (handle->name (-> this preload-stream owner)))
|
|
(format *stdcon* " q: ~S ~A~%" (-> this last-preload-stream name) (handle->name (-> this last-preload-stream owner))))
|
|
0)
|
|
|
|
(defmethod none-reserved? ((this external-art-control))
|
|
"Return true when no general-use buffer reservation has been requested."
|
|
(declare (inline))
|
|
(zero? (-> this reserve-buffer-count)))
|
|
|
|
(defmethod reserve-alloc ((this external-art-control))
|
|
"Request one streaming buffer for general heap use. Return its heap after update has activated
|
|
the reserved pseudo-file; return #f while the reservation is pending."
|
|
(set! (-> this reserve-buffer-count) 1)
|
|
(if (-> this reserve-buffer) (-> this reserve-buffer heap)))
|
|
|
|
(defmethod reserve-free ((this external-art-control) (heap kheap))
|
|
"Release the reservation backed by heap. Clear the reserved buffer's pending request and
|
|
advance it immediately; print an error when no reservation exists or heap is not the reserved
|
|
one."
|
|
(cond
|
|
((none-reserved? this)
|
|
(format 0 "ERROR: illegal attempt to free a buffer #x~X which had not been reserved (none reserved).~%" heap))
|
|
((not (-> this reserve-buffer)) (set! (-> this reserve-buffer-count) 0))
|
|
((= (-> this reserve-buffer heap) heap)
|
|
(set-pending-file (-> this reserve-buffer) (the-as string #f) -1 (the-as handle #f) SPOOL_PRIORITY_LOWEST)
|
|
(update (-> this reserve-buffer))
|
|
(set! (-> this reserve-buffer-count) 0))
|
|
(else (format 0 "ERROR: illegal attempt to free a buffer #x~X which had not been reserved (buffer unknown).~%" heap)))
|
|
0)
|
|
|
|
(defmethod clear-rec ((this external-art-control))
|
|
"Clear streaming requests. In game mode clear all three ranked requests and the preload
|
|
candidate; outside game mode remove only the reserved pseudo-request and compact later records."
|
|
(cond
|
|
((!= *master-mode* 'game)
|
|
(dotimes (i 3)
|
|
(when (name= (-> this rec i name) "reserved")
|
|
(case i
|
|
((0)
|
|
(mem-copy! (&-> this rec 0 type) (&-> this rec 1 type) (size-of spool-anim))
|
|
(mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) (size-of spool-anim)))
|
|
((1) (mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) (size-of spool-anim))))
|
|
(set! (-> this rec 2 type) spool-anim)
|
|
(set! (-> this rec 2 name) #f)
|
|
(set! (-> this rec 2 priority) SPOOL_PRIORITY_LOWEST)
|
|
(set! (-> this rec 2 owner) (the-as handle #f)))))
|
|
(else
|
|
(dotimes (i 3)
|
|
(set! (-> this rec i type) spool-anim)
|
|
(set! (-> this rec i name) #f)
|
|
(set! (-> this rec i priority) SPOOL_PRIORITY_LOWEST)
|
|
(set! (-> this rec i owner) (the-as handle #f)))
|
|
(set! (-> this preload-stream type) spool-anim)
|
|
(set! (-> this preload-stream name) #f)
|
|
(set! (-> this preload-stream priority) SPOOL_PRIORITY_LOWEST)
|
|
(set! (-> this preload-stream owner) (the-as handle #f))))
|
|
0)
|
|
|
|
(defmacro spool-calc-priority (priority proc)
|
|
"Check the priority of a spool anim and recalculate it if needed. It will be the same as distance between target and the requesting process.
|
|
priority = var that stores priority
|
|
proc = a process to recalc from"
|
|
`(when (and (= ,priority SPOOL_PRIORITY_RECALC) ,proc)
|
|
(let ((target-trans (target-pos 0)))
|
|
(set! ,priority (vector-vector-distance target-trans (-> (the-as process-drawable ,proc) root trans))))))
|
|
|
|
(defmethod try-preload-stream ((this external-art-control) (name string) (part int) (requester process) (priority float))
|
|
"Make name and part the single speculative audio preload candidate when its priority is better
|
|
than the current candidate. SPOOL_PRIORITY_RECALC derives priority from requester distance."
|
|
(spool-calc-priority priority requester)
|
|
(unless (and (-> this preload-stream name) (>= priority (-> this preload-stream priority)))
|
|
(set! (-> this preload-stream name) name)
|
|
(set! (-> this preload-stream parts) part)
|
|
(set! (-> this preload-stream priority) priority)
|
|
(set! (-> this preload-stream owner) (process->handle requester)))
|
|
0)
|
|
|
|
(defmethod spool-push ((this external-art-control) (name string) (part int) (requester process) (priority float))
|
|
"Insert a file-part request into the three-entry priority list. Lower values are more important;
|
|
SPOOL_PRIORITY_RECALC uses the requester's distance from the target. An existing request is
|
|
replaced only by a better priority, and requests below the top three are dropped."
|
|
(spool-calc-priority priority requester)
|
|
;; if this spool-anim already exists, pop it from the rec list
|
|
(cond
|
|
((and (= part (-> this rec 0 parts)) (name= name (-> this rec 0 name)))
|
|
(if (>= priority (-> this rec 0 priority)) (return (the-as int #f)))
|
|
;; first spool. copy 1st <- 2nd and 2nd <- 3rd, 3rd will be wiped
|
|
(mem-copy! (&-> this rec 0 type) (&-> this rec 1 type) (size-of spool-anim))
|
|
(mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) (size-of spool-anim))
|
|
(set! (-> this rec 2 name) #f)
|
|
(set! (-> this rec 2 owner) (the-as handle #f)))
|
|
((and (= part (-> this rec 1 parts)) (name= name (-> this rec 1 name)))
|
|
(if (>= priority (-> this rec 1 priority)) (return (the-as int #f)))
|
|
;; second spool. copy 2nd <- 3rd, 3rd will be wiped
|
|
(mem-copy! (&-> this rec 1 type) (&-> this rec 2 type) (size-of spool-anim))
|
|
(set! (-> this rec 2 name) #f)
|
|
(set! (-> this rec 2 owner) (the-as handle #f)))
|
|
((and (= part (-> this rec 2 parts)) (name= name (-> this rec 2 name)))
|
|
(if (>= priority (-> this rec 2 priority)) (return (the-as int #f)))
|
|
;; third spool. 3rd will be wiped
|
|
(set! (-> this rec 2 name) #f)
|
|
(set! (-> this rec 2 owner) (the-as handle #f))))
|
|
;; if it's top 3 priority, push this spool-anim to the rec list
|
|
(cond
|
|
((< priority (-> this rec 0 priority))
|
|
;; 1st place!
|
|
(mem-copy! (&-> this rec 2 type) (&-> this rec 1 type) (size-of spool-anim))
|
|
(mem-copy! (&-> this rec 1 type) (&-> this rec 0 type) (size-of spool-anim))
|
|
(set! (-> this rec 0 name) name)
|
|
(set! (-> this rec 0 parts) part)
|
|
(set! (-> this rec 0 priority) priority)
|
|
(set! (-> this rec 0 owner) (process->handle requester)))
|
|
((< priority (-> this rec 1 priority))
|
|
;; 2nd place.
|
|
(mem-copy! (&-> this rec 2 type) (&-> this rec 1 type) (size-of spool-anim))
|
|
(set! (-> this rec 1 name) name)
|
|
(set! (-> this rec 1 parts) part)
|
|
(set! (-> this rec 1 priority) priority)
|
|
(set! (-> this rec 1 owner) (process->handle requester)))
|
|
((< priority (-> this rec 2 priority))
|
|
;; 3rd place...
|
|
(set! (-> this rec 2 name) name)
|
|
(set! (-> this rec 2 parts) part)
|
|
(set! (-> this rec 2 priority) priority)
|
|
(set! (-> this rec 2 owner) (process->handle requester))))
|
|
0)
|
|
|
|
(defun-extern level-hint-surpress! none) ;; ? TODO
|
|
|
|
(define-extern ja-channel-push! (function int time-frame int :behavior process-drawable))
|
|
|
|
(define-extern ja-channel-set! (function int int :behavior process-drawable))
|
|
|
|
(define-extern joint-control-channel-group-eval!
|
|
(function joint-control-channel art-joint-anim (function joint-control-channel float float float) int))
|
|
|
|
(define-extern joint-control-channel-group!
|
|
(function joint-control-channel art-joint-anim (function joint-control-channel float float float) int))
|
|
|
|
(define-extern ja-aframe-num (function int float :behavior process-drawable))
|
|
|
|
(define-extern ja-abort-spooled-anim (function spool-anim art-joint-anim int int :behavior process-drawable))
|
|
|
|
(defbehavior ja-play-spooled-anim process-drawable ((request spool-anim)
|
|
(idle-anim art-joint-anim)
|
|
(exit-anim art-joint-anim)
|
|
(break-func (function process-drawable symbol)))
|
|
"Play every streamed part in request while driving the joint animation from the audio stream
|
|
position. Wait on the global spool lock using idle-anim, request the current part at highest
|
|
priority and the next part at high priority, execute timed load commands, and abort through
|
|
break-func or when audio fails to start. Cleanup always passes the last completed part and
|
|
exit-anim to ja-abort-spooled-anim."
|
|
(local-vars
|
|
(stream-pos int)
|
|
(spool-part int)
|
|
(part-audio-start float)
|
|
(old-skel-status janim-status)
|
|
(old-stream-pos int)
|
|
(good-time int)
|
|
(old-time int)
|
|
(good-count int)
|
|
(spool-sound sound-id))
|
|
(set! spool-part 0)
|
|
(set! part-audio-start -17.0)
|
|
(set! old-skel-status (-> self skel status))
|
|
(set! old-stream-pos -2)
|
|
(set! good-time 0)
|
|
(set! old-time 0)
|
|
(set! good-count 0)
|
|
(set! spool-sound (new-sound-id))
|
|
(backup-load-state-and-set-cmds *load-state* (-> request 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
|
|
(idle-anim (when (!= (ja-group) idle-anim) (ja-channel-push! 1 (seconds 0.05)) (ja :group! idle-anim :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 (break-func self) (goto cfg-88))
|
|
(spool-push *art-control* (-> request name) spool-part self -9.0)
|
|
(suspend)
|
|
(if idle-anim (ja :num! (loop!)))))
|
|
(set! (-> *art-control* spool-lock) (process->handle self))
|
|
(set! old-time (the-as int (current-time)))
|
|
(while (< spool-part (-> request parts))
|
|
(spool-push *art-control* (-> request name) spool-part self SPOOL_PRIORITY_HIGHEST)
|
|
(update *art-control* #f)
|
|
(spool-push *art-control* (-> request name) spool-part self SPOOL_PRIORITY_HIGHEST)
|
|
(when (!= (file-status *art-control* (-> request name) spool-part) 'active)
|
|
(cond
|
|
(idle-anim (when (!= (ja-group) idle-anim) (ja-channel-set! 1) (ja :group! idle-anim :num! min)))
|
|
(else (ja-channel-set! 0)))
|
|
(while (!= (file-status *art-control* (-> request name) spool-part) 'active)
|
|
(if (break-func self) (goto cfg-88))
|
|
(spool-push *art-control* (-> request name) spool-part self SPOOL_PRIORITY_HIGHEST)
|
|
(format #t "WARNING: ---------------------> loader stall on art ~S ~D~%" (-> request name) spool-part)
|
|
(suspend)
|
|
(if idle-anim (ja :num! (loop!)))))
|
|
(spool-push *art-control* (-> request name) spool-part self SPOOL_PRIORITY_HIGHEST)
|
|
(let ((loaded-anim (the-as art-joint-anim (lookup-art (-> self draw art-group) (-> request name) art-joint-anim))))
|
|
(cond
|
|
(loaded-anim
|
|
(ja-channel-set! 1)
|
|
(ja-no-eval :group! loaded-anim :num! (seek!) :frame-num 0.0)
|
|
(when (zero? spool-part)
|
|
(str-play-async (-> request name) spool-sound)
|
|
(set! (-> *art-control* active-stream) (-> request name)))
|
|
;; Convert STR positions to animation frames. Each part begins where the preceding part's
|
|
;; audio range ended, so the animation remains continuous across streamed chunks.
|
|
(let* ((frames-per-stream-unit (* 0.05859375 (-> loaded-anim speed)))
|
|
(part-audio-end (+ part-audio-start (/ (the float (+ (-> loaded-anim data 0 length) -1)) frames-per-stream-unit))))
|
|
(set! stream-pos (current-str-pos spool-sound))
|
|
(set! good-time (the-as int (current-time)))
|
|
(until (>= (the float stream-pos) part-audio-end)
|
|
(if (= (-> self skel root-channel 0) (-> self skel channel)) (logior! (-> self skel status) (janim-status spool)))
|
|
(if (or (break-func self)
|
|
(and (<= stream-pos 0) (time-elapsed? (the-as time-frame good-time) (seconds 4)))
|
|
(and (< 300 good-count) (<= stream-pos 0)))
|
|
(goto cfg-88))
|
|
(spool-push *art-control* (-> request name) spool-part self SPOOL_PRIORITY_HIGHEST)
|
|
(if (< (+ spool-part 1) (-> request parts))
|
|
(spool-push *art-control* (-> request name) (+ spool-part 1) self SPOOL_PRIORITY_HIGH)
|
|
(logclear! (-> self skel status) (janim-status done)))
|
|
(execute-commands-up-to *load-state* (ja-aframe-num 0))
|
|
(cond
|
|
((and (< old-stream-pos stream-pos) (= (current-str-id) spool-sound))
|
|
;; Use elapsed 300 Hz ticks for this display frame so high frame rates do not
|
|
;; advance the startup counter too quickly.
|
|
(+! good-count (- (current-time) (-> *display* old-base-frame-counter)))
|
|
(set! good-time (the-as int (current-time))))
|
|
(else 0))
|
|
(set! old-stream-pos stream-pos)
|
|
(set! old-time (the-as int (current-time)))
|
|
(suspend)
|
|
(let ((anim-frame (* (- (the float (current-str-pos spool-sound)) part-audio-start) frames-per-stream-unit)))
|
|
(ja-no-eval :num! (seek!) :frame-num anim-frame))
|
|
(set! stream-pos (current-str-pos spool-sound)))
|
|
(set! part-audio-start part-audio-end))
|
|
(logclear! (-> self skel status) (janim-status spool)))
|
|
(else
|
|
;; og:preserve-this fixed broken format string
|
|
(format 0 "ERROR: <asg> ~A in spool anim loop for ~A ~D, but not loaded.~%" self (-> request name) spool-part)
|
|
(goto cfg-88))))
|
|
(+! spool-part 1))
|
|
(+! spool-part -1)
|
|
(label cfg-88)
|
|
(ja-abort-spooled-anim request exit-anim spool-part)
|
|
0)
|
|
|
|
(defbehavior ja-abort-spooled-anim process-drawable ((request spool-anim) (exit-anim art-joint-anim) (completed-part int))
|
|
"Finish or abort a spooled animation. Restore loader state, stop its stream, clear spooling
|
|
status, and release the spool lock. If exit-anim is supplied and completed-part is nonnegative,
|
|
blend onto that animation while keeping the completed part requested until the channel switch
|
|
finishes."
|
|
(restore-load-state-and-cleanup *load-state*)
|
|
(str-play-stop (-> request 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 exit-anim (>= completed-part 0))
|
|
(ja-channel-push! 1 (seconds 0.1))
|
|
(set! (-> self skel root-channel 0 frame-group) exit-anim)
|
|
(while (!= (-> self skel root-channel 0) (-> self skel channel))
|
|
(spool-push *art-control* (-> request name) completed-part self SPOOL_PRIORITY_HIGHEST)
|
|
(suspend)
|
|
(ja :num! (seek!))))
|
|
(else (ja-channel-set! 0)))
|
|
(set! (-> *art-control* spool-lock) (the-as handle #f))
|
|
0)
|
|
|
|
(if (zero? *art-control*) (set! *art-control* (new 'global 'external-art-control)))
|