Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 11:26:18 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity
jak-project/goal_src/jak3/engine/level/level.gc

3933 lines
141 KiB
Common Lisp
Raw Permalink Blame History

;;-*-Lisp-*-
(in-package goal)
;; name: level.gc
;; name in dgo: level
;; dgos: GAME
(define-extern level-update-after-load (function level login-state level))
(define-extern *level-type-list* type)
(define-extern city-sound-expand-want-list (function none))
(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.2) ;; 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)
(defmacro start-debug (str &rest args)
`(format 0 ,(string-append "[START] " str) ,@args)
)
(defun give-all-stuff ()
(send-event *target* 'get-pickup (pickup-type health) 1000.0)
(send-event *target* 'get-pickup (pickup-type shield) 1000.0)
;; (send-event *target* 'get-pickup (pickup-type skill) 100.0)
;; (send-event *target* 'get-pickup (pickup-type gem) 100.0)
(send-event *target* 'get-pickup (pickup-type ammo-yellow) 1000.0)
(send-event *target* 'get-pickup (pickup-type ammo-red) 1000.0)
(send-event *target* 'get-pickup (pickup-type ammo-blue) 1000.0)
(send-event *target* 'get-pickup (pickup-type ammo-dark) 1000.0)
(send-event *target* 'get-pickup (pickup-type eco-pill-dark) 100.0)
(send-event *target* 'get-pickup (pickup-type eco-pill-light) 100.0)
(logior! (-> *game-info* features)
(game-feature
jakc
board board-launch board-zap
darkeco
darkjak darkjak darkjak-smack darkjak-bomb0 darkjak-bomb1
lighteco
lightjak lightjak-regen lightjak-swoop lightjak-freeze lightjak-shield
gun
gun-red-1 gun-yellow-1 gun-blue-1 gun-dark-1
gun-red-2 gun-yellow-2 gun-blue-2 gun-dark-2
gun-red-3 gun-yellow-3 gun-blue-3 gun-dark-3))
(logior! (-> *game-info* vehicles)
(game-vehicles
v-turtle
v-snake
v-scorpion
v-toad
v-fox
v-rhino
v-mirage
v-x-ride))
)
(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)
)
(true! *display-profile*)
;; (true! *stats-profile-bars*)
;; (true! *display-actor-marks*)
;; (true! *display-bones*)
(give-all-stuff)
)
)
)
)
;; DECOMP BEGINS
(defun level-memory-mode->string ((arg0 level-memory-mode))
"Convert level-memory-mode enum to string."
(case arg0
(((level-memory-mode large))
"large"
)
(((level-memory-mode city-center))
"city-center"
)
(((level-memory-mode tiny))
"tiny"
)
(((level-memory-mode borrow1))
"borrow1"
)
(((level-memory-mode borrow))
"borrow"
)
(((level-memory-mode small-center))
"small-center"
)
(((level-memory-mode alias))
"alias"
)
(((level-memory-mode borrow2))
"borrow2"
)
(((level-memory-mode tiny-edge))
"tiny-edge"
)
(((level-memory-mode borrow-city-small))
"borrow-city-small"
)
(((level-memory-mode borrow3))
"borrow3"
)
(((level-memory-mode medium))
"medium"
)
(((level-memory-mode tiny-center-micro))
"tiny-center-micro"
)
(((level-memory-mode small-edge))
"small-edge"
)
(((level-memory-mode borrow4))
"borrow4"
)
(((level-memory-mode tiny-center))
"tiny-center"
)
(((level-memory-mode city-tiny-edge))
"city-tiny-edge"
)
(((level-memory-mode tiny-center-small))
"tiny-center-small"
)
(((level-memory-mode borrow0))
"borrow0"
)
(((level-memory-mode micro))
"micro"
)
(else
"*unknown*"
)
)
)
;; WARN: Return type mismatch object vs level-load-info.
(defun lookup-level-info ((arg0 symbol))
"Get the level load info. Symbol can be the level name, visname, nickname, or a symbol that contains a level-load-info value."
(the-as
level-load-info
(cond
(arg0
(let ((v1-0 (-> arg0 value)))
(if (and (nonzero? v1-0)
v1-0
(= (logand (the-as int v1-0) 7) 4)
(= (-> (the-as basic v1-0) type) level-load-info)
)
(return (the-as level-load-info v1-0))
)
)
(let* ((v1-2 *level-load-list*)
(a1-5 (car v1-2))
)
(while (not (null? v1-2))
(let ((a1-6 (the-as level-load-info (-> (the-as symbol a1-5) value))))
(if (or (= arg0 (-> a1-6 name)) (= arg0 (-> a1-6 visname)) (= arg0 (-> a1-6 nickname)))
(return a1-6)
)
)
(set! v1-2 (cdr v1-2))
(set! a1-5 (car v1-2))
)
)
default-level
)
(else
default-level
)
)
)
)
(defmethod get-callback-symbol-value-by-slot! ((this level-load-info) (arg0 int))
"Look up value of symbol in callback-list with the given int as the car. Print warning if symbol's value is 0."
(let* ((v1-0 (the-as object (-> this callback-list)))
(a2-0 (-> (the-as pair v1-0) car))
)
(while (not (null? v1-0))
(let ((a3-1 (/ (the-as int (-> (the-as pair a2-0) car)) 8))
(t0-0 (-> (the-as pair a2-0) cdr))
)
(when (= a3-1 arg0)
(cond
((nonzero? (-> (the-as symbol t0-0) value))
(return (-> (the-as symbol t0-0) value))
)
(else
(format 0 "WARNING: level ~A has undefined callback slot ~D with value ~A~%" (-> this name) a3-1 t0-0)
(return #f)
)
)
(set! v1-0 0)
)
)
(set! v1-0 (-> (the-as pair v1-0) cdr))
(set! a2-0 (-> (the-as pair v1-0) car))
)
)
#f
)
;; WARN: Return type mismatch pair vs object.
(defmethod get-callback-by-slot! ((this level-load-info) (arg0 int))
"Look up value in callback-list with the given int as the car and return it. Doesn't derefence the symbol."
(let* ((v1-0 (-> this callback-list))
(a0-1 (car v1-0))
)
(while (not (null? v1-0))
(let ((a2-1 (/ (the-as int (car a0-1)) 8))
(a0-2 (cdr a0-1))
)
(if (= a2-1 arg0)
(return (the-as object a0-2))
)
)
(set! v1-0 (cdr v1-0))
(set! a0-1 (car v1-0))
)
)
(the-as pair #f)
)
(defmethod load-in-progress? ((this level-group))
"Is there a load happening now?"
(!= (-> *level* loading-level) (-> *level* level-default))
)
(defmethod get-level-by-heap-ptr-and-status ((this level-group) (arg0 pointer) (arg1 symbol))
"Look up a loaded level, given pointer inside of level's heap,
and the status of the level (active or loading)."
(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)
)
;; WARN: Return type mismatch object vs symbol.
(defmethod is-load-allowed? ((this level-group) (arg0 (pointer symbol)))
"Does the exclusive-load setting allow us to load this level?"
(let ((v1-1 (the-as pair (-> *setting-control* user-current exclusive-load))))
(if (or (not v1-1) (null? v1-1))
(return (the-as symbol #t))
)
(let ((a0-4 (if arg0
(-> arg0 0)
'default
)
)
(v0-0 (the-as object #t))
)
(let ((a1-1 (car v1-1)))
(while (not (null? v1-1))
(case (car a1-1)
(('allow)
(if (= (car (cdr a1-1)) a0-4)
(return (the-as symbol #t))
)
(if (= (car (cdr a1-1)) 'all)
(set! v0-0 #t)
)
)
(('ignore)
(if (= (car (cdr a1-1)) a0-4)
(return (the-as symbol #f))
)
(if (= (car (cdr a1-1)) 'all)
(set! v0-0 #f)
)
)
)
(set! v1-1 (cdr v1-1))
(set! a1-1 (car v1-1))
)
)
(the-as symbol v0-0)
)
)
)
(defun remap-level-name ((arg0 level-load-info))
"Get the load name, depending on if we should load a vis level or not."
(if (-> *level* vis?)
(-> arg0 visname)
(-> arg0 name)
)
)
(defmethod get-art-group-by-name ((this level) (arg0 string))
"Look up art-group in this level by name."
(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))
"Try getting the name from the BSP. If that fails, return the level's name (typically the same)."
(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))
"Callback function used by background-engine to draw a bsp.
Note that most drawing work has been moved into finish-background,
and the draw method called here just adds references to high-level rendering data
to lists. The exception is debug-draw, which does run here (only for draw-strip-lines)."
(draw arg0)
(if (nonzero? *display-strip-lines*)
(debug-draw arg0)
)
(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) (offset int))
(let ((gp-0 (-> *level* loading-level)))
(when gp-0
(cond
(this
(cond
((not (type? this bsp-header))
(format 0 "ERROR: level ~A is not a bsp-header.~%" (-> gp-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).~%"
(-> gp-0 name)
(-> this visible-list-length)
)
(the-as bsp-header #f)
)
(else
(set! (-> gp-0 bsp) this)
(set! (-> this level) gp-0)
this
)
)
)
(else
(format 0 "ERROR: level ~A is not a valid file.~%" (-> gp-0 name))
(the-as bsp-header #f)
)
)
)
)
)
;; WARN: Return type mismatch level vs none.
(defmethod load-common-package ((this level))
"Somewhat useless leftover from a more compliated package system. Will load common in some cases."
(when (not (or (not (-> this bsp)) (= *kernel-boot-mode* 'debug-boot)))
(if (not (null? (-> this info packages)))
(load-package "common" global)
)
)
(none)
)
(defmethod vis-clear ((this level))
"Clear visibility data: both the info and the cached vis bits. Switch 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))
"Link vis-infos from the bsp to the level."
(when (not (or (= (-> this status) 'inactive) (not (-> this bsp))))
(set! (-> this all-visible?) 'loading)
(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))
(set! (-> this vis-info s5-0) s4-0)
(set! (-> s4-0 current-vis-string) (the-as uint -1))
(if (= (-> s4-0 from-level) (-> this load-name))
(set! (-> s4-0 from-bsp) (-> this bsp))
(set! (-> s4-0 from-bsp) #f)
)
(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 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))
(init-level-system this #f)
(let* ((s2-0 (lookup-level-info arg0))
(s1-0 (remap-level-name s2-0))
)
(let ((s5-0 (level-get this s1-0)))
(when s5-0
(level-status-update! s5-0 arg1)
(set! s5-1 s5-0)
(goto cfg-28)
)
)
(let ((a0-7 (level-get-most-disposable this)))
(set! s5-1 (if a0-7
(level-status-update! a0-7 'inactive)
a0-7
)
)
)
(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-28)
)
(let ((s0-0 (-> s2-0 master-level)))
(when s0-0
(let ((a0-10 (lookup-level-info s0-0)))
(when (not (logtest? (level-flags allow-unloaded) (-> a0-10 level-flags)))
(dotimes (v1-16 (-> this length))
(let ((a0-15 (-> this level v1-16)))
(when (or (= (-> a0-15 status) 'active) (= (-> a0-15 status) 'alive) (= (-> a0-15 status) 'loaded))
(if (= (-> a0-15 name) s0-0)
(goto cfg-24)
)
)
)
)
(format 0 "ERROR: level ~A is loading before master-level ~A~%" arg0 s0-0)
(break!)
0
)
)
)
)
(label cfg-24)
(let ((v1-22 (+ (-> this load-order) 1)))
(set! (-> this load-order) v1-22)
(set! (-> s5-1 load-order) v1-22)
)
(set! (-> s5-1 info) s2-0)
(set! (-> s5-1 name) arg0)
(set! (-> s5-1 load-name) s1-0)
)
(dotimes (v1-23 11)
(set! (-> s5-1 texture-anim-array v1-23) #f)
)
(set! (-> s5-1 display?) #f)
(set! (-> s5-1 force-all-visible?) #f)
(set! (-> s5-1 force-inside?) #f)
(level-status-update! s5-1 'loading)
(level-status-update! s5-1 arg1)
(label cfg-28)
s5-1
)
(defmethod do-nothing ((this level-group))
"Empty method."
0
(none)
)
(defmethod status-of-level-and-borrows ((this level-group) (arg0 symbol) (arg1 symbol))
"Get the combined status of a level and borrow levels."
(if (not arg0)
(return #f)
)
(let ((s4-0 (level-get *level* arg0))
(v1-3 (lookup-level-info arg0))
)
(cond
(s4-0
(when (and (or (= (-> s4-0 status) 'loaded) (= (-> s4-0 status) 'active))
(and (-> s4-0 info borrow) (!= arg1 'ignore-borrow))
)
(dotimes (s3-1 5)
(let ((v1-14 (-> s4-0 info borrow borrow-info s3-1)))
(when v1-14
(when (car (cdr v1-14))
(let ((v1-15 (status-of-level-and-borrows this (the-as symbol (car v1-14)) arg1)))
(if (!= v1-15 (-> s4-0 status))
(return v1-15)
)
)
)
)
)
)
)
(-> s4-0 status)
)
((and v1-3 (-> v1-3 borrow) (-> v1-3 borrow alias))
(b!
(not (or (= arg0 'ctywide-ff)
(= arg0 'ctywide-kg)
(= arg0 'ctywide-mh)
(= arg0 'ctywide-ff-kg)
(= arg0 'ctywide-ff-mh)
(= arg0 'ctywide-mh-kg)
)
)
cfg-42
:delay (nop!)
)
(let ((s5-1 (the-as object *borrow-city-status-list*)))
(b! #t cfg-43 :delay (nop!))
(label cfg-42)
(set! s5-1 (-> v1-3 borrow alias))
(label cfg-43)
(let* ((a0-26 s5-1)
(s4-1 ((method-of-type (rtype-of a0-26) length) a0-26))
)
(while (and (> s4-1 0) (car s5-1))
(when (and (!= (car s5-1) 'dummy)
(or (= arg1 'all) (let ((a0-31 (lookup-level-info (the-as symbol (car s5-1)))))
(and a0-31 (not (logtest? (-> a0-31 level-flags) (level-flags city-borrow-available))))
)
)
)
(let ((v1-29 (status-of-level-and-borrows *level* (the-as symbol (car s5-1)) arg1)))
(if (!= v1-29 'active)
(return v1-29)
)
)
)
(set! s5-1 (cdr (cdr s5-1)))
(+! s4-1 -2)
)
)
)
'active
)
)
)
)
(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."
(case arg0
(('inactive)
(-> this status)
(unload! this)
)
(('loading)
(case (-> this status)
(('inactive)
(load-begin this)
)
)
)
(('loading-bt)
(case (-> this status)
(('loading)
(set! (-> this status) arg0)
(do-nothing *level*)
(load-continue this)
)
)
)
(('loading-done)
(case (-> this status)
(('loading-bt)
(set! (-> this status) arg0)
(do-nothing *level*)
)
)
)
(('loaded)
(case (-> this status)
(('loading-done)
(login-begin this)
)
(('alive 'active)
(deactivate this)
)
)
)
(('alive 'active)
(when *dproc*
(case (-> this status)
(('loaded)
(birth this)
(level-status-update! this arg0)
)
(('alive)
(when (and *dproc* (= arg0 'active))
(when (zero? (-> this display-start-time))
(set! (-> this display-start-time) (the-as uint (-> *display* real-clock frame-counter)))
0
)
(remove-by-param1 *background-draw-engine* (the-as int (-> this bsp)))
(add-connection *background-draw-engine* *dproc* add-bsp-drawable (-> this bsp) this #f)
(dotimes (v1-49 20)
(set! (-> this closest-object v1-49) 0.0)
(set! (-> this texture-mask v1-49 mask quad) (the-as uint128 0))
)
(set! (-> this status) 'active)
(do-nothing *level*)
(assign-draw-indices *level*)
)
)
)
)
)
)
this
)
(define *login-state* (new 'global 'login-state))
(define *print-login* #t)
(defun load-buffer-resize ((arg0 level) (arg1 dgo-header))
"Resize and relocate the DGO load buffers, making sure there is enough room to both load objects and heap alloc in the linker."
(case (-> arg0 load-buffer-mode)
(((level-memory-mode tiny))
(set! (-> arg0 load-buffer-size) (the-as uint (min (* 1100 1024) (the-as int (-> arg0 load-buffer-size)))))
)
(((level-memory-mode tiny-edge))
(set! (-> arg0 load-buffer-size) (+ (-> arg1 length) (* 2 1024)))
)
)
(let ((v1-4 (logand -64 (+ (-> arg0 load-buffer-size) 63))))
(if (= arg1 (-> arg0 load-buffer 0))
(set! (-> arg0 load-buffer 0) (- (-> arg0 load-buffer 1) v1-4))
(set! (-> arg0 load-buffer 1)
(the-as uint (&- (logand -64 (&+ (-> arg0 heap top-base) 0)) (the-as uint v1-4)))
)
)
)
(set! (-> arg0 heap top) (the-as pointer (-> arg0 load-buffer 0)))
0
(none)
)
(defmethod load-continue ((this level))
"Main function to run level loading/linking.
Called by the engine to make progress on loading levels."
(local-vars (sv-16 symbol))
(when (-> this linking)
(when (nonzero? (link-resume))
(set! (-> this linking) #f)
(case (-> this status)
(('loading)
(when (not (-> *texture-relocate-later* memcpy))
(cond
((= (-> this load-buffer-mode) (level-memory-mode borrow))
(let ((a2-0 (logand -64 (&+ (-> this heap current) 63))))
(dgo-load-continue a2-0 a2-0 a2-0)
)
)
(else
(load-buffer-resize this (-> 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))
)
)
)
)
)
(('loading-bt)
(level-status-update! this 'loading-done)
(level-status-update! this 'loaded)
)
)
)
(set! this this)
(goto cfg-39)
)
(when (-> *texture-relocate-later* memcpy)
(relocate-later)
(load-buffer-resize this (-> 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)
)
(case (-> this status)
(('loading)
(set! sv-16 (the-as symbol #f))
(let ((s5-0 (dgo-load-get-next (& sv-16))))
(when s5-0
(set! (-> this load-buffer-last) (the-as dgo-header 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) *dgo-time*)))
)
(set! (-> *level* load-login-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) *dgo-time*)))
)
(cond
((not sv-16)
(cond
((= (-> this load-buffer-mode) (level-memory-mode borrow))
(cond
((dgo-load-link (the-as dgo-header s5-0) (-> this heap) (the-as uint (-> this heap top-base)) *print-login* #f)
(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
(set! (-> this linking) #t)
)
)
)
((dgo-load-link (the-as dgo-header s5-0) (-> this heap) (-> this load-buffer 1) *print-login* #f)
(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
(set! (-> this linking) #t)
)
)
)
(else
(set! (-> this heap top) (-> this heap top-base))
(level-status-update! this 'loading-bt)
)
)
)
)
)
(('login)
(level-update-after-load this *login-state*)
)
(('loading-bt)
(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
)
(defun level-find-borrow-slot ((borrower-level level) (mode level-memory-mode))
"Set up a level to 'borrow' from another.
This function finds the right 'host' level, which should
have prepared a heap for this level. This level will then
be configured to use this heap."
(local-vars (a2-1 level) (found-slot symbol))
(let ((host-level-borrow-slot -1))
(dotimes (host-level-candidate-idx 10)
(let ((host-level-candidate (-> *level* level host-level-candidate-idx)))
(when (and (or (= (-> host-level-candidate status) 'active) (= (-> host-level-candidate status) 'loaded))
(and (-> host-level-candidate info borrow)
(begin
(let ((mode2 mode))
(set! found-slot
(cond
((= mode2 (level-memory-mode borrow))
(dotimes (host-level-slot-idx 5)
(when (and (-> host-level-candidate info borrow borrow-info host-level-slot-idx)
(= (car (-> host-level-candidate info borrow borrow-info host-level-slot-idx)) (-> borrower-level name))
(nonzero? (-> host-level-candidate info borrow borrow-size host-level-slot-idx))
)
(set! host-level-borrow-slot host-level-slot-idx)
(set! found-slot #t)
(goto cfg-70)
)
)
#f
)
((= mode2 (level-memory-mode borrow-city-small))
(when (= (-> borrower-level info master-level) (-> host-level-candidate name))
(dotimes (t0-13 3)
(when (not (-> host-level-candidate borrow-level t0-13))
(set! host-level-borrow-slot t0-13)
(set! found-slot #t)
(goto cfg-70)
)
)
#f
)
)
((= mode2 (level-memory-mode borrow0))
(when (and (= (-> borrower-level info master-level) (-> host-level-candidate name))
(nonzero? (-> host-level-candidate info borrow borrow-size 0))
)
(set! host-level-borrow-slot 0)
(set! found-slot #t)
(goto cfg-70)
found-slot
)
)
((= mode2 (level-memory-mode borrow1))
(when (and (= (-> borrower-level info master-level) (-> host-level-candidate name))
(nonzero? (-> host-level-candidate info borrow borrow-size 1))
)
(set! host-level-borrow-slot 1)
(set! found-slot #t)
(goto cfg-70)
found-slot
)
)
((= mode2 (level-memory-mode borrow2))
(when (and (= (-> borrower-level info master-level) (-> host-level-candidate name))
(nonzero? (-> host-level-candidate info borrow borrow-size 2))
)
(set! host-level-borrow-slot 2)
(set! found-slot #t)
(goto cfg-70)
found-slot
)
)
((= mode2 (level-memory-mode borrow3))
(when (and (= (-> borrower-level info master-level) (-> host-level-candidate name))
(nonzero? (-> host-level-candidate info borrow borrow-size 3))
)
(set! host-level-borrow-slot 3)
(set! found-slot #t)
(goto cfg-70)
found-slot
)
)
((= mode2 (level-memory-mode borrow4))
(when (and (= (-> borrower-level info master-level) (-> host-level-candidate name))
(nonzero? (-> host-level-candidate info borrow borrow-size 4))
)
(set! host-level-borrow-slot 4)
(set! found-slot #t)
(goto cfg-70)
found-slot
)
)
)
)
)
(label cfg-70)
(and found-slot
(>= host-level-borrow-slot 0)
(not (-> host-level-candidate borrow-level host-level-borrow-slot))
)
)
)
)
(set! a2-1 host-level-candidate)
(goto cfg-82)
)
)
)
(set! a2-1 (the-as level #f))
(label cfg-82)
(cond
(a2-1
(set! (-> borrower-level borrow-from-level) a2-1)
(set! (-> a2-1 borrow-level host-level-borrow-slot) borrower-level)
(mem-copy!
(the-as pointer (-> borrower-level heap))
(the-as pointer (-> a2-1 borrow-heap host-level-borrow-slot))
16
)
)
(else
(format
0
"ERROR: level ~A could not find free ~S bank in the level-group heap~%"
(-> borrower-level name)
(level-memory-mode->string mode)
)
(break!)
0
)
)
)
0
(none)
)
(defmethod load-begin ((this level))
"Start loading data of a level."
(local-vars
(sv-16 level)
(memory-unused? (function level-group int symbol))
(level-page-offset int)
(micro-mask int)
(tiny-mask int)
(heap-size int)
(sv-56 int)
)
(dotimes (v1-0 5)
(set! (-> this borrow-level v1-0) #f)
)
(set! (-> this borrow-from-level) #f)
(set! (-> this memory-mask) (the-as uint 0))
(let ((mem-mode (-> this info memory-mode)))
(dotimes (v1-4 10)
(set! sv-16 (-> *level* level v1-4))
(when (and (or (= (-> sv-16 status) 'active) (= (-> sv-16 status) 'loaded)) (-> sv-16 info borrow))
(dotimes (a0-16 5)
(when (and (-> sv-16 info borrow borrow-info a0-16)
(= (car (-> sv-16 info borrow borrow-info a0-16)) (-> this name))
(nonzero? (-> sv-16 info borrow borrow-size a0-16))
)
(when (!= mem-mode (level-memory-mode borrow))
(format 0 "WARNING: level ~A upgraded to borrow~%" (-> this name))
(set! mem-mode (level-memory-mode borrow))
)
(goto cfg-28)
)
)
)
)
(label cfg-28)
(case mem-mode
(((level-memory-mode borrow)
(level-memory-mode borrow0)
(level-memory-mode borrow1)
(level-memory-mode borrow2)
(level-memory-mode borrow3)
(level-memory-mode borrow4)
(level-memory-mode borrow-city-small)
)
(level-find-borrow-slot this mem-mode)
)
(else
(set! memory-unused? (lambda ((arg0 level-group) (arg1 int))
(dotimes (v1-0 11)
(if (logtest? (-> arg0 level v1-0 memory-mask) arg1)
(return #f)
)
)
#t
)
)
(set! level-page-offset 0)
(set! micro-mask 0)
(set! tiny-mask 0)
(dotimes (v1-15 10)
(let ((lev (-> *level* level v1-15)))
(when (and (or (= (-> lev status) 'active) (= (-> lev status) 'loaded))
(or (= (-> lev info memory-mode) (level-memory-mode micro))
(= (-> lev info memory-mode) (level-memory-mode city-tiny-edge))
)
)
(case (-> lev info memory-mode)
(((level-memory-mode city-tiny-edge))
(set! micro-mask (if (or (= (-> lev memory-mask) 60) (= (-> lev memory-mask) #x3c000))
3
#x30000
)
)
(if (zero? tiny-mask)
(set! tiny-mask (if (or (= (-> lev memory-mask) 15) (= (-> lev memory-mask) #x3c000))
#x3c000
60
)
)
)
)
(((level-memory-mode micro))
(set! micro-mask (the-as int (-> lev memory-mask)))
)
)
)
)
)
(let ((v1-18 mem-mode))
(set! heap-size (cond
((= v1-18 (level-memory-mode large))
;; 96 pages. this uses up 12 of the 18 chunks, meaning you can only have a small level alongside a large level.
;; because two of the chunks 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)
)
((= v1-18 (level-memory-mode medium))
;; 73 pages. this uses up 9 of the 18 chunks, one of them being a middle chunk
;; which is 1 page larger than non-middle sections. 8 * 8 + 9 * 1 = 73.
;; this means you can either have a medium or small level alongside this.
(* LEVEL_PAGE_SIZE 73)
)
((or (= v1-18 (level-memory-mode small-center)) (= v1-18 (level-memory-mode city-center)))
;; 50 pages. this uses up the two middle chunks. 9 * 2 + 8 * 4 = 50.
(* LEVEL_PAGE_SIZE 50)
)
((or (= v1-18 (level-memory-mode city-tiny-edge))
(= v1-18 (level-memory-mode tiny-center))
(= v1-18 (level-memory-mode tiny-edge))
(= v1-18 (level-memory-mode tiny))
)
;; 32 pages. city-tiny-edge can coexist with micro.
(* LEVEL_PAGE_SIZE 32)
)
((= v1-18 (level-memory-mode micro))
;; 16 pages. this is the smallest memory mode, and is placed
;; either at the very top of the level heap or the very bottom.
(* LEVEL_PAGE_SIZE 16)
)
((= v1-18 (level-memory-mode tiny-center-micro))
;; 24 pages. this is the second smallest memory mode. can coexist with city-tiny-edge.
(* LEVEL_PAGE_SIZE 24)
)
((= v1-18 (level-memory-mode tiny-center-small))
;; 40 pages. strange name, as it is larger than all other tiny modes.
(* LEVEL_PAGE_SIZE 40)
)
(else
;; 48 pages. this uses 6 chunks, and does NOT use any of the middle chunks. 8 * 6 = 48.
(* LEVEL_PAGE_SIZE 48)
)
)
)
)
(set! sv-56 0)
(case mem-mode
(((level-memory-mode large))
(case micro-mask
((3)
(let ((s4-0 #x3ffc0))
(when (memory-unused? *level* s4-0)
(set! level-page-offset 48)
(set! sv-56 s4-0)
(goto cfg-322)
)
)
(let ((s4-1 #x3ffc))
(when (memory-unused? *level* s4-1)
(set! level-page-offset 16)
(set! sv-56 s4-1)
(goto cfg-322)
)
)
)
((#x30000)
(let ((s4-2 4095))
(when (memory-unused? *level* s4-2)
(set! level-page-offset 0)
(set! sv-56 s4-2)
(goto cfg-322)
)
)
(let ((s4-3 #xfff0))
(when (memory-unused? *level* s4-3)
(set! level-page-offset 32)
(set! sv-56 s4-3)
(goto cfg-322)
)
)
)
(else
(let ((s4-4 4095))
(when (memory-unused? *level* s4-4)
(set! level-page-offset 0)
(set! sv-56 s4-4)
(goto cfg-322)
)
)
(let ((s4-5 #x3ffc0))
(when (memory-unused? *level* s4-5)
(set! level-page-offset 48)
(set! sv-56 s4-5)
(goto cfg-322)
)
)
)
)
)
(((level-memory-mode medium))
(let ((s4-6 511))
(when (memory-unused? *level* s4-6)
(set! level-page-offset 0)
(set! sv-56 s4-6)
(goto cfg-322)
)
)
(let ((s4-7 #x3fe00))
(when (memory-unused? *level* s4-7)
(set! level-page-offset 73)
(set! sv-56 s4-7)
(goto cfg-322)
)
)
)
(((level-memory-mode small-center))
(case micro-mask
((3)
(case tiny-mask
((#x3c000)
(let ((s4-8 #x3f00))
(when (memory-unused? *level* s4-8)
(set! level-page-offset 64)
(set! sv-56 s4-8)
(goto cfg-322)
)
)
)
(else
(let ((s4-9 4032))
(when (memory-unused? *level* s4-9)
(set! level-page-offset 48)
(set! sv-56 s4-9)
(goto cfg-322)
)
)
)
)
)
((#x30000)
(case tiny-mask
((#x3c000)
(let ((s4-10 1008))
(when (memory-unused? *level* s4-10)
(set! level-page-offset 32)
(set! sv-56 s4-10)
(goto cfg-322)
)
)
)
(else
(let ((s4-11 4032))
(when (memory-unused? *level* s4-11)
(set! level-page-offset 48)
(set! sv-56 s4-11)
(goto cfg-322)
)
)
)
)
)
(else
(let ((s4-12 4032))
(when (memory-unused? *level* s4-12)
(set! level-page-offset 48)
(set! sv-56 s4-12)
(goto cfg-322)
)
)
)
)
)
(((level-memory-mode city-center))
(let ((s4-13 4032))
(when (memory-unused? *level* s4-13)
(set! level-page-offset 48)
(set! sv-56 s4-13)
(goto cfg-322)
)
)
)
(((level-memory-mode small-edge))
(case micro-mask
((3)
(case tiny-mask
((#x3c000)
(let ((s4-14 252))
(when (memory-unused? *level* s4-14)
(set! level-page-offset 16)
(set! sv-56 s4-14)
(goto cfg-322)
)
)
(let ((s4-15 #x3f00))
(when (memory-unused? *level* s4-15)
(set! level-page-offset 64)
(set! sv-56 s4-15)
(goto cfg-322)
)
)
)
(else
(let ((s4-16 #x3f000))
(when (memory-unused? *level* s4-16)
(set! level-page-offset 98)
(set! sv-56 s4-16)
(goto cfg-322)
)
)
(let ((s4-17 4032))
(when (memory-unused? *level* s4-17)
(set! level-page-offset 48)
(set! sv-56 s4-17)
(goto cfg-322)
)
)
)
)
)
((#x30000)
(case tiny-mask
((#x3c000)
(let ((s4-18 #xfc00))
(when (memory-unused? *level* s4-18)
(set! level-page-offset 82)
(set! sv-56 s4-18)
(goto cfg-322)
)
)
(let ((s4-19 1008))
(when (memory-unused? *level* s4-19)
(set! level-page-offset 32)
(set! sv-56 s4-19)
(goto cfg-322)
)
)
)
(else
(let ((s4-20 63))
(when (memory-unused? *level* s4-20)
(set! level-page-offset 0)
(set! sv-56 s4-20)
(goto cfg-322)
)
)
(let ((s4-21 4032))
(when (memory-unused? *level* s4-21)
(set! level-page-offset 48)
(set! sv-56 s4-21)
(goto cfg-322)
)
)
)
)
)
(else
(let ((s4-22 63))
(when (memory-unused? *level* s4-22)
(set! level-page-offset 0)
(set! sv-56 s4-22)
(goto cfg-322)
)
)
(let ((s4-23 #x3f000))
(when (memory-unused? *level* s4-23)
(set! level-page-offset 98)
(set! sv-56 s4-23)
(goto cfg-322)
)
)
)
)
)
(((level-memory-mode micro))
(let ((s4-24 3))
(when (memory-unused? *level* s4-24)
(set! level-page-offset 0)
(set! sv-56 s4-24)
(goto cfg-322)
)
)
(let ((s4-25 #x30000))
(when (memory-unused? *level* s4-25)
(set! level-page-offset 130)
(set! sv-56 s4-25)
(goto cfg-322)
)
)
)
(((level-memory-mode tiny-edge) (level-memory-mode city-tiny-edge))
(let ((v1-126 micro-mask))
(cond
((or (zero? v1-126) (= v1-126 3))
(let ((s4-26 60))
(when (memory-unused? *level* s4-26)
(set! level-page-offset 16)
(set! sv-56 s4-26)
(goto cfg-322)
)
)
(let ((s4-27 #x3c000))
(when (memory-unused? *level* s4-27)
(set! level-page-offset 114)
(set! sv-56 s4-27)
(goto cfg-322)
)
)
)
((= v1-126 #x30000)
(let ((s4-28 #xf000))
(when (memory-unused? *level* s4-28)
(set! level-page-offset 98)
(set! sv-56 s4-28)
(goto cfg-322)
)
)
(let ((s4-29 15))
(when (memory-unused? *level* s4-29)
(set! level-page-offset 0)
(set! sv-56 s4-29)
(goto cfg-322)
)
)
)
)
)
)
(((level-memory-mode tiny))
(let ((v1-143 micro-mask))
(cond
((or (zero? v1-143) (= v1-143 3))
(let ((s4-30 60))
(when (memory-unused? *level* s4-30)
(set! level-page-offset 16)
(set! sv-56 s4-30)
(goto cfg-322)
)
)
(let ((s4-31 #x3c000))
(when (memory-unused? *level* s4-31)
(set! level-page-offset 114)
(set! sv-56 s4-31)
(goto cfg-322)
)
)
(let ((s4-32 #x3c00))
(when (memory-unused? *level* s4-32)
(set! level-page-offset 82)
(set! sv-56 s4-32)
(goto cfg-322)
)
)
(let ((s4-33 960))
(when (memory-unused? *level* s4-33)
(set! level-page-offset 48)
(set! sv-56 s4-33)
(goto cfg-322)
)
)
)
((= v1-143 #x30000)
(let ((s4-34 #xf000))
(when (memory-unused? *level* s4-34)
(set! level-page-offset 98)
(set! sv-56 s4-34)
(goto cfg-322)
)
)
(let ((s4-35 15))
(when (memory-unused? *level* s4-35)
(set! level-page-offset 0)
(set! sv-56 s4-35)
(goto cfg-322)
)
)
(let ((s4-36 240))
(when (memory-unused? *level* s4-36)
(set! level-page-offset 32)
(set! sv-56 s4-36)
(goto cfg-322)
)
)
(let ((s4-37 3840))
(when (memory-unused? *level* s4-37)
(set! level-page-offset 64)
(set! sv-56 s4-37)
(goto cfg-322)
)
)
)
)
)
)
(((level-memory-mode tiny-center))
(let ((v1-176 micro-mask))
(cond
((or (zero? v1-176) (= v1-176 3))
(let ((s4-38 #x3c00))
(when (memory-unused? *level* s4-38)
(set! level-page-offset 82)
(set! sv-56 s4-38)
(goto cfg-322)
)
)
(let ((s4-39 960))
(when (memory-unused? *level* s4-39)
(set! level-page-offset 48)
(set! sv-56 s4-39)
(goto cfg-322)
)
)
)
((= v1-176 #x30000)
(let ((s4-40 240))
(when (memory-unused? *level* s4-40)
(set! level-page-offset 32)
(set! sv-56 s4-40)
(goto cfg-322)
)
)
(let ((s4-41 3840))
(when (memory-unused? *level* s4-41)
(set! level-page-offset 64)
(set! sv-56 s4-41)
(goto cfg-322)
)
)
)
)
)
)
(((level-memory-mode tiny-center-small))
(let ((v1-194 micro-mask))
(cond
((or (zero? v1-194) (= v1-194 3))
(let ((s4-42 #x3e00))
(when (memory-unused? *level* s4-42)
(set! level-page-offset 72)
(set! sv-56 s4-42)
(goto cfg-322)
)
)
(let ((s4-43 1984))
(when (memory-unused? *level* s4-43)
(set! level-page-offset 48)
(set! sv-56 s4-43)
(goto cfg-322)
)
)
)
((= v1-194 #x30000)
(let ((s4-44 496))
(when (memory-unused? *level* s4-44)
(set! level-page-offset 32)
(set! sv-56 s4-44)
(goto cfg-322)
)
)
(let ((s4-45 3968))
(when (memory-unused? *level* s4-45)
(set! level-page-offset 56)
(set! sv-56 s4-45)
(goto cfg-322)
)
)
)
)
)
)
(((level-memory-mode tiny-center-micro))
(let ((v1-213 micro-mask))
(cond
((or (zero? v1-213) (= v1-213 3))
(let ((s4-46 448))
(when (memory-unused? *level* s4-46)
(set! level-page-offset 48)
(set! sv-56 s4-46)
(goto cfg-322)
)
)
(let ((s4-47 #x3800))
(when (memory-unused? *level* s4-47)
(set! level-page-offset 90)
(set! sv-56 s4-47)
(goto cfg-322)
)
)
)
((= v1-213 #x30000)
(let ((s4-48 3584))
(when (memory-unused? *level* s4-48)
(set! level-page-offset 72)
(set! sv-56 s4-48)
(goto cfg-322)
)
)
(let ((s4-49 112))
(when (memory-unused? *level* s4-49)
(set! level-page-offset 32)
(set! sv-56 s4-49)
(goto cfg-322)
)
)
)
)
)
)
)
(label cfg-322)
(cond
((zero? sv-56)
(format
0
"ERROR: level ~A could not find free ~S bank in the level-group heap (micro ~X tiny ~X)~%"
(-> this name)
(level-memory-mode->string mem-mode)
micro-mask
tiny-mask
)
(dotimes (s5-1 11)
(let ((s4-51 (-> *level* level s5-1)))
(when (!= (-> s4-51 status) 'inactive)
(format 0 "~Tlevel ~2D ~16S " s5-1 (-> s4-51 name))
(format
0
"~16S bits #b~18,'0B~%"
(if (nonzero? (-> s4-51 info))
(level-memory-mode->string (-> s4-51 info memory-mode))
)
(-> s4-51 memory-mask)
)
)
)
)
#t
(break!)
0
)
(else
(set! (-> this memory-mask) (the-as uint sv-56))
(format 0 "lev ~A ~X micro ~X tiny ~X~%" (-> this name) (-> this memory-mask) micro-mask tiny-mask)
(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-245 (-> this heap)))
(set! (-> v1-245 base) (&+ (-> *level* heap base) (* DEBUG_LEVEL_PAGE_SIZE level-page-offset)))
(set! (-> v1-245 current) (-> v1-245 base))
;(set! (-> v1-245 top-base) (&+ (-> v1-245 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-245 top-base) (&+ (-> v1-245 base) (* DEBUG_LEVEL_PAGE_SIZE (/ heap-size LEVEL_PAGE_SIZE))))
(set! (-> v1-245 top) (-> v1-245 top-base))
)
)
(else
(let ((v1-246 (-> this heap)))
;; no debug size heaps. set up our heap.
;; level-page-offset is in 146ths (1 level heap page) of the total size.
(set! (-> v1-246 base) (&+ (-> *level* heap base) (* LEVEL_PAGE_SIZE level-page-offset)))
(set! (-> v1-246 current) (-> v1-246 base))
(set! (-> v1-246 top-base) (&+ (-> v1-246 base) heap-size))
(set! (-> v1-246 top) (-> v1-246 top-base))
)
)
)
)
)
)
)
)
(set! loading-level (-> this heap))
(set! (-> *level* loading-level) this)
(set! (-> this level-type) #f)
(set! *level-type-list* (the-as type (&-> this level-type)))
(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) (the-as uint (-> *display* real-clock frame-counter)))
(set! (-> this load-stop-time) (the-as uint 0))
(set! (-> this display-start-time) (the-as uint 0))
(set! (-> this part-engine) #f)
(dotimes (v1-258 4)
(set! (-> this user-object v1-258) #f)
)
(set! (-> this load-id) (the-as uint (new-sound-id)))
(set! (-> this status) 'loading)
(do-nothing *level*)
(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)
(set! (-> this code-memory-start) (-> this heap current))
(let ((v1-278 (-> this info memory-mode)))
(cond
((or (or (= v1-278 (level-memory-mode borrow)) (or (= v1-278 (level-memory-mode borrow0))
(= v1-278 (level-memory-mode borrow1))
(= v1-278 (level-memory-mode borrow2))
(= v1-278 (level-memory-mode borrow3))
(= v1-278 (level-memory-mode borrow4))
(= v1-278 (level-memory-mode micro))
(= v1-278 (level-memory-mode borrow-city-small))
)
)
(-> this borrow-from-level)
(logtest? (-> this info level-flags) (level-flags borrow-load))
)
(set! (-> this load-buffer-mode) (level-memory-mode borrow))
(let ((t0-2 (logand -64 (&+ (-> this heap current) 63))))
(dgo-load-begin *temp-string* (the-as uint128 (-> this load-id)) t0-2 t0-2 t0-2)
)
)
(else
(let* ((v1-287 (-> this info memory-mode))
(s4-52
(cond
((= v1-287 (level-memory-mode micro))
#x80000
)
((= v1-287 (level-memory-mode tiny-center-micro))
#xc0000
)
((or (= v1-287 (level-memory-mode tiny-center))
(= v1-287 (level-memory-mode tiny-edge))
(= v1-287 (level-memory-mode tiny))
(= v1-287 (level-memory-mode city-tiny-edge))
)
#xc8000
)
(else
#x1b5800
)
)
)
(s5-4 (kmalloc (-> this heap) s4-52 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
(s3-2 (kmalloc (-> this heap) s4-52 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
)
(format 0 "-----------> begin load ~A [~S] buffers ~d bytes~%" (-> this load-name) *temp-string* s4-52)
(set! (-> this load-buffer 0) (the-as uint s3-2))
(set! (-> this load-buffer 1) (the-as uint s5-4))
(set! (-> this load-buffer-size) (the-as uint s4-52))
(set! (-> this load-buffer-mode) (level-memory-mode micro))
(dgo-load-begin
*temp-string*
(the-as uint128 (-> this load-id))
s3-2
s5-4
(logand -64 (&+ (-> this heap current) 63))
)
)
)
)
)
this
)
(defmethod login-begin ((this level))
"Start logging in loaded level data."
(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 10)
(set! (-> this sky-mask mask data v1-10) 0)
)
(let* ((s4-0 (-> this info callback-list))
(v1-14 (car s4-0))
)
(while (not (null? s4-0))
(let ((s3-0 (/ (the-as int (car v1-14)) 8))
(a3-1 (the-as symbol (cdr v1-14)))
)
(when (and (< (the-as uint 1) s3-0) (< s3-0 (the-as uint 13)))
(if (nonzero? (-> a3-1 value))
(set! (-> this texture-anim-array (+ s3-0 -2)) (init! (the-as texture-anim-array (-> a3-1 value))))
(format 0 "WARNING: level ~A has undefined texture anim array ~A~%" (-> this name) a3-1)
)
)
)
(set! s4-0 (cdr s4-0))
(set! v1-14 (car s4-0))
)
)
(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))
(dotimes (v1-28 11)
(set! (-> this eye-slot-lowres v1-28) (the-as uint 0))
(set! (-> this eye-slot-highres v1-28) (the-as uint 0))
)
(set! (-> this status) 'login)
(do-nothing *level*)
)
(else
(level-status-update! this 'inactive)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* level-default))
(set! *level-type-list* (the-as type 0))
0
)
)
this
)
;; WARN: Found some very strange gotos. Check result carefully, this is not well tested.
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 s5, Count]
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 v1, Count]
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 v1, Count]
(defun level-update-after-load ((arg0 level) (arg1 login-state))
"Run the post-load state machine to login level data."
(local-vars
(v1-4 int)
(v1-244 int)
(s5-0 int)
(sv-16 drawable)
(sv-32 proxy-prototype-array-tie)
(sv-48 int)
(sv-64 prototype-bucket-tie)
(sv-80 int)
(sv-96 adgif-shader)
)
(set! *level-index* (-> arg0 index))
0
(let* ((s3-0 (-> arg0 bsp))
(s2-0 (-> s3-0 drawable-trees))
)
0
; (.mfc0 s5-0 Count)
(label cfg-1)
0
; (.mfc0 v1-4 Count)
; (let ((v1-5 (- v1-4 s5-0)))
; (when (< #x186a0 v1-5)
; (set! arg0 arg0)
; (goto cfg-116)
; )
; )
(let ((s0-0 (the-as int (-> arg1 pos))))
(when (= (-> arg1 state) -1)
(when (< s0-0 (-> s2-0 length))
(let ((s1-0 (-> s2-0 trees (the-as uint s0-0))))
(cond
((= (-> (the-as drawable-tree-tfrag s1-0) type) drawable-tree-tfrag)
(dotimes (s0-1 (-> (the-as drawable-tree-tfrag s1-0) length))
(cond
((= (-> (the-as drawable-tree-tfrag s1-0) arrays s0-1 type) drawable-inline-array-tfrag)
(set! (-> arg1 elt (-> arg1 elts)) (-> (the-as drawable-tree-tfrag s1-0) arrays s0-1))
(+! (-> arg1 elts) 1)
)
(else
(login (-> (the-as drawable-tree-tfrag s1-0) arrays s0-1))
)
)
)
)
((= (-> s1-0 type) drawable-tree-instance-tie)
(set! (-> arg1 elt (-> arg1 elts)) s1-0)
(+! (-> arg1 elts) 1)
)
(else
(login s1-0)
(if (nonzero? (-> s3-0 hfrag-drawable))
(login (-> s3-0 hfrag-drawable))
)
)
)
)
(+! (-> arg1 pos) 1)
(goto cfg-1)
)
(let ((v1-42 (- (the-as uint s0-0) (-> s2-0 length))))
(when (< (the-as int v1-42) (-> arg0 art-group art-group-array length))
(let ((s0-2 (-> arg0 art-group art-group-array v1-42))
(s1-1 (-> *kernel-context* login-level-index))
)
(set! (-> *kernel-context* login-level-index) (-> arg0 index))
(login s0-2)
(if (contains-art-for-other-group? s0-2)
(link-art-to-master s0-2)
)
(set! (-> *kernel-context* login-level-index) s1-1)
)
(+! (-> arg1 pos) 1)
(goto cfg-1)
)
)
(set! (-> arg1 pos) (the-as uint 0))
(set! (-> arg1 state) 0)
(goto cfg-1)
)
(when (< (-> arg1 state) (the-as int (-> arg1 elts)))
(set! sv-16 (-> arg1 elt (-> arg1 state)))
(cond
((= (-> sv-16 type) drawable-inline-array-tfrag)
(set! *texture-masks-array* (-> arg0 bsp tfrag-masks))
(cond
((< s0-0 (-> (the-as drawable-inline-array-tfrag sv-16) length))
(dotimes (s1-2 200)
(when (< s0-0 (-> (the-as drawable-inline-array-tfrag sv-16) length))
(login (-> (the-as drawable-inline-array-tfrag sv-16) data (the-as uint s0-0)))
(set! s0-0 (the-as int (+ (the-as uint s0-0) 1)))
)
)
(set! (-> arg1 pos) (the-as uint s0-0))
)
(else
(set! (-> arg1 pos) (the-as uint 0))
(set! s0-0 (+ (-> arg1 state) 1))
(set! (-> arg1 state) s0-0)
)
)
)
((= (-> sv-16 type) drawable-tree-instance-tie)
(let ((s1-3 (-> (the-as drawable-tree-instance-tie sv-16) prototypes prototype-array-tie)))
(set! sv-32 (-> (the-as drawable-tree-instance-tie sv-16) prototypes))
(when (< s0-0 (-> s1-3 length))
(set! sv-48 0)
(while (< sv-48 10)
(when (< s0-0 (-> s1-3 length))
(set! sv-64 (-> s1-3 array-data (the-as uint s0-0)))
(+! (-> sv-32 prototype-max-qwc) 32)
(cond
((logtest? (-> sv-64 flags) (prototype-flags tpage-alpha))
(set! *texture-masks* (-> *level* level *level-index* bsp alpha-masks data (-> sv-64 texture-masks-index)))
)
((logtest? (-> sv-64 flags) (prototype-flags tpage-water))
(set! *texture-masks* (-> *level* level *level-index* bsp water-masks data (-> sv-64 texture-masks-index)))
)
(else
(set! *texture-masks* (-> *level* level *level-index* bsp tfrag-masks data (-> sv-64 texture-masks-index)))
)
)
(when (and *debug-segment* (-> *screen-shot-work* highres-enable))
(dotimes (v1-116 4)
(+! (-> sv-64 dists data v1-116) 40960000.0)
(set! (-> sv-64 rdists data v1-116) (/ 1.0 (-> sv-64 dists data v1-116)))
)
)
(set! sv-80 0)
(while (< sv-80 4)
(let ((a0-63 (-> sv-64 tie-geom sv-80)))
(when (nonzero? a0-63)
(+! (-> sv-32 prototype-max-qwc) (* 7 (-> a0-63 length)))
(login a0-63)
)
)
(set! sv-80 (+ sv-80 1))
)
(set! s0-0 (the-as int (+ (the-as uint s0-0) 1)))
)
(set! sv-48 (+ sv-48 1))
)
(set! (-> arg1 pos) (the-as uint s0-0))
)
(when (= (the-as uint s0-0) (-> s1-3 length))
(dotimes (s0-3 (-> s1-3 length))
(let ((v1-146 (-> s1-3 array-data s0-3)))
(cond
((logtest? (-> v1-146 flags) (prototype-flags tpage-alpha))
(set! *texture-masks* (-> *level* level *level-index* bsp alpha-masks data (-> v1-146 texture-masks-index)))
)
((logtest? (-> v1-146 flags) (prototype-flags tpage-water))
(set! *texture-masks* (-> *level* level *level-index* bsp water-masks data (-> v1-146 texture-masks-index)))
)
(else
(set! *texture-masks* (-> *level* level *level-index* bsp tfrag-masks data (-> v1-146 texture-masks-index)))
)
)
(set! sv-96 (-> v1-146 envmap-shader))
)
(when (nonzero? sv-96)
(let ((v0-8 (adgif-shader-login-no-remap sv-96)))
(when v0-8
(dotimes (v1-150 3)
(dotimes (a0-82 3)
(set! (-> (the-as (pointer int32) (+ (+ (* v1-150 16) (* a0-82 4)) (the-as int *texture-masks*))))
(logior (-> (the-as (pointer int32) (+ (* a0-82 4) (the-as int *texture-masks*) (* v1-150 16))) 0)
(-> (the-as (pointer int32) (+ (* a0-82 4) (the-as int v0-8) (* v1-150 16))) 15)
)
)
)
(set! (-> *texture-masks* data v1-150 dist)
(fmax (-> *texture-masks* data v1-150 dist) (-> v0-8 masks data v1-150 dist))
)
)
)
)
(set! (-> sv-96 tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
(set! (-> sv-96 clamp) (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
(set! (-> sv-96 alpha) (new 'static 'gs-miptbp :tbp1 #x58))
(set! (-> sv-96 reg-0) (gs-reg tex0-1))
(set! (-> sv-96 reg-1) (gs-reg tex1-1))
(set! (-> sv-96 reg-2) (gs-reg miptbp1-1))
(set! (-> sv-96 reg-3) (gs-reg clamp-1))
(set! (-> sv-96 reg-4) (gs-reg alpha-1))
)
)
(set! (-> arg1 pos) (the-as uint 0))
(+! (-> arg1 state) 1)
)
)
)
)
(goto cfg-1)
)
(when (= (-> arg1 state) (-> arg1 elts))
(let ((v1-168 (-> arg0 bsp)))
(cond
((or (zero? (-> v1-168 nav-meshes)) (= (the-as uint s0-0) (-> v1-168 nav-meshes length)))
(set! (-> arg1 pos) (the-as uint 0))
(+! (-> arg1 state) 1)
)
(else
(initialize-nav-mesh! (-> v1-168 nav-meshes (the-as uint s0-0)))
(+! (-> arg1 pos) 1)
)
)
)
(goto cfg-1)
)
(when (zero? (the-as uint s0-0))
(set! (-> arg1 pos) (the-as uint 1))
(set! arg0 arg0)
(goto cfg-116)
)
)
)
(set! (-> arg0 nickname) (-> arg0 bsp nickname))
(let ((f0-6 (-> arg0 bsp subdivide-close))
(f1-3 (-> arg0 bsp subdivide-far))
)
(when (and (= f0-6 0.0) (= f1-3 0.0))
(set! f0-6 122880.0)
(set! f1-3 286720.0)
)
(set! (-> *subdivide-settings* close (-> arg0 index)) f0-6)
(set! (-> *subdivide-settings* far (-> arg0 index)) f1-3)
(set! (-> *subdivide-settings* close 11) f0-6)
(set! (-> *subdivide-settings* far 11) f1-3)
)
(when (and *debug-segment* (-> *screen-shot-work* highres-enable))
(set! (-> *subdivide-settings* close (-> arg0 index)) 40960000.0)
(set! (-> *subdivide-settings* far (-> arg0 index)) 41369600.0)
(set! (-> *subdivide-settings* close 11) 40960000.0)
(set! (-> *subdivide-settings* far 11) 41369600.0)
)
(init-vis-from-bsp arg0)
(if (nonzero? (-> arg0 info part-engine-max))
(set! (-> arg0 part-engine)
(new 'loading-level 'engine 'sparticle-launcher (the-as int (* (-> arg0 info part-engine-max) 16)) connection)
)
)
(load-common-package arg0)
(clear-mood-context (-> arg0 mood-context))
(set! (-> arg0 mood-init)
(the-as (function mood-context none) (get-callback-symbol-value-by-slot! (-> arg0 info) 23))
)
(if (-> arg0 mood-init)
((-> arg0 mood-init) (-> arg0 mood-context))
)
(when (-> arg0 info borrow)
(dotimes (v1-229 5)
(set! (-> arg0 heap top-base)
;; og:preserve-this
(the pointer (&- (-> arg0 heap top-base) (the uint (shl (the int (* BORROW_MULT (-> arg0 info borrow borrow-size v1-229))) 10))))
)
(set! (-> arg0 heap top) (-> arg0 heap top-base))
(let ((a0-121 (-> arg0 borrow-heap v1-229)))
(set! (-> a0-121 base) (-> arg0 heap top))
(set! (-> a0-121 current) (-> a0-121 base))
;; MODIFIED
(set! (-> a0-121 top-base) (&+ (-> a0-121 base) (the int (shl (the int (* BORROW_MULT (-> arg0 info borrow borrow-size v1-229))) 10))))
(set! (-> a0-121 top) (-> a0-121 top-base))
)
)
)
(set! (-> arg0 draw-priority) (-> arg0 info draw-priority))
(set! (-> arg0 status) 'loaded)
(do-nothing *level*)
(mark-hud-warp-sprite-dirty *texture-pool*)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* level-default))
(set! *level-type-list* (the-as type 0))
(set! (-> *level* log-in-level-bsp) #f)
(set! (-> arg0 load-stop-time) (the-as uint (-> *display* real-clock frame-counter)))
0
(.mfc0 v1-244 Count)
(- v1-244 s5-0)
(set! (-> *level* load-login-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) *dgo-time*)))
)
(label cfg-116)
arg0
)
(defmethod birth ((this level))
"Start running a level."
(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)
(do-nothing *level*)
(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 s1-0
(let ((s1-1 (get-callback-symbol-value-by-slot! (-> this info) 33)))
(if (and s1-1 (type? s1-1 function))
((the-as (function object object) s1-1) this)
)
)
)
)
(let ((s1-2 (-> this status)))
(set! (-> this status) 'active)
(do-nothing *level*)
(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)
)
(let ((s0-1 (get-callback-symbol-value-by-slot! (-> this info) 35)))
(if (and s0-1 (type? s0-1 function))
((the-as (function object object object) 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))
"Keep a level in memory, but kill entities and stop drawing it."
(case (-> this status)
(('active 'alive)
(format 0 "----------- deactivate(kill) ~A (status ~A)~%" this (-> this status))
(if (and (!= (-> this bsp city-level-info) 0) *traffic-manager*)
(send-event *traffic-manager* 'level-killed this)
)
(let ((s5-0 (get-callback-symbol-value-by-slot! (-> this info) 36)))
(if (and s5-0 (type? s5-0 function))
((the-as (function object object) s5-0) this)
)
)
(copy-perms-from-level! *game-info* this)
(send-event *target* 'level-deactivate (-> this name))
(remove-by-param1 *background-draw-engine* (the-as int (-> this bsp)))
(let ((s5-1 (-> this status)))
(set! (-> this status) 'shutdown)
(do-nothing *level*)
(deactivate-entities (-> this bsp))
(set! (-> this status) s5-1)
)
(kill-all-particles-in-level this)
(unload-from-heap *anim-manager* (-> this heap))
(set! (-> this inside-boxes?) #f)
(set! (-> this meta-inside?) #f)
(set! (-> this force-inside?) #f)
(set! (-> this status) 'loaded)
(do-nothing *level*)
(set! (-> this light-hash) (the-as light-hash 0))
(set! (-> this all-visible?) 'loading)
(dotimes (v1-35 128)
(set! (-> (the-as (pointer int128) (&+ (-> this vis-bits) (* v1-35 16)))) (the int128 0))
)
(countdown (v1-38 8)
(let ((a0-23 (-> this vis-info v1-38)))
(if a0-23
(set! (-> a0-23 current-vis-string) (the-as uint -1))
)
)
)
(when (logtest? (-> this info base-task-mask) (task-mask primary0))
(let ((v1-45 (task-mask)))
(dotimes (a0-24 (-> *level* length))
(let ((a1-15 (-> *level* level a0-24)))
(if (= (-> a1-15 status) 'active)
(set! v1-45 (logior v1-45 (logand (-> a1-15 info base-task-mask) (task-mask primary0))))
)
)
)
(when (not (logtest? v1-45 (task-mask primary0)))
(dotimes (v1-48 (-> *level* length))
(let ((a0-30 (-> *level* level v1-48)))
(if (= (-> a0-30 status) 'active)
(logior! (-> a0-30 task-mask) (task-mask primary0))
)
)
)
)
)
)
)
)
(if (= (-> *level* log-in-level-bsp) (-> this bsp))
(set! (-> *level* log-in-level-bsp) #f)
)
this
)
(defmethod unload! ((this level))
"Remove level from memory."
(deactivate this)
(when (!= (-> this status) 'inactive)
(when (not (logtest? (level-flags allow-unloaded) (-> this info level-flags)))
(dotimes (s5-0 (-> *level* length))
(let ((v1-10 (-> *level* level s5-0)))
(when (or (= (-> v1-10 status) 'active) (= (-> v1-10 status) 'alive) (= (-> v1-10 status) 'loaded))
(when (= (-> v1-10 info master-level) (-> this name))
(format
0
"ERROR: level ~A is unloading but level ~A depends on it as a master-level~%"
(-> this name)
(-> v1-10 name)
)
(break!)
0
)
)
)
)
)
(dotimes (s5-1 5)
(when (-> this borrow-level s5-1)
(unload! (-> this borrow-level s5-1))
(set! (-> this borrow-level s5-1) #f)
)
)
(when (-> this borrow-from-level)
(dotimes (v1-30 5)
(if (= this (-> this borrow-from-level borrow-level v1-30))
(set! (-> this borrow-from-level borrow-level v1-30) #f)
)
)
(set! (-> this borrow-from-level) #f)
)
(case (-> this status)
(('loading 'loading-bt)
(dgo-load-cancel (the-as int (-> this load-id)))
(link-reset)
)
(('alive 'active 'loaded)
(when (-> this entity)
(let ((s5-2 (get-callback-symbol-value-by-slot! (-> this info) 34)))
(if (and s5-2 (type? s5-2 function))
((the-as (function level object) s5-2) this)
)
)
)
)
)
(when (or (= (-> this status) 'loaded)
(= (-> this status) 'alive)
(= (-> this status) 'active)
(= (-> this status) 'login)
)
(dotimes (s5-3 (-> this art-group art-group-array length))
(let ((s4-0 (-> this art-group art-group-array s5-3)))
(if (contains-art-for-other-group? s4-0)
(unlink-art-to-master s4-0)
)
(art-method-10 s4-0)
)
)
(case (-> this status)
(('alive 'active 'loaded)
(let* ((s5-4 (-> this info callback-list))
(v1-68 (car s5-4))
)
(while (not (null? s5-4))
(let ((s4-1 (/ (the-as int (car v1-68)) 8))
(v1-69 (the-as object (cdr v1-68)))
)
(when (and (< (the-as uint 1) s4-1) (< s4-1 (the-as uint 13)))
(if (nonzero? (-> (the-as symbol v1-69) value))
(set! (-> this texture-anim-array (+ s4-1 -2))
(clear! (the-as texture-anim-array (-> (the-as symbol v1-69) value)))
)
)
)
)
(set! s5-4 (cdr s5-4))
(set! v1-68 (car s5-4))
)
)
)
)
)
(set! (-> this bsp) #f)
(set! (-> this entity) #f)
(set! (-> this status) 'inactive)
(do-nothing *level*)
(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-83 4)
(set! (-> this user-object v1-83) #f)
)
(dotimes (v1-86 11)
(set! (-> this texture-anim-array v1-86) #f)
)
(countdown (s5-5 (-> this loaded-texture-page-count))
(dotimes (v1-89 32)
(when (= (-> this loaded-texture-page s5-5) (-> *texture-pool* common-page v1-89))
(set! (-> *texture-pool* common-page v1-89) (the-as texture-page 0))
0
)
)
(unload-page *texture-pool* (-> this loaded-texture-page s5-5))
)
(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-6 2)
(let ((v1-103 (-> *art-control* buffer s5-6 pending-load-file)))
(if (and (>= (the-as int v1-103) (the-as int (-> this heap base)))
(< (the-as int v1-103) (the-as int (-> this heap top-base)))
)
(set-pending-file (-> *art-control* buffer s5-6) (the-as string #f) -1 (the-as handle #f) 100000000.0)
)
)
)
(let ((v1-112 0)
(a0-79 0)
(a1-27 (-> this level-type))
)
(while a1-27
(+! a0-79 1)
(+! v1-112 (-> a1-27 psize))
(set! (-> a1-27 symbol value) (the-as object 0))
(set! a1-27 (the-as type (-> a1-27 method-table 8)))
)
)
(let* ((s5-7 (-> this info packages))
(a0-80 (car s5-7))
)
(while (not (null? s5-7))
(case (rtype-of a0-80)
((symbol)
(unload (symbol->string (the-as symbol a0-80)))
)
((string)
(unload (the-as string a0-80))
)
)
(set! s5-7 (cdr s5-7))
(set! a0-80 (car s5-7))
)
)
(vis-clear this)
(let ((v1-127 (-> this heap)))
(set! (-> v1-127 current) (-> v1-127 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* level-default))
(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-bsp? ((this level))
"Check if the camera is inside the BSP for this level."
(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))
(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) (usage memory-usage-block) (flags int))
(when (= (-> this status) 'active)
(set! (-> usage length) (max 68 (-> usage length)))
(set! (-> usage data 67 name) "entity-links")
(+! (-> usage data 67 count) (-> this entity length))
(let ((v1-8 (asize-of (-> this entity))))
(+! (-> usage data 67 used) v1-8)
(+! (-> usage data 67 total) (logand -16 (+ v1-8 15)))
)
(mem-usage (-> this art-group) usage flags)
(set! (-> usage length) (max 67 (-> usage length)))
(set! (-> usage data 66 name) "level-code")
(+! (-> usage data 66 count) 1)
(let ((v1-20 (&- (-> this code-memory-end) (the-as uint (-> this code-memory-start)))))
(+! (-> usage data 66 used) v1-20)
(+! (-> usage data 66 total) (logand -16 (+ v1-20 15)))
)
(countdown (s3-0 (-> this loaded-texture-page-count))
(mem-usage (-> this loaded-texture-page s3-0) usage flags)
)
(countdown (s3-1 (-> this loaded-text-info-count))
(mem-usage (-> this loaded-text-info s3-1) usage flags)
)
(countdown (s3-2 8)
(let ((s2-0 (-> this vis-info s3-2)))
(when s2-0
(cond
((zero? s3-2)
(set! (-> usage length) (max 63 (-> usage length)))
(set! (-> usage data 62 name) "bsp-leaf-vis-self")
(+! (-> usage data 62 count) 1)
(let ((v1-47 (+ (asize-of s2-0) (-> s2-0 allocated-length))))
(+! (-> usage data 62 used) v1-47)
(+! (-> usage data 62 total) (logand -16 (+ v1-47 15)))
)
)
(else
(set! (-> usage length) (max 64 (-> usage length)))
(set! (-> usage data 63 name) "bsp-leaf-vis-adj")
(+! (-> usage data 63 count) 1)
(let ((v1-58 (+ (asize-of s2-0) (-> s2-0 allocated-length))))
(+! (-> usage data 63 used) v1-58)
(+! (-> usage data 63 total) (logand -16 (+ v1-58 15)))
)
)
)
)
)
)
(mem-usage (-> this bsp) usage flags)
)
this
)
(defmethod init-level-system ((this level-group) (arg0 symbol))
"If needed, initialize the level system by loading common/art packages and allocating level heaps."
(when (zero? (-> *level* heap base))
(kmemopen global "level-heaps")
(when (nmember "game" *kernel-packages*)
(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 the first level with the given status, #f if there are none."
(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 inside this level-group that should
be used to load a new level."
(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))
"Lookup loaded level by name."
(when arg0
(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 level)))
"Check all levels for an art group with the given name."
(countdown (s4-0 11)
(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) s3-0)
)
(return (-> s3-0 art-group art-group-array s2-0))
)
)
)
)
)
(the-as art-group #f)
)
(defmethod activate-levels! ((this level-group))
"Make all levels '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 the player is 'in'."
(let ((s5-0 (target-pos 0)))
(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 (and (= (-> a1-3 name) v1-1) (not (logtest? (-> a1-3 info level-flags) (level-flags not-physical))))
(return a1-3)
)
)
)
)
)
)
(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 (and (= (-> a1-8 name) v1-5) (not (logtest? (-> a1-8 info level-flags) (level-flags not-physical))))
(return a1-8)
)
)
)
)
)
(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?)
(not (logtest? (-> s2-0 info level-flags) (level-flags not-physical)))
(or (not s4-0) (< f0-0 f30-0))
)
(set! s4-0 s2-0)
)
)
)
)
)
)
(if s4-0
(return s4-0)
)
)
)
(dotimes (v1-26 (-> this length))
(let ((a0-11 (-> this level v1-26)))
(when (= (-> a0-11 status) 'active)
(if (and (-> a0-11 meta-inside?) (not (logtest? (-> a0-11 info level-flags) (level-flags not-physical))))
(return a0-11)
)
)
)
)
(let ((v0-1 (the-as level #f)))
0.0
(dotimes (v1-29 (-> this length))
(let ((a0-16 (-> this level v1-29)))
(when (= (-> a0-16 status) 'active)
(if (and (not v0-1) (not (logtest? (-> a0-16 info level-flags) (level-flags not-physical))))
(set! v0-1 a0-16)
)
)
)
)
v0-1
)
)
(defmethod mem-usage ((this level-group) (usage memory-usage-block) (flags int))
(dotimes (s3-0 (-> this length))
(mem-usage (-> this level s3-0) usage flags)
)
this
)
(defun bg ((arg0 symbol))
"Debug function to start playing a given level."
(set! *cheat-mode* (if *debug-segment*
'debug
#f
)
)
(let ((v1-2 (lookup-level-info arg0)))
(cond
((= (-> v1-2 visname) arg0)
(set! (-> *level* vis?) #t)
(set! arg0 (-> v1-2 name))
)
(else
(set! (-> *level* vis?) #f)
(set! (-> *kernel-context* low-memory-message) #f)
)
)
(let ((a0-8 (-> v1-2 memory-mode)))
(if (or (= a0-8 (level-memory-mode borrow)) (or (= a0-8 (level-memory-mode borrow0))
(= a0-8 (level-memory-mode borrow1))
(= a0-8 (level-memory-mode borrow2))
(= a0-8 (level-memory-mode borrow3))
(= a0-8 (level-memory-mode borrow4))
(= a0-8 (level-memory-mode borrow-city-small))
)
)
(set! (-> v1-2 memory-mode) (level-memory-mode small-edge))
)
)
(let* ((s5-0 (-> v1-2 run-packages))
(a0-12 (car s5-0))
)
(while (not (null? s5-0))
(case (rtype-of a0-12)
((symbol)
(load-package (symbol->string (the-as symbol a0-12)) global)
)
((string)
(load-package (the-as string a0-12) global)
)
)
(set! s5-0 (cdr s5-0))
(set! a0-12 (car s5-0))
)
)
)
(let ((s5-1 (level-get-for-use *level* arg0 'active)))
(while (and s5-1
(or (= (-> s5-1 status) 'loading) (= (-> s5-1 status) 'loading-bt) (= (-> s5-1 status) 'login))
(not *dproc*)
)
(load-continue s5-1)
)
(reset! *load-state*)
(set! (-> *load-state* vis-nick) (-> s5-1 name))
(set! (-> *load-state* want 0 name) (-> s5-1 name))
(set! (-> *load-state* want 0 display?) 'display)
(if (-> s5-1 info continues)
(set-continue! *game-info* (the-as basic (car (-> s5-1 info continues))) #f)
)
)
(dotimes (v1-35 3)
(set! (-> *load-state* want-sound v1-35 name) (-> *game-info* current-continue want-sound v1-35))
(set! (-> *load-state* want-sound v1-35 mode) (sound-bank-mode unknown))
)
(add-borrow-levels *load-state*)
(activate-levels! *level*)
(set! *print-login* #f)
(cond
((= arg0 'halfpipe)
(send-event (ppointer->process *time-of-day*) 'change 'ratio 0.0)
(send-event (ppointer->process *time-of-day*) 'change 'hour 14)
(set! (-> *time-of-day-context* mode) (time-of-day-palette-id unk0 unk1))
)
(else
(set! (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
)
)
0
(none)
)
(defconstant *default-boot-level* 'wasall)
(defmacro play-desert ()
`(start 'play (get-continue-by-name *game-info* "desert-start"))
)
(defmacro play-was ()
`(start 'play (get-continue-by-name *game-info* "wascitya-start"))
)
(defun play ((arg0 symbol) (arg1 symbol))
"Start (or restart) the game!
This will start up the display process, and load the initial level."
(kmemopen global "level-boot")
(when *kernel-boot-level*
(bg (string->symbol (the-as string *kernel-boot-level*)))
(on #f)
(kmemclose)
(kmemclose)
(return 0)
)
*kernel-boot-message*
(let ((s5-0 (if *debug-segment*
*default-boot-level*
'title
)
)
)
(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)
(init-level-system *level* #t)
(set! *display-profile* #f)
(set! *cheat-mode* (if *debug-segment*
'debug
#f
)
)
(set! *time-of-day-fast* #f)
;; added nonzero check here.
(when (nonzero? *time-of-day*)
(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-9 (new 'stack-no-clear 'array 'symbol 10)))
(set! (-> a1-9 9) #f)
(set! (-> a1-9 8) #f)
(set! (-> a1-9 7) #f)
(set! (-> a1-9 6) #f)
(set! (-> a1-9 5) #f)
(set! (-> a1-9 4) #f)
(set! (-> a1-9 3) #f)
(set! (-> a1-9 2) #f)
(set! (-> a1-9 1) (if (= s5-0 'ctysluma)
'ctywide
)
)
(set! (-> a1-9 0) s5-0)
(want-levels *load-state* a1-9)
)
(want-display-level *load-state* s5-0 'display)
(if (= s5-0 'ctysluma)
(want-display-level *load-state* 'ctywide 'display)
)
(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)
)
(on #t)
(if arg1
(initialize! *game-info* 'boot (the-as game-save #f) (the-as string #f) (the-as resetter-spec #f))
)
(kmemclose)
(kmemclose)
0
)
(defun play-boot ()
"Function called by the C Kernel to start the game (wrapper around play)."
(start-debug "call to play-boot!~%")
(process-spawn-function
process
(lambda () (play #t #t) (none))
:from *4k-dead-pool*
:stack *kernel-dram-stack*
)
0
(none)
)
;; WARN: Return type mismatch int vs sound-bank-mode.
(defun sound-bank-name->mode ((arg0 symbol))
(let ((v1-0 arg0))
(the-as sound-bank-mode (cond
((or (= v1-0 'half1)
(= v1-0 'half2)
(= v1-0 'ctyslmch)
(= v1-0 'ctyslmbh)
(= v1-0 'ctygnbh)
(= v1-0 'ctyindh)
(= v1-0 'ctyslmah)
(= v1-0 'ctyporth)
(= v1-0 'mhcity1h)
(= v1-0 'mhcity2h)
(= v1-0 'citypedh)
(= v1-0 'cityffh)
(= v1-0 'citycarh)
(= v1-0 'vinroomh)
(= v1-0 'ctyprtdh)
(= v1-0 'citybbh)
)
5
)
((= v1-0 'ctywide)
9
)
(else
4
)
)
)
)
)
;; WARN: Function update-sound-banks has a return type of none, but the expression builder found a return statement.
(defun update-sound-banks ((arg0 load-state) (arg1 (inline-array sound-bank-state)))
(local-vars (v1-90 symbol))
(let ((s4-0 0)
(s5-0 (the-as object #f))
)
(dotimes (v1-1 6)
(set! (-> arg0 want-exp-sound v1-1 name) #f)
(set! (-> arg0 want-exp-sound v1-1 mode) (sound-bank-mode none))
(set! (-> arg0 target-sound v1-1 name) #f)
(set! (-> arg0 target-sound v1-1 mode) (sound-bank-mode none))
)
(dotimes (s3-0 3)
(let ((a0-10 (the-as object (-> *load-state* want-sound s3-0 name))))
(dotimes (v1-6 (-> *level* length))
(let ((a1-4 (-> *level* level v1-6)))
(when (= (-> a1-4 status) 'active)
(let ((a1-6 (-> a1-4 info extra-sound-bank)))
(when a1-6
(let ((a2-4 (car a1-6)))
(while (not (null? a1-6))
(if (= (car a2-4) a0-10)
(set! a0-10 (cdr a2-4))
)
(set! a1-6 (cdr a1-6))
(set! a2-4 (car a1-6))
)
)
)
)
)
)
)
(dotimes (v1-9 (the-as int (-> *setting-control* user-current extra-bank-count)))
(let ((a1-13 (and (not (null? (-> *setting-control* user-current extra-bank v1-9)))
(-> *setting-control* user-current extra-bank v1-9)
)
)
)
(when a1-13
(let ((a2-12 (car a1-13)))
(while (not (null? a1-13))
(cond
((and (= s3-0 2) (= (car a2-12) 'force2))
(set! s5-0 (car (cdr a2-12)))
)
((= (car a2-12) a0-10)
(set! a0-10 (cdr a2-12))
)
)
(set! a1-13 (cdr a1-13))
(set! a2-12 (car (the-as pair a1-13)))
)
)
)
)
)
(case (rtype-of a0-10)
((symbol)
(when a0-10
(set! (-> arg0 want-exp-sound s4-0 name) (the-as symbol a0-10))
(set! (-> arg0 want-exp-sound s4-0 mode) (sound-bank-name->mode (the-as symbol a0-10)))
(+! s4-0 1)
)
)
((pair)
(let* ((s2-0 (the-as pair a0-10))
(a0-11 (car s2-0))
)
(while (not (null? s2-0))
(when a0-11
(set! (-> arg0 want-exp-sound s4-0 name) (the-as symbol a0-11))
(set! (-> arg0 want-exp-sound s4-0 mode) (sound-bank-name->mode (the-as symbol a0-11)))
(+! s4-0 1)
)
(set! s2-0 (cdr s2-0))
(set! a0-11 (car s2-0))
)
)
)
)
)
)
(if (= *city-mode* 'ctywide)
(city-sound-expand-want-list)
)
(when s5-0
(cond
((-> arg0 want-exp-sound 1)
(set! (-> arg0 want-exp-sound 2 name) (the-as symbol s5-0))
(set! (-> arg0 want-exp-sound 2 mode) (sound-bank-name->mode (the-as symbol s5-0)))
)
((-> arg0 want-exp-sound)
(set! (-> arg0 want-exp-sound 1 name) (the-as symbol s5-0))
(set! (-> arg0 want-exp-sound 1 mode) (sound-bank-name->mode (the-as symbol s5-0)))
)
(else
(set! (-> arg0 want-exp-sound 0 name) (the-as symbol s5-0))
(set! (-> arg0 want-exp-sound 0 mode) (sound-bank-name->mode (the-as symbol s5-0)))
)
)
)
)
(let ((s4-1 0)
(s3-1 0)
(s2-1 0)
(s1-0 0)
(s5-1 (new 'stack-no-clear 'array 'int8 36))
)
(dotimes (v1-43 10)
(set! (-> s5-1 v1-43) 0)
)
(dotimes (s0-0 6)
(case (-> arg0 want-exp-sound s0-0 mode)
(((sound-bank-mode virtual))
)
(((sound-bank-mode full))
(if (>= s2-1 3)
(goto cfg-80)
)
(+! s2-1 1)
(+! s3-1 1)
(mem-copy! (the-as pointer (-> arg0 target-sound s1-0)) (the-as pointer (-> arg0 want-exp-sound s0-0)) 8)
(+! s1-0 1)
)
(((sound-bank-mode half))
(cond
((even? s4-1)
(if (>= s2-1 3)
(goto cfg-80)
)
(+! s2-1 1)
(mem-copy! (the-as pointer (-> arg0 target-sound s1-0)) (the-as pointer (-> arg0 want-exp-sound s0-0)) 8)
)
(else
(mem-copy! (the-as pointer (-> arg0 target-sound s1-0)) (the-as pointer (-> arg0 want-exp-sound s0-0)) 8)
)
)
(set! (-> arg0 target-sound s1-0 mode) (sound-bank-mode half))
(+! s4-1 1)
(+! s1-0 1)
)
)
(label cfg-80)
)
(let ((v1-76 0))
(dotimes (a0-28 6)
(case (-> arg0 target-sound a0-28 mode)
(((sound-bank-mode half))
(dotimes (a1-32 6)
(when (= (-> *level* sound-bank a1-32 name) (-> arg0 target-sound a0-28 name))
(let ((a2-26 (-> *level* sound-bank a1-32 mode)))
(when (and (>= (the-as uint a2-26) (the-as uint 6))
(>= (the-as uint 8) (the-as uint a2-26))
(not (and (nonzero? s3-1)
(= (+ v1-76 1) s4-1)
(< 1 s4-1)
(zero? (-> s5-1 a2-26))
(or (= (-> s5-1 6) 1) (= (-> s5-1 7) 1) (= (-> s5-1 8) 1))
)
)
)
(set! (-> arg0 target-sound a0-28 mode) (-> *level* sound-bank a1-32 mode))
(+! (-> s5-1 a2-26) 1)
(+! v1-76 1)
)
)
(goto cfg-112)
)
)
)
)
(label cfg-112)
)
)
(dotimes (v1-79 6)
(case (-> arg0 target-sound v1-79 mode)
(((sound-bank-mode half))
(cond
((= (-> s5-1 6) 1)
(+! (-> s5-1 6) 1)
(set! (-> arg0 target-sound v1-79 mode) (sound-bank-mode halfa))
)
((= (-> s5-1 7) 1)
(+! (-> s5-1 7) 1)
(set! (-> arg0 target-sound v1-79 mode) (sound-bank-mode halfb))
)
((= (-> s5-1 8) 1)
(+! (-> s5-1 8) 1)
(set! (-> arg0 target-sound v1-79 mode) (sound-bank-mode halfc))
)
((zero? (-> s5-1 6))
(+! (-> s5-1 6) 1)
(set! (-> arg0 target-sound v1-79 mode) (sound-bank-mode halfa))
)
((zero? (-> s5-1 7))
(+! (-> s5-1 7) 1)
(set! (-> arg0 target-sound v1-79 mode) (sound-bank-mode halfb))
)
((zero? (-> s5-1 8))
(+! (-> s5-1 8) 1)
(set! (-> arg0 target-sound v1-79 mode) (sound-bank-mode halfc))
)
)
)
)
)
)
(if (or (nonzero? (rpc-busy? 1)) (not (-> *setting-control* user-current sound-bank-load)))
(return 0)
)
(dotimes (s4-2 6)
(let ((s5-2 (-> arg0 target-sound s4-2))
(s2-2
(lambda ((arg0 load-state) (arg1 sound-bank-state))
(if (not (-> arg1 name))
(return #f)
)
(countdown (v1-3 6)
(if (and (= (-> arg1 name) (-> arg0 target-sound v1-3 name)) (= (-> arg1 mode) (-> arg0 target-sound v1-3 mode)))
(return #t)
)
)
#f
)
)
)
(set! v1-90 (and (-> s5-2 name) (begin
(dotimes (v1-91 6)
(when (and (= (-> s5-2 name) (-> *level* sound-bank v1-91 name))
(= (-> s5-2 mode) (-> *level* sound-bank v1-91 mode))
)
(set! v1-90 #f)
(goto cfg-150)
)
)
#t
)
)
)
(label cfg-150)
(when v1-90
(let ((s3-2 -1))
(let ((v1-94 -1))
(case (-> s5-2 mode)
(((sound-bank-mode full))
)
(else
(dotimes (a0-70 3)
(if (or (= (-> *level* sound-bank (* a0-70 2) mode) (-> s5-2 mode))
(= (-> *level* sound-bank (+ (* a0-70 2) 1) mode) (-> s5-2 mode))
)
(set! v1-94 a0-70)
)
)
)
)
(dotimes (a0-73 3)
(case (-> s5-2 mode)
(((sound-bank-mode full))
(when (and (not (-> *level* sound-bank (* a0-73 2) name)) (not (-> *level* sound-bank (+ (* a0-73 2) 1) name)))
(set! s3-2 (* a0-73 2))
(goto cfg-224)
)
)
(else
(when (or (< v1-94 0) (= v1-94 a0-73))
(when (and (not (-> *level* sound-bank (* a0-73 2) name))
(or (not (-> *level* sound-bank (+ (* a0-73 2) 1) name))
(= (-> *level* sound-bank (+ (* a0-73 2) 1) mode) (-> s5-2 mode))
)
)
(set! s3-2 (* a0-73 2))
(goto cfg-224)
)
(when (and (not (-> *level* sound-bank (+ (* a0-73 2) 1) name))
(= (-> *level* sound-bank (* a0-73 2) mode) (-> s5-2 mode))
)
(set! s3-2 (+ (* a0-73 2) 1))
(goto cfg-224)
)
)
)
)
)
)
(case (-> s5-2 mode)
(((sound-bank-mode full))
)
(else
(let ((s1-1 0))
(while (< s1-1 6)
(when (or (and (-> *level* sound-bank s1-1 name)
(= (-> *level* sound-bank s1-1 mode) (-> s5-2 mode))
(not (s2-2 arg0 (-> *level* sound-bank s1-1)))
)
(= (-> *level* sound-bank s1-1 name) (-> s5-2 name))
)
(format 0 "Unload soundbank ~A from slot ~D~%" (-> *level* sound-bank s1-1 name) s1-1)
(sound-bank-unload (string->sound-name (symbol->string (-> *level* sound-bank s1-1 name))))
(set! (-> *level* sound-bank s1-1 name) #f)
(set! (-> *level* sound-bank s1-1 mode) (sound-bank-mode none))
(return 0)
)
(set! s1-1 (+ s1-1 1))
)
)
)
)
(dotimes (s1-2 3)
(when (and (not (s2-2 arg0 (-> *level* sound-bank (* s1-2 2))))
(not (s2-2 arg0 (-> *level* sound-bank (+ (* s1-2 2) 1))))
)
(let ((gp-2 (if (-> *level* sound-bank (* s1-2 2) name)
(* s1-2 2)
(+ (* s1-2 2) 1)
)
)
)
(format 0 "Unload soundbank ~A from slot ~D~%" (-> *level* sound-bank gp-2 name) gp-2)
(sound-bank-unload (string->sound-name (symbol->string (-> *level* sound-bank gp-2 name))))
(set! (-> *level* sound-bank gp-2 name) #f)
(set! (-> *level* sound-bank gp-2 mode) (sound-bank-mode none))
)
(return 0)
)
)
(label cfg-224)
(let ((s2-3 0))
(while (< s2-3 6)
(when (= (-> *level* sound-bank s2-3 name) (-> s5-2 name))
(format 0 "Unload soundbank ~A from slot ~D~%" (-> *level* sound-bank s2-3 name) s2-3)
(sound-bank-unload (string->sound-name (symbol->string (-> *level* sound-bank s2-3 name))))
(set! (-> *level* sound-bank s2-3 name) #f)
(set! (-> *level* sound-bank s2-3 mode) (sound-bank-mode none))
(return 0)
)
(set! s2-3 (+ s2-3 1))
)
)
(when (>= s3-2 0)
(format 0 "Load soundbank ~A in slot ~D~%" (-> s5-2 name) s3-2)
(sound-bank-load (string->sound-name (symbol->string (-> s5-2 name))) (the-as int (-> s5-2 mode)) 0)
(mem-copy! (the-as pointer (-> *level* sound-bank s3-2)) (the-as pointer s5-2) 8)
(return 0)
)
)
)
)
)
0
(none)
)
(defmethod update! ((this load-state))
(local-vars (a0-11 symbol))
(if (-> this update-callback)
((-> this update-callback) this)
)
(let ((v1-3 #f))
(let ((s5-0 0))
-1
(countdown (s4-0 10)
(let ((a0-3 -1))
(countdown (a1-0 10)
(let ((a2-3 (-> *level* level a1-0)))
(when (and (!= (-> a2-3 status) 'inactive) (>= (-> a2-3 load-order) (the-as uint s5-0)))
(let ((a3-5 #f))
(dotimes (t0-2 10)
(if (= (-> a2-3 name) (-> this target t0-2 name))
(set! a3-5 #t)
)
)
(when (not a3-5)
(set! s5-0 (the-as int (-> a2-3 load-order)))
(set! a0-3 a1-0)
)
)
)
)
)
;; 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 (>= a0-3 0)
(format 0 " level loading : want to unload ~A. load-level is ~A~%" (-> *level* level a0-3 load-name) (-> *level* load-level))
(when (or (!= (-> *level* level a0-3 load-name) (-> *level* load-level))
(< 1 (- (-> *display* real-clock integral-frame-counter) *dgo-time*)))
(let ((lev-to-unload (-> *level* level a0-3)))
(format 0 "Discarding level ~A~%" (-> lev-to-unload name))
(level-status-update! lev-to-unload 'inactive) ;; kill it.
)
)
(set! v1-3 #t)
)
)
)
)
(let ((s5-1 #f))
(countdown (a0-10 10)
(when (!= (-> *level* level a0-10 status) 'inactive)
(set! a0-11 #f)
(goto cfg-25)
)
)
(set! a0-11 #t)
(label cfg-25)
(if a0-11
(set! s5-1 #t)
)
(if v1-3
(return 0)
)
(let ((v1-11 (new 'static 'boxed-array :type symbol :length 0 :allocated-length 10)))
(countdown (a0-15 10)
(set! (-> v1-11 a0-15) #f)
)
(dotimes (a0-18 10)
(when (-> this target a0-18 name)
(set! (-> v1-11 a0-18) (-> this target a0-18 name))
(dotimes (a1-17 10)
(let ((a2-13 (-> *level* level a1-17)))
(if (and (!= (-> a2-13 status) 'inactive) (= (-> a2-13 name) (-> this target a0-18 name)))
(set! (-> v1-11 a0-18) #f)
)
)
)
)
)
(let ((s4-1 -1))
(dotimes (a0-21 10)
(when (-> v1-11 a0-21)
(set! s4-1 a0-21)
(goto cfg-53)
)
)
(label cfg-53)
(when (!= s4-1 -1)
(when (and (or s5-1 (not (check-busy *load-dgo-rpc*))) (not (load-in-progress? *level*)))
(format 0 "Adding level ~A~%" (-> this target s4-1 name))
(let ((s3-1 (level-get-for-use *level* (-> this target s4-1 name) 'loaded)))
(when (and s5-1 (-> this target s4-1 display?))
(format 0 "Waiting for level to load~%")
(while (or (= (-> s3-1 status) 'loading) (= (-> s3-1 status) 'loading-bt) (= (-> s3-1 status) 'login))
(load-continue s3-1)
)
)
)
)
)
)
)
)
)
(dotimes (s5-2 10)
(when (-> this target s5-2 name)
(dotimes (s4-2 11)
(let ((s3-2 (-> *level* level s4-2)))
(when (!= (-> s3-2 status) 'inactive)
(when (= (-> s3-2 name) (-> this target s5-2 name))
(when (!= (-> s3-2 display?) (-> this target s5-2 display?))
(cond
((not (-> s3-2 display?))
(cond
((or (= (-> s3-2 status) 'loaded) (= (-> s3-2 status) 'active))
(format 0 "Displaying level ~A [~A]~%" (-> this target s5-2 name) (-> this target s5-2 display?))
(level-get-for-use *level* (-> s3-2 info name) 'active)
(set! (-> s3-2 display?) (-> this target s5-2 display?))
)
(else
(if (and (logtest? (-> s3-2 info level-flags) (level-flags display-wait))
(!= (-> this target s5-2 display?) 'display-no-wait)
)
(send-event *target* 'loading)
)
(if (and (= *cheat-mode* 'debug) (not *display-capture-mode*))
(format *stdcon* "display on for ~A but level is loading~%" (-> this target s5-2 name))
)
)
)
)
((not (-> this target s5-2 display?))
(set! (-> s3-2 display?) #f)
(format 0 "Turning level ~A off~%" (-> s3-2 name))
(deactivate s3-2)
)
(else
(format
0
"Setting level ~A display command to ~A~%"
(-> this target s5-2 name)
(-> this target s5-2 display?)
)
(set! (-> s3-2 display?) (-> this target s5-2 display?))
)
)
)
(when (!= (-> s3-2 force-all-visible?) (-> this target s5-2 force-vis?))
(set! (-> s3-2 force-all-visible?) (-> this target s5-2 force-vis?))
(format
0
"Setting force-all-visible?[~A] to ~A~%"
(-> this target s5-2 name)
(-> this target s5-2 force-vis?)
)
)
(when (!= (-> s3-2 force-inside?) (-> this target s5-2 force-inside?))
(format
0
"Setting force-inside?[~A] ~A->~A~%"
(-> this target s5-2 name)
(-> s3-2 force-inside?)
(-> this target s5-2 force-inside?)
)
(set! (-> s3-2 force-inside?) (-> this target s5-2 force-inside?))
)
)
)
)
)
)
)
(when (-> *level* border?)
(let ((v1-131 (the-as level #f))
(a0-55 0)
)
(dotimes (a1-35 (-> *level* length))
(let ((a2-32 (-> *level* level a1-35)))
(when (= (-> a2-32 status) 'active)
(when (and (-> a2-32 inside-boxes?) (not (null? (-> a2-32 info continues))))
(if (= (-> a2-32 name) (-> this vis-nick))
(goto cfg-137)
)
(if (or (not v1-131) (not (logtest? (-> a2-32 info level-flags) (level-flags not-physical))))
(set! v1-131 a2-32)
)
(+! a0-55 1)
)
)
)
)
(if (and (>= a0-55 1) (!= (-> v1-131 name) (-> this vis-nick)))
(want-vis-level this (-> v1-131 name))
)
)
)
(label cfg-137)
(update-sound-banks this (-> *level* sound-bank))
0
)
(defmethod assign-draw-indices ((this level-group))
"Assign the order for levels to be drawn."
(local-vars (t0-3 symbol))
(set! (-> this draw-level-count) 0)
(dotimes (v1-0 11)
(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) 11)
(set! (-> this draw-level (-> this draw-level-count)) #f)
(+! (-> this draw-level-count) 1)
)
(set! (-> this draw-level 10) (-> this level-default))
(set! (-> (&-> this level-default draw-index) 0) 10)
(dotimes (v1-13 11)
(let ((a2-9 (-> this level v1-13)))
(if a2-9
(set! (-> this draw-index-map v1-13) (the-as uint (-> a2-9 draw-index)))
)
)
)
0
(none)
)
(defmethod level-update ((this level-group))
"Per-frame update of the level system."
(local-vars (v1-109 symbol))
(camera-pos)
(new 'static 'boxed-array :type symbol :length 0 :allocated-length 10)
(update *setting-control*)
(update *gui-control* #t)
(update *art-control* #t)
(clear-rec *art-control*)
(dotimes (s5-0 10)
(load-continue (-> this level s5-0))
)
(dotimes (s5-1 (-> this length))
(let ((s4-0 (-> this level s5-1)))
(when (= (-> s4-0 status) 'active)
(let* ((a0-7 s4-0)
(t9-6 (method-of-object a0-7 inside-bsp?))
)
(-> *math-camera* trans)
(set! (-> s4-0 inside-boxes?) (the-as basic (t9-6 a0-7)))
)
(if (-> s4-0 inside-boxes?)
(set! (-> s4-0 meta-inside?) #t)
)
)
)
)
(update! *load-state*)
(let ((s5-2 (level-get-target-inside this)))
(dotimes (s4-1 (-> this length))
(let ((s3-0 (-> this level s4-1)))
(when (= (-> s3-0 status) 'active)
(when (-> s3-0 inside-boxes?)
(dotimes (v1-41 (-> this length))
(let ((a0-14 (-> this level v1-41)))
(when (= (-> a0-14 status) 'active)
(if (and (!= s3-0 a0-14) (not (-> a0-14 inside-boxes?)))
(set! (-> a0-14 meta-inside?) #f)
)
)
)
)
)
(when (and (= s3-0 s5-2)
(begin
(set! (-> *setting-control* user-default music) (-> s3-0 info music-bank))
(set! (-> *setting-control* user-default sound-reverb) (-> s3-0 info sound-reverb))
#t
)
(or (-> *level* border?) (logtest? (-> *game-info* current-continue flags) (continue-flags change-continue)))
(and (or (and (!= (-> s3-0 name) (-> *game-info* current-continue level))
(or (not (logtest? (level-flags check-taskname-for-continue) (-> s3-0 info level-flags)))
(!= (-> s3-0 info taskname) (-> (lookup-level-info (-> *game-info* current-continue level)) taskname))
)
)
(logtest? (-> *game-info* current-continue flags) (continue-flags change-continue))
)
(not (null? (-> s3-0 info continues)))
(-> *setting-control* user-current allow-continue)
)
)
(let ((s2-1 (car (-> s3-0 info continues))))
(let* ((s1-0 (target-pos 0))
(s3-1 (-> s3-0 info continues))
(s0-0 (car s3-1))
)
(while (not (null? s3-1))
(when (and (or (< (vector-vector-distance s1-0 (-> (the-as continue-point s0-0) trans))
(vector-vector-distance s1-0 (-> (the-as continue-point s2-1) trans))
)
(string= (-> *game-info* current-continue name) (-> (the-as continue-point s0-0) name))
)
(not (logtest? (-> (the-as continue-point s0-0) flags) (continue-flags change-continue no-auto)))
)
(set! s2-1 s0-0)
(if (string= (-> *game-info* current-continue name) (-> (the-as continue-point s0-0) name))
(goto cfg-62)
)
)
(set! s3-1 (cdr s3-1))
(set! s0-0 (car s3-1))
)
)
(label cfg-62)
(if (and s2-1 (not (logtest? (-> (the-as continue-point s2-1) flags) (continue-flags change-continue no-auto))))
(set-continue! *game-info* (the-as basic s2-1) #f)
)
)
)
)
)
)
)
(dotimes (v1-94 (-> this length))
(let ((a0-48 (-> this level v1-94)))
(when (= (-> a0-48 status) 'active)
(set! (-> a0-48 vis-self-index) 0)
0
)
)
)
(when (and (not *display-capture-mode*) (= *cheat-mode* 'debug))
(dotimes (s5-3 (-> this length))
(let ((v1-104 (-> this level s5-3)))
(when (= (-> v1-104 status) 'active)
(if (and (= (-> v1-104 status) 'active)
(!= (-> v1-104 display?) 'special)
(nonzero? (-> v1-104 bsp cam-outside-bsp))
)
(format *stdcon* "~3Loutside of bsp ~S~%~0L" (-> v1-104 name))
)
)
)
)
)
(countdown (v1-108 10)
(when (-> this level v1-108 inside-boxes?)
(set! v1-109 #f)
(goto cfg-96)
)
)
(set! v1-109 #t)
(label cfg-96)
(cond
(v1-109
0
)
(else
(dotimes (s5-4 (-> this length))
(let ((s4-2 (-> this level s5-4)))
(when (= (-> s4-2 status) 'active)
(dotimes (s3-2 8)
(let ((s2-2 (-> s4-2 vis-info s3-2)))
(when s2-2
(set! (-> s2-2 flags) (the-as vis-info-flag (logclear (-> s2-2 flags) (vis-info-flag vis-valid))))
(cond
((= s3-2 (-> s4-2 vis-self-index))
(set! (-> s2-2 from-bsp) (-> s4-2 bsp))
)
(else
(let ((v1-123 (level-get this (-> s2-2 from-level))))
(set! (-> s2-2 from-bsp) (if v1-123
(-> v1-123 bsp)
)
)
)
)
)
)
)
)
(let ((v1-126 #f))
(cond
((= (-> s4-2 display?) 'display-self)
(let ((v1-130 (-> s4-2 vis-info (-> s4-2 vis-self-index))))
(if v1-130
(set! (-> v1-130 flags) (the-as vis-info-flag (logior (vis-info-flag vis-valid) (-> v1-130 flags))))
)
)
)
((and (-> s4-2 inside-boxes?) (not v1-126))
(let ((v1-135 (-> s4-2 vis-info (-> s4-2 vis-self-index))))
(if v1-135
(set! (-> v1-135 flags) (the-as vis-info-flag (logior (vis-info-flag vis-valid) (-> v1-135 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-20 format)
(a0-86 *stdcon*)
(a1-30 " nick ~A cur ~S cont ~A~%~%")
(a2-6 (-> *load-state* vis-nick))
(v1-156 (and *target* (-> *target* current-level) (-> *target* current-level name)))
)
(t9-20
a0-86
a1-30
a2-6
(if v1-156
v1-156
)
(-> *game-info* current-continue name)
)
)
)
(dotimes (s5-5 11)
(let ((s4-3 (-> this level s5-5)))
(when (or (= (-> s4-3 status) 'active) (= (-> s4-3 status) 'reserved))
(format
*stdcon*
"~A: ~S ~A~%"
(-> s4-3 name)
(if (-> s4-3 inside-boxes?)
"inside"
)
(-> s4-3 display?)
)
(when *display-texture-distances*
(format *stdcon* "~10Htfrag: ~8,,0m" (-> s4-3 closest-object 0))
(format *stdcon* "~140Hshrub: ~8,,0m" (-> s4-3 closest-object 2))
(format *stdcon* "~272Halpha: ~8,,0m~%" (-> s4-3 closest-object 3))
(format *stdcon* "~27Htie: ~8,,0m" (-> s4-3 tie-min-dist))
(format *stdcon* "~140Hfg-tf: ~8,,0m" (-> s4-3 fg-tfrag-min-dist))
(format *stdcon* "~270Hfg-pr: ~8,,0m~%" (-> s4-3 fg-prim-min-dist))
(format *stdcon* "~10Hfg-wa: ~8,,0m" (-> s4-3 fg-warp-min-dist))
(format *stdcon* "~140Hfg-sh: ~8,,0m" (-> s4-3 fg-shrub-min-dist))
(format *stdcon* "~267Hfg-p2: ~8,,0m~%" (-> s4-3 fg-prim2-min-dist))
)
(when *display-texture-download*
(format
*stdcon*
"~30Htf: ~8D~134Hpr: ~8D~252Hsh: ~8D~370Hhd: ~8D~%"
(-> s4-3 upload-size 0)
(-> s4-3 upload-size 1)
(-> s4-3 upload-size 2)
(-> s4-3 upload-size 8)
)
(format
*stdcon*
"~30Hal: ~8D~131Hwa: ~8D~252Hsp: ~8D~370Hwp: ~8D~%"
(-> s4-3 upload-size 3)
(-> s4-3 upload-size 4)
(-> s4-3 upload-size 7)
(-> s4-3 upload-size 5)
)
(format *stdcon* "~30Hp2: ~8D~131Hhf: ~8D~%~1K" (-> s4-3 upload-size 6) (-> s4-3 upload-size 10))
)
(if *display-split-box-info*
(debug-print-region-splitbox s4-3 (-> *math-camera* trans) *stdcon*)
)
)
)
)
)
(when (and (-> this disk-load-timing?) (-> this load-level))
(let ((s5-6 format)
(s4-4 *stdcon*)
(s3-3 "~0Kload ~16S ~5S ~5DK ~5,,2fs ~5,,2fs~1K ~5,,0f k/s~%")
(s2-3 (-> this load-level))
(v1-188 (lookup-level-info (-> this load-level)))
)
(s5-6
s4-4
s3-3
s2-3
(if v1-188
(-> v1-188 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)))
)
)
)
)
(let ((v1-194 (- #x2000000 (the-as int (-> global current)))))
(if (and (not *debug-segment*) (or (< v1-194 #x4000) (= *cheat-mode* 'debug)))
(format
*stdcon*
"~3Lglobal heap fatally low at ~D.~DK free~%~0L"
(sar v1-194 10)
(/ (logand v1-194 1023) 103)
)
)
)
;; og:preserve-this added
(let ((lev-names (new 'stack-no-clear 'array 'string 10))
(active-lev-names (new 'stack-no-clear 'array 'string 10)))
(dotimes (i 10)
(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 9) #f)
(set! (-> s5-0 8) #f)
(set! (-> s5-0 7) #f)
(set! (-> s5-0 6) #f)
(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
(none)
)
(when (zero? (-> *level* level0 art-group))
(kmemopen global "level-struct")
(let ((gp-0 *level*))
(set! (-> gp-0 loading-level) (-> gp-0 level-default))
(dotimes (s5-0 10)
(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 level-default art-group) 0) (new 'global 'load-dir-art-group 512 (-> gp-0 level-default)))
(dotimes (v1-38 11)
(let ((a0-55 (-> gp-0 level v1-38)))
(dotimes (a1-50 11)
(set! (-> a0-55 texture-anim-array a1-50) #f)
(set! (-> a0-55 eye-slot-lowres a1-50) (the-as uint 0))
(set! (-> a0-55 eye-slot-highres a1-50) (the-as uint 0))
)
(set! (-> a0-55 borrow-from-level) #f)
(dotimes (a1-53 5)
(set! (-> a0-55 borrow-level a1-53) #f)
)
)
)
(set! (-> (&-> gp-0 level-default texture-anim-array 9) 0) *sky-texture-anim-array*)
(set! (-> (&-> gp-0 level-default texture-anim-array 1) 0) *darkjak-texture-anim-array*)
(set! (-> (&-> gp-0 level-default texture-anim-array 4) 0) *default-water-texture-anim-array*)
(set! (-> (&-> gp-0 level-default texture-anim-array 5) 0) *default-warp-texture-anim-array*)
(set! (-> (&-> gp-0 level-default draw-priority) 0) 20.0)
(set! (-> (&-> gp-0 level-default info) 0) default-level)
(set! (-> *kernel-context* login-level-index) (-> (&-> gp-0 level-default index) 0))
(set! *default-level* (-> gp-0 level-default))
)
(kmemclose)
)
Reference in a new issue View git blame Copy permalink