mirror of
https://github.com/open-goal/jak-project
synced 2026-06-03 18:36:52 -04:00
Matt Dallmeyer
03cae68c7d
Fixes #3644 which I believe is the same underlying issue as "NG+ glitch" To reproduce the issue in #3644 you can: - choose Hub 2 100% in the speedrun fast reset menu - hit the blue sage warp gate switch - go deep enough into any adjacent level (e.g. basin) where `village2` display is turned off - reset speedrun in the fast reset menu - tasks are reset but the switch will be pressed, giving the cutscene early You can also grab orbs/scout flies in `village2`, and they won't be reset properly because of this same bug. It happens because of the way entity perm status is managed across both `level` vs `game-info` objects. - when `village2` is deactivated (still loaded but display hidden), its entity perms are copied to `game-info`'s `perm-list` - this is how we persist `warp-gate-switch-7` being pressed if village2 is ever unloaded - during the speedrun reset `reset-actors` is called: - any active levels (loaded+displayed) have their entity perm statuses reset - because `village2` is not displayed yet, its entity perm statuses are not touched - `game-info` is re-initialized, clearing out its `perm-list` - continue is set to `firecanyon-end` - this unloads `rolling` or whatever to make room for `firecanyon` - `village2` is already loaded, and just gets displayed - at this point the game does copy entity perm status from `game-info` back to the `village2` level - but we reset the game, so it has no data about the warp-gate-switch, leaving it pressed!
1421 lines
68 KiB
Common Lisp
1421 lines
68 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))
|
|
"Get the level-load-info of a level using its name. name can be the level name, the visname or the nickname. First match is returned."
|
|
(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))
|
|
"Get the n-th load command for the given level."
|
|
(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 ((level-info level-load-info))
|
|
"Get the canonical name for a level using its level-load-info"
|
|
(if (-> *level* vis?) (-> level-info visname) (-> level-info name)))
|
|
|
|
(defmethod art-group-get-by-name ((this level) (arg0 string))
|
|
"Get the art group in the given level with the given name.
|
|
If it doesn't exist, #f."
|
|
(countdown (i (-> this art-group art-group-array length))
|
|
(if (name= (-> this art-group art-group-array i name) arg0) (return (-> this art-group art-group-array i))))
|
|
(the-as art-group #f))
|
|
|
|
(defmethod bsp-name ((this level))
|
|
"Get the name of the bsp tree of the level"
|
|
(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 ((arg0 bsp-header) (arg1 level) (arg2 symbol) (arg3 display-frame))
|
|
"Draw a level!"
|
|
;; do the draw
|
|
(draw arg0 arg0 arg3)
|
|
(if (nonzero? *display-strip-lines*) (debug-draw arg0 arg0 arg3))
|
|
(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) (dest-heap kheap) (name (pointer uint8)))
|
|
"Handle a bsp file load."
|
|
;; we expect that we'll have a loading-level set when we link/login a bsp-header
|
|
(let ((s5-0 (-> *level* loading-level)))
|
|
(if s5-0
|
|
(cond
|
|
(this
|
|
(cond
|
|
((not (type-type? (-> this type) bsp-header))
|
|
(format 0 "ERROR: level ~A is not a bsp-header.~%" (-> s5-0 name))
|
|
(the-as bsp-header #f))
|
|
((not (file-info-correct-version? (-> this info) (file-kind level-bt) 0)) (the-as bsp-header #f))
|
|
((< 2048 (-> this visible-list-length))
|
|
(format 0
|
|
"ERROR: level ~A visible-list-length ~d is greater than 2048 (16384 drawables).~%"
|
|
(-> s5-0 name)
|
|
(-> this visible-list-length))
|
|
(the-as bsp-header #f))
|
|
(else
|
|
(load-dbg "bsp relocate: ~A~%" this)
|
|
;; everything is okay, link the bsp and level.
|
|
;; og:preserve-this fix bad filenames
|
|
(when (= (-> s5-0 name) 'title)
|
|
(set! (-> this name) 'title))
|
|
(when (= (-> s5-0 name) 'demo)
|
|
(set! (-> this name) 'demo))
|
|
(set! (-> s5-0 bsp) this)
|
|
(set! (-> this level) s5-0)
|
|
this)))
|
|
(else (format 0 "ERROR: level ~A is not a valid file.~%" (-> s5-0 name)) (the-as bsp-header #f)))))
|
|
(none))
|
|
|
|
(defmethod load-required-packages ((this level))
|
|
"Load required packages for the level. This is mostly useless, but might load common.
|
|
This will have no effect most of the time - common is often loaded at boot as part of
|
|
game.cgo."
|
|
(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 the visibility info for when the level is loading."
|
|
;; clear vis-infos, so we can't try to look up a vis string.
|
|
(countdown (v1-0 8)
|
|
(nop!) ;; the usual.
|
|
(set! (-> this vis-info v1-0) #f))
|
|
;; set the vis string to all 0s.
|
|
(dotimes (v1-3 128)
|
|
(set! (deref int128 (-> this vis-bits) v1-3) (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))
|
|
"Start the initial load of a VIS file to the IOP VIS buffer. After this is done, we can use
|
|
ramdisk-load to load chunks."
|
|
;; 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 ((vis (-> this other vis-info (-> this other vis-self-index))))
|
|
(when (and vis (nonzero? (-> vis ramdisk)))
|
|
(set! (-> vis flags) (logand #xffffffffbfffffff (-> vis flags))) ;; clear waiting-for-load
|
|
(set! (-> vis ramdisk) 0)
|
|
0))
|
|
;; set up a ramdisk rpc (fill command, actually load the file from DVD to IOP buffer)
|
|
(let ((visname (make-file-name (file-kind vis) (the-as string (-> this nickname)) 0 #f))
|
|
(cmd (the-as ramdisk-rpc-fill (add-element *ramdisk-rpc*)))
|
|
(s5-0 (+ *current-ramdisk-id* 1)))
|
|
(set! *current-ramdisk-id* s5-0)
|
|
(set! (-> cmd filename) (string->sound-name visname))
|
|
(set! (-> cmd ee-id) s5-0)
|
|
(load-dbg "doing ramdisk vis load: ~A~%" visname)
|
|
(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) s5-0)))
|
|
;; return the ramdisk ID.
|
|
(-> this vis-info (-> this vis-self-index) ramdisk))
|
|
|
|
(defun load-vis-info ((vis-name symbol) (old-vis-name symbol))
|
|
"Load a new VIS file and dump the old one. The corresponding level must be active!"
|
|
(dotimes (i (-> *level* length))
|
|
(let ((lev (-> *level* level i)))
|
|
(when (= (-> lev status) 'active)
|
|
(when (= vis-name (-> lev nickname))
|
|
(format 0 "Swapping in ~A VIS [dumping ~A]~%" vis-name old-vis-name)
|
|
(vis-load lev)))))
|
|
0)
|
|
|
|
(defmethod init-vis ((this level))
|
|
"Set up the vis info in a level from the vis info in the BSP."
|
|
(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 ((s5-0 (-> this bsp vis-info 0)))
|
|
;; check that our vis info is valid.
|
|
(cond
|
|
((and s5-0 (nonzero? s5-0) (valid? s5-0 level-vis-info #f #f 0))
|
|
;; add to the level
|
|
(set! (-> this vis-info 0) s5-0)
|
|
;; don't have a string loaded yet
|
|
(set! (-> s5-0 current-vis-string) (the-as uint -1))
|
|
;; link to bsp
|
|
(set! (-> s5-0 from-bsp) (-> this bsp))
|
|
;; the current vis string (uncompressed). The level allocates/manages this.
|
|
(set! (-> s5-0 vis-bits) (-> this vis-bits))
|
|
;; clear waiting-for-load, thirty-one
|
|
(set! (-> s5-0 flags) (logand (the-as uint #xffffffff3fffffff) (-> s5-0 flags)))
|
|
;; set twenty-nine
|
|
(set! (-> s5-0 flags) (logior #x20000000 (-> s5-0 flags)))
|
|
(set! (-> s5-0 ramdisk) (the-as uint 0))
|
|
(set! (-> s5-0 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 (s5-1 6)
|
|
(let* ((s3-0 (+ s5-1 1))
|
|
(s4-0 (-> this bsp vis-info s3-0)))
|
|
(cond
|
|
((and s4-0 (nonzero? s4-0) (valid? s4-0 level-vis-info #f #f 0))
|
|
(set! (-> this vis-info s3-0) s4-0)
|
|
(set! (-> s4-0 current-vis-string) (the-as uint -1))
|
|
(set! (-> s4-0 from-bsp) #f)
|
|
(set! (-> s4-0 vis-bits) (-> this vis-bits))
|
|
;; clear 29, 30, 31
|
|
(set! (-> s4-0 flags) (logand (the-as uint #xffffffff1fffffff) (-> s4-0 flags)))
|
|
(set! *vis-boot* #t))
|
|
(else (set! (-> this vis-info s3-0) #f))))))
|
|
0)
|
|
|
|
(defmethod level-get-for-use ((this level-group) (name symbol) (want-status symbol))
|
|
"Get a level in a playable form, loading it if necessary."
|
|
(local-vars (s5-1 level))
|
|
;; debug allocate levels if necessary
|
|
(alloc-levels! this #f)
|
|
(let* ((level-info (lookup-level-info name))
|
|
(level-name (remap-level-name level-info)))
|
|
(awhen (level-get this level-name) (level-status-set! it want-status) (return it))
|
|
(let ((a0-7 (level-get-most-disposable this))) (set! s5-1 (if a0-7 (level-status-set! a0-7 'inactive) a0-7)))
|
|
;; 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 s5-1) ;;level)
|
|
(format 0 "ERROR: could not find a slot to load ~A into.~%" name)
|
|
(return (the-as level #f)))
|
|
(set! (-> s5-1 info) level-info)
|
|
(set! (-> s5-1 name) name)
|
|
(set! (-> s5-1 load-name) level-name))
|
|
(set! (-> s5-1 mood) (the mood-context (-> s5-1 info mood value)))
|
|
(set! (-> s5-1 mood-func) (the (function mood-context float int none) (-> s5-1 info mood-func value)))
|
|
(set! (-> s5-1 display?) #f)
|
|
(set! (-> s5-1 force-all-visible?) #f)
|
|
(set! (-> s5-1 force-inside?) #f)
|
|
(level-status-set! s5-1 'loading)
|
|
(level-status-set! s5-1 want-status)
|
|
s5-1)
|
|
|
|
;; 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))
|
|
"Get the status of an existing level."
|
|
(let ((lev (level-get *level* level-name))) (if lev (-> lev status))))
|
|
|
|
(defmethod level-status-set! ((this level) (want-status symbol))
|
|
"Change the status of a level, performing any cleanup and prep work as necessary.
|
|
Only change loading statuses in order!
|
|
Returns the level."
|
|
(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 (v1-40 9)
|
|
(set! (-> this closest-object v1-40) 0.0)
|
|
(set! (-> this texture-mask v1-40) (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))
|
|
"Continue loading a level from where we left off last time."
|
|
;; 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-obj #f)
|
|
(a0-15 (dgo-load-get-next (& last-obj))))
|
|
(when a0-15
|
|
;; something has finished loading!
|
|
(cond
|
|
((not last-obj)
|
|
;; not the last object. start linking
|
|
(cond
|
|
((dgo-load-link (the-as dgo-header a0-15) (-> 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 ((a0-26 (the pointer (align64 (-> this heap current)))))
|
|
(cond
|
|
((dgo-load-link (the-as dgo-header a0-26) (-> 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))
|
|
"Start loading the level. Uses 2 megabyte heaps for loading each object."
|
|
;; 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 ((s4-0 (kmalloc (-> this heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2"))
|
|
(s5-2 (kmalloc (-> this heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2")))
|
|
(load-dbg " DGO buffers at #x~X #x~X~%" s4-0 s5-2)
|
|
;; 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* s5-2 s4-0 (the pointer (align64 (-> this heap current)))))
|
|
this)
|
|
|
|
(defmethod login-begin ((this level))
|
|
"Start the login. This is spread over multiple frames."
|
|
;; 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 (-> this bsp)))
|
|
(when (nonzero? (-> bsp adgifs))
|
|
(let ((adgifs (-> bsp 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))
|
|
"Run some small amount of logins.
|
|
This will time itself and stop after some time.
|
|
When it's done, it will set the status to loaded."
|
|
(local-vars (current-timer int) (v1-154 int) (initial-timer int) (sv-16 prototype-bucket-tie) (sv-32 int))
|
|
;; there is some logic for not doing the whole login all at once...
|
|
;; for now, we will somewhat ignore that.
|
|
(let ((level-drawable-trees (-> loaded-level bsp drawable-trees)))
|
|
;;(.mfc0 initial-timer Count)
|
|
(label cfg-1)
|
|
;;(.mfc0 current-timer Count)
|
|
;; this would quit the login function after some amount of time elapsed.
|
|
#|
|
|
(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 (idx-in-drawable (-> current-drawable length))
|
|
(cond
|
|
((= (-> current-drawable data idx-in-drawable 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 idx-in-drawable))
|
|
(+! (-> level-login-state elts) 1))
|
|
(else
|
|
;;(load-dbg " tfrag actual login case~%")
|
|
(login (-> current-drawable data idx-in-drawable))))))
|
|
((= (-> 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 ((v1-39 (- (the-as uint current-login-pos) (the-as uint (-> level-drawable-trees length)))))
|
|
(when (< (the-as int v1-39) (-> loaded-level art-group art-group-array length))
|
|
(let ((s2-2 (-> loaded-level art-group art-group-array v1-39))) (login s2-2) (if (needs-link? s2-2) (link-art! s2-2)))
|
|
(+! (-> 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 ((s1-1 (-> level-login-state elt (-> level-login-state state))))
|
|
(cond
|
|
((= (-> s1-1 type) drawable-inline-array-tfrag)
|
|
;; (load-dbg " login drawable-inline-array-tfrag: ~A~%" s1-1)
|
|
(cond
|
|
((< current-login-pos (-> (the-as drawable-inline-array-tfrag s1-1) length))
|
|
(dotimes (s0-0 200)
|
|
(when (< current-login-pos (-> (the-as drawable-inline-array-tfrag s1-1) length))
|
|
;; (load-dbg " login from drawable-inline-array-tfrag: ~A~%" (-> (the-as drawable-inline-array-tfrag s1-1) data (the-as uint current-login-pos)))
|
|
(login (-> (the-as drawable-inline-array-tfrag s1-1) 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))))
|
|
((= (-> s1-1 type) drawable-tree-instance-tie)
|
|
;;(load-dbg " login drawable-tree-instance-tie: ~A~%" s1-1)
|
|
(let ((s1-2 (-> (the-as drawable-tree-instance-tie s1-1) prototypes prototype-array-tie)))
|
|
(when (< current-login-pos (-> s1-2 length))
|
|
(dotimes (s0-1 10)
|
|
(when (< current-login-pos (-> s1-2 length))
|
|
(set! sv-16 (-> s1-2 array-data (the-as uint current-login-pos)))
|
|
(set! sv-32 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 (!= (-> sv-16 envmap-fade-far) 0.0)
|
|
(*! (-> sv-16 envmap-fade-far) 10000.)))
|
|
(while (< sv-32 4)
|
|
(let ((a0-28 (-> sv-16 geometry sv-32)))
|
|
;;(load-dbg " login geom: ~A~%" a0-28)
|
|
(if (nonzero? a0-28) (login a0-28)))
|
|
(set! sv-32 (+ sv-32 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) (-> s1-2 length))
|
|
(dotimes (s2-3 (-> s1-2 length))
|
|
(let ((s0-2 (-> s1-2 array-data s2-3 envmap-shader)))
|
|
(when (nonzero? s0-2)
|
|
;;(load-dbg " login adgif shader for envmap~%")
|
|
(adgif-shader-login-no-remap s0-2)
|
|
(set! (-> s0-2 tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
|
|
(set! (-> s0-2 clamp) (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
|
|
(set! (-> s0-2 alpha) (new 'static 'gs-alpha :b #x2 :c #x1 :d #x1))
|
|
(set! (-> s0-2 prims 1) (gs-reg64 tex0-1))
|
|
(set! (-> s0-2 prims 3) (gs-reg64 tex1-1))
|
|
(set! (-> s0-2 prims 5) (gs-reg64 miptbp1-1))
|
|
(set! (-> s0-2 clamp-reg) (gs-reg64 clamp-1))
|
|
(set! (-> s0-2 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 ((v1-115 (-> loaded-level bsp)))
|
|
(cond
|
|
((or (zero? (-> v1-115 actors)) (= (the-as uint current-login-pos) (-> v1-115 actors length)))
|
|
(set! (-> level-login-state pos) (the-as uint 0))
|
|
(+! (-> level-login-state state) 1))
|
|
(else
|
|
(let ((a0-36 (-> v1-115 actors data (the-as uint current-login-pos) actor)))
|
|
;; (load-dbg "entity nav login: ~A~%" a0-36)
|
|
(entity-nav-login a0-36))
|
|
(+! (-> 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 ((f0-0 (-> loaded-level bsp unk-data-4))
|
|
(f1-0 (-> loaded-level bsp unk-data-5)))
|
|
(when (and (= f0-0 0.0) (= f1-0 0.0))
|
|
(set! f0-0 122880.0)
|
|
(set! f1-0 286720.0))
|
|
(set! (-> *subdivide-settings* close (-> loaded-level index)) f0-0)
|
|
(set! (-> *subdivide-settings* far (-> loaded-level index)) f1-0)
|
|
(set! (-> *subdivide-settings* close 3) f0-0)
|
|
(set! (-> *subdivide-settings* far 3) f1-0))
|
|
(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)
|
|
; 0
|
|
; (.mfc0 v1-154 Count)
|
|
; (- v1-154 initial-timer)
|
|
(label cfg-78)
|
|
loaded-level)
|
|
|
|
(defmethod birth ((this level))
|
|
"Birth a level to make it alive! It must be loaded."
|
|
(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))
|
|
"Kill the level. This won't remove it from memory."
|
|
(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 (v1-19 128)
|
|
(set! (deref int128 (-> this vis-bits) v1-19) (the-as int128 0)))
|
|
(let ((v1-22 8))
|
|
(while (nonzero? v1-22)
|
|
(+! v1-22 -1)
|
|
(let ((a0-14 (-> this vis-info v1-22))) (if a0-14 (set! (-> a0-14 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))
|
|
"Unloads the level. This does not free the heap. The level will be made inactive and ready to be loaded some other time."
|
|
(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 (s5-0 (-> this art-group art-group-array length))
|
|
(let ((s4-0 (-> this art-group art-group-array s5-0))) (if (needs-link? s4-0) (unlink-art! s4-0)))))
|
|
;; 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 (s5-1 (-> this loaded-texture-page-count))
|
|
(dotimes (v1-27 32)
|
|
(when (= (-> this loaded-texture-page s5-1) (-> *texture-pool* common-page v1-27))
|
|
(set! (-> *texture-pool* common-page v1-27) (the-as texture-page 0))))
|
|
(unload! *texture-pool* (-> this loaded-texture-page s5-1)))
|
|
(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 (s5-2 2)
|
|
(let ((v1-41 (-> *art-control* buffer s5-2 pending-load-file)))
|
|
(if (and (>= (the-as int v1-41) (the-as int (-> this heap base)))
|
|
(< (the-as int v1-41) (the-as int (-> this heap top-base))))
|
|
(set-pending-file (-> *art-control* buffer s5-2) (the-as string #f) -1 (the-as handle #f) 100000000.0))))
|
|
;; unload packages (doesn't really do anything.)
|
|
(let* ((s5-3 (-> this info packages))
|
|
(a0-29 (car s5-3)))
|
|
(while (not (null? s5-3))
|
|
(case (rtype-of a0-29)
|
|
((symbol) (unload (symbol->string (the-as symbol a0-29))))
|
|
((string) (unload (the-as string a0-29))))
|
|
(set! s5-3 (cdr s5-3))
|
|
(set! a0-29 (car s5-3))))
|
|
(vis-clear this)
|
|
;; reset the level heap!
|
|
(let ((v1-64 (-> this heap))) (set! (-> v1-64 current) (-> v1-64 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) (arg0 int))
|
|
"Is arg0 visible? Note that this will return #f if the visibility data is not loaded."
|
|
;; 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 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 point-in-boxes? ((this level) (arg0 vector))
|
|
"Is this point in the list of level boxes?"
|
|
(cond
|
|
((or (not (-> this bsp)) (zero? (-> this bsp boxes)))
|
|
;; no boxes or no bsp
|
|
#f)
|
|
((-> this force-inside?) #t)
|
|
(else
|
|
(let* ((a0-1 (-> this bsp boxes))
|
|
(v1-5 (-> a0-1 data)))
|
|
(countdown (a0-2 (-> a0-1 length))
|
|
(if (and (>= (-> arg0 x) (-> v1-5 0 min x))
|
|
(>= (-> arg0 y) (-> v1-5 0 min y))
|
|
(>= (-> arg0 z) (-> v1-5 0 min z))
|
|
(< (-> arg0 x) (-> v1-5 0 max x))
|
|
(< (-> arg0 y) (-> v1-5 0 max y))
|
|
(< (-> arg0 z) (-> v1-5 0 max z)))
|
|
(return #t))
|
|
(set! v1-5 (the (inline-array box8s) (-> v1-5 1)))))
|
|
#f)))
|
|
|
|
(defmethod debug-print-splitbox ((this level) (arg0 vector) (arg1 string))
|
|
"Print the current splitbox, if we're in one."
|
|
(cond
|
|
((or (not (-> this bsp)) (zero? (-> this bsp boxes)) (zero? (-> this bsp split-box-indices)))
|
|
;; do nothing!
|
|
)
|
|
(else
|
|
(let* ((s3-0 (-> this bsp boxes))
|
|
(s2-0 (-> s3-0 data)))
|
|
(dotimes (s1-0 (-> s3-0 length))
|
|
(if (and (>= (-> arg0 x) (-> s2-0 0 min x))
|
|
(>= (-> arg0 y) (-> s2-0 0 min y))
|
|
(>= (-> arg0 z) (-> s2-0 0 min z))
|
|
(< (-> arg0 x) (-> s2-0 0 max x))
|
|
(< (-> arg0 y) (-> s2-0 0 max y))
|
|
(< (-> arg0 z) (-> s2-0 0 max z)))
|
|
(format arg1 " splitbox-~D~%" (-> this bsp split-box-indices s1-0)))
|
|
(set! s2-0 (the (inline-array box8s) (-> s2-0 1)))))))
|
|
0
|
|
(none))
|
|
|
|
(defmethod mem-usage ((this level) (arg0 memory-usage-block) (arg1 int))
|
|
"Get the memory usage for a level."
|
|
(when (= (-> this status) 'active)
|
|
(set! (-> arg0 length) (max 65 (-> arg0 length)))
|
|
(set! (-> arg0 data 64 name) "entity-links")
|
|
(set! (-> arg0 data 64 count) (+ (-> arg0 data 64 count) (-> this entity length)))
|
|
(let ((v1-8 (asize-of (-> this entity))))
|
|
(set! (-> arg0 data 64 used) (+ (-> arg0 data 64 used) v1-8))
|
|
(set! (-> arg0 data 64 total) (+ (-> arg0 data 64 total) (logand -16 (+ v1-8 15)))))
|
|
(set! (-> arg0 length) (max 65 (-> arg0 length)))
|
|
(set! (-> arg0 data 64 name) "ambient-links")
|
|
(set! (-> arg0 data 64 count) (+ (-> arg0 data 64 count) (-> this ambient length)))
|
|
(let ((v1-18 (asize-of (-> this ambient))))
|
|
(set! (-> arg0 data 64 used) (+ (-> arg0 data 64 used) v1-18))
|
|
(set! (-> arg0 data 64 total) (+ (-> arg0 data 64 total) (logand -16 (+ v1-18 15)))))
|
|
(mem-usage (-> this art-group) arg0 arg1)
|
|
(set! (-> arg0 length) (max 64 (-> arg0 length)))
|
|
(set! (-> arg0 data 63 name) "level-code")
|
|
(set! (-> arg0 data 63 count) (+ (-> arg0 data 63 count) 1))
|
|
(let ((v1-30 (&- (-> this code-memory-end) (the-as uint (-> this code-memory-start)))))
|
|
(set! (-> arg0 data 63 used) (+ (-> arg0 data 63 used) v1-30))
|
|
(set! (-> arg0 data 63 total) (+ (-> arg0 data 63 total) (logand -16 (+ v1-30 15)))))
|
|
(countdown (s3-0 (-> this loaded-texture-page-count))
|
|
(mem-usage (-> this loaded-texture-page s3-0) arg0 arg1))
|
|
(countdown (s3-1 8)
|
|
(let ((s2-0 (-> this vis-info s3-1)))
|
|
(when s2-0
|
|
(cond
|
|
((zero? s3-1)
|
|
(set! (-> arg0 length) (max 60 (-> arg0 length)))
|
|
(set! (-> arg0 data 59 name) "bsp-leaf-vis-self")
|
|
(set! (-> arg0 data 59 count) (+ (-> arg0 data 59 count) 1))
|
|
(let ((v1-50 (asize-of s2-0)))
|
|
(set! (-> arg0 data 59 used) (+ (-> arg0 data 59 used) v1-50))
|
|
(set! (-> arg0 data 59 total) (+ (-> arg0 data 59 total) (logand -16 (+ v1-50 15))))))
|
|
(else
|
|
(set! (-> arg0 length) (max 61 (-> arg0 length)))
|
|
(set! (-> arg0 data 60 name) "bsp-leaf-vis-adj")
|
|
(set! (-> arg0 data 60 count) (+ (-> arg0 data 60 count) 1))
|
|
(let ((v1-61 (+ (asize-of s2-0) (the-as int (-> s2-0 allocated-length)))))
|
|
(set! (-> arg0 data 60 used) (+ (-> arg0 data 60 used) v1-61))
|
|
(set! (-> arg0 data 60 total) (+ (-> arg0 data 60 total) (logand -16 (+ v1-61 15))))))))))
|
|
(mem-usage (-> this bsp) arg0 arg1))
|
|
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))
|
|
"Allocate the level heaps and load the common packages for levels."
|
|
;; 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))
|
|
(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))
|
|
"Get a level that's least likely to be in use right now. #f = all levels in use."
|
|
;; check inactive levels first
|
|
(dotimes (v1-0 (-> this length))
|
|
(case (-> this level v1-0 status)
|
|
(('inactive) (return (-> this level v1-0)))))
|
|
;; check for any loading levels
|
|
(dotimes (v1-6 (-> this length))
|
|
(case (-> this level v1-6 status)
|
|
(('loading 'loading-bt) (return (-> this level v1-6)))))
|
|
;; check for loaded, but not active, levels.
|
|
(dotimes (v1-12 (-> this length))
|
|
(let ((a1-18 (-> this level v1-12 status))) (if (= a1-18 'loaded) (return (-> this level v1-12)))))
|
|
;; check active levels. pick one we're not in bounds of.
|
|
(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) (name symbol))
|
|
"Return the level data using its name, if it is available. Returns #f if none are found."
|
|
(dotimes (lev (-> this length))
|
|
(if (and (!= (-> this level lev status) 'inactive)
|
|
(or (= (-> this level lev name) name) (= (-> this level lev load-name) name)))
|
|
(return (-> this level lev))))
|
|
(the level #f))
|
|
|
|
(defmethod art-group-get-by-name ((this level-group) (arg0 string))
|
|
(countdown (i 3)
|
|
(let ((lev (-> this level i)))
|
|
(countdown (ii (-> lev art-group art-group-array length))
|
|
(if (name= (-> lev art-group art-group-array ii name) arg0) (return (-> lev art-group art-group-array ii))))))
|
|
(the-as art-group #f))
|
|
|
|
(defmethod activate-levels! ((this level-group))
|
|
"Try to activate all levels."
|
|
(dotimes (i (-> this length))
|
|
(level-status-set! (-> this level i) 'active))
|
|
0)
|
|
|
|
(defmethod level-get-target-inside ((this level-group))
|
|
"Get the level target is in, or one it is close to.
|
|
The distance checks do not work."
|
|
(let ((target-trans (target-pos 0)))
|
|
(let ((current-level (-> *game-info* current-continue level)))
|
|
(dotimes (i (-> this length))
|
|
(let ((ilev (-> this level i))) (when (= (-> ilev status) 'active) (if (= (-> ilev name) current-level) (return ilev))))))
|
|
(let ((level-ret (the-as level #f)))
|
|
(let ((min-distance-to-level 0.0)) ;; uh-huh
|
|
(dotimes (i (-> this length))
|
|
(let ((ilev (-> this level i)))
|
|
(when (= (-> ilev status) 'active)
|
|
(let ((distance-to-level (vector-vector-distance (-> ilev bsp bsphere) target-trans)))
|
|
(if (and (-> ilev inside-boxes?) (or (not level-ret) (< distance-to-level min-distance-to-level))) (set! level-ret ilev)))))))
|
|
(if level-ret (return level-ret))))
|
|
(dotimes (i (-> this length))
|
|
(let ((ilev (-> this level i))) (when (= (-> ilev status) 'active) (if (-> ilev meta-inside?) (return ilev)))))
|
|
(let ((level-ret (the-as level #f)))
|
|
(let ((min-distance-to-level 0.0)) ;; why?
|
|
(dotimes (i (-> this length))
|
|
(let ((ilev (-> this level i)))
|
|
(when (= (-> ilev status) 'active)
|
|
(if (or (not level-ret) (< (-> ilev level-distance) min-distance-to-level)) (set! level-ret ilev))))))
|
|
level-ret))
|
|
|
|
(defmethod load-commands-set! ((this level-group) (load-commands pair))
|
|
(set! (-> this load-commands) load-commands)
|
|
load-commands)
|
|
|
|
(defmethod mem-usage ((this level-group) (arg0 memory-usage-block) (arg1 int))
|
|
"Get the memory usage data for a level-group"
|
|
;; get memory usage of each level
|
|
(dotimes (i (-> this length))
|
|
(mem-usage (-> this level i) arg0 arg1))
|
|
this)
|
|
|
|
(defun bg ((level-name symbol))
|
|
"Begin game in a given level.
|
|
The level name can be the full name (village3), the nickname (vi3), or visname (village3-vis)
|
|
If the visname is used (and its a recognized level in level-info), it will use vis mode.
|
|
Otherwise, it will use the non-vis DGO name (like VILLAGE3.DGO) which will usually fail.
|
|
"
|
|
(set! *cheat-mode* (if *debug-segment* 'debug #f))
|
|
(let ((v1-2 (lookup-level-info level-name)))
|
|
(cond
|
|
((= (-> v1-2 visname) level-name) (set! (-> *level* vis?) #t) (set! level-name (-> v1-2 name)))
|
|
(else (set! (-> *level* vis?) #f) (set! (-> *kernel-context* low-memory-message) #f)))
|
|
(let* ((s5-0 (-> v1-2 run-packages))
|
|
(a0-8 (car s5-0)))
|
|
(while (not (null? s5-0))
|
|
(let ((v1-4 (rtype-of a0-8)))
|
|
(cond
|
|
((= v1-4 symbol) (load-package (symbol->string (the-as symbol a0-8)) global))
|
|
((= v1-4 string) (load-package (the-as string a0-8) global))))
|
|
(set! s5-0 (cdr s5-0))
|
|
(set! a0-8 (car s5-0)))))
|
|
(let ((gp-1 (level-get-for-use *level* level-name 'active)))
|
|
(while (and gp-1 (or (= (-> gp-1 status) 'loading) (= (-> gp-1 status) 'loading-bt) (= (-> gp-1 status) 'login)) (not *dproc*))
|
|
(load-continue gp-1))
|
|
(vis-load gp-1)
|
|
(set! (-> *load-state* vis-nick) (if (-> *level* vis?) (-> gp-1 nickname) #f))
|
|
(set! (-> *load-state* want 0 name) (-> gp-1 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 (-> gp-1 info continues) (set-continue! *game-info* (the-as continue-point (car (-> gp-1 info continues))))))
|
|
(activate-levels! *level*)
|
|
(set! *print-login* #f)
|
|
0)
|
|
|
|
(defun play ((use-vis symbol) (init-game symbol))
|
|
"The entry point to the actual game! This allocates the level heaps, loads some data, sets some default parameters and sets the startup level."
|
|
;; temp
|
|
(format #t "(play :use-vis ~A :init-game ~A) has been called!~%" use-vis init-game)
|
|
(format 0 "(play :use-vis ~A :init-game ~A) has been called!~%" use-vis init-game)
|
|
(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?) use-vis)
|
|
(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 ((s4-1 (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 s4-1 (or (= (-> s4-1 status) 'loading) (= (-> s4-1 status) 'loading-bt) (= (-> s4-1 status) 'login)))
|
|
(set-blackout-frames 6)
|
|
(load-continue s4-1))))
|
|
(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 init-game
|
|
(initialize! *game-info* 'game (the-as game-save #f) (the-as string #f)))
|
|
0)
|
|
|
|
(defun update-sound-banks ()
|
|
(if (nonzero? (rpc-busy? RPC-SOUND-LOADER)) (return 0))
|
|
(let ((gp-0 #f)
|
|
(s5-0 #f))
|
|
(dotimes (s4-0 (-> *level* length))
|
|
(let ((v1-5 (-> *level* level s4-0)))
|
|
(when (= (-> v1-5 status) 'active)
|
|
(let* ((s3-0 (-> v1-5 info sound-banks))
|
|
(t0-0 (the-as symbol (car s3-0))))
|
|
(while (not (null? s3-0))
|
|
(cond
|
|
((or (= gp-0 t0-0) (= s5-0 t0-0) (-> *setting-control* current movie)))
|
|
((not gp-0) (set! gp-0 t0-0))
|
|
((not s5-0) (set! s5-0 t0-0))
|
|
(else (format 0 "ERROR: Soundbanks ~A, ~A and ~A all required~%" gp-0 s5-0 t0-0)))
|
|
(set! s3-0 (cdr s3-0))
|
|
(set! t0-0 (the-as symbol (car s3-0))))))))
|
|
(when (and gp-0 (!= gp-0 *sound-bank-1*) (!= gp-0 *sound-bank-2*))
|
|
(when (not *sound-bank-1*)
|
|
(format 0 "Load soundbank ~A~%" gp-0)
|
|
(sound-bank-load (string->sound-name (symbol->string gp-0)))
|
|
(set! *sound-bank-1* gp-0)
|
|
(return 0))
|
|
(when (not *sound-bank-2*)
|
|
(format 0 "Load soundbank ~A~%" gp-0)
|
|
(sound-bank-load (string->sound-name (symbol->string gp-0)))
|
|
(set! *sound-bank-2* gp-0)
|
|
(return 0))
|
|
(when (!= *sound-bank-1* s5-0)
|
|
(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* s5-0)
|
|
(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 s5-0 (!= s5-0 *sound-bank-1*) (!= s5-0 *sound-bank-2*))
|
|
(when (not *sound-bank-1*)
|
|
(format 0 "Load soundbank ~A~%" s5-0)
|
|
(sound-bank-load (string->sound-name (symbol->string s5-0)))
|
|
(set! *sound-bank-1* s5-0)
|
|
(return 0))
|
|
(when (not *sound-bank-2*)
|
|
(format 0 "Load soundbank ~A~%" s5-0)
|
|
(sound-bank-load (string->sound-name (symbol->string s5-0)))
|
|
(set! *sound-bank-2* s5-0)
|
|
(return 0))
|
|
(when (!= *sound-bank-1* gp-0)
|
|
(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* gp-0)
|
|
(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))
|
|
"Updates load requests."
|
|
(update-sound-banks)
|
|
(let ((v1-0 #f))
|
|
(dotimes (s5-0 2)
|
|
(let ((s4-0 (-> *level* level s5-0)))
|
|
(when (!= (-> s4-0 status) 'inactive)
|
|
(let ((a0-6 #f))
|
|
(dotimes (a1-2 2)
|
|
(if (= (-> s4-0 name) (-> this want a1-2 name)) (set! a0-6 #t)))
|
|
(when (not a0-6)
|
|
(format 0 "Discarding level ~A~%" (-> s4-0 name))
|
|
(level-status-set! s4-0 'inactive)
|
|
(set! v1-0 #t)
|
|
(#when PC_PORT
|
|
(when *debug-segment*
|
|
(define-extern *entity* entity)
|
|
(set! *entity* (the entity #f)))))))))
|
|
(let ((s5-1 #f))
|
|
(if (and (= (-> *level* level0 status) 'inactive) (= (-> *level* level1 status) 'inactive)) (set! s5-1 #t))
|
|
(if v1-0 (return 0))
|
|
(let ((a0-20 #f)
|
|
(v1-5 #f))
|
|
(when (-> this want 0 name)
|
|
(set! a0-20 #t)
|
|
(dotimes (a1-12 3)
|
|
(let ((a2-9 (-> *level* level a1-12)))
|
|
(if (and (!= (-> a2-9 status) 'inactive) (= (-> a2-9 name) (-> this want 0 name))) (set! a0-20 #f)))))
|
|
(when (-> this want 1 name)
|
|
(set! v1-5 #t)
|
|
(dotimes (a1-17 3)
|
|
(let ((a2-17 (-> *level* level a1-17)))
|
|
(if (and (!= (-> a2-17 status) 'inactive) (= (-> a2-17 name) (-> this want 1 name))) (set! v1-5 #f)))))
|
|
(let ((s4-1 -1))
|
|
(cond
|
|
((and a0-20 v1-5) (set! s4-1 0) (if (and (-> this want 1 display?) (not (-> this want 0 display?))) (set! s4-1 1)))
|
|
(a0-20 (set! s4-1 0))
|
|
(v1-5 (set! s4-1 1)))
|
|
(when (!= s4-1 -1)
|
|
(when (or s5-1 (not (check-busy *load-dgo-rpc*)))
|
|
(format 0 "Adding level ~A~%" (-> this want s4-1 name))
|
|
(let ((s3-0 (level-get-for-use *level* (the-as symbol (-> this want s4-1 name)) 'loaded)))
|
|
(when (and s5-1 (-> this want s4-1 display?))
|
|
(format 0 "Waiting for level to load~%")
|
|
(while (or (= (-> s3-0 status) 'loading) (= (-> s3-0 status) 'loading-bt) (= (-> s3-0 status) 'login))
|
|
(load-continue s3-0))))))))))
|
|
(dotimes (s5-2 2)
|
|
(when (-> this want s5-2 name)
|
|
(dotimes (s4-2 3)
|
|
(let ((s3-1 (-> *level* level s4-2)))
|
|
(when (!= (-> s3-1 status) 'inactive)
|
|
(when (= (-> s3-1 name) (-> this want s5-2 name))
|
|
(when (!= (-> s3-1 display?) (-> this want s5-2 display?))
|
|
(cond
|
|
((not (-> s3-1 display?))
|
|
(cond
|
|
((or (= (-> s3-1 status) 'loaded) (= (-> s3-1 status) 'active))
|
|
(format 0 "Displaying level ~A [~A]~%" (-> this want s5-2 name) (-> this want s5-2 display?))
|
|
(level-get-for-use *level* (-> s3-1 info name) 'active)
|
|
(set! (-> s3-1 display?) (-> this want s5-2 display?)))
|
|
(else
|
|
(when (and (-> s3-1 info wait-for-load) (!= (-> this want s5-2 display?) 'display-no-wait))
|
|
(send-event *target* 'loading))
|
|
(if (= *cheat-mode* 'debug) (format *stdcon* "display on for ~A but level is loading~%" (-> this want s5-2 name))))))
|
|
(else
|
|
(cond
|
|
((not (-> this want s5-2 display?))
|
|
(set! (-> s3-1 display?) #f)
|
|
(format 0 "Turning level ~A off~%" (-> s3-1 name))
|
|
(deactivate s3-1))
|
|
(else
|
|
(format 0 "Setting level ~A display command to ~A~%" (-> this want s5-2 name) (-> this want s5-2 display?))
|
|
(set! (-> s3-1 display?) (-> this want s5-2 display?)))))))
|
|
(when (!= (-> s3-1 force-all-visible?) (-> this want s5-2 force-vis?))
|
|
(set! (-> s3-1 force-all-visible?) (-> this want s5-2 force-vis?))
|
|
(format 0 "Setting force-all-visible?[~A] to ~A~%" (-> this want s5-2 name) (-> this want s5-2 force-vis?)))
|
|
(when (!= (-> s3-1 force-inside?) (-> this want s5-2 force-inside?))
|
|
(set! (-> s3-1 force-inside?) (-> this want s5-2 force-inside?))
|
|
(format 0 "Setting force-inside?[~A] to ~A~%" (-> this want s5-2 name) (-> this want s5-2 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 ((s5-3 #f))
|
|
(dotimes (v1-121 (-> *level* length))
|
|
(let ((a0-55 (-> *level* level v1-121)))
|
|
(when (= (-> a0-55 status) 'active) ;; level is active
|
|
(if (nonzero? (-> a0-55 vis-info (-> a0-55 vis-self-index) ramdisk)) ;; and vis is set up.
|
|
(set! s5-3 (-> a0-55 nickname))))))
|
|
;; if we have the wrong vis
|
|
(when (and (!= s5-3 (-> this vis-nick)) (-> *level* vis?))
|
|
;; and we want a vis
|
|
(when (-> this vis-nick)
|
|
;; find matching level and load vis
|
|
(dotimes (s4-3 (-> *level* length))
|
|
(let ((v1-133 (-> *level* level s4-3)))
|
|
(when (= (-> v1-133 status) 'active)
|
|
(if (and (= (-> v1-133 nickname) (-> this vis-nick))
|
|
(-> v1-133 inside-boxes?) ;; note: only start if we are inside boxes.
|
|
)
|
|
(load-vis-info (-> this vis-nick) s5-3))))))))
|
|
0)
|
|
|
|
;; method 16 level-group (debug text stuff)
|
|
|
|
(defmethod level-update ((this level-group))
|
|
;; 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 (s5-0 2)
|
|
(load-continue (-> this level s5-0)))
|
|
;; compute inside for each level
|
|
(dotimes (s5-1 (-> this length))
|
|
(let ((s4-0 (-> this level s5-1)))
|
|
(when (= (-> s4-0 status) 'active)
|
|
(set! (-> s4-0 inside-boxes?) (point-in-boxes? s4-0 (-> *math-camera* trans)))
|
|
(set! (-> s4-0 inside-sphere?) (>= (-> s4-0 bsp bsphere w) (-> s4-0 level-distance)))
|
|
;; being inside sets your meta-inside to #t. If you are outside, remember your old inside.
|
|
(if (-> s4-0 inside-boxes?) (set! (-> s4-0 meta-inside?) #t)))))
|
|
;; update load state machine (the level-border one)
|
|
(update! *load-state*)
|
|
;; checkpoint assignment
|
|
(dotimes (s5-2 (-> this length))
|
|
(let ((s4-1 (-> this level s5-2)))
|
|
(when (= (-> s4-1 status) 'active)
|
|
;; if you're outside here, and inside somewhere else, kick out of meta inside.
|
|
(if (and (-> s4-1 inside-boxes?) (not (-> s4-1 other inside-boxes?))) (set! (-> s4-1 other meta-inside?) #f))
|
|
(when (and (null? (-> this load-commands))
|
|
(= (-> s4-1 nickname) (-> *load-state* vis-nick))
|
|
(!= (-> s4-1 name) (-> *game-info* current-continue level))
|
|
(-> *level* border?))
|
|
(let ((s3-0 (the-as continue-point (car (-> s4-1 info continues)))))
|
|
(let* ((s2-0 (target-pos 0))
|
|
(s4-2 (-> s4-1 info continues))
|
|
(s1-0 (the-as continue-point (car s4-2))))
|
|
(while (not (null? s4-2))
|
|
(if (and (< (vector-vector-distance s2-0 (-> s1-0 trans)) (vector-vector-distance s2-0 (-> s3-0 trans)))
|
|
(zero? (-> s1-0 flags)))
|
|
(set! s3-0 s1-0))
|
|
(set! s4-2 (cdr s4-2))
|
|
(set! s1-0 (the-as continue-point (car s4-2)))))
|
|
(set-continue! *game-info* s3-0))))))
|
|
;; determine vis info idx for each level
|
|
(dotimes (v1-67 (-> this length))
|
|
(let ((a0-26 (-> this level v1-67)))
|
|
(when (= (-> a0-26 status) 'active)
|
|
;; self is always 0
|
|
(set! (-> a0-26 vis-self-index) 0)
|
|
;; neighbor level defaults to 7 (null placeholder)...
|
|
(set! (-> a0-26 vis-adj-index) 7)
|
|
;; but if there's a second level that's active, search for a vis info for that level...
|
|
(when (= (-> a0-26 other status) 'active)
|
|
(dotimes (a1-10 8)
|
|
(if (and (-> a0-26 vis-info a1-10) (= (-> a0-26 vis-info a1-10 from-level) (-> a0-26 other load-name)))
|
|
;; and store it in the adj index.
|
|
(set! (-> a0-26 vis-adj-index) a1-10)))))))
|
|
;; display level vis info
|
|
(when *display-level-border*
|
|
(dotimes (s5-3 (-> this length))
|
|
(let ((s4-3 (-> this level s5-3)))
|
|
(when (= (-> s4-3 status) 'active)
|
|
(let ((s3-1 (-> s4-3 bsp current-bsp-back-flags)))
|
|
(dotimes (s2-1 6)
|
|
(when (and (logtest? s3-1 3) (-> s4-3 vis-info (+ s2-1 1)))
|
|
(let ((v1-88 (lookup-level-info (-> s4-3 vis-info (+ s2-1 1) from-level))))
|
|
(format *stdcon*
|
|
" ~A -> ~A: load: ~A display: ~A~%"
|
|
(-> s4-3 name)
|
|
(-> v1-88 name)
|
|
(logtest? s3-1 1)
|
|
(logtest? s3-1 2))))
|
|
(set! s3-1 (shr s3-1 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 (s5-4 (-> this length))
|
|
(let ((s4-4 (-> this level s5-4)))
|
|
(when (= (-> s4-4 status) 'active)
|
|
(when (and (= (-> s4-4 nickname) (-> *load-state* vis-nick)) ;; vis for A
|
|
(not (-> s4-4 inside-boxes?)) ;; but not in A
|
|
)
|
|
(if (and (= *cheat-mode* 'debug) (-> s4-4 other inside-boxes?))
|
|
(format *stdcon* "~3LForcing outside of ~A [bad split boxes]~%~0L" (-> s4-4 other name)))
|
|
(set! (-> s4-4 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 (v1-125 (-> this length))
|
|
(let ((a0-44 (-> this level v1-125)))
|
|
(when (= (-> a0-44 status) 'active)
|
|
;; loop over vis infos
|
|
(dotimes (a1-17 8)
|
|
(let ((a2-18 (-> a0-44 vis-info a1-17)))
|
|
(when a2-18
|
|
;; clear bit 31
|
|
(set! (-> a2-18 flags) (logand (the-as uint #xffffffff7fffffff) (-> a2-18 flags)))
|
|
;; link info to bsp
|
|
(cond
|
|
((= a1-17 (-> a0-44 vis-self-index)) (set! (-> a2-18 from-bsp) (-> a0-44 bsp)))
|
|
((= a1-17 (-> a0-44 vis-adj-index)) (set! (-> a2-18 from-bsp) (-> a0-44 other bsp)))
|
|
(else (set! (-> a2-18 from-bsp) #f))))))
|
|
;; now, handle setting bit 31 (maybe single vis mode?)
|
|
(cond
|
|
;; special display self mode.
|
|
((= (-> a0-44 display?) 'display-self)
|
|
(let ((a0-46 (-> a0-44 vis-info (-> a0-44 vis-self-index))))
|
|
(if a0-46 (set! (-> a0-46 flags) (the-as uint (logior (shl #x8000 16) (-> a0-46 flags)))))))
|
|
;; in this level, but not the other, only use vis for this.
|
|
((and (-> a0-44 inside-boxes?) (not (-> a0-44 other inside-boxes?)))
|
|
(let ((a0-48 (-> a0-44 vis-info (-> a0-44 vis-self-index))))
|
|
(if a0-48 (set! (-> a0-48 flags) (the-as uint (logior (shl #x8000 16) (-> a0-48 flags)))))))
|
|
;; only in other level, only use vis for other.
|
|
((-> a0-44 other inside-boxes?)
|
|
(let ((a0-50 (-> a0-44 vis-info (-> a0-44 vis-adj-index))))
|
|
(if a0-50 (set! (-> a0-50 flags) (the-as uint (logior (shl #x8000 16) (-> a0-50 flags)))))))))))))
|
|
(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 (s5-5 (-> this length))
|
|
(let ((s4-5 (-> this level s5-5)))
|
|
(when (= (-> s4-5 status) 'active)
|
|
(format *stdcon*
|
|
"~A: ~S ~A~%"
|
|
(-> s4-5 name)
|
|
(if (point-in-boxes? s4-5 (-> *math-camera* trans)) "inside")
|
|
(-> s4-5 display?))
|
|
(when *display-texture-download*
|
|
(format *stdcon* " tfrag: ~8,,0m " (-> s4-5 closest-object 0))
|
|
(format *stdcon* " shrub: ~8,,0m " (-> s4-5 closest-object 2))
|
|
(format *stdcon* " alpha: ~8,,0m #x~8X~%" (-> s4-5 closest-object 3) (-> s4-5 texture-mask 8))
|
|
(format *stdcon* " tie: ~8,,0m " (-> s4-5 closest-object 5))
|
|
(format *stdcon* " fg-tf: ~8,,0m " (-> s4-5 closest-object 6))
|
|
(format *stdcon* " fg-pr: ~8,,0m #x~8X~%" (-> s4-5 closest-object 7) (-> s4-5 texture-mask 7))
|
|
(format *stdcon*
|
|
" tf: ~8D pr: ~8D sh: ~8D al: ~8D wa: ~8D~%~1K"
|
|
(-> s4-5 upload-size 0)
|
|
(-> s4-5 upload-size 1)
|
|
(-> s4-5 upload-size 2)
|
|
(-> s4-5 upload-size 3)
|
|
(-> s4-5 upload-size 4)))
|
|
(if *display-split-box-info* (debug-print-splitbox s4-5 (-> *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))
|
|
(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)))
|