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

1859 lines
63 KiB
Common Lisp
Vendored
Generated

;;-*-Lisp-*-
(in-package goal)
;; definition for symbol *spawn-actors*, type symbol
(define *spawn-actors* #t)
;; definition for symbol *compact-actors*, type symbol
(define *compact-actors* #t)
;; definition for symbol *vis-actors*, type symbol
(define *vis-actors* #t)
;; definition for method 8 of type drawable-actor
;; INFO: Return type mismatch int vs drawable-actor.
(defmethod mem-usage ((this drawable-actor) (usage memory-usage-block) (flags int))
(set! (-> usage length) (max 44 (-> usage length)))
(set! (-> usage data 43 name) "entity")
(+! (-> usage data 43 count) 1)
(let ((v1-6 (asize-of this)))
(+! (-> usage data 43 used) v1-6)
(+! (-> usage data 43 total) (logand -16 (+ v1-6 15)))
)
(mem-usage (-> this actor) usage (logior flags 64))
(the-as drawable-actor 0)
)
;; definition for method 8 of type drawable-inline-array-actor
;; INFO: Return type mismatch int vs drawable-inline-array-actor.
(defmethod mem-usage ((this drawable-inline-array-actor) (usage memory-usage-block) (flags int))
(set! (-> usage length) (max 1 (-> usage length)))
(set! (-> usage data 0 name) (symbol->string 'drawable-group))
(+! (-> usage data 0 count) 1)
(let ((v1-7 32))
(+! (-> usage data 0 used) v1-7)
(+! (-> usage data 0 total) (logand -16 (+ v1-7 15)))
)
(dotimes (s3-0 (-> this length))
(mem-usage (-> this data s3-0) usage flags)
)
(the-as drawable-inline-array-actor 0)
)
;; definition for method 2 of type entity-links
(defmethod print ((this entity-links))
(format #t "#<entity-links :process ~A @ #x~X>" (-> this process) this)
this
)
;; definition for method 2 of type entity-perm
(defmethod print ((this entity-perm))
(format
#t
"#<entity-perm :aid ~D :task ~D :status #x~X :data #x~X @ #x~X>"
(-> this aid)
(-> this task)
(-> this status)
(-> this user-uint64)
this
)
this
)
;; definition for method 22 of type entity
(defmethod birth! ((this entity))
(format #t "birth ~A~%" this)
this
)
;; definition for method 23 of type entity
(defmethod kill! ((this entity))
(format #t "kill ~A~%" this)
this
)
;; definition for method 2 of type entity
(defmethod print ((this entity))
(format #t "#<~A :name ~S @ #x~X>" (-> this type) (res-lump-struct this 'name structure) this)
this
)
;; definition for method 26 of type entity
(defmethod get-level ((this entity))
(dotimes (v1-0 (-> *level* length))
(let ((a1-3 (-> *level* level v1-0)))
(when (= (-> a1-3 status) 'active)
(if (and (>= (the-as int this) (the-as int (-> a1-3 heap base)))
(< (the-as int this) (the-as int (-> a1-3 heap top-base)))
)
(return a1-3)
)
)
)
)
(-> *level* level-default)
)
;; definition for function entity-by-name
(defun entity-by-name ((arg0 string))
(dotimes (s5-0 (-> *level* length))
(let ((s4-0 (-> *level* level s5-0)))
(when (= (-> s4-0 status) 'active)
(let ((s3-0 (-> s4-0 bsp actors)))
(when (nonzero? s3-0)
(dotimes (s2-0 (-> s3-0 length))
(let ((s1-0 (-> s3-0 data s2-0 actor)))
(if (name= (res-lump-struct s1-0 'name basic) arg0)
(return s1-0)
)
)
)
)
)
(let ((s3-1 (-> s4-0 bsp ambients)))
(when (nonzero? s3-1)
(dotimes (s2-1 (-> s3-1 length))
(let ((s1-1 (-> s3-1 data s2-1 ambient)))
(if (name= (res-lump-struct s1-1 'name basic) arg0)
(return s1-1)
)
)
)
)
)
(let ((s4-1 (-> s4-0 bsp cameras)))
(when (nonzero? s4-1)
(dotimes (s3-2 (-> s4-1 length))
(let ((s2-2 (-> s4-1 s3-2)))
(if (name= (res-lump-struct s2-2 'name basic) arg0)
(return s2-2)
)
)
)
)
)
)
)
)
(the-as entity #f)
)
;; definition for function entity-by-type
(defun entity-by-type ((arg0 type))
(dotimes (s5-0 (-> *level* length))
(let ((v1-3 (-> *level* level s5-0)))
(when (= (-> v1-3 status) 'active)
(let ((s4-0 (-> v1-3 bsp actors)))
(when (nonzero? s4-0)
(dotimes (s3-0 (-> s4-0 length))
(let ((s2-0 (-> s4-0 data s3-0 actor)))
(if (and (type-type? (-> s2-0 type) entity-actor) (= (-> s2-0 etype) arg0))
(return s2-0)
)
)
)
)
)
)
)
)
(the-as entity-actor #f)
)
;; definition for function entity-by-aid
(defun entity-by-aid ((arg0 uint))
(dotimes (v1-0 (-> *level* length))
(let ((a1-3 (-> *level* level v1-0)))
(when (= (-> a1-3 status) 'active)
(let ((a1-4 (-> a1-3 entity)))
(when (nonzero? a1-4)
(let ((a2-4 0)
(a3-2 (+ (-> a1-4 length) -1))
)
0
(while (>= a3-2 a2-4)
(let* ((t0-3 (+ a2-4 (/ (- a3-2 a2-4) 2)))
(t1-2 (-> a1-4 data t0-3))
(t2-0 (-> t1-2 perm aid))
)
(cond
((= t2-0 arg0)
(return (-> t1-2 entity))
)
((< (the-as uint t2-0) arg0)
(set! a2-4 (+ t0-3 1))
)
(else
(set! a3-2 (+ t0-3 -1))
)
)
)
)
)
)
)
)
)
)
(the-as entity #f)
)
;; definition for function entity-by-meters
(defun entity-by-meters ((arg0 float) (arg1 float) (arg2 float))
(dotimes (v1-0 (-> *level* length))
(let ((a3-3 (-> *level* level v1-0)))
(when (= (-> a3-3 status) 'active)
(let ((a3-5 (-> a3-3 bsp actors)))
(when (nonzero? a3-5)
(dotimes (t0-4 (-> a3-5 length))
(let* ((t1-3 (-> a3-5 data t0-4 actor))
(t2-1 (-> t1-3 extra trans))
)
(if (and (= (the float (the int (-> t2-1 x))) arg0)
(= (the float (the int (-> t2-1 y))) arg1)
(= (the float (the int (-> t2-1 z))) arg2)
)
(return t1-3)
)
)
)
)
)
)
)
)
(the-as entity-actor #f)
)
;; definition for function process-by-ename
(defun process-by-ename ((arg0 string))
(let ((v1-0 (entity-by-name arg0)))
(if v1-0
(-> v1-0 extra process)
)
)
)
;; definition for function entity-process-count
(defun entity-process-count ((arg0 symbol))
(let ((gp-0 0))
(dotimes (s4-0 (-> *level* length))
(let ((s3-0 (-> *level* level s4-0)))
(when (= (-> s3-0 status) 'active)
(let ((s2-0 (-> s3-0 bsp level entity)))
(dotimes (s1-0 (-> s2-0 length))
(let ((v1-9 (-> s2-0 data s1-0 entity)))
(case arg0
(('vis)
(if (is-object-visible? s3-0 (-> v1-9 extra vis-id))
(+! gp-0 1)
)
)
(else
(if (-> v1-9 extra process)
(+! gp-0 1)
)
)
)
)
)
)
)
)
)
gp-0
)
)
;; definition for function entity-count
(defun entity-count ()
(let ((v0-0 0))
(dotimes (v1-0 (-> *level* length))
(let ((a0-3 (-> *level* level v1-0)))
(when (= (-> a0-3 status) 'active)
(let ((a0-6 (-> a0-3 bsp level entity)))
(dotimes (a1-3 (-> a0-6 length))
(-> a0-6 data a1-3 entity)
(+! v0-0 1)
)
)
)
)
)
v0-0
)
)
;; definition for function entity-remap-names
;; INFO: Return type mismatch int vs none.
(defun entity-remap-names ((arg0 pair))
(let ((s5-0 (car arg0)))
(while (not (null? arg0))
(let ((a0-2 (entity-by-meters
(the float (/ (the-as int (car (cdr s5-0))) 8))
(the float (/ (the-as int (car (cdr (cdr s5-0)))) 8))
(the float (/ (the-as int (car (cdr (cdr (cdr s5-0))))) 8))
)
)
)
(if a0-2
(add-data!
a0-2
(new 'static 'res-tag :name 'name :key-frame -1000000000.0 :elt-count #x1 :elt-type string)
(the-as pointer (car s5-0))
)
)
)
(set! arg0 (cdr arg0))
(set! s5-0 (car arg0))
)
)
0
(none)
)
;; definition (debug) for function process-status-bits
;; INFO: Return type mismatch int vs none.
(defun-debug process-status-bits ((arg0 process) (arg1 symbol))
(let* ((s5-0 arg0)
(proc-draw (the-as process-drawable (if (and (nonzero? s5-0) (type-type? (-> s5-0 type) process-drawable))
(the-as process-drawable s5-0)
)
)
)
)
(if (and (the-as process proc-draw) (zero? (-> proc-draw draw)))
(set! proc-draw (the-as process-drawable #f))
)
(let ((s5-1 format)
(s4-0 "~C~C~C")
(a2-0 (if (and arg0 (not (logtest? (-> *kernel-context* prevent-from-run) (-> arg0 mask))) (run-logic? arg0))
114
32
)
)
(a3-0 (if (and proc-draw (logtest? (-> proc-draw draw status) (draw-status was-drawn)))
100
32
)
)
(t0-0 (cond
((and proc-draw (logtest? (-> proc-draw draw status) (draw-status was-drawn)))
(let ((v1-15 (-> proc-draw draw cur-lod)))
(cond
((zero? v1-15)
48
)
((= v1-15 1)
49
)
((= v1-15 2)
50
)
((= v1-15 3)
51
)
((= v1-15 4)
52
)
)
)
)
(else
32
)
)
)
)
(s5-1 arg1 s4-0 a2-0 a3-0 t0-0)
)
)
0
(none)
)
;; definition for method 2 of type process
(defmethod print ((this process))
(format
#t
"#<~A ~S ~A :state ~S :flags "
(-> this type)
(-> this name)
(-> this status)
(if (-> this state)
(-> this state name)
)
)
(process-status-bits this #t)
(format
#t
" :stack ~D/~D :heap ~D/~D @ #x~X>"
(&- (-> this top-thread stack-top) (the-as uint (-> this top-thread sp)))
(-> this main-thread stack-size)
(- (-> this allocated-length) (&- (-> this heap-top) (the-as uint (-> this heap-cur))))
(-> this allocated-length)
this
)
this
)
;; definition for method 3 of type entity
(defmethod inspect ((this entity))
((the-as (function entity entity) (find-parent-method entity 3)) this)
(format #t "~Ttrans: ~`vector`P~%" (-> this trans))
(format #t "~Taid: ~A~%" (-> this aid))
this
)
;; definition for method 3 of type entity-actor
(defmethod inspect ((this entity-actor))
((the-as (function entity-actor entity-actor) (find-parent-method entity-actor 3)) this)
(format #t "~Tnav-mesh: ~A~%" (-> this nav-mesh))
(format #t "~Tetype: ~A~%" (-> this etype))
(format #t "~Ttask: ~d~%" (-> this task))
(format #t "~Tvis-id: ~d~%" (-> this vis-id-signed))
(format #t "~Tquat: ~`vector`P~%" (-> this quat))
this
)
;; definition for method 29 of type entity-actor
;; INFO: Return type mismatch entity-actor vs none.
(defmethod debug-print ((this entity-actor) (mode symbol) (expected-type type))
(let ((s4-0 (-> this etype)))
(when (or (not expected-type) (and s4-0 (valid? s4-0 type #f #f 0) (type-type? s4-0 expected-type)))
(format #t "~5D #x~8X ~-21S" (-> this extra vis-id) this (res-lump-struct this 'name structure))
(let ((t9-4 format)
(a0-5 #t)
(a1-5 "~8D ~3D ~-4S #x~4X")
(a2-4 (-> this extra perm aid))
(a3-3 (-> this extra perm task))
(t0-3 (-> this extra level nickname))
)
(set! t0-3 (cond
(t0-3
(empty)
t0-3
)
(else
(-> this extra level name)
)
)
)
(t9-4 a0-5 a1-5 a2-4 a3-3 t0-3 (-> this extra perm status))
)
(if (= mode 'entity-meters)
(format #t " :trans ~14m ~14m ~14m " (-> this extra trans x) (-> this extra trans y) (-> this extra trans z))
(format #t " :trans ~14f ~14f ~14f " (-> this extra trans x) (-> this extra trans y) (-> this extra trans z))
)
(let* ((s3-2 (-> this extra process))
(s4-2 (if (and (nonzero? s3-2) (type-type? (-> s3-2 type) process-drawable))
s3-2
)
)
)
(format
#t
":pr #x~8X ~-12S ~-21S ~-5S/~-5S "
(if (-> this extra process)
(-> this extra process)
0
)
(if (-> this extra process)
(-> this extra process name)
""
)
(if (and (-> this extra process) (-> this extra process state))
(-> this extra process state name)
""
)
(if (-> this extra process)
(* (- (-> this extra process allocated-length)
(&- (-> this extra process heap-top) (the-as uint (-> this extra process heap-cur)))
)
8
)
""
)
(if (-> this extra process)
(* (-> this extra process allocated-length) 8)
""
)
)
(process-status-bits s4-2 #t)
)
(format #t "~%")
(if (= mode 'entity-perm)
(format #t " ~`entity-perm`P~%" (-> this extra perm))
)
)
)
(none)
)
;; definition for method 13 of type level-group
;; INFO: Return type mismatch int vs none.
(defmethod debug-print-entities ((this level-group) (mode symbol) (expected-type type))
(format
#t
" id address name aid tsk lev status x y z address name state heap flags~%"
0
0
0
)
(dotimes (s3-0 (-> this length))
(let ((s2-0 (-> this level s3-0)))
(when (= (-> s2-0 status) 'active)
(case mode
(('art-group)
(format #t "level ~A~%" (-> s2-0 name))
(dotimes (s1-0 (-> s2-0 art-group art-group-array length))
(format #t "~T~2D ~S~%" s1-0 (-> s2-0 art-group art-group-array s1-0 name))
)
)
(else
(let ((s2-1 (-> s2-0 bsp level entity)))
(dotimes (s1-1 (-> s2-1 length))
(debug-print (the-as entity-actor (-> s2-1 data s1-1 entity)) mode expected-type)
)
)
)
)
)
)
)
0
(none)
)
;; definition for method 24 of type entity
;; INFO: Used lq/sq
;; INFO: Return type mismatch entity vs none.
(defmethod add-to-level! ((this entity) (lev-group level-group) (lev level) (aid actor-id))
(let ((level-link (-> lev entity data (-> lev entity length))))
(+! (-> lev entity length) 1)
(set! (-> level-link process) #f)
(set! (-> level-link entity) this)
(set! (-> this extra) level-link)
(cond
((-> lev-group entity-link)
(let* ((other-prev (-> lev-group entity-link))
(other-front (-> other-prev next-link))
)
(set! (-> other-prev next-link) level-link)
(set! (-> level-link prev-link) other-prev)
(set! (-> level-link next-link) other-front)
(set! (-> other-front prev-link) level-link)
)
)
(else
(set! (-> level-link prev-link) level-link)
(set! (-> level-link next-link) level-link)
)
)
(set! (-> lev-group entity-link) level-link)
(set! (-> level-link trans quad) (-> this trans quad))
)
(set! (-> this extra perm aid) aid)
(set! (-> this extra level) lev)
(cond
((= (-> this type) entity-actor)
(set! (-> (the-as entity-actor this) extra perm task) (-> (the-as entity-actor this) task))
(set! (-> (the-as entity-actor this) extra vis-id) (-> (the-as entity-actor this) vis-id-signed))
)
(else
(set! (-> this extra perm task) (game-task none))
(set! (-> this extra vis-id) 0)
0
)
)
(none)
)
;; definition for method 25 of type entity
(defmethod remove-from-level! ((this entity) (arg0 level-group))
(let ((v1-0 (-> this extra)))
(cond
((= (-> v1-0 next-link) v1-0)
(set! (-> arg0 entity-link) #f)
)
(else
(set! (-> v1-0 next-link prev-link) (-> v1-0 prev-link))
(set! (-> v1-0 prev-link next-link) (-> v1-0 next-link))
(if (= (-> arg0 entity-link) v1-0)
(set! (-> arg0 entity-link) (-> v1-0 prev-link))
)
)
)
)
this
)
;; definition for function update-actor-vis-box
;; INFO: Return type mismatch int vs none.
(defun update-actor-vis-box ((proc process-drawable) (min-pt vector) (max-pt vector))
(when (and proc (nonzero? (-> proc draw)))
(let ((world-bounds-origin (vector+! (new 'stack-no-clear 'vector) (-> proc draw origin) (-> proc draw bounds)))
(radius (-> proc draw bounds w))
)
(set! (-> min-pt x) (fmin (-> min-pt x) (- (-> world-bounds-origin x) radius)))
(set! (-> min-pt y) (fmin (-> min-pt y) (- (-> world-bounds-origin y) radius)))
(set! (-> min-pt z) (fmin (-> min-pt z) (- (-> world-bounds-origin z) radius)))
(set! (-> max-pt x) (fmax (-> max-pt x) (+ (-> world-bounds-origin x) radius)))
(set! (-> max-pt y) (fmax (-> max-pt y) (+ (-> world-bounds-origin y) radius)))
(set! (-> max-pt z) (fmax (-> max-pt z) (+ (-> world-bounds-origin z) radius)))
)
)
0
(none)
)
;; definition for method 22 of type level-group
;; INFO: Used lq/sq
;; INFO: Return type mismatch int vs none.
(defmethod update-vis-volumes ((this level-group))
(local-vars (v1-10 symbol) (sv-16 process))
(dotimes (s5-0 (-> this length))
(let ((v1-3 (-> this level s5-0)))
(when (= (-> v1-3 status) 'active)
(let ((s4-0 (-> v1-3 bsp level entity)))
(dotimes (s3-0 (-> s4-0 length))
(let* ((s0-0 (-> s4-0 data s3-0 entity))
(v0-0 (res-lump-data s0-0 'visvol (inline-array vector)))
(s2-0 (-> v0-0 0))
(s1-0 (-> v0-0 1))
)
(let ((s0-1 (-> s0-0 extra process)))
(set! v1-10 (when (and (nonzero? s0-1) (type-type? (-> s0-1 type) process-drawable))
(set! sv-16 (the-as process v1-10))
(set! sv-16 s0-1)
v1-10
)
)
)
(when sv-16
(update-actor-vis-box (the-as process-drawable sv-16) s2-0 s1-0)
(let ((s0-2 (-> sv-16 child)))
(while s0-2
(let ((sv-32 update-actor-vis-box)
(sv-48 (-> s0-2 0))
)
(sv-32
(the-as process-drawable (if (and (nonzero? sv-48) (type-type? (-> sv-48 type) process-drawable))
sv-48
)
)
s2-0
s1-0
)
)
(set! s0-2 (-> s0-2 0 brother))
)
)
)
)
)
)
)
)
)
0
(none)
)
;; definition for method 23 of type level-group
;; INFO: Used lq/sq
;; INFO: Return type mismatch int vs none.
(defmethod update-vis-volumes-from-nav-mesh ((this level-group))
(dotimes (s5-0 (-> this length))
(let ((v1-3 (-> this level s5-0)))
(when (= (-> v1-3 status) 'active)
(let ((s4-0 (-> v1-3 bsp level entity)))
(dotimes (s3-0 (-> s4-0 length))
(let* ((sv-32 (-> s4-0 data s3-0 entity))
(v0-0 (res-lump-data sv-32 'visvol (inline-array vector)))
(s1-0 (-> v0-0 0))
(s2-0 (-> v0-0 1))
)
(let ((s0-0 (-> sv-32 extra trans))
(sv-16 sv-32)
)
(let ((v0-1 (entity-actor-lookup sv-32 'nav-mesh-actor 0)))
(when v0-1
(set! sv-16 v0-1)
(the-as entity-actor (the-as entity-actor sv-16))
)
)
(cond
((and (type-type? (-> sv-16 type) entity-actor) (nonzero? (-> (the-as entity-actor sv-16) nav-mesh)))
(compute-bounding-box (-> (the-as entity-actor sv-16) nav-mesh) s1-0 s2-0)
)
(else
(set! (-> s1-0 quad) (-> s0-0 quad))
(set! (-> s2-0 quad) (-> s0-0 quad))
)
)
)
(let ((f1-0 -12288.0)
(f0-0 12288.0)
)
(+! (-> s1-0 x) f1-0)
(+! (-> s1-0 y) f1-0)
(+! (-> s1-0 z) f1-0)
(+! (-> s2-0 x) f0-0)
(+! (-> s2-0 y) f0-0)
(+! (-> s2-0 z) f0-0)
)
)
)
)
)
)
)
0
(none)
)
;; definition for method 24 of type level-group
;; INFO: Used lq/sq
;; INFO: Return type mismatch int vs none.
(defmethod print-volume-sizes ((this level-group))
(local-vars (sv-16 type))
(dotimes (s5-0 (-> this length))
(let ((v1-3 (-> this level s5-0)))
(when (= (-> v1-3 status) 'active)
(let ((s4-0 (-> v1-3 bsp level entity)))
(dotimes (s3-0 (-> s4-0 length))
(let* ((sv-80 (-> s4-0 data s3-0 entity))
(s1-0 (the-as object (res-lump-data sv-80 'visvol pointer)))
(f30-0 (res-lump-float sv-80 'vis-dist :default 409600.0))
(s2-0 (-> sv-80 extra trans))
)
(set! sv-16 (cond
((type-type? (-> sv-80 type) entity-actor)
(set! sv-16 (-> (the-as entity-actor sv-80) etype))
sv-16
)
(else
(the-as type #f)
)
)
)
(let ((s0-0 (-> (the-as (inline-array vector) s1-0) 0))
(s1-1 (-> (the-as (inline-array vector) s1-0) 1))
)
(when (not (or (name= sv-16 money) (or (name= sv-16 crate) (name= sv-16 fuel-cell) (name= sv-16 springbox))))
(format #t "actor-vis ~S ~6,,1M " (res-lump-struct sv-80 'name structure) f30-0)
(format
#t
"~6,,1M ~6,,1M ~6,,1M ~6,,1M ~6,,1M ~6,,1M~%"
(- (-> s0-0 x) (-> s2-0 x))
(- (-> s0-0 y) (-> s2-0 y))
(- (-> s0-0 z) (-> s2-0 z))
(- (-> s1-1 x) (-> s2-0 x))
(- (-> s1-1 y) (-> s2-0 y))
(- (-> s1-1 z) (-> s2-0 z))
)
)
)
)
)
)
)
)
)
0
(none)
)
;; definition for function expand-vis-box-with-point
;; INFO: Return type mismatch int vs none.
(defun expand-vis-box-with-point ((arg0 entity) (arg1 vector))
(let ((v1-1 (res-lump-data arg0 'visvol (inline-array vector))))
(when v1-1
(let ((a0-2 (-> v1-1 0))
(v1-2 (-> v1-1 1))
)
(set! (-> a0-2 x) (fmin (-> a0-2 x) (-> arg1 x)))
(set! (-> a0-2 y) (fmin (-> a0-2 y) (-> arg1 y)))
(set! (-> a0-2 z) (fmin (-> a0-2 z) (-> arg1 z)))
(set! (-> v1-2 x) (fmax (-> v1-2 x) (-> arg1 x)))
(set! (-> v1-2 y) (fmax (-> v1-2 y) (-> arg1 y)))
(set! (-> v1-2 z) (fmax (-> v1-2 z) (-> arg1 z)))
)
)
)
0
(none)
)
;; definition for method 14 of type level-group
;; INFO: Used lq/sq
;; INFO: Return type mismatch int vs none.
(defmethod debug-draw-actors ((this level-group) (arg0 symbol))
(when (and arg0 (not (or (= *master-mode* 'menu) (= *master-mode* 'progress))))
(dotimes (s4-0 (-> this length))
(let ((v1-8 (-> this level s4-0)))
(when (= (-> v1-8 status) 'active)
(let ((s3-0 (-> v1-8 bsp level entity)))
(dotimes (s2-0 (-> s3-0 length))
(let* ((s0-0 (-> s3-0 data s2-0 entity))
(s1-0 (-> s0-0 extra trans))
)
(cond
((and (= arg0 'process) (-> s0-0 extra process) (type-type? (-> s0-0 extra process type) process-drawable))
(let ((s1-1 (the-as process-drawable (-> s0-0 extra process))))
(add-debug-x
#t
(bucket-id debug-no-zbuf)
(-> s1-1 root trans)
(new 'static 'rgba :r #x80 :g #xff :b #x80 :a #x80)
)
(add-debug-text-3d
#t
(bucket-id debug-no-zbuf)
(res-lump-struct s0-0 'name string)
(-> s1-1 root trans)
(font-color white)
(new 'static 'vector2h :y 8)
)
(add-debug-text-3d
#t
(bucket-id debug-no-zbuf)
(symbol->string (-> s1-1 state name))
(-> s1-1 root trans)
(font-color white)
(new 'static 'vector2h :y 16)
)
(let ((s0-1 (res-lump-data (-> s1-1 entity) 'eco-info (pointer int32) :time 0.0)))
(when s0-1
(let ((sv-96 add-debug-text-3d)
(sv-112 #t)
(sv-128 68)
)
(format (clear *temp-string*) "~S ~D~%" (pickup-type->string (the-as pickup-type (-> s0-1 0))) (-> s0-1 1))
(sv-96
sv-112
(the-as bucket-id sv-128)
*temp-string*
(-> s1-1 root trans)
(font-color white)
(new 'static 'vector2h :y 24)
)
)
)
)
(let ((v0-10 (res-lump-struct (-> s1-1 entity) 'art-name symbol)))
(if (and (the-as structure v0-10) (= (-> v0-10 type) symbol))
(add-debug-text-3d
#t
(bucket-id debug-no-zbuf)
(symbol->string v0-10)
(-> s1-1 root trans)
(font-color white)
(new 'static 'vector2h :y 24)
)
)
)
)
)
((or (= arg0 'full) (-> s0-0 extra process))
(add-debug-x #t (bucket-id debug-no-zbuf) s1-0 (if (-> s0-0 extra process)
(new 'static 'rgba :r #x80 :g #xff :b #x80 :a #x80)
(new 'static 'rgba :r #xff :a #x80)
)
)
(let ((sv-192 add-debug-text-3d)
(sv-208 #t)
(sv-224 68)
)
(sv-192
sv-208
(the-as bucket-id sv-224)
(res-lump-struct s0-0 'name string)
s1-0
(if (logtest? (-> s0-0 extra perm status) (entity-perm-status bit-0 bit-1))
(font-color white)
(font-color yellow)
)
(new 'static 'vector2h :y 8)
)
)
)
)
)
)
)
)
)
)
)
(when (and *display-actor-vis* (not (or *display-actor-anim* *display-process-anim*)))
(let ((s5-1 *display-actor-vis*))
(dotimes (s4-1 (-> this length))
(let ((s3-1 (-> this level s4-1)))
(when (= (-> s3-1 status) 'active)
(let ((s2-1 (-> s3-1 bsp level entity)))
(dotimes (s1-2 (-> s2-1 length))
(let ((s0-2 (-> s2-1 data s1-2 entity)))
(let ((v0-15 (res-lump-data s0-2 'visvol pointer))
(a1-16 (-> s0-2 extra vis-id))
)
(when (and v0-15 (or (= s5-1 #t) (= s5-1 'box)))
(let ((sv-240 add-debug-box)
(sv-256 #t)
(sv-272 68)
(sv-288 (&+ v0-15 0))
(sv-304 (&+ v0-15 16))
)
(sv-240
sv-256
(the-as bucket-id sv-272)
(the-as vector sv-288)
(the-as vector sv-304)
(if (is-object-visible? s3-1 a1-16)
(new 'static 'rgba :g #x80 :b #x80 :a #x80)
(new 'static 'rgba :r #x80 :b #x80 :a #x80)
)
)
)
)
)
(when (or (= s5-1 #t) (= s5-1 'sphere))
(let ((s0-3 (-> s0-2 extra process)))
(when s0-3
(when (and (type-type? (-> s0-3 type) process-drawable) (nonzero? (-> (the-as process-drawable s0-3) draw)))
(add-debug-x
#t
(bucket-id debug-no-zbuf)
(-> (the-as process-drawable s0-3) root trans)
(new 'static 'rgba :r #xff :g #xff :b #xff :a #x80)
)
(add-debug-sphere
#t
(bucket-id debug)
(vector+!
(new 'stack-no-clear 'vector)
(-> (the-as process-drawable s0-3) draw origin)
(-> (the-as process-drawable s0-3) draw bounds)
)
(-> (the-as process-drawable s0-3) draw bounds w)
(new 'static 'rgba :r #x80 :a #x80)
)
)
)
)
)
)
)
)
)
)
)
)
)
(if *generate-actor-vis*
(update-vis-volumes this)
)
(when (or *display-actor-anim* *display-process-anim*)
(let ((s5-2 (ppointer->process *display-process-anim*)))
(if (not s5-2)
(set! s5-2 (process-by-name *display-actor-anim* *active-pool*))
)
(when (and s5-2 (type-type? (-> s5-2 type) process-drawable))
(let ((s3-2 (-> (the-as process-drawable s5-2) entity))
(s4-2 (-> (the-as process-drawable s5-2) root trans))
)
(when s3-2
(add-debug-x #t (bucket-id debug-no-zbuf) s4-2 (if (-> s3-2 extra process)
(new 'static 'rgba :r #x80 :g #xff :b #x80 :a #x80)
(new 'static 'rgba :r #xff :a #x80)
)
)
(add-debug-text-3d
#t
(bucket-id debug-no-zbuf)
(res-lump-struct s3-2 'name string)
s4-2
(if (logtest? (-> s3-2 extra perm status) (entity-perm-status bit-0 bit-1))
(font-color white)
(font-color white)
)
(new 'static 'vector2h :y 8)
)
(add-debug-text-3d
#t
(bucket-id debug-no-zbuf)
(symbol->string (-> (the-as process-drawable s5-2) state name))
s4-2
(font-color white)
(new 'static 'vector2h :y 16)
)
)
)
(if (nonzero? (-> (the-as process-drawable s5-2) skel))
(debug-print-channels (-> (the-as process-drawable s5-2) skel) (the-as symbol *stdcon*))
)
(if (nonzero? (-> (the-as process-drawable s5-2) nav))
(debug-draw (-> (the-as process-drawable s5-2) nav))
)
(if (nonzero? (-> (the-as process-drawable s5-2) path))
(debug-draw (-> (the-as process-drawable s5-2) path))
)
(if (nonzero? (-> (the-as process-drawable s5-2) vol))
(init! (-> (the-as process-drawable s5-2) vol))
)
)
(if (and (the-as process-drawable s5-2)
(type-type? (-> (the-as process-drawable s5-2) type) process-drawable)
(nonzero? (-> (the-as process-drawable s5-2) draw))
*display-actor-vis*
)
(add-debug-sphere
#t
(bucket-id debug)
(vector+!
(new 'stack-no-clear 'vector)
(-> (the-as process-drawable s5-2) draw origin)
(-> (the-as process-drawable s5-2) draw bounds)
)
(-> (the-as process-drawable s5-2) draw bounds w)
(new 'static 'rgba :r #x80 :a #x80)
)
)
)
(when (and *display-actor-vis* *display-actor-anim*)
(let ((s5-3 (entity-by-name *display-actor-anim*)))
(when s5-3
(let ((v0-35 (res-lump-data s5-3 'visvol pointer))
(a1-31 (-> s5-3 extra vis-id))
)
(if v0-35
(add-debug-box
#t
(bucket-id debug-no-zbuf)
(the-as vector (&+ v0-35 0))
(the-as vector (&+ v0-35 16))
(if (is-object-visible? (-> s5-3 extra level) a1-31)
(new 'static 'rgba :g #x80 :b #x80 :a #x80)
(new 'static 'rgba :r #x80 :b #x80 :a #x80)
)
)
)
)
)
)
)
)
(if (and (or *display-nav-marks* *display-path-marks* *display-vol-marks*)
(not (or *display-actor-anim* *display-process-anim*))
)
(iterate-process-tree
*active-pool*
(lambda ((arg0 process-drawable))
(when (type-type? (-> arg0 type) process-drawable)
(if (nonzero? (-> arg0 nav))
(debug-draw (-> arg0 nav))
)
(if (nonzero? (-> arg0 path))
(debug-draw (-> arg0 path))
)
(if (nonzero? (-> arg0 vol))
(init! (-> arg0 vol))
)
)
(none)
)
*null-kernel-context*
)
)
(when (and *display-actor-graph* (not (or (= *master-mode* 'menu) (= *master-mode* 'progress))))
(if (not (paused?))
(float-save-timeplot (if (< (the int (the float (mod (current-time) 600))) 300)
1.0
0.0
)
)
)
(camera-plot-float-func
0.0
399.0
-81920.0
81920.0
float-lookup-redline
(new 'static 'vector4w :x #xff :w #x80)
)
(camera-plot-float-func
0.0
399.0
-81920.0
81920.0
float-lookup-blueline
(new 'static 'vector4w :z #xff :w #x80)
)
(camera-plot-float-func
0.0
399.0
-81920.0
81920.0
float-lookup-greenline
(new 'static 'vector4w :y #xff :w #x80)
)
(camera-plot-float-func
0.0
399.0
0.0
409600.0
float-lookup-yellowline
(new 'static 'vector4w :x #xff :y #xff :w #x80)
)
(camera-plot-float-func
0.0
399.0
0.0
1.0
float-lookup-timeplot
(new 'static 'vector4w :x #x80 :y #x80 :z #x80 :w #x80)
)
)
(when *display-split-boxes*
(dotimes (s5-4 (-> this length))
(let ((s4-4 (-> this level s5-4)))
(when (= (-> s4-4 status) 'active)
(when (nonzero? (-> s4-4 bsp boxes))
(let ((s3-4 (-> s4-4 bsp boxes)))
(countdown (s2-4 (-> s3-4 length))
(add-debug-box
#t
(bucket-id debug)
(-> s3-4 data s2-4 min)
(the-as vector (+ (the-as uint (-> s3-4 data 0 max)) (* s2-4 32)))
(if (zero? (-> s4-4 index))
(new 'static 'rgba :g #x80 :b #x80 :a #x80)
(new 'static 'rgba :r #xff :g #x80 :b #x80 :a #x80)
)
)
)
)
)
)
)
)
)
(when (or *display-ambient-hint-marks*
*display-ambient-sound-marks*
*display-ambient-poi-marks*
*display-ambient-light-marks*
*display-ambient-dark-marks*
*display-ambient-weather-off-marks*
*display-ambient-ocean-off-marks*
*display-ambient-ocean-near-off-marks*
*display-ambient-music-marks*
)
(dotimes (s5-5 (-> this length))
(let ((v1-214 (-> this level s5-5)))
(when (= (-> v1-214 status) 'active)
(let ((s4-5 (-> v1-214 bsp ambients)))
(when (nonzero? s4-5)
(dotimes (s3-5 (-> s4-5 length))
(draw-debug (-> s4-5 data s3-5 ambient))
)
)
)
)
)
)
)
0
(none)
)
;; definition for method 22 of type entity-camera
(defmethod birth! ((this entity-camera))
(add-connection *camera-engine* *camera* nothing this #f #f)
this
)
;; definition for method 23 of type entity-camera
(defmethod kill! ((this entity-camera))
(remove-by-param1 *camera-engine* this)
this
)
;; definition for function init-entity
;; INFO: Return type mismatch process vs none.
(defun init-entity ((proc process) (ent entity-actor))
(activate proc *entity-pool* (res-lump-struct ent 'name basic) (the-as pointer #x70004000))
(set! (-> proc entity) ent)
(set! (-> ent extra process) proc)
((the-as (function process function process entity none) run-function-in-process)
proc
(method-of-object proc init-from-entity!)
proc
ent
)
(none)
)
;; definition for method 22 of type entity-actor
(defmethod birth! ((this entity-actor))
(let* ((entity-type (-> this etype))
(info (entity-info-lookup entity-type))
(entity-process (get-process *default-dead-pool* entity-type (if info
(-> info heap-size)
#x4000
)
)
)
)
(cond
((not entity-process)
)
((begin
(set! (-> entity-process type) entity-type)
(and entity-type
(valid? entity-type type #f #f 0)
(valid? (method-of-object entity-process init-from-entity!) function #f #f 0)
)
)
(init-entity entity-process this)
)
(else
(when (not (birth-viewer entity-process this))
(format 0 "ERROR: no proper process type named ~A exists in the code, could not start ~A~%" entity-type this)
(logior! (-> this extra perm status) (entity-perm-status bit-0))
)
)
)
)
this
)
;; definition for function entity-deactivate-handler
;; INFO: Return type mismatch symbol vs none.
(defun entity-deactivate-handler ((arg0 process) (arg1 entity-actor))
(when (= arg0 (-> arg1 extra process))
(logclear! (-> arg1 extra perm status) (entity-perm-status bit-1 bit-3))
(set! (-> arg1 extra process) #f)
)
(none)
)
;; definition for method 23 of type entity-actor
(defmethod kill! ((this entity-actor))
(let ((a0-1 (-> this extra process)))
(if a0-1
(deactivate a0-1)
(entity-deactivate-handler a0-1 this)
)
)
this
)
;; definition for method 18 of type bsp-header
;; INFO: Return type mismatch bsp-header vs none.
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 s5, Count]
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 v1, Count]
(defmethod birth ((this bsp-header))
(local-vars (v1-71 int) (s5-0 int))
(.mfc0 s5-0 Count)
(let ((actor-count (if (nonzero? (-> this actors))
(-> this actors length)
0
)
)
)
(cond
((not (-> this level entity))
(set! (-> this level entity) (new 'loading-level 'entity-links-array actor-count))
)
((< (-> this level entity allocated-length) actor-count)
(format
0
"ERROR: Attempting to rebirth level ~A with incorrect entity table size ~D/~D~%"
(-> this level)
actor-count
(-> this level entity allocated-length)
)
)
)
)
(set! (-> this level entity length) 0)
0
(when (nonzero? (-> this actors))
(dotimes (birth-idx (-> this actors length))
(let* ((idx-to-birth (-> this actor-birth-order birth-idx))
(actor-to-birth (-> this actors data (logand idx-to-birth #xffff) actor))
)
(add-to-level! actor-to-birth *level* (-> this level) (the-as actor-id (-> actor-to-birth aid)))
)
)
)
(let ((existing-amb-count (if (nonzero? (-> this ambients))
(-> this ambients length)
0
)
)
)
(cond
((not (-> this level ambient))
(set! (-> this level ambient) (new 'loading-level 'entity-ambient-data-array existing-amb-count))
)
((< (-> this level ambient allocated-length) existing-amb-count)
(format
0
"ERROR: Attempting to rebirth level ~A with incorrect ambient table size ~D/~D~%"
(-> this level)
existing-amb-count
(-> this level ambient allocated-length)
)
)
)
)
(set! (-> this level ambient length) 0)
0
(let ((amb-array (-> this level ambient))
(bsp-ambs (-> this ambients))
)
(when (nonzero? bsp-ambs)
(dotimes (s2-0 (-> bsp-ambs length))
(let ((amb-to-birth (-> bsp-ambs data s2-0 ambient)))
(set! (-> amb-to-birth ambient-data) (-> amb-array data (-> amb-array length)))
(birth-ambient! amb-to-birth)
)
(+! (-> amb-array length) 1)
)
)
)
(let ((cams (-> this cameras)))
(when (nonzero? cams)
(dotimes (s3-1 (-> cams length))
(birth! (-> cams s3-1))
)
)
)
(.mfc0 v1-71 Count)
(let ((a3-3 (- v1-71 s5-0)))
(format 0 "Done ~S in ~D~%" "birth" a3-3)
)
(none)
)
;; definition for method 19 of type bsp-header
;; INFO: Return type mismatch bsp-header vs none.
(defmethod deactivate-entities ((this bsp-header))
(let ((s5-0 (-> this actors)))
(when (nonzero? s5-0)
(dotimes (s4-0 (-> s5-0 length))
(let ((s3-0 (-> s5-0 data s4-0 actor)))
(kill! s3-0)
(remove-from-level! s3-0 *level*)
)
)
)
)
(let ((s5-1 (-> this cameras)))
(when (nonzero? s5-1)
(dotimes (s4-1 (-> s5-1 length))
(kill! (-> s5-1 s4-1))
)
)
)
(let ((s5-2 (-> *entity-pool* child))
(s4-2 (-> this level heap base))
(s3-1 (-> this level heap top-base))
)
(while s5-2
(let ((s2-0 (ppointer->process s5-2)))
(set! s5-2 (-> s5-2 0 brother))
(cond
((-> (the-as process s2-0) entity)
(when (= (-> (the-as process s2-0) entity extra level) (-> this level))
(format #t "NOTICE: rogue level entity ~A~% still alive~%" s2-0)
(deactivate s2-0)
)
)
((= (-> s2-0 type) part-tracker)
(let ((v1-28 (the-as part-tracker s2-0)))
(if (and (nonzero? (-> v1-28 part))
(>= (the-as int (-> v1-28 part group)) (the-as int s4-2))
(< (the-as int (-> v1-28 part group)) (the-as int s3-1))
)
(deactivate s2-0)
)
)
)
(else
(let* ((s1-0 s2-0)
(v1-34 (if (and (nonzero? s1-0) (type-type? (-> s1-0 type) process-drawable))
s1-0
)
)
)
(when v1-34
(cond
((and (nonzero? (-> (the-as process-drawable v1-34) part))
(>= (the-as int (-> (the-as process-drawable v1-34) part group)) (the-as int s4-2))
(< (the-as int (-> (the-as process-drawable v1-34) part group)) (the-as int s3-1))
)
(format
#t
"NOTICE: rogue null level entity (using part ~A) ~A~% still alive~%"
(-> (the-as process-drawable (-> (the-as process-drawable v1-34) part)) brother)
s2-0
)
(deactivate s2-0)
)
((and (nonzero? (-> (the-as process-drawable v1-34) draw))
(>= (the-as int (-> (the-as process-drawable v1-34) draw art-group)) (the-as int s4-2))
(< (the-as int (-> (the-as process-drawable v1-34) draw art-group)) (the-as int s3-1))
)
(format
#t
"NOTICE: rogue null level entity (using art ~A) ~A~% still alive~%"
(-> (the-as process-drawable (-> (the-as process-drawable v1-34) draw)) mask)
s2-0
)
(deactivate s2-0)
)
)
)
)
)
)
)
)
)
(none)
)
;; definition for function process-drawable-from-entity!
;; INFO: Used lq/sq
;; INFO: Return type mismatch process-drawable vs none.
(defun process-drawable-from-entity! ((arg0 process-drawable) (arg1 entity-actor))
(logior! (-> arg0 mask) (process-mask actor-pause))
(set! (-> arg0 root trans quad) (-> arg1 extra trans quad))
(quaternion-copy! (-> arg0 root quat) (-> arg1 quat))
(vector-identity! (-> arg0 root scale))
(none)
)
;; definition for method 9 of type entity-perm
(defmethod update-perm! ((this entity-perm) (arg0 symbol) (arg1 entity-perm-status))
(cond
((= arg0 'game)
(logclear! (-> this status) arg1)
)
((nonzero? (-> this task))
(logclear! (-> this status) (logior (if (logtest? (-> this status) (entity-perm-status bit-4))
524
0
)
515
)
)
)
(else
(logclear! (-> this status) (logior arg1 (if (logtest? (-> this status) (entity-perm-status bit-4))
524
0
)
)
)
)
)
(when (not (logtest? (-> this status) (entity-perm-status user-set-from-cstage)))
(set! (-> this user-uint64) (the-as uint 0))
0
)
this
)
;; definition for function reset-actors
;; INFO: Return type mismatch int vs none.
(defun reset-actors ((arg0 symbol))
(set! *display-process-anim* (the-as (pointer process) #f))
(let* ((v1-0 arg0)
(s5-0 (cond
((or (= v1-0 'life) (= v1-0 'debug))
623
)
((= v1-0 'try)
623
)
((= v1-0 'game)
1919
)
(else
1663
)
)
)
(s4-0 *game-info*)
)
(dotimes (s3-0 (-> *level* length))
(let ((v1-4 (-> *level* level s3-0)))
(when (= (-> v1-4 status) 'active)
(let ((s2-0 (-> v1-4 bsp level entity)))
(dotimes (s1-0 (-> s2-0 length))
(let ((s0-0 (-> s2-0 data s1-0 entity)))
(kill! s0-0)
(update-perm! (-> s0-0 extra perm) arg0 (the-as entity-perm-status s5-0))
)
)
)
)
)
)
(let ((s3-1 (-> s4-0 task-perm-list)))
(dotimes (s2-1 (-> s3-1 length))
(update-perm! (-> s3-1 data s2-1) arg0 (the-as entity-perm-status s5-0))
)
(logior! (-> s3-1 data 1 status) (entity-perm-status real-complete))
)
(let ((s4-1 (-> s4-0 perm-list)))
(dotimes (s3-2 (-> s4-1 length))
(update-perm! (-> s4-1 data s3-2) arg0 (the-as entity-perm-status s5-0))
)
)
)
(iterate-process-tree
*entity-pool*
(lambda ((arg0 process-drawable)) (deactivate arg0) (none))
*null-kernel-context*
)
(if (= arg0 'game)
(task-control-reset arg0)
)
(set! (-> *ACTOR-bank* birth-max) 1000)
0
(none)
)
;; definition for function reset-cameras
;; INFO: Return type mismatch int vs none.
(defun reset-cameras ()
(remove-all *camera-engine*)
(dotimes (gp-0 (-> *level* length))
(let ((v1-5 (-> *level* level gp-0)))
(when (= (-> v1-5 status) 'active)
(let ((s5-0 (-> v1-5 bsp cameras)))
(when (nonzero? s5-0)
(dotimes (s4-0 (-> s5-0 length))
(birth! (-> s5-0 s4-0))
)
)
)
)
)
)
0
(none)
)
;; definition for method 12 of type process-drawable
(defmethod run-logic? ((this process-drawable))
(or (not (logtest? (-> this mask) (process-mask actor-pause)))
(or (>= (+ (-> *ACTOR-bank* pause-dist) (-> this root pause-adjust-distance))
(vector-vector-distance (-> this root trans) (math-camera-pos))
)
(and (nonzero? (-> this skel)) (!= (-> this skel root-channel 0) (-> this skel channel)))
(and (nonzero? (-> this draw)) (logtest? (-> this draw status) (draw-status no-skeleton-update)))
)
)
)
;; definition for method 9 of type entity-links
(defmethod birth? ((this entity-links) (arg0 vector))
(and (not (logtest? (-> this perm status) (entity-perm-status bit-0 dead)))
(< (vector-vector-distance (-> this trans) arg0) (-> *ACTOR-bank* birth-dist))
)
)
;; definition for method 15 of type level-group
;; INFO: Used lq/sq
;; INFO: Return type mismatch int vs object.
(defmethod actors-update ((this level-group))
(when *compact-actors*
(if (and (= *compact-actors* 'debug) (= (-> *nk-dead-pool* alive-list prev) (-> *nk-dead-pool* first-gap)))
(churn *nk-dead-pool* 1)
)
(if (nonzero? *debug-dead-pool*)
(compact *debug-dead-pool* 10)
)
(compact
*nk-dead-pool*
(the int
(lerp-scale 8.0 1.0 (the float (-> *display* frames (-> *display* last-screen) frame run-time)) 2000.0 8000.0)
)
)
)
(when (not (paused?))
(let ((s5-1 (-> *display* frames (-> *display* last-screen) frame run-time)))
(let ((f0-5 (fmax 327680.0 (fmin (+ 327680.0 (* 204.8 (the float (- 7000 s5-1)))) (-> *ACTOR-bank* birth-dist)))))
(seek! (-> *ACTOR-bank* pause-dist) f0-5 (* 81920.0 (seconds-per-frame)))
)
(seekl! (-> *ACTOR-bank* birth-max) (the int (lerp-scale 25.0 1.0 (the float s5-1) 2000.0 7000.0)) 10)
)
(if (movie?)
(set! (-> *ACTOR-bank* birth-max) 1000)
)
)
(when *spawn-actors*
(let ((sv-16 (camera-pos))
(sv-24 0)
)
(dotimes (s5-2 (-> this length))
(let ((s4-2 (-> this level s5-2)))
(when (= (-> s4-2 status) 'active)
(cond
((= (-> s4-2 display?) 'special)
(let* ((s4-3 (-> s4-2 entity))
(s3-1 (-> s4-3 length))
)
(dotimes (s2-0 s3-1)
(let ((v1-44 (-> s4-3 data s2-0)))
(cond
((logtest? (-> v1-44 perm status) (entity-perm-status bit-7))
(when (not (or (-> v1-44 process) (logtest? (-> v1-44 perm status) (entity-perm-status bit-0 dead))))
(birth! (-> v1-44 entity))
(+! sv-24 1)
(if (>= sv-24 (-> *ACTOR-bank* birth-max))
(return (the-as object #f))
)
)
)
(else
(if (and (-> v1-44 process) (not (logtest? (-> v1-44 perm status) (entity-perm-status bit-3))))
(kill! (-> v1-44 entity))
)
)
)
)
)
)
)
((= (-> s4-2 display?) 'special-vis)
(let* ((s3-2 (-> s4-2 entity))
(s2-1 (-> s3-2 length))
)
(dotimes (s1-0 s2-1)
(let ((s0-0 (-> s3-2 data s1-0)))
(cond
((and (logtest? (-> s0-0 perm status) (entity-perm-status bit-7)) (is-object-visible? s4-2 (-> s0-0 vis-id)))
(when (not (or (-> s0-0 process) (logtest? (-> s0-0 perm status) (entity-perm-status bit-0 dead))))
(birth! (-> s0-0 entity))
(+! sv-24 1)
)
)
(else
(when (and (-> s0-0 process) (not (logtest? (-> s0-0 perm status) (entity-perm-status bit-3))))
(kill! (-> s0-0 entity))
(+! sv-24 1)
)
)
)
)
(if (>= sv-24 (-> *ACTOR-bank* birth-max))
(return (the-as object #f))
)
)
)
)
((= (-> s4-2 display?) 'actor)
(let* ((s4-4 (-> s4-2 entity))
(s3-3 (-> s4-4 length))
)
(dotimes (s2-2 s3-3)
(let ((v1-84 (-> s4-4 data s2-2)))
(cond
(#t
(when (not (or (-> v1-84 process) (logtest? (-> v1-84 perm status) (entity-perm-status bit-0 dead))))
(birth! (-> v1-84 entity))
(+! sv-24 1)
(if (>= sv-24 (-> *ACTOR-bank* birth-max))
(return (the-as object #f))
)
)
)
(else
(if (and (-> v1-84 process) (not (logtest? (-> v1-84 perm status) (entity-perm-status bit-3))))
(kill! (-> v1-84 entity))
)
)
)
)
)
)
)
((not *vis-actors*)
(let* ((s4-5 (-> s4-2 entity))
(s3-4 (-> s4-5 length))
)
(dotimes (s2-3 s3-4)
(let ((s1-1 (-> s4-5 data s2-3)))
(cond
((and (< (vector-vector-distance (-> s1-1 trans) sv-16) (-> *ACTOR-bank* birth-dist))
(not (logtest? (-> s1-1 perm status) (entity-perm-status bit-9 bit-10)))
)
(when (not (or (-> s1-1 process) (logtest? (-> s1-1 perm status) (entity-perm-status bit-0 dead))))
(birth! (-> s1-1 entity))
(+! sv-24 1)
(if (>= sv-24 (-> *ACTOR-bank* birth-max))
(return (the-as object #f))
)
)
)
(else
(if (and (-> s1-1 process) (not (logtest? (-> s1-1 perm status) (entity-perm-status bit-3))))
(kill! (-> s1-1 entity))
)
)
)
)
)
)
)
(*vis-actors*
(when (not (and (-> s4-2 vis-info 0) (-> s4-2 all-visible?)))
(let* ((s3-5 (-> s4-2 entity))
(s2-4 (-> s3-5 length))
(s0-1 #f)
)
(dotimes (s1-2 s2-4)
(let ((sv-32 (-> s3-5 data s1-2)))
(cond
((and (is-object-visible? s4-2 (-> sv-32 vis-id))
(not (logtest? (-> sv-32 perm status) (entity-perm-status bit-9 bit-10)))
)
(when (not (or (-> sv-32 process) (logtest? (-> sv-32 perm status) (entity-perm-status bit-0 dead)) s0-1))
(birth! (-> sv-32 entity))
(+! sv-24 1)
(when (< (/ (the float (memory-free *nk-dead-pool*)) (the float (memory-total *nk-dead-pool*))) 0.1)
(format
0
"WARNING: low actor memory, no birth triggered!!! ~D/~D~%"
(memory-free *nk-dead-pool*)
(memory-total *nk-dead-pool*)
)
(set! s0-1 #t)
)
)
)
(else
(when (and (-> sv-32 process) (not (logtest? (-> sv-32 perm status) (entity-perm-status bit-3))))
(kill! (-> sv-32 entity))
(+! sv-24 1)
)
)
)
)
(if (>= sv-24 (-> *ACTOR-bank* birth-max))
(return (the-as object #f))
)
)
)
)
)
)
)
)
)
)
)
0
)
;; definition for function entity-birth-no-kill
;; INFO: Return type mismatch process vs none.
(defun entity-birth-no-kill ((arg0 entity))
(let ((gp-0 (-> arg0 extra)))
(logior! (-> gp-0 perm status) (entity-perm-status bit-3))
(if (not (or (-> gp-0 process) (logtest? (-> gp-0 perm status) (entity-perm-status bit-0 dead))))
(birth! (-> gp-0 entity))
)
(-> gp-0 process)
)
(none)
)
;; definition for function entity-task-complete-on
;; INFO: Return type mismatch int vs none.
(defun entity-task-complete-on ((arg0 entity))
(let ((v1-0 (-> arg0 extra)))
(if (nonzero? (-> v1-0 perm task))
(logior! (-> *game-info* task-perm-list data (-> v1-0 perm task) status) (entity-perm-status real-complete))
)
)
0
(none)
)
;; definition for function entity-task-complete-off
;; INFO: Return type mismatch int vs none.
(defun entity-task-complete-off ((arg0 entity))
(let ((v1-0 (-> arg0 extra)))
(if (!= (-> v1-0 perm task) (game-task complete))
(logclear! (-> *game-info* task-perm-list data (-> v1-0 perm task) status) (entity-perm-status real-complete))
)
)
0
(none)
)
;; definition for method 30 of type entity-actor
;; INFO: Return type mismatch entity-perm-status vs none.
(defmethod set-or-clear-status! ((this entity-actor) (arg0 entity-perm-status) (arg1 symbol))
(let ((v1-0 (-> this extra)))
(if arg1
(logior! (-> v1-0 perm status) arg0)
(logclear! (-> v1-0 perm status) arg0)
)
(-> v1-0 perm status)
)
(none)
)
;; definition for function process-entity-status!
(defun process-entity-status! ((arg0 process) (arg1 entity-perm-status) (arg2 symbol))
(cond
((and (-> arg0 entity) (= arg0 (-> arg0 entity extra process)))
(let ((v1-6 (-> arg0 entity extra)))
(if arg2
(logior! (-> v1-6 perm status) arg1)
(logclear! (-> v1-6 perm status) arg1)
)
(the-as int (-> v1-6 perm status))
)
)
(else
0
)
)
)
;; definition (debug) for function entity-speed-test
;; INFO: Return type mismatch entity vs none.
;; ERROR: Unsupported inline assembly instruction kind - [mfc0 s4, Count]
(defun-debug entity-speed-test ((arg0 string))
(local-vars (s4-0 int))
(let ((gp-0 (entity-by-name arg0)))
(when gp-0
(set! *spawn-actors* #f)
(reset-actors 'debug)
0
(disable-irq)
(.mtc0 Count 0)
(.sync.p)
(birth! gp-0)
(.mfc0 s4-0 Count)
(enable-irq)
(format #t "~D spawn ~A ~A ~%" s4-0 arg0 (-> gp-0 extra process))
(kill! gp-0)
)
)
(none)
)
;; failed to figure out what this is:
0