;;-*-Lisp-*- (in-package goal) ;; name: script.gc ;; name in dgo: script ;; dgos: GAME (declare-type script-form structure) (define-extern *script-form* (inline-array script-form)) ;; DECOMP BEGINS 'script 'idle 'bigmap? (defun command-get-int ((arg0 object) (arg1 int)) (cond ((null? arg0) (empty) arg1 ) ((type? arg0 binteger) (the-as int (/ (the-as int arg0) 8)) ) ((type? arg0 bfloat) (the int (-> (the-as bfloat arg0) data)) ) (else (empty) arg1 ) ) ) (defun command-get-float ((arg0 object) (arg1 float)) (cond ((null? arg0) (empty) arg1 ) ((type? arg0 binteger) (the float (/ (the-as int arg0) 8)) ) ((type? arg0 bfloat) (-> (the-as bfloat arg0) data) ) (else (empty) arg1 ) ) ) ;; WARN: Return type mismatch int vs time-frame. (defun command-get-time ((arg0 object) (arg1 int)) (the-as time-frame (cond ((null? arg0) (empty) arg1 ) ((and (pair? arg0) (= (car arg0) 'seconds)) (the int (* 300.0 (command-get-float (car (cdr arg0)) 0.0))) ) ((and (pair? arg0) (= (car arg0) 'frame-time)) (the int (* 5.0000005 (command-get-float (car (cdr arg0)) 0.0))) ) ((and (pair? arg0) (= (car arg0) 'frame-time-30)) (the int (* 10.000001 (command-get-float (car (cdr arg0)) 0.0))) ) ((and (pair? arg0) (= (car arg0) 'frame-range)) (let ((f30-3 (command-get-float (car (cdr arg0)) 0.0)) (f28-0 (command-get-float (car (cdr (cdr arg0))) 0.0)) (f0-9 (command-get-float (car (cdr (cdr (cdr arg0)))) 0.0)) ) (if (= f0-9 0.0) (set! f0-9 30.0) ) (the int (* 300.0 (/ (- f28-0 f30-3) f0-9))) ) ) ((type? arg0 binteger) (the-as int (/ (the-as int arg0) 8)) ) ((type? arg0 bfloat) (the int (-> (the-as bfloat arg0) data)) ) (else (empty) arg1 ) ) ) ) (defun command-get-param ((arg0 object) (arg1 object)) (cond ((null? arg0) arg1 ) ((and (pair? arg0) (= (car arg0) 'seconds)) (the int (* 300.0 (command-get-float (car (cdr arg0)) 0.0))) ) ((and (pair? arg0) (= (car arg0) 'meters)) (* 4096.0 (command-get-float (car (cdr arg0)) 0.0)) ) ((and (pair? arg0) (= (car arg0) 'deg)) (* 182.04445 (command-get-float (car (cdr arg0)) 0.0)) ) ((and (pair? arg0) (= (car arg0) 'static-vectorm)) (let ((s4-0 (the-as object (new 'static 'vector)))) (set-vector! (the-as vector s4-0) (* 4096.0 (command-get-float (car (cdr arg0)) 0.0)) (* 4096.0 (command-get-float (car (cdr (cdr arg0))) 0.0)) (* 4096.0 (command-get-float (car (cdr (cdr (cdr arg0)))) 0.0)) 1.0 ) s4-0 ) ) ((type? arg0 binteger) (/ (the-as int arg0) 8) ) ((type? arg0 bfloat) (-> (the-as bfloat arg0) data) ) (else arg0 ) ) ) (defun command-get-quoted-param ((arg0 object) (arg1 object)) (if (and (pair? arg0) (= (car arg0) 'quote)) (command-get-param (car (cdr arg0)) arg1) (command-get-param arg0 arg1) ) ) ;; WARN: Return type mismatch object vs process. ;; ERROR: Failed load: (set! v1-30 (l.wu 0)) at op 111 ;; WARN: disable def twice: 125. This may happen when a cond (no else) is nested inside of another conditional, but it should be rare. (defun command-get-process ((arg0 object) (arg1 process)) (with-pp (set! arg1 (cond ((or (null? arg0) (not arg0)) (empty) arg1 ) ((or (type? arg0 process) (= (rtype-of arg0) actor-group)) (the-as process arg0) ) ((type? arg0 entity-actor) (-> (the-as entity-actor arg0) extra process) ) ((or (= arg0 'target) (= arg0 '*target*)) *target* ) ((= arg0 'sidekick) (if *target* (ppointer->process (-> *target* sidekick)) ) ) ((= arg0 'parent) (let ((v1-16 (-> pp parent))) (if v1-16 (the-as process (-> v1-16 0 self)) ) ) ) ((= arg0 'camera) *camera* ) ((= arg0 '*task-manager*) (when (nonzero? (-> *setting-control* user-current exclusive-task-count)) (let ((v1-24 (-> *task-manager-engine* alive-list next0))) *task-manager-engine* (let ((a0-10 (-> v1-24 next0))) (while (!= v1-24 (-> *task-manager-engine* alive-list-end)) (when (= (-> (the-as game-task-node-info (-> (the-as connection v1-24) param2)) task) (-> *setting-control* user-current exclusive-task 0) ) (set! arg1 (the-as process (-> (the-as connection v1-24) param1))) (goto cfg-97) ) (set! v1-24 a0-10) *task-manager-engine* (set! a0-10 (-> a0-10 next0)) ) ) ) ) (let ((v1-30 (-> *task-manager-engine* alive-list next0))) *task-manager-engine* (-> v1-30 next0) (while (!= v1-30 (-> *task-manager-engine* alive-list-end)) (set! arg1 (the-as process (-> (the-as connection v1-30) param1))) (b! #t cfg-97 :delay (nop!)) (the-as none 0) (the-as none *task-manager-engine*) (the-as none 0) (the-as none 0) (set! v1-30 (the-as connectable (l.wu 0))) ) ) (the-as process #f) ) ((= arg0 '*desert-duststorm*) (handle->process (-> *game-info* dust-storm)) ) ((type? arg0 string) (set! arg1 (process-by-ename (the-as string arg0))) (cond (arg1 (empty) arg1 ) ((-> *setting-control* user-current movie) (let ((s5-1 (ppointer->process (-> *setting-control* user-current movie 0 child)))) (while s5-1 (when (name= arg0 (-> s5-1 name)) (set! arg1 (the-as process s5-1)) (goto cfg-97) ) (set! s5-1 (ppointer->process (-> s5-1 brother))) ) ) (let ((s5-2 (ppointer->process (-> *setting-control* user-current movie 0 child)))) (while s5-2 (let* ((s3-0 s5-2) (s4-0 (if (type? s3-0 process-drawable) s3-0 ) ) ) (format (clear *temp-string*) "~S-lod0" arg0) (let ((s3-2 *temp-string*)) (when (and s4-0 (nonzero? (-> (the-as process-drawable s4-0) draw)) (or (and (nonzero? (-> (the-as process-drawable s4-0) draw art-group)) (string= (the-as string arg0) (-> (the-as process-drawable s4-0) draw art-group name)) ) (and (nonzero? (-> (the-as process-drawable s4-0) draw jgeo)) (string= s3-2 (-> (the-as process-drawable s4-0) draw jgeo name)) ) ) ) (format 0 "WARNING: command-get-process returning art-group or jgeo named ~A~%" arg0) (set! arg1 (the-as process s4-0)) (goto cfg-97) ) ) ) (set! s5-2 (ppointer->process (-> s5-2 brother))) ) ) (the-as process #f) ) (else (let ((v1-76 (process-by-name (the-as string arg0) *active-pool*))) (if v1-76 v1-76 ) ) ) ) ) (else (empty) arg1 ) ) ) (label cfg-97) (the-as process arg1) ) ) ;; WARN: Return type mismatch object vs entity. (defun command-get-entity ((arg0 object) (arg1 entity)) (the-as entity (cond ((null? arg0) (empty) arg1 ) ((type? arg0 process) (-> (the-as process arg0) entity) ) ((type? arg0 entity) (the-as entity arg0) ) ((type? arg0 string) (entity-by-name (the-as string arg0)) ) (else (empty) arg1 ) ) ) ) (defun command-get-trans ((arg0 object) (arg1 vector)) (cond ((or (not arg0) (null? arg0)) (empty) arg1 ) ((= arg0 'null) *null-vector* ) ((= arg0 'target) (target-pos 0) ) ((= (rtype-of arg0) string) (let ((v1-5 (command-get-process arg0 *target*))) (cond ((and v1-5 (nonzero? (-> (the-as process-drawable v1-5) root))) (-> (the-as process-drawable v1-5) root trans) ) (else (empty) arg1 ) ) ) ) ((pair? arg0) (let* ((s3-0 (command-get-process (car arg0) *target*)) (s4-0 (if (type? s3-0 process-drawable) s3-0 ) ) (a1-7 (car (cdr arg0))) ) (cond ((and s4-0 (nonzero? (-> (the-as process-drawable s4-0) draw)) (nonzero? (-> (the-as process-drawable s4-0) node-list)) ) (let ((a0-12 (the-as joint (get-art-by-name-method (-> (the-as process-drawable s4-0) draw jgeo) (the-as string a1-7) (the-as type #f)) ) ) ) (cond (a0-12 (-> (the-as process-drawable s4-0) node-list data (+ (-> a0-12 number) 1) bone transform trans) ) (else (empty) arg1 ) ) ) ) (else (empty) arg1 ) ) ) ) (else (empty) arg1 ) ) ) (defmethod script-context-method-10 ((this script-context) (arg0 object) (arg1 pair)) (let* ((s5-0 (rtype-of arg0)) (s4-0 arg1) (s3-0 (car s4-0)) ) (while (not (null? s4-0)) (cond ((not s3-0) (if (not arg0) (return 'symbol) ) ) (else (let ((a1-1 (-> (the-as symbol s3-0) value))) (if (type-type? s5-0 (the-as type a1-1)) (return s3-0) ) ) ) ) (set! s4-0 (cdr s4-0)) (set! s3-0 (car s4-0)) ) ) #f ) ;; WARN: Return type mismatch object vs pair. (defun key-assoc ((arg0 object) (arg1 pair) (arg2 vector4w)) (set! (-> arg2 dword 0) (the-as uint 0)) (let ((v1-0 arg1)) (while (not (or (null? v1-0) (= (car (car v1-0)) arg0))) (+! (-> arg2 dword 0) 1) (set! v1-0 (cdr v1-0)) ) (the-as pair (if (not (null? v1-0)) (car v1-0) ) ) ) ) (defmethod script-context-method-11 ((this script-context) (arg0 pair) (arg1 pair) (arg2 symbol)) (local-vars (sv-16 symbol) (sv-20 pair) (sv-24 pair) (sv-28 int) (sv-32 int) (sv-40 pair)) (let ((s3-0 (cdr arg1))) (set! sv-16 (the-as symbol #f)) (set! sv-20 arg0) (set! sv-24 s3-0) (set! (-> this param-count) 0) (set! (-> this expr) arg0) (let ((a1-1 (car sv-20)) (s2-0 (car s3-0)) ) (while (not (and (null? sv-20) (null? sv-24))) (cond ((= s2-0 '&rest) (let ((v1-2 (-> this param-count))) (set! (-> this param v1-2) sv-20) (set! (-> this param-type v1-2) 'pair) (set! (-> this param-count) (+ v1-2 1)) ) (return (not sv-16)) ) ((= s2-0 '&key) (set! sv-28 (-> this param-count)) (set! sv-32 0) (set! sv-24 (cdr sv-24)) (let ((v1-11 sv-28)) (let* ((a0-3 sv-24) (a1-6 (car a0-3)) ) (while (not (null? a0-3)) (set! (-> this param v1-11) (car (cdr (cdr (cdr a1-6))))) (let ((a1-13 (-> this param v1-11))) (set! (-> this param-type v1-11) (-> (rtype-of a1-13) symbol)) ) (+! v1-11 1) (set! a0-3 (cdr a0-3)) (set! a1-6 (car a0-3)) ) ) (set! (-> this param-count) v1-11) ) (while (not (null? sv-20)) (set! sv-40 (key-assoc (car sv-20) sv-24 (the-as vector4w (& sv-32)))) (cond (sv-40 (set! sv-20 (cdr sv-20)) (let* ((v1-18 (car (cdr sv-40))) (s3-1 (if (= v1-18 'eval) (eval! this (the-as pair (car sv-20))) (car sv-20) ) ) (s2-1 (+ sv-28 sv-32)) ) (set! (-> this param s2-1) s3-1) (let ((v1-29 (script-context-method-10 this s3-1 (the-as pair (car (cdr (cdr sv-40))))))) (set! (-> this param-type s2-1) v1-29) (when (not v1-29) (set! sv-16 #t) (if arg2 (format 0 "ERROR: SCRIPT: param ~A = ~A is type ~A, needed type ~A.~%" (car sv-40) s3-1 (rtype-of s3-1) (car (cdr (cdr sv-40))) ) ) ) ) ) ) (else (set! sv-16 #t) (if arg2 (format 0 "ERROR: SCRIPT: found unknown keyword ~A in expression ~A.~%" (car sv-20) arg0) ) (set! sv-20 (cdr sv-20)) ) ) (set! sv-20 (cdr sv-20)) ) (return (not sv-16)) ) ((null? s2-0) (if arg2 (format 0 "ERROR: SCRIPT: got too many params matching ~A to ~A~%" arg0 s3-0) ) (return #f) ) ((null? a1-1) (cond ((null? (car (cdr (cdr (cdr s2-0))))) (if arg2 (format 0 "ERROR: SCRIPT: got too few params matching ~A to ~A~%" arg0 s3-0) ) (return #f) ) (else (let ((v1-62 (-> this param-count))) (set! (-> this param v1-62) (car (cdr (cdr (cdr s2-0))))) (let ((a0-28 (-> this param v1-62))) (set! (-> this param-type v1-62) (-> (rtype-of a0-28) symbol)) ) (set! (-> this param-count) (+ v1-62 1)) ) (set! sv-24 (cdr sv-24)) ) ) ) (else (let* ((v1-67 (car (cdr s2-0))) (s0-0 (if (= v1-67 'eval) (eval! this (the-as pair a1-1)) a1-1 ) ) (s1-0 (-> this param-count)) ) (set! (-> this param s1-0) s0-0) (let ((v1-74 (script-context-method-10 this s0-0 (the-as pair (car (cdr (cdr s2-0))))))) (set! (-> this param-type s1-0) v1-74) (when (not v1-74) (set! sv-16 #t) (if arg2 (format 0 "ERROR: SCRIPT: param ~A = ~A is type ~A, needed type ~A.~%" (car s2-0) s0-0 (rtype-of s0-0) (car (cdr (cdr s2-0))) ) ) ) ) (set! (-> this param-count) (+ s1-0 1)) ) (set! sv-20 (cdr sv-20)) (set! sv-24 (cdr sv-24)) ) ) (set! a1-1 (car sv-20)) (set! s2-0 (car sv-24)) ) ) ) (not sv-16) ) (defmethod eval! ((this script-context) (arg0 pair)) (let ((s5-0 (the-as object #f))) (set! (-> this expr) arg0) (case (rtype-of arg0) ((pair) (let* ((s4-0 arg0) (a2-0 (car s4-0)) ) (cond ((null? s4-0) (set! s5-0 '()) ) (else (let ((s3-0 (-> *script-form* 0))) (while (nonzero? (-> s3-0 name)) (when (= a2-0 (-> s3-0 name)) (let ((s2-0 (new 'stack-no-clear 'script-context))) (set! (-> s2-0 load-state) (-> this load-state)) (set! (-> s2-0 key) (-> this key)) (set! (-> s2-0 process) (-> this process)) (set! (-> s2-0 trans) (-> this trans)) (set! (-> s2-0 side-effect?) (-> this side-effect?)) (set! (-> s2-0 got-error?) #f) (cond ((script-context-method-11 s2-0 s4-0 (-> s3-0 spec) #t) (set! (-> s2-0 expr) s4-0) (set! s5-0 ((-> s3-0 func) s2-0)) ) (else (set! (-> s2-0 got-error?) #t) ) ) (set! (-> this got-error?) (or (-> this got-error?) (-> s2-0 got-error?))) ) (goto cfg-23) ) (&+! s3-0 12) ) ) (format 0 "ERROR: SCRIPT: taking the value of unknown symbol ~A in ~A for application.~%" a2-0 s4-0) (set! (-> this got-error?) #t) ) ) ) (label cfg-23) s5-0 ) ((symbol) (let ((a0-8 (the-as object arg0))) (cond ((= (the-as pair a0-8) 'MINIMAP_FLAG_MINIMAP) (set! s5-0 1024) ) ((= (the-as pair a0-8) 'FACT_SUPER_SKILL_INC) (set! s5-0 (* (the int (-> *FACT-bank* super-skill-inc)) 8)) ) ((= (the-as pair a0-8) 'self) (set! s5-0 (-> this process)) ) ((= (the-as pair a0-8) 'key) (set! s5-0 (-> this key)) ) ((= (the-as pair a0-8) '*target*) (set! s5-0 (command-get-process (the-as pair a0-8) *target*)) ) ((= (the-as pair a0-8) '*time-of-day*) (set! s5-0 (ppointer->process *time-of-day*)) ) ((= (the-as pair a0-8) '*task-manager*) (set! s5-0 (command-get-process (the-as pair a0-8) *target*)) ) ((= (the-as pair a0-8) '*desert-duststorm*) (set! s5-0 (command-get-process (the-as pair a0-8) *target*)) ) (else (set! s5-0 (-> (the-as symbol a0-8) value)) ) ) ) s5-0 ) (else arg0 ) ) ) ) (define *script-form* (the-as (inline-array script-form) (malloc 'global 1536))) (let ((v1-13 (-> *script-form* 0))) (set! (-> v1-13 name) 'quote) (set! (-> v1-13 spec) '((return macro (object)) (function macro (symbol)) (value macro (object)))) (set! (-> v1-13 func) (lambda ((arg0 script-context)) (-> arg0 param 1))) ) (let ((v1-15 (-> *script-form* 1))) (set! (-> v1-15 name) 'meters) (set! (-> v1-15 spec) '((return macro (float)) (function macro (symbol)) (value eval (bfloat binteger)))) (set! (-> v1-15 func) (lambda ((arg0 script-context)) (* 4096.0 (command-get-float (-> arg0 param 1) 0.0)))) ) (let ((v1-17 (-> *script-form* 2))) (set! (-> v1-17 name) 'seconds) (set! (-> v1-17 spec) '((return macro (integer)) (function macro (symbol)) (value eval (bfloat binteger)))) (set! (-> v1-17 func) (lambda ((arg0 script-context)) (the int (* 300.0 (command-get-float (-> arg0 param 1) 0.0)))) ) ) (let ((v1-19 (-> *script-form* 3))) (set! (-> v1-19 name) 'secondsf) (set! (-> v1-19 spec) '((return macro (integer)) (function macro (symbol)) (value eval (bfloat binteger)))) (set! (-> v1-19 func) (lambda ((arg0 script-context)) (* 300.0 (command-get-float (-> arg0 param 1) 0.0)))) ) (let ((v1-21 (-> *script-form* 4))) (set! (-> v1-21 name) 'deg) (set! (-> v1-21 spec) '((return macro (integer)) (function macro (symbol)) (value eval (bfloat binteger)))) (set! (-> v1-21 func) (lambda ((arg0 script-context)) (* 182.04445 (command-get-float (-> arg0 param 1) 0.0))) ) ) (let ((v1-23 (-> *script-form* 5))) (set! (-> v1-23 name) 'float) (set! (-> v1-23 spec) '((return macro (float)) (function macro (symbol)) (value eval (bfloat binteger)))) (set! (-> v1-23 func) (lambda ((arg0 script-context)) (command-get-float (-> arg0 param 1) 0.0))) ) (let ((v1-25 (-> *script-form* 6))) (set! (-> v1-25 name) 'int) (set! (-> v1-25 spec) '((return macro (integer)) (function macro (symbol)) (value eval (bfloat binteger)))) (set! (-> v1-25 func) (lambda ((arg0 script-context)) (command-get-int (-> arg0 param 1) 0))) ) (let ((v1-27 (-> *script-form* 7))) (set! (-> v1-27 name) 'begin) (set! (-> v1-27 spec) '((return macro (object)) (function macro (symbol)) &rest body)) (set! (-> v1-27 func) (lambda ((arg0 script-context)) (let ((v0-0 (the-as object #f))) (let* ((s5-0 (-> arg0 param 1)) (a1-0 (-> (the-as pair s5-0) car)) ) (while (not (null? s5-0)) (set! v0-0 (eval! arg0 (the-as pair a1-0))) (set! s5-0 (-> (the-as pair s5-0) cdr)) (set! a1-0 (-> (the-as pair s5-0) car)) ) ) v0-0 ) ) ) ) (let ((v1-29 (-> *script-form* 8))) (set! (-> v1-29 name) 'print) (set! (-> v1-29 spec) '((return macro (object)) (function macro (symbol)) (value eval (object)))) (set! (-> v1-29 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) (printl (-> arg0 param 1)) (-> arg0 param 1) ) ) ) ) (let ((v1-31 (-> *script-form* 9))) (set! (-> v1-31 name) 'if) (set! (-> v1-31 spec) '((return macro (object)) (function macro (symbol)) (condition eval (object)) (if macro (object) ) (else macro (object) #f ) ) ) (set! (-> v1-31 func) (lambda ((arg0 script-context)) (if (-> arg0 param 1) (eval! arg0 (the-as pair (-> arg0 param 2))) (eval! arg0 (the-as pair (-> arg0 param 3))) ) ) ) ) (let ((v1-33 (-> *script-form* 10))) (set! (-> v1-33 name) 'not) (set! (-> v1-33 spec) '((return macro (object)) (function macro (symbol)) (condition eval (object)))) (set! (-> v1-33 func) (lambda ((arg0 script-context)) (not (-> arg0 param 1)))) ) (let ((v1-35 (-> *script-form* 11))) (set! (-> v1-35 name) 'and) (set! (-> v1-35 spec) '((return macro (object)) (function macro (symbol)) &rest body)) (set! (-> v1-35 func) (lambda ((arg0 script-context)) (let ((s5-0 (-> arg0 param 1)) (v0-0 (the-as object #f)) ) (let ((a1-0 (-> (the-as pair s5-0) car))) (while (not (null? s5-0)) (set! v0-0 (eval! arg0 (the-as pair a1-0))) (if (not v0-0) (return #f) ) (set! s5-0 (-> (the-as pair s5-0) cdr)) (set! a1-0 (-> (the-as pair s5-0) car)) ) ) v0-0 ) ) ) ) (let ((v1-37 (-> *script-form* 12))) (set! (-> v1-37 name) 'or) (set! (-> v1-37 spec) '((return macro (object)) (function macro (symbol)) &rest body)) (set! (-> v1-37 func) (lambda ((arg0 script-context)) (let ((s5-0 (-> arg0 param 1))) (let ((a1-0 (-> (the-as pair s5-0) car))) (while (not (null? s5-0)) (let ((v1-2 (eval! arg0 (the-as pair a1-0)))) (if v1-2 (return v1-2) ) ) (set! s5-0 (-> (the-as pair s5-0) cdr)) (set! a1-0 (-> (the-as pair s5-0) car)) ) ) ) #f ) ) ) (let ((v1-39 (-> *script-form* 13))) (set! (-> v1-39 name) 'when) (set! (-> v1-39 spec) '((return macro (object)) (function macro (symbol)) (condition eval (object)) &rest body) ) (set! (-> v1-39 func) (lambda ((arg0 script-context)) (let ((v0-0 (the-as object #f))) (when (-> arg0 param 1) (let* ((s5-0 (-> arg0 param 2)) (a1-0 (-> (the-as pair s5-0) car)) ) (while (not (null? s5-0)) (set! v0-0 (eval! arg0 (the-as pair a1-0))) (set! s5-0 (-> (the-as pair s5-0) cdr)) (set! a1-0 (-> (the-as pair s5-0) car)) ) ) ) v0-0 ) ) ) ) (let ((v1-41 (-> *script-form* 14))) (set! (-> v1-41 name) 'unless) (set! (-> v1-41 spec) '((return macro (object)) (function macro (symbol)) (condition eval (object)) &rest body) ) (set! (-> v1-41 func) (lambda ((arg0 script-context)) (let ((v0-0 (the-as object #f))) (when (not (-> arg0 param 1)) (let* ((s5-0 (-> arg0 param 2)) (a1-0 (-> (the-as pair s5-0) car)) ) (while (not (null? s5-0)) (set! v0-0 (eval! arg0 (the-as pair a1-0))) (set! s5-0 (-> (the-as pair s5-0) cdr)) (set! a1-0 (-> (the-as pair s5-0) car)) ) ) ) v0-0 ) ) ) ) (let ((v1-43 (-> *script-form* 15))) (set! (-> v1-43 name) 'cond) (set! (-> v1-43 spec) '((return macro (object)) (function macro (symbol)) &rest body)) (set! (-> v1-43 func) (lambda ((arg0 script-context)) (let ((gp-0 (the-as object #f))) (let* ((s4-0 (-> arg0 param 1)) (s3-0 (-> (the-as pair s4-0) car)) ) (while (not (null? s4-0)) (when (pair? s3-0) (let ((a1-0 (-> (the-as pair s3-0) car))) (when (or (= a1-0 'else) (eval! arg0 (the-as pair a1-0))) (let* ((s4-1 (-> (the-as pair s3-0) cdr)) (a1-1 (-> (the-as pair s4-1) car)) ) (while (not (null? s4-1)) (set! gp-0 (eval! arg0 (the-as pair a1-1))) (set! s4-1 (-> (the-as pair s4-1) cdr)) (set! a1-1 (-> (the-as pair s4-1) car)) ) ) (set! gp-0 gp-0) (goto cfg-14) ) ) ) (set! s4-0 (-> (the-as pair s4-0) cdr)) (set! s3-0 (-> (the-as pair s4-0) car)) ) ) (label cfg-14) gp-0 ) ) ) ) (let ((v1-45 (-> *script-form* 16))) (set! (-> v1-45 name) 'case) (set! (-> v1-45 spec) '((return macro (object)) (function macro (symbol)) (value eval (object)) &rest body)) (set! (-> v1-45 func) (lambda ((arg0 script-context)) (let ((gp-0 (the-as object #f))) (let* ((s4-0 (-> arg0 param 1)) (s3-0 (-> arg0 param 2)) (s2-0 (-> (the-as pair s3-0) car)) ) (while (not (null? s3-0)) (when (pair? s2-0) (let ((s1-0 (-> (the-as pair s2-0) car))) (when (or (= s1-0 'else) (and (pair? s1-0) (member s4-0 s1-0)) (= s1-0 s4-0)) (let* ((s4-1 (-> (the-as pair s2-0) cdr)) (a1-1 (-> (the-as pair s4-1) car)) ) (while (not (null? s4-1)) (set! gp-0 (eval! arg0 (the-as pair a1-1))) (set! s4-1 (-> (the-as pair s4-1) cdr)) (set! a1-1 (-> (the-as pair s4-1) car)) ) ) (set! gp-0 gp-0) (goto cfg-19) ) ) ) (set! s3-0 (-> (the-as pair s3-0) cdr)) (set! s2-0 (-> (the-as pair s3-0) car)) ) ) (label cfg-19) gp-0 ) ) ) ) (let ((v1-47 (-> *script-form* 17))) (set! (-> v1-47 name) 'set!) (set! (-> v1-47 spec) '((return macro (object)) (function macro (symbol)) (symbol macro (symbol)) (value eval (object))) ) (set! (-> v1-47 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((v0-0 (-> arg0 param 2))) (set! (-> (the-as symbol (-> arg0 param 1)) value) v0-0) v0-0 ) ) ) ) ) (let ((v1-49 (-> *script-form* 18))) (set! (-> v1-49 name) 'eval) (set! (-> v1-49 spec) '((return macro (object)) (function macro (symbol)) (value eval (object)))) (set! (-> v1-49 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) (eval! arg0 (the-as pair (-> arg0 param 1))) ) ) ) ) (let ((v1-51 (-> *script-form* 19))) (set! (-> v1-51 name) 'apply) (set! (-> v1-51 spec) '((return macro (object)) (function macro (symbol)) (value eval (function)))) (set! (-> v1-51 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) ((the-as (function none) (-> arg0 param 1))) ) ) ) ) (let ((v1-53 (-> *script-form* 20))) (set! (-> v1-53 name) '=) (set! (-> v1-53 spec) '((return macro (object)) (function macro (symbol)) (test1 eval (bfloat binteger)) (test2 eval (bfloat binteger)) ) ) (set! (-> v1-53 func) (lambda ((arg0 script-context)) (= (command-get-float (-> arg0 param 1) 0.0) (command-get-float (-> arg0 param 2) 0.0)) ) ) ) (let ((v1-55 (-> *script-form* 21))) (set! (-> v1-55 name) '<=) (set! (-> v1-55 spec) '((return macro (object)) (function macro (symbol)) (test1 eval (bfloat binteger)) (test2 eval (bfloat binteger)) ) ) (set! (-> v1-55 func) (lambda ((arg0 script-context)) (>= (command-get-float (-> arg0 param 2) 0.0) (command-get-float (-> arg0 param 1) 0.0)) ) ) ) (let ((v1-57 (-> *script-form* 22))) (set! (-> v1-57 name) '<) (set! (-> v1-57 spec) '((return macro (object)) (function macro (symbol)) (test1 eval (bfloat binteger)) (test2 eval (bfloat binteger)) ) ) (set! (-> v1-57 func) (lambda ((arg0 script-context)) (< (command-get-float (-> arg0 param 1) 0.0) (command-get-float (-> arg0 param 2) 0.0)) ) ) ) (let ((v1-59 (-> *script-form* 23))) (set! (-> v1-59 name) 'eq?) (set! (-> v1-59 spec) '((return macro (object)) (function macro (symbol)) (test1 eval (object)) (test2 eval (object))) ) (set! (-> v1-59 func) (lambda ((arg0 script-context)) (let ((gp-0 (-> arg0 param 1)) (s5-0 (-> arg0 param 2)) ) (if (and (type? gp-0 string) (type? s5-0 string)) (string= (the-as string gp-0) (the-as string s5-0)) (= gp-0 s5-0) ) ) ) ) ) (let ((v1-61 (-> *script-form* 24))) (set! (-> v1-61 name) 'unbox) (set! (-> v1-61 spec) '((return macro (object)) (function macro (symbol)) (value eval (bfloat binteger)))) (set! (-> v1-61 func) (lambda ((arg0 script-context)) (the-as meters (cond ((not (logtest? (the-as int (-> arg0 param 1)) 7)) (/ (the-as int (-> arg0 param 1)) 8) ) (else (let ((v1-3 bfloat) (a1-0 (-> arg0 param 1)) ) (if (= (rtype-of a1-0) v1-3) (-> (the-as bfloat (-> arg0 param 1)) data) (-> arg0 param 1) ) ) ) ) ) ) ) ) (let ((v1-63 (-> *script-form* 25))) (set! (-> v1-63 name) 'static-vectorm) (set! (-> v1-63 spec) '((return macro (vector)) (function macro (symbol)) (x eval (bfloat binteger)) (y eval (bfloat binteger)) (z eval (bfloat binteger)) ) ) (set! (-> v1-63 func) (lambda ((arg0 script-context)) (let ((s5-0 (new 'static 'vector))) (set-vector! s5-0 (* 4096.0 (command-get-float (-> arg0 param 1) 0.0)) (* 4096.0 (command-get-float (-> arg0 param 2) 0.0)) (* 4096.0 (command-get-float (-> arg0 param 3) 0.0)) 1.0 ) s5-0 ) ) ) ) (defun level-from-heap ((arg0 int)) (dotimes (v1-0 (-> *level* length)) (let ((a1-3 (-> *level* level v1-0))) (when (= (-> a1-3 status) 'active) (let ((a3-1 (-> a1-3 heap base)) (a2-3 (-> a1-3 heap top-base)) ) (if (and (>= arg0 (the-as int a3-1)) (< arg0 (the-as int a2-3))) (return a1-3) ) ) ) ) ) (the-as level #f) ) (let ((v1-66 (-> *script-form* 26))) (set! (-> v1-66 name) 'level-status?) (set! (-> v1-66 spec) '((return macro (symbol)) (function macro (symbol)) (level eval (symbol)))) (set! (-> v1-66 func) (lambda ((arg0 script-context)) (level-status? *level* (the-as symbol (-> arg0 param 1)) #f)) ) ) (let ((v1-68 (-> *script-form* 27))) (set! (-> v1-68 name) 'want-vis) (set! (-> v1-68 spec) '((return macro (none)) (function macro (symbol)) (level eval (symbol)))) (set! (-> v1-68 func) (lambda ((arg0 script-context)) (if (and (-> arg0 side-effect?) (-> *level* border?)) (want-vis-level (-> arg0 load-state) (the-as symbol (-> arg0 param 1))) ) ) ) ) (let ((v1-70 (-> *script-form* 28))) (set! (-> v1-70 name) 'want-load) (set! (-> v1-70 spec) '((return macro (none)) (function macro (symbol)) &rest levels)) (set! (-> v1-70 func) (lambda ((arg0 script-context)) (let ((s5-0 10) (a0-1 (-> arg0 param 1)) ) (cond ((>= s5-0 ((method-of-type (rtype-of a0-1) length) a0-1)) (when (and (-> arg0 side-effect?) (-> *level* border?) (is-load-allowed? *level* (the-as (pointer symbol) (level-from-heap (the-as int (-> arg0 key))))) ) (let ((s5-2 (new 'static 'boxed-array :type symbol :length 0 :allocated-length 10))) (dotimes (s4-1 10) (let ((a1-4 (ref (-> arg0 param 1) s4-1))) (set! (-> s5-2 s4-1) (the-as symbol (if (not (null? a1-4)) (eval! arg0 (the-as pair a1-4)) ) ) ) ) ) (want-levels (-> arg0 load-state) (-> s5-2 data)) ) ) ) (else (format 0 "ERROR: SCRIPT: got too many params to want-load ~A~%" (-> arg0 param 1)) (set! (-> arg0 got-error?) #t) ) ) ) 0 ) ) ) (let ((v1-72 (-> *script-form* 29))) (set! (-> v1-72 name) 'want-sound) (set! (-> v1-72 spec) '((return macro (none)) (function macro (symbol)) &rest sounds)) (set! (-> v1-72 func) (lambda ((arg0 script-context)) (let ((s5-0 3) (a0-1 (-> arg0 param 1)) ) (cond ((>= s5-0 ((method-of-type (rtype-of a0-1) length) a0-1)) (when (and (-> arg0 side-effect?) (-> *level* border?) (is-load-allowed? *level* (the-as (pointer symbol) (level-from-heap (the-as int (-> arg0 key))))) ) (let ((s5-2 (new 'static 'boxed-array :type symbol :length 0 :allocated-length 3))) (dotimes (s4-1 3) (let ((a1-4 (ref (-> arg0 param 1) s4-1))) (set! (-> s5-2 s4-1) (the-as symbol (if (not (null? a1-4)) (eval! arg0 (the-as pair a1-4)) ) ) ) ) ) (want-sound-banks (-> arg0 load-state) (-> s5-2 data)) ) ) ) (else (format 0 "ERROR: SCRIPT: got too many params to want-sound ~A~%" (-> arg0 param 1)) (set! (-> arg0 got-error?) #t) ) ) ) 0 ) ) ) (let ((v1-74 (-> *script-form* 30))) (set! (-> v1-74 name) 'want-display) (set! (-> v1-74 spec) '((return macro (none)) (function macro (symbol)) (level eval (symbol)) (mode eval (symbol) display)) ) (set! (-> v1-74 func) (lambda ((arg0 script-context)) (if (and (-> arg0 side-effect?) (-> *level* border?) (is-load-allowed? *level* (the-as (pointer symbol) (level-from-heap (the-as int (-> arg0 key))))) ) (want-display-level (-> arg0 load-state) (the-as symbol (-> arg0 param 1)) (the-as symbol (-> arg0 param 2))) ) 0 ) ) ) (let ((v1-76 (-> *script-form* 31))) (set! (-> v1-76 name) 'want-force-vis) (set! (-> v1-76 spec) '((return macro (none)) (function macro (symbol)) (level eval (symbol)) (mode eval (symbol) #t)) ) (set! (-> v1-76 func) (lambda ((arg0 script-context)) (if (and (-> arg0 side-effect?) (-> *level* border?)) (want-force-vis (-> arg0 load-state) (the-as symbol (-> arg0 param 1)) (the-as symbol (-> arg0 param 2))) ) 0 ) ) ) (let ((v1-78 (-> *script-form* 32))) (set! (-> v1-78 name) 'want-force-inside) (set! (-> v1-78 spec) '((return macro (none)) (function macro (symbol)) (level eval (symbol)) (mode eval (symbol) #t)) ) (set! (-> v1-78 func) (lambda ((arg0 script-context)) (if (and (-> arg0 side-effect?) (-> *level* border?)) (want-force-inside (-> arg0 load-state) (the-as symbol (-> arg0 param 1)) (the-as symbol (-> arg0 param 2))) ) 0 ) ) ) (let ((v1-80 (-> *script-form* 33))) (set! (-> v1-80 name) 'want-continue) (set! (-> v1-80 spec) '((return macro (none)) (function macro (symbol)) (continue-point eval (string)))) (set! (-> v1-80 func) (lambda ((arg0 script-context)) (when (and (-> arg0 side-effect?) (-> *setting-control* user-current allow-continue)) (set-continue! *game-info* (the-as basic (-> arg0 param 1)) #f) (send-event *target* 'want-continue (-> arg0 param 1)) ) 0 ) ) ) (let ((v1-82 (-> *script-form* 34))) (set! (-> v1-82 name) 'want-vehicle) (set! (-> v1-82 spec) '((return macro (none)) (function macro (symbol)) (vehicle eval (string)) &key (force eval (symbol) #t)) ) (set! (-> v1-82 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (if (and (not (-> arg0 param 2)) (= (-> *game-info* current-vehicle) (vehicle-type-u8 vt27))) (return (the-as object 0)) ) (let ((gp-0 (-> arg0 param 1))) (cond ((string= (the-as string gp-0) "turtle") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-turtle)) ) ((string= (the-as string gp-0) "scorpion") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-scorpion)) ) ((string= (the-as string gp-0) "toad") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-toad)) ) ((string= (the-as string gp-0) "snake") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-snake)) ) ((string= (the-as string gp-0) "rhino") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-rhino)) ) ((string= (the-as string gp-0) "fox") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-fox)) ) ((string= (the-as string gp-0) "mirage") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-mirage)) ) ((string= (the-as string gp-0) "x-ride") (set! (-> *game-info* current-vehicle) (vehicle-type-u8 v-x-ride)) ) ) ) ) 0 ) ) ) (let ((v1-84 (-> *script-form* 35))) (set! (-> v1-84 name) 'want-anim) (set! (-> v1-84 spec) '((return macro (none)) (function macro (symbol)) (name eval (string)))) (set! (-> v1-84 func) (lambda ((arg0 script-context)) "we want to preload this anim." (if (-> arg0 side-effect?) (gui-control-method-12 *gui-control* (-> arg0 process) (gui-channel art-load) (gui-action queue) (the-as string (-> arg0 param 1)) 0 -1.0 (new 'static 'sound-id) ) ) 0 ) ) ) (let ((v1-86 (-> *script-form* 36))) (set! (-> v1-86 name) 'send-event) (set! (-> v1-86 spec) '((return macro (object)) (function macro (symbol)) (target eval (string symbol process entity-actor actor-group #f binteger)) (message eval (symbol)) &rest params ) ) (set! (-> v1-86 func) (lambda ((arg0 script-context)) (local-vars (sv-96 (function script-context pair object))) (when (-> arg0 side-effect?) (let ((gp-0 (command-get-process (-> arg0 param 1) (the-as process #f))) (s5-0 (new 'stack-no-clear 'event-message-block)) (s2-0 (-> arg0 param 3)) (s4-0 (the-as object #f)) ) (when gp-0 (set! (-> s5-0 from) (process->ppointer (-> arg0 process))) (set! (-> s5-0 message) (the-as symbol (-> arg0 param 2))) (let ((a0-3 s2-0)) (set! (-> s5-0 num-params) ((method-of-type (rtype-of a0-3) length) a0-3)) ) (dotimes (s1-0 (-> s5-0 num-params)) (let ((s0-0 arg0)) (set! sv-96 (method-of-type script-context eval!)) (let ((a1-4 (ref s2-0 s1-0))) (set! (-> s5-0 param s1-0) (the-as uint (sv-96 s0-0 (the-as pair a1-4)))) ) ) ) (cond ((= (-> gp-0 type) actor-group) (dotimes (s3-1 (the-as int (-> gp-0 name))) (let ((t9-4 send-event-function) (v1-18 (the-as object (-> (the-as (pointer uint32) (+ (+ (* s3-1 8) 12) (the-as int gp-0)))))) ) (set! s4-0 (t9-4 (if (the-as uint v1-18) (-> (the-as process v1-18) child 3) ) s5-0 ) ) ) ) ) (else (set! s4-0 (send-event-function gp-0 s5-0)) ) ) ) s4-0 ) ) ) ) ) (let ((v1-88 (-> *script-form* 37))) (set! (-> v1-88 name) 'send-event-attack) (set! (-> v1-88 spec) '((return macro (object)) (function macro (symbol)) (target eval (string process entity-actor actor-group #f binteger)) (none macro (object)) &key (mode eval (symbol) generic) (message eval (symbol) attack) ) ) (set! (-> v1-88 func) (lambda ((arg0 script-context)) (with-pp (when (-> arg0 side-effect?) (let ((s5-0 (command-get-process (-> arg0 param 1) (the-as process #f))) (v0-0 (the-as object #f)) ) (when s5-0 (cond ((= (-> s5-0 type) actor-group) (dotimes (s4-0 (the-as int (-> s5-0 name))) (let ((a1-1 (new 'stack-no-clear 'event-message-block))) (set! (-> a1-1 from) (process->ppointer pp)) (set! (-> a1-1 num-params) 2) (set! (-> a1-1 message) (the-as symbol (-> arg0 param 4))) (set! (-> a1-1 param 0) (the-as uint #f)) (set! (-> a1-1 param 1) (the-as uint (static-attack-info :mask (vehicle-impulse-factor) ((id (new-attack-id)) (damage 2.0) (vehicle-damage-factor 1.0) (vehicle-impulse-factor 1.0) (mode (the-as symbol (-> arg0 param 3))) ) ) ) ) (let ((t9-1 send-event-function) (v1-10 (the-as object (-> (the-as (pointer uint32) (+ (+ (* s4-0 8) 12) (the-as int s5-0)))))) ) (set! v0-0 (t9-1 (if (the-as uint v1-10) (-> (the-as process v1-10) child 3) ) a1-1 ) ) ) ) ) ) (else (let ((a1-2 (new 'stack-no-clear 'event-message-block))) (set! (-> a1-2 from) (process->ppointer pp)) (set! (-> a1-2 num-params) 2) (set! (-> a1-2 message) (the-as symbol (-> arg0 param 4))) (set! (-> a1-2 param 0) (the-as uint #f)) (set! (-> a1-2 param 1) (the-as uint (static-attack-info :mask (vehicle-impulse-factor) ((id (new-attack-id)) (damage 2.0) (vehicle-damage-factor 1.0) (vehicle-impulse-factor 1.0) (mode (the-as symbol (-> arg0 param 3))) ) ) ) ) (set! v0-0 (send-event-function s5-0 a1-2)) ) ) ) ) v0-0 ) ) ) ) ) ) (let ((v1-90 (-> *script-form* 38))) (set! (-> v1-90 name) 'focus-test?) (set! (-> v1-90 spec) '((return macro (symbol)) (function macro (symbol)) (target eval (string process entity-actor actor-group #f binteger)) &rest params ) ) (set! (-> v1-90 func) (lambda ((arg0 script-context)) (let* ((s4-0 (command-get-process (-> arg0 param 1) (the-as process #f))) (gp-0 (if (type? s4-0 process-focusable) (the-as process-focusable s4-0) ) ) ) (when gp-0 (let* ((s5-1 (-> arg0 param 2)) (v1-0 (-> (the-as pair s5-1) car)) ) (while (not (null? s5-1)) (cond ((logtest? (the-as int v1-0) 1) (cond ((= v1-0 'board) (if (focus-test? gp-0 board) (return #t) ) ) ((= v1-0 'gun) (if (focus-test? gp-0 gun) (return #t) ) ) ((= v1-0 'mech) (if (focus-test? gp-0 mech) (return #t) ) ) ((= v1-0 'pilot) (if (focus-test? gp-0 pilot) (return #t) ) ) ((= v1-0 'grabbed) (if (focus-test? gp-0 grabbed) (return #t) ) ) ((= v1-0 'indax) (if (focus-test? gp-0 indax) (return #t) ) ) ((= v1-0 'hang) (if (and (= (-> gp-0 type) target) (logtest? (state-flags hang) (-> gp-0 state-flags))) (return #t) ) ) ((= v1-0 'flut) (if (focus-test? gp-0 flut) (return #t) ) ) ((= v1-0 'dark) (if (focus-test? gp-0 dark) (return #t) ) ) ((= v1-0 'light) (if (focus-test? gp-0 light) (return #t) ) ) ((= v1-0 'tube) (if (focus-test? gp-0 tube) (return #t) ) ) ((= v1-0 'invisible) (if (and (= (-> gp-0 type) target) (logtest? (state-flags invisible) (-> gp-0 state-flags))) (return #t) ) ) ) ) (else (format 0 "ERROR: SCRIPT: param bit = ~A is type ~A, needed type ~A.~%" v1-0 (rtype-of v1-0) 'symbol) ) ) (set! s5-1 (-> (the-as pair s5-1) cdr)) (set! v1-0 (-> (the-as pair s5-1) car)) ) ) #f ) ) ) ) ) (let ((v1-92 (-> *script-form* 39))) (set! (-> v1-92 name) 'game-feature!) (set! (-> v1-92 spec) '((return macro (none)) (function macro (symbol)) (feature macro (symbol)) (value eval (symbol))) ) (set! (-> v1-92 func) (lambda ((arg0 script-context)) (case (-> arg0 param 1) (('board) (if (-> arg0 param 2) (logior! (-> *game-info* features) (game-feature board)) (logclear! (-> *game-info* features) (game-feature board)) ) ) (else (format 0 "ERROR: SCRIPT: unknown feature type ~A~%" (-> arg0 param 1)) ) ) (the-as symbol 0) ) ) ) (let ((v1-94 (-> *script-form* 40))) (set! (-> v1-94 name) 'game-feature?) (set! (-> v1-94 spec) '((return macro (boolean)) (function macro (symbol)) (feature macro (symbol)))) (set! (-> v1-94 func) (lambda ((arg0 script-context)) (case (-> arg0 param 1) (('board) (logtest? (game-feature board) (-> *game-info* features)) ) (else (format 0 "ERROR: SCRIPT: unknown feature type ~A~%" (-> arg0 param 1)) #f ) ) ) ) ) (let ((v1-96 (-> *script-form* 41))) (set! (-> v1-96 name) 'entity-status?) (set! (-> v1-96 spec) '((return macro (symbol)) (function macro (symbol)) (target eval (string process entity-actor actor-group #f binteger)) &rest params ) ) (set! (-> v1-96 func) (lambda ((arg0 script-context)) (let ((v1-0 (command-get-entity (-> arg0 param 1) (the-as entity #f)))) (when v1-0 (let* ((gp-1 (-> arg0 param 2)) (s5-0 (-> v1-0 extra perm status)) (v1-2 (-> (the-as pair gp-1) car)) ) (while (not (null? gp-1)) (cond ((logtest? (the-as int v1-2) 1) (cond ((or (= v1-2 'no-birth) (= v1-2 'dead)) (if (logtest? s5-0 (entity-perm-status dead)) (return #t) ) ) ((= v1-2 'subtask-complete) (if (logtest? s5-0 (entity-perm-status subtask-complete bit-12)) (return #t) ) ) ) ) (else (format 0 "ERROR: SCRIPT: param bit = ~A is type ~A, needed type ~A.~%" v1-2 (rtype-of v1-2) 'symbol) ) ) (set! gp-1 (-> (the-as pair gp-1) cdr)) (set! v1-2 (-> (the-as pair gp-1) car)) ) ) #f ) ) ) ) ) (let ((v1-98 (-> *script-form* 42))) (set! (-> v1-98 name) 'entity-status!) (set! (-> v1-98 spec) '((return macro (none)) (function macro (symbol)) (target eval (string process entity-actor actor-group #f binteger)) (value eval (symbol)) &rest params ) ) (set! (-> v1-98 func) (lambda ((arg0 script-context)) (let ((s5-0 (command-get-entity (-> arg0 param 1) (the-as entity #f)))) (when s5-0 (let ((s4-0 (-> arg0 param 3))) (-> s5-0 extra perm status) (let ((v1-3 (-> (the-as pair s4-0) car))) (while (not (null? s4-0)) (cond ((logtest? (the-as int v1-3) 1) (if (= v1-3 'subtask-complete) (toggle-status (the-as entity-actor s5-0) (entity-perm-status subtask-complete) (the-as symbol (-> arg0 param 2)) ) ) ) (else (format 0 "ERROR: SCRIPT: param bit = ~A is type ~A, needed type ~A.~%" v1-3 (rtype-of v1-3) 'symbol) ) ) (set! s4-0 (-> (the-as pair s4-0) cdr)) (set! v1-3 (-> (the-as pair s4-0) car)) ) ) ) ) ) 0 ) ) ) (let ((v1-100 (-> *script-form* 43))) (set! (-> v1-100 name) 'setting-set) (set! (-> v1-100 spec) '((return macro (none)) (function macro (symbol)) (setting macro (symbol)) &key (mode eval (object)) (value eval (bfloat)) (mask eval (binteger)) ) ) (set! (-> v1-100 func) (lambda ((arg0 script-context)) " '(setting-set bg-a :mode 'abs :value 1.0) " (if (-> arg0 side-effect?) (add-setting *setting-control* (-> arg0 process) (the-as symbol (-> arg0 param 1)) (-> arg0 param 2) (command-get-float (-> arg0 param 3) 0.0) (command-get-int (-> arg0 param 4) 0) ) ) ) ) ) (let ((v1-102 (-> *script-form* 44))) (set! (-> v1-102 name) 'setting-reset) (set! (-> v1-102 spec) '((return macro (none)) (function macro (symbol)) (setting macro (symbol)) &key (mode eval (object)) (value eval (bfloat)) (mask eval (binteger)) ) ) (set! (-> v1-102 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) (set-setting *setting-control* (-> arg0 process) (the-as symbol (-> arg0 param 1)) (-> arg0 param 2) (command-get-float (-> arg0 param 3) 0.0) (command-get-int (-> arg0 param 4) 0) ) ) ) ) ) (let ((v1-104 (-> *script-form* 45))) (set! (-> v1-104 name) 'setting-pers) (set! (-> v1-104 spec) '((return macro (none)) (function macro (symbol)) (setting macro (symbol)) &key (mode eval (object) #f) (value macro (bfloat pair) (new 'static 'bfloat)) (mask eval (binteger) 0) (time macro (pair) 0) ) ) (set! (-> v1-104 func) (lambda ((arg0 script-context)) " (setting-pers ambient-volume :mode 'rel :value 0.5) " (local-vars (sv-16 pair) (sv-24 object) (sv-32 float) (sv-48 float)) (when (-> arg0 side-effect?) (set! sv-16 (-> arg0 expr)) (set! sv-24 (eval! arg0 (the-as pair (-> arg0 param 5)))) (set! sv-32 (the-as float (if (pair? (-> arg0 param 3)) (eval! arg0 (the-as pair (-> arg0 param 3))) (command-get-float (-> arg0 param 3) 0.0) ) ) ) (let* ((s5-0 *setting-control*) (s4-0 (method-of-object s5-0 persist-with-delay)) (s3-0 sv-16) (s2-0 sv-24) (s1-0 (-> arg0 param 1)) (s0-0 (-> arg0 param 2)) ) (set! sv-48 sv-32) (let ((t2-0 (command-get-int (-> arg0 param 4) 0))) (s4-0 s5-0 (the-as symbol s3-0) (the-as time-frame s2-0) (the-as symbol s1-0) (the-as symbol s0-0) sv-48 t2-0) ) ) ) ) ) ) (let ((v1-106 (-> *script-form* 46))) (set! (-> v1-106 name) 'setting-unset) (set! (-> v1-106 spec) '((return macro (none)) (function macro (symbol)) (setting macro (symbol)))) (set! (-> v1-106 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) (remove-setting *setting-control* (-> arg0 process) (the-as symbol (-> arg0 param 1))) ) ) ) ) (let ((v1-108 (-> *script-form* 47))) (set! (-> v1-108 name) 'setting-value) (set! (-> v1-108 spec) '((return macro (object)) (function macro (symbol)) (setting macro (symbol)) &key (min eval (bfloat binteger) (new 'static 'bfloat)) (max eval (bfloat binteger) (new 'static 'bfloat :data 1.0)) ) ) (set! (-> v1-108 func) (lambda ((arg0 script-context)) "return the value of a setting." (case (-> arg0 param 1) (('entity-name) (-> *setting-control* cam-current entity-name) ) (('airlock) (-> *setting-control* user-current airlock) ) (('dynamic-ambient-volume) (let ((s5-0 (the-as object (new 'static 'bfloat)))) (let ((f30-0 (-> *setting-control* user-current dynamic-ambient-volume))) (set! (-> (the-as bfloat s5-0) data) (lerp-scale (command-get-float (-> arg0 param 2) 0.0) (command-get-float (-> arg0 param 3) 0.0) f30-0 0.0 1.0) ) ) s5-0 ) ) (('exclusive-task) (* (-> *setting-control* user-current exclusive-task 0) 8) ) ) ) ) ) (let ((v1-110 (-> *script-form* 48))) (set! (-> v1-110 name) 'setting-update) (set! (-> v1-110 spec) '((return macro (none)) (function macro (symbol)))) (set! (-> v1-110 func) (lambda ((arg0 script-context)) "update settings" (if (-> arg0 side-effect?) (apply-settings *setting-control*) ) 0 ) ) ) (let ((v1-112 (-> *script-form* 49))) (set! (-> v1-112 name) 'sound-play) (set! (-> v1-112 spec) '((return macro (none)) (function macro (symbol)) (name eval (string)) &key (volume eval (bfloat binteger) (new 'static 'bfloat :data 1.0)) (pitch-mod eval (bfloat binteger) (new 'static 'bfloat)) (bend eval (bfloat binteger) (new 'static 'bfloat)) (trans eval (vector) #f) (ground-effect (symbol) #t) ) ) (set! (-> v1-112 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((s5-0 sound-play-by-name) (s4-0 (string->sound-name (the-as string (-> arg0 param 1)))) (s3-0 (new-sound-id)) (s2-0 (the int (* 1024.0 (command-get-float (-> arg0 param 2) 0.0)))) (s1-0 (the int (* 1524.0 (command-get-float (-> arg0 param 3) 0.0)))) (t0-0 (the int (* 327.66998 (command-get-float (-> arg0 param 4) 0.0)))) (t1-0 0) (t2-0 (-> arg0 param 5)) ) (set! t2-0 (cond (t2-0 (empty) t2-0 ) (else (-> arg0 trans) ) ) ) (s5-0 s4-0 s3-0 s2-0 s1-0 t0-0 (the-as sound-group t1-0) t2-0) ) ) ) ) ) (let ((v1-114 (-> *script-form* 50))) (set! (-> v1-114 name) 'sound-play-loop) (set! (-> v1-114 spec) '((return macro (none)) (function macro (symbol)) (name eval (string)) &key (volume eval (bfloat binteger) (new 'static 'bfloat :data 1.0)) (pitch-mod eval (bfloat binteger) (new 'static 'bfloat)) (bend eval (bfloat binteger) (new 'static 'bfloat)) (trans eval (vector) #f) ) ) (set! (-> v1-114 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((s3-0 (schedule-callback *sound-loop-engine* (-> arg0 expr) 0))) (when s3-0 (if (zero? (-> s3-0 param-int64 0)) (set! (-> s3-0 param-int64 0) (the-as int (new-sound-id))) ) (let ((s5-0 sound-play-by-name) (s4-0 (string->sound-name (the-as string (-> arg0 param 1)))) (s3-1 (-> s3-0 param-int64 0)) (s2-0 (the int (* 1024.0 (command-get-float (-> arg0 param 2) 0.0)))) (a3-0 (the int (* 1524.0 (command-get-float (-> arg0 param 3) 0.0)))) (t0-0 0) (t1-0 0) (t2-0 (-> arg0 param 5)) ) (set! t2-0 (cond (t2-0 (empty) t2-0 ) (else (-> arg0 trans) ) ) ) (s5-0 s4-0 (the-as sound-id s3-1) s2-0 a3-0 t0-0 (the-as sound-group t1-0) t2-0) ) ) ) ) ) ) ) (let ((v1-116 (-> *script-form* 51))) (set! (-> v1-116 name) 'blackout) (set! (-> v1-116 spec) '((return macro (none)) (function macro (symbol)) (time macro (binteger bfloat pair)))) (set! (-> v1-116 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((a2-0 (if (pair? (-> arg0 param 1)) (the-as int (command-get-time (-> arg0 param 1) 1)) (the int (* 5.0000005 (the float (command-get-int (-> arg0 param 1) 0)))) ) ) ) (persist-with-delay *setting-control* 'blackout (the-as time-frame a2-0) 'bg-a-force 'abs 1.0 0) ) ) ) ) ) (let ((v1-118 (-> *script-form* 52))) (set! (-> v1-118 name) 'fadeout) (set! (-> v1-118 spec) '((return macro (none)) (function macro (symbol)) (time macro (binteger bfloat pair)))) (set! (-> v1-118 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((gp-0 (command-get-time (-> arg0 param 1) 1))) (persist-with-delay *setting-control* 'bg-a-speed (+ gp-0 (seconds 1)) 'bg-a-speed 'abs (/ 300.0 (the float gp-0)) 0 ) (persist-with-delay *setting-control* 'bg-a (+ gp-0 (seconds 1)) 'bg-a 'abs 1.0 0) ) ) 0 ) ) ) (let ((v1-120 (-> *script-form* 53))) (set! (-> v1-120 name) 'fadein) (set! (-> v1-120 spec) '((return macro (none)) (function macro (symbol)) (time macro (binteger bfloat pair)))) (set! (-> v1-120 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((gp-0 (command-get-time (-> arg0 param 1) 1))) (set! (-> *setting-control* user-current bg-a) 1.0) (apply-settings *setting-control*) (persist-with-delay *setting-control* 'bg-a-speed (+ gp-0 (seconds 1)) 'bg-a-speed 'abs (/ 300.0 (the float gp-0)) 0 ) ) ) 0 ) ) ) (let ((v1-122 (-> *script-form* 54))) (set! (-> v1-122 name) 'time-of-day) (set! (-> v1-122 spec) '((return macro (none)) (function macro (symbol)) (value eval (binteger bfloat)))) (set! (-> v1-122 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((v1-1 (command-get-int (-> arg0 param 1) 0))) (cond ((< v1-1 0) (send-event (ppointer->process *time-of-day*) 'change 'ratio 1.0) ) (else (send-event (ppointer->process *time-of-day*) 'change 'hour v1-1) (send-event (ppointer->process *time-of-day*) 'change 'ratio 0.0) ) ) ) ) ) ) ) (let ((v1-124 (-> *script-form* 55))) (set! (-> v1-124 name) 'time-of-day?) (set! (-> v1-124 spec) '((return macro (boolean)) (function macro (symbol)) (value macro (symbol)))) (set! (-> v1-124 func) (lambda ((arg0 script-context)) (with-pp (let ((a1-0 (new 'stack-no-clear 'event-message-block))) (set! (-> a1-0 from) (process->ppointer pp)) (set! (-> a1-0 num-params) 0) (set! (-> a1-0 message) 'hour) (let ((v1-4 (send-event-function (ppointer->process *time-of-day*) a1-0))) (case (-> arg0 param 1) (('night) (or (>= (the-as int v1-4) 18) (< (the-as int v1-4) 6)) ) (('day) (and (>= (the-as int v1-4) 6) (< (the-as int v1-4) 18)) ) (('dawn) (and (>= (the-as int v1-4) 4) (< (the-as int v1-4) 7)) ) (('dusk) (and (>= (the-as int v1-4) 16) (< (the-as int v1-4) 19)) ) (else (format 0 "ERROR: SCRIPT: unknown time-of-day? test '~A'~%" (-> arg0 param 1)) ) ) ) ) ) ) ) ) (let ((v1-126 (-> *script-form* 56))) (set! (-> v1-126 name) 'region-prim) (set! (-> v1-126 spec) '((return macro (drawable-region-prim)) (function macro (symbol)) (id eval (binteger))) ) (set! (-> v1-126 func) (lambda ((arg0 script-context)) "lookup a region by number and return the region-prim." (region-prim-lookup-by-id (command-get-int (-> arg0 param 1) 0) #f 0) ) ) ) (let ((v1-128 (-> *script-form* 57))) (set! (-> v1-128 name) 'region) (set! (-> v1-128 spec) '((return macro (drawable-region-prim)) (function macro (symbol)) (id eval (binteger))) ) (set! (-> v1-128 func) (lambda ((arg0 script-context)) "lookup a region by number and return the region-prim." (region-lookup-by-id (command-get-int (-> arg0 param 1) 0)) ) ) ) (let ((v1-130 (-> *script-form* 58))) (set! (-> v1-130 name) 'part-tracker) (set! (-> v1-130 spec) '((return macro (none)) (function macro (symbol)) (name eval (string)) &key (entity eval (string process entity-actor drawable-region-prim #f) #f) (joint eval (string) #f) (track eval (symbol) #f) (duration macro (object) 0) (subsample-num eval (binteger bfloat) (new 'static 'bfloat)) (parent eval (symbol) unknown) ) ) (set! (-> v1-130 func) (lambda ((arg0 script-context)) " spawn a part tracker. If the :entity is given, do it at that process's location. Otherwise use the (-> context process), if not that then the (-> context trans). " (local-vars (a1-17 process-tree) (a1-21 process-tree) (sv-80 sparticle-launch-group) (sv-84 process) (sv-88 entity) (sv-92 drawable-region-prim) (sv-96 matrix) (sv-104 int) (sv-112 object) (sv-120 time-frame) ) (the-as symbol (when (-> arg0 side-effect?) (if (not (-> arg0 param 2)) (set! (-> arg0 param 2) (-> arg0 process)) ) (set! sv-80 (if (type? (-> arg0 param 1) string) (lookup-part-group-by-name (the-as string (-> arg0 param 1))) (the-as sparticle-launch-group #f) ) ) (let ((gp-0 (command-get-process (-> arg0 param 2) (the-as process #f)))) (set! sv-84 (if (type? gp-0 process-drawable) gp-0 ) ) ) (set! sv-88 (the-as entity #f)) (set! sv-92 (the-as drawable-region-prim #f)) (set! sv-96 (matrix-identity! (new 'stack-no-clear 'matrix))) (set! sv-104 0) (set! sv-112 (-> arg0 param 4)) (set! sv-120 (command-get-time (-> arg0 param 5) 1)) (let* ((s4-0 sv-80) (gp-1 (if (type? s4-0 sparticle-launch-group) s4-0 ) ) (v1-8 (-> arg0 param 2)) (s4-1 (and (= (rtype-of v1-8) string) (string= (the-as string (-> arg0 param 2)) "zero"))) ) (cond (gp-1 (when (not sv-84) (set! sv-112 #f) (set! sv-88 (command-get-entity (-> arg0 param 2) (the-as entity #f))) (when (not sv-88) (let ((s3-0 (-> arg0 param 2))) (set! sv-92 (if (type? s3-0 drawable-region-prim) (the-as drawable-region-prim s3-0) ) ) ) ) ) (if (and (not sv-84) (and (not sv-88) (-> arg0 param 2) (not s4-1))) (format 0 "ERROR: SCRIPT: part-tracker: unknown entity ~A in:~%~T~A~%" (-> arg0 param 2) (-> arg0 expr)) ) (when (or sv-84 sv-88 sv-92 (-> arg0 trans) s4-1) (cond ((and sv-84 (nonzero? (-> (the-as process-drawable sv-84) root))) (let ((a1-10 (-> arg0 param 3))) (cond (a1-10 (let ((v1-33 (if (nonzero? (-> (the-as process-drawable sv-84) draw)) (the-as joint (get-art-by-name-method (-> (the-as process-drawable sv-84) draw jgeo) (the-as string a1-10) (the-as type #f)) ) ) ) ) (cond (v1-33 (set! sv-104 (+ (-> v1-33 number) 1)) (let ((a1-11 (-> (the-as process-drawable sv-84) node-list data sv-104))) (let* ((v1-42 sv-96) (t0-0 (-> a1-11 bone transform)) (a0-22 (-> t0-0 rvec quad)) (a2-2 (-> t0-0 uvec quad)) (a3-1 (-> t0-0 fvec quad)) (t0-1 (-> t0-0 trans quad)) ) (set! (-> v1-42 rvec quad) a0-22) (set! (-> v1-42 uvec quad) a2-2) (set! (-> v1-42 fvec quad) a3-1) (set! (-> v1-42 trans quad) t0-1) ) (vector<-cspace! (-> sv-96 trans) a1-11) ) ) (else (format 0 "ERROR: SCRIPT: part-tracker: unknown joint ~A in:~%~T~A~%" (-> arg0 param 3) (-> arg0 expr)) (set! (-> sv-96 trans quad) (-> (the-as process-drawable sv-84) root trans quad)) ) ) ) ) (else (set! (-> sv-96 trans quad) (-> (the-as process-drawable sv-84) root trans quad)) ) ) ) ) (sv-88 (set! (-> sv-96 trans quad) (-> sv-88 extra trans quad)) ) (sv-92 (set! (-> sv-96 trans quad) (-> sv-92 bsphere quad)) ) (s4-1 (set! (-> sv-96 trans quad) (-> *null-vector* quad)) ) (else (set! (-> sv-96 trans quad) (-> arg0 trans quad)) ) ) ) (when (logtest? (-> sv-80 flags) (sp-group-flag sp2)) (let* ((a2-4 sv-96) (a3-3 *identity-matrix*) (v1-63 (-> a3-3 rvec quad)) (a0-44 (-> a3-3 uvec quad)) (a1-13 (-> a3-3 fvec quad)) (a3-4 (-> a3-3 trans quad)) ) (set! (-> a2-4 rvec quad) v1-63) (set! (-> a2-4 uvec quad) a0-44) (set! (-> a2-4 fvec quad) a1-13) (set! (-> a2-4 trans quad) a3-4) ) ) (cond ((logtest? (-> sv-80 flags) (sp-group-flag sp13)) (let ((s4-2 (new 'stack-no-clear 'part-tracker-subsampler-init-params)) (f30-0 (command-get-float (-> arg0 param 6) 0.0)) (s3-1 (get-process *default-dead-pool* part-tracker-subsampler #x4000 1)) ) (when s3-1 (let ((t9-16 (method-of-type part-tracker-subsampler activate)) (a0-47 s3-1) ) (set! a1-17 (cond ((or sv-112 (= (-> arg0 param 7) #t)) sv-84 ) ((= (-> arg0 param 7) #f) *entity-pool* ) (else (set! a1-17 (ppointer->process (-> *setting-control* user-current movie))) (cond ((the-as process a1-17) (empty) a1-17 ) (else *entity-pool* ) ) ) ) ) (t9-16 (the-as part-tracker-subsampler a0-47) a1-17 "part-tracker-subsampler" (the-as pointer #x70004000)) ) (let ((t9-17 run-function-in-process) (a0-48 s3-1) (a1-18 part-tracker-subsampler-init) ) (set! (-> s4-2 group) gp-1) (set! (-> s4-2 duration) sv-120) (set! (-> s4-2 callback) #f) (set! (-> s4-2 userdata) (the-as uint #f)) (set! (-> s4-2 target) (the-as process-drawable (if sv-112 sv-84 (the-as process #f) ) ) ) (set! (-> s4-2 mat-joint) (if sv-112 sv-104 sv-96 ) ) (set! (-> s4-2 subsample-num) f30-0) ((the-as (function object object object none) t9-17) a0-48 a1-18 s4-2) ) (-> s3-1 ppointer) ) ) ) (else (let ((s4-3 (new 'stack-no-clear 'part-tracker-init-params)) (s3-2 (get-process *default-dead-pool* part-tracker #x4000 1)) ) (when s3-2 (let ((t9-19 (method-of-type part-tracker activate)) (a0-50 s3-2) ) (set! a1-21 (cond ((or sv-112 (= (-> arg0 param 7) #t)) sv-84 ) ((= (-> arg0 param 7) #f) *entity-pool* ) (else (set! a1-21 (ppointer->process (-> *setting-control* user-current movie))) (cond ((the-as process a1-21) (empty) a1-21 ) (else *entity-pool* ) ) ) ) ) (t9-19 (the-as part-tracker a0-50) a1-21 "part-tracker" (the-as pointer #x70004000)) ) (let ((t9-20 run-function-in-process) (a0-51 s3-2) (a1-22 part-tracker-init) ) (set! (-> s4-3 group) gp-1) (set! (-> s4-3 duration) sv-120) (set! (-> s4-3 callback) #f) (set! (-> s4-3 userdata) (the-as uint #f)) (set! (-> s4-3 target) (the-as process-drawable (if sv-112 sv-84 (the-as process #f) ) ) ) (set! (-> s4-3 mat-joint) (if sv-112 sv-104 sv-96 ) ) ((the-as (function object object object none) t9-20) a0-51 a1-22 s4-3) ) (-> s3-2 ppointer) ) ) ) ) ) (else (format 0 "ERROR: SCRIPT: part-tracker: unknown particle group \"~S\" in:~%~T~A~%" (-> arg0 param 1) (-> arg0 expr) ) ) ) ) ) ) ) ) ) (let ((v1-132 (-> *script-form* 59))) (set! (-> v1-132 name) 'lightning-tracker) (set! (-> v1-132 spec) '((return macro (none)) (function macro (symbol)) (name eval (string)) &key (from-entity eval (string process entity-actor drawable-region-prim #f) #f) (to-entity eval (string process entity-actor drawable-region-prim #f) #f) (from-joint eval (string) #f) (to-joint eval (string) #f) (duration macro (object) 0) ) ) (set! (-> v1-132 func) (lambda ((arg0 script-context)) (local-vars (sv-48 vector) (sv-52 vector) (sv-56 int) (sv-64 int) (sv-72 time-frame) (sv-80 lightning-spec)) (when (-> arg0 side-effect?) (if (not (-> arg0 param 2)) (set! (-> arg0 param 2) (-> arg0 process)) ) (if (type? (-> arg0 param 1) string) (set! sv-80 (lookup-lightning-spec-by-name (the-as string (-> arg0 param 1)))) (set! sv-80 (the-as lightning-spec #f)) ) (let* ((s5-0 (command-get-process (-> arg0 param 2) (the-as process #f))) (gp-0 (if (type? s5-0 process-drawable) s5-0 ) ) (s5-1 (command-get-process (-> arg0 param 3) (the-as process #f))) (s4-0 (if (type? s5-1 process-drawable) s5-1 ) ) (s0-0 (the-as entity #f)) (s1-0 (the-as entity #f)) (s5-2 #f) ) (set! sv-48 (vector-reset! (new 'stack-no-clear 'vector))) (set! sv-52 (vector-reset! (new 'stack-no-clear 'vector))) (set! sv-56 0) (set! sv-64 0) (set! sv-72 (command-get-time (-> arg0 param 6) 1)) (let ((s3-0 (if (type? sv-80 lightning-spec) sv-80 ) ) ) (when s3-0 (if (not gp-0) (set! s0-0 (command-get-entity (-> arg0 param 2) (the-as entity #f))) ) (if (not (the-as process s4-0)) (set! s1-0 (command-get-entity (-> arg0 param 3) (the-as entity #f))) ) (when (or (and gp-0 (the-as process s4-0)) (and s0-0 s1-0)) (cond ((and gp-0 (the-as process s4-0)) (set! s5-2 #t) (let ((s0-1 (-> arg0 param 4)) (s1-1 (-> arg0 param 5)) ) (cond (s0-1 (let ((v1-17 (the-as joint (get-art-by-name-method (-> (the-as process-drawable gp-0) draw jgeo) (the-as string s0-1) (the-as type #f)) ) ) ) (cond (v1-17 (set! sv-56 (+ (-> v1-17 number) 1)) (let ((a1-10 (-> (the-as process-drawable gp-0) node-list data sv-56))) (vector<-cspace! sv-48 a1-10) ) ) (else (format 0 "ERROR: SCRIPT: lightning-tracker: unknown from-joint ~A in:~%~T~A~%" s0-1 (-> arg0 expr)) (set! (-> sv-48 quad) (-> (the-as process-drawable gp-0) root trans quad)) ) ) ) ) (else (set! (-> sv-48 quad) (-> (the-as process-drawable gp-0) root trans quad)) ) ) (cond (s1-1 (let ((v1-28 (the-as joint (get-art-by-name-method (-> (the-as process-drawable s4-0) draw jgeo) (the-as string s1-1) (the-as type #f)) ) ) ) (cond (v1-28 (set! sv-64 (+ (-> v1-28 number) 1)) (let ((a1-13 (-> (the-as process-drawable s4-0) node-list data sv-64))) (vector<-cspace! sv-52 a1-13) ) ) (else (format 0 "ERROR: SCRIPT: lightning-tracker: unknown to-joint ~A in:~%~T~A~%" s1-1 (-> arg0 expr)) (set! (-> sv-52 quad) (-> (the-as process-drawable s4-0) root trans quad)) ) ) ) ) (else (set! (-> sv-52 quad) (-> (the-as process-drawable s4-0) root trans quad)) ) ) ) ) ((and s0-0 s1-0) (set! (-> sv-48 quad) (-> s0-0 extra trans quad)) (set! (-> sv-52 quad) (-> s1-0 extra trans quad)) ) ) ) (process-spawn lightning-tracker :init lightning-tracker-init s3-0 sv-72 #f (cond (s5-2 (empty) gp-0 ) (else (the-as process #f) ) ) (if s5-2 sv-56 sv-48 ) (if s5-2 sv-64 sv-52 ) :name "lightning-tracker" :to (cond (s5-2 (empty) s4-0 ) (else (set! s4-0 (ppointer->process (-> *setting-control* user-current movie))) (cond ((the-as process s4-0) (empty) s4-0 ) (else *entity-pool* ) ) ) ) ) ) ) ) ) ) ) ) (let ((v1-134 (-> *script-form* 60))) (set! (-> v1-134 name) 'joint-eval) (set! (-> v1-134 spec) '((return macro (none)) (function macro (symbol)) (lambda eval (function)) &key (entity eval (string process entity-actor #f) #f) (joint eval (string) #f) ) ) (set! (-> v1-134 func) (lambda ((arg0 script-context)) " call a (lambda (process vector cspace)) on the specified location. e.g `(joint-eval ,(lambda ((proc process) (trans vector) (cs cspace)) (format #t \"~A ~`vector`P ~`cspace`P~%\" proc trans cs)) :entity *target* :joint \"neckB\") proc - the process or #f trans - the position specified (will always be true) cs - the cspace, or #f " (when (-> arg0 side-effect?) (if (not (-> arg0 param 2)) (set! (-> arg0 param 2) (-> arg0 process)) ) (let* ((s4-0 (-> arg0 param 1)) (gp-0 (if (type? s4-0 function) s4-0 ) ) (s3-0 (command-get-process (-> arg0 param 2) (the-as process #f))) (s4-1 (if (type? s3-0 process-drawable) s3-0 ) ) (v1-5 (the-as entity #f)) ) (let ((s3-1 (the-as object #f))) (if (not s4-1) (set! v1-5 (command-get-entity (-> arg0 param 2) (the-as entity #f))) ) (if (or s4-1 v1-5 (-> arg0 trans)) ((the-as (function process-drawable cspace none) gp-0) (the-as process-drawable s4-1) (the-as cspace (cond ((and s4-1 (nonzero? (-> (the-as process-drawable s4-1) draw)) (nonzero? (-> (the-as process-drawable s4-1) node-list)) ) (let ((a1-5 (-> arg0 param 3))) (cond (a1-5 (let ((v1-8 (the-as joint (get-art-by-name-method (-> (the-as process-drawable s4-1) draw jgeo) (the-as string a1-5) (the-as type #f)) ) ) ) (cond (v1-8 (set! s3-1 (-> (the-as process-drawable s4-1) node-list data (+ (-> v1-8 number) 1))) (vector<-cspace! (new 'stack-no-clear 'vector) (the-as cspace s3-1)) ) (else (format 0 "ERROR: SCRIPT: joint-eval: unknown joint ~A in:~%~T~A~%" (-> arg0 param 3) (-> arg0 expr)) (set! s3-1 (-> (the-as process-drawable s4-1) node-list data)) (-> (the-as process-drawable s4-1) root trans) ) ) ) ) (else (set! s3-1 (-> (the-as process-drawable s4-1) node-list data)) (-> (the-as process-drawable s4-1) root trans) ) ) ) ) (v1-5 (-> v1-5 extra trans) ) (else (-> arg0 trans) ) ) ) ) (format 0 "ERROR: SCRIPT: joint-eval: unknown entity ~A in:~%~T~A~%" (-> arg0 param 2) (-> arg0 expr)) ) ) ) ) ) ) ) (let ((v1-136 (-> *script-form* 61))) (set! (-> v1-136 name) 'auto-save) (set! (-> v1-136 spec) '((return macro (none)) (function macro (symbol)) (value eval (symbol)))) (set! (-> v1-136 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (case *kernel-boot-message* (('play 'preview) (auto-save-command (the-as symbol (-> arg0 param 1)) 0 0 *default-pool* #f) ) ) ) ) ) ) (let ((v1-138 (-> *script-form* 62))) (set! (-> v1-138 name) 'teleport) (set! (-> v1-138 spec) '((return macro (none)) (function macro (symbol)))) (set! (-> v1-138 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (set! *teleport* #t) (let ((v0-0 1000)) (set! (-> *ACTOR-bank* birth-max) v0-0) v0-0 ) ) ) ) ) (let ((v1-140 (-> *script-form* 63))) (set! (-> v1-140 name) 'scene-play) (set! (-> v1-140 spec) '((return macro (none)) (function macro (symbol)) (name eval (string pair)) &key (continue eval (string #f) #f) ) ) (set! (-> v1-140 func) (lambda ((arg0 script-context)) (if (and (-> arg0 side-effect?) *target* (not *scene-player*) (not (logtest? (-> *target* focus-status) (focus-status dead))) ) (process-spawn scene-player :init scene-player-init (-> arg0 param 1) #t (-> arg0 param 2) :name "scene-player" ) ) ) ) ) (let ((v1-142 (-> *script-form* 64))) (set! (-> v1-142 name) 'kill-by-type) (set! (-> v1-142 spec) '((return macro (none)) (function macro (symbol)) (type macro (symbol)) &key (store eval (symbol) #t)) ) (set! (-> v1-142 func) (lambda ((arg0 script-context)) "Kill all processes that are of type type." (local-vars (v1-11 int) (s4-0 process)) (when (-> arg0 side-effect?) (let ((s5-0 (-> (the-as symbol (-> arg0 param 1)) value))) (set! *global-search-name* (the-as basic (if (type? s5-0 type) s5-0 ) ) ) ) (when *global-search-name* (let ((s5-1 (-> arg0 load-state))) (while (begin (set! s4-0 (search-process-tree *active-pool* (the-as (function process-tree object) (lambda ((arg0 basic)) (= (-> arg0 type) *global-search-name*))) ) ) s4-0 ) (let ((a0-3 (if (type? s4-0 process-drawable) s4-0 ) ) ) (when a0-3 (let* ((s3-0 (-> a0-3 entity)) (s4-1 (if (type? s3-0 entity-actor) s3-0 ) ) ) (when s4-1 (let ((a0-6 (res-lump-struct s4-1 'name structure))) (cond ((-> arg0 param 2) (dotimes (v1-10 256) (when (not (-> s5-1 object-name v1-10)) (set! (-> s5-1 object-name v1-10) (the-as string a0-6)) (set! (-> s5-1 object-status v1-10) (the-as basic (-> s4-1 extra perm status))) (set! v1-11 v1-10) (goto cfg-19) ) ) (set! v1-11 -1) (label cfg-19) (when (>= v1-11 0) (if (-> s4-1 extra process) (kill! s4-1) ) (logior! (-> s4-1 extra perm status) (entity-perm-status dead)) ) ) (else (if (-> s4-1 extra process) (kill! s4-1) ) (logior! (-> s4-1 extra perm status) (entity-perm-status dead)) ) ) ) ) ) ) ) ) ) #f ) ) ) ) ) (let ((v1-144 (-> *script-form* 65))) (set! (-> v1-144 name) 'kill) (set! (-> v1-144 spec) '((return macro (none)) (function macro (symbol)) (entity eval (string entity-actor process #f)) &key (store eval (symbol) #t) ) ) (set! (-> v1-144 func) (lambda ((arg0 script-context)) "Store an entity's state in the load-state and then kill him and set him to be dead." (local-vars (v0-0 entity-perm-status) (v1-5 int)) (when (-> arg0 side-effect?) (let* ((s5-0 (-> arg0 load-state)) (s3-0 (command-get-entity (-> arg0 param 1) (the-as entity #f))) (gp-0 (if (type? s3-0 entity-actor) s3-0 ) ) ) (when gp-0 (let ((a0-4 (res-lump-struct gp-0 'name structure))) (cond ((-> arg0 param 2) (dotimes (v1-4 256) (when (not (-> s5-0 object-name v1-4)) (set! (-> s5-0 object-name v1-4) (the-as string a0-4)) (set! (-> s5-0 object-status v1-4) (the-as basic (-> gp-0 extra perm status))) (set! v1-5 v1-4) (goto cfg-12) ) ) (set! v1-5 -1) (label cfg-12) (when (>= v1-5 0) (if (-> gp-0 extra process) (kill! gp-0) ) (set! v0-0 (logior (-> gp-0 extra perm status) (entity-perm-status dead))) (set! (-> gp-0 extra perm status) v0-0) v0-0 ) ) (else (if (-> gp-0 extra process) (kill! gp-0) ) (set! v0-0 (logior (-> gp-0 extra perm status) (entity-perm-status dead))) (set! (-> gp-0 extra perm status) v0-0) v0-0 ) ) ) ) ) ) ) ) ) (let ((v1-146 (-> *script-form* 66))) (set! (-> v1-146 name) 'alive) (set! (-> v1-146 spec) '((return macro (none)) (function macro (symbol)) (entity eval (string entity-actor process #f)) &key (store eval (symbol) #t) ) ) (set! (-> v1-146 func) (lambda ((arg0 script-context)) "Store an entity's state in the load-state and then force him to be alive." (local-vars (v1-12 int)) (when (-> arg0 side-effect?) (let* ((s5-0 (-> arg0 load-state)) (s3-0 (command-get-entity (-> arg0 param 1) (the-as entity #f))) (gp-0 (if (type? s3-0 entity-actor) s3-0 ) ) ) (when gp-0 (cond ((-> arg0 param 2) (dotimes (s4-1 256) (when (not (-> s5-0 object-name s4-1)) (set! (-> s5-0 object-name s4-1) (res-lump-struct gp-0 'name string)) (set! (-> s5-0 object-status s4-1) (the-as basic (-> gp-0 extra perm status))) (set! v1-12 s4-1) (goto cfg-12) ) ) (set! v1-12 -1) (label cfg-12) (when (>= v1-12 0) (entity-birth-no-kill gp-0) (let ((v1-16 (-> gp-0 extra process))) (when v1-16 (logclear! (-> v1-16 mask) (process-mask actor-pause)) (let ((v0-0 (the-as object (logclear (-> v1-16 mask) (-> *kernel-context* prevent-from-run))))) (set! (-> v1-16 mask) (the-as process-mask v0-0)) v0-0 ) ) ) ) ) (else (entity-birth-no-kill gp-0) ) ) ) ) ) ) ) ) (let ((v1-148 (-> *script-form* 67))) (set! (-> v1-148 name) 'restore) (set! (-> v1-148 spec) '((return macro (none)) (function macro (symbol)) (entity eval (string entity-actor process #f))) ) (set! (-> v1-148 func) (lambda ((arg0 script-context)) "restore an entity's state fromt he load-state storage. Will reset him if he is alive." (when (-> arg0 side-effect?) (let* ((gp-0 (-> arg0 load-state)) (s4-0 (command-get-entity (-> arg0 param 1) (the-as entity #f))) (s5-0 (if (type? s4-0 entity-actor) s4-0 ) ) ) (when s5-0 (let ((s3-0 (res-lump-struct s5-0 'name structure))) (dotimes (s4-1 256) (when (string= (-> gp-0 object-name s4-1) (the-as string s3-0)) (set! (-> s5-0 extra perm status) (the-as entity-perm-status (-> gp-0 object-status s4-1))) (if (-> s5-0 extra process) (kill! s5-0) ) (set! (-> gp-0 object-name s4-1) #f) (return #f) ) ) ) #f ) ) ) ) ) ) (let ((v1-150 (-> *script-form* 68))) (set! (-> v1-150 name) 'special) (set! (-> v1-150 spec) '((return macro (none)) (function macro (symbol)) (entity eval (string entity-actor process #f)) (value eval (symbol)) ) ) (set! (-> v1-150 func) (lambda ((arg0 script-context)) "make a guy special or not." (when (-> arg0 side-effect?) (let* ((s5-0 (command-get-entity (-> arg0 param 1) (the-as entity #f))) (a0-3 (if (type? s5-0 entity-actor) s5-0 ) ) ) (if a0-3 (toggle-status (the-as entity-actor a0-3) (entity-perm-status special) (the-as symbol (-> arg0 param 2))) ) ) ) ) ) ) (let ((v1-152 (-> *script-form* 69))) (set! (-> v1-152 name) 'save) (set! (-> v1-152 spec) '((return macro (none)) (function macro (symbol)))) (set! (-> v1-152 func) (lambda ((arg0 script-context)) "make changes permanent." (when (-> arg0 side-effect?) (mem-copy! (&-> *backup-load-state* type) (&-> (-> arg0 load-state) type) 2664) (set! (-> *backup-load-state* command-list) '()) (dotimes (v1-5 256) (if (-> *backup-load-state* object-name v1-5) (set! (-> *backup-load-state* object-name v1-5) #f) ) ) #f ) ) ) ) (let ((v1-154 (-> *script-form* 70))) (set! (-> v1-154 name) 'task-close!) (set! (-> v1-154 spec) '((return macro (none)) (function macro (symbol)) (task eval (binteger string)))) (set! (-> v1-154 func) (lambda ((arg0 script-context)) "close a task stage." (when (-> arg0 side-effect?) (cond ((not (logtest? (the-as int (-> arg0 param 1)) 7)) (task-node-close! (the-as game-task-node (command-get-int (-> arg0 param 1) 0)) 'event) ) (else (let ((s5-1 (-> arg0 param 1))) (let ((s4-0 (-> *game-info* sub-task-list))) (dotimes (s3-0 (-> s4-0 length)) (when (nonzero? s3-0) (let ((s2-0 (-> s4-0 s3-0))) (when (string= (the-as string s5-1) (-> s2-0 name)) (open! s2-0 'event) (return 0) ) ) ) ) ) (format 0 "ERROR: SCRIPT: unknown task-node ~A in command ~A.~%" s5-1 (-> arg0 expr)) ) ) ) ) ) ) ) (let ((v1-156 (-> *script-form* 71))) (set! (-> v1-156 name) 'task-open!) (set! (-> v1-156 spec) '((return macro (none)) (function macro (symbol)) (task eval (binteger string)))) (set! (-> v1-156 func) (lambda ((arg0 script-context)) "close a task stage." (when (-> arg0 side-effect?) (cond ((not (logtest? (the-as int (-> arg0 param 1)) 7)) (task-node-open! (the-as game-task-node (command-get-int (-> arg0 param 1) 0)) 'event) ) (else (let ((s4-0 (-> arg0 param 1))) (let ((s3-0 (-> *game-info* sub-task-list))) (dotimes (s2-0 (-> s3-0 length)) (when (nonzero? s2-0) (let ((gp-1 (-> s3-0 s2-0))) (when (string= (the-as string s4-0) (-> gp-1 name)) (dotimes (s5-1 4) (if (nonzero? (-> gp-1 parent-node s5-1)) (open! (-> *game-info* sub-task-list (-> gp-1 parent-node s5-1)) 'event) ) ) (game-task-node-info-method-11 gp-1 'event) (return 0) ) ) ) ) ) (format 0 "ERROR: SCRIPT: unknown task-node ~A in command ~A.~%" s4-0 (-> arg0 expr)) ) ) ) ) ) ) ) (let ((v1-158 (-> *script-form* 72))) (set! (-> v1-158 name) 'task-complete?) (set! (-> v1-158 spec) '((return macro (none)) (function macro (symbol)) (task eval (binteger)))) (set! (-> v1-158 func) (lambda ((arg0 script-context)) "test whether the need resolution stage of a task is closed (actually tests the bit array)" (task-complete? *game-info* (the-as game-task (command-get-int (-> arg0 param 1) 0))) ) ) ) (let ((v1-160 (-> *script-form* 73))) (set! (-> v1-160 name) 'task-closed?) (set! (-> v1-160 spec) '((return macro (boolean)) (function macro (symbol)) (task eval (binteger string)))) (set! (-> v1-160 func) (lambda ((arg0 script-context)) "test whether the need resolution stage of a task is closed (actually tests the bit array)" (cond ((not (logtest? (the-as int (-> arg0 param 1)) 7)) (task-node-closed? (the-as game-task-node (command-get-int (-> arg0 param 1) 0))) ) (else (let ((s5-1 (-> arg0 param 1))) (let ((s4-0 (-> *game-info* sub-task-list))) (dotimes (s3-0 (-> s4-0 length)) (when (nonzero? s3-0) (let ((s2-0 (-> s4-0 s3-0))) (if (string= (the-as string s5-1) (-> s2-0 name)) (return (logtest? (-> s2-0 flags) (game-task-node-flag closed))) ) ) ) ) ) (format 0 "ERROR: SCRIPT: unknown task-node ~A in command ~A.~%" s5-1 (-> arg0 expr)) ) ) ) #f ) ) ) (let ((v1-162 (-> *script-form* 74))) (set! (-> v1-162 name) 'bigmap?) (set! (-> v1-162 spec) '((return macro (boolean)) (function macro (symbol)) (task eval (binteger string)))) (set! (-> v1-162 func) (lambda ((arg0 script-context)) (cond ((not *bigmap*) (return #f) ) (else (let ((a0-1 (-> arg0 param 1)) (v1-3 (-> *bigmap* bigmap-index)) ) (cond ((zero? v1-3) (if (string= (the-as string a0-1) "city") (return #t) ) ) ((= v1-3 1) (if (string= (the-as string a0-1) "comb") (return #t) ) ) ((= v1-3 2) (if (string= (the-as string a0-1) "desert") (return #t) ) ) ((= v1-3 3) (if (string= (the-as string a0-1) "factory") (return #t) ) ) ((= v1-3 4) (if (string= (the-as string a0-1) "forest") (return #t) ) ) ((= v1-3 5) (if (string= (the-as string a0-1) "metalhead-city") (return #t) ) ) ((= v1-3 6) (if (string= (the-as string a0-1) "mine") (return #t) ) ) ((= v1-3 7) (if (string= (the-as string a0-1) "nest") (return #t) ) ) ((= v1-3 8) (if (string= (the-as string a0-1) "nest2") (return #t) ) ) ((= v1-3 9) (if (string= (the-as string a0-1) "none") (return #t) ) ) ((= v1-3 10) (if (string= (the-as string a0-1) "precursor1") (return #t) ) ) ((= v1-3 11) (if (string= (the-as string a0-1) "precursor2") (return #t) ) ) ((= v1-3 12) (if (string= (the-as string a0-1) "rubble") (return #t) ) ) ((= v1-3 13) (if (string= (the-as string a0-1) "sewer-hum-kg") (return #t) ) ) ((= v1-3 14) (if (string= (the-as string a0-1) "sewer-kg-met") (return #t) ) ) ((= v1-3 15) (if (string= (the-as string a0-1) "sewer-met-hum") (return #t) ) ) ((= v1-3 16) (if (string= (the-as string a0-1) "stadium") (return #t) ) ) ((= v1-3 17) (if (string= (the-as string a0-1) "temple1") (return #t) ) ) ((= v1-3 18) (if (string= (the-as string a0-1) "temple2") (return #t) ) ) ((= v1-3 19) (if (string= (the-as string a0-1) "temple3") (return #t) ) ) ((= v1-3 20) (if (string= (the-as string a0-1) "temple4") (return #t) ) ) ((= v1-3 21) (if (string= (the-as string a0-1) "tower") (return #t) ) ) ((= v1-3 22) (if (string= (the-as string a0-1) "volcano") (return #t) ) ) ((= v1-3 23) (if (string= (the-as string a0-1) "wascity") (return #t) ) ) ) ) ) ) #f ) ) ) (let ((v1-164 (-> *script-form* 75))) (set! (-> v1-164 name) 'task-open?) (set! (-> v1-164 spec) '((return macro (boolean)) (function macro (symbol)) (task eval (string)))) (set! (-> v1-164 func) (lambda ((arg0 script-context)) "test whether the need resolution stage of a task is closed (actually tests the bit array)" (let ((s5-0 (-> arg0 param 1))) (let ((s4-0 (-> *game-info* sub-task-list)) (s3-0 0) ) (while (< s3-0 (-> s4-0 length)) (when (nonzero? s3-0) (let ((v1-5 (-> s4-0 s3-0))) (if (string= (the-as string s5-0) (-> v1-5 name)) (return (the-as object (task-node-open? (the-as game-task-node s3-0)))) ) ) ) (set! s3-0 (+ s3-0 1)) ) ) (format 0 "ERROR: SCRIPT: unknown task-node ~A in command ~A.~%" s5-0 (-> arg0 expr)) ) #f ) ) ) (let ((v1-166 (-> *script-form* 76))) (set! (-> v1-166 name) 'play-task) (set! (-> v1-166 spec) '((return macro (none)) (function macro (symbol)) (task eval (binteger)))) (set! (-> v1-166 func) (lambda ((arg0 script-context)) "set the attributes for a task." (if (-> arg0 side-effect?) (play-task (the-as game-task (command-get-int (-> arg0 param 1) 0)) 'debug #f) ) ) ) ) (let ((v1-168 (-> *script-form* 77))) (set! (-> v1-168 name) 'task-manager) (set! (-> v1-168 spec) '((return macro (process)) (function macro (symbol)) &key (type macro (symbol) task-manager) (level macro (symbol) #f) ) ) (set! (-> v1-168 func) (lambda ((arg0 script-context)) "set the attributes for a task." (the-as symbol (when (-> arg0 side-effect?) (let* ((s4-0 (-> arg0 key)) (gp-0 (if (type? s4-0 game-task-node-info) (the-as game-task-node-info s4-0) ) ) (s3-0 (-> (the-as symbol (-> arg0 param 1)) value)) (s4-1 (if (type? s3-0 type) s3-0 ) ) (s5-1 (-> arg0 param 2)) ) (set! s5-1 (cond (s5-1 (empty) s5-1 ) (else (if (and gp-0 (-> gp-0 manager)) (-> gp-0 manager level) ) ) ) ) (cond ((not (and gp-0 (-> gp-0 manager))) (the-as int #f) ) ((begin (when (= s4-1 task-manager) (let ((s3-1 (-> gp-0 manager type-to-spawn value))) (set! s4-1 (if (type? s3-1 type) s3-1 ) ) ) ) (and s4-1 (or (not s5-1) (= (level-status? *level* (the-as symbol s5-1) #f) 'active))) ) (when (not (handle->process (-> gp-0 manager manager))) (let* ((s4-2 (get-process *default-dead-pool* (the-as type s4-1) #x4000 1)) (v0-0 (ppointer->handle (when s4-2 (let ((t9-5 (method-of-type process activate))) (t9-5 s4-2 *entity-pool* (-> gp-0 name) (the-as pointer #x70004000)) ) (run-now-in-process s4-2 task-manager-init-by-other gp-0 s5-1) (-> s4-2 ppointer) ) ) ) ) (set! (-> gp-0 manager manager) (the-as handle v0-0)) v0-0 ) ) ) ) ) ) ) ) ) ) (let ((v1-170 (-> *script-form* 78))) (set! (-> v1-170 name) 'water) (set! (-> v1-170 spec) '((return macro (pair)) (function macro (symbol)) (mode macro (symbol)) (data eval (object)) (params macro (pair)) ) ) (set! (-> v1-170 func) (lambda ((arg0 script-context)) "define a water volume. command does nothing, just defines the syntax." (-> arg0 expr) ) ) ) (let ((v1-172 (-> *script-form* 79))) (set! (-> v1-172 name) 'movie?) (set! (-> v1-172 spec) '((return macro (boolean)) (function macro (symbol)))) (set! (-> v1-172 func) (lambda ((arg0 script-context)) (movie?))) ) (let ((v1-174 (-> *script-form* 80))) (set! (-> v1-174 name) 'scene-select?) (set! (-> v1-174 spec) '((return macro (boolean)) (function macro (symbol)))) (set! (-> v1-174 func) (lambda ((arg0 script-context)) (scene-select?))) ) (let ((v1-176 (-> *script-form* 81))) (set! (-> v1-176 name) 'demo?) (set! (-> v1-176 spec) '((return macro (boolean)) (function macro (symbol)))) (set! (-> v1-176 func) (lambda ((arg0 script-context)) "are we in demo?" (demo?))) ) (let ((v1-178 (-> *script-form* 82))) (set! (-> v1-178 name) 'kiosk?) (set! (-> v1-178 spec) '((return macro (boolean)) (function macro (symbol)))) (set! (-> v1-178 func) (lambda ((arg0 script-context)) "are we in kiosk?" (kiosk?))) ) (let ((v1-180 (-> *script-form* 83))) (set! (-> v1-180 name) 'kiosk-complete) (set! (-> v1-180 spec) '((return macro (none)) (function macro (symbol)))) (set! (-> v1-180 func) (lambda ((arg0 script-context)) "are we in kiosk?" (when (and (or (= *kernel-boot-message* 'kiosk) (= *kernel-boot-message* 'demo) (= *kernel-boot-message* 'demo-shared)) (and (-> arg0 side-effect?) (!= *master-mode* 'kiosk) (not *progress-process*)) ) (remove-setting! 'allow-progress) (apply-settings *setting-control*) (set-blackout-frames 0) (set! (-> *setting-control* user-current bg-a-force) 0.0) (initialize! *game-info* 'game (the-as game-save #f) "title-restart" (the-as resetter-spec #f)) ) ) ) ) (let ((v1-182 (-> *script-form* 84))) (set! (-> v1-182 name) 'restart-mission) (set! (-> v1-182 spec) '((return macro (none)) (function macro (symbol)))) (set! (-> v1-182 func) (lambda ((arg0 script-context)) "fail jak no mater what." (restart-mission) 0)) ) (let ((v1-184 (-> *script-form* 85))) (set! (-> v1-184 name) 'scene-player?) (set! (-> v1-184 spec) '((return macro (boolean)) (function macro (symbol)))) (set! (-> v1-184 func) (lambda ((arg0 script-context)) "test whether the need resolution stage of a task is closed (actually tests the bit array)" (if *scene-player* #t #f ) ) ) ) (let ((v1-186 (-> *script-form* 86))) (set! (-> v1-186 name) 'talker-spawn) (set! (-> v1-186 spec) '((return macro (binteger)) (function macro (symbol)) (message eval (string)))) (set! (-> v1-186 func) (lambda ((arg0 script-context)) (cond ((-> arg0 side-effect?) (let ((s5-0 (string->talker-speech (the-as string (-> arg0 param 1))))) (if (= s5-0 (-> *talker-speech* 0)) (format 0 "ERROR: talker-spawn could not find a speech named ~A.~%" (-> arg0 param 1)) ) ;; og:preserve-this (* 8 (talker-spawn-func s5-0 *entity-pool* (target-pos 0) (the-as region (-> arg0 key))) ) ) ) (else 0 ) ) ) ) ) (let ((v1-188 (-> *script-form* 87))) (set! (-> v1-188 name) 'mark-played!) (set! (-> v1-188 spec) '((return macro (none)) (function macro (symbol)) (message eval (string)))) (set! (-> v1-188 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((a0-2 (string->talker-speech (the-as string (-> arg0 param 1))))) (if a0-2 (mark-played! a0-2) ) ) ) 0 ) ) ) (let ((v1-190 (-> *script-form* 88))) (set! (-> v1-190 name) 'yes-play!) (set! (-> v1-190 spec) '((return macro (none)) (function macro (symbol)) (message eval (string)) (count eval (binteger bfloat))) ) (set! (-> v1-190 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((s5-0 (string->talker-speech (the-as string (-> arg0 param 1)))) (a1-1 (command-get-int (-> arg0 param 2) 0)) ) (if s5-0 (yes-play! s5-0 a1-1) ) ) ) 0 ) ) ) (let ((v1-192 (-> *script-form* 89))) (set! (-> v1-192 name) 'no-play!) (set! (-> v1-192 spec) '((return macro (none)) (function macro (symbol)) (message eval (string)) (count eval (binteger bfloat))) ) (set! (-> v1-192 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let ((s5-0 (string->talker-speech (the-as string (-> arg0 param 1)))) (a1-1 (command-get-int (-> arg0 param 2) 0)) ) (if s5-0 (no-play! s5-0 a1-1) ) ) ) 0 ) ) ) (let ((v1-194 (-> *script-form* 90))) (set! (-> v1-194 name) 'endlessfall) (set! (-> v1-194 spec) '((return macro (object)) (function macro (symbol)))) (set! (-> v1-194 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) (send-event *target* 'attack-invinc #f (static-attack-info :mask (vehicle-impulse-factor) ((id (the-as uint 2)) (damage 2.0) (vehicle-damage-factor 1.0) (vehicle-impulse-factor 1.0) (mode 'endlessfall) ) ) ) ) ) ) ) (let ((v1-196 (-> *script-form* 91))) (set! (-> v1-196 name) 'birth-pickup) (set! (-> v1-196 spec) '((return macro (process)) (function macro (symbol)) (trans macro (vector symbol string pair)) (pickup macro (symbol)) (amount eval (bfloat binteger)) &key (flags macro (pair) ('())) ) ) (set! (-> v1-196 func) (lambda ((arg0 script-context)) (when (-> arg0 side-effect?) (let* ((v1-1 (-> arg0 param 2)) (s5-0 (cond ((= v1-1 'board) 38 ) ((= v1-1 'skill) 24 ) (else 0 ) ) ) ) (cond ((nonzero? s5-0) (let ((s4-0 (new 'static 'fact-info))) (set! (-> s4-0 options) (actor-option)) (let* ((v1-2 (-> arg0 param 4)) (a0-3 (-> (the-as pair v1-2) car)) ) (while (not (null? v1-2)) (cond ((= a0-3 'suck-in) (logior! (-> s4-0 options) (actor-option suck-in)) ) ((= a0-3 'auto-pickup) (logior! (-> s4-0 options) (actor-option auto-pickup)) ) ) (set! v1-2 (-> (the-as pair v1-2) cdr)) (set! a0-3 (-> (the-as pair v1-2) car)) ) ) (ppointer->process (birth-pickup-at-point (command-get-trans (-> arg0 param 1) (-> arg0 trans)) (the-as pickup-type s5-0) (command-get-float (-> arg0 param 3) 0.0) #t *entity-pool* s4-0 ) ) ) ) (else (format 0 "ERROR: SCRIPT: could not spawn pickup, unknown type ~A~%" (-> arg0 param 2)) ) ) ) ) ) ) ) (let ((v1-198 (-> *script-form* 92))) (set! (-> v1-198 name) 'test-pickup) (set! (-> v1-198 spec) '((return macro (binteger)) (function macro (symbol)) (pickup macro (symbol)))) (set! (-> v1-198 func) (lambda ((arg0 script-context)) (case (-> arg0 param 1) (('gem) (* (the int (the float (send-event *target* 'test-pickup (pickup-type gem)))) 8) ) (else 0 ) ) ) ) ) (let ((v1-200 (-> *script-form* 93))) (set! (-> v1-200 name) 'get-alert-level) (set! (-> v1-200 spec) '((return macro (binteger)) (function macro (symbol)))) (set! (-> v1-200 func) (lambda ((arg0 script-context)) 0)) ) (let ((v1-202 (-> *script-form* 94))) (set! (-> v1-202 name) 'pause) (set! (-> v1-202 spec) '((return macro (none)) (function macro (symbol)))) (set! (-> v1-202 func) (lambda ((arg0 script-context)) (set-master-mode 'pause) 0)) ) (let ((v1-204 (-> *script-form* 95))) (set! (-> v1-204 name) 'camera-smush) (set! (-> v1-204 spec) '((return macro (none)) (function macro (symbol)) &key (size macro (binteger bfloat pair) (meters (new 'static 'bfloat :data 0.1))) (duration macro (binteger bfloat pair) (seconds (new 'static 'bfloat :data 0.25))) ) ) (set! (-> v1-204 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) (activate! *camera-smush-control* (the-as float (command-get-param (-> arg0 param 1) #f)) 15 (the-as int (command-get-time (-> arg0 param 2) 1)) 1.0 0.98 (-> *display* camera-clock) ) ) 0 ) ) ) (let ((v1-206 (-> *script-form* 96))) (set! (-> v1-206 name) 'show-hud) (set! (-> v1-206 spec) '((return macro (none)) (function macro (symbol)) (name eval (symbol)))) (set! (-> v1-206 func) (lambda ((arg0 script-context)) (if (-> arg0 side-effect?) (show-hud (-> arg0 param 1)) ) 0 ) ) ) (let ((v1-208 (-> *script-form* 97))) (set! (-> v1-208 name) 'fma-sphere) (set! (-> v1-208 spec) '((return macro (none)) (function macro (symbol)) (mode macro (pair)) &key (entity eval (string process entity-actor #f) #f) (joint eval (string) #f) (duration macro (object) (frame-time 0)) (sphere eval (binteger #f) #f) (danger eval (binteger #f) #f) ;; og:preserve-this ;; (nav-mesh-id eval (binteger) (the integer 0)) (nav-mesh-id eval (binteger) (integer 0)) ) ) (set! (-> v1-208 func) (lambda ((arg0 script-context)) (local-vars (a1-9 process-tree) (sv-16 object) (sv-20 int) (sv-24 process) (sv-32 int) (sv-40 time-frame) (sv-48 object) (sv-52 object) (sv-56 int) ) (when (-> arg0 side-effect?) (set! sv-16 (-> arg0 param 1)) (set! sv-20 0) (let ((s5-0 (command-get-process (-> arg0 param 2) (the-as process #f)))) (set! sv-24 (if (type? s5-0 process-drawable) s5-0 ) ) ) (set! sv-32 -1) (set! sv-40 (command-get-time (-> arg0 param 4) 1)) (set! sv-48 (-> arg0 param 5)) (set! sv-52 (-> arg0 param 6)) (set! sv-56 (command-get-int (-> arg0 param 7) 0)) (let* ((s5-1 sv-16) (a2-0 (-> (the-as pair s5-1) car)) ) (while (not (null? s5-1)) (case (the-as symbol a2-0) (('nav) (set! sv-20 (logior sv-20 1)) ) (('kill-once) (set! sv-20 (logior sv-20 2)) ) (('danger) (set! sv-20 (logior sv-20 4)) ) (('deadly-overlap) (set! sv-20 (logior sv-20 8)) ) (else (format 0 "ERROR: SCRIPT: unknown fma-sphere-mode ~A~%" a2-0) ) ) (set! s5-1 (-> (the-as pair s5-1) cdr)) (set! a2-0 (-> (the-as pair s5-1) car)) ) ) (when (and sv-24 (and (nonzero? (-> (the-as process-drawable sv-24) draw)) (nonzero? (-> (the-as process-drawable sv-24) node-list)) ) ) (let ((a1-5 (-> arg0 param 3))) (when a1-5 (let ((v1-31 (the-as joint (get-art-by-name-method (-> (the-as process-drawable sv-24) draw jgeo) (the-as string a1-5) (the-as type #f)) ) ) ) (if v1-31 (set! sv-32 (+ (-> v1-31 number) 1)) (format 0 "ERROR: SCRIPT: joint-eval: unknown joint ~A in:~%~T~A~%" (-> arg0 param 3) (-> arg0 expr)) ) ) ) ) ) (let ((gp-1 (new 'stack 'fma-sphere-params))) (set! (-> gp-1 mode) (the-as fma-sphere-mode sv-20)) (set! (-> gp-1 proc) (the-as process-focusable sv-24)) (set! (-> gp-1 track-joint) sv-32) (set! (-> gp-1 duration) sv-40) (set! (-> gp-1 sphere) (the-as sphere sv-48)) (set! (-> gp-1 danger) (the-as traffic-danger-info sv-52)) (set! (-> gp-1 nav-mesh-id) (the-as uint sv-56)) (let ((s5-2 (get-process *default-dead-pool* fma-sphere #x4000 1))) (when s5-2 (let ((t9-9 (method-of-type fma-sphere activate)) (a0-16 s5-2) ) (set! a1-9 (cond (sv-24 sv-24 ) (else (set! a1-9 (ppointer->process (-> *setting-control* user-current movie))) (cond ((the-as process a1-9) (empty) a1-9 ) (else *entity-pool* ) ) ) ) ) (t9-9 (the-as fma-sphere a0-16) a1-9 "fma-sphere" (the-as pointer #x70004000)) ) (run-now-in-process s5-2 fma-sphere-init-by-other gp-1) (-> s5-2 ppointer) ) ) ) ) 0 ) ) ) (let ((v1-210 (-> *script-form* 98))) (set! (-> v1-210 name) 'reset-cloth) (set! (-> v1-210 spec) '((return macro (none)) (function macro (symbol)) (manipy-name eval (string)))) (set! (-> v1-210 func) (lambda ((arg0 script-context)) (let ((a0-2 (command-get-process (-> arg0 param 1) *target*))) (if (and (-> arg0 side-effect?) a0-2) (process-drawable-reset-all-cloth (the-as process-drawable a0-2)) ) ) ) ) ) (let ((v1-212 (-> *script-form* 99))) (set! (-> v1-212 name) 'hide-cloth) (set! (-> v1-212 spec) '((return macro (none)) (function macro (symbol)) (manipy-name eval (string)))) (set! (-> v1-212 func) (lambda ((arg0 script-context)) (let ((a0-2 (command-get-process (-> arg0 param 1) *target*))) (if (and (-> arg0 side-effect?) a0-2) (process-drawable-show-all-cloth (the-as process-drawable a0-2) #f) ) ) ) ) ) (let ((v1-214 (-> *script-form* 100))) (set! (-> v1-214 name) 'show-cloth) (set! (-> v1-214 spec) '((return macro (none)) (function macro (symbol)) (manipy-name eval (string)))) (set! (-> v1-214 func) (lambda ((arg0 script-context)) (let ((a0-2 (command-get-process (-> arg0 param 1) *target*))) (if (and (-> arg0 side-effect?) a0-2) (process-drawable-show-all-cloth (the-as process-drawable a0-2) #t) ) ) ) ) ) (let ((v1-216 (-> *script-form* 101))) (set! (-> v1-216 name) 'cloth-slow-mo) (set! (-> v1-216 spec) '((return macro (none)) (function macro (symbol)) (manipy-name eval (string)))) (set! (-> v1-216 func) (lambda ((arg0 script-context)) (let ((a0-2 (command-get-process (-> arg0 param 1) *target*))) (if (and (-> arg0 side-effect?) a0-2) (process-drawable-slow-mo-cloth (the-as process-drawable a0-2) #t) ) ) ) ) ) (let ((v1-218 (-> *script-form* 102))) (set! (-> v1-218 name) 'cloth-restore-mo) (set! (-> v1-218 spec) '((return macro (none)) (function macro (symbol)) (manipy-name eval (string)))) (set! (-> v1-218 func) (lambda ((arg0 script-context)) (let ((a0-2 (command-get-process (-> arg0 param 1) *target*))) (if (and (-> arg0 side-effect?) a0-2) (process-drawable-slow-mo-cloth (the-as process-drawable a0-2) #f) ) ) ) ) ) (let ((v1-220 (-> *script-form* 103))) (set! (-> v1-220 name) 'set-cloth-ground-height) (set! (-> v1-220 spec) '((return macro (none)) (function macro (symbol)) (manipy-name eval (string)) (ground-height eval (binteger bfloat)) ) ) (set! (-> v1-220 func) (lambda ((arg0 script-context)) (let ((gp-0 (command-get-process (-> arg0 param 1) *target*)) (f0-0 (command-get-float (-> arg0 param 2) 0.0)) ) (if (and (-> arg0 side-effect?) gp-0) (process-drawable-set-cloth-ground-height (the-as process-drawable gp-0) f0-0) ) ) ) ) ) (let ((v1-222 (-> *script-form* 104))) (set! (-> v1-222 name) 'set-cloth-wind) (set! (-> v1-222 spec) '((return macro (none)) (function macro (symbol)) (manipy-name eval (string)) (wind eval (binteger bfloat))) ) (set! (-> v1-222 func) (lambda ((arg0 script-context)) (let ((gp-0 (command-get-process (-> arg0 param 1) *target*)) (f0-0 (command-get-float (-> arg0 param 2) 0.0)) ) (if (and (-> arg0 side-effect?) gp-0) (process-drawable-set-wind-strength (the-as process-drawable gp-0) f0-0) ) ) ) ) ) (let ((v1-224 (-> *script-form* 105))) (set! (-> v1-224 name) 'los) (set! (-> v1-224 spec) '((return macro (none)) (function macro (symbol)))) (set! (-> v1-224 func) (lambda ((arg0 script-context)) 'los)) ) ;; og:preserve-this (let ((v1-227 (new 'global 'script-context (process->ppointer PP) PP (the-as vector #f)))) (set! (-> v1-227 side-effect?) #f) (set! *syntax-context* v1-227) ) (define *script-context* (new 'global 'script-context (process->ppointer PP) PP (the-as vector #f))) (let ((v0-6 (-> *script-form* 106))) (set! (-> v0-6 name) 'beam-tracker) (set! (-> v0-6 spec) '((return macro (none)) (function macro (symbol)) &key (entity1 eval (string process entity-actor drawable-region-prim #f) #f) (entity2 eval (string process entity-actor drawable-region-prim #f) #f) (joint1 eval (string) #f) (joint2 eval (string) #f) (duration macro (object) 0) (beam-type eval (symbol) *default-prim-beam-appearance*) ) ) (set! (-> v0-6 func) (lambda ((arg0 script-context)) (the-as (pointer prim-beam-tracker) (when (-> arg0 side-effect?) (if (not (-> arg0 param 1)) (set! (-> arg0 param 1) (-> arg0 process)) ) (if (not (-> arg0 param 2)) (set! (-> arg0 param 2) (-> arg0 process)) ) (let* ((gp-0 (command-get-process (-> arg0 param 1) (the-as process #f))) (s0-0 (if (type? gp-0 process-drawable) gp-0 ) ) (gp-1 (command-get-process (-> arg0 param 2) (the-as process #f))) (s2-0 (if (type? gp-1 process-drawable) gp-1 ) ) (s4-0 0) (s3-0 0) (s5-0 (command-get-time (-> arg0 param 5) 1)) (gp-2 (-> arg0 param 6)) ) (when (and s0-0 s2-0) (when (and s0-0 (nonzero? (-> (the-as process-drawable s0-0) root))) (let ((a1-5 (-> arg0 param 3))) (when a1-5 (let ((v1-12 (if (nonzero? (-> (the-as process-drawable s0-0) draw)) (the-as joint (get-art-by-name-method (-> (the-as process-drawable s0-0) draw jgeo) (the-as string a1-5) (the-as type #f)) ) ) ) ) (if v1-12 (set! s4-0 (+ (-> v1-12 number) 1)) ) ) ) ) ) (when (and s2-0 (nonzero? (-> (the-as process-drawable s2-0) root))) (let ((a1-6 (-> arg0 param 4))) (when a1-6 (let ((v1-20 (if (nonzero? (-> (the-as process-drawable s2-0) draw)) (the-as joint (get-art-by-name-method (-> (the-as process-drawable s2-0) draw jgeo) (the-as string a1-6) (the-as type #f)) ) ) ) ) (if v1-20 (set! s3-0 (+ (-> v1-20 number) 1)) ) ) ) ) ) (let ((a0-16 (new 'stack-no-clear 'prim-beam-tracker-params))) (set! (-> a0-16 track-obj1) (process->handle s0-0)) (set! (-> a0-16 track-obj2) (process->handle s2-0)) (set! (-> a0-16 track-joint1) s4-0) (set! (-> a0-16 track-joint2) s3-0) (set! (-> a0-16 pos0) #f) (set! (-> a0-16 pos1) #f) (set! (-> a0-16 appearance) #f) (set! (-> a0-16 duration) s5-0) (let ((a2-2 (if *scene-player* (ppointer->process *scene-player*) *entity-pool* ) ) ) (spawn-prim-beam-tracker a0-16 (the-as symbol gp-2) (the-as process a2-2)) ) ) ) ) ) ) ) ) )