mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 21:27:52 -04:00
1af0f4a1a7
* [decomp] most of `level` and some game loop functions + couple decompiler fixes * add ART.CGO to fake-iso
1578 lines
50 KiB
Common Lisp
1578 lines
50 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: level.gc
|
|
;; name in dgo: level
|
|
;; dgos: GAME, ENGINE
|
|
|
|
|
|
(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 level-group ((obj level-group) (name symbol) (cmd-idx int))
|
|
(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 level ((obj level) (arg0 string))
|
|
(countdown (i (-> obj art-group art-group-array length))
|
|
(if (name= (-> obj art-group art-group-array i name) arg0)
|
|
(return (-> obj art-group art-group-array i))
|
|
)
|
|
)
|
|
(the-as art-group #f)
|
|
)
|
|
|
|
(defmethod bsp-name level ((obj level))
|
|
"Get the name of the bsp tree of the level"
|
|
|
|
(if (and (!= (-> obj status) 'inactive)
|
|
(-> obj bsp)
|
|
(nonzero? (-> obj bsp name))
|
|
)
|
|
(-> obj bsp name)
|
|
(-> obj name)
|
|
)
|
|
)
|
|
|
|
(defun add-bsp-drawable ((bsp bsp-header) (arg1 level) (arg2 symbol) (arg3 display-frame))
|
|
;;(dummy-10 bsp bsp arg3)
|
|
;;(if (nonzero? *display-strip-lines*)
|
|
;; (dummy-15 bsp)
|
|
;; )
|
|
(none)
|
|
)
|
|
|
|
(defmethod print level ((obj level))
|
|
"print a level."
|
|
|
|
(format #t "#<~A ~A ~S @ #x~X>"
|
|
(-> obj type)
|
|
(-> obj status)
|
|
(-> obj name)
|
|
obj
|
|
)
|
|
obj
|
|
)
|
|
|
|
;; relocate bsp-header
|
|
|
|
(defmethod dummy-24 level ((obj level))
|
|
(unless (or (not (-> obj bsp)) (= *kernel-boot-mode* 'debug-boot))
|
|
(unless (null? (-> obj info packages))
|
|
(load-package "common" global)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod vis-clear level ((obj level))
|
|
(countdown (v1-0 8)
|
|
(nop!) ;; the usual.
|
|
(set! (-> obj vis-info v1-0) #f)
|
|
)
|
|
(dotimes (v1-3 128)
|
|
(set! (deref int128 (-> obj vis-bits) v1-3) (the-as int128 0))
|
|
)
|
|
(set! (-> obj all-visible?) 'loading)
|
|
0
|
|
)
|
|
|
|
|
|
(defmethod vis-load level ((obj level))
|
|
(when (zero? (-> obj vis-info (-> obj vis-self-index) ramdisk))
|
|
(let ((vis (-> obj other vis-info (-> obj other vis-self-index))))
|
|
(when (and vis (nonzero? (-> vis ramdisk)))
|
|
(set! (-> vis flags) (logand #xffffffffbfffffff (-> vis flags))) ;; clear #x40000000
|
|
(set! (-> vis ramdisk) 0)
|
|
0
|
|
)
|
|
)
|
|
(let ((visname (make-file-name (file-kind vis) (the-as string (-> obj 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)
|
|
(call *ramdisk-rpc* (the-as uint 1) (the-as pointer 0) (the-as uint 0))
|
|
(set! (-> obj vis-info (-> obj vis-self-index) ramdisk) s5-0)
|
|
)
|
|
)
|
|
(-> obj vis-info (-> obj 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 dummy-25 level ((obj level))
|
|
(unless (or (= (-> obj status) 'inactive)
|
|
(not (-> obj bsp))
|
|
)
|
|
(set! (-> obj all-visible?) 'loading)
|
|
(let ((s5-0 (-> obj bsp vis-info 0)))
|
|
(cond
|
|
((and s5-0 (nonzero? s5-0) (valid? s5-0 level-vis-info #f #f 0))
|
|
(set! (-> obj vis-info 0) s5-0)
|
|
(set! (-> s5-0 current-vis-string) (the-as uint -1))
|
|
(set! (-> s5-0 from-bsp) (-> obj bsp))
|
|
(set! (-> s5-0 vis-bits) (-> obj vis-bits))
|
|
(set! (-> s5-0 flags) (logand #xffffffff3fffffff (-> s5-0 flags))) ;; clear #x80000000 and #x40000000
|
|
(set! (-> s5-0 flags) (logior #x20000000 (-> s5-0 flags)))
|
|
(set! (-> s5-0 ramdisk) 0)
|
|
(set! (-> s5-0 string-block) (the-as uint #f))
|
|
(set! *vis-boot* #t)
|
|
)
|
|
(else
|
|
(set! (-> obj vis-info 0) #f)
|
|
)
|
|
)
|
|
)
|
|
(dotimes (s5-1 6)
|
|
(let* ((s3-0 (+ s5-1 1))
|
|
(s4-0 (-> obj bsp vis-info s3-0))
|
|
)
|
|
(cond
|
|
((and s4-0 (nonzero? s4-0) (valid? s4-0 level-vis-info #f #f 0))
|
|
(set! (-> obj 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) (-> obj vis-bits))
|
|
(set! (-> s4-0 flags) (logand #xffffffff1fffffff (-> s4-0 flags))) ;; clear #x80000000 and #x40000000 and #x20000000
|
|
(set! *vis-boot* #t)
|
|
)
|
|
(else
|
|
(set! (-> obj vis-info s3-0) #f)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defmethod level-get-for-use level-group ((obj 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! obj #f)
|
|
|
|
(let* ((level-info (lookup-level-info name))
|
|
(level-name (remap-level-name level-info))
|
|
)
|
|
(swhen (level-get obj level-name)
|
|
(level-status-set! bc want-status)
|
|
(return bc)
|
|
)
|
|
(let ((a0-7 (level-get-most-disposable obj)))
|
|
(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 (-> 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
|
|
)
|
|
|
|
(defmethod level-status level-group ((obj 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! level ((obj 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 (-> obj status)
|
|
)
|
|
(unload! obj)
|
|
)
|
|
(('loading)
|
|
(case (-> obj status)
|
|
(('inactive)
|
|
(load-begin obj)
|
|
)
|
|
)
|
|
)
|
|
(('loading-bt)
|
|
(case (-> obj status)
|
|
(('loading)
|
|
(set! (-> obj status) want-status)
|
|
(load-continue obj)
|
|
)
|
|
)
|
|
)
|
|
(('loading-done)
|
|
(case (-> obj status)
|
|
(('loading-bt)
|
|
(set! (-> obj status) want-status)
|
|
)
|
|
)
|
|
)
|
|
(('loaded)
|
|
(case (-> obj status)
|
|
(('loading-done)
|
|
(login obj)
|
|
)
|
|
(('alive 'active)
|
|
(deactivate obj)
|
|
)
|
|
)
|
|
)
|
|
(('alive 'active)
|
|
(when *dproc*
|
|
(case (-> obj status)
|
|
(('loaded)
|
|
(activate obj)
|
|
(level-status-set! obj want-status)
|
|
)
|
|
(('alive)
|
|
(when (and *dproc* (= want-status 'active))
|
|
(remove-by-param1 *background-draw-engine* (-> obj bsp))
|
|
(add-connection *background-draw-engine* *dproc* (the (function object object object object object) add-bsp-drawable) (-> obj bsp) obj #f)
|
|
(dotimes (v1-40 9)
|
|
(set! (-> obj closest-object v1-40) 0.0)
|
|
(set! (-> obj texture-mask v1-40) (the-as uint 0))
|
|
)
|
|
(set! (-> obj level-distance) 0.0)
|
|
(set! (-> obj status) 'active)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(define *login-state* (new 'global 'login-state))
|
|
(define *print-login* #t)
|
|
|
|
(defmethod load-continue level ((obj level))
|
|
"Continue loading a level from where we left off last time."
|
|
|
|
;; see if we are still linking some file
|
|
(when (-> obj linking)
|
|
;; do some more linking
|
|
(when (nonzero? (link-resume))
|
|
;; done linking and object file!
|
|
(set! (-> obj linking) #f)
|
|
(case (-> obj status)
|
|
(('loading)
|
|
;; load another object if we don't wanna copy anything
|
|
(if (not (-> *texture-relocate-later* memcpy))
|
|
(dgo-load-continue (align64 (-> obj heap current)))
|
|
)
|
|
)
|
|
(('loading-bt)
|
|
;; finished loading the background!
|
|
(level-status-set! obj 'loading-done)
|
|
(level-status-set! obj 'loaded)
|
|
)
|
|
)
|
|
)
|
|
(return obj)
|
|
)
|
|
;; otherwise, copy stuff that needs copying
|
|
(when (-> *texture-relocate-later* memcpy)
|
|
;; (relocate-later) TODO
|
|
(dgo-load-continue (align64 (-> obj heap current)))
|
|
(return obj)
|
|
)
|
|
;; otherwise, check status
|
|
(case (-> obj 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, so it's some non-background file. start linking
|
|
(cond
|
|
((dgo-load-link (the-as dgo-header a0-15) (-> obj heap) *print-login* #f)
|
|
;; linking finished (that was fast)
|
|
(if (not (-> *texture-relocate-later* memcpy))
|
|
(dgo-load-continue (align64 (-> obj heap current)))
|
|
)
|
|
)
|
|
(else
|
|
;; linking is not done, resume later.
|
|
(set! (-> obj linking) #t)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
;; the background is always the last object, so we're loading the background now
|
|
(set! (-> obj heap top) (-> obj heap top-base))
|
|
(level-status-set! obj 'loading-bt)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(('login)
|
|
;; run level login
|
|
(level-update-after-load obj *login-state*)
|
|
)
|
|
(('loading-bt)
|
|
;; link the bt object
|
|
(let ((a0-26 (align64 (-> obj heap current))))
|
|
(cond
|
|
((dgo-load-link (the-as dgo-header a0-26) (-> obj heap) *print-login* #t)
|
|
(level-status-set! obj 'loading-done)
|
|
(level-status-set! obj 'loaded)
|
|
)
|
|
(else
|
|
(set! (-> obj linking) #t)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod load-begin level ((obj level))
|
|
"Start loading the level. Uses 2 megabyte heaps for loading each non-bt object."
|
|
|
|
(set! loading-level (-> obj heap))
|
|
(set! (-> *level* unknown-level-2) obj)
|
|
(set! (-> *level* unknown-level-1) #f)
|
|
(set! (-> obj nickname) #f)
|
|
(set! (-> obj bsp) #f)
|
|
(set! (-> obj entity) #f)
|
|
(set! (-> obj ambient) #f)
|
|
(set! (-> obj linking) #f)
|
|
(vis-clear obj)
|
|
(set! (-> obj status) 'loading)
|
|
(set! (-> *texture-pool* allocate-func) texture-page-level-allocate)
|
|
(if (= (-> obj load-name) (-> obj info visname))
|
|
(format (clear *temp-string*) "~S" (-> obj info nickname))
|
|
(format (clear *temp-string*) "~S" (-> obj name))
|
|
)
|
|
(set! (-> *temp-string* data 8) (the-as uint 0))
|
|
(format *temp-string* ".DGO")
|
|
(set! (-> obj heap top) (-> obj heap top-base))
|
|
(let ((s4-0 (kmalloc (-> obj heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2"))
|
|
(s5-2 (kmalloc (-> obj heap) (* 2 1024 1024) (kmalloc-flags align-64 top) "dgo-level-buf-2"))
|
|
)
|
|
(set! (-> obj code-memory-start) (-> obj heap current))
|
|
(format 0 "-----------> begin load ~A [~S]~%" (-> obj load-name) *temp-string*)
|
|
(dgo-load-begin *temp-string* s5-2 s4-0 (align64 (-> obj heap current)))
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod login level ((obj level))
|
|
(set! (-> *texture-pool* allocate-func) texture-page-default-allocate)
|
|
(cond
|
|
((-> obj bsp)
|
|
(set! (-> *level* unknown-level-1) (the-as level (-> obj bsp)))
|
|
(login-level-textures *texture-pool* obj (-> obj bsp unk-data-1-len) (the-as (pointer texture-id) (-> obj bsp unk-data-1)))
|
|
(let ((bsp (-> obj bsp)))
|
|
(when (nonzero? (-> bsp adgifs))
|
|
(let ((adgifs (-> bsp adgifs)))
|
|
(dotimes (i (-> adgifs length))
|
|
;;(adgif-shader-login-no-remap (-> adgifs data i)) TODO texture.gc
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> *login-state* state) -1)
|
|
(set! (-> *login-state* pos) (the-as uint 0))
|
|
(set! (-> *login-state* elts) (the-as uint 0))
|
|
(set! (-> obj status) 'login)
|
|
)
|
|
(else
|
|
(level-status-set! obj 'inactive)
|
|
(set! loading-level global)
|
|
(set! (-> *level* unknown-level-2) (-> *level* level-default))
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defun level-update-after-load ((loaded-level level) (level-login-state login-state))
|
|
"Runs a bunch of logins on various things in a level"
|
|
|
|
(local-vars
|
|
(current-timer int)
|
|
(initial-timer int)
|
|
)
|
|
0
|
|
(let ((level-drawable-trees (-> loaded-level bsp drawable-trees)))
|
|
0
|
|
;;(.mfc0 initial-timer Count)
|
|
(label cfg-1)
|
|
0
|
|
;;(.mfc0 current-timer Count)
|
|
(let ((elapsed-timer (- current-timer initial-timer)))
|
|
(if (< 100000 elapsed-timer) ;; what is this measuring?
|
|
(return loaded-level)
|
|
)
|
|
)
|
|
;; I don't know what this is doing
|
|
(let ((current-login-pos (the-as int (-> level-login-state pos))))
|
|
(when (= (-> level-login-state state) -1)
|
|
(when (< (the-as int current-login-pos) (-> level-drawable-trees length))
|
|
(let ((current-drawable (the-as drawable-tree (-> level-drawable-trees data (the-as uint current-login-pos)))))
|
|
(cond
|
|
((= (-> (the-as drawable current-drawable) type) drawable-tree-tfrag)
|
|
(dotimes (idx-in-drawable (-> current-drawable length))
|
|
(cond
|
|
((= (-> current-drawable data idx-in-drawable type) drawable-inline-array-tfrag)
|
|
(set! (-> level-login-state elt (-> level-login-state elts)) (-> current-drawable data idx-in-drawable))
|
|
(1+! (-> level-login-state elts))
|
|
)
|
|
(else
|
|
(dummy-9 (-> current-drawable data idx-in-drawable))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(cond
|
|
((= (-> (the-as drawable current-drawable) type) drawable-tree-instance-tie)
|
|
(set! (-> level-login-state elt (-> level-login-state elts)) (the-as drawable current-drawable))
|
|
(1+! (-> level-login-state elts))
|
|
)
|
|
(else
|
|
(dummy-9 (the-as drawable current-drawable))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(1+! (-> level-login-state elts))
|
|
(goto cfg-1)
|
|
)
|
|
(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)))
|
|
(dummy-9 s2-2)
|
|
(if (dummy-12 s2-2)
|
|
(dummy-13 s2-2)
|
|
)
|
|
)
|
|
(1+! (-> level-login-state elts))
|
|
(goto cfg-1)
|
|
)
|
|
)
|
|
(set! (-> level-login-state pos) (the-as uint 0))
|
|
(set! (-> level-login-state state) 0)
|
|
(goto cfg-1)
|
|
)
|
|
(when (< (-> level-login-state state) (the-as int (-> level-login-state elts)))
|
|
(let ((s1-1 (-> level-login-state elt (-> level-login-state state))))
|
|
(cond
|
|
((= (-> s1-1 type) drawable-inline-array-tfrag)
|
|
(cond
|
|
((< (the-as int current-login-pos) (-> (the-as drawable-inline-array-tfrag s1-1) length))
|
|
(dotimes (s0-0 200)
|
|
(when (< (the-as int current-login-pos) (-> (the-as drawable-inline-array-tfrag s1-1) length))
|
|
(dummy-9 (-> (the-as drawable-inline-array-tfrag s1-1) data (the-as uint current-login-pos)))
|
|
(1+! current-login-pos)
|
|
)
|
|
)
|
|
(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)
|
|
(let ((s1-2 (-> (the-as drawable-tree-instance-tie s1-1) prototypes prototype-array-tie)))
|
|
(when (< (the-as int current-login-pos) (-> s1-2 length))
|
|
(dotimes (s0-1 10)
|
|
(when (< (the-as int current-login-pos) (-> s1-2 length))
|
|
(let ((sv-16 (-> s1-2 array-data (the-as uint current-login-pos))))
|
|
(dotimes (sv-32 4)
|
|
(let ((a0-28 (-> sv-16 geometry sv-32)))
|
|
(if (nonzero? a0-28)
|
|
(dummy-9 a0-28)
|
|
)
|
|
)
|
|
)
|
|
(1+! current-login-pos)
|
|
)
|
|
)
|
|
)
|
|
(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)
|
|
;;(adgif-shader-login-no-remap s0-2) TODO texture.gc
|
|
(set! (-> s0-2 tex1) (the-as uint 96))
|
|
(set! (-> s0-2 clamp) (the-as uint 5))
|
|
(set! (-> s0-2 alpha) (the-as uint 88))
|
|
(set! (-> s0-2 prims 1) (the-as uint 6))
|
|
(set! (-> s0-2 prims 3) (the-as uint 20))
|
|
(set! (-> s0-2 prims 5) (the-as uint 52))
|
|
(set! (-> s0-2 clamp-reg) (the-as uint 8))
|
|
(set! (-> s0-2 prims 9) (the-as uint 66))
|
|
)
|
|
)
|
|
)
|
|
(set! (-> level-login-state pos) (the-as uint 0))
|
|
(1+! (-> level-login-state state))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(goto cfg-1)
|
|
)
|
|
(if (= (-> level-login-state state) (-> level-login-state elts))
|
|
(begin
|
|
(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))
|
|
(1+! (-> level-login-state state))
|
|
)
|
|
(else
|
|
(let ((a0-36 (-> v1-115 actors data current-login-pos actor)))
|
|
(entity-nav-login a0-36)
|
|
)
|
|
(1+! (-> level-login-state pos))
|
|
)
|
|
)
|
|
)
|
|
(goto cfg-1)
|
|
)
|
|
)
|
|
(when (zero? (the-as uint current-login-pos))
|
|
(set! (-> level-login-state pos) (the-as uint 1))
|
|
(return loaded-level)
|
|
)
|
|
)
|
|
)
|
|
(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 (meters 30))
|
|
(set! f1-0 (meters 70))
|
|
)
|
|
(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)
|
|
)
|
|
(dummy-25 loaded-level)
|
|
(dummy-24 loaded-level)
|
|
(set! (-> loaded-level status) 'loaded)
|
|
(set! loading-level global)
|
|
(set! (-> *level* unknown-level-2) (-> *level* level-default))
|
|
(set! (-> *level* unknown-level-1) #f)
|
|
0
|
|
;;(.mfc0 v1-154 Count)
|
|
;;(- v1-154 initial-timer)
|
|
|
|
loaded-level
|
|
)
|
|
|
|
(defmethod activate level ((obj level))
|
|
"Activate a level! It must be loaded."
|
|
|
|
(case (-> obj status)
|
|
(('loaded)
|
|
(protect (loading-level
|
|
(-> *level* unknown-level-2)
|
|
(-> *level* unknown-level-1)
|
|
)
|
|
(set! loading-level (-> obj heap))
|
|
(set! (-> *level* unknown-level-1) (the-as level (-> obj bsp)))
|
|
(set! (-> *level* unknown-level-2) obj)
|
|
(dummy-18 (-> obj bsp))
|
|
(set! (-> obj status) 'alive)
|
|
(dummy-15 *game-info*)
|
|
(send-event *camera* 'level-activate (-> obj name))
|
|
(send-event *target* 'level-activate (-> obj name))
|
|
)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod deactivate level ((obj level))
|
|
"Kill the level. This won't remove it from memory."
|
|
|
|
(case (-> obj status)
|
|
(('active 'alive)
|
|
(format 0 "----------- kill ~A (status ~A)~%" obj (-> obj status))
|
|
(dummy-14 *game-info*)
|
|
(send-event *camera* 'level-deactivate (-> obj name))
|
|
(send-event *target* 'level-deactivate (-> obj name))
|
|
(remove-by-param1 *background-draw-engine* (-> obj bsp))
|
|
(dummy-19 (-> obj bsp))
|
|
;; (kill-all-particles-in-level) TODO
|
|
(set! (-> obj inside-sphere?) #f)
|
|
(set! (-> obj inside-boxes?) #f)
|
|
(set! (-> obj meta-inside?) #f)
|
|
(set! (-> obj force-inside?) #f)
|
|
(set! (-> obj status) 'loaded)
|
|
(set! (-> obj all-visible?) 'loading)
|
|
;; clear vis buffers
|
|
(dotimes (v1-19 128)
|
|
(set! (deref int128 (-> obj vis-bits) v1-19) (the-as int128 0))
|
|
)
|
|
(let ((v1-22 8))
|
|
(while (nonzero? v1-22)
|
|
(+! v1-22 -1)
|
|
(let ((a0-14 (-> obj vis-info v1-22)))
|
|
(if a0-14
|
|
(set! (-> a0-14 current-vis-string) (the-as uint -1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(if (= (-> *level* unknown-level-1) (-> obj bsp))
|
|
(set! (-> *level* unknown-level-1) #f)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod unload! level ((obj 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 obj)
|
|
(when (!= (-> obj status) 'inactive)
|
|
|
|
;; no idea
|
|
(when (or (= (-> obj status) 'loaded)
|
|
(= (-> obj status) 'alive)
|
|
(= (-> obj status) 'active)
|
|
(= (-> obj status) 'login)
|
|
)
|
|
(dotimes (s5-0 (-> obj art-group art-group-array length))
|
|
(let ((s4-0 (-> obj art-group art-group-array s5-0)))
|
|
(if (dummy-12 s4-0)
|
|
(dummy-14 s4-0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; turn some things off
|
|
(set! (-> obj bsp) #f)
|
|
(set! (-> obj entity) #f)
|
|
(set! (-> obj ambient) #f)
|
|
(set! (-> obj status) 'inactive)
|
|
(set! (-> obj art-group string-array length) 0)
|
|
(set! (-> obj art-group art-group-array length) 0)
|
|
|
|
;; unload texture pages?
|
|
(let ((s5-1 (-> obj loaded-texture-page-count)))
|
|
(while (nonzero? s5-1)
|
|
(+! s5-1 -1)
|
|
(dotimes (v1-27 32)
|
|
(when (= (-> obj loaded-texture-page s5-1) (-> *texture-pool* common-page v1-27))
|
|
(set! (-> *texture-pool* common-page v1-27) (the-as texture-page 0))
|
|
)
|
|
)
|
|
(dummy-20 *texture-pool* (-> obj loaded-texture-page s5-1))
|
|
)
|
|
)
|
|
|
|
(set! (-> obj loaded-texture-page-count) 0)
|
|
(dummy-9 *texture-page-dir* (-> obj heap))
|
|
;; (unlink-part-group-by-heap (-> obj heap)) TODO
|
|
; (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 (-> obj heap base)))
|
|
; (< (the-as int v1-41) (the-as int (-> obj heap top-base)))
|
|
; )
|
|
; (dummy-9 (-> *art-control* buffer s5-2) #f -1 #f 100000000.0)
|
|
; )
|
|
; )
|
|
; )
|
|
(let* ((s5-3 (-> obj 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 obj)
|
|
(let ((v1-64 (-> obj heap)))
|
|
(set! (-> v1-64 current) (-> v1-64 base))
|
|
)
|
|
(set! (-> obj code-memory-start) (the pointer 0))
|
|
(set! (-> obj code-memory-end) (the pointer 0))
|
|
(when (= (-> *level* unknown-level-2) obj)
|
|
(set! loading-level global)
|
|
(set! (-> *level* unknown-level-2) (-> *level* level-default))
|
|
(set! (-> *level* unknown-level-1) #f)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
;; method 10 level
|
|
;; method 15 level
|
|
;; method 27 level
|
|
|
|
(defmethod mem-usage level ((obj level) (arg0 memory-usage-block) (arg1 int))
|
|
"Get the memory usage for a level."
|
|
|
|
(when (= (-> obj 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) (-> obj entity length))
|
|
)
|
|
(let ((v1-8 (asize-of (-> obj 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) (-> obj ambient length))
|
|
)
|
|
(let ((v1-18 (asize-of (-> obj 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 (-> obj 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
|
|
(&- (-> obj code-memory-end) (the-as uint (-> obj 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 (-> obj loaded-texture-page-count))
|
|
(mem-usage (-> obj loaded-texture-page s3-0) arg0 arg1)
|
|
)
|
|
(countdown (s3-1 8)
|
|
(let ((s2-0 (-> obj 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 (-> obj bsp) arg0 arg1)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod alloc-levels! level-group ((obj 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 (* 10416 1024)
|
|
(* 25600 1024)))
|
|
)
|
|
(dotimes (lev LEVEL_COUNT)
|
|
(let ((level-heap (-> obj 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 level-group ((obj level-group) (status symbol))
|
|
(dotimes (i (-> obj length))
|
|
(if (= (-> obj level i status) status)
|
|
(return (-> obj level i))
|
|
)
|
|
)
|
|
(the-as level #f)
|
|
)
|
|
|
|
(defmethod level-get-most-disposable level-group ((obj 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 (-> obj length))
|
|
(case (-> obj level v1-0 status)
|
|
(('inactive)
|
|
(return (-> obj level v1-0))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; check for any loading levels
|
|
(dotimes (v1-6 (-> obj length))
|
|
(case (-> obj level v1-6 status)
|
|
(('loading 'loading-bt)
|
|
(return (-> obj level v1-6))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; check for loaded, but not active, levels.
|
|
(dotimes (v1-12 (-> obj length))
|
|
(let ((a1-18 (-> obj level v1-12 status)))
|
|
(if (= a1-18 'loaded)
|
|
(return (-> obj level v1-12))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; check active levels. pick one we're not in bounds of.
|
|
(let ((v0-0 (the-as level #f)))
|
|
(dotimes (v1-18 (-> obj length))
|
|
(case (-> obj level v1-18 status)
|
|
(('active)
|
|
(if (and (not (-> obj level v1-18 inside-boxes?))
|
|
(or (not v0-0)
|
|
(< (-> obj level v1-18 info priority) (-> v0-0 info priority))
|
|
)
|
|
)
|
|
(set! v0-0 (-> obj level v1-18))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
v0-0
|
|
)
|
|
)
|
|
|
|
(defmethod level-get level-group ((obj level-group) (name symbol))
|
|
"Return the level data using its name, if it is available. Returns #f if none are found."
|
|
|
|
(dotimes (lev (-> obj length))
|
|
(if (and (!= (-> obj level lev status) 'inactive)
|
|
(or (= (-> obj level lev name) name)
|
|
(= (-> obj level lev load-name) name)
|
|
)
|
|
)
|
|
(return (-> obj level lev))
|
|
)
|
|
)
|
|
(the level #f)
|
|
)
|
|
|
|
(defmethod art-group-get-by-name level-group ((obj level-group) (arg0 string))
|
|
(countdown (i 3)
|
|
(let ((lev (-> obj 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! level-group ((obj level-group))
|
|
"Try to activate all levels."
|
|
|
|
(dotimes (i (-> obj length))
|
|
(level-status-set! (-> obj level i) 'active)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defmethod level-get-target-inside level-group ((obj 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 (-> obj length))
|
|
(let ((ilev (-> obj 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 (-> obj length))
|
|
(let ((ilev (-> obj 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 (-> obj length))
|
|
(let ((ilev (-> obj 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 (-> obj length))
|
|
(let ((ilev (-> obj 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! level-group ((obj level-group) (load-commands pair))
|
|
(set! (-> obj load-commands) load-commands)
|
|
load-commands
|
|
)
|
|
|
|
(defmethod mem-usage level-group ((obj 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 (-> obj length))
|
|
(mem-usage (-> obj level i) arg0 arg1)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defun bg ((level-name symbol))
|
|
(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)
|
|
(dummy-19 *game-info* (the-as continue-point (car (-> gp-1 info continues))))
|
|
)
|
|
)
|
|
(activate-levels! *level*)
|
|
(set! *print-login* #f)
|
|
0
|
|
)
|
|
|
|
(defun play ((use-vis symbol) (arg1 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 ~A ~A) has been called!~%" use-vis arg1)
|
|
(format 0 "(play ~A ~A) has been called!~%" use-vis arg1)
|
|
(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* #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) (seconds 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)
|
|
)
|
|
(on #t)
|
|
(when arg1
|
|
(dummy-9 *game-info* 'game #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*))
|
|
(if (not *sound-bank-1*)
|
|
(return (begin
|
|
(format 0 "Load soundbank ~A~%" gp-0)
|
|
(sound-bank-load (string->sound-name (symbol->string gp-0)))
|
|
(set! *sound-bank-1* gp-0)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(if (not *sound-bank-2*)
|
|
(return (begin
|
|
(format 0 "Load soundbank ~A~%" gp-0)
|
|
(sound-bank-load (string->sound-name (symbol->string gp-0)))
|
|
(set! *sound-bank-2* gp-0)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(if (!= *sound-bank-1* s5-0)
|
|
(return (begin
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-1*)
|
|
(sound-bank-unload
|
|
(string->sound-name (symbol->string *sound-bank-1*))
|
|
)
|
|
(set! *sound-bank-1* #f)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(if (!= *sound-bank-2* s5-0)
|
|
(return (begin
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-2*)
|
|
(sound-bank-unload
|
|
(string->sound-name (symbol->string *sound-bank-2*))
|
|
)
|
|
(set! *sound-bank-2* #f)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (and s5-0 (!= s5-0 *sound-bank-1*) (!= s5-0 *sound-bank-2*))
|
|
(if (not *sound-bank-1*)
|
|
(return (begin
|
|
(format 0 "Load soundbank ~A~%" s5-0)
|
|
(sound-bank-load (string->sound-name (symbol->string s5-0)))
|
|
(set! *sound-bank-1* s5-0)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(if (not *sound-bank-2*)
|
|
(return (begin
|
|
(format 0 "Load soundbank ~A~%" s5-0)
|
|
(sound-bank-load (string->sound-name (symbol->string s5-0)))
|
|
(set! *sound-bank-2* s5-0)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(if (!= *sound-bank-1* gp-0)
|
|
(return (begin
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-1*)
|
|
(sound-bank-unload
|
|
(string->sound-name (symbol->string *sound-bank-1*))
|
|
)
|
|
(set! *sound-bank-1* #f)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(if (!= *sound-bank-2* gp-0)
|
|
(return (begin
|
|
(format 0 "Unload soundbank ~A~%" *sound-bank-2*)
|
|
(sound-bank-unload
|
|
(string->sound-name (symbol->string *sound-bank-2*))
|
|
)
|
|
(set! *sound-bank-2* #f)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defmethod update! load-state ((obj 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) (-> obj 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)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(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 (-> obj 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) (-> obj want 0 name))
|
|
)
|
|
(set! a0-20 #f)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (-> obj 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) (-> obj want 1 name))
|
|
)
|
|
(set! v1-5 #f)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(let ((s4-1 -1))
|
|
(cond
|
|
((and a0-20 v1-5)
|
|
(set! s4-1 0)
|
|
(if (and (-> obj want 1 display?)
|
|
(not (-> obj 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~%" (-> obj want s4-1 name))
|
|
(let ((s3-0 (level-get-for-use *level* (the-as symbol (-> obj want s4-1 name)) 'loaded)))
|
|
(when (and s5-1 (-> obj 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 (-> obj want s5-2 name)
|
|
(dotimes (s4-2 3)
|
|
(let ((s3-1 (-> *level* level s4-2)))
|
|
(when (!= (-> s3-1 status) 'inactive)
|
|
(when (= (-> s3-1 name) (-> obj want s5-2 name))
|
|
(when (!= (-> s3-1 display?) (-> obj 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]~%" (-> obj want s5-2 name) (-> obj want s5-2 display?))
|
|
(level-get-for-use *level* (-> s3-1 info name) 'active)
|
|
(set! (-> s3-1 display?) (-> obj want s5-2 display?))
|
|
)
|
|
(else
|
|
(when (and (-> s3-1 info wait-for-load)
|
|
(!= (-> obj 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~%" (-> obj want s5-2 name))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(cond
|
|
((not (-> obj 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~%" (-> obj want s5-2 name) (-> obj want s5-2 display?))
|
|
(set! (-> s3-1 display?) (-> obj want s5-2 display?))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (!= (-> s3-1 force-all-visible?) (-> obj want s5-2 force-vis?))
|
|
(set! (-> s3-1 force-all-visible?) (-> obj want s5-2 force-vis?))
|
|
(format 0 "Setting force-all-visible?[~A] to ~A~%" (-> obj want s5-2 name) (-> obj want s5-2 force-vis?))
|
|
)
|
|
(when (!= (-> s3-1 force-inside?) (-> obj want s5-2 force-inside?))
|
|
(set! (-> s3-1 force-inside?) (-> obj want s5-2 force-inside?))
|
|
(format 0 "Setting force-inside?[~A] to ~A~%" (-> obj want s5-2 name) (-> obj want s5-2 force-inside?))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(let ((s5-3 #f))
|
|
(dotimes (v1-121 (-> *level* length))
|
|
(let ((a0-55 (-> *level* level v1-121)))
|
|
(when (= (-> a0-55 status) 'active)
|
|
(if (nonzero? (-> a0-55 vis-info (-> a0-55 vis-self-index) ramdisk))
|
|
(set! s5-3 (-> a0-55 nickname))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (and (!= s5-3 (-> obj vis-nick)) (-> *level* vis?))
|
|
(when (-> obj vis-nick)
|
|
(dotimes (s4-3 (-> *level* length))
|
|
(let ((v1-133 (-> *level* level s4-3)))
|
|
(when (= (-> v1-133 status) 'active)
|
|
(if (and (= (-> v1-133 nickname) (-> obj vis-nick))
|
|
(-> v1-133 inside-boxes?)
|
|
)
|
|
(load-vis-info (-> obj vis-nick) s5-3)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
;; method 16 level-group (debug text stuff)
|
|
|
|
(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
|
|
(when (zero? (-> *level* level0 art-group))
|
|
(let ((lev-group *level*))
|
|
(set! (-> lev-group vis?) #f)
|
|
(set! (-> lev-group unknown-level-2) (-> 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 280))
|
|
(set! (-> lev-group level0 foreground-draw-engine 1) (new 'global 'engine 'draw 280))
|
|
(set! (-> lev-group level0 foreground-draw-engine 2) (new 'global 'engine 'draw 16))
|
|
(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 280))
|
|
(set! (-> lev-group level1 foreground-draw-engine 1) (new 'global 'engine 'draw 280))
|
|
(set! (-> lev-group level1 foreground-draw-engine 2) (new 'global 'engine 'draw 16))
|
|
(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 280))
|
|
(set! (-> lev-group level-default foreground-draw-engine 1) (new 'global 'engine 'draw 10))
|
|
(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)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
|
|
|