mirror of
https://github.com/open-goal/jak-project
synced 2026-08-06 18:03:30 -04:00
water111
1466 lines
75 KiB
Common Lisp
1466 lines
75 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/engine/engines.gc")
|
|
(require "engine/level/load-boundary.gc")
|
|
(require "engine/gfx/tie/tie-h.gc")
|
|
(require "engine/gfx/mood/mood-h.gc")
|
|
(require "engine/level/level-info.gc")
|
|
(require "engine/level/bsp.gc")
|
|
(require "engine/gfx/sprite/sparticle/sparticle.gc")
|
|
(require "engine/load/ramdisk.gc")
|
|
(require "engine/gfx/tfrag/tfrag.gc")
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;
|
|
;; level info/names
|
|
;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun lookup-level-info ((name symbol))
|
|
"Return the first level-load-info whose canonical name, VIS name, or nickname matches name.
|
|
Return default-level when no entry matches."
|
|
(let* ((rest *level-load-list*)
|
|
(current-sym (the symbol (car rest))))
|
|
(while (not (null? rest))
|
|
(let ((info (the level-load-info (-> current-sym value))))
|
|
(if (or (= name (-> info name)) (= name (-> info visname)) (= name (-> info nickname))) (return info)))
|
|
(set! rest (cdr rest))
|
|
(set! current-sym (the symbol (car rest)))))
|
|
default-level)
|
|
|
|
(defmethod load-command-get-index ((this level-group) (name symbol) (cmd-idx int))
|
|
"Return command-index from level-name's alternate load-command list."
|
|
(let ((cmd-lst (-> (lookup-level-info name) alt-load-commands)))
|
|
(while (nonzero? cmd-idx)
|
|
(+! cmd-idx -1)
|
|
(set! cmd-lst (cdr cmd-lst))
|
|
(nop!)
|
|
(nop!)
|
|
(nop!))
|
|
(the-as pair (car cmd-lst))))
|
|
|
|
(defun remap-level-name ((info level-load-info))
|
|
"Return info's VIS filename symbol when VIS mode is enabled, otherwise its canonical level
|
|
name."
|
|
(if (-> *level* vis?) (-> info visname) (-> info name)))
|
|
|
|
(defmethod art-group-get-by-name ((this level) (name string))
|
|
"Return this level's art group whose name matches name, or false."
|
|
(countdown (i (-> this art-group art-group-array length))
|
|
(if (name= (-> this art-group art-group-array i name) name) (return (-> this art-group art-group-array i))))
|
|
(the-as art-group #f))
|
|
|
|
(defmethod bsp-name ((this level))
|
|
"Return the loaded BSP name when available, otherwise return this level's requested name."
|
|
(if (and (!= (-> this status) 'inactive) (-> this bsp) (nonzero? (-> this bsp name))) (-> this bsp name) (-> this name)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; BSP
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; The "bsp" is the big data structure that contains the level geometry.
|
|
|
|
;; the background draw engine will use this function to draw an entire level's background.
|
|
;; The actual drawing is executed with (execute-connections *background-draw-engine* ...)
|
|
;; in drawable.gc
|
|
|
|
(defun add-bsp-drawable ((bsp-data bsp-header) (level-data level) (unused symbol) (display-frame-data display-frame))
|
|
"Draw a level BSP for the current display frame and optionally append its strip-line debug view."
|
|
;; do the draw
|
|
(draw bsp-data bsp-data display-frame-data)
|
|
(if (nonzero? *display-strip-lines*) (debug-draw bsp-data bsp-data display-frame-data))
|
|
(none))
|
|
|
|
(defmethod print ((this level))
|
|
"print a level."
|
|
(format #t "#<~A ~A ~S @ #x~X>" (-> this type) (-> this status) (-> this name) this)
|
|
this)
|
|
|
|
(defmethod relocate ((this bsp-header) (heap kheap) (name (pointer uint8)))
|
|
"Validate a newly linked BSP for the currently loading level, preserve the corrected title and
|
|
demo names, and connect the BSP and level to each other. Reject invalid types, versions, and
|
|
visibility lists longer than 2048 entries."
|
|
;; we expect that we'll have a loading-level set when we link/login a bsp-header
|
|
(let ((loading-level (-> *level* loading-level)))
|
|
(if loading-level
|
|
(cond
|
|
(this
|
|
(cond
|
|
((not (type-type? (-> this type) bsp-header))
|
|
(format 0 "ERROR: level ~A is not a bsp-header.~%" (-> loading-level 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).~%"
|
|
(-> loading-level name)
|
|
(-> this visible-list-length))
|
|
(the-as bsp-header #f))
|
|
(else
|
|
(load-dbg "bsp relocate: ~A~%" this)
|
|
;; everything is okay, link the bsp and level.
|
|
;; og:preserve-this fix bad filenames
|
|
(when (= (-> loading-level name) 'title)
|
|
(set! (-> this name) 'title))
|
|
(when (= (-> loading-level name) 'demo)
|
|
(set! (-> this name) 'demo))
|
|
(set! (-> loading-level bsp) this)
|
|
(set! (-> this level) loading-level)
|
|
this)))
|
|
(else (format 0 "ERROR: level ~A is not a valid file.~%" (-> loading-level name)) (the-as bsp-header #f)))))
|
|
(none))
|
|
|
|
(defmethod load-required-packages ((this level))
|
|
"Load the common package requested by a non-debug BSP when its level package list is nonempty."
|
|
(when (not (or (not (-> this bsp)) (= *kernel-boot-mode* 'debug-boot)))
|
|
(if (not (null? (-> this info packages))) (load-package "common" global)))
|
|
this)
|
|
|
|
;;;;;;;;;;;;;;
|
|
;; vis
|
|
;;;;;;;;;;;;;;
|
|
|
|
(defmethod vis-clear ((this level))
|
|
"Clear this level's eight VIS descriptors and 2048-byte visibility bit string, then mark
|
|
visibility as loading."
|
|
;; clear vis-infos, so we can't try to look up a vis string.
|
|
(countdown (i 8)
|
|
(nop!) ;; the usual.
|
|
(set! (-> this vis-info i) #f))
|
|
;; set the vis string to all 0s.
|
|
(dotimes (i 128)
|
|
(set! (deref int128 (-> this vis-bits) i) (the-as int128 0)))
|
|
;; this flag indicates we don't have vis data because loading is in progress
|
|
(set! (-> this all-visible?) 'loading)
|
|
0)
|
|
|
|
(defmethod vis-load ((this level))
|
|
"Ensure this level's self VIS file owns an IOP ramdisk slot, evicting the other level's slot when
|
|
necessary, and return the assigned ramdisk ID."
|
|
;; check to see if we have a buffer for loaded vis data.
|
|
(when (zero? (-> this vis-info (-> this vis-self-index) ramdisk))
|
|
;; nope, we have no vis data buffer, we need to set it up.
|
|
;; first, we should see if the other level has loaded vis. if so, kill it.
|
|
(let ((other-vis (-> this other vis-info (-> this other vis-self-index))))
|
|
(when (and other-vis (nonzero? (-> other-vis ramdisk)))
|
|
(set! (-> other-vis flags) (logand #xffffffffbfffffff (-> other-vis flags))) ;; clear waiting-for-load
|
|
(set! (-> other-vis ramdisk) 0)
|
|
0))
|
|
;; set up a ramdisk rpc (fill command, actually load the file from DVD to IOP buffer)
|
|
(let ((vis-filename (make-file-name (file-kind vis) (the-as string (-> this nickname)) 0 #f))
|
|
(request (the-as ramdisk-rpc-fill (add-element *ramdisk-rpc*)))
|
|
(ramdisk-id (+ *current-ramdisk-id* 1)))
|
|
(set! *current-ramdisk-id* ramdisk-id)
|
|
(set! (-> request filename) (string->sound-name vis-filename))
|
|
(set! (-> request ee-id) ramdisk-id)
|
|
(load-dbg "doing ramdisk vis load: ~A~%" vis-filename)
|
|
(call *ramdisk-rpc* RAMDISK_RPC_FILL_FNO (the-as pointer 0) (the-as uint 0))
|
|
;; remember which ramdisk id we are assigned
|
|
(set! (-> this vis-info (-> this vis-self-index) ramdisk) ramdisk-id)))
|
|
;; return the ramdisk ID.
|
|
(-> this vis-info (-> this vis-self-index) ramdisk))
|
|
|
|
(defun load-vis-info ((vis-name symbol) (old-vis-name symbol))
|
|
"Start loading the self VIS file for the active level whose nickname matches vis-name, replacing
|
|
the old VIS file when required."
|
|
(dotimes (i (-> *level* length))
|
|
(let ((active-level (-> *level* level i)))
|
|
(when (= (-> active-level status) 'active)
|
|
(when (= vis-name (-> active-level nickname))
|
|
(format 0 "Swapping in ~A VIS [dumping ~A]~%" vis-name old-vis-name)
|
|
(vis-load active-level)))))
|
|
0)
|
|
|
|
(defmethod init-vis ((this level))
|
|
"Attach the BSP's self and neighboring level-vis-info records, initialize their owners, output
|
|
buffers, packed flags, and ramdisk state, and enable visibility-aware actor-memory warnings."
|
|
(when (not (or (= (-> this status) 'inactive) (not (-> this bsp))))
|
|
;; no vis loaded at first, mark as loading/invalid.
|
|
(set! (-> this all-visible?) 'loading)
|
|
;; vis info 0 is always self.
|
|
(let ((self-vis (-> this bsp vis-info 0)))
|
|
;; check that our vis info is valid.
|
|
(cond
|
|
((and self-vis (nonzero? self-vis) (valid? self-vis level-vis-info #f #f 0))
|
|
;; add to the level
|
|
(set! (-> this vis-info 0) self-vis)
|
|
;; don't have a string loaded yet
|
|
(set! (-> self-vis current-vis-string) (the-as uint -1))
|
|
;; link to bsp
|
|
(set! (-> self-vis from-bsp) (-> this bsp))
|
|
;; the current vis string (uncompressed). The level allocates/manages this.
|
|
(set! (-> self-vis vis-bits) (-> this vis-bits))
|
|
(logclear! (-> self-vis flags) (vis-info-flag waiting-for-iop-to-ee using-this-as-only-vis))
|
|
(logior! (-> self-vis flags) (vis-info-flag from-vis-file))
|
|
(set! (-> self-vis ramdisk) (the-as uint 0))
|
|
(set! (-> self-vis string-block) (the-as uint #f))
|
|
;; remember that we use the vis system. This will enable warnings in the kernel
|
|
;; if we run out of actor memory. Without vis, I guess this happens a lot.
|
|
(set! *vis-boot* #t))
|
|
(else
|
|
;; we don't have vis (but it's okay)
|
|
(set! (-> this vis-info 0) #f))))
|
|
;; check for up to 6 neighbor level vis info. The last one is always left as null.
|
|
(dotimes (i 6)
|
|
(let* ((vis-index (+ i 1))
|
|
(neighbor-vis (-> this bsp vis-info vis-index)))
|
|
(cond
|
|
((and neighbor-vis (nonzero? neighbor-vis) (valid? neighbor-vis level-vis-info #f #f 0))
|
|
(set! (-> this vis-info vis-index) neighbor-vis)
|
|
(set! (-> neighbor-vis current-vis-string) (the-as uint -1))
|
|
(set! (-> neighbor-vis from-bsp) #f)
|
|
(set! (-> neighbor-vis vis-bits) (-> this vis-bits))
|
|
(logclear! (-> neighbor-vis flags) (vis-info-flag from-vis-file waiting-for-iop-to-ee using-this-as-only-vis))
|
|
(set! *vis-boot* #t))
|
|
(else (set! (-> this vis-info vis-index) #f))))))
|
|
0)
|
|
|
|
(defmethod level-get-for-use ((this level-group) (name symbol) (want-status symbol))
|
|
"Return a slot for name at want-status. Reuse a matching level when possible; otherwise dispose
|
|
of the safest slot, initialize its level-info and mood state, and begin loading."
|
|
(local-vars (selected-level level))
|
|
;; debug allocate levels if necessary
|
|
(alloc-levels! this #f)
|
|
(let* ((info (lookup-level-info name))
|
|
(load-name (remap-level-name info)))
|
|
(awhen (level-get this load-name)
|
|
(level-status-set! it want-status)
|
|
(return it))
|
|
(let ((disposable-level (level-get-most-disposable this)))
|
|
(set! selected-level (if disposable-level (level-status-set! disposable-level 'inactive) disposable-level)))
|
|
;; THIS WAS BUGGED IN THE ORIGINAL GAME!! Probably due to a fault in the original GOAL compiler and because they had
|
|
;; a local variable called "level", this branch here checks for the *TYPE* object called level instead of the
|
|
;; variable. Since the type will never be equal to #f when this code runs, this failsafe never runs, and the game will
|
|
;; proceed to corrupt the symbol table since it thinks #f is a level, which most definitely crashes the game
|
|
;; very quickly.
|
|
;; We are fixing it.
|
|
(when (not selected-level) ;; level
|
|
(format 0 "ERROR: could not find a slot to load ~A into.~%" name)
|
|
(return (the-as level #f)))
|
|
(set! (-> selected-level info) info)
|
|
(set! (-> selected-level name) name)
|
|
(set! (-> selected-level load-name) load-name))
|
|
(set! (-> selected-level mood) (the mood-context (-> selected-level info mood value)))
|
|
(set! (-> selected-level mood-func)
|
|
(the (function mood-context float int none) (-> selected-level info mood-func value)))
|
|
(set! (-> selected-level display?) #f)
|
|
(set! (-> selected-level force-all-visible?) #f)
|
|
(set! (-> selected-level force-inside?) #f)
|
|
(level-status-set! selected-level 'loading)
|
|
(level-status-set! selected-level want-status)
|
|
selected-level)
|
|
|
|
;; level status:
|
|
;; - inactive: nothing loaded or loading.
|
|
;; - loading: level is reserved and in the process of loading. There can only be 1 loading level at a time.
|
|
;; when loading, the loading-level heap is set to the appropriate level heap.
|
|
;; also, (-> *level* loading-level) points to the level.
|
|
;; - loading-bt: loading the "buffer top". This is the big BSP object file, it loads differently.
|
|
;; - loading-done: loading is done, but no login/init has started
|
|
;; - login: login is in progress
|
|
;; - loaded: login is done
|
|
;; - alive: level is birthed, etc
|
|
;; - active: level is being drawn
|
|
|
|
(defmethod level-status ((this level-group) (level-name symbol))
|
|
"Return the status of the loaded level matching level-name, or false."
|
|
(let ((loaded-level (level-get *level* level-name))) (if loaded-level (-> loaded-level status))))
|
|
|
|
(defmethod level-status-set! ((this level) (want-status symbol))
|
|
"Move this level toward want-status through the legal load, login, birth, activation,
|
|
deactivation, and unload transitions. Loading states may only advance in order."
|
|
(case want-status
|
|
(('inactive)
|
|
(case (-> this status))
|
|
(unload! this))
|
|
(('loading)
|
|
(case (-> this status)
|
|
(('inactive) (load-begin this))))
|
|
(('loading-bt)
|
|
(case (-> this status)
|
|
(('loading) (set! (-> this status) want-status) (load-continue this))))
|
|
(('loading-done)
|
|
(case (-> this status)
|
|
(('loading-bt) (set! (-> this status) want-status))))
|
|
(('loaded)
|
|
(case (-> this status)
|
|
(('loading-done)
|
|
;; will actually put us in login for a bit.
|
|
(login-begin this))
|
|
(('alive 'active) (deactivate this))))
|
|
(('alive 'active)
|
|
(when *dproc*
|
|
(case (-> this status)
|
|
(('loaded)
|
|
(birth this)
|
|
;; try again. we will be in alive.
|
|
;; this will do nothing if we want alive, but will activate if we want activate
|
|
(level-status-set! this want-status))
|
|
(('alive)
|
|
(when (and *dproc* (= want-status 'active))
|
|
;; only if we want to do alive -> active
|
|
;; will set the level to be drawn.
|
|
(remove-by-param1 *background-draw-engine* (-> this bsp))
|
|
(add-connection *background-draw-engine*
|
|
*dproc*
|
|
(the (function object object object object object) add-bsp-drawable)
|
|
(-> this bsp)
|
|
this
|
|
#f)
|
|
(dotimes (i 9)
|
|
(set! (-> this closest-object i) 0.0)
|
|
(set! (-> this texture-mask i) (the-as uint 0)))
|
|
(set! (-> this level-distance) 0.0)
|
|
(set! (-> this status) 'active)))))))
|
|
this)
|
|
|
|
(define *login-state* (new 'global 'login-state))
|
|
|
|
(define *print-login* #t)
|
|
|
|
(defmethod load-continue ((this level))
|
|
"Advance this level's asynchronous DGO load, deferred texture relocation, linking, final
|
|
BSP-object load, or incremental login according to its current status."
|
|
;; see if we are still linking some file
|
|
(when (-> this linking)
|
|
;; do some more linking
|
|
(when (nonzero? (link-resume))
|
|
;; done linking and object file!
|
|
(set! (-> this linking) #f)
|
|
(case (-> this status)
|
|
(('loading)
|
|
;; load another object if we don't wanna copy anything
|
|
(if (not (-> *texture-relocate-later* memcpy)) (dgo-load-continue (the pointer (align64 (-> this heap current))))))
|
|
(('loading-bt)
|
|
;; finished loading the last object!
|
|
(level-status-set! this 'loading-done)
|
|
(level-status-set! this 'loaded))))
|
|
(return this))
|
|
;; otherwise, copy stuff that needs copying
|
|
(when (-> *texture-relocate-later* memcpy)
|
|
(relocate-later)
|
|
(dgo-load-continue (the pointer (align64 (-> this heap current))))
|
|
(return this))
|
|
;; otherwise, check status
|
|
(case (-> this status)
|
|
(('loading)
|
|
;; we are still loading
|
|
(let* ((last-object-name #f)
|
|
(loaded-object (dgo-load-get-next (& last-object-name))))
|
|
(when loaded-object
|
|
;; something has finished loading!
|
|
(cond
|
|
((not last-object-name)
|
|
;; not the last object. start linking
|
|
(cond
|
|
((dgo-load-link (the-as dgo-header loaded-object) (-> this heap) *print-login* #f)
|
|
;; linking finished (that was fast)
|
|
(if (not (-> *texture-relocate-later* memcpy)) (dgo-load-continue (the pointer (align64 (-> this heap current))))))
|
|
(else
|
|
;; linking is not done, resume later.
|
|
(set! (-> this linking) #t))))
|
|
(else
|
|
;; we're loading the last object now, which has different rules
|
|
(set! (-> this heap top) (-> this heap top-base))
|
|
(level-status-set! this 'loading-bt))))))
|
|
(('login)
|
|
;; run level login
|
|
(level-update-after-load this *login-state*))
|
|
(('loading-bt)
|
|
;; link the last object
|
|
(let ((load-destination (the pointer (align64 (-> this heap current)))))
|
|
(cond
|
|
((dgo-load-link (the-as dgo-header load-destination) (-> this heap) *print-login* #t)
|
|
(level-status-set! this 'loading-done)
|
|
;; will start login.
|
|
(level-status-set! this 'loaded))
|
|
(else (set! (-> this linking) #t))))))
|
|
this)
|
|
|
|
(defmethod load-begin ((this level))
|
|
"Reserve this level slot, clear its previous state, select the level texture allocator, build the
|
|
DGO filename, allocate two 2 MiB streaming buffers, and begin the asynchronous load."
|
|
;; set the level heap. level code logins called from linker may allocate here
|
|
(set! loading-level (-> this heap))
|
|
;; relocate method of the bsp will look for this
|
|
(set! (-> *level* loading-level) this)
|
|
;; clear out old stuff
|
|
(set! (-> *level* log-in-level-bsp) #f)
|
|
(set! (-> this nickname) #f)
|
|
(set! (-> this bsp) #f)
|
|
(set! (-> this entity) #f)
|
|
(set! (-> this ambient) #f)
|
|
(set! (-> this linking) #f)
|
|
(vis-clear this)
|
|
(set! (-> this status) 'loading)
|
|
;; incoming textures should use the level allocator
|
|
(set! (-> *texture-pool* allocate-func) texture-page-level-allocate)
|
|
;; build name
|
|
(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")
|
|
;; reset temporary allocations on level heap
|
|
(set! (-> this heap top) (-> this heap top-base))
|
|
;; allocate DGO loading buffers
|
|
(let ((buffer-a (kmalloc (-> this heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2"))
|
|
(buffer-b (kmalloc (-> this heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2")))
|
|
(load-dbg " DGO buffers at #x~X #x~X~%" buffer-a buffer-b)
|
|
;; we expect to load code first, remember where the heap is now.
|
|
(set! (-> this code-memory-start) (-> this heap current))
|
|
(format 0 "-----------> begin load ~A [~S]~%" (-> this load-name) *temp-string*)
|
|
;; kick off the load!
|
|
(dgo-load-begin *temp-string* buffer-b buffer-a (the pointer (align64 (-> this heap current)))))
|
|
this)
|
|
|
|
(defmethod login-begin ((this level))
|
|
"Restore the default texture allocator, log in the BSP's texture pages and ADGIF shaders,
|
|
initialize the incremental login state, and enter login status. An absent BSP unloads the
|
|
level."
|
|
;; done with load, reset the texture page allocator
|
|
(set! (-> *texture-pool* allocate-func) texture-page-default-allocate)
|
|
(cond
|
|
((-> this bsp)
|
|
(set! (-> *level* log-in-level-bsp) (-> this bsp))
|
|
;; login textures
|
|
(login-level-textures *texture-pool* this (-> this bsp texture-page-count) (-> this bsp texture-ids))
|
|
;; login shaders
|
|
(let ((bsp-data (-> this bsp)))
|
|
(when (nonzero? (-> bsp-data adgifs))
|
|
(let ((adgifs (-> bsp-data adgifs))) (dotimes (i (-> adgifs length)) (adgif-shader-login-no-remap (-> adgifs data i))))))
|
|
;; set the login state machine at the beginning.
|
|
(set! (-> *login-state* state) -1)
|
|
(set! (-> *login-state* pos) (the-as uint 0))
|
|
(set! (-> *login-state* elts) (the-as uint 0))
|
|
(set! (-> this status) 'login))
|
|
(else
|
|
;; something went wrong, kill the level.
|
|
(level-status-set! this 'inactive)
|
|
(set! loading-level global)
|
|
(set! (-> *level* loading-level) (-> *level* level-default))))
|
|
this)
|
|
|
|
(defun level-update-after-load ((loaded-level level) (level-login-state login-state))
|
|
"Advance a level's incremental login. Log in direct drawable trees and art groups, process queued
|
|
tfragment arrays and TIE prototypes in bounded batches, initialize actor navigation, then attach
|
|
visibility, load packages, publish subdivision distances, and mark the level loaded."
|
|
(local-vars
|
|
(current-timer int)
|
|
(final-timer int)
|
|
(initial-timer int)
|
|
(current-prototype prototype-bucket-tie)
|
|
(geometry-index int))
|
|
;; The EE limits one call to 100,000 Count ticks so BSP login is spread over several frames.
|
|
;; The PC has no equivalent Count register and finishes the same state machine in one call.
|
|
(let ((level-drawable-trees (-> loaded-level bsp drawable-trees)))
|
|
(#unless PC_PORT
|
|
(m initial-timer Count))
|
|
(label cfg-1)
|
|
(#unless PC_PORT
|
|
(m current-timer Count)
|
|
(let ((elapsed-timer (- current-timer initial-timer)))
|
|
(when (< #x186a0 elapsed-timer)
|
|
(set! loaded-level loaded-level)
|
|
(goto cfg-78))))
|
|
(let ((current-login-pos (the-as int (-> level-login-state pos))))
|
|
;; Login state -1.
|
|
;; in this state, we log in drawables/art-groups that are in referenced in the bsp directly
|
|
;; the current-login-pos in the index of the drawable/art to login.
|
|
(when (= (-> level-login-state state) -1)
|
|
;;(load-dbg "login state -1~%")
|
|
;; login some drawables.
|
|
(when (< current-login-pos (-> level-drawable-trees length))
|
|
(let ((current-drawable (-> level-drawable-trees trees (the-as uint current-login-pos))))
|
|
;;(load-dbg "login draw: ~A~%" current-drawable)
|
|
(cond
|
|
((= (-> current-drawable type) drawable-tree-tfrag)
|
|
;; tfrag!
|
|
(dotimes (drawable-index (-> current-drawable length))
|
|
(cond
|
|
((= (-> current-drawable data drawable-index type) drawable-inline-array-tfrag)
|
|
;; we got an array of drawables. instead of iterating/recursing, just add it to the back of the login list.
|
|
;;(load-dbg " tfrag array case~%")
|
|
(set! (-> level-login-state elt (-> level-login-state elts)) (-> current-drawable data drawable-index))
|
|
(+! (-> level-login-state elts) 1))
|
|
(else
|
|
;;(load-dbg " tfrag actual login case~%")
|
|
(login (-> current-drawable data drawable-index))))))
|
|
((= (-> current-drawable type) drawable-tree-instance-tie)
|
|
;; tie! add the tree to the list.
|
|
;;(load-dbg " tie tree case~%")
|
|
(set! (-> level-login-state elt (-> level-login-state elts)) current-drawable)
|
|
(+! (-> level-login-state elts) 1))
|
|
(else
|
|
;;(load-dbg " other actual login: ~A~%" (method-of-object current-drawable login))
|
|
(login current-drawable))))
|
|
(+! (-> level-login-state pos) 1)
|
|
(goto cfg-1))
|
|
;; this makes the art groups go at the end.
|
|
(let ((art-index (- (the-as uint current-login-pos) (the-as uint (-> level-drawable-trees length)))))
|
|
(when (< (the-as int art-index) (-> loaded-level art-group art-group-array length))
|
|
(let ((current-art-group (-> loaded-level art-group art-group-array art-index)))
|
|
(login current-art-group)
|
|
(if (needs-link? current-art-group) (link-art! current-art-group)))
|
|
(+! (-> level-login-state pos) 1)
|
|
(goto cfg-1)))
|
|
;; if we got here, we're done with state -1!
|
|
(set! (-> level-login-state pos) (the-as uint 0))
|
|
(set! (-> level-login-state state) 0)
|
|
(goto cfg-1))
|
|
;; login state 0.
|
|
;; we log in children of the drawables from state -1.
|
|
(when (< (-> level-login-state state) (the-as int (-> level-login-state elts)))
|
|
;; (load-dbg " login state 0~%")
|
|
(let ((queued-drawable (-> level-login-state elt (-> level-login-state state))))
|
|
(cond
|
|
((= (-> queued-drawable type) drawable-inline-array-tfrag)
|
|
;; (load-dbg " login drawable-inline-array-tfrag: ~A~%" queued-drawable)
|
|
(cond
|
|
((< current-login-pos (-> (the-as drawable-inline-array-tfrag queued-drawable) length))
|
|
(dotimes (batch-index 200)
|
|
(when (< current-login-pos (-> (the-as drawable-inline-array-tfrag queued-drawable) length))
|
|
;; (load-dbg " login from drawable-inline-array-tfrag: ~A~%" (-> (the-as drawable-inline-array-tfrag queued-drawable) data (the-as uint current-login-pos)))
|
|
(login (-> (the-as drawable-inline-array-tfrag queued-drawable) data (the-as uint current-login-pos)))
|
|
(set! current-login-pos (the-as int (+ (the-as uint current-login-pos) 1)))))
|
|
(set! (-> level-login-state pos) (the-as uint current-login-pos)))
|
|
(else
|
|
(set! (-> level-login-state pos) (the-as uint 0))
|
|
(set! current-login-pos (+ (-> level-login-state state) 1))
|
|
(set! (-> level-login-state state) current-login-pos))))
|
|
((= (-> queued-drawable type) drawable-tree-instance-tie)
|
|
;;(load-dbg " login drawable-tree-instance-tie: ~A~%" queued-drawable)
|
|
(let ((prototypes (-> (the-as drawable-tree-instance-tie queued-drawable) prototypes prototype-array-tie)))
|
|
(when (< current-login-pos (-> prototypes length))
|
|
(dotimes (batch-index 10)
|
|
(when (< current-login-pos (-> prototypes length))
|
|
(set! current-prototype (-> prototypes array-data (the-as uint current-login-pos)))
|
|
(set! geometry-index 0)
|
|
(#when PC_PORT
|
|
;; if a TIE uses environment mapping, disable the fade out so it always renderers with
|
|
;; the generic renderer. In the port, we just make envmapped things always envmap.
|
|
(when (!= (-> current-prototype envmap-fade-far) 0.0)
|
|
(*! (-> current-prototype envmap-fade-far) 10000.)))
|
|
(while (< geometry-index 4)
|
|
(let ((tie-geometry (-> current-prototype geometry geometry-index)))
|
|
;;(load-dbg " login geom: ~A~%" tie-geometry)
|
|
(if (nonzero? tie-geometry) (login tie-geometry)))
|
|
(set! geometry-index (+ geometry-index 1)))
|
|
(set! current-login-pos (the-as int (+ (the-as uint current-login-pos) 1)))))
|
|
(set! (-> level-login-state pos) (the-as uint current-login-pos)))
|
|
(when (= (the-as uint current-login-pos) (-> prototypes length))
|
|
(dotimes (prototype-index (-> prototypes length))
|
|
(let ((envmap-shader (-> prototypes array-data prototype-index envmap-shader)))
|
|
(when (nonzero? envmap-shader)
|
|
;;(load-dbg " login adgif shader for envmap~%")
|
|
(adgif-shader-login-no-remap envmap-shader)
|
|
(set! (-> envmap-shader tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
|
|
(set! (-> envmap-shader clamp) (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
|
|
(set! (-> envmap-shader alpha) (new 'static 'gs-alpha :b #x2 :c #x1 :d #x1))
|
|
(set! (-> envmap-shader prims 1) (gs-reg64 tex0-1))
|
|
(set! (-> envmap-shader prims 3) (gs-reg64 tex1-1))
|
|
(set! (-> envmap-shader prims 5) (gs-reg64 miptbp1-1))
|
|
(set! (-> envmap-shader clamp-reg) (gs-reg64 clamp-1))
|
|
(set! (-> envmap-shader prims 9) (gs-reg64 alpha-1)))))
|
|
(set! (-> level-login-state pos) (the-as uint 0))
|
|
(+! (-> level-login-state state) 1))))))
|
|
(goto cfg-1))
|
|
(when (= (-> level-login-state state) (-> level-login-state elts))
|
|
(let ((bsp-data (-> loaded-level bsp)))
|
|
(cond
|
|
((or (zero? (-> bsp-data actors)) (= (the-as uint current-login-pos) (-> bsp-data actors length)))
|
|
(set! (-> level-login-state pos) (the-as uint 0))
|
|
(+! (-> level-login-state state) 1))
|
|
(else
|
|
(let ((actor-data (-> bsp-data actors data (the-as uint current-login-pos) actor)))
|
|
;; (load-dbg "entity nav login: ~A~%" actor-data)
|
|
(entity-nav-login actor-data))
|
|
(+! (-> level-login-state pos) 1))))
|
|
(goto cfg-1))
|
|
(when (zero? (the-as uint current-login-pos))
|
|
(set! (-> level-login-state pos) (the-as uint 1))
|
|
(set! loaded-level loaded-level)
|
|
(goto cfg-78))))
|
|
;; done!
|
|
(set! (-> loaded-level nickname) (-> loaded-level bsp nickname))
|
|
(if (nonzero? (-> loaded-level bsp nodes)) (set! *time-of-day-effects* #t) (set! *time-of-day-effects* #f))
|
|
(let ((close-distance (-> loaded-level bsp unk-data-4))
|
|
(far-distance (-> loaded-level bsp unk-data-5)))
|
|
(when (and (= close-distance 0.0) (= far-distance 0.0))
|
|
(set! close-distance 122880.0)
|
|
(set! far-distance 286720.0))
|
|
(set! (-> *subdivide-settings* close (-> loaded-level index)) close-distance)
|
|
(set! (-> *subdivide-settings* far (-> loaded-level index)) far-distance)
|
|
(set! (-> *subdivide-settings* close 3) close-distance)
|
|
(set! (-> *subdivide-settings* far 3) far-distance))
|
|
(load-dbg "init-vis~%")
|
|
(init-vis loaded-level)
|
|
(load-dbg "package load~%")
|
|
(load-required-packages loaded-level)
|
|
(set! (-> loaded-level status) 'loaded)
|
|
(set! loading-level global)
|
|
(set! (-> *level* loading-level) (-> *level* level-default))
|
|
(set! (-> *level* log-in-level-bsp) #f)
|
|
(#unless PC_PORT
|
|
0
|
|
(m final-timer Count)
|
|
(- final-timer initial-timer))
|
|
(label cfg-78)
|
|
loaded-level)
|
|
|
|
(defmethod birth ((this level))
|
|
"Birth a loaded BSP, restore its saved permanent entity state, mark the level alive, and notify
|
|
the camera and target."
|
|
(case (-> this status)
|
|
(('loaded)
|
|
(protect (loading-level
|
|
(-> *level* loading-level)
|
|
(-> *level* log-in-level-bsp))
|
|
(set! loading-level (-> this heap))
|
|
(set! (-> *level* log-in-level-bsp) (-> this bsp))
|
|
(set! (-> *level* loading-level) this)
|
|
(birth (-> this bsp))
|
|
(set! (-> this status) 'alive)
|
|
;;(load-dbg "copy perms~%")
|
|
(copy-perms-to-level! *game-info* this)
|
|
;;(load-dbg "send activate~%")
|
|
;; note: this isn't a great name - the level isn't actually activated, just alive.
|
|
(send-event *camera* 'level-activate (-> this name))
|
|
(send-event *target* 'level-activate (-> this name)))))
|
|
this)
|
|
|
|
(defmethod deactivate ((this level))
|
|
"Save permanent entity state, remove this level from drawing, deactivate its entities and
|
|
particles, clear inside and visibility state, and leave its data loaded."
|
|
(case (-> this status)
|
|
(('active 'alive)
|
|
(format 0 "----------- kill ~A (status ~A)~%" this (-> this status))
|
|
;; copy data from the level to the game-info storage. This will remember permanent level stuff, like
|
|
;; what you collected/completed.
|
|
(copy-perms-from-level! *game-info* this)
|
|
;; og:preserve-this fully clear entity perm status in the level itself (based on reset-actors)
|
|
;; it should be copied back out of game-info on birth to prevent "NG+ glitch"
|
|
(let ((lev-ents (-> this entity)))
|
|
(dotimes (idx (-> lev-ents length))
|
|
(let ((ent (-> lev-ents data idx entity))) (update-perm! (-> ent extra perm) 'game (the-as entity-perm-status 1919)))))
|
|
(send-event *camera* 'level-deactivate (-> this name))
|
|
(send-event *target* 'level-deactivate (-> this name))
|
|
;; remove this BSP from the engine. This will stop us from being drawn.
|
|
(remove-by-param1 *background-draw-engine* (-> this bsp))
|
|
;; track down all the entities and kill them
|
|
(deactivate-entities (-> this bsp))
|
|
;; kill any remaining particles not associated with a part-tracker
|
|
(kill-all-particles-in-level this)
|
|
;; clean up our level
|
|
(set! (-> this inside-sphere?) #f)
|
|
(set! (-> this inside-boxes?) #f)
|
|
(set! (-> this meta-inside?) #f)
|
|
(set! (-> this force-inside?) #f)
|
|
;; we're still loaded.
|
|
(set! (-> this status) 'loaded)
|
|
(set! (-> this all-visible?) 'loading)
|
|
;; clear vis buffers
|
|
(dotimes (i 128)
|
|
(set! (deref int128 (-> this vis-bits) i) (the-as int128 0)))
|
|
(let ((i 8))
|
|
(while (nonzero? i)
|
|
(+! i -1)
|
|
(let ((vis-record (-> this vis-info i))) (if vis-record (set! (-> vis-record current-vis-string) (the-as uint -1))))))))
|
|
(if (= (-> *level* log-in-level-bsp) (-> this bsp)) (set! (-> *level* log-in-level-bsp) #f))
|
|
this)
|
|
|
|
(defmethod unload! ((this level))
|
|
"Deactivate this level, unlink its art, textures, particle groups, packages, and pending art
|
|
loads, reset its heap and visibility state, and make its slot inactive."
|
|
(deactivate this)
|
|
(when (!= (-> this status) 'inactive)
|
|
;; if we linked art group, unlink it.
|
|
(when (or (= (-> this status) 'loaded) (= (-> this status) 'alive) (= (-> this status) 'active) (= (-> this status) 'login))
|
|
(dotimes (art-index (-> this art-group art-group-array length))
|
|
(let ((current-art-group (-> this art-group art-group-array art-index)))
|
|
(if (needs-link? current-art-group) (unlink-art! current-art-group)))))
|
|
;; turn some things off
|
|
(set! (-> this bsp) #f)
|
|
(set! (-> this entity) #f)
|
|
(set! (-> this ambient) #f)
|
|
(set! (-> this status) 'inactive)
|
|
(set! (-> this art-group string-array length) 0)
|
|
(set! (-> this art-group art-group-array length) 0)
|
|
;; unload texture pages
|
|
(countdown (texture-index (-> this loaded-texture-page-count))
|
|
(dotimes (common-index 32)
|
|
(when (= (-> this loaded-texture-page texture-index) (-> *texture-pool* common-page common-index))
|
|
(set! (-> *texture-pool* common-page common-index) (the-as texture-page 0))))
|
|
(unload! *texture-pool* (-> this loaded-texture-page texture-index)))
|
|
(set! (-> this loaded-texture-page-count) 0)
|
|
(unlink-textures-in-heap! *texture-page-dir* (-> this heap))
|
|
;; unload particle groups that were defined in the level data
|
|
(unlink-part-group-by-heap (-> this heap))
|
|
;; if there are any in-progress art loads for this level, kill them.
|
|
(dotimes (buffer-index 2)
|
|
(let ((pending-file (-> *art-control* buffer buffer-index pending-load-file)))
|
|
(if (and (>= (the-as int pending-file) (the-as int (-> this heap base)))
|
|
(< (the-as int pending-file) (the-as int (-> this heap top-base))))
|
|
(set-pending-file (-> *art-control* buffer buffer-index) (the-as string #f) -1 (the-as handle #f) 100000000.0))))
|
|
;; unload packages (doesn't really do anything.)
|
|
(let* ((packages (-> this info packages))
|
|
(package (car packages)))
|
|
(while (not (null? packages))
|
|
(case (rtype-of package)
|
|
((symbol) (unload (symbol->string (the-as symbol package))))
|
|
((string) (unload (the-as string package))))
|
|
(set! packages (cdr packages))
|
|
(set! package (car packages))))
|
|
(vis-clear this)
|
|
;; reset the level heap!
|
|
(let ((level-heap (-> this heap))) (set! (-> level-heap current) (-> level-heap base)))
|
|
(set! (-> this code-memory-start) (the-as pointer 0))
|
|
(set! (-> this code-memory-end) (the-as pointer 0))
|
|
(when (= (-> *level* loading-level) this)
|
|
(set! loading-level global)
|
|
(set! (-> *level* loading-level) (-> *level* level-default))
|
|
(set! (-> *level* log-in-level-bsp) #f)))
|
|
this)
|
|
|
|
;; method 27 level
|
|
|
|
;; method 10 level
|
|
(defmethod is-object-visible? ((this level) (drawable-index int))
|
|
"Return whether drawable-index's bit is set in this level's current visibility string. Return
|
|
false when the bit is clear; the PC actor visibility setting may bypass this test."
|
|
;; og:preserve-this pc port added option to show every actor regardless
|
|
(with-pc
|
|
(if (not (-> *pc-settings* ps2-actor-vis?)) (return #t)))
|
|
;; check the vis bits!
|
|
(let* (;; lwu v1, 388(a0)
|
|
(vis-data (-> this vis-bits))
|
|
;; sra a0, a1, 3
|
|
(byte-idx (sar drawable-index 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 drawable-index #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~%" drawable-index vis-byte check-sign-word (>= check-sign-word 0))
|
|
(< check-sign-word 0)))
|
|
|
|
(defmethod point-in-boxes? ((this level) (position vector))
|
|
"Return true when position lies inside one of this level's half-open BSP boxes. force-inside?
|
|
bypasses the geometric test."
|
|
(cond
|
|
((or (not (-> this bsp)) (zero? (-> this bsp boxes)))
|
|
;; no boxes or no bsp
|
|
#f)
|
|
((-> this force-inside?) #t)
|
|
(else
|
|
(let* ((boxes (-> this bsp boxes))
|
|
(box-cursor (-> boxes data)))
|
|
(countdown (boxes-left (-> boxes length))
|
|
(if (and (>= (-> position x) (-> box-cursor 0 min x))
|
|
(>= (-> position y) (-> box-cursor 0 min y))
|
|
(>= (-> position z) (-> box-cursor 0 min z))
|
|
(< (-> position x) (-> box-cursor 0 max x))
|
|
(< (-> position y) (-> box-cursor 0 max y))
|
|
(< (-> position z) (-> box-cursor 0 max z)))
|
|
(return #t))
|
|
(set! box-cursor (the (inline-array box8s) (-> box-cursor 1)))))
|
|
#f)))
|
|
|
|
(defmethod debug-print-splitbox ((this level) (position vector) (output string))
|
|
"Print the split-box identifier for every BSP box containing position."
|
|
(cond
|
|
((or (not (-> this bsp)) (zero? (-> this bsp boxes)) (zero? (-> this bsp split-box-indices)))
|
|
;; do nothing!
|
|
)
|
|
(else
|
|
(let* ((boxes (-> this bsp boxes))
|
|
(box-cursor (-> boxes data)))
|
|
(dotimes (i (-> boxes length))
|
|
(if (and (>= (-> position x) (-> box-cursor 0 min x))
|
|
(>= (-> position y) (-> box-cursor 0 min y))
|
|
(>= (-> position z) (-> box-cursor 0 min z))
|
|
(< (-> position x) (-> box-cursor 0 max x))
|
|
(< (-> position y) (-> box-cursor 0 max y))
|
|
(< (-> position z) (-> box-cursor 0 max z)))
|
|
(format output " splitbox-~D~%" (-> this bsp split-box-indices i)))
|
|
(set! box-cursor (the (inline-array box8s) (-> box-cursor 1)))))))
|
|
0
|
|
(none))
|
|
|
|
(defmethod mem-usage ((this level) (usage memory-usage-block) (flags mem-usage-flags))
|
|
"Account for this active level's entity and ambient links, art, code, texture pages, visibility
|
|
records, and BSP data."
|
|
(when (= (-> this status) 'active)
|
|
(mem-usage-add! usage entity-links (-> this entity length) (asize-of (-> this entity)))
|
|
(set! (-> usage length) (max 65 (-> usage length)))
|
|
(set! (-> usage data 64 name) "ambient-links")
|
|
(+! (-> usage data 64 count) (-> this ambient length))
|
|
(let ((ambient-bytes (asize-of (-> this ambient))))
|
|
(+! (-> usage data 64 used) ambient-bytes)
|
|
(+! (-> usage data 64 total) (logand -16 (+ ambient-bytes 15))))
|
|
(mem-usage (-> this art-group) usage flags)
|
|
(mem-usage-add! usage level-code 1 (&- (-> this code-memory-end) (the-as uint (-> this code-memory-start))))
|
|
(countdown (i (-> this loaded-texture-page-count))
|
|
(mem-usage (-> this loaded-texture-page i) usage flags))
|
|
(countdown (vis-index 8)
|
|
(let ((vis-record (-> this vis-info vis-index)))
|
|
(when vis-record
|
|
(cond
|
|
((zero? vis-index)
|
|
(mem-usage-add! usage bsp-leaf-vis-self 1 (asize-of vis-record)))
|
|
(else
|
|
(mem-usage-add! usage bsp-leaf-vis-adj 1 (+ (asize-of vis-record) (the-as int (-> vis-record allocated-length)))))))))
|
|
(mem-usage (-> this bsp) usage flags))
|
|
this)
|
|
|
|
(#cond
|
|
(PC_PORT
|
|
(defconstant LEVEL_HEAP_SIZE (* 10416 1024)) ;; 10.416K
|
|
(defconstant LEVEL_HEAP_SIZE_DEBUG (* 11000 1024)))
|
|
(#t
|
|
(defconstant LEVEL_HEAP_SIZE (* 10416 1024)) ;; 10.416K
|
|
(defconstant LEVEL_HEAP_SIZE_DEBUG (* 25600 1024)) ;; 25.600K
|
|
))
|
|
|
|
(defmethod alloc-levels! ((this level-group) (compact-level-heaps symbol))
|
|
"Load the shared art packages and allocate three level heaps. compact-level-heaps selects the
|
|
smaller heap size and loads common explicitly."
|
|
;; only do stuff if levels are not allocated
|
|
(when (zero? (-> *level* level0 heap base))
|
|
;; GAME.CGO is made up of ART.CGO and COMMON.CGO
|
|
(when (nmember "game" *kernel-packages*)
|
|
(set! *kernel-packages* (cons "art" *kernel-packages*))
|
|
(set! *kernel-packages* (cons "common" *kernel-packages*)))
|
|
(load-package "art" global) ;; load ART
|
|
(if compact-level-heaps
|
|
(load-package "common" global) ;; load COMMON unless we're debugging levels
|
|
)
|
|
;; allocate level heaps. turn on compact-level-heaps for use in 32MB systems
|
|
(let ((level-heap-size (if compact-level-heaps LEVEL_HEAP_SIZE LEVEL_HEAP_SIZE_DEBUG)))
|
|
(dotimes (lev LEVEL_COUNT)
|
|
(let ((level-heap (-> this level lev heap)))
|
|
(set! (-> level-heap base) (malloc 'global level-heap-size))
|
|
(set! (-> level-heap current) (-> level-heap base))
|
|
(set! (-> level-heap top-base) (&+ (-> level-heap base) level-heap-size))
|
|
(set! (-> level-heap top) (-> level-heap top-base))))))
|
|
0)
|
|
|
|
(defmethod level-get-with-status ((this level-group) (status symbol))
|
|
"Return the first level slot with status, or false."
|
|
(dotimes (i (-> this length))
|
|
(if (= (-> this level i status) status) (return (-> this level i))))
|
|
(the-as level #f))
|
|
|
|
(defmethod level-get-most-disposable ((this level-group))
|
|
"Choose a slot for a new load. Prefer inactive, loading, or merely loaded slots; otherwise choose
|
|
the lowest-priority active level whose boxes do not contain the camera."
|
|
;; check inactive levels first
|
|
(dotimes (i (-> this length))
|
|
(case (-> this level i status)
|
|
(('inactive) (return (-> this level i)))))
|
|
;; check for any loading levels
|
|
(dotimes (i (-> this length))
|
|
(case (-> this level i status)
|
|
(('loading 'loading-bt) (return (-> this level i)))))
|
|
;; check for loaded, but not active, levels.
|
|
(dotimes (i (-> this length))
|
|
(if (= (-> this level i status) 'loaded) (return (-> this level i))))
|
|
;; check active levels. pick one we're not in bounds of.
|
|
(let ((candidate (the-as level #f)))
|
|
(dotimes (i (-> this length))
|
|
(case (-> this level i status)
|
|
(('active)
|
|
(if (and (not (-> this level i inside-boxes?))
|
|
(or (not candidate) (< (-> this level i info priority) (-> candidate info priority))))
|
|
(set! candidate (-> this level i))))))
|
|
candidate))
|
|
|
|
(defmethod level-get ((this level-group) (name symbol))
|
|
"Return the non-inactive level whose requested or remapped load name matches name, or false."
|
|
(dotimes (i (-> this length))
|
|
(if (and (!= (-> this level i status) 'inactive) (or (= (-> this level i name) name) (= (-> this level i load-name) name)))
|
|
(return (-> this level i))))
|
|
(the level #f))
|
|
|
|
(defmethod art-group-get-by-name ((this level-group) (name string))
|
|
"Search all three level slots for an art group whose name matches name, or return false."
|
|
(countdown (level-index 3)
|
|
(let ((loaded-level (-> this level level-index)))
|
|
(countdown (art-index (-> loaded-level art-group art-group-array length))
|
|
(if (name= (-> loaded-level art-group art-group-array art-index name) name)
|
|
(return (-> loaded-level art-group art-group-array art-index))))))
|
|
(the-as art-group #f))
|
|
|
|
(defmethod activate-levels! ((this level-group))
|
|
"Request active status for every allocated level slot."
|
|
(dotimes (i (-> this length))
|
|
(level-status-set! (-> this level i) 'active))
|
|
0)
|
|
|
|
(defmethod level-get-target-inside ((this level-group))
|
|
"Choose an active level for the target. Prefer the current continue's level, then the first
|
|
inside-box level, then the first remembered meta-inside level, and finally the first active
|
|
level. The distance accumulators are never updated, so they do not rank later candidates."
|
|
(let ((target-position (target-pos 0)))
|
|
(let ((continue-level-name (-> *game-info* current-continue level)))
|
|
(dotimes (i (-> this length))
|
|
(let ((active-level (-> this level i)))
|
|
(when (= (-> active-level status) 'active)
|
|
(if (= (-> active-level name) continue-level-name) (return active-level))))))
|
|
(let ((inside-level (the-as level #f)))
|
|
(let ((unused-distance-limit 0.0)) ;; This is never updated, so the first match wins.
|
|
(dotimes (i (-> this length))
|
|
(let ((active-level (-> this level i)))
|
|
(when (= (-> active-level status) 'active)
|
|
(let ((distance (vector-vector-distance (-> active-level bsp bsphere) target-position)))
|
|
(if (and (-> active-level inside-boxes?) (or (not inside-level) (< distance unused-distance-limit)))
|
|
(set! inside-level active-level)))))))
|
|
(if inside-level (return inside-level))))
|
|
(dotimes (i (-> this length))
|
|
(let ((active-level (-> this level i)))
|
|
(when (= (-> active-level status) 'active)
|
|
(if (-> active-level meta-inside?) (return active-level)))))
|
|
(let ((selected-level (the-as level #f)))
|
|
(let ((unused-distance-limit 0.0)) ;; This is never updated, so the first active level wins.
|
|
(dotimes (i (-> this length))
|
|
(let ((active-level (-> this level i)))
|
|
(when (= (-> active-level status) 'active)
|
|
(if (or (not selected-level) (< (-> active-level level-distance) unused-distance-limit)) (set! selected-level active-level))))))
|
|
selected-level))
|
|
|
|
(defmethod load-commands-set! ((this level-group) (load-commands pair))
|
|
"Replace the level group's pending load-command list and return it."
|
|
(set! (-> this load-commands) load-commands)
|
|
load-commands)
|
|
|
|
(defmethod mem-usage ((this level-group) (usage memory-usage-block) (flags mem-usage-flags))
|
|
"Account for every allocated level slot."
|
|
;; get memory usage of each level
|
|
(dotimes (i (-> this length))
|
|
(mem-usage (-> this level i) usage flags))
|
|
this)
|
|
|
|
(defun bg ((level-name symbol))
|
|
"Load and activate one level for the background/debug entry point. Accept its canonical name,
|
|
VIS name, or nickname; load its runtime packages, initialize load-state and continue state, and
|
|
synchronously advance loading when no display process exists."
|
|
(set! *cheat-mode* (if *debug-segment* 'debug #f))
|
|
(let ((info (lookup-level-info level-name)))
|
|
(cond
|
|
((= (-> info visname) level-name) (set! (-> *level* vis?) #t) (set! level-name (-> info name)))
|
|
(else (set! (-> *level* vis?) #f) (set! (-> *kernel-context* low-memory-message) #f)))
|
|
(let* ((packages (-> info run-packages))
|
|
(package (car packages)))
|
|
(while (not (null? packages))
|
|
(let ((package-type (rtype-of package)))
|
|
(cond
|
|
((= package-type symbol) (load-package (symbol->string (the-as symbol package)) global))
|
|
((= package-type string) (load-package (the-as string package) global))))
|
|
(set! packages (cdr packages))
|
|
(set! package (car packages)))))
|
|
(let ((loaded-level (level-get-for-use *level* level-name 'active)))
|
|
(while (and loaded-level
|
|
(or (= (-> loaded-level status) 'loading) (= (-> loaded-level status) 'loading-bt) (= (-> loaded-level status) 'login))
|
|
(not *dproc*))
|
|
(load-continue loaded-level))
|
|
(vis-load loaded-level)
|
|
(set! (-> *load-state* vis-nick) (if (-> *level* vis?) (-> loaded-level nickname) #f))
|
|
(set! (-> *load-state* want 0 name) (-> loaded-level name))
|
|
(set! (-> *load-state* want 0 display?) 'display)
|
|
(set! (-> *load-state* want 0 force-vis?) #f)
|
|
(set! (-> *load-state* want 0 force-inside?) #f)
|
|
(set! (-> *load-state* want 1 name) #f)
|
|
(set! (-> *load-state* want 1 display?) #f)
|
|
(set! (-> *load-state* want 1 force-inside?) #f)
|
|
(if (-> loaded-level info continues)
|
|
(set-continue! *game-info* (the-as continue-point (car (-> loaded-level info continues))))))
|
|
(activate-levels! *level*)
|
|
(set! *print-login* #f)
|
|
0)
|
|
|
|
(defun play ((vis-enabled symbol) (initialize-progress symbol))
|
|
"Initialize the normal game entry point: choose the startup level from the boot message, allocate
|
|
level heaps, reset presentation and load state, load and activate the startup level, start the
|
|
display process, and optionally initialize game progress."
|
|
;; temp
|
|
(format #t "(play :use-vis ~A :init-game ~A) has been called!~%" vis-enabled initialize-progress)
|
|
(format 0 "(play :use-vis ~A :init-game ~A) has been called!~%" vis-enabled initialize-progress)
|
|
(format 0 "*kernel-boot-message*: ~A~%" *kernel-boot-message*)
|
|
;;(kernel-shutdown)
|
|
(let ((startup-level (case *kernel-boot-message*
|
|
(('play) (if *debug-segment* 'village1 'title))
|
|
(else 'demo))))
|
|
(stop 'play)
|
|
(set! (-> *level* vis?) vis-enabled)
|
|
(set! (-> *level* want-level) #f)
|
|
(set! (-> *level* border?) #t)
|
|
(set! (-> *setting-control* default border-mode) #t)
|
|
(set! (-> *level* play?) #t)
|
|
(alloc-levels! *level* #f) ;;#t)
|
|
(set! *display-profile* #f)
|
|
(set! *cheat-mode* (if *debug-segment* 'debug #f))
|
|
(set! *time-of-day-fast* #f)
|
|
(load-commands-set! *level* '())
|
|
(when *time-of-day-proc*
|
|
(set! (-> *time-of-day-proc* 0 time-ratio) (fsec 1.0))
|
|
(set! (-> *time-of-day-proc* 0 hour) 7) ;; 7AM waking up in the morning
|
|
)
|
|
(set-blackout-frames 6)
|
|
(unless *dproc*
|
|
(reset! *load-state*)
|
|
(let ((startup-level-data (level-get-for-use *level* startup-level 'active)))
|
|
(load-state-want-levels startup-level #f)
|
|
(load-state-want-display-level startup-level 'display)
|
|
(load-state-want-vis (-> (lookup-level-info startup-level) nickname))
|
|
(while (and startup-level-data
|
|
(or (= (-> startup-level-data status) 'loading)
|
|
(= (-> startup-level-data status) 'loading-bt)
|
|
(= (-> startup-level-data status) 'login)))
|
|
(set-blackout-frames 6)
|
|
(load-continue startup-level-data))))
|
|
(set! *print-login* #f)
|
|
(level-status-set! (level-get *level* startup-level) 'active))
|
|
(load-dbg "Load complete. Level: ~A. Now starting display!~%" (-> *level* level0))
|
|
(on #t)
|
|
(load-dbg "Display started: ~A~%" *dproc*)
|
|
(when initialize-progress
|
|
(initialize! *game-info* 'game (the-as game-save #f) (the-as string #f)))
|
|
0)
|
|
|
|
(defun update-sound-banks ()
|
|
"Reconcile the two resident sound-bank slots with the distinct banks required by active levels.
|
|
Do nothing while the loader RPC is busy or a movie is active, report more than two requirements,
|
|
and perform at most one load or unload per call."
|
|
(if (nonzero? (rpc-busy? RPC-SOUND-LOADER)) (return 0))
|
|
(let ((required-bank-a #f)
|
|
(required-bank-b #f))
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(let* ((banks (-> active-level info sound-banks))
|
|
(bank (the-as symbol (car banks))))
|
|
(while (not (null? banks))
|
|
(cond
|
|
((or (= required-bank-a bank) (= required-bank-b bank) (-> *setting-control* current movie)))
|
|
((not required-bank-a) (set! required-bank-a bank))
|
|
((not required-bank-b) (set! required-bank-b bank))
|
|
(else (format 0 "ERROR: Soundbanks ~A, ~A and ~A all required~%" required-bank-a required-bank-b bank)))
|
|
(set! banks (cdr banks))
|
|
(set! bank (the-as symbol (car banks))))))))
|
|
(when (and required-bank-a (!= required-bank-a *sound-bank-1*) (!= required-bank-a *sound-bank-2*))
|
|
(when (not *sound-bank-1*)
|
|
(format 0 "Load soundbank ~A~%" required-bank-a)
|
|
(sound-bank-load (string->sound-name (symbol->string required-bank-a)))
|
|
(set! *sound-bank-1* required-bank-a)
|
|
(return 0))
|
|
(when (not *sound-bank-2*)
|
|
(format 0 "Load soundbank ~A~%" required-bank-a)
|
|
(sound-bank-load (string->sound-name (symbol->string required-bank-a)))
|
|
(set! *sound-bank-2* required-bank-a)
|
|
(return 0))
|
|
(when (!= *sound-bank-1* required-bank-b)
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-1*)
|
|
(sound-bank-unload (string->sound-name (symbol->string *sound-bank-1*)))
|
|
(set! *sound-bank-1* #f)
|
|
(return 0))
|
|
(when (!= *sound-bank-2* required-bank-b)
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-2*)
|
|
(sound-bank-unload (string->sound-name (symbol->string *sound-bank-2*)))
|
|
(set! *sound-bank-2* #f)
|
|
(return 0)))
|
|
(when (and required-bank-b (!= required-bank-b *sound-bank-1*) (!= required-bank-b *sound-bank-2*))
|
|
(when (not *sound-bank-1*)
|
|
(format 0 "Load soundbank ~A~%" required-bank-b)
|
|
(sound-bank-load (string->sound-name (symbol->string required-bank-b)))
|
|
(set! *sound-bank-1* required-bank-b)
|
|
(return 0))
|
|
(when (not *sound-bank-2*)
|
|
(format 0 "Load soundbank ~A~%" required-bank-b)
|
|
(sound-bank-load (string->sound-name (symbol->string required-bank-b)))
|
|
(set! *sound-bank-2* required-bank-b)
|
|
(return 0))
|
|
(when (!= *sound-bank-1* required-bank-a)
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-1*)
|
|
(sound-bank-unload (string->sound-name (symbol->string *sound-bank-1*)))
|
|
(set! *sound-bank-1* #f)
|
|
(return 0))
|
|
(when (!= *sound-bank-2* required-bank-a)
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-2*)
|
|
(sound-bank-unload (string->sound-name (symbol->string *sound-bank-2*)))
|
|
(set! *sound-bank-2* #f)
|
|
(return 0))))
|
|
0)
|
|
|
|
(defmethod update! ((this load-state))
|
|
"Advance requested level loading, display, forced-visibility, and forced-inside state. Discard
|
|
unrequested levels before starting another load, wait synchronously only when both ordinary
|
|
slots were empty and the requested display mode requires it, then switch the active VIS file
|
|
after entering the requested level's boxes."
|
|
(update-sound-banks)
|
|
(let ((discarded-level #f))
|
|
(dotimes (level-index 2)
|
|
(let ((loaded-level (-> *level* level level-index)))
|
|
(when (!= (-> loaded-level status) 'inactive)
|
|
(let ((requested #f))
|
|
(dotimes (request-index 2)
|
|
(if (= (-> loaded-level name) (-> this want request-index name)) (set! requested #t)))
|
|
(when (not requested)
|
|
(format 0 "Discarding level ~A~%" (-> loaded-level name))
|
|
(level-status-set! loaded-level 'inactive)
|
|
(set! discarded-level #t)
|
|
(#when PC_PORT
|
|
(when *debug-segment*
|
|
(define-extern *entity* entity)
|
|
(set! *entity* (the entity #f)))))))))
|
|
(let ((ordinary-slots-empty #f))
|
|
(if (and (= (-> *level* level0 status) 'inactive) (= (-> *level* level1 status) 'inactive)) (set! ordinary-slots-empty #t))
|
|
(if discarded-level (return 0))
|
|
(let ((need-level0 #f)
|
|
(need-level1 #f))
|
|
(when (-> this want 0 name)
|
|
(set! need-level0 #t)
|
|
(dotimes (level-index 3)
|
|
(let ((loaded-level (-> *level* level level-index)))
|
|
(if (and (!= (-> loaded-level status) 'inactive) (= (-> loaded-level name) (-> this want 0 name))) (set! need-level0 #f)))))
|
|
(when (-> this want 1 name)
|
|
(set! need-level1 #t)
|
|
(dotimes (level-index 3)
|
|
(let ((loaded-level (-> *level* level level-index)))
|
|
(if (and (!= (-> loaded-level status) 'inactive) (= (-> loaded-level name) (-> this want 1 name))) (set! need-level1 #f)))))
|
|
(let ((request-to-load -1))
|
|
(cond
|
|
((and need-level0 need-level1)
|
|
(set! request-to-load 0)
|
|
(if (and (-> this want 1 display?) (not (-> this want 0 display?))) (set! request-to-load 1)))
|
|
(need-level0 (set! request-to-load 0))
|
|
(need-level1 (set! request-to-load 1)))
|
|
(when (!= request-to-load -1)
|
|
(when (or ordinary-slots-empty (not (check-busy *load-dgo-rpc*)))
|
|
(format 0 "Adding level ~A~%" (-> this want request-to-load name))
|
|
(let ((requested-level (level-get-for-use *level* (the-as symbol (-> this want request-to-load name)) 'loaded)))
|
|
(when (and ordinary-slots-empty (-> this want request-to-load display?))
|
|
(format 0 "Waiting for level to load~%")
|
|
(while (or (= (-> requested-level status) 'loading)
|
|
(= (-> requested-level status) 'loading-bt)
|
|
(= (-> requested-level status) 'login))
|
|
(load-continue requested-level))))))))))
|
|
(dotimes (request-index 2)
|
|
(when (-> this want request-index name)
|
|
(dotimes (level-index 3)
|
|
(let ((loaded-level (-> *level* level level-index)))
|
|
(when (!= (-> loaded-level status) 'inactive)
|
|
(when (= (-> loaded-level name) (-> this want request-index name))
|
|
(when (!= (-> loaded-level display?) (-> this want request-index display?))
|
|
(cond
|
|
((not (-> loaded-level display?))
|
|
(cond
|
|
((or (= (-> loaded-level status) 'loaded) (= (-> loaded-level status) 'active))
|
|
(format 0 "Displaying level ~A [~A]~%" (-> this want request-index name) (-> this want request-index display?))
|
|
(level-get-for-use *level* (-> loaded-level info name) 'active)
|
|
(set! (-> loaded-level display?) (-> this want request-index display?)))
|
|
(else
|
|
(when (and (-> loaded-level info wait-for-load) (!= (-> this want request-index display?) 'display-no-wait))
|
|
(send-event *target* 'loading))
|
|
(if (= *cheat-mode* 'debug) (format *stdcon* "display on for ~A but level is loading~%" (-> this want request-index name))))))
|
|
(else
|
|
(cond
|
|
((not (-> this want request-index display?))
|
|
(set! (-> loaded-level display?) #f)
|
|
(format 0 "Turning level ~A off~%" (-> loaded-level name))
|
|
(deactivate loaded-level))
|
|
(else
|
|
(format 0
|
|
"Setting level ~A display command to ~A~%"
|
|
(-> this want request-index name)
|
|
(-> this want request-index display?))
|
|
(set! (-> loaded-level display?) (-> this want request-index display?)))))))
|
|
(when (!= (-> loaded-level force-all-visible?) (-> this want request-index force-vis?))
|
|
(set! (-> loaded-level force-all-visible?) (-> this want request-index force-vis?))
|
|
(format 0
|
|
"Setting force-all-visible?[~A] to ~A~%"
|
|
(-> this want request-index name)
|
|
(-> this want request-index force-vis?)))
|
|
(when (!= (-> loaded-level force-inside?) (-> this want request-index force-inside?))
|
|
(set! (-> loaded-level force-inside?) (-> this want request-index force-inside?))
|
|
(format 0
|
|
"Setting force-inside?[~A] to ~A~%"
|
|
(-> this want request-index name)
|
|
(-> this want request-index force-inside?)))))))))
|
|
;; load vis info.
|
|
;; The load-state's vis-nick is the level we want vis data for.
|
|
;; Note that we won't load vis until we are inside the level's boxes.
|
|
;; this will be the level that is currently being used.
|
|
(let ((loaded-vis-nick #f))
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(when (= (-> active-level status) 'active) ;; level is active
|
|
(if (nonzero? (-> active-level vis-info (-> active-level vis-self-index) ramdisk)) ;; and vis is set up.
|
|
(set! loaded-vis-nick (-> active-level nickname))))))
|
|
;; if we have the wrong vis
|
|
(when (and (!= loaded-vis-nick (-> this vis-nick)) (-> *level* vis?))
|
|
;; and we want a vis
|
|
(when (-> this vis-nick)
|
|
;; find matching level and load vis
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(if (and (= (-> active-level nickname) (-> this vis-nick))
|
|
(-> active-level inside-boxes?) ;; note: only start if we are inside boxes.
|
|
)
|
|
(load-vis-info (-> this vis-nick) loaded-vis-nick))))))))
|
|
0)
|
|
|
|
;; method 16 level-group (debug text stuff)
|
|
|
|
(defmethod level-update ((this level-group))
|
|
"Advance settings, art and DGO loading, inside-box and checkpoint state, load-state requests,
|
|
neighboring VIS selection and ownership, and level debug displays for this frame. Publish both
|
|
displayed BSP names to the PC renderer."
|
|
;; this does nothing...
|
|
(camera-pos)
|
|
(new 'static 'boxed-array :type symbol :length 0 :allocated-length 2)
|
|
;; compute the settings for this frame
|
|
(update *setting-control*)
|
|
;; run the art loading system
|
|
(update *art-control* #t)
|
|
(clear-rec *art-control*)
|
|
;; run level loading!
|
|
(dotimes (load-slot 2)
|
|
(load-continue (-> this level load-slot)))
|
|
;; compute inside for each level
|
|
(dotimes (level-index (-> this length))
|
|
(let ((active-level (-> this level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(set! (-> active-level inside-boxes?) (point-in-boxes? active-level (-> *math-camera* trans)))
|
|
(set! (-> active-level inside-sphere?) (>= (-> active-level bsp bsphere w) (-> active-level level-distance)))
|
|
;; being inside sets your meta-inside to #t. If you are outside, remember your old inside.
|
|
(if (-> active-level inside-boxes?) (set! (-> active-level meta-inside?) #t)))))
|
|
;; update load state machine (the level-border one)
|
|
(update! *load-state*)
|
|
;; checkpoint assignment
|
|
(dotimes (level-index (-> this length))
|
|
(let ((active-level (-> this level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
;; if you're outside here, and inside somewhere else, kick out of meta inside.
|
|
(if (and (-> active-level inside-boxes?) (not (-> active-level other inside-boxes?)))
|
|
(set! (-> active-level other meta-inside?) #f))
|
|
(when (and (null? (-> this load-commands))
|
|
(= (-> active-level nickname) (-> *load-state* vis-nick))
|
|
(!= (-> active-level name) (-> *game-info* current-continue level))
|
|
(-> *level* border?))
|
|
(let ((nearest-continue (the-as continue-point (car (-> active-level info continues)))))
|
|
(let* ((target-position (target-pos 0))
|
|
(continues (-> active-level info continues))
|
|
(candidate-continue (the-as continue-point (car continues))))
|
|
(while (not (null? continues))
|
|
(if (and (< (vector-vector-distance target-position (-> candidate-continue trans))
|
|
(vector-vector-distance target-position (-> nearest-continue trans)))
|
|
(zero? (-> candidate-continue flags)))
|
|
(set! nearest-continue candidate-continue))
|
|
(set! continues (cdr continues))
|
|
(set! candidate-continue (the-as continue-point (car continues))))
|
|
(set-continue! *game-info* nearest-continue)))))))
|
|
;; determine vis info idx for each level
|
|
(dotimes (level-index (-> this length))
|
|
(let ((active-level (-> this level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
;; self is always 0
|
|
(set! (-> active-level vis-self-index) 0)
|
|
;; neighbor level defaults to 7 (null placeholder)...
|
|
(set! (-> active-level vis-adj-index) 7)
|
|
;; but if there's a second level that's active, search for a vis info for that level...
|
|
(when (= (-> active-level other status) 'active)
|
|
(dotimes (vis-index 8)
|
|
(if (and (-> active-level vis-info vis-index)
|
|
(= (-> active-level vis-info vis-index from-level) (-> active-level other load-name)))
|
|
;; and store it in the adj index.
|
|
(set! (-> active-level vis-adj-index) vis-index)))))))
|
|
;; display level vis info
|
|
(when *display-level-border*
|
|
(dotimes (level-index (-> this length))
|
|
(let ((active-level (-> this level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(let ((border-flags (-> active-level bsp current-bsp-back-flags)))
|
|
(dotimes (neighbor-index 6)
|
|
(when (and (logtest? border-flags 3) (-> active-level vis-info (+ neighbor-index 1)))
|
|
(let ((neighbor-info (lookup-level-info (-> active-level vis-info (+ neighbor-index 1) from-level))))
|
|
(format *stdcon*
|
|
" ~A -> ~A: load: ~A display: ~A~%"
|
|
(-> active-level name)
|
|
(-> neighbor-info name)
|
|
(logtest? border-flags 1)
|
|
(logtest? border-flags 2))))
|
|
(set! border-flags (shr border-flags 2))))))))
|
|
;; if we have vis for level A, but we aren't "in" it, display an error and
|
|
;; force us out of the other level. Ideally the boxes and the load boundary system
|
|
;; will be consistent and there is no way to set a vis to a level that we aren't in.
|
|
;; (you can be "in" multiple levels at the same time, when crossing levels, it is expected
|
|
;; that you are in both.)
|
|
(dotimes (level-index (-> this length))
|
|
(let ((active-level (-> this level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(when (and (= (-> active-level nickname) (-> *load-state* vis-nick)) ;; vis for A
|
|
(not (-> active-level inside-boxes?)) ;; but not in A
|
|
)
|
|
(if (and (= *cheat-mode* 'debug) (-> active-level other inside-boxes?))
|
|
(format *stdcon* "~3LForcing outside of ~A [bad split boxes]~%~0L" (-> active-level other name)))
|
|
(set! (-> active-level other inside-boxes?) #f)))))
|
|
;; if we are outside of the boxes, we consider ourselves "outside of bsp"
|
|
;; if we are outside of both levels boxes, then we don't really know what to do
|
|
;; for vis, and we can display the classic "outside of bsp" error.
|
|
(cond
|
|
((not (or (-> this level0 inside-boxes?) (-> this level1 inside-boxes?)))
|
|
(when (or (-> this level0 vis-info 0) (-> this level1 vis-info 0))
|
|
(if (= *cheat-mode* 'debug) (format *stdcon* "~3Loutside of bsp~%~0L"))))
|
|
(else
|
|
;; we are in at least one bsp.
|
|
;; now we need to link vis info to bsps.
|
|
(dotimes (level-index (-> this length))
|
|
(let ((active-level (-> this level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
;; loop over vis infos
|
|
(dotimes (vis-index 8)
|
|
(let ((vis-record (-> active-level vis-info vis-index)))
|
|
(when vis-record
|
|
;; clear bit 31
|
|
(logclear! (-> vis-record flags) (vis-info-flag using-this-as-only-vis))
|
|
;; link info to bsp
|
|
(cond
|
|
((= vis-index (-> active-level vis-self-index)) (set! (-> vis-record from-bsp) (-> active-level bsp)))
|
|
((= vis-index (-> active-level vis-adj-index)) (set! (-> vis-record from-bsp) (-> active-level other bsp)))
|
|
(else (set! (-> vis-record from-bsp) #f))))))
|
|
;; cam-update only consumes a VIS record with using-this-as-only-vis set. Select the
|
|
;; self or adjacent record according to the display override and which split boxes
|
|
;; contain the camera.
|
|
(cond
|
|
;; special display self mode.
|
|
((= (-> active-level display?) 'display-self)
|
|
(let ((self-vis (-> active-level vis-info (-> active-level vis-self-index))))
|
|
(if self-vis (logior! (-> self-vis flags) (vis-info-flag using-this-as-only-vis)))))
|
|
;; in this level, but not the other, only use vis for this.
|
|
((and (-> active-level inside-boxes?) (not (-> active-level other inside-boxes?)))
|
|
(let ((self-vis (-> active-level vis-info (-> active-level vis-self-index))))
|
|
(if self-vis (logior! (-> self-vis flags) (vis-info-flag using-this-as-only-vis)))))
|
|
;; only in other level, only use vis for other.
|
|
((-> active-level other inside-boxes?)
|
|
(let ((adjacent-vis (-> active-level vis-info (-> active-level vis-adj-index))))
|
|
(if adjacent-vis (logior! (-> adjacent-vis flags) (vis-info-flag using-this-as-only-vis)))))))))))
|
|
(when (or *display-level-border* *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?))
|
|
(format *stdcon*
|
|
" nick ~A cur ~S cont ~A~%~%"
|
|
(-> *load-state* vis-nick)
|
|
(let ((lev-name (and *target* (-> *target* current-level name)))) (if lev-name (symbol->string lev-name)))
|
|
(-> *game-info* current-continue name))
|
|
; (let ((t9-16 format)
|
|
; (a0-53 *stdcon*)
|
|
; (a1-49 " nick ~A cur ~S cont ~A~%~%")
|
|
; (a2-24 (-> *load-state* vis-nick))
|
|
; (v1-142 (and *target* (-> *target* current-level name)))
|
|
; )
|
|
; (t9-16 a0-53 a1-49 a2-24 (if v1-142
|
|
; (->
|
|
; (the-as
|
|
; (pointer uint32)
|
|
; (+ #xff38 (the-as int v1-142))
|
|
; )
|
|
; )
|
|
; )
|
|
; (-> *game-info* current-continue name)
|
|
; )
|
|
; )
|
|
)
|
|
(dotimes (level-index (-> this length))
|
|
(let ((active-level (-> this level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(format *stdcon*
|
|
"~A: ~S ~A~%"
|
|
(-> active-level name)
|
|
(if (point-in-boxes? active-level (-> *math-camera* trans)) "inside")
|
|
(-> active-level display?))
|
|
(when *display-texture-download*
|
|
(format *stdcon* " tfrag: ~8,,0m " (-> active-level closest-object 0))
|
|
(format *stdcon* " shrub: ~8,,0m " (-> active-level closest-object 2))
|
|
(format *stdcon* " alpha: ~8,,0m #x~8X~%" (-> active-level closest-object 3) (-> active-level texture-mask 8))
|
|
(format *stdcon* " tie: ~8,,0m " (-> active-level closest-object 5))
|
|
(format *stdcon* " fg-tf: ~8,,0m " (-> active-level closest-object 6))
|
|
(format *stdcon* " fg-pr: ~8,,0m #x~8X~%" (-> active-level closest-object 7) (-> active-level texture-mask 7))
|
|
(format *stdcon*
|
|
" tf: ~8D pr: ~8D sh: ~8D al: ~8D wa: ~8D~%~1K"
|
|
(-> active-level upload-size 0)
|
|
(-> active-level upload-size 1)
|
|
(-> active-level upload-size 2)
|
|
(-> active-level upload-size 3)
|
|
(-> active-level upload-size 4)))
|
|
(if *display-split-box-info* (debug-print-splitbox active-level (-> *math-camera* trans) *stdcon*))))))
|
|
;; tell PC port about our levels
|
|
(__pc-set-levels (if (symbol-member? (-> this level0 status) '(active alive loaded)) (symbol->string (bsp-name (-> this level0))) "none")
|
|
(if (symbol-member? (-> this level1 status) '(active alive loaded)) (symbol->string (bsp-name (-> this level1))) "none"))
|
|
0)
|
|
|
|
(defun-debug show-level ((level-name symbol))
|
|
"Keep the target's current level requested and add level-name as the displayed neighbor."
|
|
(set! (-> *setting-control* default border-mode) #t)
|
|
(load-state-want-levels (-> (level-get-target-inside *level*) name) level-name)
|
|
(load-state-want-display-level level-name 'display)
|
|
0)
|
|
|
|
;; init art buffers and engines
|
|
(defconstant FOREGROUND_DRAW_MAX_COUNT_0 (* PROCESS_HEAP_MULT 280))
|
|
|
|
(defconstant FOREGROUND_DRAW_MAX_COUNT_2 (* PROCESS_HEAP_MULT 16))
|
|
|
|
(defconstant DEFAULT_DRAW_MAX_COUNT_0 (* PROCESS_HEAP_MULT 280))
|
|
|
|
(defconstant DEFAULT_DRAW_MAX_COUNT_2 (* PROCESS_HEAP_MULT 10))
|
|
|
|
(when (zero? (-> *level* level0 art-group))
|
|
(let ((lev-group *level*))
|
|
(set! (-> lev-group vis?) #f)
|
|
(set! (-> lev-group loading-level) (-> lev-group level-default))
|
|
(set! (-> lev-group level0 art-group) (new 'global 'load-dir-art-group 50 (-> lev-group level0)))
|
|
(set! (-> lev-group level0 foreground-draw-engine 0) (new 'global 'engine 'draw FOREGROUND_DRAW_MAX_COUNT_0))
|
|
(set! (-> lev-group level0 foreground-draw-engine 1) (new 'global 'engine 'draw FOREGROUND_DRAW_MAX_COUNT_0))
|
|
(set! (-> lev-group level0 foreground-draw-engine 2) (new 'global 'engine 'draw FOREGROUND_DRAW_MAX_COUNT_2))
|
|
(set! (-> lev-group level1 art-group) (new 'global 'load-dir-art-group 50 (-> lev-group level1)))
|
|
(set! (-> lev-group level1 foreground-draw-engine 0) (new 'global 'engine 'draw FOREGROUND_DRAW_MAX_COUNT_0))
|
|
(set! (-> lev-group level1 foreground-draw-engine 1) (new 'global 'engine 'draw FOREGROUND_DRAW_MAX_COUNT_0))
|
|
(set! (-> lev-group level1 foreground-draw-engine 2) (new 'global 'engine 'draw FOREGROUND_DRAW_MAX_COUNT_2))
|
|
(set! (-> lev-group level-default art-group) (new 'global 'load-dir-art-group 50 (-> lev-group level1)))
|
|
(set! (-> lev-group level-default foreground-draw-engine 0) (new 'global 'engine 'draw DEFAULT_DRAW_MAX_COUNT_0))
|
|
(set! (-> lev-group level-default foreground-draw-engine 1) (new 'global 'engine 'draw DEFAULT_DRAW_MAX_COUNT_2))
|
|
(set! (-> lev-group level0 other) (-> lev-group level1))
|
|
(set! (-> lev-group level1 other) (-> lev-group level0))
|
|
(set! (-> lev-group level-default other) #f)
|
|
(dotimes (i 2)
|
|
(let ((lev (-> lev-group level i))) (set! (-> lev vis-bits) (malloc 'global 2048)) (vis-clear lev)))
|
|
(dotimes (i 3)
|
|
(let ((lev (-> lev-group level i)))
|
|
(set! (-> lev linking) #f)
|
|
(dotimes (ii 3)
|
|
(set! (-> lev foreground-sink-group ii level) lev))))))
|
|
|
|
(defmacro test-play ()
|
|
`(begin
|
|
;; before calling play, the C Kernel would set this.
|
|
(define *kernel-boot-message* 'play)
|
|
(load-package "game" global)
|
|
(play #t #t)))
|