mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
623 lines
19 KiB
Common Lisp
623 lines
19 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: load-state.gc
|
|
;; name in dgo: load-state
|
|
;; dgos: GAME
|
|
|
|
(declare-type cty-borrow-manager basic)
|
|
(define-extern *city-borrow-manager* cty-borrow-manager)
|
|
(define-extern mark-permanent-holds (function pair object))
|
|
(define-extern add-want-level (function (inline-array level-buffer-state) (pointer int64) symbol symbol symbol symbol object))
|
|
(define-extern *backup-load-state* load-state)
|
|
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(defmethod print ((this level-buffer-state))
|
|
(format
|
|
#t
|
|
"#<level-buffer-state ~A ~A ~A ~A @ #x~X>"
|
|
(-> this name)
|
|
(-> this display?)
|
|
(-> this force-vis?)
|
|
(-> this force-inside?)
|
|
this
|
|
)
|
|
this
|
|
)
|
|
|
|
(defmethod print ((this level-buffer-state-small))
|
|
(format #t "#<level-buffer-state ~A ~A @ #x~X>" (-> this name) (-> this display?) this)
|
|
this
|
|
)
|
|
|
|
(defmethod print ((this sound-bank-state))
|
|
(let ((t9-0 format)
|
|
(a0-1 #t)
|
|
(a1-0 "#<sound-bank-state ~A ~S @ #x~X>")
|
|
(a2-0 (-> this name))
|
|
(v1-0 (-> this mode))
|
|
)
|
|
(t9-0
|
|
a0-1
|
|
a1-0
|
|
a2-0
|
|
(cond
|
|
((= v1-0 (sound-bank-mode halfa))
|
|
"halfa"
|
|
)
|
|
((= v1-0 (sound-bank-mode halfc))
|
|
"halfc"
|
|
)
|
|
((= v1-0 (sound-bank-mode half))
|
|
"half"
|
|
)
|
|
((= v1-0 (sound-bank-mode full))
|
|
"full"
|
|
)
|
|
((= v1-0 (sound-bank-mode mode))
|
|
"mode"
|
|
)
|
|
((= v1-0 (sound-bank-mode unknown))
|
|
"unknown"
|
|
)
|
|
((= v1-0 (sound-bank-mode common))
|
|
"common"
|
|
)
|
|
((= v1-0 (sound-bank-mode halfb))
|
|
"halfb"
|
|
)
|
|
((= v1-0 (sound-bank-mode none))
|
|
"none"
|
|
)
|
|
((= v1-0 (sound-bank-mode virtual))
|
|
"virtual"
|
|
)
|
|
(else
|
|
"*unknown*"
|
|
)
|
|
)
|
|
this
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
(defmethod reset! ((this load-state))
|
|
(dotimes (v1-0 10)
|
|
(set! (-> this want v1-0 name) #f)
|
|
(set! (-> this want v1-0 display?) #f)
|
|
(set! (-> this want v1-0 force-vis?) #f)
|
|
(set! (-> this want v1-0 force-inside?) #f)
|
|
)
|
|
(dotimes (v1-3 3)
|
|
(set! (-> this want-sound v1-3 name) #f)
|
|
(set! (-> this want-sound v1-3 mode) (sound-bank-mode none))
|
|
)
|
|
(set! (-> this command-list) '())
|
|
(dotimes (v1-7 256)
|
|
(set! (-> this object-name v1-7) #f)
|
|
(set! (-> this object-status v1-7) (the-as basic 0))
|
|
)
|
|
this
|
|
)
|
|
|
|
(defun level-base-level-name ((arg0 symbol))
|
|
(when arg0
|
|
(let ((v1-0 (lookup-level-info arg0)))
|
|
(if (and v1-0 (-> v1-0 borrow) (-> v1-0 borrow alias))
|
|
(car (-> v1-0 borrow alias))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmethod want-levels ((this load-state) (arg0 (pointer symbol)))
|
|
(dotimes (v1-0 10)
|
|
(dotimes (a0-1 10)
|
|
(when (= (-> this want v1-0 name) (-> arg0 a0-1))
|
|
(set! (-> arg0 a0-1) #f)
|
|
(goto cfg-8)
|
|
)
|
|
)
|
|
(set! (-> this want v1-0 name) #f)
|
|
(label cfg-8)
|
|
)
|
|
(dotimes (s4-0 10)
|
|
(when (-> arg0 s4-0)
|
|
(dotimes (s3-0 10)
|
|
(when (not (-> this want s3-0 name))
|
|
(set! (-> this want s3-0 name) (-> arg0 s4-0))
|
|
(set! (-> this want s3-0 display?) #f)
|
|
(set! (-> this want s3-0 force-vis?) #f)
|
|
(set! (-> this want s3-0 force-inside?) #f)
|
|
(let ((a0-13 (level-base-level-name (-> this want s3-0 name))))
|
|
(dotimes (v1-22 10)
|
|
(when (= (-> this want-exp v1-22 name) a0-13)
|
|
(set! (-> this want s3-0 display?) (-> this want-exp v1-22 display?))
|
|
(set! (-> this want s3-0 force-vis?) (-> this want-exp v1-22 force-vis?))
|
|
(set! (-> this want s3-0 force-inside?) (-> this want-exp v1-22 force-inside?))
|
|
(goto cfg-21)
|
|
)
|
|
)
|
|
)
|
|
(label cfg-21)
|
|
(goto cfg-26)
|
|
)
|
|
)
|
|
)
|
|
(label cfg-26)
|
|
)
|
|
(dotimes (v1-35 10)
|
|
(when (not (-> this want v1-35 name))
|
|
(set! (-> this want v1-35 display?) #f)
|
|
(set! (-> this want v1-35 force-vis?) #f)
|
|
(set! (-> this want v1-35 force-inside?) #f)
|
|
)
|
|
)
|
|
(add-borrow-levels this)
|
|
0
|
|
)
|
|
|
|
(define *borrow-city-expansion-list* '(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
|
|
|
|
(define *borrow-city-status-list* '(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))
|
|
|
|
;; WARN: Return type mismatch pair vs object.
|
|
(defun borrow-city-expansion ((arg0 pair))
|
|
(local-vars (v1-12 type) (s2-2 int) (sv-16 pair) (sv-20 symbol) (sv-24 object))
|
|
(let ((gp-0 *borrow-city-expansion-list*))
|
|
0
|
|
(let ((s4-0 0))
|
|
(b! #t cfg-2 :delay (nop!))
|
|
(label cfg-1)
|
|
(set! (car (ref& gp-0 s4-0)) #f)
|
|
(set! (car (ref& *borrow-city-status-list* s4-0)) #f)
|
|
(+! s4-0 1)
|
|
(label cfg-2)
|
|
(let ((a0-3 (the-as object gp-0)))
|
|
(b! (< s4-0 ((method-of-type (rtype-of (the-as pair a0-3)) length) (the-as pair a0-3))) cfg-1)
|
|
)
|
|
)
|
|
(let* ((v1-7 gp-0)
|
|
(a0-4 arg0)
|
|
(a1-4 (car a0-4))
|
|
)
|
|
(while (not (null? a0-4))
|
|
(set! (car v1-7) a1-4)
|
|
(set! v1-7 (cdr v1-7))
|
|
(set! a0-4 (cdr a0-4))
|
|
(set! a1-4 (car a0-4))
|
|
)
|
|
)
|
|
(let ((v1-11 (shr (shl (the-as int arg0) 61) 61)))
|
|
(b! (zero? v1-11) cfg-20 :likely-delay (set! v1-12 binteger))
|
|
(b! (= v1-11 4) cfg-20 :likely-delay (set! v1-12 (-> (the-as basic arg0) type)))
|
|
(b! (= v1-11 2) cfg-20 :likely-delay (set! v1-12 pair))
|
|
)
|
|
(set! v1-12 symbol)
|
|
(label cfg-20)
|
|
(let ((s5-1 ((method-of-type v1-12 length) arg0)))
|
|
(if (and (nonzero? *city-borrow-manager*) *city-borrow-manager*)
|
|
(mark-permanent-holds gp-0)
|
|
)
|
|
(dotimes (s4-1 (the-as int (-> *setting-control* user-current borrow-city-count)))
|
|
(set! sv-16 (-> *setting-control* user-current borrow-city s4-1))
|
|
(let* ((s3-0 sv-16)
|
|
(v1-20 (car s3-0))
|
|
)
|
|
(while (not (null? s3-0))
|
|
(set! sv-20 (the-as symbol #f))
|
|
(set! sv-24 v1-20)
|
|
(when sv-24
|
|
(dotimes (s2-0 (/ s5-1 2))
|
|
(when (= sv-24 (ref gp-0 (* s2-0 2)))
|
|
(set! sv-20 #t)
|
|
(if (= (ref gp-0 (+ (* s2-0 2) 1)) 'auto)
|
|
(set! (car (ref& gp-0 (+ (* s2-0 2) 1))) 'faction)
|
|
)
|
|
0
|
|
(goto cfg-37)
|
|
)
|
|
)
|
|
(label cfg-37)
|
|
(when (not sv-20)
|
|
(dotimes (s2-1 (/ s5-1 2))
|
|
(when (= (ref gp-0 (+ (* s2-1 2) 1)) 'auto)
|
|
(set! s2-2 s2-1)
|
|
(goto cfg-45)
|
|
)
|
|
)
|
|
(set! s2-2 -1)
|
|
(label cfg-45)
|
|
(when (> s2-2 0)
|
|
(set! (car (ref& gp-0 (* s2-2 2))) sv-24)
|
|
(set! (car (ref& gp-0 (+ (* s2-2 2) 1))) 'faction)
|
|
)
|
|
)
|
|
)
|
|
(set! s3-0 (cdr s3-0))
|
|
(set! v1-20 (car s3-0))
|
|
)
|
|
)
|
|
)
|
|
(let ((s4-2 0))
|
|
(dotimes (s3-1 (/ s5-1 2))
|
|
(let ((v1-48 (ref gp-0 (+ (* s3-1 2) 1))))
|
|
(when (not (or (= v1-48 'auto) (= v1-48 'faction)))
|
|
(set! (car (ref& *borrow-city-status-list* (* s4-2 2))) (ref gp-0 (* s3-1 2)))
|
|
(set! (car (ref& *borrow-city-status-list* (+ (* s4-2 2) 1))) (ref gp-0 (+ (* s3-1 2) 1)))
|
|
(+! s4-2 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(dotimes (s4-3 (/ s5-1 2))
|
|
(case (ref gp-0 (+ (* s4-3 2) 1))
|
|
(('auto 'faction)
|
|
(set! (car (ref& gp-0 (+ (* s4-3 2) 1))) 'special)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
;; WARN: Return type mismatch int vs object.
|
|
(defun add-want-level ((arg0 (inline-array level-buffer-state))
|
|
(arg1 (pointer int64))
|
|
(arg2 symbol)
|
|
(arg3 symbol)
|
|
(arg4 symbol)
|
|
(arg5 symbol)
|
|
)
|
|
(when arg2
|
|
(let ((s1-0 (lookup-level-info arg2)))
|
|
(cond
|
|
((>= (-> arg1 0) 10)
|
|
)
|
|
((and (-> s1-0 borrow) (-> s1-0 borrow alias))
|
|
(let* ((s0-1 (borrow-city-expansion (the-as pair (-> s1-0 borrow alias))))
|
|
(a0-3 (-> s1-0 borrow alias))
|
|
(s1-1 ((method-of-type (rtype-of a0-3) length) a0-3))
|
|
)
|
|
(while (and (> s1-1 0) (car s0-1))
|
|
(when (!= (car s0-1) 'dummy)
|
|
(let ((t9-3 add-want-level)
|
|
(a0-5 arg0)
|
|
(a1-3 arg1)
|
|
(a2-1 (car s0-1))
|
|
(a3-1 (car (cdr s0-1)))
|
|
)
|
|
(set! a3-1 (cond
|
|
((or (not arg3) (= a3-1 'copy))
|
|
arg3
|
|
)
|
|
(else
|
|
(empty)
|
|
a3-1
|
|
)
|
|
)
|
|
)
|
|
(t9-3 a0-5 a1-3 (the-as symbol a2-1) (the-as symbol a3-1) arg4 arg5)
|
|
)
|
|
)
|
|
(set! s0-1 (cdr (cdr s0-1)))
|
|
(+! s1-1 -2)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(set! (-> arg0 (-> arg1 0) name) arg2)
|
|
(set! (-> arg0 (-> arg1 0) display?) arg3)
|
|
(set! (-> arg0 (-> arg1 0) force-vis?) arg4)
|
|
(set! (-> arg0 (-> arg1 0) force-inside?) arg5)
|
|
(+! (-> arg1 0) 1)
|
|
(when (-> s1-0 borrow)
|
|
(dotimes (s0-2 5)
|
|
(let ((v1-38 (-> s1-0 borrow borrow-info s0-2)))
|
|
(when v1-38
|
|
(let ((t9-4 add-want-level)
|
|
(a0-9 arg0)
|
|
(a1-4 arg1)
|
|
(a2-2 (car v1-38))
|
|
(a3-2 (car (cdr v1-38)))
|
|
)
|
|
(set! a3-2 (cond
|
|
((or (not arg3) (= a3-2 'copy))
|
|
arg3
|
|
)
|
|
(else
|
|
(empty)
|
|
a3-2
|
|
)
|
|
)
|
|
)
|
|
(t9-4 a0-9 a1-4 (the-as symbol a2-2) (the-as symbol a3-2) arg4 arg5)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defmethod add-borrow-levels ((this load-state))
|
|
(local-vars (sv-16 int))
|
|
(dotimes (s5-0 10)
|
|
(let ((a0-1 (-> this want s5-0 name)))
|
|
(when a0-1
|
|
(let ((a0-2 (lookup-level-info a0-1)))
|
|
(when (= (-> a0-2 memory-mode) (level-memory-mode borrow))
|
|
(set! (-> this want s5-0 name) #f)
|
|
(set! (-> this want s5-0 display?) #f)
|
|
(set! (-> this want s5-0 force-vis?) #f)
|
|
(set! (-> this want s5-0 force-inside?) #f)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! sv-16 0)
|
|
(dotimes (s5-1 10)
|
|
(if (-> this want s5-1 name)
|
|
(add-want-level
|
|
(-> this want-exp)
|
|
(the-as (pointer int64) (& sv-16))
|
|
(-> this want s5-1 name)
|
|
(-> this want s5-1 display?)
|
|
(-> this want s5-1 force-vis?)
|
|
(-> this want s5-1 force-inside?)
|
|
)
|
|
)
|
|
)
|
|
(while (< sv-16 10)
|
|
(set! (-> this want-exp sv-16 name) #f)
|
|
(set! (-> this want-exp sv-16 display?) #f)
|
|
(set! (-> this want-exp sv-16 force-vis?) #f)
|
|
(set! (-> this want-exp sv-16 force-inside?) #f)
|
|
(set! sv-16 (+ sv-16 1))
|
|
)
|
|
(cond
|
|
((-> this update-callback)
|
|
((-> this update-callback) this)
|
|
)
|
|
(else
|
|
(dotimes (v1-49 10)
|
|
(set! (-> this target v1-49 name) (-> this want-exp v1-49 name))
|
|
(set! (-> this target v1-49 display?) (-> this want-exp v1-49 display?))
|
|
(set! (-> this target v1-49 force-vis?) (-> this want-exp v1-49 force-vis?))
|
|
(set! (-> this target v1-49 force-inside?) (-> this want-exp v1-49 force-inside?))
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod want-sound-banks ((this load-state) (arg0 (pointer symbol)))
|
|
(dotimes (v1-0 3)
|
|
(dotimes (a2-0 3)
|
|
(when (= (-> this want-sound v1-0 name) (-> arg0 a2-0))
|
|
(set! (-> arg0 a2-0) #f)
|
|
(goto cfg-8)
|
|
)
|
|
)
|
|
(set! (-> this want-sound v1-0 name) #f)
|
|
(set! (-> this want-sound v1-0 mode) (sound-bank-mode none))
|
|
0
|
|
(label cfg-8)
|
|
)
|
|
(dotimes (v1-3 3)
|
|
(when (-> arg0 v1-3)
|
|
(dotimes (a2-15 3)
|
|
(when (not (-> this want-sound a2-15 name))
|
|
(set! (-> this want-sound a2-15 name) (-> arg0 v1-3))
|
|
(set! (-> this want-sound a2-15 mode) (sound-bank-mode unknown))
|
|
(goto cfg-19)
|
|
)
|
|
)
|
|
)
|
|
(label cfg-19)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod want-display-level ((this load-state) (arg0 symbol) (arg1 symbol))
|
|
(dotimes (v1-0 10)
|
|
(when (= (-> this want v1-0 name) arg0)
|
|
(set! (-> this want v1-0 display?) arg1)
|
|
(add-borrow-levels this)
|
|
(return 0)
|
|
)
|
|
)
|
|
(if arg1
|
|
(format 0 "ERROR: can't display ~A because it isn't loaded~%" arg0)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defmethod want-vis-level ((this load-state) (arg0 symbol))
|
|
(let ((v1-0 (lookup-level-info arg0)))
|
|
(if v1-0
|
|
(set! arg0 (-> v1-0 name))
|
|
)
|
|
)
|
|
(set! (-> this vis-nick) arg0)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod want-force-vis ((this load-state) (arg0 symbol) (arg1 symbol))
|
|
(dotimes (v1-0 10)
|
|
(when (= (-> this want v1-0 name) arg0)
|
|
(set! (-> this want v1-0 force-vis?) arg1)
|
|
(add-borrow-levels this)
|
|
(return 0)
|
|
)
|
|
)
|
|
(format 0 "ERROR: can't force vis on ~A because it isn't loaded~%" arg0)
|
|
0
|
|
)
|
|
|
|
;; WARN: Function (method 16 load-state) has a return type of none, but the expression builder found a return statement.
|
|
(defmethod want-force-inside ((this load-state) (arg0 symbol) (arg1 symbol))
|
|
(dotimes (v1-0 10)
|
|
(when (= (-> this want v1-0 name) arg0)
|
|
(set! (-> this want v1-0 force-inside?) arg1)
|
|
(add-borrow-levels this)
|
|
(return 0)
|
|
)
|
|
)
|
|
(format 0 "ERROR: can't force inside on ~A because it isn't loaded~%" arg0)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(define *display-load-commands* #f)
|
|
|
|
(defmethod backup-load-state-and-set-cmds ((this load-state) (arg0 pair))
|
|
(dotimes (s4-0 256)
|
|
(when (-> this object-name s4-0)
|
|
(format 0 "WARNING: load state somehow aquired object command ~A~%" (-> this object-name s4-0))
|
|
(set! (-> this object-name s4-0) #f)
|
|
)
|
|
)
|
|
(mem-copy! (&-> *backup-load-state* type) (&-> this type) 2664)
|
|
(set! (-> *backup-load-state* command-list) '())
|
|
(set! (-> this command-list) arg0)
|
|
0
|
|
)
|
|
|
|
(defmethod restore-load-state-and-cleanup ((this load-state))
|
|
(with-pp
|
|
(execute-commands-up-to this 100000.0)
|
|
(dotimes (gp-0 256)
|
|
(when (-> this object-name gp-0)
|
|
(let ((a0-3 (entity-by-name (-> this object-name gp-0))))
|
|
(when a0-3
|
|
(set! (-> a0-3 extra perm status) (the-as entity-perm-status (-> this object-status gp-0)))
|
|
(if (-> a0-3 extra process)
|
|
(kill! a0-3)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> this object-name gp-0) #f)
|
|
)
|
|
)
|
|
(let ((s5-0 (new 'stack 'load-state))
|
|
(gp-1 (-> *load-state* update-callback))
|
|
)
|
|
(mem-copy! (&-> s5-0 type) (&-> *load-state* type) 2664)
|
|
(mem-copy! (&-> this type) (&-> *backup-load-state* type) 2664)
|
|
(when (!= (-> pp type) scene-player)
|
|
(dotimes (s4-1 10)
|
|
(mem-copy! (the-as pointer (-> *load-state* want s4-1)) (the-as pointer (-> s5-0 want s4-1)) 16)
|
|
)
|
|
(dotimes (v1-34 3)
|
|
(set! (-> *load-state* want-sound v1-34 name) (-> s5-0 want-sound v1-34 name))
|
|
(set! (-> *load-state* want-sound v1-34 mode) (-> s5-0 want-sound v1-34 mode))
|
|
)
|
|
)
|
|
(dotimes (s4-2 10)
|
|
(mem-copy! (the-as pointer (-> *load-state* want-exp s4-2)) (the-as pointer (-> s5-0 want-exp s4-2)) 16)
|
|
(mem-copy! (the-as pointer (-> *load-state* target s4-2)) (the-as pointer (-> s5-0 target s4-2)) 16)
|
|
)
|
|
(dotimes (v1-47 6)
|
|
(set! (-> *load-state* want-exp-sound v1-47 name) (-> s5-0 want-exp-sound v1-47 name))
|
|
(set! (-> *load-state* want-exp-sound v1-47 mode) (-> s5-0 want-exp-sound v1-47 mode))
|
|
(set! (-> *load-state* target-sound v1-47 name) (-> s5-0 target-sound v1-47 name))
|
|
(set! (-> *load-state* target-sound v1-47 mode) (-> s5-0 target-sound v1-47 mode))
|
|
)
|
|
(set! (-> *load-state* update-callback) gp-1)
|
|
)
|
|
(add-borrow-levels *load-state*)
|
|
0
|
|
)
|
|
)
|
|
|
|
(defmethod restore-load-state ((this load-state))
|
|
(dotimes (v1-0 256)
|
|
(if (-> this object-name v1-0)
|
|
(set! (-> this object-name v1-0) #f)
|
|
)
|
|
)
|
|
(let ((s5-0 (new 'stack-no-clear 'inline-array 'level-buffer-state 10)))
|
|
(dotimes (s4-0 10)
|
|
((method-of-type level-buffer-state new) (the-as symbol (-> s5-0 s4-0)) level-buffer-state)
|
|
)
|
|
(let ((s4-1 (new 'stack-no-clear 'inline-array 'level-buffer-state 10)))
|
|
(dotimes (s3-0 10)
|
|
((method-of-type level-buffer-state new) (the-as symbol (-> s4-1 s3-0)) level-buffer-state)
|
|
)
|
|
(let ((s3-1 (-> *load-state* update-callback)))
|
|
(dotimes (s2-0 10)
|
|
(mem-copy! (the-as pointer (-> s5-0 s2-0)) (the-as pointer (-> *load-state* want-exp s2-0)) 16)
|
|
(mem-copy! (the-as pointer (-> s4-1 s2-0)) (the-as pointer (-> *load-state* target s2-0)) 16)
|
|
)
|
|
(mem-copy! (&-> this type) (&-> *backup-load-state* type) 2664)
|
|
(dotimes (gp-1 10)
|
|
(mem-copy! (the-as pointer (-> *load-state* want-exp gp-1)) (the-as pointer (-> s5-0 gp-1)) 16)
|
|
(mem-copy! (the-as pointer (-> *load-state* target gp-1)) (the-as pointer (-> s4-1 gp-1)) 16)
|
|
)
|
|
(set! (-> *load-state* update-callback) s3-1)
|
|
)
|
|
)
|
|
)
|
|
(add-borrow-levels *load-state*)
|
|
0
|
|
)
|
|
|
|
;; WARN: Function (method 17 load-state) has a return type of none, but the expression builder found a return statement.
|
|
(defmethod execute-commands-up-to ((this load-state) (arg0 float))
|
|
(with-pp
|
|
(let ((s4-0 (new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))))
|
|
(set! (-> s4-0 load-state) this)
|
|
(while (not (null? (-> this command-list)))
|
|
(let ((f0-0 (command-get-float (car (car (-> this command-list))) 0.0))
|
|
(s3-0 (cdr (car (-> this command-list))))
|
|
)
|
|
(if (< arg0 f0-0)
|
|
(return #f)
|
|
)
|
|
(if *display-load-commands*
|
|
(format 0 "NOTICE: ~D: ~f: execute command ~A~%" (current-time) f0-0 s3-0)
|
|
)
|
|
(cond
|
|
((pair? (car s3-0))
|
|
(let ((a1-4 (car s3-0)))
|
|
(while (not (null? s3-0))
|
|
(eval! s4-0 (the-as pair a1-4))
|
|
(set! s3-0 (cdr s3-0))
|
|
(set! a1-4 (car s3-0))
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(eval! s4-0 s3-0)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> this command-list) (cdr (-> this command-list)))
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
)
|
|
|
|
(kmemopen global "load-state-struct")
|
|
|
|
(define *backup-load-state* (new 'global 'load-state))
|
|
|
|
(define-perm *load-state* load-state (new 'global 'load-state))
|
|
|
|
(kmemclose)
|