Mirrors
/
open-goal-jak-project
mirror of https://github.com/open-goal/jak-project.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
open-goal-jak-project/goal_src/jak2/engine/level/level.gc

3034 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 ((this 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? ((this level-group))
"Is a level being loaded right now?"
(!= (-> *level* loading-level) (-> *level* default-level))
)
(defmethod get-level-by-heap-ptr-and-status ((this 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 (-> this length))
(let ((a2-6 (-> this 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 (-> this length))
(let ((a2-12 (-> this 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 ((this 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 (-> this art-group art-group-array length))
(if (name= (-> this art-group art-group-array s4-0 name) arg0)
(return (-> this art-group art-group-array s4-0))
)
)
(the-as art-group #f)
)
(defmethod bsp-name ((this level))
"Get the name of the bsp. If this can't be done, get the name of the level."
(if (and (!= (-> this status) 'inactive) (-> this bsp) (nonzero? (-> this bsp name)))
(-> this bsp name)
(-> this 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 ((this level))
(format #t "#<~A ~A ~S @ #x~X>" (-> this type) (-> this status) (-> this name) this)
this
)
(defmethod relocate ((this 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
(this
(cond
((not (type? this 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? (-> this info) (file-kind level-bt) 0))
(the-as bsp-header #f)
)
((< 2048 (-> this visible-list-length))
(format
0
"ERROR: level ~A visible-list-length ~d is greater than 2048 (16384 drawables).~%"
(-> s5-0 name)
(-> this visible-list-length)
)
(the-as bsp-header #f)
)
(else
(set! (-> s5-0 bsp) this)
(set! (-> this level) s5-0)
this
)
)
)
(else
(format 0 "ERROR: level ~A is not a valid file.~%" (-> s5-0 name))
(the-as bsp-header #f)
)
)
)
)
)
(defmethod load-required-packages ((this 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 (-> this bsp)) (= *kernel-boot-mode* 'debug-boot)))
(if (not (null? (-> this info packages)))
(load-package "common" global)
)
)
this
)
(defmethod vis-clear ((this level))
"Completely invalide all visibility data, vis-info, and set all-visible? to loading."
(countdown (v1-0 8)
(nop!)
(set! (-> this vis-info v1-0) #f)
)
(dotimes (v1-3 128)
(set! (-> (the-as (pointer int128) (&+ (-> this vis-bits) (* v1-3 16)))) (the int128 0))
)
(set! (-> this all-visible?) 'loading)
0
(none)
)
(defmethod init-vis-from-bsp ((this level))
"Set up a level's vis-infos from a bsp."
(when (not (or (= (-> this status) 'inactive) (not (-> this bsp))))
;; mark our visibility as 'loading.
(set! (-> this all-visible?) 'loading)
;; check vis-info's from the loaded bsp:
(dotimes (s5-0 8)
(let ((s4-0 (-> this 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! (-> this vis-info s5-0) s4-0)
(set! (-> s4-0 current-vis-string) (the-as uint -1))
;; vis info -> bsp
(if (= (-> s4-0 from-level) (-> this load-name))
(set! (-> s4-0 from-bsp) (-> this bsp))
(set! (-> s4-0 from-bsp) #f)
)
;; vis info -> level's vis-bits
(set! (-> s4-0 vis-bits) (the-as uint (-> this 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! (-> this vis-info s5-0) #f)
)
)
)
)
)
0
(none)
)
(defmethod level-get-for-use ((this 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 this #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 this 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 this)))
(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 (+ (-> this load-order) 1)))
(set! (-> this 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 ((this 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! ((this 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~%" (-> this status) arg0 (-> this name))
(case arg0
(('inactive)
;; any request to go inactive should unload.
(-> this status)
(unload! this)
)
(('loading)
(case (-> this status)
(('inactive)
;; inactive -> loading transition, start the loader
(load-begin this)
)
)
)
(('loading-bt)
(case (-> this status)
(('loading)
;; loading -> loading-bt, transition immediately and do one load-continue
(set! (-> this status) arg0)
(load-continue this)
)
)
)
(('loading-done)
(case (-> this status)
(('loading-bt)
;; loading-bt -> loading-done, the only allowed transition to loading-done
(set! (-> this status) arg0)
)
)
)
(('loaded)
(case (-> this status)
(('loading-done)
;; loading-done->loaded, need to log in first
(login-begin this)
)
(('alive 'active)
;; deactivating
(deactivate this)
)
)
)
(('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 (-> this status)
(('loaded)
;; loaded (so logged in too), do birth (will set to alive), then try again
(birth this)
(level-status-update! this arg0)
)
(('alive)
;; on the second run, gets here:
(when (and *dproc* (= arg0 'active))
;; remember when
(when (zero? (-> this display-start-time))
(set! (-> this 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 (-> this bsp)))
(add-connection *background-draw-engine* *dproc* add-bsp-drawable (-> this bsp) this #f)
;; not sure why this becomes 0...
(dotimes (v1-46 18)
(set! (-> this closest-object-array v1-46) 0.0)
(set! (-> this texture-mask v1-46 mask quad) (the-as uint128 0))
)
(set! (-> this status) 'active)
;; set up for drawing.
(assign-draw-indices *level*)
)
)
)
)
)
)
this
)
(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 ((this 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 (-> this linking)
(when (nonzero? (link-resume)) ;; run linker
;; linker return is nonzero, we're done!
(start-debug "link done!~%")
(set! (-> this linking) #f)
(case (-> this 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
((= (-> this 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 (&+ (-> this 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 this (the-as dgo-header (-> this load-buffer-last)))
(start-debug "kicking next load~%")
(dgo-load-continue
(the-as pointer (-> this load-buffer 0))
(the-as pointer (-> this load-buffer 1))
(logand -64 (&+ (-> this heap current) 63))
)
)
)
)
)
(('loading-bt)
;; finished linking the final object! begin login.
(level-status-update! this 'loading-done)
(level-status-update! this 'loaded)
)
)
)
(set! this this)
(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 this (the-as dgo-header (-> this load-buffer-last)))
(dgo-load-continue
(the-as pointer (-> this load-buffer 0))
(the-as pointer (-> this load-buffer 1))
(logand -64 (&+ (-> this heap current) 63))
)
(set! this this)
(goto cfg-39)
)
;; not waiting on the linker, check other cases
(case (-> this 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! (-> this 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
((= (-> this 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) (-> this heap) (the-as uint (-> this heap top-base)) *print-login* #f)
;; linker finished immediately, kick off next load
(when (not (-> *texture-relocate-later* memcpy))
(let ((a2-8 (logand -64 (&+ (-> this heap current) 63))))
(dgo-load-continue a2-8 a2-8 a2-8)
)
)
)
(else
;; linker still going, remember and come back later.
(set! (-> this linking) #t)
)
)
)
;; not borrow mode, start linker
((dgo-load-link (the-as dgo-header s5-0) (-> this heap) (-> this load-buffer 1) *print-login* #f)
;; finished immediately, kick off next loa
(when (not (-> *texture-relocate-later* memcpy))
(load-buffer-resize this (the-as dgo-header s5-0))
(dgo-load-continue
(the-as pointer (-> this load-buffer 0))
(the-as pointer (-> this load-buffer 1))
(logand -64 (&+ (-> this heap current) 63))
)
)
)
(else
;; otherwise remember we're loading.
(set! (-> this linking) #t)
)
)
)
(else
;; we are the last object. update heap top and go to bt load.
(set! (-> this heap top) (-> this heap top-base))
(level-status-update! this 'loading-bt)
)
)
)
)
)
(('login)
;; logging in, load already finished. run the login state machine
(level-update-after-load this *login-state*)
)
(('loading-bt)
;; last object was loaded, start linking it.
(let ((a0-36 (logand -64 (&+ (-> this heap current) 63))))
(cond
((dgo-load-link (the-as dgo-header a0-36) (-> this heap) (the-as uint (-> this heap top-base)) *print-login* #t)
(level-status-update! this 'loading-done)
(level-status-update! this 'loaded)
)
(else
(set! (-> this linking) #t)
)
)
)
)
)
(label cfg-39)
this
)
(defmethod load-begin ((this 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! (-> this borrow-level v1-0) #f) ;; levels that borrow our heap
)
(set! (-> this borrow-from-level) #f) ;; level that we borrow our heap for.
(set! (-> this memory-mask) (the-as uint 0)) ;; bits representing which sections of the big level heap we use.
(let ((mem-mode (-> this 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) (-> this 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! (-> this borrow-from-level) borrow-from-lev)
(set! (-> borrow-from-lev borrow-level slot-in-borrow-from-lev) this)
;; 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 (-> this 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 (-> this heap))
)
(else
;; couldn't find it, die.
(format 0 "ERROR: level ~A could not find free ~S bank in the level-group heap~%"
(-> this 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~%" (-> this 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! (-> this 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 (-> this 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))))
;; og:preserve-this 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 (-> this 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 (-> this heap))
(set! (-> *level* loading-level) this)
;; start linked list of types associated with this level
(set! (-> this level-type) #f)
(set! *level-type-list* (the-as type (&-> this level-type)))
;; clear stuff out
(set! (-> *level* log-in-level-bsp) #f)
(set! (-> this nickname) #f)
(set! (-> this bsp) #f)
(set! (-> this entity) #f)
(set! (-> this linking) #f)
(set! (-> this task-mask) (-> *setting-control* user-current task-mask))
(vis-clear this)
(set! (-> this load-start-time) (-> *display* real-clock frame-counter))
(set! (-> this load-stop-time) 0)
(set! (-> this display-start-time) 0)
(set! (-> this part-engine) #f)
(dotimes (v1-57 4)
(set! (-> this user-object v1-57) #f)
)
;; go straight to loading
(set! (-> this status) 'loading)
;; non-permanent allocator
(set! (-> *texture-pool* allocate-func) texture-page-level-allocate)
(if (= (-> this load-name) (-> this info visname))
(format (clear *temp-string*) "~S" (-> this info nickname))
(format (clear *temp-string*) "~S" (-> this name))
)
(set! (-> *temp-string* data 8) (the-as uint 0))
(format *temp-string* ".DGO")
(set! (-> this heap top) (-> this heap top-base))
(set! (-> *level* load-level) (-> this 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! (-> this code-memory-start) (-> this heap current))
(cond
((= (-> this 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! (-> this load-buffer-mode) (load-buffer-mode borrow))
(let ((a3-19 (logand -64 (&+ (-> this 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 (-> this heap) s3-1 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
(s5-4 (kmalloc (-> this heap) s3-1 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
)
(format 0 "-----------> begin load ~A [~S]~%" (-> this load-name) *temp-string*)
(set! (-> this load-buffer 0) (the-as uint s5-4))
(set! (-> this load-buffer 1) (the-as uint s4-1))
(set! (-> this 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! (-> this 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 (&+ (-> this heap current) 63)))
(dgo-load-begin *temp-string* s5-4 s4-1 (logand -64 (&+ (-> this heap current) 63)))
)
)
)
this
)
(defmethod login-begin ((this 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
((-> this bsp)
(let ((s5-0 (-> this 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) (-> this bsp))
(login-level-textures *texture-pool* this (-> this bsp texture-page-count) (-> this bsp texture-ids))
(dotimes (v1-10 6)
(set! (-> this sky-mask mask data v1-10) 0)
)
(dotimes (s4-0 10)
(let ((a0-8 (-> this info texture-anim s4-0)))
(when a0-8
(set! (-> this 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! (-> this status) 'login)
)
(else
(level-status-update! this 'inactive)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* default-level))
(set! *level-type-list* (the-as type 0))
0
)
)
this
)
(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 ((this level))
"Start running code for a level that has been loaded."
(local-vars (sv-96 int))
(case (-> this 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 (-> this entity))))
(set! loading-level (-> this heap))
(set! (-> *level* log-in-level-bsp) (-> this bsp))
(set! (-> *level* loading-level) this)
(set! *level-type-list* (the-as type (&-> this level-type)))
(cond
((valid? (-> this bsp light-hash) light-hash (the-as string #f) #t 0)
(set! (-> this light-hash) (-> this bsp light-hash))
)
(else
(set! (-> this light-hash) (the-as light-hash 0))
0
)
)
(birth (-> this bsp))
(set! (-> this status) 'alive)
(set! (-> this render?) #t)
(copy-perms-to-level! *game-info* this)
(send-event *camera* 'level-activate (-> this name))
(send-event *target* 'level-activate (-> this name))
(when (and (-> this info login-func) s1-0)
(let ((s1-1 (-> this info login-func value)))
(if (and s1-1 (nonzero? s1-1) (type? s1-1 function))
((the (function level none) s1-1) this)
)
)
)
)
(let ((s1-2 (-> this status)))
(set! (-> this status) 'active)
(update-task-masks 'level)
(assign-draw-indices *level*)
(let ((s0-0 (-> this 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 (!= (-> this bsp city-level-info) 0) *traffic-manager*)
(send-event *traffic-manager* 'level-loaded this)
)
(when (-> this info activate-func)
(let ((s0-1 (-> this info activate-func value)))
(if (and s0-1 (nonzero? s0-1) (type? s0-1 function))
((the (function level symbol none) s0-1) this 'display)
)
)
)
(set! (-> this 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)
)
)
)
this
)
(defmethod deactivate ((this level))
"Take a level out of active/alive"
(case (-> this status)
(('active 'alive)
(format 0 "----------- kill ~A (status ~A)~%" this (-> this status))
;; send event to traffic manager.
(if (and (!= (-> this bsp city-level-info) 0) *traffic-manager*)
(send-event *traffic-manager* 'level-killed this)
)
;; run kill callbacks
(when (-> this info kill-func)
(let ((s5-0 (-> this info kill-func value)))
(if (and s5-0 (nonzero? s5-0) (type? s5-0 function))
((the (function level none) s5-0) this)
)
)
)
;; copy data from entities to permanent storage
(copy-perms-from-level! *game-info* this)
;; tell target
(send-event *target* 'level-deactivate (-> this name))
;; remove from background draw system
(remove-by-param1 *background-draw-engine* (the-as int (-> this bsp)))
;; kill entities, particles, anims
(deactivate-entities (-> this bsp))
(kill-all-particles-in-level this)
(unload-from-level *anim-manager* this)
;; reset status
(set! (-> this inside-boxes) #f)
(set! (-> this meta-inside?) #f)
(set! (-> this force-inside?) #f)
(set! (-> this status) 'loaded)
(set! (-> this light-hash) (the-as light-hash 0))
(set! (-> this all-visible?) 'loading)
;; clear vis.
(dotimes (v1-34 128)
(set! (-> (the-as (pointer int128) (&+ (-> this vis-bits) (* v1-34 16)))) (the int128 0))
)
(countdown (v1-37 8)
(let ((a0-20 (-> this vis-info v1-37)))
(if a0-20
(set! (-> a0-20 current-vis-string) (the-as uint -1))
)
)
)
)
)
(if (= (-> *level* log-in-level-bsp) (-> this bsp))
(set! (-> *level* log-in-level-bsp) #f)
)
this
)
(defmethod unload! ((this level))
"Unload a level."
;; make sure it's not alive/active
(deactivate this)
(when (!= (-> this status) 'inactive)
;; first, unload anybody who borrows from us.
(dotimes (s5-0 2)
(when (-> this borrow-level s5-0)
(unload! (-> this borrow-level s5-0))
(set! (-> this borrow-level s5-0) #f)
)
)
;; if we borrow from somebody, remove ourselves from them
(when (-> this borrow-from-level)
(dotimes (v1-19 2)
(if (= this (-> this borrow-from-level borrow-level v1-19))
(set! (-> this borrow-from-level borrow-level v1-19) #f)
)
)
(set! (-> this borrow-from-level) #f)
)
(case (-> this 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 (-> this info deactivate-func)
(let ((s5-1 (-> this info deactivate-func value)))
(if (and s5-1 (nonzero? s5-1) (type? s5-1 function))
((the (function level none) s5-1) this)
)
)
)
)
)
;; unlink art groups.
(when (or (= (-> this status) 'loaded)
(= (-> this status) 'alive)
(= (-> this status) 'active)
(= (-> this status) 'login)
)
(dotimes (s5-2 (-> this art-group art-group-array length))
(let ((s4-0 (-> this art-group art-group-array s5-2)))
(if (needs-link? s4-0)
(unlink-art! s4-0)
)
)
)
)
(set! (-> this bsp) #f)
(set! (-> this entity) #f)
(set! (-> this status) 'inactive)
(set! (-> this linking) #f)
(set! (-> this art-group string-array length) 0)
(set! (-> this art-group art-group-array length) 0)
(set! (-> this mem-usage-block) (the-as memory-usage-block 0))
(set! (-> this mem-usage) 0)
(set! (-> this part-engine) #f)
(dotimes (v1-60 4)
(set! (-> this user-object v1-60) #f)
)
;; kill texture anims
(let ((v1-63 (-> this status)))
(when (or (= v1-63 'alive) (or (= v1-63 'active) (= v1-63 'loaded)))
(dotimes (s5-3 10)
(let ((a0-37 (-> this info texture-anim s5-3)))
(if a0-37
(set! (-> this texture-anim-array s5-3)
(clear! (the-as texture-anim-array (-> a0-37 value)))
)
)
)
)
)
)
(dotimes (v1-73 10)
(set! (-> this texture-anim-array v1-73) #f)
)
(countdown (s5-4 (-> this loaded-texture-page-count))
(dotimes (v1-76 32)
(when (= (-> this 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* (-> this loaded-texture-page s5-4))
)
(set! (-> this loaded-texture-page-count) 0)
(unlink-shaders-in-heap *texture-page-dir* (-> this heap))
(unlink-part-group-by-heap (-> this heap))
(unlink-lightning-spec-by-heap (-> this heap))
(particle-adgif-cache-flush)
(set! (-> this 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 (-> this heap base)))
(< (the-as int v1-90) (the-as int (-> this 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) (-> this name)))
(countdown (a2-6 7)
(set! (-> a1-20 info hooks a2-6) #f)
)
)
)
)
)
)
(let ((v1-103 0)
(a0-60 0)
(a1-23 (-> this level-type))
)
(while a1-23
(+! a0-60 1)
(+! v1-103 (-> a1-23 psize))
;; og:preserve-this 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 (-> this 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 this)
(let ((v1-120 (-> this heap)))
(set! (-> v1-120 current) (-> v1-120 base))
)
(set! (-> this memory-mask) (the-as uint 0))
(set! (-> this code-memory-start) (the-as pointer 0))
(set! (-> this code-memory-end) (the-as pointer 0))
(set! (-> this level-type) #f)
(when (= (-> *level* loading-level) this)
(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*)
)
this
)
(defmethod is-object-visible? ((this 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 (-> this 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 ((this 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 (-> this bsp))
#f
)
((-> this force-inside?)
#t
)
(else
(zero? (-> this bsp cam-outside-bsp))
)
)
)
(defmethod debug-print-region-splitbox ((this level) (arg0 vector) (arg1 object))
"Display debug info about the regions of a level."
(cond
((or (not (-> this bsp)) (zero? (-> this bsp region-tree)))
)
((nonzero? (-> this bsp region-tree))
(debug-print (-> this bsp region-tree) arg0 arg1)
)
)
0
(none)
)
(defmethod mem-usage ((this level) (arg0 memory-usage-block) (arg1 int))
"Compute the memory usage of a level."
(when (= (-> this status) 'active)
(set! (-> arg0 length) (max 67 (-> arg0 length)))
(set! (-> arg0 data 66 name) "entity-links")
(+! (-> arg0 data 66 count) (-> this entity length))
(let ((v1-8 (asize-of (-> this entity))))
(+! (-> arg0 data 66 used) v1-8)
(+! (-> arg0 data 66 total) (logand -16 (+ v1-8 15)))
)
(mem-usage (-> this 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 (&- (-> this code-memory-end) (the-as uint (-> this code-memory-start)))))
(+! (-> arg0 data 65 used) v1-20)
(+! (-> arg0 data 65 total) (logand -16 (+ v1-20 15)))
)
(countdown (s3-0 (-> this loaded-texture-page-count))
(mem-usage (-> this loaded-texture-page s3-0) arg0 arg1)
)
(countdown (s3-1 (-> this loaded-text-info-count))
(mem-usage (-> this loaded-text-info s3-1) arg0 arg1)
)
(countdown (s3-2 8)
(let ((s2-0 (-> this 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 (-> this bsp) arg0 arg1)
)
this
)
(defmethod alloc-levels-if-needed ((this 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 (-> this heap))
)
(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 ((this level-group) (arg0 symbol))
"Get a level with the given status."
(dotimes (v1-0 (-> this length))
(if (= (-> this level v1-0 status) arg0)
(return (-> this level v1-0))
)
)
(the-as level #f)
)
(defmethod level-get-most-disposable ((this level-group))
"Get the level that's least useful."
(dotimes (v1-0 (-> this length))
(case (-> this level v1-0 status)
(('inactive)
(return (-> this level v1-0))
)
)
)
(dotimes (v1-6 (-> this length))
(case (-> this level v1-6 status)
(('loading 'loading-bt)
(return (-> this level v1-6))
)
)
)
(dotimes (v1-12 (-> this length))
(case (-> this level v1-12 status)
(('loaded)
(return (-> this level v1-12))
)
)
)
(let ((v0-0 (the-as level #f)))
(dotimes (v1-18 (-> this length))
(case (-> this level v1-18 status)
(('active)
(if (and (not (-> this level v1-18 inside-boxes))
(or (not v0-0) (< (-> this level v1-18 info priority) (-> v0-0 info priority)))
)
(set! v0-0 (-> this level v1-18))
)
)
)
)
v0-0
)
)
(defmethod level-get ((this level-group) (arg0 symbol))
"Get a level by name or load-name"
(dotimes (v1-0 (-> this length))
(if (and (!= (-> this level v1-0 status) 'inactive)
(or (= (-> this level v1-0 name) arg0) (= (-> this level v1-0 load-name) arg0))
)
(return (-> this level v1-0))
)
)
(the-as level #f)
)
(defmethod art-group-get-by-name ((this 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! ((this level-group))
"Set all levels to active."
(dotimes (s5-0 (-> this length))
(level-status-update! (-> this level s5-0) 'active)
)
0
)
(defmethod level-get-target-inside ((this 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 (-> this length))
(let ((a1-3 (-> this 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 (-> this length))
(let ((a1-8 (-> this 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 (-> this length))
(let ((s2-0 (-> this 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 (-> this length))
(let ((a0-11 (-> this 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 (-> this length))
(let ((a0-16 (-> this level v1-26)))
(when (= (-> a0-16 status) 'active)
(if (not v0-1)
(set! v0-1 a0-16)
)
)
)
)
v0-1
)
)
(defmethod load-commands-set! ((this level-group) (arg0 pair))
"Set the load-commands of a level."
(set! (-> this load-commands) arg0)
(none)
)
(defmethod mem-usage ((this level-group) (arg0 memory-usage-block) (arg1 int))
"Compute mem-usage for an entire level-group."
(dotimes (s3-0 (-> this length))
(mem-usage (-> this level s3-0) arg0 arg1)
)
this
)
(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 1.0)
(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! ((this 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) (-> this 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)
)
)
)
)
)
;; og:preserve-this
;; did we find one to unload?
;; PC NOTE : added an extra check for DGO time and name. 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)
(format 0 " level loading : want to unload ~A. load-level is ~A~%" (-> *level* level unload-idx load-name) (-> *level* load-level))
(when (or (!= (-> *level* level unload-idx load-name) (-> *level* load-level))
(< 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 (-> this want want-lev-idx name)
(set! (-> desired-levels want-lev-idx) (-> this 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) (-> this 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~%" (-> this want want-lev-idx-to-load name))
;; do the actual level assignment
(let ((new-lev (level-get-for-use *level* (-> this 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 (-> this 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 (-> this 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) (-> this want want-lev-i name))
;; change in display:
(when (!= (-> lev display?) (-> this 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]~%" (-> this want want-lev-i name) (-> this 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?) (-> this 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) (!= (-> this 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~%" (-> this want want-lev-i name))
)
)
)
)
((not (-> this 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~%"
(-> this want want-lev-i name)
(-> this want want-lev-i display?)
)
(set! (-> lev display?) (-> this want want-lev-i display?))
)
)
)
;; update force-all-visible
(when (!= (-> lev force-all-visible?) (-> this want want-lev-i force-vis?))
(set! (-> lev force-all-visible?) (-> this want want-lev-i force-vis?))
(format 0 "Setting force-all-visible?[~A] to ~A~%"
(-> this want want-lev-i name)
(-> this want want-lev-i force-vis?)
)
)
;; update force-inside
(when (!= (-> lev force-inside?) (-> this want want-lev-i force-inside?))
(format 0 "Setting force-inside?[~A] ~A->~A~%"
(-> this want want-lev-i name)
(-> lev force-inside?)
(-> this want want-lev-i force-inside?)
)
(set! (-> lev force-inside?) (-> this 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) (-> this 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) (-> this vis-nick)))
(want-vis-level this (-> 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 ((this level-group))
"Sort the levels by draw priority."
(local-vars (t0-3 symbol))
(set! (-> this draw-level-count) 0)
(dotimes (v1-0 LEVEL_TOTAL)
(let ((f0-0 100000.0)
(a1-1 (the-as level #f))
)
(dotimes (a2-0 (-> this length))
(let ((a3-3 (-> this level a2-0)))
(when (= (-> a3-3 status) 'active)
(set! t0-3 (and (< (-> a3-3 draw-priority) f0-0) (begin
(dotimes (t0-4 (-> this draw-level-count))
(when (= a3-3 (-> this 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! (-> this draw-level (-> this draw-level-count)) a1-1)
(set! (-> a1-1 draw-index) (-> this draw-level-count))
(+! (-> this draw-level-count) 1)
)
)
)
(while (< (-> this draw-level-count) LEVEL_TOTAL)
(set! (-> this draw-level (-> this draw-level-count)) #f)
(+! (-> this draw-level-count) 1)
)
(set! (-> this draw-level LEVEL_MAX) (-> this default-level))
(set! (-> (&-> this default-level draw-index) 0) LEVEL_MAX)
(dotimes (v1-12 LEVEL_TOTAL)
(let ((a2-9 (-> this level v1-12)))
(if a2-9
(set! (-> this draw-index-map v1-12) (the-as uint (-> a2-9 draw-index)))
)
)
)
0
(none)
)
(defmethod level-update ((this 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 (-> this level s5-0))
)
(dotimes (s5-1 (-> this length))
(let ((s4-0 (-> this 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 (-> this length))
(let ((s4-1 (-> this level s5-2)))
(when (= (-> s4-1 status) 'active)
(when (-> s4-1 inside-boxes)
(dotimes (v1-40 (-> this length))
(let ((a0-13 (-> this 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? (-> this 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 (-> this length))
(let ((a0-48 (-> this level v1-88)))
(when (= (-> a0-48 status) 'active)
(set! (-> a0-48 vis-self-index) 0)
0
)
)
)
(when (= *cheat-mode* 'debug)
(dotimes (s5-3 (-> this length))
(let ((v1-96 (-> this 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 (-> this 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 (-> this length))
(let ((s4-3 (-> this 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 this (-> 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 this)
(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 (-> this 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 (-> this disk-load-timing?) (-> this 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 (-> this load-level))
(v1-180 (lookup-level-info (-> this load-level)))
)
(s5-6
s4-5
s3-2
s2-2
(if v1-180
(-> v1-180 nickname)
""
)
(shr (-> this load-size) 10)
(-> this load-time)
(-> this load-login-time)
(if (= (-> this load-time) 0.0)
0
(* 0.0009765625 (/ (the float (-> this load-size)) (-> this load-time)))
)
)
)
)
;; og:preserve-this 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)))
)
)
;; og:preserve-this added
(let ((lev-names (new 'stack-no-clear 'array 'string LEVEL_MAX))
(active-lev-names (new 'stack-no-clear 'array 'string LEVEL_MAX)))
(dotimes (i LEVEL_MAX)
(set! (-> active-lev-names i) "none")
(set! (-> lev-names i) "none")
(cond
((or (= (-> this level i status) 'active)
(= (-> this level i status) 'alive)
(= (-> this level i status) 'loaded))
(set! (-> lev-names i) (symbol->string (bsp-name (-> this level i))))
(if (-> this level i display?)
(set! (-> active-lev-names i) (-> lev-names i)))
)
)
)
(__pc-set-levels lev-names)
(__pc-set-active-levels active-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 New Issue View Git Blame Copy Permalink