Files
water111 637990314b wip: better stack var support (#4222)
Closes #736

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2026-04-19 00:14:44 +02:00

2542 lines
88 KiB
Common Lisp
Vendored
Generated

;;-*-Lisp-*-
(in-package goal)
;; definition for function lookup-level-info
(defun lookup-level-info ((arg0 symbol))
(let* ((v1-0 *level-load-list*)
(a1-0 (car v1-0))
)
(while (not (null? v1-0))
(let ((a1-1 (the-as level-load-info (-> (the-as symbol a1-0) value))))
(if (or (= arg0 (-> a1-1 name)) (= arg0 (-> a1-1 visname)) (= arg0 (-> a1-1 nickname)))
(return a1-1)
)
)
(set! v1-0 (cdr v1-0))
(set! a1-0 (car v1-0))
)
)
default-level
)
;; definition for method 24 of type level-group
;; WARN: Return type mismatch object vs pair.
(defmethod alt-load-command-get-index ((this level-group) (arg0 symbol) (arg1 int))
(let ((v1-1 (-> (lookup-level-info arg0) alt-load-commands)))
(while (nonzero? arg1)
(+! arg1 -1)
(set! v1-1 (cdr v1-1))
(nop!)
(nop!)
(nop!)
)
(the-as pair (car v1-1))
)
)
;; definition for method 29 of type level-group
(defmethod load-in-progress? ((this level-group))
(!= (-> *level* loading-level) (-> *level* default-level))
)
;; definition for method 11 of type level-group
(defmethod get-level-by-heap-ptr-and-status ((this level-group) (arg0 pointer) (arg1 symbol))
(case arg1
(('active)
(dotimes (v1-1 (-> this length))
(let ((a2-6 (-> this level v1-1)))
(when (= (-> a2-6 status) 'active)
(if (and (>= (the-as int arg0) (the-as int (-> a2-6 heap base)))
(< (the-as int arg0) (the-as int (-> a2-6 heap top-base)))
)
(return a2-6)
)
)
)
)
)
(('loading)
(dotimes (v1-5 (-> this length))
(let ((a2-12 (-> this level v1-5)))
(when (!= (-> a2-12 status) 'inactive)
(if (and (>= (the-as int arg0) (the-as int (-> a2-12 heap base)))
(< (the-as int arg0) (the-as int (-> a2-12 heap top-base)))
)
(return a2-12)
)
)
)
)
)
)
(the-as level #f)
)
;; definition for function remap-level-name
(defun remap-level-name ((arg0 level-load-info))
(if (-> *level* vis?)
(-> arg0 visname)
(-> arg0 name)
)
)
;; definition for method 21 of type level
(defmethod get-art-group-by-name ((this level) (arg0 string))
(countdown (s4-0 (-> this art-group art-group-array length))
(if (name= (-> this art-group art-group-array s4-0 name) arg0)
(return (-> this art-group art-group-array s4-0))
)
)
(the-as art-group #f)
)
;; definition for method 13 of type level
(defmethod bsp-name ((this level))
(if (and (!= (-> this status) 'inactive) (-> this bsp) (nonzero? (-> this bsp name)))
(-> this bsp name)
(-> this name)
)
)
;; definition for function add-bsp-drawable
(defun add-bsp-drawable ((arg0 bsp-header) (arg1 level) (arg2 symbol) (arg3 display-frame))
(draw arg0 arg0 arg3)
(if (nonzero? *display-strip-lines*)
(debug-draw arg0 arg0 arg3)
)
(none)
)
;; definition for method 2 of type level
(defmethod print ((this level))
(format #t "#<~A ~A ~S @ #x~X>" (-> this type) (-> this status) (-> this name) this)
this
)
;; definition for method 7 of type bsp-header
(defmethod relocate ((this bsp-header) (offset int))
(let ((s5-0 (-> *level* loading-level)))
(when s5-0
(cond
(this
(cond
((not (type? this bsp-header))
(format 0 "ERROR: level ~A is not a bsp-header.~%" (-> s5-0 name))
(the-as bsp-header #f)
)
((not (file-info-correct-version? (-> this info) (file-kind level-bt) 0))
(the-as bsp-header #f)
)
((< 2048 (-> this visible-list-length))
(format
0
"ERROR: level ~A visible-list-length ~d is greater than 2048 (16384 drawables).~%"
(-> s5-0 name)
(-> this visible-list-length)
)
(the-as bsp-header #f)
)
(else
(set! (-> s5-0 bsp) this)
(set! (-> this level) s5-0)
this
)
)
)
(else
(format 0 "ERROR: level ~A is not a valid file.~%" (-> s5-0 name))
(the-as bsp-header #f)
)
)
)
)
)
;; definition for method 27 of type level
(defmethod load-required-packages ((this level))
(when (not (or (not (-> this bsp)) (= *kernel-boot-mode* 'debug-boot)))
(if (not (null? (-> this info packages)))
(load-package "common" global)
)
)
this
)
;; definition for method 29 of type level
;; INFO: Used lq/sq
;; WARN: Return type mismatch int vs none.
(defmethod vis-clear ((this level))
(countdown (v1-0 8)
(nop!)
(set! (-> this vis-info v1-0) #f)
)
(dotimes (v1-3 128)
(set! (-> (the-as (pointer int128) (&+ (-> this vis-bits) (* v1-3 16)))) 0)
)
(set! (-> this all-visible?) 'loading)
0
(none)
)
;; definition for method 28 of type level
;; WARN: Return type mismatch int vs none.
(defmethod init-vis-from-bsp ((this level))
(when (not (or (= (-> this status) 'inactive) (not (-> this bsp))))
(set! (-> this all-visible?) 'loading)
(dotimes (s5-0 8)
(let ((s4-0 (-> this bsp vis-info s5-0)))
(cond
((and s4-0 (nonzero? s4-0) (valid? s4-0 level-vis-info (the-as string #f) #f 0))
(set! (-> this vis-info s5-0) s4-0)
(set! (-> s4-0 current-vis-string) (the-as uint -1))
(if (= (-> s4-0 from-level) (-> this load-name))
(set! (-> s4-0 from-bsp) (-> this bsp))
(set! (-> s4-0 from-bsp) #f)
)
(set! (-> s4-0 vis-bits) (the-as uint (-> this vis-bits)))
(set! (-> s4-0 flags)
(the-as vis-info-flag (logclear (-> s4-0 flags) (vis-info-flag in-iop loading vis-valid)))
)
(set! *vis-boot* #t)
)
(else
(set! (-> this vis-info s5-0) #f)
)
)
)
)
)
0
(none)
)
;; definition for method 12 of type level-group
(defmethod level-get-for-use ((this level-group) (arg0 symbol) (arg1 symbol))
(local-vars (s5-1 level))
(alloc-levels-if-needed this #f)
(let* ((s2-0 (lookup-level-info arg0))
(s1-0 (remap-level-name s2-0))
)
(let ((s5-0 (level-get this s1-0)))
(when s5-0
(level-status-update! s5-0 arg1)
(set! s5-1 s5-0)
(goto cfg-13)
)
)
(let ((a0-7 (level-get-most-disposable this)))
(set! s5-1 (if a0-7
(level-status-update! a0-7 'inactive)
a0-7
)
)
)
(when (not level)
(format 0 "ERROR: could not find a slot to load ~A into.~%" arg0)
(set! s5-1 (the-as level #f))
(goto cfg-13)
)
(let ((v1-13 (+ (-> this load-order) 1)))
(set! (-> this load-order) v1-13)
(set! (-> s5-1 load-order) (the-as int v1-13))
)
(set! (-> s5-1 info) s2-0)
(set! (-> s5-1 name) arg0)
(set! (-> s5-1 load-name) s1-0)
)
(set! (-> s5-1 mood-func) (the-as (function mood-context float int none) (-> s5-1 info mood-func value)))
(set! (-> s5-1 mood-init) (the-as (function mood-context none) (-> s5-1 info mood-init value)))
(dotimes (v1-20 10)
(set! (-> s5-1 texture-anim-array v1-20) #f)
)
(set! (-> s5-1 display?) #f)
(set! (-> s5-1 force-all-visible?) #f)
(set! (-> s5-1 force-inside?) #f)
(level-status-update! s5-1 'loading)
(level-status-update! s5-1 arg1)
(label cfg-13)
s5-1
)
;; definition for method 28 of type level-group
(defmethod level-status ((this level-group) (arg0 symbol))
(let ((v1-1 (level-get *level* arg0)))
(if v1-1
(-> v1-1 status)
)
)
)
;; definition for method 26 of type level
;; INFO: Used lq/sq
(defmethod level-status-update! ((this level) (arg0 symbol))
(case arg0
(('inactive)
(-> this status)
(unload! this)
)
(('loading)
(case (-> this status)
(('inactive)
(load-begin this)
)
)
)
(('loading-bt)
(case (-> this status)
(('loading)
(set! (-> this status) arg0)
(load-continue this)
)
)
)
(('loading-done)
(case (-> this status)
(('loading-bt)
(set! (-> this status) arg0)
)
)
)
(('loaded)
(case (-> this status)
(('loading-done)
(login-begin this)
)
(('alive 'active)
(deactivate this)
)
)
)
(('alive 'active)
(when *dproc*
(case (-> this status)
(('loaded)
(birth this)
(level-status-update! this arg0)
)
(('alive)
(when (and *dproc* (= arg0 'active))
(when (zero? (-> this display-start-time))
(set! (-> this display-start-time) (-> *display* real-clock frame-counter))
0
)
(remove-by-param1 *background-draw-engine* (the-as int (-> this bsp)))
(add-connection *background-draw-engine* *dproc* add-bsp-drawable (-> this bsp) this #f)
(dotimes (v1-46 18)
(set! (-> this closest-object-array v1-46) 0.0)
(set! (-> this texture-mask v1-46 mask quad) (the-as uint128 0))
)
(set! (-> this status) 'active)
(assign-draw-indices *level*)
)
)
)
)
)
)
this
)
;; definition for symbol *login-state*, type login-state
(define *login-state* (new 'global 'login-state))
;; definition for symbol *print-login*, type symbol
(define *print-login* #t)
;; definition for function load-buffer-resize
;; WARN: Return type mismatch int vs none.
(defun load-buffer-resize ((arg0 level) (arg1 dgo-header))
(case (-> arg0 load-buffer-mode)
(((load-buffer-mode small-center))
(set! (-> arg0 load-buffer-size) (the-as uint #x113000))
)
(((load-buffer-mode medium))
(set! (-> arg0 load-buffer-size) (+ (-> arg1 length) 2048))
)
)
(let ((v1-6 (logand -64 (+ (-> arg0 load-buffer-size) 63))))
(if (= arg1 (-> arg0 load-buffer 0))
(set! (-> arg0 load-buffer 0) (- (-> arg0 load-buffer 1) v1-6))
(set! (-> arg0 load-buffer 1)
(the-as uint (&- (logand -64 (&+ (-> arg0 heap top-base) 0)) (the-as uint v1-6)))
)
)
)
(set! (-> arg0 heap top) (the-as pointer (-> arg0 load-buffer 0)))
0
(none)
)
;; definition for method 17 of type level
(defmethod load-continue ((this level))
(when (-> this linking)
(when (nonzero? (link-resume))
(set! (-> this linking) #f)
(case (-> this status)
(('loading)
(when (not (-> *texture-relocate-later* memcpy))
(cond
((= (-> this load-buffer-mode) (load-buffer-mode ten))
(let ((a2-0 (logand -64 (&+ (-> this heap current) 63))))
(dgo-load-continue a2-0 a2-0 a2-0)
)
)
(else
(load-buffer-resize this (the-as dgo-header (-> this load-buffer-last)))
(dgo-load-continue
(the-as pointer (-> this load-buffer 0))
(the-as pointer (-> this load-buffer 1))
(logand -64 (&+ (-> this heap current) 63))
)
)
)
)
)
(('loading-bt)
(level-status-update! this 'loading-done)
(level-status-update! this 'loaded)
)
)
)
(set! this this)
(goto cfg-39)
)
(when (-> *texture-relocate-later* memcpy)
(relocate-later)
(load-buffer-resize this (the-as dgo-header (-> this load-buffer-last)))
(dgo-load-continue
(the-as pointer (-> this load-buffer 0))
(the-as pointer (-> this load-buffer 1))
(logand -64 (&+ (-> this heap current) 63))
)
(set! this this)
(goto cfg-39)
)
(case (-> this status)
(('loading)
(let* ((sv-16 (the-as symbol #f))
(s5-0 (dgo-load-get-next (& sv-16)))
)
(when s5-0
(set! (-> this load-buffer-last) (the-as uint s5-0))
(+! (-> *level* load-size) (-> (the-as (pointer uint32) s5-0)))
(set! (-> *level* load-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
)
(set! (-> *level* load-login-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
)
(cond
((not sv-16)
(cond
((= (-> this load-buffer-mode) (load-buffer-mode ten))
(cond
((dgo-load-link (the-as dgo-header s5-0) (-> this heap) (the-as uint (-> this heap top-base)) *print-login* #f)
(when (not (-> *texture-relocate-later* memcpy))
(let ((a2-8 (logand -64 (&+ (-> this heap current) 63))))
(dgo-load-continue a2-8 a2-8 a2-8)
)
)
)
(else
(set! (-> this linking) #t)
)
)
)
((dgo-load-link (the-as dgo-header s5-0) (-> this heap) (-> this load-buffer 1) *print-login* #f)
(when (not (-> *texture-relocate-later* memcpy))
(load-buffer-resize this (the-as dgo-header s5-0))
(dgo-load-continue
(the-as pointer (-> this load-buffer 0))
(the-as pointer (-> this load-buffer 1))
(logand -64 (&+ (-> this heap current) 63))
)
)
)
(else
(set! (-> this linking) #t)
)
)
)
(else
(set! (-> this heap top) (-> this heap top-base))
(level-status-update! this 'loading-bt)
)
)
)
)
)
(('login)
(level-update-after-load this *login-state*)
)
(('loading-bt)
(let ((a0-36 (logand -64 (&+ (-> this heap current) 63))))
(cond
((dgo-load-link
(the-as dgo-header a0-36)
(-> this heap)
(the-as uint (-> this heap top-base))
*print-login*
#t
)
(level-status-update! this 'loading-done)
(level-status-update! this 'loaded)
)
(else
(set! (-> this linking) #t)
)
)
)
)
)
(label cfg-39)
this
)
;; definition for method 18 of type level
(defmethod load-begin ((this level))
(local-vars (bits-to-use int) (borrow-from-lev level) (found-borrow symbol))
(dotimes (v1-0 2)
(set! (-> this borrow-level v1-0) #f)
)
(set! (-> this borrow-from-level) #f)
(set! (-> this memory-mask) (the-as uint 0))
(let ((mem-mode (-> this info memory-mode)))
(case mem-mode
(((load-buffer-mode borrow))
(let ((slot-in-borrow-from-lev -1))
(dotimes (borrow-from-lev-idx 6)
(let ((maybe-borrow-from-lev (-> *level* level borrow-from-lev-idx)))
(when (and (or (= (-> maybe-borrow-from-lev status) 'active) (= (-> maybe-borrow-from-lev status) 'loaded))
(begin
(dotimes (check-slot-idx 2)
(when (and (= (-> maybe-borrow-from-lev info borrow-level check-slot-idx) (-> this name))
(nonzero? (-> maybe-borrow-from-lev info borrow-size check-slot-idx))
)
(set! slot-in-borrow-from-lev check-slot-idx)
(set! found-borrow #t)
(goto cfg-20)
)
)
(set! found-borrow #f)
(label cfg-20)
(and found-borrow
(>= slot-in-borrow-from-lev 0)
(not (-> maybe-borrow-from-lev borrow-level slot-in-borrow-from-lev))
)
)
)
(set! borrow-from-lev maybe-borrow-from-lev)
(goto cfg-32)
)
)
)
(set! borrow-from-lev (the-as level #f))
(label cfg-32)
(cond
(borrow-from-lev
(set! (-> this borrow-from-level) borrow-from-lev)
(set! (-> borrow-from-lev borrow-level slot-in-borrow-from-lev) this)
(mem-copy!
(the-as pointer (-> this heap))
(the-as pointer (-> borrow-from-lev borrow-heap slot-in-borrow-from-lev))
16
)
)
(else
(format
0
"ERROR: level ~A could not find free ~S bank in the level-group heap~%"
(-> this name)
(cond
((= mem-mode (load-buffer-mode large))
"large"
)
((= mem-mode (load-buffer-mode borrow))
"borrow"
)
((= mem-mode (load-buffer-mode small-center))
"small-center"
)
((= mem-mode (load-buffer-mode medium))
"medium"
)
((= mem-mode (load-buffer-mode small-edge))
"small-edge"
)
(else
"*unknown*"
)
)
)
(break!)
0
)
)
)
)
(else
(let* ((memory-unused? (lambda ((arg0 level-group) (arg1 int))
(dotimes (v1-0 7)
(if (logtest? (-> arg0 level v1-0 memory-mask) arg1)
(return #f)
)
)
#t
)
)
(offset-in-level-heap 0)
(v1-14 mem-mode)
(heap-size (cond
((= v1-14 (load-buffer-mode large))
#xbd0000
)
((= v1-14 (load-buffer-mode medium))
#x8fb800
)
((= v1-14 (load-buffer-mode small-center))
#x627000
)
(else
#x5e8000
)
)
)
)
(case mem-mode
(((load-buffer-mode large))
(when (memory-unused? *level* 15)
(set! bits-to-use 15)
(goto cfg-83)
)
(when (memory-unused? *level* 60)
(set! offset-in-level-heap 48)
(set! bits-to-use 60)
(goto cfg-83)
)
)
(((load-buffer-mode medium))
(when (memory-unused? *level* 7)
(set! bits-to-use 7)
(goto cfg-83)
)
(when (memory-unused? *level* 56)
(set! offset-in-level-heap 73)
(set! bits-to-use 56)
(goto cfg-83)
)
)
(((load-buffer-mode small-center))
(when (memory-unused? *level* 12)
(set! offset-in-level-heap 48)
(set! bits-to-use 12)
(goto cfg-83)
)
)
(((load-buffer-mode small-edge))
(when (memory-unused? *level* 3)
(set! bits-to-use 3)
(goto cfg-83)
)
(when (memory-unused? *level* 48)
(set! offset-in-level-heap 98)
(set! bits-to-use 48)
(goto cfg-83)
)
)
)
(set! bits-to-use 0)
(label cfg-83)
(cond
((zero? bits-to-use)
(let ((v1-32 mem-mode))
(format
0
"ERROR: level ~A could not find free ~S bank in the level-group heap~%"
(-> this name)
(cond
((= v1-32 (load-buffer-mode large))
"large"
)
((= v1-32 (load-buffer-mode borrow))
"borrow"
)
((= v1-32 (load-buffer-mode small-center))
"small-center"
)
((= v1-32 (load-buffer-mode medium))
"medium"
)
((= v1-32 (load-buffer-mode small-edge))
"small-edge"
)
(else
"*unknown*"
)
)
)
)
(dotimes (s5-1 7)
(if (!= (-> *level* level s5-1 status) 'inactive)
(format
0
"~Tlevel ~16S using bits #x~6,'0B~%"
(-> *level* level s5-1 name)
(-> *level* level s5-1 memory-mask)
)
)
)
#t
(break!)
0
)
(else
(set! (-> this memory-mask) (the-as uint bits-to-use))
(cond
((= (&- (-> *level* heap top) (the-as uint (-> *level* heap base))) #x1af2800)
(let ((v1-44 (-> this heap)))
(set! (-> v1-44 base) (&+ (-> *level* heap base) (* #x2f400 offset-in-level-heap)))
(set! (-> v1-44 current) (-> v1-44 base))
(set! (-> v1-44 top-base) (&+ (-> v1-44 base) (+ heap-size (/ heap-size 2))))
(set! (-> v1-44 top) (-> v1-44 top-base))
)
)
(else
(let ((v1-45 (-> this heap)))
(set! (-> v1-45 base) (&+ (-> *level* heap base) (* #x1f800 offset-in-level-heap)))
(set! (-> v1-45 current) (-> v1-45 base))
(set! (-> v1-45 top-base) (&+ (-> v1-45 base) heap-size))
(set! (-> v1-45 top) (-> v1-45 top-base))
)
)
)
)
)
)
)
)
)
(set! loading-level (-> this heap))
(set! (-> *level* loading-level) this)
(set! (-> this level-type) #f)
(set! *level-type-list* (the-as type (&-> this level-type)))
(set! (-> *level* log-in-level-bsp) #f)
(set! (-> this nickname) #f)
(set! (-> this bsp) #f)
(set! (-> this entity) #f)
(set! (-> this linking) #f)
(set! (-> this task-mask) (-> *setting-control* user-current task-mask))
(vis-clear this)
(set! (-> this load-start-time) (-> *display* real-clock frame-counter))
(set! (-> this load-stop-time) 0)
(set! (-> this display-start-time) 0)
(set! (-> this part-engine) #f)
(dotimes (v1-57 4)
(set! (-> this user-object v1-57) #f)
)
(set! (-> this status) 'loading)
(set! (-> *texture-pool* allocate-func) texture-page-level-allocate)
(if (= (-> this load-name) (-> this info visname))
(format (clear *temp-string*) "~S" (-> this info nickname))
(format (clear *temp-string*) "~S" (-> this name))
)
(set! (-> *temp-string* data 8) (the-as uint 0))
(format *temp-string* ".DGO")
(set! (-> this heap top) (-> this heap top-base))
(set! (-> *level* load-level) (-> this load-name))
(set! (-> *level* load-size) (the-as uint 0))
(set! (-> *level* load-time) 0.0)
(set! (-> *level* load-login-time) 0.0)
(set! (-> this code-memory-start) (-> this heap current))
(cond
((= (-> this info memory-mode) (load-buffer-mode borrow))
(set! (-> this load-buffer-mode) (load-buffer-mode ten))
(let ((a3-19 (logand -64 (&+ (-> this heap current) 63))))
(dgo-load-begin *temp-string* a3-19 a3-19 a3-19)
)
)
(else
(let* ((s3-1 #x1b5800)
(s4-1 (kmalloc (-> this heap) s3-1 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
(s5-4 (kmalloc (-> this heap) s3-1 (kmalloc-flags align-64 top) "dgo-level-buf-2"))
)
(format 0 "-----------> begin load ~A [~S]~%" (-> this load-name) *temp-string*)
(set! (-> this load-buffer 0) (the-as uint s5-4))
(set! (-> this load-buffer 1) (the-as uint s4-1))
(set! (-> this load-buffer-size) (the-as uint s3-1))
(set! (-> this load-buffer-mode) (load-buffer-mode small-edge))
(dgo-load-begin *temp-string* s5-4 s4-1 (logand -64 (&+ (-> this heap current) 63)))
)
)
)
this
)
;; definition for method 19 of type level
(defmethod login-begin ((this level))
(set! (-> *texture-pool* allocate-func) texture-page-default-allocate)
(cond
((-> this bsp)
(let ((s5-0 (-> this bsp)))
(set! (-> s5-0 level tfrag-gs-test)
(if (logtest? (-> s5-0 texture-flags 0) (texture-page-flag alpha-enable))
(new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest greater-equal))
(new 'static 'gs-test
:ate #x1
:atst (gs-atest greater-equal)
:aref #x26
:zte #x1
:ztst (gs-ztest greater-equal)
)
)
)
(set! (-> *level* log-in-level-bsp) (-> this bsp))
(login-level-textures *texture-pool* this (-> this bsp texture-page-count) (-> this bsp texture-ids))
(dotimes (v1-10 6)
(set! (-> this sky-mask mask data v1-10) 0)
)
(dotimes (s4-0 10)
(let ((a0-8 (-> this info texture-anim s4-0)))
(if a0-8
(set! (-> this texture-anim-array s4-0) (init! (the-as texture-anim-array (-> a0-8 value))))
)
)
)
(build-masks s5-0)
)
(set! (-> *login-state* state) -1)
(set! (-> *login-state* pos) (the-as uint 0))
(set! (-> *login-state* elts) (the-as uint 0))
(set! (-> this status) 'login)
)
(else
(level-status-update! this 'inactive)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* default-level))
(set! *level-type-list* (the-as type 0))
0
)
)
this
)
;; definition for function level-update-after-load
;; WARN: Found some very strange gotos. Check result carefully, this is not well tested.
;; INFO: Used lq/sq
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 s5, Count]
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 v1, Count]
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 v1, Count]
(defun level-update-after-load ((lev level) (lstate login-state))
(local-vars (current-time int) (end-time int) (start-time int))
(set! *level-index* (-> lev index))
0
(let ((drawable-trees (-> lev bsp drawable-trees)))
0
(.mfc0 start-time Count)
(label cfg-1)
0
(.mfc0 current-time Count)
(let ((v1-6 (- current-time start-time)))
(when (< #x186a0 v1-6)
(set! lev lev)
(goto cfg-113)
)
)
(let ((login-state-pos (the-as int (-> lstate pos))))
(when (= (-> lstate state) -1)
(when (< login-state-pos (-> drawable-trees length))
(let ((current-tree (-> drawable-trees trees (the-as uint login-state-pos))))
(cond
((= (-> current-tree type) drawable-tree-tfrag)
(dotimes (tree-array-idx (-> current-tree length))
(cond
((= (-> current-tree data tree-array-idx type) drawable-inline-array-tfrag)
(set! (-> lstate elt (-> lstate elts)) (-> current-tree data tree-array-idx))
(+! (-> lstate elts) 1)
)
(else
(login (-> current-tree data tree-array-idx))
)
)
)
)
((= (-> current-tree type) drawable-tree-instance-tie)
(set! (-> lstate elt (-> lstate elts)) current-tree)
(+! (-> lstate elts) 1)
)
(else
(login current-tree)
)
)
)
(+! (-> lstate pos) 1)
(goto cfg-1)
)
(let ((art-group-array-idx (- (the-as uint login-state-pos) (-> drawable-trees length))))
(when (< (the-as int art-group-array-idx) (-> lev art-group art-group-array length))
(let ((current-ag (-> lev art-group art-group-array art-group-array-idx)))
(login current-ag)
(if (needs-link? current-ag)
(link-art! current-ag)
)
)
(+! (-> lstate pos) 1)
(goto cfg-1)
)
)
(set! (-> lstate pos) (the-as uint 0))
(set! (-> lstate state) 0)
(goto cfg-1)
)
(when (< (-> lstate state) (the-as int (-> lstate elts)))
(let ((current-array (-> lstate elt (-> lstate state))))
(cond
((= (-> current-array type) drawable-inline-array-tfrag)
(set! *texture-masks-array* (-> lev bsp tfrag-masks))
(cond
((< login-state-pos (-> (the-as drawable-inline-array-tfrag current-array) length))
(dotimes (s2-2 200)
(when (< login-state-pos (-> (the-as drawable-inline-array-tfrag current-array) length))
(login (-> (the-as drawable-inline-array-tfrag current-array) data (the-as uint login-state-pos)))
(set! login-state-pos (the-as int (+ (the-as uint login-state-pos) 1)))
)
)
(set! (-> lstate pos) (the-as uint login-state-pos))
)
(else
(set! (-> lstate pos) (the-as uint 0))
(set! login-state-pos (+ (-> lstate state) 1))
(set! (-> lstate state) login-state-pos)
)
)
)
((= (-> current-array type) drawable-tree-instance-tie)
(let ((proto-array (-> (the-as drawable-tree-instance-tie current-array) prototypes prototype-array-tie)))
(let ((protos (-> (the-as drawable-tree-instance-tie current-array) prototypes)))
(when (< login-state-pos (-> proto-array length))
(let ((sv-16 0))
(while (< sv-16 10)
(when (< login-state-pos (-> proto-array length))
(let ((proto (-> proto-array array-data (the-as uint login-state-pos))))
(+! (-> protos prototype-max-qwc) 32)
(cond
((logtest? (-> proto flags) (prototype-flags tpage-alpha))
(set! *texture-masks* (-> *level* level *level-index* bsp alpha-masks data (-> proto texture-masks-index)))
)
((logtest? (-> proto flags) (prototype-flags tpage-water))
(set! *texture-masks* (-> *level* level *level-index* bsp water-masks data (-> proto texture-masks-index)))
)
(else
(set! *texture-masks* (-> *level* level *level-index* bsp tfrag-masks data (-> proto texture-masks-index)))
)
)
(when (and *debug-segment* (-> *screen-shot-work* highres-enable))
(dotimes (v1-105 4)
(+! (-> proto dists data v1-105) 40960000.0)
(set! (-> proto rdists data v1-105) (/ 1.0 (-> proto dists data v1-105)))
)
)
(let ((geom-idx 0))
(while (< geom-idx 4)
(let ((geom (-> proto tie-geom geom-idx)))
(when (nonzero? geom)
(+! (-> protos prototype-max-qwc) (* 7 (-> geom length)))
(login geom)
)
)
(+! geom-idx 1)
)
)
)
(set! login-state-pos (the-as int (+ (the-as uint login-state-pos) 1)))
)
(+! sv-16 1)
)
)
(set! (-> lstate pos) (the-as uint login-state-pos))
)
)
(when (= (the-as uint login-state-pos) (-> proto-array length))
(dotimes (proto2-idx (-> proto-array length))
(let ((proto2 (-> proto-array array-data proto2-idx)))
(cond
((logtest? (-> proto2 flags) (prototype-flags tpage-alpha))
(set! *texture-masks* (-> *level* level *level-index* bsp alpha-masks data (-> proto2 texture-masks-index)))
)
((logtest? (-> proto2 flags) (prototype-flags tpage-water))
(set! *texture-masks* (-> *level* level *level-index* bsp water-masks data (-> proto2 texture-masks-index)))
)
(else
(set! *texture-masks* (-> *level* level *level-index* bsp tfrag-masks data (-> proto2 texture-masks-index)))
)
)
(let ((envmap-shader (-> proto2 envmap-shader)))
(when (nonzero? envmap-shader)
(let ((envmap-tex (adgif-shader-login-no-remap envmap-shader)))
(when envmap-tex
(dotimes (v1-137 3)
(dotimes (a0-74 3)
(set! (-> (the-as (pointer int32) (+ (+ (* v1-137 16) (* a0-74 4)) (the-as int *texture-masks*))))
(logior (-> (the-as (pointer int32) (+ (* a0-74 4) (the-as int *texture-masks*) (* v1-137 16))) 0)
(-> (the-as (pointer int32) (+ (* a0-74 4) (the-as int envmap-tex) (* v1-137 16))) 15)
)
)
)
(set! (-> *texture-masks* data v1-137 dist)
(fmax (-> *texture-masks* data v1-137 dist) (-> envmap-tex masks data v1-137 dist))
)
)
)
)
(set! (-> envmap-shader tex1) (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
(set! (-> envmap-shader clamp)
(new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp))
)
(set! (-> envmap-shader alpha) (new 'static 'gs-alpha :b #x2 :c #x1 :d #x1))
(set! (-> envmap-shader prims 1) (gs-reg64 tex0-1))
(set! (-> envmap-shader prims 3) (gs-reg64 tex1-1))
(set! (-> envmap-shader prims 5) (gs-reg64 miptbp1-1))
(set! (-> envmap-shader clamp-reg) (gs-reg64 clamp-1))
(set! (-> envmap-shader prims 9) (gs-reg64 alpha-1))
)
)
)
)
(set! (-> lstate pos) (the-as uint 0))
(+! (-> lstate state) 1)
)
)
)
)
)
(goto cfg-1)
)
(when (= (-> lstate state) (-> lstate elts))
(let ((lev-bsp (-> lev bsp)))
(cond
((or (zero? (-> lev-bsp nav-meshes)) (= (the-as uint login-state-pos) (-> lev-bsp nav-meshes length)))
(set! (-> lstate pos) (the-as uint 0))
(+! (-> lstate state) 1)
)
(else
(initialize-nav-mesh! (-> lev-bsp nav-meshes (the-as uint login-state-pos)))
(+! (-> lstate pos) 1)
)
)
)
(goto cfg-1)
)
(when (zero? (the-as uint login-state-pos))
(set! (-> lstate pos) (the-as uint 1))
(set! lev lev)
(goto cfg-113)
)
)
)
(set! (-> lev nickname) (-> lev bsp nickname))
(let ((close-dist (-> lev bsp subdivide-close))
(far-dist (-> lev bsp subdivide-far))
)
(when (and (= close-dist 0.0) (= far-dist 0.0))
(set! close-dist 122880.0)
(set! far-dist 286720.0)
)
(set! (-> *subdivide-settings* close (-> lev index)) close-dist)
(set! (-> *subdivide-settings* far (-> lev index)) far-dist)
(set! (-> *subdivide-settings* close 7) close-dist)
(set! (-> *subdivide-settings* far 7) far-dist)
)
(when (and *debug-segment* (-> *screen-shot-work* highres-enable))
(set! (-> *subdivide-settings* close (-> lev index)) 40960000.0)
(set! (-> *subdivide-settings* far (-> lev index)) 41369600.0)
(set! (-> *subdivide-settings* close 7) 40960000.0)
(set! (-> *subdivide-settings* far 7) 41369600.0)
)
(init-vis-from-bsp lev)
(if (nonzero? (-> lev info part-engine-max))
(set! (-> lev part-engine)
(new 'loading-level 'engine 'sparticle-launcher (-> lev info part-engine-max) connection)
)
)
(load-required-packages lev)
(clear-mood-context (-> lev mood-context))
(if (-> lev mood-init)
((-> lev mood-init) (-> lev mood-context))
)
(dotimes (v1-211 2)
(set! (-> lev heap top-base)
(&- (-> lev heap top-base) (the-as uint (shl (-> lev info borrow-size v1-211) 10)))
)
(set! (-> lev heap top) (-> lev heap top-base))
(let ((borrower-heap (-> lev borrow-heap v1-211)))
(set! (-> borrower-heap base) (-> lev heap top))
(set! (-> borrower-heap current) (-> borrower-heap base))
(set! (-> borrower-heap top-base) (&+ (-> borrower-heap base) (shl (-> lev info borrow-size v1-211) 10)))
(set! (-> borrower-heap top) (-> borrower-heap top-base))
)
)
(set! (-> lev draw-priority) (-> lev info draw-priority))
(set! (-> lev status) 'loaded)
(mark-hud-warp-sprite-dirty *texture-pool*)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* default-level))
(set! *level-type-list* (the-as type 0))
(set! (-> *level* log-in-level-bsp) #f)
(set! (-> lev load-stop-time) (-> *display* real-clock frame-counter))
0
(.mfc0 end-time Count)
(- end-time start-time)
(set! (-> *level* load-login-time)
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) (the-as uint *dgo-time*))))
)
(label cfg-113)
lev
)
;; definition for method 25 of type level
;; INFO: Used lq/sq
(defmethod birth ((this level))
(case (-> this status)
(('loaded)
(let ((s5-0 loading-level)
(s4-0 (-> *level* loading-level))
(s3-0 (-> *level* log-in-level-bsp))
(s2-1 *level-type-list*)
)
(let ((s1-0 (not (-> this entity))))
(set! loading-level (-> this heap))
(set! (-> *level* log-in-level-bsp) (-> this bsp))
(set! (-> *level* loading-level) this)
(set! *level-type-list* (the-as type (&-> this level-type)))
(cond
((valid? (-> this bsp light-hash) light-hash (the-as string #f) #t 0)
(set! (-> this light-hash) (-> this bsp light-hash))
)
(else
(set! (-> this light-hash) (the-as light-hash 0))
0
)
)
(birth (-> this bsp))
(set! (-> this status) 'alive)
(set! (-> this render?) #t)
(copy-perms-to-level! *game-info* this)
(send-event *camera* 'level-activate (-> this name))
(send-event *target* 'level-activate (-> this name))
(when (and (-> this info login-func) s1-0)
(let ((s1-1 (-> this info login-func value)))
(if (and s1-1 (nonzero? s1-1) (type? s1-1 function))
(s1-1 this)
)
)
)
)
(let ((s1-2 (-> this status)))
(set! (-> this status) 'active)
(update-task-masks 'level)
(assign-draw-indices *level*)
(let ((s0-0 (-> this bsp nav-meshes)))
(when (nonzero? s0-0)
(let ((sv-96 0))
(while (< sv-96 (-> s0-0 length))
(birth! (-> s0-0 sv-96))
(+! sv-96 1)
)
)
)
)
(if (and (!= (-> this bsp city-level-info) 0) *traffic-manager*)
(send-event *traffic-manager* 'level-loaded this)
)
(when (-> this info activate-func)
(let ((s0-1 (-> this info activate-func value)))
(if (and s0-1 (nonzero? s0-1) (type? s0-1 function))
(s0-1 this 'display)
)
)
)
(set! (-> this status) s1-2)
)
(set! loading-level s5-0)
(set! (-> *level* loading-level) s4-0)
(set! (-> *level* log-in-level-bsp) s3-0)
(set! *level-type-list* s2-1)
)
)
)
this
)
;; definition for method 9 of type level
;; INFO: Used lq/sq
(defmethod deactivate ((this level))
(case (-> this status)
(('active 'alive)
(format 0 "----------- kill ~A (status ~A)~%" this (-> this status))
(if (and (!= (-> this bsp city-level-info) 0) *traffic-manager*)
(send-event *traffic-manager* 'level-killed this)
)
(when (-> this info kill-func)
(let ((s5-0 (-> this info kill-func value)))
(if (and s5-0 (nonzero? s5-0) (type? s5-0 function))
(s5-0 this)
)
)
)
(copy-perms-from-level! *game-info* this)
(send-event *target* 'level-deactivate (-> this name))
(remove-by-param1 *background-draw-engine* (the-as int (-> this bsp)))
(deactivate-entities (-> this bsp))
(kill-all-particles-in-level this)
(unload-from-level *anim-manager* this)
(set! (-> this inside-boxes) #f)
(set! (-> this meta-inside?) #f)
(set! (-> this force-inside?) #f)
(set! (-> this status) 'loaded)
(set! (-> this light-hash) (the-as light-hash 0))
(set! (-> this all-visible?) 'loading)
(dotimes (v1-34 128)
(set! (-> (the-as (pointer int128) (&+ (-> this vis-bits) (* v1-34 16)))) 0)
)
(countdown (v1-37 8)
(let ((a0-20 (-> this vis-info v1-37)))
(if a0-20
(set! (-> a0-20 current-vis-string) (the-as uint -1))
)
)
)
)
)
(if (= (-> *level* log-in-level-bsp) (-> this bsp))
(set! (-> *level* log-in-level-bsp) #f)
)
this
)
;; definition for method 12 of type level
;; WARN: Using new Jak 2 rtype-of
(defmethod unload! ((this level))
(deactivate this)
(when (!= (-> this status) 'inactive)
(dotimes (s5-0 2)
(when (-> this borrow-level s5-0)
(unload! (-> this borrow-level s5-0))
(set! (-> this borrow-level s5-0) #f)
)
)
(when (-> this borrow-from-level)
(dotimes (v1-19 2)
(if (= this (-> this borrow-from-level borrow-level v1-19))
(set! (-> this borrow-from-level borrow-level v1-19) #f)
)
)
(set! (-> this borrow-from-level) #f)
)
(case (-> this status)
(('loading 'loading-bt)
(if (nonzero? link-reset)
(link-reset)
)
)
(('alive 'active 'loaded)
(when (-> this info deactivate-func)
(let ((s5-1 (-> this info deactivate-func value)))
(if (and s5-1 (nonzero? s5-1) (type? s5-1 function))
(s5-1 this)
)
)
)
)
)
(when (or (= (-> this status) 'loaded)
(= (-> this status) 'alive)
(= (-> this status) 'active)
(= (-> this status) 'login)
)
(dotimes (s5-2 (-> this art-group art-group-array length))
(let ((s4-0 (-> this art-group art-group-array s5-2)))
(if (needs-link? s4-0)
(unlink-art! s4-0)
)
)
)
)
(set! (-> this bsp) #f)
(set! (-> this entity) #f)
(set! (-> this status) 'inactive)
(set! (-> this linking) #f)
(set! (-> this art-group string-array length) 0)
(set! (-> this art-group art-group-array length) 0)
(set! (-> this mem-usage-block) (the-as memory-usage-block 0))
(set! (-> this mem-usage) 0)
(set! (-> this part-engine) #f)
(dotimes (v1-60 4)
(set! (-> this user-object v1-60) #f)
)
(let ((v1-63 (-> this status)))
(when (or (= v1-63 'alive) (or (= v1-63 'active) (= v1-63 'loaded)))
(dotimes (s5-3 10)
(let ((a0-37 (-> this info texture-anim s5-3)))
(if a0-37
(set! (-> this texture-anim-array s5-3) (clear! (the-as texture-anim-array (-> a0-37 value))))
)
)
)
)
)
(dotimes (v1-73 10)
(set! (-> this texture-anim-array v1-73) #f)
)
(countdown (s5-4 (-> this loaded-texture-page-count))
(dotimes (v1-76 32)
(when (= (-> this loaded-texture-page s5-4) (-> *texture-pool* common-page v1-76))
(set! (-> *texture-pool* common-page v1-76) (the-as texture-page 0))
0
)
)
(unload-page *texture-pool* (-> this loaded-texture-page s5-4))
)
(set! (-> this loaded-texture-page-count) 0)
(unlink-shaders-in-heap *texture-page-dir* (-> this heap))
(unlink-part-group-by-heap (-> this heap))
(unlink-lightning-spec-by-heap (-> this heap))
(particle-adgif-cache-flush)
(set! (-> this loaded-text-info-count) 0)
(dotimes (s5-5 2)
(let ((v1-90 (-> *art-control* buffer s5-5 pending-load-file)))
(if (and (>= (the-as int v1-90) (the-as int (-> this heap base)))
(< (the-as int v1-90) (the-as int (-> this heap top-base)))
)
(set-pending-file (-> *art-control* buffer s5-5) (the-as string #f) -1 (the-as handle #f) 100000000.0)
)
)
)
(let ((v1-100 (-> *game-info* sub-task-list)))
(dotimes (a0-59 (-> v1-100 length))
(when (nonzero? a0-59)
(let ((a1-20 (-> v1-100 a0-59)))
(when (and (-> a1-20 info) (= (-> a1-20 info level) (-> this name)))
(countdown (a2-6 7)
(set! (-> a1-20 info hooks a2-6) #f)
)
)
)
)
)
)
(let ((v1-103 0)
(a0-60 0)
(a1-23 (the-as basic (-> this level-type)))
)
(while a1-23
(+! a0-60 1)
(+! v1-103 (-> (the-as type a1-23) psize))
(set! (-> (the-as type a1-23) symbol value) (the-as object 0))
(set! a1-23 (-> (the-as type a1-23) method-table 8))
)
)
(let* ((s5-6 (-> this info packages))
(a0-61 (car s5-6))
)
(while (not (null? s5-6))
(case (rtype-of a0-61)
((symbol)
(unload (symbol->string (the-as symbol a0-61)))
)
((string)
(unload (the-as string a0-61))
)
)
(set! s5-6 (cdr s5-6))
(set! a0-61 (car s5-6))
)
)
(vis-clear this)
(let ((v1-120 (-> this heap)))
(set! (-> v1-120 current) (-> v1-120 base))
)
(set! (-> this memory-mask) (the-as uint 0))
(set! (-> this code-memory-start) (the-as pointer 0))
(set! (-> this code-memory-end) (the-as pointer 0))
(set! (-> this level-type) #f)
(when (= (-> *level* loading-level) this)
(set! loading-level global)
(set! (-> *level* loading-level) (-> *level* default-level))
(set! (-> *level* log-in-level-bsp) #f)
(set! *level-type-list* (the-as type 0))
0
)
(assign-draw-indices *level*)
)
this
)
;; definition for method 10 of type level
;; ERROR: Unsupported inline assembly instruction kind - [addiu a0, a0, 56]
(defmethod is-object-visible? ((this level) (arg0 int))
(local-vars (a0-1 int) (a0-3 int))
(let ((v1-0 (-> this vis-bits)))
(shift-arith-right-32 a0-1 arg0 3)
(let ((v1-2 (-> (the-as (pointer int8) (+ a0-1 (the-as int v1-0))))))
(let ((a0-2 (logand arg0 7)))
(.addiu a0-3 a0-2 56)
)
(< (shl v1-2 a0-3) 0)
)
)
)
;; definition for method 15 of type level
(defmethod inside-boxes-check ((this level) (arg0 vector))
(cond
((not (-> this bsp))
#f
)
((-> this force-inside?)
#t
)
(else
(zero? (-> this bsp cam-outside-bsp))
)
)
)
;; definition for method 20 of type level
;; WARN: Return type mismatch int vs none.
(defmethod debug-print-region-splitbox ((this level) (arg0 vector) (arg1 object))
(cond
((or (not (-> this bsp)) (zero? (-> this bsp region-tree)))
)
((nonzero? (-> this bsp region-tree))
(debug-print (-> this bsp region-tree) arg0 arg1)
)
)
0
(none)
)
;; definition for method 8 of type level
(defmethod mem-usage ((this level) (usage memory-usage-block) (flags int))
(when (= (-> this status) 'active)
(set! (-> usage length) (max 67 (-> usage length)))
(set! (-> usage data 66 name) "entity-links")
(+! (-> usage data 66 count) (-> this entity length))
(let ((v1-8 (asize-of (-> this entity))))
(+! (-> usage data 66 used) v1-8)
(+! (-> usage data 66 total) (logand -16 (+ v1-8 15)))
)
(mem-usage (-> this art-group) usage flags)
(set! (-> usage length) (max 66 (-> usage length)))
(set! (-> usage data 65 name) "level-code")
(+! (-> usage data 65 count) 1)
(let ((v1-20 (&- (-> this code-memory-end) (the-as uint (-> this code-memory-start)))))
(+! (-> usage data 65 used) v1-20)
(+! (-> usage data 65 total) (logand -16 (+ v1-20 15)))
)
(countdown (s3-0 (-> this loaded-texture-page-count))
(mem-usage (-> this loaded-texture-page s3-0) usage flags)
)
(countdown (s3-1 (-> this loaded-text-info-count))
(mem-usage (-> this loaded-text-info s3-1) usage flags)
)
(countdown (s3-2 8)
(let ((s2-0 (-> this vis-info s3-2)))
(when s2-0
(cond
((zero? s3-2)
(set! (-> usage length) (max 62 (-> usage length)))
(set! (-> usage data 61 name) "bsp-leaf-vis-self")
(+! (-> usage data 61 count) 1)
(let ((v1-47 (+ (asize-of s2-0) (-> s2-0 allocated-length))))
(+! (-> usage data 61 used) v1-47)
(+! (-> usage data 61 total) (logand -16 (+ v1-47 15)))
)
)
(else
(set! (-> usage length) (max 63 (-> usage length)))
(set! (-> usage data 62 name) "bsp-leaf-vis-adj")
(+! (-> usage data 62 count) 1)
(let ((v1-58 (+ (asize-of s2-0) (-> s2-0 allocated-length))))
(+! (-> usage data 62 used) v1-58)
(+! (-> usage data 62 total) (logand -16 (+ v1-58 15)))
)
)
)
)
)
)
(mem-usage (-> this bsp) usage flags)
)
this
)
;; definition for method 21 of type level-group
;; WARN: Return type mismatch int vs none.
(defmethod alloc-levels-if-needed ((this level-group) (arg0 symbol))
(when (zero? (-> *level* heap base))
(kmemopen global "level-heaps")
(when (nmember "game" *kernel-packages*)
(set! *kernel-packages* (cons "art" *kernel-packages*))
(set! *kernel-packages* (cons "common" *kernel-packages*))
)
(load-package "art" global)
(if arg0
(load-package "common" global)
)
(let ((s5-1 (if (and arg0 (not *debug-segment*))
#x11f7000
#x1af2800
)
)
(gp-1 (-> this heap))
)
(set! (-> gp-1 base) (kmalloc global s5-1 (kmalloc-flags) "heap"))
(set! (-> gp-1 current) (-> gp-1 base))
(set! (-> gp-1 top-base) (&+ (-> gp-1 base) s5-1))
(set! (-> gp-1 top) (-> gp-1 top-base))
)
(kmemclose)
)
0
(none)
)
;; definition for method 10 of type level-group
(defmethod level-get-with-status ((this level-group) (arg0 symbol))
(dotimes (v1-0 (-> this length))
(if (= (-> this level v1-0 status) arg0)
(return (-> this level v1-0))
)
)
(the-as level #f)
)
;; definition for method 30 of type level-group
(defmethod level-get-most-disposable ((this level-group))
(dotimes (v1-0 (-> this length))
(case (-> this level v1-0 status)
(('inactive)
(return (-> this level v1-0))
)
)
)
(dotimes (v1-6 (-> this length))
(case (-> this level v1-6 status)
(('loading 'loading-bt)
(return (-> this level v1-6))
)
)
)
(dotimes (v1-12 (-> this length))
(case (-> this level v1-12 status)
(('loaded)
(return (-> this level v1-12))
)
)
)
(let ((v0-0 (the-as level #f)))
(dotimes (v1-18 (-> this length))
(case (-> this level v1-18 status)
(('active)
(if (and (not (-> this level v1-18 inside-boxes))
(or (not v0-0) (< (-> this level v1-18 info priority) (-> v0-0 info priority)))
)
(set! v0-0 (-> this level v1-18))
)
)
)
)
v0-0
)
)
;; definition for method 9 of type level-group
(defmethod level-get ((this level-group) (arg0 symbol))
(dotimes (v1-0 (-> this length))
(if (and (!= (-> this level v1-0 status) 'inactive)
(or (= (-> this level v1-0 name) arg0) (= (-> this level v1-0 load-name) arg0))
)
(return (-> this level v1-0))
)
)
(the-as level #f)
)
;; definition for method 23 of type level-group
(defmethod art-group-get-by-name ((this level-group) (arg0 string) (arg1 (pointer uint32)))
(countdown (s4-0 7)
(let ((s3-0 (-> *level* level s4-0)))
(when (or (= (-> s3-0 status) 'active) (= (-> s3-0 status) 'reserved))
(countdown (s2-0 (-> s3-0 art-group art-group-array length))
(when (name= (-> s3-0 art-group art-group-array s2-0 name) arg0)
(if arg1
(set! (-> arg1 0) (the-as uint s3-0))
)
(return (-> s3-0 art-group art-group-array s2-0))
)
)
)
)
)
(the-as art-group #f)
)
;; definition for method 13 of type level-group
(defmethod activate-levels! ((this level-group))
(dotimes (s5-0 (-> this length))
(level-status-update! (-> this level s5-0) 'active)
)
0
)
;; definition for method 20 of type level-group
(defmethod level-get-target-inside ((this level-group))
(let ((s5-0 (target-pos 0)))
(let ((v1-1 (-> *load-state* vis-nick)))
(when v1-1
(dotimes (a0-3 (-> this length))
(let ((a1-3 (-> this level a0-3)))
(when (= (-> a1-3 status) 'active)
(if (= (-> a1-3 name) v1-1)
(return a1-3)
)
)
)
)
)
)
(let ((v1-5 (-> *game-info* current-continue level)))
(dotimes (a0-5 (-> this length))
(let ((a1-8 (-> this level a0-5)))
(when (= (-> a1-8 status) 'active)
(if (= (-> a1-8 name) v1-5)
(return a1-8)
)
)
)
)
)
(let ((s4-0 (the-as level #f)))
(let ((f30-0 0.0))
(dotimes (s3-0 (-> this length))
(let ((s2-0 (-> this level s3-0)))
(when (= (-> s2-0 status) 'active)
(let ((f0-0 (vector-vector-distance (-> s2-0 bsp bsphere) s5-0)))
(if (and (-> s2-0 inside-boxes) (or (not s4-0) (< f0-0 f30-0)))
(set! s4-0 s2-0)
)
)
)
)
)
)
(if s4-0
(return s4-0)
)
)
)
(dotimes (v1-23 (-> this length))
(let ((a0-11 (-> this level v1-23)))
(when (= (-> a0-11 status) 'active)
(if (-> a0-11 meta-inside?)
(return a0-11)
)
)
)
)
(let ((v0-1 (the-as level #f)))
0.0
(dotimes (v1-26 (-> this length))
(let ((a0-16 (-> this level v1-26)))
(when (= (-> a0-16 status) 'active)
(if (not v0-1)
(set! v0-1 a0-16)
)
)
)
)
v0-1
)
)
;; definition for method 22 of type level-group
;; WARN: Return type mismatch int vs none.
(defmethod load-commands-set! ((this level-group) (arg0 pair))
(set! (-> this load-commands) arg0)
0
(none)
)
;; definition for method 8 of type level-group
(defmethod mem-usage ((this level-group) (usage memory-usage-block) (flags int))
(dotimes (s3-0 (-> this length))
(mem-usage (-> this level s3-0) usage flags)
)
this
)
;; definition for function bg
;; WARN: Return type mismatch int vs none.
;; WARN: Using new Jak 2 rtype-of
(defun bg ((arg0 symbol))
(set! *cheat-mode* (if *debug-segment*
'debug
#f
)
)
(let ((v1-2 (lookup-level-info arg0)))
(cond
((= (-> v1-2 visname) arg0)
(set! (-> *level* vis?) #t)
(set! arg0 (-> v1-2 name))
)
(else
(set! (-> *level* vis?) #f)
(set! (-> *kernel-context* low-memory-message) #f)
)
)
(case (-> v1-2 memory-mode)
(((load-buffer-mode borrow))
(set! (-> v1-2 memory-mode) (load-buffer-mode small-edge))
0
)
)
(let* ((s5-0 (-> v1-2 run-packages))
(a0-11 (car s5-0))
)
(while (not (null? s5-0))
(case (rtype-of a0-11)
((symbol)
(load-package (symbol->string (the-as symbol a0-11)) global)
)
((string)
(load-package (the-as string a0-11) global)
)
)
(set! s5-0 (cdr s5-0))
(set! a0-11 (car s5-0))
)
)
)
(let ((gp-1 (level-get-for-use *level* arg0 '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)
)
(reset! *load-state*)
(set! (-> *load-state* vis-nick) (-> gp-1 name))
(set! (-> *load-state* want 0 name) (-> gp-1 name))
(set! (-> *load-state* want 0 display?) 'display)
(if (-> gp-1 info continues)
(set-continue! *game-info* (the-as basic (car (-> gp-1 info continues))) #f)
)
)
(dotimes (v1-37 3)
(set! (-> *load-state* want-sound v1-37) (-> *game-info* current-continue want-sound v1-37))
)
(add-borrow-levels *load-state*)
(activate-levels! *level*)
(set! *print-login* #f)
(set! (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
0
(none)
)
;; definition for function play
(defun play ((arg0 symbol) (arg1 symbol))
(kmemopen global "level-boot")
(when *kernel-boot-level*
(bg *kernel-boot-level*)
(on #f)
(kmemclose)
(kmemclose)
(return 0)
)
(let* ((v1-3 *kernel-boot-message*)
(s5-0 (cond
((or (= v1-3 'demo) (= v1-3 'demo-shared))
'demo
)
(*debug-segment*
'prison
)
(else
'title
)
)
)
)
(stop 'play)
(set! (-> *level* vis?) arg0)
(set! (-> *level* want-level) #f)
(set! (-> *level* border?) #t)
(set! (-> *setting-control* user-default border-mode) #t)
(set! (-> *level* play?) #t)
(alloc-levels-if-needed *level* #t)
(set! *display-profile* #f)
(set! *cheat-mode* (if *debug-segment*
'debug
#f
)
)
(set! *time-of-day-fast* #f)
(load-commands-set! *level* '())
(send-event (ppointer->process *time-of-day*) 'change 'ratio 1.0)
(send-event (ppointer->process *time-of-day*) 'change 'hour 7)
(send-event (ppointer->process *time-of-day*) 'change 'minutes 0)
(send-event (ppointer->process *time-of-day*) 'change 'seconds 0)
(send-event (ppointer->process *time-of-day*) 'change 'frames 0)
(set! (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
(set! (-> *mood-control* overide-weather-flag) #f)
(set-blackout-frames (seconds 0.02))
(when (not *dproc*)
(reset! *load-state*)
(let ((s4-1 (level-get-for-use *level* s5-0 'active)))
(let ((a1-11 (new 'stack-no-clear 'array 'symbol 10)))
(set! (-> a1-11 5) #f)
(set! (-> a1-11 4) #f)
(set! (-> a1-11 3) #f)
(set! (-> a1-11 2) #f)
(set! (-> a1-11 1) (if (= s5-0 'ctysluma)
'ctywide
)
)
(set! (-> a1-11 0) s5-0)
(want-levels *load-state* a1-11)
)
(want-display-level *load-state* s5-0 'display)
(if (= s5-0 'ctysluma)
(want-display-level *load-state* 'ctywide 'display)
)
(want-vis-level *load-state* s5-0)
(while (and s4-1 (or (= (-> s4-1 status) 'loading) (= (-> s4-1 status) 'loading-bt) (= (-> s4-1 status) 'login)))
(set-blackout-frames (seconds 0.02))
(load-continue s4-1)
)
)
)
(set! *print-login* #f)
(level-status-update! (level-get *level* s5-0) 'active)
)
(on #t)
(if arg1
(initialize! *game-info* 'game (the-as game-save #f) (the-as string #f))
)
(kmemclose)
(kmemclose)
0
)
;; definition for function play-boot
;; WARN: Return type mismatch int vs none.
(defun play-boot ()
(process-spawn-function
process
(lambda () (play #t #t) (none))
:from *4k-dead-pool*
:stack *kernel-dram-stack*
)
0
(none)
)
;; definition for function update-sound-banks
(defun update-sound-banks ()
(local-vars (v1-21 level-load-info) (v1-28 level-load-info) (a0-24 symbol))
(if (or (nonzero? (rpc-busy? 1))
(nonzero? (rpc-busy? 3))
(load-in-progress? *level*)
(not (-> *setting-control* user-current sound-bank-load))
)
(return 0)
)
(let ((gp-0 (new 'static 'boxed-array :type symbol :length 0 :allocated-length 3)))
(set! (-> gp-0 length) 3)
(dotimes (s5-0 3)
(let ((s4-0 (the-as object (-> *load-state* want-sound s5-0))))
(let ((v1-13 (and (not (null? (-> *setting-control* user-current extra-bank)))
(-> *setting-control* user-current extra-bank)
)
)
)
(when v1-13
(let ((a0-7 (car v1-13)))
(while (not (null? v1-13))
(cond
((and (= s5-0 2) (= (car a0-7) 'force2))
(set! s4-0 (car (cdr a0-7)))
)
((= (car a0-7) s4-0)
(set! s4-0 (car (cdr a0-7)))
)
)
(set! v1-13 (cdr v1-13))
(set! a0-7 (car (the-as pair v1-13)))
)
)
)
)
(let ((v1-19 (and (-> ctywide borrow-level 0)
(begin (set! v1-21 (lookup-level-info (-> ctywide borrow-level 0))) v1-21)
(-> v1-21 extra-sound-bank)
)
)
)
(when v1-19
(let ((a0-14 (car v1-19)))
(while (not (null? v1-19))
(if (= (car a0-14) s4-0)
(set! s4-0 (car (cdr a0-14)))
)
(set! v1-19 (cdr v1-19))
(set! a0-14 (car (the-as pair v1-19)))
)
)
)
)
(let ((v1-26 (and (-> ctywide borrow-level 1)
(begin (set! v1-28 (lookup-level-info (-> ctywide borrow-level 1))) v1-28)
(-> v1-28 extra-sound-bank)
)
)
)
(when v1-26
(let ((a0-19 (car v1-26)))
(while (not (null? v1-26))
(if (= (car a0-19) s4-0)
(set! s4-0 (car (cdr a0-19)))
)
(set! v1-26 (cdr v1-26))
(set! a0-19 (car (the-as pair v1-26)))
)
)
)
)
(set! (-> gp-0 s5-0) (the-as symbol s4-0))
)
)
(dotimes (v1-35 3)
(let ((s5-1 (-> gp-0 v1-35)))
(set! a0-24 (and s5-1 (begin
(dotimes (a0-25 3)
(when (= s5-1 (-> *level* sound-bank a0-25))
(set! a0-24 #f)
(goto cfg-63)
)
)
#t
)
)
)
(label cfg-63)
(when a0-24
(let ((s4-1 -1))
(dotimes (a0-28 3)
(when (not (-> *level* sound-bank a0-28))
(set! s4-1 a0-28)
(goto cfg-81)
)
)
(dotimes (s3-0 3)
(countdown (a0-32 3)
(if (= (-> gp-0 a0-32) (-> *level* sound-bank s3-0))
(goto cfg-78)
)
)
(format 0 "Unload soundbank ~A from slot ~D (want ~A)~%" (-> *level* sound-bank s3-0) s3-0 gp-0)
(sound-bank-unload (string->sound-name (symbol->string (-> *level* sound-bank s3-0))))
(set! (-> *level* sound-bank s3-0) #f)
(return 0)
(label cfg-78)
)
(label cfg-81)
(when (>= s4-1 0)
(format 0 "Load soundbank ~A in slot ~D (want ~A)~%" s5-1 s4-1 gp-0)
(sound-bank-load (string->sound-name (symbol->string s5-1)))
(set! (-> *level* sound-bank s4-1) (the-as basic s5-1))
(return 0)
)
)
)
)
)
)
0
)
;; definition for method 10 of type load-state
(defmethod update! ((this load-state))
(local-vars (all-levels-inactive symbol))
(let ((discarded-level #f))
(let ((most-recent-load-order 0))
-1
(countdown (unload-attempt 6)
(let ((unload-idx -1))
(countdown (unload-candidate-idx 6)
(let ((unload-candidate-lev (-> *level* level unload-candidate-idx)))
(when (and (!= (-> unload-candidate-lev status) 'inactive)
(>= (the-as uint (-> unload-candidate-lev load-order)) (the-as uint most-recent-load-order))
)
(let ((still-wanted #f))
(dotimes (t0-2 6)
(if (= (-> unload-candidate-lev name) (-> this want t0-2 name))
(set! still-wanted #t)
)
)
(when (not still-wanted)
(set! most-recent-load-order (-> unload-candidate-lev load-order))
(set! unload-idx unload-candidate-idx)
)
)
)
)
)
(when (>= unload-idx 0)
(let ((lev-to-unload (-> *level* level unload-idx)))
(format 0 "Discarding level ~A~%" (-> lev-to-unload name))
(level-status-update! lev-to-unload 'inactive)
)
(set! discarded-level #t)
)
)
)
)
(let ((no-levels-at-all #f))
(countdown (a0-9 6)
(when (!= (-> *level* level a0-9 status) 'inactive)
(set! all-levels-inactive #f)
(goto cfg-23)
)
)
(set! all-levels-inactive #t)
(label cfg-23)
(if all-levels-inactive
(set! no-levels-at-all #t)
)
(if discarded-level
(return 0)
)
(let ((desired-levels (new 'static 'boxed-array :type symbol :length 0 :allocated-length 6)))
(countdown (a0-14 6)
(set! (-> desired-levels a0-14) #f)
)
(dotimes (want-lev-idx 6)
(when (-> this want want-lev-idx name)
(set! (-> desired-levels want-lev-idx) (-> this want want-lev-idx name))
(dotimes (a1-17 6)
(let ((a2-13 (-> *level* level a1-17)))
(if (and (!= (-> a2-13 status) 'inactive) (= (-> a2-13 name) (-> this want want-lev-idx name)))
(set! (-> desired-levels want-lev-idx) #f)
)
)
)
)
)
(let ((want-lev-idx-to-load -1))
(dotimes (a0-20 6)
(when (-> desired-levels a0-20)
(set! want-lev-idx-to-load a0-20)
(goto cfg-51)
)
)
(label cfg-51)
(when (!= want-lev-idx-to-load -1)
(when (and (or no-levels-at-all (not (check-busy *load-dgo-rpc*))) (not (load-in-progress? *level*)))
(format 0 "Adding level ~A~%" (-> this want want-lev-idx-to-load name))
(let ((new-lev (level-get-for-use *level* (-> this want want-lev-idx-to-load name) 'loaded)))
(when (and no-levels-at-all (-> this want want-lev-idx-to-load display?))
(format 0 "Waiting for level to load~%")
(while (or (= (-> new-lev status) 'loading) (= (-> new-lev status) 'loading-bt) (= (-> new-lev status) 'login))
(load-continue new-lev)
)
)
)
)
)
)
)
)
)
(dotimes (want-lev-i 6)
(when (-> this want want-lev-i name)
(dotimes (lev-i 7)
(let ((lev (-> *level* level lev-i)))
(when (!= (-> lev status) 'inactive)
(when (= (-> lev name) (-> this want want-lev-i name))
(when (!= (-> lev display?) (-> this want want-lev-i display?))
(cond
((not (-> lev display?))
(cond
((or (= (-> lev status) 'loaded) (= (-> lev status) 'active))
(format 0 "Displaying level ~A [~A]~%" (-> this want want-lev-i name) (-> this want want-lev-i display?))
(level-get-for-use *level* (-> lev info name) 'active)
(set! (-> lev display?) (-> this want want-lev-i display?))
)
(else
(if (and (-> lev info wait-for-load) (!= (-> this want want-lev-i display?) 'display-no-wait))
(send-event *target* 'loading)
)
(if (= *cheat-mode* 'debug)
(format *stdcon* "display on for ~A but level is loading~%" (-> this want want-lev-i name))
)
)
)
)
((not (-> this want want-lev-i display?))
(set! (-> lev display?) #f)
(format 0 "Turning level ~A off~%" (-> lev name))
(deactivate lev)
)
(else
(format
0
"Setting level ~A display command to ~A~%"
(-> this want want-lev-i name)
(-> this want want-lev-i display?)
)
(set! (-> lev display?) (-> this want want-lev-i display?))
)
)
)
(when (!= (-> lev force-all-visible?) (-> this want want-lev-i force-vis?))
(set! (-> lev force-all-visible?) (-> this want want-lev-i force-vis?))
(format
0
"Setting force-all-visible?[~A] to ~A~%"
(-> this want want-lev-i name)
(-> this want want-lev-i force-vis?)
)
)
(when (!= (-> lev force-inside?) (-> this want want-lev-i force-inside?))
(format
0
"Setting force-inside?[~A] ~A->~A~%"
(-> this want want-lev-i name)
(-> lev force-inside?)
(-> this want want-lev-i force-inside?)
)
(set! (-> lev force-inside?) (-> this want want-lev-i force-inside?))
)
)
)
)
)
)
)
(let ((lev-for-vis (the-as level #f))
(num-vis-levs 0)
)
(dotimes (a1-35 (-> *level* length))
(let ((a2-32 (-> *level* level a1-35)))
(when (= (-> a2-32 status) 'active)
(when (and (-> a2-32 inside-boxes) (not (null? (-> a2-32 info continues))))
(if (= (-> a2-32 name) (-> this vis-nick))
(goto cfg-125)
)
(set! lev-for-vis a2-32)
(+! num-vis-levs 1)
)
)
)
)
(if (and (>= num-vis-levs 1) (!= (-> lev-for-vis name) (-> this vis-nick)))
(want-vis-level this (-> lev-for-vis name))
)
)
(label cfg-125)
(update-sound-banks)
0
)
;; definition for method 16 of type level-group
;; WARN: Return type mismatch int vs none.
(defmethod assign-draw-indices ((this level-group))
(local-vars (t0-3 symbol))
(set! (-> this draw-level-count) 0)
(dotimes (v1-0 7)
(let ((f0-0 100000.0)
(a1-1 (the-as level #f))
)
(dotimes (a2-0 (-> this length))
(let ((a3-3 (-> this level a2-0)))
(when (= (-> a3-3 status) 'active)
(set! t0-3 (and (< (-> a3-3 draw-priority) f0-0) (begin
(dotimes (t0-4 (-> this draw-level-count))
(when (= a3-3 (-> this draw-level t0-4))
(set! t0-3 #f)
(goto cfg-14)
)
)
#t
)
)
)
(label cfg-14)
(when t0-3
(set! a1-1 a3-3)
(set! f0-0 (-> a1-1 draw-priority))
)
)
)
)
(when a1-1
(set! (-> this draw-level (-> this draw-level-count)) a1-1)
(set! (-> a1-1 draw-index) (-> this draw-level-count))
(+! (-> this draw-level-count) 1)
)
)
)
(while (< (-> this draw-level-count) 7)
(set! (-> this draw-level (-> this draw-level-count)) #f)
(+! (-> this draw-level-count) 1)
)
(set! (-> this draw-level 6) (-> this default-level))
(set! (-> (&-> this default-level draw-index) 0) 6)
(dotimes (v1-12 7)
(let ((a2-9 (-> this level v1-12)))
(if a2-9
(set! (-> this draw-index-map v1-12) (the-as uint (-> a2-9 draw-index)))
)
)
)
0
(none)
)
;; definition for method 19 of type level-group
;; WARN: Return type mismatch int vs none.
(defmethod level-update ((this level-group))
(local-vars (v1-101 symbol))
(camera-pos)
(new 'static 'boxed-array :type symbol :length 0 :allocated-length 6)
(update *setting-control*)
(update *gui-control* #t)
(update *art-control* #t)
(clear-rec *art-control*)
(dotimes (s5-0 6)
(load-continue (-> this level s5-0))
)
(dotimes (s5-1 (-> this length))
(let ((s4-0 (-> this level s5-1)))
(when (= (-> s4-0 status) 'active)
(set! (-> s4-0 inside-boxes) (inside-boxes-check s4-0 (-> *math-camera* trans)))
(if (-> s4-0 inside-boxes)
(set! (-> s4-0 meta-inside?) #t)
)
)
)
)
(update! *load-state*)
(dotimes (s5-2 (-> this length))
(let ((s4-1 (-> this level s5-2)))
(when (= (-> s4-1 status) 'active)
(when (-> s4-1 inside-boxes)
(dotimes (v1-40 (-> this length))
(let ((a0-13 (-> this level v1-40)))
(when (= (-> a0-13 status) 'active)
(if (and (!= s4-1 a0-13) (not (-> a0-13 inside-boxes)))
(set! (-> a0-13 meta-inside?) #f)
)
)
)
)
)
(when (and (null? (-> this load-commands))
(= (-> s4-1 name) (-> *load-state* vis-nick))
(begin
(set! (-> *setting-control* user-default music) (-> s4-1 info music-bank))
(set! (-> *setting-control* user-default sound-reverb) (-> s4-1 info sound-reverb))
#t
)
(or (-> *level* border?) (logtest? (-> *game-info* current-continue flags) (continue-flags change-continue)))
(or (!= (-> s4-1 name) (-> *game-info* current-continue level))
(logtest? (-> *game-info* current-continue flags) (continue-flags change-continue))
)
(not (null? (-> s4-1 info continues)))
(-> *setting-control* user-current allow-continue)
)
(let ((s3-0 (car (-> s4-1 info continues))))
(let* ((s2-0 (target-pos 0))
(s4-2 (-> s4-1 info continues))
(s1-0 (car s4-2))
)
(while (not (null? s4-2))
(when (and (or (< (vector-vector-distance s2-0 (-> (the-as continue-point s1-0) trans))
(vector-vector-distance s2-0 (-> (the-as continue-point s3-0) trans))
)
(string= (-> *game-info* current-continue name) (-> (the-as continue-point s1-0) name))
)
(not (logtest? (-> (the-as continue-point s1-0) flags) (continue-flags change-continue no-auto)))
)
(set! s3-0 (the-as continue-point s1-0))
(if (string= (-> *game-info* current-continue name) (-> (the-as continue-point s1-0) name))
(goto cfg-59)
)
)
(set! s4-2 (cdr s4-2))
(set! s1-0 (car s4-2))
)
)
(label cfg-59)
(if (and (the-as continue-point s3-0)
(not (logtest? (-> (the-as continue-point s3-0) flags) (continue-flags change-continue no-auto)))
)
(set-continue! *game-info* (the-as basic s3-0) #f)
)
)
)
)
)
)
(dotimes (v1-88 (-> this length))
(let ((a0-48 (-> this level v1-88)))
(when (= (-> a0-48 status) 'active)
(set! (-> a0-48 vis-self-index) 0)
0
)
)
)
(when (= *cheat-mode* 'debug)
(dotimes (s5-3 (-> this length))
(let ((v1-96 (-> this level s5-3)))
(when (= (-> v1-96 status) 'active)
(if (and (= (-> v1-96 status) 'active)
(!= (-> v1-96 display?) 'special)
(nonzero? (-> v1-96 bsp cam-outside-bsp))
)
(format *stdcon* "~3Loutside of bsp ~S~%~0L" (-> v1-96 name))
)
)
)
)
)
(countdown (v1-100 6)
(when (-> this level v1-100 inside-boxes)
(set! v1-101 #f)
(goto cfg-90)
)
)
(set! v1-101 #t)
(label cfg-90)
(cond
(v1-101
0
)
(else
(dotimes (s5-4 (-> this length))
(let ((s4-3 (-> this level s5-4)))
(when (= (-> s4-3 status) 'active)
(dotimes (s3-1 8)
(let ((s2-1 (-> s4-3 vis-info s3-1)))
(when s2-1
(set! (-> s2-1 flags) (the-as vis-info-flag (logclear (-> s2-1 flags) (vis-info-flag vis-valid))))
(cond
((= s3-1 (-> s4-3 vis-self-index))
(set! (-> s2-1 from-bsp) (-> s4-3 bsp))
)
(else
(let ((v1-114 (level-get this (-> s2-1 from-level))))
(set! (-> s2-1 from-bsp) (if v1-114
(-> v1-114 bsp)
)
)
)
)
)
)
)
)
(let ((v1-117 #f))
(cond
((= (-> s4-3 display?) 'display-self)
(let ((v1-121 (-> s4-3 vis-info (-> s4-3 vis-self-index))))
(if v1-121
(set! (-> v1-121 flags) (the-as vis-info-flag (logior (vis-info-flag vis-valid) (-> v1-121 flags))))
)
)
)
((and (-> s4-3 inside-boxes) (not v1-117))
(let ((v1-126 (-> s4-3 vis-info (-> s4-3 vis-self-index))))
(if v1-126
(set! (-> v1-126 flags) (the-as vis-info-flag (logior (vis-info-flag vis-valid) (-> v1-126 flags))))
)
)
)
)
)
)
)
)
)
)
(assign-draw-indices this)
(when (or *display-level-border* *display-texture-distances* *display-texture-download* *display-split-box-info*)
(when *display-level-border*
(format
*stdcon*
" want: ~A ~A/~A ~A ~A/~A~%"
(-> *load-state* want 0 name)
(-> *load-state* want 0 display?)
(-> *load-state* want 0 force-vis?)
(-> *load-state* want 1 name)
(-> *load-state* want 1 display?)
(-> *load-state* want 1 force-vis?)
)
(let ((t9-18 format)
(a0-86 *stdcon*)
(a1-30 " nick ~A cur ~S cont ~A~%~%")
(a2-6 (-> *load-state* vis-nick))
(v1-147 (and *target* (-> *target* current-level) (-> *target* current-level name)))
)
(t9-18
a0-86
a1-30
a2-6
(if v1-147
(symbol->string (the-as symbol v1-147))
)
(-> *game-info* current-continue name)
)
)
)
(dotimes (s5-5 7)
(let ((s4-4 (-> this level s5-5)))
(when (or (= (-> s4-4 status) 'active) (= (-> s4-4 status) 'reserved))
(let ((t9-19 format)
(a0-90 *stdcon*)
(a1-31 "~A: ~S ~A~%")
(a2-7 (-> s4-4 name))
(a3-3 (if (-> s4-4 inside-boxes)
"inside"
)
)
)
(t9-19 a0-90 a1-31 a2-7 a3-3 (-> s4-4 display?))
(when *display-texture-distances*
(format *stdcon* "~10Htfrag: ~8,,0m" (-> s4-4 closest-object) (the-as none a3-3))
(format *stdcon* "~140Hshrub: ~8,,0m" (-> s4-4 closest-object-array 2) (the-as none a3-3))
(format *stdcon* "~272Halpha: ~8,,0m~%" (-> s4-4 closest-object-array 3) (the-as none a3-3))
(format *stdcon* "~27Htie: ~8,,0m" (-> s4-4 closest-object-array 10) (the-as none a3-3))
(format *stdcon* "~140Hfg-tf: ~8,,0m" (-> s4-4 closest-object-array 11) (the-as none a3-3))
(format *stdcon* "~270Hfg-pr: ~8,,0m~%" (-> s4-4 closest-object-array 12) (the-as none a3-3))
(format *stdcon* "~10Hfg-wa: ~8,,0m" (-> s4-4 closest-object-array 15) (the-as none a3-3))
(format *stdcon* "~140Hfg-sh: ~8,,0m" (-> s4-4 closest-object-array 13) (the-as none a3-3))
(format *stdcon* "~267Hfg-p2: ~8,,0m~%" (-> s4-4 closest-object-array 17) (the-as none a3-3))
)
)
(when *display-texture-download*
(format
*stdcon*
"~30Htf: ~8D~134Hpr: ~8D~252Hsh: ~8D~370Hhd: ~8D~%"
(-> s4-4 upload-size 0)
(-> s4-4 upload-size 1)
(-> s4-4 upload-size 2)
(-> s4-4 upload-size 8)
)
(let ((t9-30 format)
(a0-101 *stdcon*)
(a1-42 "~30Hal: ~8D~131Hwa: ~8D~252Hsp: ~8D~370Hwp: ~8D~%")
(a2-18 (-> s4-4 upload-size 3))
(a3-5 (-> s4-4 upload-size 4))
)
(t9-30 a0-101 a1-42 a2-18 a3-5 (-> s4-4 upload-size 7) (-> s4-4 upload-size 5))
(format *stdcon* "~30Hp2: ~8D~%~1K" (-> s4-4 upload-size 6) (the-as none a3-5))
)
)
(if *display-split-box-info*
(debug-print-region-splitbox s4-4 (-> *math-camera* trans) *stdcon*)
)
)
)
)
)
(when (and (-> this disk-load-timing?) (-> this load-level))
(let ((s5-6 format)
(s4-5 *stdcon*)
(s3-2 "~0Kload ~16S ~5S ~5DK ~5,,2fs ~5,,2fs~1K ~5,,0f k/s~%")
(s2-2 (-> this load-level))
(v1-180 (lookup-level-info (-> this load-level)))
)
(s5-6
s4-5
s3-2
s2-2
(if v1-180
(-> v1-180 nickname)
""
)
(shr (-> this load-size) 10)
(-> this load-time)
(-> this load-login-time)
(if (= (-> this load-time) 0.0)
0
(* 0.0009765625 (/ (the float (-> this load-size)) (-> this load-time)))
)
)
)
)
(let ((v1-186 (- #x2000000 (the-as int (-> global current)))))
(if (and (not *debug-segment*) (< v1-186 #x10000))
(format *stdcon* "~3Lglobal heap fatally low at ~DK free~%~0L" (sar v1-186 10))
)
)
0
(none)
)
;; definition (debug) for function show-level
(defun-debug show-level ((arg0 symbol))
(set! (-> *setting-control* user-default border-mode) #t)
(let ((s5-0 (new 'stack-no-clear 'array 'symbol 10)))
(set! (-> s5-0 5) #f)
(set! (-> s5-0 4) #f)
(set! (-> s5-0 3) #f)
(set! (-> s5-0 2) #f)
(set! (-> s5-0 1) arg0)
(set! (-> s5-0 0) (-> (level-get-target-inside *level*) name))
(want-levels *load-state* s5-0)
)
(want-display-level *load-state* arg0 'display)
0
)
;; failed to figure out what this is:
(when (zero? (-> *level* level0 art-group))
(kmemopen global "level")
(let ((gp-0 *level*))
(set! (-> gp-0 loading-level) (-> gp-0 default-level))
(dotimes (s5-0 6)
(let ((s4-0 (-> gp-0 level s5-0)))
(set! (-> s4-0 art-group) (new 'global 'load-dir-art-group 100 s4-0))
(set! (-> s4-0 vis-bits) (malloc 'global 2048))
(vis-clear s4-0)
(set! (-> s4-0 tfrag-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 tfrag-dists) (malloc 'global 4))
(set! (-> s4-0 shrub-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 shrub-dists) (malloc 'global 4))
(set! (-> s4-0 alpha-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 alpha-dists) (malloc 'global 4))
(set! (-> s4-0 water-masks) (new 'global 'texture-masks-array 1))
(set! (-> s4-0 water-dists) (malloc 'global 4))
(clear-mood-context (-> s4-0 mood-context))
)
)
(set! (-> gp-0 default-level art-group) (new 'global 'load-dir-art-group 512 (-> gp-0 default-level)))
(dotimes (v1-31 7)
(let ((a0-53 (-> gp-0 level v1-31)))
(dotimes (a1-48 10)
(set! (-> a0-53 texture-anim-array a1-48) #f)
)
)
)
(set! (-> (&-> gp-0 default-level texture-anim-array 9) 0) *sky-texture-anim-array*)
(set! (-> (&-> gp-0 default-level texture-anim-array 1) 0) *darkjak-texture-anim-array*)
(set! (-> (&-> gp-0 default-level texture-anim-array 4) 0) *bomb-texture-anim-array*)
(set! (-> (&-> gp-0 default-level draw-priority) 0) 20.0)
(set! *default-level* (-> gp-0 default-level))
)
(kmemclose)
)