Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 21:27:52 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity
jak-project/goal_src/jak2/engine/level/level.gc
water111 2fc943977f
[jak2] GOAL side texture animation stuff (#2766) 
It turns out we didn't decompile any of this stuff yet.
2023-06-24 10:11:47 -04:00

3027 lines
111 KiB
Common Lisp
Raw Blame History

;;-*-Lisp-*-
(in-package goal)
;; name: level.gc
;; name in dgo: level
;; dgos: ENGINE, GAME
#|@file
the level heap is a giant block of memory which is seperated into "pages" so that it can easily
be split into different sizes for the different kinds of level sizes.
it is split into 6 sections, 24-24-25-25-24-24 pages large.
this means the "center" portion of the main level heap is actually "larger"
which is why there is a special small-center level memory mode for two-section
levels that want to be placed in the middle of the heap for that slight size boost.
some code checks for 7 bits in the memory mask, indicating the heap was originally split
into 7 sections, which might explain the weird sizes in the center.
|#
;; DECOMP BEGINS
(define-extern level-update-after-load (function level login-state level))
(define-extern *level-type-list* type)
(defglobalconstant NUM_LEVEL_PAGES 146)
(defglobalconstant LEVEL_PAGE_SIZE_KB 126) ;; original value
(defglobalconstant LEVEL_PAGE_SIZE (* LEVEL_PAGE_SIZE_KB 1024)) ;; original value
(defglobalconstant LEVEL_HEAP_SIZE (* NUM_LEVEL_PAGES LEVEL_PAGE_SIZE))
;(defglobalconstant DEBUG_LEVEL_HEAP_MULT 1.5) ;; level heap in debug mode is 1.5x larger
(defglobalconstant DEBUG_LEVEL_HEAP_MULT 1.1) ;; we're gonna use debug mode-style heaps but we don't actually need them at 1.5x size right now
(defglobalconstant DEBUG_LEVEL_PAGE_SIZE (* 1024 (* DEBUG_LEVEL_HEAP_MULT LEVEL_PAGE_SIZE_KB)))
(defglobalconstant DEBUG_LEVEL_HEAP_SIZE (* NUM_LEVEL_PAGES DEBUG_LEVEL_PAGE_SIZE))
;; multiplier for borrow heap size. It is a bit of a hack required to load the slightly larger PC port levels.
;; in the original game, borrow levels never got extra room, even with big level heaps
;; Setting this means that borrow won't work with normal-size level heaps, but this is probably okay
;; because normal-size level heaps don't work at all.
(defglobalconstant BORROW_MULT DEBUG_LEVEL_HEAP_MULT)
(defun give-all-stuff ()
(send-event *target* 'get-pickup 18 #x447a0000)
(send-event *target* 'get-pickup 17 #x447a0000)
(send-event *target* 'get-pickup 13 #x447a0000)
(send-event *target* 'get-pickup 14 #x447a0000)
(send-event *target* 'get-pickup 15 #x447a0000)
(send-event *target* 'get-pickup 16 #x447a0000)
(send-event *target* 'get-pickup 7 #x42c80000)
(logior! (-> *game-info* features) (game-feature gun gun-yellow gun-red gun-blue gun-dark board darkjak))
(let ((v0-7
(logior (-> *game-info* debug-features) (game-feature gun gun-yellow gun-red gun-blue gun-dark board darkjak))
)
)
(set! (-> *game-info* debug-features) v0-7)
v0-7
)
)
(defmacro test-play ()
"Temporary start macro"
`(begin
(start-debug "test-play~%")
(define *kernel-boot-message* 'play)
(start-debug "loading GAME.DGO~%")
(load-package "game" global)
(play-boot)
;; wait 10 frames and then turn on profile bars.
;; they get shut off as part of startup, so we can't do it here.
(process-spawn-function
process
(lambda ()
(dotimes (i 10)
(suspend)
)
(set! *display-profile* #t)
(give-all-stuff)
;;(set! *stats-profile-bars* #t)
)
)
)
)
(defun lookup-level-info ((arg0 symbol))
"Get level-load-info for the specified level.
The level-load-info for all levels is always available to the engine and is used
to figure out how to load levels."
(let* ((v1-0 *level-load-list*)
(a1-0 (car v1-0))
)
(while (not (null? v1-0))
(let ((a1-1 (the-as level-load-info (-> (the-as symbol a1-0) value))))
(if (or (= arg0 (-> a1-1 name)) (= arg0 (-> a1-1 visname)) (= arg0 (-> a1-1 nickname)))
(return a1-1)
)
)
(set! v1-0 (cdr v1-0))
(set! a1-0 (car v1-0))
)
)
default-level
)
(defmethod alt-load-command-get-index level-group ((obj level-group) (arg0 symbol) (arg1 int))
"Get the n-th alt-load-command for the given level.
This is likely unused in jak 2 because no levels have alt-load-commands."
(let ((v1-1 (-> (lookup-level-info arg0) alt-load-commands)))
(while (nonzero? arg1)
(+! arg1 -1)
(set! v1-1 (cdr v1-1))
(nop!)
(nop!)
(nop!)
)
(the-as pair (car v1-1))
)
)
(defmethod load-in-progress? level-group ((obj level-group))
"Is a level being loaded right now?"
(!= (-> *level* loading-level) (-> *level* default-level))
)
(defmethod get-level-by-heap-ptr-and-status level-group ((obj level-group) (arg0 pointer) (arg1 symbol))
"Get a level by a heap pointer and status.
If no matching level is found, return #f.
The purpose of the status check is possibly to prevent bugs with getting stuff
from a level that's just been replaced with another."
(case arg1
(('active)
(dotimes (v1-1 (-> obj length))
(let ((a2-6 (-> obj level v1-1)))
(when (= (-> a2-6 status) 'active)
(if (and (>= (the-as int arg0) (the-as int (-> a2-6 heap base)))
(< (the-as int arg0) (the-as int (-> a2-6 heap top-base)))
)
(return a2-6)
)
)
)
)
)
(('loading)
(dotimes (v1-5 (-> obj length))
(let ((a2-12 (-> obj level v1-5)))
(when (!= (-> a2-12 status) 'inactive)
(if (and (>= (the-as int arg0) (the-as int (-> a2-12 heap base)))
(< (the-as int arg0) (the-as int (-> a2-12 heap top-base)))
)
(return a2-12)
)
)
)
)
)
)
(the-as level #f)
)
(defun remap-level-name ((arg0 level-load-info))
"Get the name of a level to use. Picks the visname if the vis? setting is on."
(if (-> *level* vis?)
(-> arg0 visname)
(-> arg0 name)
)
)
(defmethod get-art-group-by-name level ((obj level) (arg0 string))
"As the name implies, look through the art-groups of this level and get the one
with the given name. Return #f if not found."
(countdown (s4-0 (-> obj art-group art-group-array length))
(if (name= (-> obj art-group art-group-array s4-0 name) arg0)
(return (-> obj art-group art-group-array s4-0))
)
)
(the-as art-group #f)
)
(defmethod bsp-name level ((obj level))
"Get the name of the bsp. If this can't be done, get the name of the level."
(if (and (!= (-> obj status) 'inactive) (-> obj bsp) (nonzero? (-> obj bsp name)))
(-> obj bsp name)
(-> obj name)
)
)
(defun add-bsp-drawable ((arg0 bsp-header) (arg1 level) (arg2 symbol) (arg3 display-frame))
"Draw this bsp!
Calling draw on a bsp mostly just adds stuff to background-work, so maybe that's why
it's called 'add'. This also will do a debug-draw on the entire bsp if the
display-strip-lines option is set."
(draw arg0 arg0 arg3)
(if (nonzero? *display-strip-lines*)
(debug-draw arg0 arg0 arg3)
)
(none)
)
(defmethod print level ((obj level))
(format #t "#<~A ~A ~S @ #x~X>" (-> obj type) (-> obj status) (-> obj name) obj)
obj
)
(defmethod relocate bsp-header ((obj bsp-header) (arg0 int))
"Handle the load of a new bsp-header. The linker calls this function
when the bsp-header is linked.
Do some sanity checks and link the bsp-header and level to each other."
(let ((s5-0 (-> *level* loading-level)))
(when s5-0
(cond
(obj
(cond
((not (type? obj bsp-header))
(format 0 "ERROR: level ~A is not a bsp-header.~%" (-> s5-0 name))
(the-as bsp-header #f)
)
((not (file-info-correct-version? (-> obj info) (file-kind level-bt) 0))
(the-as bsp-header #f)
)
((< 2048 (-> obj visible-list-length))
(format
0
"ERROR: level ~A visible-list-length ~d is greater than 2048 (16384 drawables).~%"
(-> s5-0 name)
(-> obj visible-list-length)
)
(the-as bsp-header #f)
)
(else
(set! (-> s5-0 bsp) obj)
(set! (-> obj level) s5-0)
obj
)
)
)
(else
(format 0 "ERROR: level ~A is not a valid file.~%" (-> s5-0 name))
(the-as bsp-header #f)
)
)
)
)
)
(defmethod load-required-packages level ((obj level))
"Load packages for a level.
This just loads common, and this feature is not really useful.
Packages were only used during development, and seem only partially used in Jak 2
(the only package is common)."
(when (not (or (not (-> obj bsp)) (= *kernel-boot-mode* 'debug-boot)))
(if (not (null? (-> obj info packages)))
(load-package "common" global)
)
)
obj
)
(defmethod vis-clear level ((obj level))
"Completely invalide all visibility data, vis-info, and set all-visible? to loading."
(countdown (v1-0 8)
(nop!)
(set! (-> obj vis-info v1-0) #f)
)
(dotimes (v1-3 128)
(set! (-> (the-as (pointer int128) (&+ (-> obj vis-bits) (* v1-3 16)))) (the int128 0))
)
(set! (-> obj all-visible?) 'loading)
0
(none)
)
(defmethod init-vis-from-bsp level ((obj level))
"Set up a level's vis-infos from a bsp."
(when (not (or (= (-> obj status) 'inactive) (not (-> obj bsp))))
;; mark our visibility as 'loading.
(set! (-> obj all-visible?) 'loading)
;; check vis-info's from the loaded bsp:
(dotimes (s5-0 8)
(let ((s4-0 (-> obj bsp vis-info s5-0)))
(cond
((and s4-0 (nonzero? s4-0) (valid? s4-0 level-vis-info (the-as string #f) #f 0))
;; looks good
;; level -> vis info
(set! (-> obj vis-info s5-0) s4-0)
(set! (-> s4-0 current-vis-string) (the-as uint -1))
;; vis info -> bsp
(if (= (-> s4-0 from-level) (-> obj load-name))
(set! (-> s4-0 from-bsp) (-> obj bsp))
(set! (-> s4-0 from-bsp) #f)
)
;; vis info -> level's vis-bits
(set! (-> s4-0 vis-bits) (the-as uint (-> obj vis-bits)))
(set! (-> s4-0 flags)
(the-as vis-info-flag (logclear (-> s4-0 flags) (vis-info-flag in-iop loading vis-valid)))
)
(set! *vis-boot* #t)
)
(else
(set! (-> obj vis-info s5-0) #f)
)
)
)
)
)
0
(none)
)
(defmethod level-get-for-use level-group ((obj level-group) (arg0 symbol) (arg1 symbol))
"Request a level by name in the given state.
Will return quickly (non-blocking) and might not be able to get a level in the desired state,
though it will ofborrow do some small amount of work to make progress on loading.
This is the most general/powerful function like this: if there is no level with this name
it will kick out levels as needed to make a free slot, and set up a new level, and start
the load. This should only be used when you might want to start a load.
"
(local-vars (s5-1 level))
(start-debug "level-get-for-use: ~A ~A~%" arg0 arg1)
;; make sure we have level heaps
(alloc-levels-if-needed obj #f)
;; look up the requested level
(let* ((s2-0 (lookup-level-info arg0))
(s1-0 (remap-level-name s2-0))
)
(start-debug "level info: ~A, remapped name: ~A~%" s2-0 s1-0)
;; if we already have it, try updating status, then return it
(let ((s5-0 (level-get obj s1-0)))
(when s5-0
(level-status-update! s5-0 arg1)
(set! s5-1 s5-0)
(goto cfg-13)
)
)
(start-debug "level isn't loaded already, need to find a level~%")
;; find slot to load into
(let ((a0-7 (level-get-most-disposable obj)))
(start-debug "found slot: ~A~%" a0-7)
;; mark it as inactive, we're kicking it out.
(set! s5-1 (if a0-7
(level-status-update! a0-7 'inactive)
a0-7
)
)
)
;; oops: same bug as jak 1 here...
(when (not level)
(format 0 "ERROR: could not find a slot to load ~A into.~%" arg0)
(set! s5-1 (the-as level #f))
(goto cfg-13)
)
;; remember where we were loaded
(let ((v1-13 (+ (-> obj load-order) 1)))
(set! (-> obj load-order) v1-13)
(set! (-> s5-1 load-order) (the-as int v1-13))
)
;; set up the level info
(set! (-> s5-1 info) s2-0)
(set! (-> s5-1 name) arg0)
(set! (-> s5-1 load-name) s1-0)
)
;; other setup from level-info
(set! (-> s5-1 mood-func) (the-as (function mood-context float int none) (-> s5-1 info mood-func value)))
(set! (-> s5-1 mood-init) (the-as (function mood-context none) (-> s5-1 info mood-init value)))
;; clear old stuff in level
(dotimes (v1-20 10)
(set! (-> s5-1 texture-anim-array v1-20) #f)
)
(set! (-> s5-1 display?) #f)
(set! (-> s5-1 force-all-visible?) #f)
(set! (-> s5-1 force-inside?) #f)
;; kick off the load!
(start-debug "about to start loading~%")
(level-status-update! s5-1 'loading)
(start-debug "done with load in level-get-for-use, now updating to ~A~%" arg1)
(level-status-update! s5-1 arg1)
(label cfg-13)
s5-1
)
(defmethod level-status level-group ((obj level-group) (arg0 symbol))
"Get the status of a level by name, return #f if no level is found."
(let ((v1-1 (level-get *level* arg0)))
(if v1-1
(-> v1-1 status)
)
)
)
(defmethod level-status-update! level ((obj level) (arg0 symbol))
"Try to update the level to the given status, calling whatever is needed
to make it happen.
This can do both loading, linking, login, and activation.
This is somewhat similar to level-get-for-use, but requires that you already have
the level object.
This function is the way to transition from loaded to alive/active."
(start-debug "level-status-update trying to do ~A to ~A for ~A~%" (-> obj status) arg0 (-> obj name))
(case arg0
(('inactive)
;; any request to go inactive should unload.
(-> obj status)
(unload! obj)
)
(('loading)
(case (-> obj status)
(('inactive)
;; inactive -> loading transition, start the loader
(load-begin obj)
)
)
)
(('loading-bt)
(case (-> obj status)
(('loading)
;; loading -> loading-bt, transition immediately and do one load-continue
(set! (-> obj status) arg0)
(load-continue obj)
)
)
)
(('loading-done)
(case (-> obj status)
(('loading-bt)
;; loading-bt -> loading-done, the only allowed transition to loading-done
(set! (-> obj status) arg0)
)
)
)
(('loaded)
(case (-> obj status)
(('loading-done)
;; loading-done->loaded, need to log in first
(login-begin obj)
)
(('alive 'active)
;; deactivating
(deactivate obj)
)
)
)
(('alive 'active)
(when *dproc*
;; we do this twice, once to alive, then once to active.
;; alive means that entities are alive, active means alive and
;; added to draw engine.
(case (-> obj status)
(('loaded)
;; loaded (so logged in too), do birth (will set to alive), then try again
(birth obj)
(level-status-update! obj arg0)
)
(('alive)
;; on the second run, gets here:
(when (and *dproc* (= arg0 'active))
;; remember when
(when (zero? (-> obj display-start-time))
(set! (-> obj display-start-time) (-> *display* real-clock frame-counter))
0
)
;; add us to the background draw engine! this will cause us to be drawn.
(remove-by-param1 *background-draw-engine* (the-as int (-> obj bsp)))
(add-connection *background-draw-engine* *dproc* add-bsp-drawable (-> obj bsp) obj #f)
;; not sure why this becomes 0...
(dotimes (v1-46 18)
(set! (-> obj closest-object-array v1-46) 0.0)
(set! (-> obj texture-mask v1-46 mask quad) (the-as uint128 0))
)
(set! (-> obj status) 'active)
;; set up for drawing.
(assign-draw-indices *level*)
)
)
)
)
)
)
obj
)
(define *login-state* (new 'global 'login-state))
(define *print-login* #t)
;; load buffering:
;; the dgo loader and linker are double buffered and require two temp buffers
;; while the dgo loader is loading from the DVD to one buffer, the linker is using the other.
;; the linker will copy data from the temp buffer to the heap.
;; the final object loaded by the DGO loader will be loaded directly to the heap, not the temporary buffer.
;; this is the bt load (buffer top?). This can't be double buffered - the linker and login process may allocate memory.
;; the extra syncronization point is in RunDGOStateMachine in the Overlord (see DgoState::Read_Last_Obj)
;; this approach has 2 advantages:
;; - this final load can completely fill up the heap, without needing a separate temporary load buffer
;; - this final load can skip copying data from a temporary buffer (requires v4 format)
;; - the final load can be an object much larger than the temporary buffers.
(defun load-buffer-resize ((arg0 level) (arg1 dgo-header))
"Adjust the load buffers size and location.
The dgo-header passed in should be the load buffer we're about to use."
;; first, determine the size.
;; interestingly, if we are in the 'medium' mode, we use the size of the
;; previous object, plus 2048 bytes. Maybe the objects are sorted in decreasing size,
;; so this allows the big ones to load first, then shrink the temp buffer as the rest come in.
;; the "medium" case is hit because the relocate method for `art-group` changes the mode.
;; if it detects that it runs after textures.
(case (-> arg0 load-buffer-mode)
(((load-buffer-mode small-center))
(set! (-> arg0 load-buffer-size) (the-as uint (* 1100 1024))) ;; 1100 KB
)
(((load-buffer-mode medium))
(set! (-> arg0 load-buffer-size) (+ (-> arg1 length) (* 2 1024)))
)
)
;; adjust the load buffer location
;; the two load buffers are located at the top of the heap, like in jak 1.
(let ((v1-6 (logand -64 (+ (-> arg0 load-buffer-size) 63))))
(if (= arg1 (-> arg0 load-buffer 0))
;; loading to 0, just place this before load-buffer 1 (in use, can't modify)
(set! (-> arg0 load-buffer 0) (- (-> arg0 load-buffer 1) v1-6))
;; loading to 1, place relative to the top of the heap.
(set! (-> arg0 load-buffer 1)
(the-as uint (&- (logand -64 (&+ (-> arg0 heap top-base) 0)) (the-as uint v1-6)))
)
)
)
;; update heap top pointer.
(set! (-> arg0 heap top) (the-as pointer (-> arg0 load-buffer 0)))
0
(none)
)
;; borrowing system:
;; the "borrow" system allows a "borrower" level to use the heap of another level.
;; for an unknown reason, the borrow system doesn't use the double buffering of normal.
;; it's unclear exactly how the linking/loading works here, and it may be that we're missing
;; a case in the DGO loader here. If the objects come in totally corrupted, we're likely missing
;; some additional syncronization.
(defmethod load-continue level ((obj level))
"Run the loading/login state machine.
This will only make progress on loading, linking, and login for loads that have already started.
No 'scary' state transitions (like birth, alive, deactivate) are made here."
(local-vars (sv-16 symbol))
;; if any linking is in progress, do that first.
(when (-> obj linking)
(when (nonzero? (link-resume)) ;; run linker
;; linker return is nonzero, we're done!
(start-debug "link done!~%")
(set! (-> obj linking) #f)
(case (-> obj status)
(('loading) ;; we're loading to b0/b1, not the top buffer
;; if we are doing a texture relocate later, don't do anything now, come back later.
(when (not (-> *texture-relocate-later* memcpy))
(cond
((= (-> obj load-buffer-mode) (load-buffer-mode borrow))
;; in this "borrow" mode, load directly to the heap.
(start-debug "kick load borrow case~%")
(let ((a2-0 (logand -64 (&+ (-> obj heap current) 63))))
(dgo-load-continue a2-0 a2-0 a2-0)
)
)
(else
;; otherwise, continue with double buffered load to b0/b1 like normal
;; update load buffers, and make the dgo loader continue.
(load-buffer-resize obj (the-as dgo-header (-> obj load-buffer-last)))
(start-debug "kicking next load~%")
(dgo-load-continue
(the-as pointer (-> obj load-buffer 0))
(the-as pointer (-> obj load-buffer 1))
(logand -64 (&+ (-> obj heap current) 63))
)
)
)
)
)
(('loading-bt)
;; finished linking the final object! begin login.
(level-status-update! obj 'loading-done)
(level-status-update! obj 'loaded)
)
)
)
(set! obj obj)
(goto cfg-39)
)
;; if any pending texture-relocate, do that, then kick the dgo loader.
;; (note that this doens't handle mode "borrow")
(when (-> *texture-relocate-later* memcpy)
(relocate-later)
(load-buffer-resize obj (the-as dgo-header (-> obj load-buffer-last)))
(dgo-load-continue
(the-as pointer (-> obj load-buffer 0))
(the-as pointer (-> obj load-buffer 1))
(logand -64 (&+ (-> obj heap current) 63))
)
(set! obj obj)
(goto cfg-39)
)
;; not waiting on the linker, check other cases
(case (-> obj status)
(('loading)
;; if loading, we are waiting on the DGO loader. Check it again:
(set! sv-16 (the-as symbol #f))
(let ((s5-0 (dgo-load-get-next (& sv-16))))
(when s5-0
;; we got something! remember where and update stats
(set! (-> obj load-buffer-last) (the-as uint s5-0))
(+! (-> *level* load-size) (-> (the-as (pointer uint32) s5-0)))
(set! (-> *level* load-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
)
(set! (-> *level* load-login-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
)
(cond
((not sv-16)
;; not the last object
(cond
((= (-> obj load-buffer-mode) (load-buffer-mode borrow))
;; start the linker. in "borrow" mode, load directly to the heap again.
(cond
((dgo-load-link (the-as dgo-header s5-0) (-> obj heap) (the-as uint (-> obj heap top-base)) *print-login* #f)
;; linker finished immediately, kick off next load
(when (not (-> *texture-relocate-later* memcpy))
(let ((a2-8 (logand -64 (&+ (-> obj heap current) 63))))
(dgo-load-continue a2-8 a2-8 a2-8)
)
)
)
(else
;; linker still going, remember and come back later.
(set! (-> obj linking) #t)
)
)
)
;; not borrow mode, start linker
((dgo-load-link (the-as dgo-header s5-0) (-> obj heap) (-> obj load-buffer 1) *print-login* #f)
;; finished immediately, kick off next loa
(when (not (-> *texture-relocate-later* memcpy))
(load-buffer-resize obj (the-as dgo-header s5-0))
(dgo-load-continue
(the-as pointer (-> obj load-buffer 0))
(the-as pointer (-> obj load-buffer 1))
(logand -64 (&+ (-> obj heap current) 63))
)
)
)
(else
;; otherwise remember we're loading.
(set! (-> obj linking) #t)
)
)
)
(else
;; we are the last object. update heap top and go to bt load.
(set! (-> obj heap top) (-> obj heap top-base))
(level-status-update! obj 'loading-bt)
)
)
)
)
)
(('login)
;; logging in, load already finished. run the login state machine
(level-update-after-load obj *login-state*)
)
(('loading-bt)
;; last object was loaded, start linking it.
(let ((a0-36 (logand -64 (&+ (-> obj heap current) 63))))
(cond
((dgo-load-link (the-as dgo-header a0-36) (-> obj heap) (the-as uint (-> obj heap top-base)) *print-login* #t)
(level-status-update! obj 'loading-done)
(level-status-update! obj 'loaded)
)
(else
(set! (-> obj linking) #t)
)
)
)
)
)
(label cfg-39)
obj
)
(defmethod load-begin level ((obj level))
"Begin loading a level.
This assigns memory to a level and is somewhat confusing."
(local-vars (bits-to-use int) (borrow-from-lev level) (found-borrow symbol))
(when (!= (&- (-> *level* heap top) (the-as uint (-> *level* heap base))) DEBUG_LEVEL_HEAP_SIZE)
(format 0 "------------- load-begin called without large level heaps. This is not supported on PC~%")
(break!)
)
;; a "borrow" level will borrow the heap of an existing level
(dotimes (v1-0 2)
(set! (-> obj borrow-level v1-0) #f) ;; levels that borrow our heap
)
(set! (-> obj borrow-from-level) #f) ;; level that we borrow our heap for.
(set! (-> obj memory-mask) (the-as uint 0)) ;; bits representing which sections of the big level heap we use.
(let ((mem-mode (-> obj info memory-mode)))
(case mem-mode
(((load-buffer-mode borrow))
;; we need to find a level to borrow from.
;; borrowing is a two-way thing. the host level has to have our name.
(let ((slot-in-borrow-from-lev -1)) ;; the slot in the host
(dotimes (borrow-from-lev-idx LEVEL_MAX) ;; loop over all levels
(let ((maybe-borrow-from-lev (-> *level* level borrow-from-lev-idx)))
;; only can borrow from loaded level
(when (and (or (= (-> maybe-borrow-from-lev status) 'active) (= (-> maybe-borrow-from-lev status) 'loaded))
(begin
(dotimes (check-slot-idx 2) ;; check both borrow slots in the host
(when (and (= (-> maybe-borrow-from-lev info borrow-level check-slot-idx) (-> obj name)) ;; match name!
(nonzero? (-> maybe-borrow-from-lev info borrow-size check-slot-idx)) ;; has room!
)
(set! slot-in-borrow-from-lev check-slot-idx)
(set! found-borrow #t)
(goto cfg-20)
)
)
(set! found-borrow #f)
(label cfg-20)
(and found-borrow
(>= slot-in-borrow-from-lev 0)
(not (-> maybe-borrow-from-lev borrow-level slot-in-borrow-from-lev)) ;; nobody else using the slot (how?)
)
)
)
(set! borrow-from-lev maybe-borrow-from-lev) ;; success, found somebody to borrow from
(goto cfg-32)
)
)
)
(set! borrow-from-lev (the-as level #f))
(label cfg-32)
(cond
(borrow-from-lev
;; link to borrow level
(set! (-> obj borrow-from-level) borrow-from-lev)
(set! (-> borrow-from-lev borrow-level slot-in-borrow-from-lev) obj)
;; and copy the heap. seems kind of weird to copy the actual kheap object, but the host actually prepared
;; for this, so it should be fine.
(mem-copy!
(the-as pointer (-> obj heap))
(the-as pointer (-> borrow-from-lev borrow-heap slot-in-borrow-from-lev))
16
)
(start-debug "borrowing from ~A. heap:~%" borrow-from-lev)
(inspect (-> obj heap))
)
(else
;; couldn't find it, die.
(format 0 "ERROR: level ~A could not find free ~S bank in the level-group heap~%"
(-> obj name)
(enum->string load-buffer-mode mem-mode)
)
(break!)
0
)
)
)
)
(else
(start-debug "load-begin, no borrow~%")
(dotimes (i LEVEL_TOTAL)
(start-debug "lev ~8S bits #b~b~%"
(-> *level* level i name)
(-> *level* level i memory-mask))
)
;; not borrowing, we have to find our own memory.
;; there's a bit mask to indicate which sections of memory are used, with 6 bits.
;; large = 4 bits, medium = 3 bits, small = 2 bits.
;; note that the the "bits" are not exact sizes, so there is some code to fudge the boundaries a bit
;; depending on the layout - there are 6 bits, but the heap is divided into 146ths, and the actual
;; boundaries are set so the following combinations work:
;; the supported layouts are
;; large + small
;; small + large
;; medium + medium
;; small + medium
;; medium + small
;; small + small-center + small
;; note that small-center cannot exist at the same time as any medium/large.
;; helper function to check to see if a certain group of bits is unused.
(let* ((memory-unused? (lambda ((arg0 level-group) (arg1 int))
(dotimes (v1-0 LEVEL_TOTAL)
(if (logtest? (-> arg0 level v1-0 memory-mask) arg1)
(return #f)
)
)
#t
)
)
(offset-in-level-heap 0)
(heap-size (case mem-mode
(((load-buffer-mode large))
;; 96 pages. this uses up four of the six sections, meaning you can only have a small level alongside a large level.
;; because two of the sections are gonna be in the middle, there is actually space for 98 pages.
;; but it seems ndi did not notice that when writing this code.
(* LEVEL_PAGE_SIZE 96)
)
(((load-buffer-mode medium))
;; 73 pages. this uses up three of the six sections, one of them being a middle section
;; which is 1 page larger than non-middle sections. 24 + 24 + 25 = 73.
;; this means you can either have a medium or small level alongside this.
(* LEVEL_PAGE_SIZE 73)
)
(((load-buffer-mode small-center))
;; 50 pages. this uses up the two middle sections. 25 + 25 = 50.
;; this leaves two sections on each edge of the heap which are used by the small mode.
;; small-center + small + small is the only way to get 3 levels! (borrow levels excluded)
(* LEVEL_PAGE_SIZE 50)
)
(else
;; 48 pages. this uses up two sections that aren't in the middle. 24 + 24 = 48.
(* LEVEL_PAGE_SIZE 48)
)
)
)
)
(case mem-mode
(((load-buffer-mode large))
;; need 4 bits in the mask. first try lower 4
(when (memory-unused? *level* #b001111)
(set! bits-to-use #b1111)
(goto cfg-83)
)
;; nope, try upper 4.
(when (memory-unused? *level* #b111100)
(set! offset-in-level-heap (+ 24 24))
(set! bits-to-use #b111100)
(goto cfg-83)
)
)
(((load-buffer-mode medium))
;; need 3 bits in the mask.
;; like large, check both ends.
(when (memory-unused? *level* #b000111)
(set! bits-to-use #b000111)
(goto cfg-83)
)
(when (memory-unused? *level* #b111000)
(set! offset-in-level-heap (+ 24 24 25)) ;; weird sizing
(set! bits-to-use #b111000)
(goto cfg-83)
)
)
(((load-buffer-mode small-center))
;; only one place for us to go, in the center
(when (memory-unused? *level* #b001100)
(set! offset-in-level-heap (+ 24 24))
(set! bits-to-use #b001100)
(goto cfg-83)
)
)
(((load-buffer-mode small-edge))
;; check one side
(when (memory-unused? *level* #b000011)
(set! bits-to-use #b000011)
(goto cfg-83)
)
;; and the other
(when (memory-unused? *level* #b110000)
(set! offset-in-level-heap (+ 24 24 25 25))
(set! bits-to-use #b110000)
(goto cfg-83)
)
)
)
(set! bits-to-use 0)
(label cfg-83)
(cond
((zero? bits-to-use)
;; darn, couldn't find a spot.
(format 0 "ERROR: level ~A could not find free ~S bank in the level-group heap~%" (-> obj name) (enum->string load-buffer-mode mem-mode))
(dotimes (s5-1 LEVEL_TOTAL)
(if (!= (-> *level* level s5-1 status) 'inactive)
(format
0
"~Tlevel ~16S using bits #x~6,'0B~%"
(-> *level* level s5-1 name)
(-> *level* level s5-1 memory-mask)
)
)
)
#t
(break!)
0
)
(else
(start-debug "successfully found load: size #x~X, bits #x~X, offset ~D~%"
heap-size bits-to-use offset-in-level-heap)
;; found a spot, set mask.
(set! (-> obj memory-mask) (the-as uint bits-to-use))
(cond
;; are we using debug sized large level?
((= (&- (-> *level* heap top) (the-as uint (-> *level* heap base))) DEBUG_LEVEL_HEAP_SIZE)
;; if so, everything is bigger!
(let ((v1-44 (-> obj heap)))
(set! (-> v1-44 base) (&+ (-> *level* heap base) (* DEBUG_LEVEL_PAGE_SIZE offset-in-level-heap)))
(set! (-> v1-44 current) (-> v1-44 base))
;(set! (-> v1-44 top-base) (&+ (-> v1-44 base) (+ heap-size (/ heap-size 2))))
;; pc port note : modified the math here so we can just use a float to change the size
(set! (-> v1-44 top-base) (&+ (-> v1-44 base) (* DEBUG_LEVEL_PAGE_SIZE (/ heap-size LEVEL_PAGE_SIZE))))
(set! (-> v1-44 top) (-> v1-44 top-base))
)
)
(else
(let ((v1-45 (-> obj heap)))
;; no debug size heaps. set up our heap.
;; offset-in-level-heap is in 146ths (1 level heap page) of the total size.
(set! (-> v1-45 base) (&+ (-> *level* heap base) (* LEVEL_PAGE_SIZE offset-in-level-heap)))
(set! (-> v1-45 current) (-> v1-45 base))
(set! (-> v1-45 top-base) (&+ (-> v1-45 base) heap-size))
(set! (-> v1-45 top) (-> v1-45 top-base))
)
)
)
)
)
)
)
)
)
;; our heap is now set up, prepare for loading.
;; the global loading-level heap is used by many relocate/top-level code to allocate on the level heap
(set! loading-level (-> obj heap))
(set! (-> *level* loading-level) obj)
;; start linked list of types associated with this level
(set! (-> obj level-type) #f)
(set! *level-type-list* (the-as type (&-> obj level-type)))
;; clear stuff out
(set! (-> *level* log-in-level-bsp) #f)
(set! (-> obj nickname) #f)
(set! (-> obj bsp) #f)
(set! (-> obj entity) #f)
(set! (-> obj linking) #f)
(set! (-> obj task-mask) (-> *setting-control* user-current task-mask))
(vis-clear obj)
(set! (-> obj load-start-time) (-> *display* real-clock frame-counter))
(set! (-> obj load-stop-time) 0)
(set! (-> obj display-start-time) 0)
(set! (-> obj part-engine) #f)
(dotimes (v1-57 4)
(set! (-> obj user-object v1-57) #f)
)
;; go straight to loading
(set! (-> obj status) 'loading)
;; non-permanent allocator
(set! (-> *texture-pool* allocate-func) texture-page-level-allocate)
(if (= (-> obj load-name) (-> obj info visname))
(format (clear *temp-string*) "~S" (-> obj info nickname))
(format (clear *temp-string*) "~S" (-> obj name))
)
(set! (-> *temp-string* data 8) (the-as uint 0))
(format *temp-string* ".DGO")
(set! (-> obj heap top) (-> obj heap top-base))
(set! (-> *level* load-level) (-> obj load-name))
(set! (-> *level* load-size) (the-as uint 0))
(set! (-> *level* load-time) 0.0)
(set! (-> *level* load-login-time) 0.0)
;; code comes first
(set! (-> obj code-memory-start) (-> obj heap current))
(cond
((= (-> obj info memory-mode) (load-buffer-mode borrow))
;; if we're borrowing, we should load directly to heap current.
;; this is somewhat strange, and has two drawbacks:
;; - we can't discard link data easily, like we would normally with the double buffer setup
;; - we can't allocate during login. Or if we allocate more than our link data, then bad things happen.
(set! (-> obj load-buffer-mode) (load-buffer-mode borrow))
(let ((a3-19 (logand -64 (&+ (-> obj heap current) 63))))
(start-debug "DGO-LOAD-BEGIN FOR BORROW: #x~x~%" a3-19)
;; start dgo loader!
(dgo-load-begin *temp-string* a3-19 a3-19 a3-19)
)
)
(else
;; normal loading into a new heap.
;; allocate the two dgo level load buffers on top, like normal
(let* ((s3-1 #x1b5800)
(s4-1 (kmalloc (-> obj heap) s3-1 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
(s5-4 (kmalloc (-> obj heap) s3-1 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
)
(format 0 "-----------> begin load ~A [~S]~%" (-> obj load-name) *temp-string*)
(set! (-> obj load-buffer 0) (the-as uint s5-4))
(set! (-> obj load-buffer 1) (the-as uint s4-1))
(set! (-> obj load-buffer-size) (the-as uint s3-1))
;; unclear why they do this, I guess it avoids the weird "medium" case in load-buffer-resize.
(set! (-> obj load-buffer-mode) (load-buffer-mode small-edge))
(start-debug "DGO-LOAD-BEGIN: #x~X #x~X #x~X~%" s5-4 s4-1 (logand -64 (&+ (-> obj heap current) 63)))
(dgo-load-begin *temp-string* s5-4 s4-1 (logand -64 (&+ (-> obj heap current) 63)))
)
)
)
obj
)
(defmethod login-begin level ((obj level))
"Begin login of a level after linking.
The login is spread over multiple frames."
;; link done, revert allocate-func back to "normal".
(set! (-> *texture-pool* allocate-func) texture-page-default-allocate)
(cond
((-> obj bsp)
(let ((s5-0 (-> obj bsp)))
(set! (-> s5-0 level tfrag-gs-test)
(if (logtest? (-> s5-0 texture-flags 0) (texture-page-flag alpha-enable))
(new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest greater-equal))
(new 'static 'gs-test
:ate #x1
:atst (gs-atest greater-equal)
:aref #x26
:zte #x1
:ztst (gs-ztest greater-equal)
)
)
)
(set! (-> *level* log-in-level-bsp) (-> obj bsp))
(login-level-textures *texture-pool* obj (-> obj bsp texture-page-count) (-> obj bsp texture-ids))
(dotimes (v1-10 6)
(set! (-> obj sky-mask mask data v1-10) 0)
)
(dotimes (s4-0 10)
(let ((a0-8 (-> obj info texture-anim s4-0)))
(when a0-8
(set! (-> obj info texture-anim s4-0) #f)
(set! (-> obj texture-anim-array s4-0)
(init! (the-as texture-anim-array (-> a0-8 value)))
)
)
)
)
(build-masks s5-0)
)
(set! (-> *login-state* state) -1)
(set! (-> *login-state* pos) (the-as uint 0))
(set! (-> *login-state* elts) (the-as uint 0))
(set! (-> obj status) 'login)
)
(else
(level-status-update! obj 'inactive)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* default-level))
(set! *level-type-list* (the-as type 0))
0
)
)
obj
)
(defun level-update-after-load ((lev level) (lstate login-state))
"Make progress on login.
Will set status to loaded when done."
(local-vars
(current-time int)
(end-time int)
(start-time int)
(sv-16 int)
(proto prototype-bucket-tie)
(geom-idx int)
)
;; in the pc port, lets just do all the login all at once for now.
(set! *level-index* (-> lev index))
0
(let ((drawable-trees (-> lev bsp drawable-trees)))
;; periodically, the code would jump back up here, see if it's been too long.
;; if so, it would return early.
;(.mfc0 start-time Count)
(label cfg-1)
;(.mfc0 current-time Count)
;(let ((v1-6 (- current-time start-time)))
; (when (< #x186a0 v1-6)
; (set! lev lev)
; (goto cfg-113)
; )
; )
(let ((login-state-pos (the-as int (-> lstate pos))))
;;;;;;;;;;;;;; STATE -1: first pass of tree login, art group login.
;; this pass adds drawable-inline-array-tfrag and drawable-tree-instance-tie's to
;; a list in lstate, logs in all other drawable-trees (fast), logs in all art groups,
;; and links all art.
(when (= (-> lstate state) -1)
;; STATE -1, part 1: drawable trees
(when (< login-state-pos (-> drawable-trees length))
(let ((current-tree (-> drawable-trees trees (the-as uint login-state-pos))))
(cond
((= (-> current-tree type) drawable-tree-tfrag)
;; for tfrags, iterate through all arrays
(dotimes (tree-array-idx (-> current-tree length))
(cond
;; for the actual tfrags, defer
((= (-> current-tree data tree-array-idx type) drawable-inline-array-tfrag)
(set! (-> lstate elt (-> lstate elts)) (-> current-tree data tree-array-idx))
(+! (-> lstate elts) 1)
)
(else
;; for the draw node arrays, just do them now (doesn't do anything, I think.)
(login (-> current-tree data tree-array-idx))
)
)
)
)
((= (-> current-tree type) drawable-tree-instance-tie)
;; instance-ties are deferred. This time, the whole thing is put off, including draw-node arrays
(set! (-> lstate elt (-> lstate elts)) current-tree)
(+! (-> lstate elts) 1)
)
(else
;; other trees are logged in hers.
(login current-tree)
)
)
)
;; on to the next tree. Check time
(+! (-> lstate pos) 1)
(goto cfg-1)
)
;; STATE -1, part 2: art gropus:
(let ((art-group-array-idx (- (the-as uint login-state-pos) (-> drawable-trees length))))
(when (< (the-as int art-group-array-idx) (-> lev art-group art-group-array length))
(let ((current-ag (-> lev art-group art-group-array art-group-array-idx)))
;; login and link. only janim's need linking.
(login current-ag)
(if (needs-link? current-ag)
(link-art! current-ag)
)
)
(+! (-> lstate pos) 1)
(goto cfg-1)
)
)
(set! (-> lstate pos) (the-as uint 0))
(set! (-> lstate state) 0)
(goto cfg-1)
)
;; next state is the arrays we put off from last state.
(when (< (-> lstate state) (the-as int (-> lstate elts)))
(let ((current-array (-> lstate elt (-> lstate state))))
(cond
((= (-> current-array type) drawable-inline-array-tfrag)
(set! *texture-masks-array* (-> lev bsp tfrag-masks))
(cond
((< login-state-pos (-> (the-as drawable-inline-array-tfrag current-array) length))
(dotimes (s2-2 200)
(when (< login-state-pos (-> (the-as drawable-inline-array-tfrag current-array) length))
(login (-> (the-as drawable-inline-array-tfrag current-array) data (the-as uint login-state-pos)))
(set! login-state-pos (the-as int (+ (the-as uint login-state-pos) 1)))
)
)
(set! (-> lstate pos) (the-as uint login-state-pos))
)
(else
(set! (-> lstate pos) (the-as uint 0))
(set! login-state-pos (+ (-> lstate state) 1))
(set! (-> lstate state) login-state-pos)
)
)
)
((= (-> current-array type) drawable-tree-instance-tie)
(let ((proto-array (-> (the-as drawable-tree-instance-tie current-array) prototypes prototype-array-tie)))
(let ((protos (-> (the-as drawable-tree-instance-tie current-array) prototypes)))
(when (< login-state-pos (-> proto-array length))
(set! sv-16 0)
(while (< sv-16 10)
(when (< login-state-pos (-> proto-array length))
(set! proto (-> proto-array array-data (the-as uint login-state-pos)))
(+! (-> protos prototype-max-qwc) 32)
(cond
((logtest? (-> proto flags) (prototype-flags tpage-alpha))
(set! *texture-masks* (-> *level* level *level-index* bsp alpha-masks data (-> proto texture-masks-index)))
)
((logtest? (-> proto flags) (prototype-flags tpage-water))
(set! *texture-masks* (-> *level* level *level-index* bsp water-masks data (-> proto texture-masks-index)))
)
(else
(set! *texture-masks* (-> *level* level *level-index* bsp tfrag-masks data (-> proto texture-masks-index)))
)
)
(when (and *debug-segment* (-> *screen-shot-work* highres-enable))
(dotimes (v1-105 4)
(set! (-> proto dists data v1-105) (+ 40960000.0 (-> proto dists data v1-105)))
(set! (-> proto rdists data v1-105) (/ 1.0 (-> proto dists data v1-105)))
)
)
(set! geom-idx 0)
(while (< geom-idx 4)
(let ((geom (-> proto tie-geom geom-idx)))
(when (nonzero? geom)
(+! (-> protos prototype-max-qwc) (* 7 (-> geom length)))
(login geom)
)
)
(set! geom-idx (+ geom-idx 1))
)
(set! login-state-pos (the-as int (+ (the-as uint login-state-pos) 1)))
)
(set! sv-16 (+ sv-16 1))
)
(set! (-> lstate pos) (the-as uint login-state-pos))
)
)
(when (= (the-as uint login-state-pos) (-> proto-array length))
(dotimes (proto2-idx (-> proto-array length))
(let ((proto2 (-> proto-array array-data proto2-idx)))
(cond
((logtest? (-> proto2 flags) (prototype-flags tpage-alpha))
(set! *texture-masks* (-> *level* level *level-index* bsp alpha-masks data (-> proto2 texture-masks-index)))
)
((logtest? (-> proto2 flags) (prototype-flags tpage-water))
(set! *texture-masks* (-> *level* level *level-index* bsp water-masks data (-> proto2 texture-masks-index)))
)
(else
(set! *texture-masks* (-> *level* level *level-index* bsp tfrag-masks data (-> proto2 texture-masks-index)))
)
)
(let ((envmap-shader (-> proto2 envmap-shader)))
(when (nonzero? envmap-shader)
(let ((envmap-tex (adgif-shader-login-no-remap envmap-shader)))
(when envmap-tex
(dotimes (v1-137 3)
(dotimes (a0-74 3)
(set! (-> (the-as (pointer int32) (+ (+ (* v1-137 16) (* a0-74 4)) (the-as int *texture-masks*))))
(logior (-> (the-as (pointer int32) (+ (* a0-74 4) (the-as int *texture-masks*) (* v1-137 16))) 0)
(-> (the-as (pointer int32) (+ (* a0-74 4) (the-as int envmap-tex) (* v1-137 16))) 15)
)
)
)
(set! (-> *texture-masks* data v1-137 mask w)
(the-as int (fmax (-> *texture-masks* data v1-137 dist) (-> envmap-tex masks data v1-137 dist)))
)
)
)
)
(set! (-> envmap-shader tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
(set! (-> envmap-shader clamp)
(new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp))
)
(set! (-> envmap-shader alpha) (new 'static 'gs-alpha :b #x2 :c #x1 :d #x1))
(set! (-> envmap-shader prims 1) (gs-reg64 tex0-1))
(set! (-> envmap-shader prims 3) (gs-reg64 tex1-1))
(set! (-> envmap-shader prims 5) (gs-reg64 miptbp1-1))
(set! (-> envmap-shader clamp-reg) (gs-reg64 clamp-1))
(set! (-> envmap-shader prims 9) (gs-reg64 alpha-1))
)
)
)
)
(set! (-> lstate pos) (the-as uint 0))
(+! (-> lstate state) 1)
)
)
)
)
)
(goto cfg-1)
)
;; next is nav-meshes
(when (= (-> lstate state) (-> lstate elts))
(let ((lev-bsp (-> lev bsp)))
(cond
((or (zero? (-> lev-bsp nav-meshes)) (= (the-as uint login-state-pos) (-> lev-bsp nav-meshes length)))
(set! (-> lstate pos) (the-as uint 0))
(+! (-> lstate state) 1)
)
(else
(initialize-nav-mesh! (-> lev-bsp nav-meshes (the-as uint login-state-pos)))
(+! (-> lstate pos) 1)
)
)
)
(goto cfg-1)
)
(when (zero? (the-as uint login-state-pos))
(set! (-> lstate pos) (the-as uint 1))
(set! lev lev)
(goto cfg-113)
)
)
)
;; final!
;; name
(set! (-> lev nickname) (-> lev bsp nickname))
;; added: tombc has the wrong nickname in the bsp file...
(if (and (= (-> lev bsp name) 'tombc) (= (-> lev bsp nickname) 'toa))
(set! (-> lev nickname) 'toc)
)
;; subdivide distances
(let ((close-dist (-> lev bsp subdivide-close))
(far-dist (-> lev bsp subdivide-far))
)
(when (and (= close-dist 0.0) (= far-dist 0.0))
(set! close-dist 122880.0)
(set! far-dist 286720.0)
)
(set! (-> *subdivide-settings* close (-> lev index)) close-dist)
(set! (-> *subdivide-settings* far (-> lev index)) far-dist)
(set! (-> *subdivide-settings* close 7) close-dist)
(set! (-> *subdivide-settings* far 7) far-dist)
)
(when (and *debug-segment* (-> *screen-shot-work* highres-enable))
(set! (-> *subdivide-settings* close (-> lev index)) 40960000.0)
(set! (-> *subdivide-settings* far (-> lev index)) 41369600.0)
(set! (-> *subdivide-settings* close 7) 40960000.0)
(set! (-> *subdivide-settings* far 7) 41369600.0)
)
;; visibility info
(init-vis-from-bsp lev)
;; particle engines
(if (nonzero? (-> lev info part-engine-max))
(set! (-> lev part-engine)
(new 'loading-level 'engine 'sparticle-launcher (-> lev info part-engine-max) connection)
)
)
;; load other packages (used only for development, I think)
(load-required-packages lev)
;; mood setup
(clear-mood-context (-> lev mood-context))
(if (-> lev mood-init)
((-> lev mood-init) (-> lev mood-context))
)
;; if somebody will borrow from us, set aside some memory for them on the top of our heap
(dotimes (v1-211 2)
(set! (-> lev heap top-base)
;; MODIFIED
(the pointer (&- (-> lev heap top-base) (the uint (shl (the int (* BORROW_MULT (-> lev info borrow-size v1-211))) 10))))
)
(set! (-> lev heap top) (-> lev heap top-base))
(let ((borrower-heap (-> lev borrow-heap v1-211)))
(set! (-> borrower-heap base) (-> lev heap top))
(set! (-> borrower-heap current) (-> borrower-heap base))
;; MODIFIED
(set! (-> borrower-heap top-base) (&+ (-> borrower-heap base) (the int (shl (the int (* BORROW_MULT (-> lev info borrow-size v1-211))) 10))))
(set! (-> borrower-heap top) (-> borrower-heap top-base))
)
)
;; end the load
(set! (-> lev draw-priority) (-> lev info draw-priority))
(set! (-> lev status) 'loaded)
(mark-hud-warp-sprite-dirty *texture-pool*)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* default-level))
(set! *level-type-list* (the-as type 0))
(set! (-> *level* log-in-level-bsp) #f)
(set! (-> lev load-stop-time) (-> *display* real-clock frame-counter))
0
(.mfc0 end-time Count)
(- end-time start-time)
(set! (-> *level* load-login-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
)
(label cfg-113)
lev
)
(defmethod birth level ((obj level))
"Start running code for a level that has been loaded."
(local-vars (sv-96 int))
(case (-> obj status)
(('loaded)
(let ((s5-0 loading-level)
(s4-0 (-> *level* loading-level))
(s3-0 (-> *level* log-in-level-bsp))
(s2-1 *level-type-list*)
)
(let ((s1-0 (not (-> obj entity))))
(set! loading-level (-> obj heap))
(set! (-> *level* log-in-level-bsp) (-> obj bsp))
(set! (-> *level* loading-level) obj)
(set! *level-type-list* (the-as type (&-> obj level-type)))
(cond
((valid? (-> obj bsp light-hash) light-hash (the-as string #f) #t 0)
(set! (-> obj light-hash) (-> obj bsp light-hash))
)
(else
(set! (-> obj light-hash) (the-as light-hash 0))
0
)
)
(birth (-> obj bsp))
(set! (-> obj status) 'alive)
(set! (-> obj render?) #t)
(copy-perms-to-level! *game-info* obj)
(send-event *camera* 'level-activate (-> obj name))
(send-event *target* 'level-activate (-> obj name))
(when (and (-> obj info login-func) s1-0)
(let ((s1-1 (-> obj info login-func value)))
(if (and s1-1 (nonzero? s1-1) (type? s1-1 function))
((the (function level none) s1-1) obj)
)
)
)
)
(let ((s1-2 (-> obj status)))
(set! (-> obj status) 'active)
(update-task-masks 'level)
(assign-draw-indices *level*)
(let ((s0-0 (-> obj bsp nav-meshes)))
(when (nonzero? s0-0)
(set! sv-96 0)
(while (< sv-96 (-> s0-0 length))
(birth! (-> s0-0 sv-96))
(set! sv-96 (+ sv-96 1))
)
)
)
(if (and (!= (-> obj bsp city-level-info) 0) *traffic-manager*)
(send-event *traffic-manager* 'level-loaded obj)
)
(when (-> obj info activate-func)
(let ((s0-1 (-> obj info activate-func value)))
(if (and s0-1 (nonzero? s0-1) (type? s0-1 function))
((the (function level symbol none) s0-1) obj 'display)
)
)
)
(set! (-> obj status) s1-2)
)
(set! loading-level s5-0)
(set! (-> *level* loading-level) s4-0)
(set! (-> *level* log-in-level-bsp) s3-0)
(set! *level-type-list* s2-1)
)
)
)
obj
)
(defmethod deactivate level ((obj level))
"Take a level out of active/alive"
(case (-> obj status)
(('active 'alive)
(format 0 "----------- kill ~A (status ~A)~%" obj (-> obj status))
;; send event to traffic manager.
(if (and (!= (-> obj bsp city-level-info) 0) *traffic-manager*)
(send-event *traffic-manager* 'level-killed obj)
)
;; run kill callbacks
(when (-> obj info kill-func)
(let ((s5-0 (-> obj info kill-func value)))
(if (and s5-0 (nonzero? s5-0) (type? s5-0 function))
((the (function level none) s5-0) obj)
)
)
)
;; copy data from entities to permanent storage
(copy-perms-from-level! *game-info* obj)
;; tell target
(send-event *target* 'level-deactivate (-> obj name))
;; remove from background draw system
(remove-by-param1 *background-draw-engine* (the-as int (-> obj bsp)))
;; kill entities, particles, anims
(deactivate-entities (-> obj bsp))
(kill-all-particles-in-level obj)
(unload-from-level *anim-manager* obj)
;; reset status
(set! (-> obj inside-boxes) #f)
(set! (-> obj meta-inside?) #f)
(set! (-> obj force-inside?) #f)
(set! (-> obj status) 'loaded)
(set! (-> obj light-hash) (the-as light-hash 0))
(set! (-> obj all-visible?) 'loading)
;; clear vis.
(dotimes (v1-34 128)
(set! (-> (the-as (pointer int128) (&+ (-> obj vis-bits) (* v1-34 16)))) (the int128 0))
)
(countdown (v1-37 8)
(let ((a0-20 (-> obj vis-info v1-37)))
(if a0-20
(set! (-> a0-20 current-vis-string) (the-as uint -1))
)
)
)
)
)
(if (= (-> *level* log-in-level-bsp) (-> obj bsp))
(set! (-> *level* log-in-level-bsp) #f)
)
obj
)
(defmethod unload! level ((obj level))
"Unload a level."
;; make sure it's not alive/active
(deactivate obj)
(when (!= (-> obj status) 'inactive)
;; first, unload anybody who borrows from us.
(dotimes (s5-0 2)
(when (-> obj borrow-level s5-0)
(unload! (-> obj borrow-level s5-0))
(set! (-> obj borrow-level s5-0) #f)
)
)
;; if we borrow from somebody, remove ourselves from them
(when (-> obj borrow-from-level)
(dotimes (v1-19 2)
(if (= obj (-> obj borrow-from-level borrow-level v1-19))
(set! (-> obj borrow-from-level borrow-level v1-19) #f)
)
)
(set! (-> obj borrow-from-level) #f)
)
(case (-> obj status)
(('loading 'loading-bt)
;; kill the linker if we're mid link.
(if (nonzero? link-reset)
(link-reset)
)
)
(('alive 'active 'loaded)
;; run deactivate func.
(when (-> obj info deactivate-func)
(let ((s5-1 (-> obj info deactivate-func value)))
(if (and s5-1 (nonzero? s5-1) (type? s5-1 function))
((the (function level none) s5-1) obj)
)
)
)
)
)
;; unlink art groups.
(when (or (= (-> obj status) 'loaded)
(= (-> obj status) 'alive)
(= (-> obj status) 'active)
(= (-> obj status) 'login)
)
(dotimes (s5-2 (-> obj art-group art-group-array length))
(let ((s4-0 (-> obj art-group art-group-array s5-2)))
(if (needs-link? s4-0)
(unlink-art! s4-0)
)
)
)
)
(set! (-> obj bsp) #f)
(set! (-> obj entity) #f)
(set! (-> obj status) 'inactive)
(set! (-> obj linking) #f)
(set! (-> obj art-group string-array length) 0)
(set! (-> obj art-group art-group-array length) 0)
(set! (-> obj mem-usage-block) (the-as memory-usage-block 0))
(set! (-> obj mem-usage) 0)
(set! (-> obj part-engine) #f)
(dotimes (v1-60 4)
(set! (-> obj user-object v1-60) #f)
)
;; kill texture anims
(let ((v1-63 (-> obj status)))
(when (or (= v1-63 'alive) (or (= v1-63 'active) (= v1-63 'loaded)))
(dotimes (s5-3 10)
(let ((a0-37 (-> obj info texture-anim s5-3)))
(if a0-37
(set! (-> obj texture-anim-array s5-3)
(clear! (the-as texture-anim-array (-> a0-37 value)))
)
)
)
)
)
)
(dotimes (v1-73 10)
(set! (-> obj texture-anim-array v1-73) #f)
)
(countdown (s5-4 (-> obj loaded-texture-page-count))
(dotimes (v1-76 32)
(when (= (-> obj loaded-texture-page s5-4) (-> *texture-pool* common-page v1-76))
(set! (-> *texture-pool* common-page v1-76) (the-as texture-page 0))
0
)
)
(unload-page *texture-pool* (-> obj loaded-texture-page s5-4))
)
(set! (-> obj loaded-texture-page-count) 0)
(unlink-shaders-in-heap *texture-page-dir* (-> obj heap))
(unlink-part-group-by-heap (-> obj heap))
(unlink-lightning-spec-by-heap (-> obj heap))
(particle-adgif-cache-flush)
(set! (-> obj loaded-text-info-count) 0)
(dotimes (s5-5 2)
(let ((v1-90 (-> *art-control* buffer s5-5 pending-load-file)))
(if (and (>= (the-as int v1-90) (the-as int (-> obj heap base)))
(< (the-as int v1-90) (the-as int (-> obj heap top-base)))
)
(set-pending-file (-> *art-control* buffer s5-5) (the-as string #f) -1 (the-as handle #f) 100000000.0)
)
)
)
(let ((v1-100 (-> *game-info* sub-task-list)))
(dotimes (a0-59 (-> v1-100 length))
(when (nonzero? a0-59)
(let ((a1-20 (-> v1-100 a0-59)))
(when (and (-> a1-20 info) (= (-> a1-20 info level) (-> obj name)))
(countdown (a2-6 7)
(set! (-> a1-20 info hooks a2-6) #f)
)
)
)
)
)
)
(let ((v1-103 0)
(a0-60 0)
(a1-23 (-> obj level-type))
)
(while a1-23
(+! a0-60 1)
(+! v1-103 (-> a1-23 psize))
;; PC port note : added this call to kill entities using level types that are being unloaded because of bad entity placement
(kill-by-type a1-23 *active-pool*)
(set! (-> a1-23 symbol value) (the-as object 0))
(set! a1-23 (the-as type (-> a1-23 method-table 8)))
)
)
(let* ((s5-6 (-> obj info packages))
(a0-61 (car s5-6))
)
(while (not (null? s5-6))
(case (rtype-of a0-61)
((symbol)
(unload (symbol->string (the-as symbol a0-61)))
)
((string)
(unload (the-as string a0-61))
)
)
(set! s5-6 (cdr s5-6))
(set! a0-61 (car s5-6))
)
)
(vis-clear obj)
(let ((v1-120 (-> obj heap)))
(set! (-> v1-120 current) (-> v1-120 base))
)
(set! (-> obj memory-mask) (the-as uint 0))
(set! (-> obj code-memory-start) (the-as pointer 0))
(set! (-> obj code-memory-end) (the-as pointer 0))
(set! (-> obj level-type) #f)
(when (= (-> *level* loading-level) obj)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* default-level))
(set! (-> *level* log-in-level-bsp) #f)
(set! *level-type-list* (the-as type 0))
0
)
(assign-draw-indices *level*)
)
obj
)
(defmethod is-object-visible? level ((obj level) (arg0 int))
"Is drawable arg0 visible? Note that this will return #f if the visibility data is not loaded."
;; check the vis bits!
(let* (;; lwu v1, 388(a0)
(vis-data (-> obj vis-bits))
;; sra a0, a1, 3
(byte-idx (sar arg0 3))
;; daddu v1, a0, v1
;; lb v1, 0(v1)
(vis-byte (-> (the (pointer int8) vis-data) byte-idx))
;; andi a0, a1, 7
(bit-idx (logand arg0 #b111))
;; addiu a0, a0, 56
(shift-amount (+ bit-idx 56)) ;; 56 + 8 = 64, to set the sign bit
;; dsllv v1, v1, a0
(check-sign-word (the int (shl vis-byte shift-amount))) ;; signed
)
;; slt v1, v1, r0 v1 = (csw < 0)
;; daddiu v0, s7, 8
;; movz v0, s7, v1 if (csw >= 0) result = false
;;(format 0 "vis check ~D ~X ~X ~A~%" arg0 vis-byte check-sign-word (>= check-sign-word 0))
(< check-sign-word 0)
)
)
(defmethod inside-boxes-check level ((obj level) (arg0 vector))
"NOTE: this function used to check if we were in boxes - here it just checks
a flag. However, it is still used to set the inside-boxes field, so it keeps
the name we gave it in Jak 1.
The jak 2 behavior is that any loaded level (with a bsp) is considered 'in-boxes'
except for if the require-force-inside flag is set in the bsp-header, in which case
it requires the level to be marked as force-inside?"
(cond
((not (-> obj bsp))
#f
)
((-> obj force-inside?)
#t
)
(else
(zero? (-> obj bsp cam-outside-bsp))
)
)
)
(defmethod debug-print-region-splitbox level ((obj level) (arg0 vector) (arg1 object))
"Display debug info about the regions of a level."
(cond
((or (not (-> obj bsp)) (zero? (-> obj bsp region-tree)))
)
((nonzero? (-> obj bsp region-tree))
(debug-print (-> obj bsp region-tree) arg0 arg1)
)
)
0
(none)
)
(defmethod mem-usage level ((obj level) (arg0 memory-usage-block) (arg1 int))
"Compute the memory usage of a level."
(when (= (-> obj status) 'active)
(set! (-> arg0 length) (max 67 (-> arg0 length)))
(set! (-> arg0 data 66 name) "entity-links")
(+! (-> arg0 data 66 count) (-> obj entity length))
(let ((v1-8 (asize-of (-> obj entity))))
(+! (-> arg0 data 66 used) v1-8)
(+! (-> arg0 data 66 total) (logand -16 (+ v1-8 15)))
)
(mem-usage (-> obj art-group) arg0 arg1)
(set! (-> arg0 length) (max 66 (-> arg0 length)))
(set! (-> arg0 data 65 name) "level-code")
(+! (-> arg0 data 65 count) 1)
(let ((v1-20 (&- (-> obj code-memory-end) (the-as uint (-> obj code-memory-start)))))
(+! (-> arg0 data 65 used) v1-20)
(+! (-> arg0 data 65 total) (logand -16 (+ v1-20 15)))
)
(countdown (s3-0 (-> obj loaded-texture-page-count))
(mem-usage (-> obj loaded-texture-page s3-0) arg0 arg1)
)
(countdown (s3-1 (-> obj loaded-text-info-count))
(mem-usage (-> obj loaded-text-info s3-1) arg0 arg1)
)
(countdown (s3-2 8)
(let ((s2-0 (-> obj vis-info s3-2)))
(when s2-0
(cond
((zero? s3-2)
(set! (-> arg0 length) (max 62 (-> arg0 length)))
(set! (-> arg0 data 61 name) "bsp-leaf-vis-self")
(+! (-> arg0 data 61 count) 1)
(let ((v1-47 (+ (asize-of s2-0) (-> s2-0 allocated-length))))
(+! (-> arg0 data 61 used) v1-47)
(+! (-> arg0 data 61 total) (logand -16 (+ v1-47 15)))
)
)
(else
(set! (-> arg0 length) (max 63 (-> arg0 length)))
(set! (-> arg0 data 62 name) "bsp-leaf-vis-adj")
(+! (-> arg0 data 62 count) 1)
(let ((v1-58 (+ (asize-of s2-0) (-> s2-0 allocated-length))))
(+! (-> arg0 data 62 used) v1-58)
(+! (-> arg0 data 62 total) (logand -16 (+ v1-58 15)))
)
)
)
)
)
)
;; most of this is in the bsp:
(mem-usage (-> obj bsp) arg0 arg1)
)
obj
)
(defmethod alloc-levels-if-needed level-group ((obj level-group) (arg0 symbol))
"Setup for playing levels by loading the required base packages (art, common)
and allocating the level heap."
(when (zero? (-> *level* heap base))
(start-debug "level one-time setup~%")
(kmemopen global "level-heaps")
(when (nmember "game" *kernel-packages*)
(start-debug "game already loaded, provides art/common~%")
(set! *kernel-packages* (cons "art" *kernel-packages*))
(set! *kernel-packages* (cons "common" *kernel-packages*))
)
(load-package "art" global)
(if arg0
(load-package "common" global)
)
(let ((s5-1 (if (and arg0 (not *debug-segment*))
(#if PC_PORT DEBUG_LEVEL_HEAP_SIZE LEVEL_HEAP_SIZE)
DEBUG_LEVEL_HEAP_SIZE
)
)
(gp-1 (-> obj heap))
)
(start-debug "about to allocate level heap with size #x~X (~f MB)~%" s5-1 (/ (the float s5-1) 1024.))
(set! (-> gp-1 base) (kmalloc global s5-1 (kmalloc-flags) "heap"))
(set! (-> gp-1 current) (-> gp-1 base))
(set! (-> gp-1 top-base) (&+ (-> gp-1 base) s5-1))
(set! (-> gp-1 top) (-> gp-1 top-base))
)
(kmemclose)
)
0
(none)
)
(defmethod level-get-with-status level-group ((obj level-group) (arg0 symbol))
"Get a level with the given status."
(dotimes (v1-0 (-> obj length))
(if (= (-> obj level v1-0 status) arg0)
(return (-> obj level v1-0))
)
)
(the-as level #f)
)
(defmethod level-get-most-disposable level-group ((obj level-group))
"Get the level that's least useful."
(dotimes (v1-0 (-> obj length))
(case (-> obj level v1-0 status)
(('inactive)
(return (-> obj level v1-0))
)
)
)
(dotimes (v1-6 (-> obj length))
(case (-> obj level v1-6 status)
(('loading 'loading-bt)
(return (-> obj level v1-6))
)
)
)
(dotimes (v1-12 (-> obj length))
(case (-> obj level v1-12 status)
(('loaded)
(return (-> obj level v1-12))
)
)
)
(let ((v0-0 (the-as level #f)))
(dotimes (v1-18 (-> obj length))
(case (-> obj level v1-18 status)
(('active)
(if (and (not (-> obj level v1-18 inside-boxes))
(or (not v0-0) (< (-> obj level v1-18 info priority) (-> v0-0 info priority)))
)
(set! v0-0 (-> obj level v1-18))
)
)
)
)
v0-0
)
)
(defmethod level-get level-group ((obj level-group) (arg0 symbol))
"Get a level by name or load-name"
(dotimes (v1-0 (-> obj length))
(if (and (!= (-> obj level v1-0 status) 'inactive)
(or (= (-> obj level v1-0 name) arg0) (= (-> obj level v1-0 load-name) arg0))
)
(return (-> obj level v1-0))
)
)
(the-as level #f)
)
(defmethod art-group-get-by-name level-group ((obj level-group) (arg0 string) (arg1 (pointer uint32)))
"Search all levels for an art-group. Return the art group, or #f. Optionally return the level index."
(countdown (s4-0 LEVEL_TOTAL)
(let ((s3-0 (-> *level* level s4-0)))
(when (or (= (-> s3-0 status) 'active) (= (-> s3-0 status) 'reserved))
(countdown (s2-0 (-> s3-0 art-group art-group-array length))
(when (name= (-> s3-0 art-group art-group-array s2-0 name) arg0)
(if arg1
(set! (-> arg1 0) (the-as uint s3-0))
)
(return (-> s3-0 art-group art-group-array s2-0))
)
)
)
)
)
(the-as art-group #f)
)
(defmethod activate-levels! level-group ((obj level-group))
"Set all levels to active."
(dotimes (s5-0 (-> obj length))
(level-status-update! (-> obj level s5-0) 'active)
)
0
)
(defmethod level-get-target-inside level-group ((obj level-group))
"Get the level that target is 'in'. With a bunch of tricks for what 'in' really means."
(let ((s5-0 (target-pos 0)))
;; first, try the level that we want for visibility data.
;; this is the most 'in' level.
(let ((v1-1 (-> *load-state* vis-nick)))
(when v1-1
(dotimes (a0-3 (-> obj length))
(let ((a1-3 (-> obj level a0-3)))
(when (= (-> a1-3 status) 'active)
(if (= (-> a1-3 name) v1-1)
(return a1-3)
)
)
)
)
)
)
;; next, try the level for the continue point.
(let ((v1-5 (-> *game-info* current-continue level)))
(dotimes (a0-5 (-> obj length))
(let ((a1-8 (-> obj level a0-5)))
(when (= (-> a1-8 status) 'active)
(if (= (-> a1-8 name) v1-5)
(return a1-8)
)
)
)
)
)
;; next, try using bounding spheres to find the closest.
;; (note that this is slightly broken, f30-0 is never updated)
(let ((s4-0 (the-as level #f)))
(let ((f30-0 0.0))
(dotimes (s3-0 (-> obj length))
(let ((s2-0 (-> obj level s3-0)))
(when (= (-> s2-0 status) 'active)
(let ((f0-0 (vector-vector-distance (-> s2-0 bsp bsphere) s5-0)))
(if (and (-> s2-0 inside-boxes) (or (not s4-0) (< f0-0 f30-0)))
(set! s4-0 s2-0)
)
)
)
)
)
)
(if s4-0
(return s4-0)
)
)
)
;; if all that failed, try any with the meta-inside? flag.
(dotimes (v1-23 (-> obj length))
(let ((a0-11 (-> obj level v1-23)))
(when (= (-> a0-11 status) 'active)
(if (-> a0-11 meta-inside?)
(return a0-11)
)
)
)
)
;; if that still didn't work, return any active level.
(let ((v0-1 (the-as level #f)))
0.0
(dotimes (v1-26 (-> obj length))
(let ((a0-16 (-> obj level v1-26)))
(when (= (-> a0-16 status) 'active)
(if (not v0-1)
(set! v0-1 a0-16)
)
)
)
)
v0-1
)
)
(defmethod load-commands-set! level-group ((obj level-group) (arg0 pair))
"Set the load-commands of a level."
(set! (-> obj load-commands) arg0)
(none)
)
(defmethod mem-usage level-group ((obj level-group) (arg0 memory-usage-block) (arg1 int))
"Compute mem-usage for an entire level-group."
(dotimes (s3-0 (-> obj length))
(mem-usage (-> obj level s3-0) arg0 arg1)
)
obj
)
(defun bg ((arg0 symbol))
"Begin playing a level. Works with or without dproc running (won't start it)."
;; enable cheat-mode if debugging
(set! *cheat-mode* (if *debug-segment*
'debug
#f
)
)
(let ((v1-2 (lookup-level-info arg0)))
(cond
((= (-> v1-2 visname) arg0) ;; we used a visname, enable vis!
(set! (-> *level* vis?) #t)
(set! arg0 (-> v1-2 name)) ;; and use the normal name for loading.
)
(else
;; otherwise disable vis, low memory warnings.
(set! (-> *level* vis?) #f)
(set! (-> *kernel-context* low-memory-message) #f)
)
)
;; disable borrow mode, as we might not have anybody to borrow from.
(case (-> v1-2 memory-mode)
(((load-buffer-mode borrow))
(set! (-> v1-2 memory-mode) (load-buffer-mode small-edge))
0
)
)
;; load all required packages
(let* ((s5-0 (-> v1-2 run-packages))
(a0-11 (car s5-0))
)
(while (not (null? s5-0))
(case (rtype-of a0-11)
((symbol)
(load-package (symbol->string (the-as symbol a0-11)) global)
)
((string)
(load-package (the-as string a0-11) global)
)
)
(set! s5-0 (cdr s5-0))
(set! a0-11 (car s5-0))
)
)
)
;; start the load!
(let ((gp-1 (level-get-for-use *level* arg0 'active)))
;; if dproc isn't running, run the load here...
(while (and gp-1
(or (= (-> gp-1 status) 'loading) (= (-> gp-1 status) 'loading-bt) (= (-> gp-1 status) 'login))
(not *dproc*)
)
(load-continue gp-1)
)
;; otherwise, set up the load-state. level-update will be called from dproc, which will read this and load it.
(reset! *load-state*)
(set! (-> *load-state* vis-nick) (-> gp-1 name))
(set! (-> *load-state* want 0 name) (-> gp-1 name))
(set! (-> *load-state* want 0 display?) 'display)
;; load the first continue point
(if (-> gp-1 info continues)
(set-continue! *game-info* (the-as basic (car (-> gp-1 info continues))) #f)
)
)
(dotimes (v1-37 3)
(set! (-> *load-state* want-sound v1-37) (-> *game-info* current-continue want-sound v1-37))
)
;; also try to load borrow level
(add-borrow-levels *load-state*)
;; if we loaded, activate now.
(activate-levels! *level*)
(set! *print-login* #f)
(set! (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
0
(none)
)
(defun play ((arg0 symbol) (arg1 symbol))
"Set up the game engine for playing."
(kmemopen global "level-boot")
(when *kernel-boot-level*
(start-debug "using *kernel-boot-level*: ~A~%" *kernel-boot-level*)
(bg *kernel-boot-level*)
(on #f)
(kmemclose)
(kmemclose)
(return 0)
)
(let* ((v1-3 *kernel-boot-message*)
(s5-0 (cond
((or (= v1-3 'demo) (= v1-3 'demo-shared))
'demo
)
(*debug-segment*
'prison
)
(else
'title
)
)
)
)
(start-debug "PLAY: kernel-boot-message is: ~A, startup level is ~A~%" v1-3 s5-0)
(stop 'play)
(set! (-> *level* vis?) arg0)
(set! (-> *level* want-level) #f)
(set! (-> *level* border?) #t)
(set! (-> *setting-control* user-default border-mode) #t)
(set! (-> *level* play?) #t)
(start-debug "PLAY: allocating levels~%")
(alloc-levels-if-needed *level* #t)
(start-debug "PLAY: global heap after level alloc:~%")
(inspect global)
(set! *display-profile* #f)
(set! *cheat-mode* (if *debug-segment*
'debug
#f
)
)
(set! *time-of-day-fast* #f)
(load-commands-set! *level* '())
(send-event (ppointer->process *time-of-day*) 'change 'ratio #x3f800000)
(send-event (ppointer->process *time-of-day*) 'change 'hour 7)
(send-event (ppointer->process *time-of-day*) 'change 'minutes 0)
(send-event (ppointer->process *time-of-day*) 'change 'seconds 0)
(send-event (ppointer->process *time-of-day*) 'change 'frames 0)
(set! (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
(set! (-> *mood-control* overide-weather-flag) #f)
(set-blackout-frames (seconds 0.02))
(when (not *dproc*)
(reset! *load-state*)
(let ((s4-1 (level-get-for-use *level* s5-0 'active)))
(let ((a1-11 (new 'stack-no-clear 'array 'symbol 10)))
(set! (-> a1-11 5) #f)
(set! (-> a1-11 4) #f)
(set! (-> a1-11 3) #f)
(set! (-> a1-11 2) #f)
(set! (-> a1-11 1) (if (= s5-0 'ctysluma)
'ctywide
)
)
(set! (-> a1-11 0) s5-0)
(start-debug "setting load-state want-levels~%")
(want-levels *load-state* a1-11)
)
(start-debug "setting load-state want-display-level~%")
(want-display-level *load-state* s5-0 'display)
(if (= s5-0 'ctysluma)
(want-display-level *load-state* 'ctywide 'display)
)
(start-debug "setting load-state want-vis-level~%")
(want-vis-level *load-state* s5-0)
(while (and s4-1 (or (= (-> s4-1 status) 'loading) (= (-> s4-1 status) 'loading-bt) (= (-> s4-1 status) 'login)))
(set-blackout-frames (seconds 0.02))
(load-continue s4-1)
)
)
)
(set! *print-login* #f)
(level-status-update! (level-get *level* s5-0) 'active)
)
(start-debug "PLAY: starting dproc~%")
(on #t)
(if arg1
(initialize! *game-info* 'game (the-as game-save #f) (the-as string #f))
)
(kmemclose)
(kmemclose)
0
)
(defun play-boot ()
"Entry point from C to initialize game for running.
This simply calls (play #t #t) in a GOAL thread."
(start-debug "play-boot about to switch stacks for calling play...~%")
(process-spawn-function
process
(lambda () (play #t #t) (none))
:from *4k-dead-pool*
:stack *kernel-dram-stack*
)
0
(none)
)
(defun update-sound-banks ()
"Load sound banks as needed."
(local-vars (v1-21 level-load-info) (v1-28 level-load-info) (a0-24 symbol))
(if (or (nonzero? (rpc-busy? 1))
(nonzero? (rpc-busy? 3))
(load-in-progress? *level*)
(not (-> *setting-control* user-current sound-bank-load))
)
(return 0)
)
(let ((gp-0 (new 'static 'boxed-array :type symbol :length 0 :allocated-length 3)))
(set! (-> gp-0 length) 3)
(dotimes (s5-0 3)
(let ((s4-0 (the-as object (-> *load-state* want-sound s5-0))))
(let ((v1-13 (and (not (null? (-> *setting-control* user-current extra-bank)))
(-> *setting-control* user-current extra-bank)
)
)
)
(when v1-13
(let ((a0-7 (car v1-13)))
(while (not (null? v1-13))
(cond
((and (= s5-0 2) (= (car a0-7) 'force2))
(set! s4-0 (car (cdr a0-7)))
)
((= (car a0-7) s4-0)
(set! s4-0 (car (cdr a0-7)))
)
)
(set! v1-13 (cdr v1-13))
(set! a0-7 (car (the-as pair v1-13)))
)
)
)
)
(let ((v1-19 (and (-> ctywide borrow-level 0)
(begin (set! v1-21 (lookup-level-info (-> ctywide borrow-level 0))) v1-21)
(-> v1-21 extra-sound-bank)
)
)
)
(when v1-19
(let ((a0-14 (car v1-19)))
(while (not (null? v1-19))
(if (= (car a0-14) s4-0)
(set! s4-0 (car (cdr a0-14)))
)
(set! v1-19 (cdr v1-19))
(set! a0-14 (car (the-as pair v1-19)))
)
)
)
)
(let ((v1-26 (and (-> ctywide borrow-level 1)
(begin (set! v1-28 (lookup-level-info (-> ctywide borrow-level 1))) v1-28)
(-> v1-28 extra-sound-bank)
)
)
)
(when v1-26
(let ((a0-19 (car v1-26)))
(while (not (null? v1-26))
(if (= (car a0-19) s4-0)
(set! s4-0 (car (cdr a0-19)))
)
(set! v1-26 (cdr v1-26))
(set! a0-19 (car (the-as pair v1-26)))
)
)
)
)
(set! (-> gp-0 s5-0) (the-as symbol s4-0))
)
)
(dotimes (v1-35 3)
(let ((s5-1 (-> gp-0 v1-35)))
(set! a0-24 (and s5-1 (begin
(dotimes (a0-25 3)
(when (= s5-1 (-> *level* sound-bank a0-25))
(set! a0-24 #f)
(goto cfg-63)
)
)
#t
)
)
)
(label cfg-63)
(when a0-24
(let ((s4-1 -1))
(dotimes (a0-28 3)
(when (not (-> *level* sound-bank a0-28))
(set! s4-1 a0-28)
(goto cfg-81)
)
)
(dotimes (s3-0 3)
(countdown (a0-32 3)
(if (= (-> gp-0 a0-32) (-> *level* sound-bank s3-0))
(goto cfg-78)
)
)
(format 0 "Unload soundbank ~A from slot ~D (want ~A)~%" (-> *level* sound-bank s3-0) s3-0 gp-0)
(sound-bank-unload (string->sound-name (symbol->string (-> *level* sound-bank s3-0))))
(set! (-> *level* sound-bank s3-0) #f)
(return 0)
(label cfg-78)
)
(label cfg-81)
(when (>= s4-1 0)
(format 0 "Load soundbank ~A in slot ~D (want ~A)~%" s5-1 s4-1 gp-0)
(sound-bank-load (string->sound-name (symbol->string s5-1)))
(set! (-> *level* sound-bank s4-1) (the-as basic s5-1))
(return 0)
)
)
)
)
)
)
0
)
(defmethod update! load-state ((obj load-state))
"Update level stuff based on load state.
This does scary transitions."
(local-vars (all-levels-inactive symbol))
(let ((discarded-level #f)) ;; set if we end up unloading anything.
;; First, discard levels. We'll discard levels that are no longer wanted, in reverse load order
(let ((most-recent-load-order 0))
-1
;; unload up to 6 levels, so try 6 times
(countdown (unload-attempt LEVEL_MAX)
(let ((unload-idx -1)) ;; which is best to unload
;; try all six, to find the best to unload
(countdown (unload-candidate-idx LEVEL_MAX)
(let ((unload-candidate-lev (-> *level* level unload-candidate-idx)))
(when (and (!= (-> unload-candidate-lev status) 'inactive) ;; in use
(>= (the-as uint (-> unload-candidate-lev load-order)) (the-as uint most-recent-load-order)) ;; newer than best
)
;; check if still wanted
(let ((still-wanted #f))
(dotimes (t0-2 LEVEL_MAX)
(if (= (-> unload-candidate-lev name) (-> obj want t0-2 name))
(set! still-wanted #t)
)
)
(when (not still-wanted)
;; not wanted, and best so far, remember.
(set! most-recent-load-order (-> unload-candidate-lev load-order))
(set! unload-idx unload-candidate-idx)
)
)
)
)
)
;; did we find one to unload?
;; PC NOTE : added an extra check for DGO time. If you start a load and discard it on the next frame,
;; you may attempt to start a new load right away before the ISO thread can properly stop the previous load
;; which will just crash the game. Sadly this means loads may sometimes be delayed by one frame. The horror.
(when ;(>= unload-idx 0)
(and (>= unload-idx 0) (< 1 (- (-> *display* real-clock integral-frame-counter) *dgo-time*)))
(let ((lev-to-unload (-> *level* level unload-idx)))
(format 0 "Discarding level ~A~%" (-> lev-to-unload name))
(level-status-update! lev-to-unload 'inactive) ;; kill it.
)
(set! discarded-level #t)
)
)
)
)
;; next, start loads
(let ((no-levels-at-all #f))
;; see if all levels inactive
(countdown (a0-9 LEVEL_MAX)
(when (!= (-> *level* level a0-9 status) 'inactive)
(set! all-levels-inactive #f)
(goto cfg-23)
)
)
(set! all-levels-inactive #t)
(label cfg-23)
(if all-levels-inactive
(set! no-levels-at-all #t) ;; weird macro or something.
)
(if discarded-level ;; if we discarded stuff on this frame, don't also start a load
(return 0)
)
;; build array of desired levels that we might want to load
(let ((desired-levels (new 'static 'boxed-array :type symbol :length 0 :allocated-length LEVEL_MAX)))
(countdown (a0-14 LEVEL_MAX)
(set! (-> desired-levels a0-14) #f)
)
(dotimes (want-lev-idx LEVEL_MAX) ;; loop over wants
(when (-> obj want want-lev-idx name)
(set! (-> desired-levels want-lev-idx) (-> obj want want-lev-idx name))
;; check if this wanted level is already present, in any state.
(dotimes (a1-17 LEVEL_MAX)
(let ((a2-13 (-> *level* level a1-17)))
(if (and (!= (-> a2-13 status) 'inactive) (= (-> a2-13 name) (-> obj want want-lev-idx name)))
(set! (-> desired-levels want-lev-idx) #f) ;; it's already there, not candidate for load start
)
)
)
)
)
;; find the first level in the possible load array that's not #f (nothing, or already assigned to a level)
(let ((want-lev-idx-to-load -1))
(dotimes (a0-20 LEVEL_MAX)
(when (-> desired-levels a0-20)
(set! want-lev-idx-to-load a0-20)
(goto cfg-51)
)
)
(label cfg-51)
(when (!= want-lev-idx-to-load -1)
;; we have a level that we should start loading!
;; loading only starts if we're not busy - there's a strange exception that if we have no levels at all,
;; and dgo is busy, we at least start the load.
(when (and (or no-levels-at-all (not (check-busy *load-dgo-rpc*))) (not (load-in-progress? *level*)))
(format 0 "Adding level ~A~%" (-> obj want want-lev-idx-to-load name))
;; do the actual level assignment
(let ((new-lev (level-get-for-use *level* (-> obj want want-lev-idx-to-load name) 'loaded)))
;; if we have no levels at all, there's nothing we can show until this one is loading, so block here and load.
(when (and no-levels-at-all (-> obj want want-lev-idx-to-load display?))
(format 0 "Waiting for level to load~%")
(while (or (= (-> new-lev status) 'loading) (= (-> new-lev status) 'loading-bt) (= (-> new-lev status) 'login))
(load-continue new-lev)
)
)
)
)
)
)
)
)
)
;; process other changes in want.
;; loop over all wanted levels
(dotimes (want-lev-i LEVEL_MAX)
(when (-> obj want want-lev-i name)
;; and find the associated level
(dotimes (lev-i LEVEL_TOTAL)
(let ((lev (-> *level* level lev-i)))
(when (!= (-> lev status) 'inactive)
(when (= (-> lev name) (-> obj want want-lev-i name))
;; change in display:
(when (!= (-> lev display?) (-> obj want want-lev-i display?))
(cond
((not (-> lev display?)) ;; off to on:
(cond
((or (= (-> lev status) 'loaded) (= (-> lev status) 'active))
(format 0 "Displaying level ~A [~A]~%" (-> obj want want-lev-i name) (-> obj want want-lev-i display?))
;; will activate/birth, starting entities and background drawing.
(level-get-for-use *level* (-> lev info name) 'active)
(set! (-> lev display?) (-> obj want want-lev-i display?))
)
(else
;; but the level isn't ready! trip jak (unless we have display-no-wait.)
(if (and (-> lev info wait-for-load) (!= (-> obj want want-lev-i display?) 'display-no-wait))
(send-event *target* 'loading)
)
(if (= *cheat-mode* 'debug)
(format *stdcon* "display on for ~A but level is loading~%" (-> obj want want-lev-i name))
)
)
)
)
((not (-> obj want want-lev-i display?)) ;; on -> off.
(set! (-> lev display?) #f)
(format 0 "Turning level ~A off~%" (-> lev name))
(deactivate lev)
)
(else
;; other change (special, etc)
(format 0 "Setting level ~A display command to ~A~%"
(-> obj want want-lev-i name)
(-> obj want want-lev-i display?)
)
(set! (-> lev display?) (-> obj want want-lev-i display?))
)
)
)
;; update force-all-visible
(when (!= (-> lev force-all-visible?) (-> obj want want-lev-i force-vis?))
(set! (-> lev force-all-visible?) (-> obj want want-lev-i force-vis?))
(format 0 "Setting force-all-visible?[~A] to ~A~%"
(-> obj want want-lev-i name)
(-> obj want want-lev-i force-vis?)
)
)
;; update force-inside
(when (!= (-> lev force-inside?) (-> obj want want-lev-i force-inside?))
(format 0 "Setting force-inside?[~A] ~A->~A~%"
(-> obj want want-lev-i name)
(-> lev force-inside?)
(-> obj want want-lev-i force-inside?)
)
(set! (-> lev force-inside?) (-> obj want want-lev-i force-inside?))
)
)
)
)
)
)
)
;; update vis level. this actually modifies the load state.
(let ((lev-for-vis (the-as level #f))
(num-vis-levs 0)
)
(dotimes (a1-35 (-> *level* length))
(let ((a2-32 (-> *level* level a1-35)))
(when (= (-> a2-32 status) 'active)
;; take any level that we're inside of, and has continue points
(when (and (-> a2-32 inside-boxes) (not (null? (-> a2-32 info continues))))
(if (= (-> a2-32 name) (-> obj vis-nick))
(goto cfg-125)
)
(set! lev-for-vis a2-32)
(+! num-vis-levs 1)
)
)
)
)
(if (and (>= num-vis-levs 1) (!= (-> lev-for-vis name) (-> obj vis-nick)))
(want-vis-level obj (-> lev-for-vis name))
)
)
(label cfg-125)
(update-sound-banks)
0
)
;; "draw" levels:
;; the "draw level" system is used to order the levels for drawing.
;; the draw-level array of level-group stores levels in the order they should be drawn.
;; eg: level3 of the DMA bucket array is actually (-> *level* draw-level 3), not (-> *level* level 3).
(defmethod assign-draw-indices level-group ((obj level-group))
"Sort the levels by draw priority."
(local-vars (t0-3 symbol))
(set! (-> obj draw-level-count) 0)
(dotimes (v1-0 LEVEL_TOTAL)
(let ((f0-0 100000.0)
(a1-1 (the-as level #f))
)
(dotimes (a2-0 (-> obj length))
(let ((a3-3 (-> obj level a2-0)))
(when (= (-> a3-3 status) 'active)
(set! t0-3 (and (< (-> a3-3 draw-priority) f0-0) (begin
(dotimes (t0-4 (-> obj draw-level-count))
(when (= a3-3 (-> obj draw-level t0-4))
(set! t0-3 #f)
(goto cfg-14)
)
)
#t
)
)
)
(label cfg-14)
(when t0-3
(set! a1-1 a3-3)
(set! f0-0 (-> a1-1 draw-priority))
)
)
)
)
(when a1-1
(set! (-> obj draw-level (-> obj draw-level-count)) a1-1)
(set! (-> a1-1 draw-index) (-> obj draw-level-count))
(+! (-> obj draw-level-count) 1)
)
)
)
(while (< (-> obj draw-level-count) LEVEL_TOTAL)
(set! (-> obj draw-level (-> obj draw-level-count)) #f)
(+! (-> obj draw-level-count) 1)
)
(set! (-> obj draw-level LEVEL_MAX) (-> obj default-level))
(set! (-> (&-> obj default-level draw-index) 0) LEVEL_MAX)
(dotimes (v1-12 LEVEL_TOTAL)
(let ((a2-9 (-> obj level v1-12)))
(if a2-9
(set! (-> obj draw-index-map v1-12) (the-as uint (-> a2-9 draw-index)))
)
)
)
0
(none)
)
(defmethod level-update level-group ((obj level-group))
(local-vars (v1-101 symbol))
(camera-pos)
(new 'static 'boxed-array :type symbol :length 0 :allocated-length LEVEL_MAX)
(update *setting-control*)
(update *gui-control* #t)
(update *art-control* #t)
(clear-rec *art-control*)
(dotimes (s5-0 LEVEL_MAX)
(load-continue (-> obj level s5-0))
)
(dotimes (s5-1 (-> obj length))
(let ((s4-0 (-> obj level s5-1)))
(when (= (-> s4-0 status) 'active)
(set! (-> s4-0 inside-boxes) (inside-boxes-check s4-0 (-> *math-camera* trans)))
(if (-> s4-0 inside-boxes)
(set! (-> s4-0 meta-inside?) #t)
)
)
)
)
(update! *load-state*)
(dotimes (s5-2 (-> obj length))
(let ((s4-1 (-> obj level s5-2)))
(when (= (-> s4-1 status) 'active)
(when (-> s4-1 inside-boxes)
(dotimes (v1-40 (-> obj length))
(let ((a0-13 (-> obj level v1-40)))
(when (= (-> a0-13 status) 'active)
(if (and (!= s4-1 a0-13) (not (-> a0-13 inside-boxes)))
(set! (-> a0-13 meta-inside?) #f)
)
)
)
)
)
(when (and (null? (-> obj load-commands))
(= (-> s4-1 name) (-> *load-state* vis-nick))
(begin
(set! (-> *setting-control* user-default music) (-> s4-1 info music-bank))
(set! (-> *setting-control* user-default sound-reverb) (-> s4-1 info sound-reverb))
#t
)
(or (-> *level* border?) (logtest? (-> *game-info* current-continue flags) (continue-flags change-continue)))
(or (!= (-> s4-1 name) (-> *game-info* current-continue level))
(logtest? (-> *game-info* current-continue flags) (continue-flags change-continue))
)
(not (null? (-> s4-1 info continues)))
(-> *setting-control* user-current allow-continue)
)
(let ((s3-0 (car (-> s4-1 info continues))))
(let* ((s2-0 (target-pos 0))
(s4-2 (-> s4-1 info continues))
(s1-0 (car s4-2))
)
(while (not (null? s4-2))
(when (and (or (< (vector-vector-distance s2-0 (-> (the-as continue-point s1-0) trans))
(vector-vector-distance s2-0 (-> (the-as continue-point s3-0) trans))
)
(string= (-> *game-info* current-continue name) (-> (the-as continue-point s1-0) name))
)
(not (logtest? (-> (the-as continue-point s1-0) flags) (continue-flags change-continue no-auto)))
)
(set! s3-0 (the-as continue-point s1-0))
(if (string= (-> *game-info* current-continue name) (-> (the-as continue-point s1-0) name))
(goto cfg-59)
)
)
(set! s4-2 (cdr s4-2))
(set! s1-0 (car s4-2))
)
)
(label cfg-59)
(if (and (the-as continue-point s3-0)
(not (logtest? (-> (the-as continue-point s3-0) flags) (continue-flags change-continue no-auto)))
)
(set-continue! *game-info* (the-as basic s3-0) #f)
)
)
)
)
)
)
(dotimes (v1-88 (-> obj length))
(let ((a0-48 (-> obj level v1-88)))
(when (= (-> a0-48 status) 'active)
(set! (-> a0-48 vis-self-index) 0)
0
)
)
)
(when (= *cheat-mode* 'debug)
(dotimes (s5-3 (-> obj length))
(let ((v1-96 (-> obj level s5-3)))
(when (= (-> v1-96 status) 'active)
(if (and (= (-> v1-96 status) 'active)
(!= (-> v1-96 display?) 'special)
(nonzero? (-> v1-96 bsp cam-outside-bsp))
)
(format *stdcon* "~3Loutside of bsp ~S~%~0L" (-> v1-96 name))
)
)
)
)
)
(countdown (v1-100 LEVEL_MAX)
(when (-> obj level v1-100 inside-boxes)
(set! v1-101 #f)
(goto cfg-90)
)
)
(set! v1-101 #t)
(label cfg-90)
(cond
(v1-101
0
)
(else
(dotimes (s5-4 (-> obj length))
(let ((s4-3 (-> obj level s5-4)))
(when (= (-> s4-3 status) 'active)
(dotimes (s3-1 8)
(let ((s2-1 (-> s4-3 vis-info s3-1)))
(when s2-1
(set! (-> s2-1 flags) (the-as vis-info-flag (logclear (-> s2-1 flags) (vis-info-flag vis-valid))))
(cond
((= s3-1 (-> s4-3 vis-self-index))
(set! (-> s2-1 from-bsp) (-> s4-3 bsp))
)
(else
(let ((v1-114 (level-get obj (-> s2-1 from-level))))
(set! (-> s2-1 from-bsp) (if v1-114
(-> v1-114 bsp)
)
)
)
)
)
)
)
)
(let ((v1-117 #f))
(cond
((= (-> s4-3 display?) 'display-self)
(let ((v1-121 (-> s4-3 vis-info (-> s4-3 vis-self-index))))
(if v1-121
(set! (-> v1-121 flags) (the-as vis-info-flag (logior (vis-info-flag vis-valid) (-> v1-121 flags))))
)
)
)
((and (-> s4-3 inside-boxes) (not v1-117))
(let ((v1-126 (-> s4-3 vis-info (-> s4-3 vis-self-index))))
(if v1-126
(set! (-> v1-126 flags) (the-as vis-info-flag (logior (vis-info-flag vis-valid) (-> v1-126 flags))))
)
)
)
)
)
)
)
)
)
)
(assign-draw-indices obj)
(when (or *display-level-border* *display-texture-distances* *display-texture-download* *display-split-box-info*)
(when *display-level-border*
(format
*stdcon*
" want: ~A ~A/~A ~A ~A/~A~%"
(-> *load-state* want 0 name)
(-> *load-state* want 0 display?)
(-> *load-state* want 0 force-vis?)
(-> *load-state* want 1 name)
(-> *load-state* want 1 display?)
(-> *load-state* want 1 force-vis?)
)
(let ((t9-18 format)
(a0-86 *stdcon*)
(a1-30 " nick ~A cur ~S cont ~A~%~%")
(a2-6 (-> *load-state* vis-nick))
(v1-147 (and *target* (-> *target* current-level) (-> *target* current-level name)))
)
(t9-18
a0-86
a1-30
a2-6
(if v1-147
(symbol->string (the-as symbol v1-147))
)
(-> *game-info* current-continue name)
)
)
)
(dotimes (s5-5 LEVEL_TOTAL)
(let ((s4-4 (-> obj level s5-5)))
(when (or (= (-> s4-4 status) 'active) (= (-> s4-4 status) 'reserved))
(let ((t9-19 format)
(a0-90 *stdcon*)
(a1-31 "~A: ~S ~A~%")
(a2-7 (-> s4-4 name))
(a3-3 (if (-> s4-4 inside-boxes)
"inside"
)
)
)
(t9-19 a0-90 a1-31 a2-7 a3-3 (-> s4-4 display?))
(when *display-texture-distances*
(format *stdcon* "~10Htfrag: ~8,,0m" (-> s4-4 closest-object) (the-as none a3-3))
(format *stdcon* "~140Hshrub: ~8,,0m" (-> s4-4 closest-object-array 2) (the-as none a3-3))
(format *stdcon* "~272Halpha: ~8,,0m~%" (-> s4-4 closest-object-array 3) (the-as none a3-3))
(format *stdcon* "~27Htie: ~8,,0m" (-> s4-4 closest-object-array 10) (the-as none a3-3))
(format *stdcon* "~140Hfg-tf: ~8,,0m" (-> s4-4 closest-object-array 11) (the-as none a3-3))
(format *stdcon* "~270Hfg-pr: ~8,,0m~%" (-> s4-4 closest-object-array 12) (the-as none a3-3))
(format *stdcon* "~10Hfg-wa: ~8,,0m" (-> s4-4 closest-object-array 15) (the-as none a3-3))
(format *stdcon* "~140Hfg-sh: ~8,,0m" (-> s4-4 closest-object-array 13) (the-as none a3-3))
(format *stdcon* "~267Hfg-p2: ~8,,0m~%" (-> s4-4 closest-object-array 17) (the-as none a3-3))
)
)
(when *display-texture-download*
(format
*stdcon*
"~30Htf: ~8D~134Hpr: ~8D~252Hsh: ~8D~370Hhd: ~8D~%"
(-> s4-4 upload-size 0)
(-> s4-4 upload-size 1)
(-> s4-4 upload-size 2)
(-> s4-4 upload-size 8)
)
(let ((t9-30 format)
(a0-101 *stdcon*)
(a1-42 "~30Hal: ~8D~131Hwa: ~8D~252Hsp: ~8D~370Hwp: ~8D~%")
(a2-18 (-> s4-4 upload-size 3))
(a3-5 (-> s4-4 upload-size 4))
)
(t9-30 a0-101 a1-42 a2-18 a3-5 (-> s4-4 upload-size 7) (-> s4-4 upload-size 5))
(format *stdcon* "~30Hp2: ~8D~%~1K" (-> s4-4 upload-size 6) (the-as none a3-5))
)
)
(if *display-split-box-info*
(debug-print-region-splitbox s4-4 (-> *math-camera* trans) *stdcon*)
)
)
)
)
)
(when (and (-> obj disk-load-timing?) (-> obj load-level))
(let ((s5-6 format)
(s4-5 *stdcon*)
(s3-2 "~0Kload ~16S ~5S ~5DK ~5,,2fs ~5,,2fs~1K ~5,,0f k/s~%")
(s2-2 (-> obj load-level))
(v1-180 (lookup-level-info (-> obj load-level)))
)
(s5-6
s4-5
s3-2
s2-2
(if v1-180
(-> v1-180 nickname)
""
)
(shr (-> obj load-size) 10)
(-> obj load-time)
(-> obj load-login-time)
(if (= (-> obj load-time) 0.0)
0
(* 0.0009765625 (/ (the float (-> obj load-size)) (-> obj load-time)))
)
)
)
)
;; pc port note : this was hardcoded to the top of EE memory (#x2000000)
(let ((v1-186 (&- (-> global top-base) (-> global current))))
(if (and (not *debug-segment*) (< v1-186 (* 64 1024)))
(format *stdcon* "~3Lglobal heap fatally low at ~DK free~%~0L" (/ v1-186 (* 1024 1024)))
)
)
;; pc port added
(let ((lev-names (new 'stack-no-clear 'array 'string LEVEL_MAX)))
(dotimes (i LEVEL_MAX)
(cond
((= (-> obj level i status) 'inactive)
(set! (-> lev-names i) "none")
)
(else
(set! (-> lev-names i) (symbol->string (-> obj level i nickname)))
)
)
)
(__pc-set-levels lev-names)
)
0
(none)
)
(defun-debug show-level ((arg0 symbol))
(set! (-> *setting-control* user-default border-mode) #t)
(let ((s5-0 (new 'stack-no-clear 'array 'symbol 10)))
(set! (-> s5-0 5) #f)
(set! (-> s5-0 4) #f)
(set! (-> s5-0 3) #f)
(set! (-> s5-0 2) #f)
(set! (-> s5-0 1) arg0)
(set! (-> s5-0 0) (-> (level-get-target-inside *level*) name))
(want-levels *load-state* s5-0)
)
(want-display-level *load-state* arg0 'display)
0
)
(when (zero? (-> *level* level0 art-group))
(kmemopen global "level")
(let ((gp-0 *level*))
(set! (-> gp-0 loading-level) (-> gp-0 default-level))
(dotimes (s5-0 LEVEL_MAX)
(let ((s4-0 (-> gp-0 level s5-0)))
(set! (-> s4-0 art-group) (new 'global 'load-dir-art-group 100 s4-0))
(set! (-> s4-0 vis-bits) (malloc 'global 2048))
(vis-clear s4-0)
(set! (-> s4-0 tfrag-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 tfrag-dists) (malloc 'global 4))
(set! (-> s4-0 shrub-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 shrub-dists) (malloc 'global 4))
(set! (-> s4-0 alpha-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 alpha-dists) (malloc 'global 4))
(set! (-> s4-0 water-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 water-dists) (malloc 'global 4))
(clear-mood-context (-> s4-0 mood-context))
)
)
(set! (-> gp-0 default-level art-group) (new 'global 'load-dir-art-group 512 (-> gp-0 default-level)))
(dotimes (v1-31 LEVEL_TOTAL)
(let ((a0-53 (-> gp-0 level v1-31)))
(dotimes (a1-48 10)
(set! (-> a0-53 texture-anim-array a1-48) #f)
)
)
)
(set! (-> (&-> gp-0 default-level texture-anim-array 9) 0) *sky-texture-anim-array*)
(set! (-> (&-> gp-0 default-level texture-anim-array 1) 0) *darkjak-texture-anim-array*)
(set! (-> (&-> gp-0 default-level texture-anim-array 4) 0) *bomb-texture-anim-array*)
(set! (-> (&-> gp-0 default-level draw-priority) 0) 20.0)
(set! *default-level* (-> gp-0 default-level))
)
(kmemclose)
)
Reference in a new issue View git blame Copy permalink