Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 21:27:52 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity
jak-project/goal_src/engine/level/load-boundary.gc
water111 c9fc4f0bf9
[graphics] eyes (#1169) 
* first draft eye renderer

* working

* working
2022-02-15 19:37:51 -05:00

2289 lines
65 KiB
Common Lisp
Raw Blame History

;;-*-Lisp-*-
(in-package goal)
;; name: load-boundary.gc
;; name in dgo: load-boundary
;; dgos: GAME, ENGINE
;; the editor state
(deftype lb-editor-parms (basic)
((boundary load-boundary :offset-assert 4)
(vertex int32 :offset-assert 8)
(x-origin float :offset-assert 12)
(z-origin float :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
(define *lb-editor-parms* (new 'global 'lb-editor-parms))
(set! (-> *lb-editor-parms* boundary) #f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Editor Rendering
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-extern triangulate-boundary (function load-boundary object))
(define-extern find-bounding-circle (function load-boundary none))
(define-extern check-boundary (function load-boundary none))
(define-extern split-monotone-polygon (function load-boundary int none))
(define-extern fix-boundary-normals (function load-boundary none))
;; The editor uses the same system as sky for drawing large polygons.
;; using mips2c so we get the regs in C++.
(def-mips2c init-boundary-regs (function none))
#|
(defun-debug init-boundary-regs ()
(local-vars (v1-2 float))
(rlet ((vf0 :class vf)
(vf13 :class vf)
(vf14 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf)
)
(init-vf0-vector)
(let ((v1-0 *math-camera*))
(set-vector!
(-> *sky-tng-data* fog)
(-> v1-0 pfog0)
(-> v1-0 fog-min)
(-> v1-0 fog-max)
3071.0
)
(.lvf vf31 (&-> v1-0 camera-temp vector 0 quad))
(.lvf vf30 (&-> v1-0 camera-temp vector 1 quad))
(.lvf vf29 (&-> v1-0 camera-temp vector 2 quad))
(.lvf vf28 (&-> v1-0 camera-temp vector 3 quad))
(.lvf vf14 (&-> v1-0 hmge-scale quad))
(.lvf vf26 (&-> v1-0 inv-hmge-scale quad))
(.lvf vf25 (&-> v1-0 hvdf-off quad))
)
(.lvf vf13 (&-> *sky-tng-data* fog quad))
(.mul.vf vf31 vf31 vf14)
(.mul.vf vf30 vf30 vf14)
(.mul.vf vf29 vf29 vf14)
(.mul.vf vf28 vf28 vf14)
(.mov.vf vf24 vf0)
(.mov v1-2 vf24)
0
(none)
)
)
|#
(defun-debug add-boundary-shader ((arg0 texture-id) (arg1 dma-buffer))
"Add the adgif shader to the dma-buffer. It's never changed during load boundary rendering"
(let* ((v1-0 arg1)
(a1-1 (the-as object (-> v1-0 base)))
)
(set!
(-> (the-as gs-gif-tag a1-1) tag)
(new 'static 'gif-tag64 :nloop #x1 :nreg #x5)
)
(set!
(-> (the-as gs-gif-tag a1-1) regs)
(new 'static 'gif-tag-regs
:regs0 (gif-reg-id a+d)
:regs1 (gif-reg-id a+d)
:regs2 (gif-reg-id a+d)
:regs3 (gif-reg-id a+d)
:regs4 (gif-reg-id a+d)
)
)
(set! (-> v1-0 base) (&+ (the-as pointer a1-1) 16))
)
(let ((s5-0 (the-as adgif-shader (-> arg1 base))))
(adgif-shader<-texture-simple! s5-0 (lookup-texture-by-id arg0))
(set! (-> s5-0 alpha) (new 'static 'gs-alpha :b #x1 :d #x1))
(set! (-> s5-0 tex0 tfx) 0)
(set! (-> s5-0 tex1 mmag) 0)
(set! (-> s5-0 clamp) (new 'static 'gs-clamp))
)
0
(&+! (-> arg1 base) 80)
(none)
)
;; note: draw-boundary-polygon is in C++ only, called from the two functions below.
;; render-boundary-quad
(def-mips2c render-boundary-quad (function lbvtx dma-buffer none))
;; render-boundary-tri
(def-mips2c render-boundary-tri (function lbvtx dma-buffer none))
;; the polygon curently rendering.
(define *boundary-polygon* (new 'static 'inline-array lbvtx 12
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
(new 'static 'lbvtx)
)
)
(defun-debug draw-boundary-side ((arg0 load-boundary) (arg1 integer) (arg2 integer) (arg3 dma-buffer) (arg4 symbol))
(rlet ((vf27 :class vf))
(let ((v1-2 (-> arg0 data arg1)))
(let ((a1-3 (-> arg0 data arg2)))
(let ((a2-2 (-> *boundary-polygon* 0)))
(set! (-> a2-2 x) (-> v1-2 x))
(set! (-> a2-2 y) (-> arg0 bot-plane))
(set! (-> a2-2 z) (-> v1-2 z))
(set! (-> a2-2 v w) 1.0)
)
(let ((a2-4 (-> *boundary-polygon* 3)))
(set! (-> a2-4 x) (-> a1-3 x))
(set! (-> a2-4 y) (-> arg0 bot-plane))
(set! (-> a2-4 z) (-> a1-3 z))
(set! (-> a2-4 v w) 1.0)
)
(let ((a2-6 (-> *boundary-polygon* 6)))
(set! (-> a2-6 x) (-> a1-3 x))
(set! (-> a2-6 y) (-> arg0 top-plane))
(set! (-> a2-6 z) (-> a1-3 z))
(set! (-> a2-6 v w) 1.0)
)
)
(let ((a1-5 (-> *boundary-polygon* 9)))
(set! (-> a1-5 x) (-> v1-2 x))
(set! (-> a1-5 y) (-> arg0 top-plane))
(set! (-> a1-5 z) (-> v1-2 z))
(set! (-> a1-5 v w) 1.0)
)
)
(cond
(arg4
(let ((v1-4 (-> *boundary-polygon* 1)))
(set! (-> v1-4 x) 0.0)
(set! (-> v1-4 y) 0.0)
(set! (-> v1-4 z) 1.0)
(set! (-> v1-4 v w) 1.0)
)
(let ((v1-6 (-> *boundary-polygon* 4)))
(set! (-> v1-6 x) 1.0)
(set! (-> v1-6 y) 0.0)
(set! (-> v1-6 z) 1.0)
(set! (-> v1-6 v w) 1.0)
)
(let ((v1-8 (-> *boundary-polygon* 7)))
(set! (-> v1-8 x) 1.0)
(set! (-> v1-8 y) 8.0)
(set! (-> v1-8 z) 1.0)
(set! (-> v1-8 v w) 1.0)
)
(let ((v1-10 (-> *boundary-polygon* 10)))
(set! (-> v1-10 x) 0.0)
(set! (-> v1-10 y) 8.0)
(set! (-> v1-10 z) 1.0)
(set! (-> v1-10 v w) 1.0)
)
)
(else
(let ((v1-12 (-> *boundary-polygon* 1)))
(set! (-> v1-12 x) 1.0)
(set! (-> v1-12 y) 0.0)
(set! (-> v1-12 z) 1.0)
(set! (-> v1-12 v w) 1.0)
)
(let ((v1-14 (-> *boundary-polygon* 4)))
(set! (-> v1-14 x) 0.0)
(set! (-> v1-14 y) 0.0)
(set! (-> v1-14 z) 1.0)
(set! (-> v1-14 v w) 1.0)
)
(let ((v1-16 (-> *boundary-polygon* 7)))
(set! (-> v1-16 x) 0.0)
(set! (-> v1-16 y) 8.0)
(set! (-> v1-16 z) 1.0)
(set! (-> v1-16 v w) 1.0)
)
(let ((v1-18 (-> *boundary-polygon* 10)))
(set! (-> v1-18 x) 1.0)
(set! (-> v1-18 y) 8.0)
(set! (-> v1-18 z) 1.0)
(set! (-> v1-18 v w) 1.0)
)
)
)
(init-boundary-regs)
;;(.lvf vf27 (&-> *sky-tng-data* giftag-roof qword))
(set-sky-vf27 (&-> *sky-tng-data* giftag-roof qword))
(render-boundary-quad (-> *boundary-polygon* 0) arg3)
0
(none)
)
)
(defun-debug draw-boundary-cap ((arg0 load-boundary) (arg1 float) (arg2 dma-buffer) (arg3 symbol))
(rlet ((vf27 :class vf))
(dotimes (s2-0 (-> arg0 tri-cnt))
(let ((a1-1 (-> arg0 data (-> arg0 data s2-0 v0)))
(a0-1 (-> arg0 data (-> arg0 data s2-0 v1)))
(v1-15 (-> arg0 data (-> arg0 data s2-0 v2)))
)
(let ((a2-2 (-> *boundary-polygon* 0)))
(set! (-> a2-2 x) (-> a1-1 x))
(set! (-> a2-2 y) arg1)
(set! (-> a2-2 z) (-> a1-1 z))
(set! (-> a2-2 v w) 1.0)
)
(let ((a1-3 (-> *boundary-polygon* 3)))
(set! (-> a1-3 x) (-> a0-1 x))
(set! (-> a1-3 y) arg1)
(set! (-> a1-3 z) (-> a0-1 z))
(set! (-> a1-3 v w) 1.0)
)
(let ((a0-3 (-> *boundary-polygon* 6)))
(set! (-> a0-3 x) (-> v1-15 x))
(set! (-> a0-3 y) arg1)
(set! (-> a0-3 z) (-> v1-15 z))
(set! (-> a0-3 v w) 1.0)
)
)
(cond
(arg3
(let ((v1-17 (-> *boundary-polygon* 1)))
(set! (-> v1-17 x) 0.0)
(set! (-> v1-17 y) 0.0)
(set! (-> v1-17 z) 1.0)
(set! (-> v1-17 v w) 1.0)
)
(let ((v1-19 (-> *boundary-polygon* 4)))
(set! (-> v1-19 x) 0.0)
(set! (-> v1-19 y) 1.0)
(set! (-> v1-19 z) 1.0)
(set! (-> v1-19 v w) 1.0)
)
(let ((v1-21 (-> *boundary-polygon* 7)))
(set! (-> v1-21 x) 1.0)
(set! (-> v1-21 y) 0.0)
(set! (-> v1-21 z) 1.0)
(set! (-> v1-21 v w) 1.0)
)
)
(else
(let ((v1-23 (-> *boundary-polygon* 1)))
(set! (-> v1-23 x) 1.0)
(set! (-> v1-23 y) 0.0)
(set! (-> v1-23 z) 1.0)
(set! (-> v1-23 v w) 1.0)
)
(let ((v1-25 (-> *boundary-polygon* 4)))
(set! (-> v1-25 x) 1.0)
(set! (-> v1-25 y) 1.0)
(set! (-> v1-25 z) 1.0)
(set! (-> v1-25 v w) 1.0)
)
(let ((v1-27 (-> *boundary-polygon* 7)))
(set! (-> v1-27 x) 0.0)
(set! (-> v1-27 y) 0.0)
(set! (-> v1-27 z) 1.0)
(set! (-> v1-27 v w) 1.0)
)
)
)
(init-boundary-regs)
;;(.lvf vf27 (&-> *sky-tng-data* giftag-roof qword))
(set-sky-vf27 (&-> *sky-tng-data* giftag-roof qword))
(render-boundary-tri (-> *boundary-polygon* 0) arg2)
)
0
(none)
)
)
(defun-debug boundary-set-color ((arg0 lbvtx) (arg1 load-boundary-crossing-command))
"Set the color based on the color."
(case (-> arg1 cmd)
(((load-boundary-cmd load))
(let ((v1-1 arg0))
(set! (-> v1-1 x) 128.0)
(set! (-> v1-1 y) 128.0)
(set! (-> v1-1 z) 128.0)
(set! (-> v1-1 v w) 128.0)
)
)
(((load-boundary-cmd cmd2))
(let ((v1-2 arg0))
(set! (-> v1-2 x) 0.0)
(set! (-> v1-2 y) 0.0)
(set! (-> v1-2 z) 0.0)
(set! (-> v1-2 v w) 128.0)
)
)
(((load-boundary-cmd display))
(cond
((-> arg1 lev1)
(let ((v1-4 arg0))
(set! (-> v1-4 x) 128.0)
(set! (-> v1-4 y) 128.0)
(set! (-> v1-4 z) 0.0)
(set! (-> v1-4 v w) 128.0)
)
)
(else
(let ((v1-5 arg0))
(set! (-> v1-5 x) 64.0)
(set! (-> v1-5 y) 64.0)
(set! (-> v1-5 z) 0.0)
(set! (-> v1-5 v w) 128.0)
)
)
)
)
(((load-boundary-cmd vis))
(let ((v1-6 arg0))
(set! (-> v1-6 x) 128.0)
(set! (-> v1-6 y) 0.0)
(set! (-> v1-6 z) 0.0)
(set! (-> v1-6 v w) 128.0)
)
)
(((load-boundary-cmd checkpt))
(let ((v1-7 arg0))
(set! (-> v1-7 x) 0.0)
(set! (-> v1-7 y) 128.0)
(set! (-> v1-7 z) 128.0)
(set! (-> v1-7 v w) 128.0)
)
)
(else
(let ((v1-8 arg0))
(set! (-> v1-8 x) 64.0)
(set! (-> v1-8 y) 64.0)
(set! (-> v1-8 z) 64.0)
(set! (-> v1-8 v w) 128.0)
)
)
)
0
(none)
)
(defun-debug render-boundary ((arg0 load-boundary))
(let ((s3-0 (or (!= arg0 (-> *lb-editor-parms* boundary))
(logtest? (-> *display* real-actual-frame-counter) 4)
)
))
(with-dma-buffer-add-bucket ((s5-0 (-> (current-frame) global-buf)) (bucket-id debug-draw0))
(dma-buffer-add-gs-set-flusha s5-0
(zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24)))
(test-1 (new 'static 'gs-test :ate #x1 :atst (gs-atest greater-equal) :aref #x26 :zte #x1 :ztst (gs-ztest greater-equal)))
(alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1))
)
(boundary-set-color (-> *boundary-polygon* 2) (-> arg0 cmd-fwd))
(boundary-set-color (-> *boundary-polygon* 5) (-> arg0 cmd-bwd))
(with-cnt-vif-block-qwc (s5-0)
(add-boundary-shader (new 'static 'texture-id :index #x33 :page #x2) s5-0)
(cond
((logtest? (-> arg0 flags) (load-boundary-flags closed))
(draw-boundary-cap arg0 (-> arg0 top-plane) s5-0 s3-0)
)
(else
(dotimes (s1-0 (the-as int (+ (-> arg0 num-points) -1)))
(draw-boundary-side arg0 s1-0 (+ s1-0 1) s5-0 s3-0)
)
)
)
(close-sky-buffer s5-0)
)
)
)
0
(none)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
;; Load Boundary File
;;;;;;;;;;;;;;;;;;;;;;;;;
;; the load-boundary-data.gc file can be re-generated after editing load boundaries.
(defmacro static-lb-list (&rest lbs)
`(new 'static 'boxed-array :type array :length ,(length lbs) :allocated-length ,(length lbs)
,@(reverse lbs)
)
)
(defmacro static-load-boundary (&key flags
&key top &key bot
&key points
&key (fwd (invalid #f #f))
&key (bwd (invalid #f #f)))
`(new 'static 'boxed-array :type object :length 4 :allocated-length 4
(the binteger (load-boundary-flags ,@flags))
(new 'static 'boxed-array :type float :length ,(+ 2 (length points)) :allocated-length ,(+ 2 (length points))
,top ,bot
,@points
)
'((the binteger (load-boundary-cmd ,(first fwd))) ,(second fwd) ,(third fwd))
'((the binteger (load-boundary-cmd ,(first bwd))) ,(second bwd) ,(third bwd))
)
)
(defun-debug format-boundary-cmd ((arg0 load-boundary-crossing-command))
(case (-> arg0 cmd)
(((load-boundary-cmd load))
(format *stdcon* " LOAD(~A,~A)~%" (-> arg0 lev0) (-> arg0 lev1))
)
(((load-boundary-cmd cmd2))
)
(((load-boundary-cmd display))
(if (-> arg0 lev1)
(format *stdcon* " DISPLAY(~A,~A)~%" (-> arg0 lev0) (-> arg0 lev1))
(format *stdcon* " DISPLAY(~A,OFF)~%" (-> arg0 lev0))
)
)
(((load-boundary-cmd vis))
(format *stdcon* " VIS(~A)~%" (-> arg0 lev0))
)
(((load-boundary-cmd checkpt))
(format *stdcon* " CHECKPT(~A)~%" (-> arg0 lev0))
)
)
0
(none)
)
(defun-debug edit-load-boundaries ()
(let* ((gp-0 *lb-editor-parms*)
(s5-0 (-> gp-0 boundary))
)
(format *stdcon* "~3L")
(cond
((not s5-0)
(format *stdcon* "No load boundary selected - use Player 2 pad to select~%")
)
(else
(format *stdcon* "Selected load boundary ~X~%" s5-0)
(if (logtest? (-> s5-0 flags) (load-boundary-flags player))
(format *stdcon* "PLAYER activated~%")
(format *stdcon* "CAMERA activated~%")
)
(when (nonzero? (-> s5-0 cmd-fwd cmd))
(format *stdcon* "in->out~%")
(format-boundary-cmd (-> s5-0 cmd-fwd))
)
(when (nonzero? (-> s5-0 cmd-bwd cmd))
(format *stdcon* "out->in~%")
(format-boundary-cmd (-> s5-0 cmd-bwd))
)
)
)
(format *stdcon* "~0L")
(let ((s3-0 (new 'stack-no-clear 'vector))
(s4-0 (new 'stack-no-clear 'vector))
)
(set! (-> s3-0 quad) (-> *math-camera* inv-camera-rot vector 0 quad))
(set! (-> s4-0 quad) (-> *math-camera* inv-camera-rot vector 1 quad))
(set! (-> s3-0 y) 0.0)
(set! (-> s4-0 y) 0.0)
(when (and s5-0 (!= -1 (-> gp-0 vertex)))
(let ((s2-0 (new 'stack-no-clear 'vector)))
(set! (-> s2-0 quad) (-> s5-0 data (-> gp-0 vertex) quad))
(set! (-> s2-0 y) (-> s5-0 top-plane))
(add-debug-sphere
#t
(bucket-id debug-draw1)
s2-0
8192.0
(new 'static 'rgba :a #x80)
)
(when (zero? (logand (-> s5-0 flags) (load-boundary-flags closed)))
(set! (-> s2-0 y) (-> s5-0 bot-plane))
(add-debug-sphere
#t
(bucket-id debug-draw1)
s2-0
8192.0
(new 'static 'rgba :a #x80)
)
)
)
)
(let* ((f30-1 (* 4096.0 (analog-input (the-as int (-> *cpad-list* cpads 1 leftx)) 128.0 48.0 110.0 -1.0)))
(f28-1 (* 4096.0 (analog-input (the-as int (-> *cpad-list* cpads 1 lefty)) 128.0 48.0 110.0 -1.0)))
(f30-2 (+ f30-1 (* 409.6 (analog-input (the-as int (-> *cpad-list* cpads 1 rightx)) 128.0 48.0 110.0 -1.0))))
(f0-10 (+ f28-1 (* 409.6 (analog-input (the-as int (-> *cpad-list* cpads 1 righty)) 128.0 48.0 110.0 -1.0))))
)
(cond
((logtest? (-> *cpad-list* cpads 1 button0-abs 0) (pad-buttons x))
(cond
((= (-> gp-0 vertex) -1)
(dotimes (v1-37 (the-as int (-> s5-0 num-points)))
(+! (-> s5-0 data v1-37 x) (* f30-2 (-> s3-0 x)))
(+! (-> s5-0 data v1-37 z) (* f30-2 (-> s3-0 z)))
(+! (-> s5-0 data v1-37 x) (* f0-10 (-> s4-0 x)))
(+! (-> s5-0 data v1-37 z) (* f0-10 (-> s4-0 z)))
)
)
(else
(+! (-> s5-0 data (-> gp-0 vertex) x) (* f30-2 (-> s3-0 x)))
(+! (-> s5-0 data (-> gp-0 vertex) z) (* f30-2 (-> s3-0 z)))
(+! (-> s5-0 data (-> gp-0 vertex) x) (* f0-10 (-> s4-0 x)))
(+! (-> s5-0 data (-> gp-0 vertex) z) (* f0-10 (-> s4-0 z)))
)
)
(set! (-> s5-0 tri-cnt) 0)
0
)
((logtest? (-> *cpad-list* cpads 1 button0-abs 0) (pad-buttons r1))
(if s5-0
(+! (-> s5-0 top-plane) f0-10)
)
)
((logtest? (-> *cpad-list* cpads 1 button0-abs 0) (pad-buttons r2))
(if s5-0
(+! (-> s5-0 bot-plane) f0-10)
)
)
((logtest? (-> *cpad-list* cpads 1 button0-rel 0) (pad-buttons up))
(if s5-0
(set! s5-0 (-> s5-0 next))
(set! s5-0 *load-boundary-list*)
)
(set! (-> gp-0 vertex) -1)
)
((logtest? (-> *cpad-list* cpads 1 button0-rel 0) (pad-buttons down))
(cond
((= s5-0 *load-boundary-list*)
(set! s5-0 (the-as load-boundary #f))
)
(else
(let ((v1-95 *load-boundary-list*))
(while v1-95
(when (= s5-0 (-> v1-95 next))
(set! s5-0 v1-95)
(set! v1-95 (the-as load-boundary #f))
)
(if v1-95
(set! v1-95 (-> v1-95 next))
)
)
)
)
)
(set! (-> gp-0 vertex) -1)
)
((logtest? (-> *cpad-list* cpads 1 button0-rel 0) (pad-buttons right))
(+! (-> gp-0 vertex) 1)
(if (= (-> gp-0 vertex) (-> s5-0 num-points))
(set! (-> gp-0 vertex) -1)
)
)
((logtest? (-> *cpad-list* cpads 1 button0-rel 0) (pad-buttons left))
(+! (-> gp-0 vertex) -1)
(if (= (-> gp-0 vertex) -2)
(set! (-> gp-0 vertex) (the-as int (+ (-> s5-0 num-points) -1)))
)
)
)
)
)
(set! (-> gp-0 boundary) s5-0)
)
0
(none)
)
(defun-debug copy-load-command! ((arg0 load-boundary-crossing-command) (arg1 load-boundary-crossing-command))
(set! (-> arg0 cmd) (-> arg1 cmd))
(dotimes (v1-1 3)
(set! (-> arg0 bparm v1-1) (-> arg1 bparm v1-1))
)
(dotimes (v1-4 2)
(set! (-> arg0 parm v1-4) (-> arg1 parm v1-4))
)
0
(none)
)
(defun-debug copy-load-boundary! ((arg0 load-boundary) (arg1 load-boundary))
(set! (-> arg0 flags) (-> arg1 flags))
(set! (-> arg0 top-plane) (-> arg1 top-plane))
(set! (-> arg0 bot-plane) (-> arg1 bot-plane))
(set! (-> arg0 tri-cnt) 0)
(copy-load-command! (-> arg0 cmd-fwd) (-> arg1 cmd-fwd))
(copy-load-command! (-> arg0 cmd-bwd) (-> arg1 cmd-bwd))
0
(none)
)
(defun-debug replace-load-boundary ((arg0 load-boundary) (arg1 load-boundary))
(set! (-> arg1 next) (-> arg0 next))
(if (= (-> *lb-editor-parms* boundary) arg0)
(set! (-> *lb-editor-parms* boundary) arg1)
)
(when (= arg0 *load-boundary-list*)
(set! *load-boundary-list* arg1)
(return 0)
)
(let ((v1-9 *load-boundary-list*))
(while (and v1-9 (!= (-> v1-9 next) arg0))
(set! v1-9 (-> v1-9 next))
)
(when v1-9
(set! (-> v1-9 next) arg1)
(return 0)
)
)
(format 0 "ERROR: Couldn't find old boundary in list!!!!~%")
0
(none)
)
(defun-debug lb-del ()
(let ((v1-1 (-> *lb-editor-parms* boundary)))
(set! (-> *lb-editor-parms* boundary) #f)
(when (not v1-1)
(format 0 "No boundary selected~%")
(return 0)
)
(when (= v1-1 *load-boundary-list*)
(set! *load-boundary-list* (-> v1-1 next))
(return 0)
)
(let ((a0-5 *load-boundary-list*))
(while (and a0-5 (!= (-> a0-5 next) v1-1))
(set! a0-5 (-> a0-5 next))
)
(when a0-5
(set! (-> a0-5 next) (-> v1-1 next))
(return 0)
)
)
)
(format 0 "ERROR: Couldn't find old boundary in list!!!!~%")
0
(none)
)
(defun-debug lb-add-vtx-before ()
(let* ((v1-0 *lb-editor-parms*)
(gp-0 (-> v1-0 boundary))
(s4-0 (-> v1-0 vertex))
)
(when (not gp-0)
(format 0 "No boundary selected~%")
(return 0)
)
(when (= s4-0 -1)
(format 0 "No vertex selected~%")
(return 0)
)
(let ((s5-0 (new 'global 'load-boundary (the-as int (+ (-> gp-0 num-points) 1)) #f #f)))
(copy-load-boundary! s5-0 gp-0)
(let ((v1-8 0))
(while (< v1-8 s4-0)
(set! (-> s5-0 data v1-8 quad) (-> gp-0 data v1-8 quad))
(+! v1-8 1)
)
(cond
((zero? s4-0)
(set! (-> s5-0 data v1-8 x)
(* 0.5 (+ (-> gp-0 data 0 x) (-> gp-0 data (+ (-> gp-0 num-points) -1) x))))
(set! (-> s5-0 data v1-8 z)
(* 0.5 (+ (-> gp-0 data 0 z) (-> gp-0 data (+ (-> gp-0 num-points) -1) z))))
)
(else
(set! (-> s5-0 data v1-8 x)
(* 0.5 (+ (-> gp-0 data (+ s4-0 -1) x) (-> gp-0 data s4-0 x)))
)
(set! (-> s5-0 data v1-8 z)
(* 0.5 (+ (-> gp-0 data (+ s4-0 -1) z) (-> gp-0 data s4-0 z)))
)
)
)
(let ((v1-9 (+ v1-8 1)))
(while (>= (the-as int (-> gp-0 num-points)) v1-9)
(set! (-> s5-0 data v1-9 quad) (-> gp-0 data (+ v1-9 -1) quad))
(+! v1-9 1)
)
)
)
(replace-load-boundary gp-0 s5-0)
)
)
0
(none)
)
(defun-debug lb-add-vtx-after ()
(let ((gp-0 *lb-editor-parms*))
(let ((s5-0 (-> gp-0 boundary))
(s3-0 (-> gp-0 vertex))
)
(when (not s5-0)
(format 0 "No boundary selected~%")
(return 0)
)
(when (= s3-0 -1)
(format 0 "No vertex selected~%")
(return 0)
)
(let ((s4-0 (new 'global 'load-boundary (the-as int (+ (-> s5-0 num-points) 1)) #f #f)))
(copy-load-boundary! s4-0 s5-0)
(let ((v1-7 0))
(while (>= s3-0 v1-7)
(set! (-> s4-0 data v1-7 quad) (-> s5-0 data v1-7 quad))
(+! v1-7 1)
)
(cond
((= s3-0 (+ (-> s5-0 num-points) -1))
(set! (-> s4-0 data v1-7 x)
(* 0.5 (+ (-> s5-0 data 0 x) (-> s5-0 data (+ (-> s5-0 num-points) -1) x)))
)
(set! (-> s4-0 data v1-7 z)
(* 0.5 (+ (-> s5-0 data 0 z) (-> s5-0 data (+ (-> s5-0 num-points) -1) z)))
)
)
(else
(set! (-> s4-0 data v1-7 x)
(* 0.5 (+ (-> s5-0 data (+ s3-0 1) x) (-> s5-0 data s3-0 x)))
)
(set! (-> s4-0 data v1-7 z)
(* 0.5 (+ (-> s5-0 data (+ s3-0 1) z) (-> s5-0 data s3-0 z)))
)
)
)
(let ((v1-8 (+ v1-7 1)))
(while (>= (the-as int (-> s5-0 num-points)) v1-8)
(set! (-> s4-0 data v1-8 quad) (-> s5-0 data (+ v1-8 -1) quad))
(+! v1-8 1)
)
)
)
(replace-load-boundary s5-0 s4-0)
)
)
(+! (-> gp-0 vertex) 1)
)
0
(none)
)
(defun-debug lb-del-vtx ()
(let* ((gp-0 *lb-editor-parms*)
(s5-0 (-> gp-0 boundary))
)
(let ((s3-0 (-> gp-0 vertex)))
(when (not s5-0)
(format 0 "No boundary selected~%")
(return 0)
)
(when (= s3-0 -1)
(format 0 "No vertex selected~%")
(return 0)
)
(let ((s4-0 (new 'global 'load-boundary (the-as int (+ (-> s5-0 num-points) -1)) #f #f)))
(copy-load-boundary! s4-0 s5-0)
(let ((v1-7 0))
(while (< v1-7 s3-0)
(set! (-> s4-0 data v1-7 quad) (-> s5-0 data v1-7 quad))
(+! v1-7 1)
)
(let ((v1-8 (+ v1-7 1)))
(while (< v1-8 (the-as int (-> s5-0 num-points)))
(set! (-> s4-0 data (+ v1-8 -1) quad) (-> s5-0 data v1-8 quad))
(+! v1-8 1)
)
)
)
(replace-load-boundary s5-0 s4-0)
)
)
(if (= (-> gp-0 vertex) (+ (-> s5-0 num-points) -1))
(set! (-> gp-0 vertex) -1)
)
)
0
(none)
)
(defun-debug save-boundary-cmd ((arg0 load-boundary-crossing-command) (arg1 string) (arg2 object))
(case (-> arg0 cmd)
(((load-boundary-cmd load))
(format arg2 " :~S (load ~A ~A)~%" arg1 (-> arg0 lev0) (-> arg0 lev1))
)
(((load-boundary-cmd cmd2))
)
(((load-boundary-cmd display))
(format arg2 " :~S (display ~A ~A)~%" arg1 (-> arg0 lev0) (-> arg0 lev1))
)
(((load-boundary-cmd vis))
(format arg2 " :~S (vis ~A #f)~%" arg1 (-> arg0 lev0))
)
(((load-boundary-cmd force-vis))
(format arg2 " :~S (force-vis ~A ~A)~%" arg1 (-> arg0 lev0) (-> arg0 lev1))
)
(((load-boundary-cmd checkpt))
(format arg2 " :~S (checkpt ~A #f)~%" arg1 (-> arg0 lev0))
)
)
0
(none)
)
(defun load-boundary-from-template ((arg0 (array object)))
(let* ((s5-0 (the-as (array float) (-> arg0 1)))
(a2-0 (+ (/ (-> s5-0 length) 2) -1))
(v0-0 (new 'global 'load-boundary a2-0 #f #t))
)
(set!
(-> v0-0 flags)
(the-as load-boundary-flags (/ (the-as int (-> arg0 0)) 8))
)
(set! (-> v0-0 top-plane) (-> s5-0 0))
(set! (-> v0-0 bot-plane) (-> s5-0 1))
(let ((v1-5 2))
(while (< v1-5 (-> s5-0 length))
(let ((a0-6 (-> v0-0 data (+ (/ v1-5 2) -1))))
(set! (-> a0-6 x) (-> s5-0 v1-5))
(set! (-> a0-6 z) (-> s5-0 (+ v1-5 1)))
)
(+! v1-5 2)
)
)
(let ((v1-7 (-> v0-0 cmd-fwd))
(a0-9 (-> arg0 2))
)
(set!
(-> v1-7 cmd)
(the-as load-boundary-cmd (/ (the-as int (car (the-as pair a0-9))) 8))
)
(set! (-> v1-7 lev0) (the-as basic (car (cdr a0-9))))
(set! (-> v1-7 lev1) (the-as basic (car (cdr (cdr a0-9)))))
)
(let ((v1-8 (-> v0-0 cmd-bwd))
(a0-13 (-> arg0 3))
)
(set!
(-> v1-8 cmd)
(the-as load-boundary-cmd (/ (the-as int (car (the-as pair a0-13))) 8))
)
(set! (-> v1-8 lev0) (the-as basic (car (cdr a0-13))))
(set! (-> v1-8 lev1) (the-as basic (car (cdr (cdr a0-13)))))
)
)
(none)
)
(defun-debug ---lb-save ()
(clear *temp-string*)
(format *temp-string* "game/load-boundary-data.gc")
(let ((gp-0 (new 'stack 'file-stream *temp-string* 'write)))
(format gp-0 ";-*-Lisp-*-~%")
(format gp-0 "(in-package goal)~%~%")
(format gp-0 ";; reset boundary in editor~%")
(format gp-0 "(set! (-> *lb-editor-parms* boundary) #f)~%~%")
(format gp-0 ";; reset all existing load boundaries~%")
(format gp-0 "(set! *load-boundary-list* #f)~%~%")
(format
gp-0
"(define *static-load-boundary-list* (new 'static 'array 'array 0~%~%"
)
(let ((s5-0 *load-boundary-list*))
(while s5-0
(format
gp-0
"(static-load-boundary :flags (~S~S)~%"
(if (logtest? (-> s5-0 flags) (load-boundary-flags closed))
"closed "
""
)
(if (logtest? (-> s5-0 flags) (load-boundary-flags player))
"player "
""
)
)
(format
gp-0
" :top ~f :bot ~f~%"
(-> s5-0 top-plane)
(-> s5-0 bot-plane)
)
(format gp-0 " :points (")
(dotimes (s4-0 (the-as int (-> s5-0 num-points)))
(format gp-0 " ~f ~f " (-> s5-0 data s4-0 x) (-> s5-0 data s4-0 z))
)
(format gp-0 ")~%")
(save-boundary-cmd (-> s5-0 cmd-fwd) "fwd" gp-0)
(save-boundary-cmd (-> s5-0 cmd-bwd) "bwd" gp-0)
(format gp-0 " )~%~%")
(set! s5-0 (-> s5-0 next))
)
)
(format
gp-0
"))~%~%(doarray (i *static-load-boundary-list*)~% (load-boundary-from-template i)~% )~%~%"
)
(file-stream-close gp-0)
)
(format 0 "Written ~S~%" *temp-string*)
0
(none)
)
(defun-debug lb-add ()
(let ((gp-0 (new 'global 'load-boundary 2 #f #t)))
(let ((v1-1 (camera-pos)))
(set! (-> gp-0 data 0 x) (-> v1-1 x))
(set! (-> gp-0 data 0 z) (-> v1-1 z))
(set! (-> gp-0 data2 1 x) (-> v1-1 x))
(set! (-> gp-0 data2 1 z) (+ 204800.0 (-> v1-1 z)))
)
(set! (-> *lb-editor-parms* boundary) gp-0)
(set! (-> *lb-editor-parms* vertex) -1)
gp-0
)
)
(defun-debug lb-add-plane ()
(let ((gp-0 (new 'global 'load-boundary 4 #t #t)))
(let ((v1-1 (camera-pos)))
(set! (-> gp-0 data 0 x) (-> v1-1 x))
(set! (-> gp-0 data 0 z) (-> v1-1 z))
(set! (-> gp-0 data2 1 x) (-> v1-1 x))
(set! (-> gp-0 data2 1 z) (+ 204800.0 (-> v1-1 z)))
(set! (-> gp-0 data2 2 x) (+ 204800.0 (-> v1-1 x)))
(set! (-> gp-0 data2 2 z) (+ 204800.0 (-> v1-1 z)))
(set! (-> gp-0 data2 3 x) (+ 204800.0 (-> v1-1 x)))
(set! (-> gp-0 data2 3 z) (-> v1-1 z))
)
(set! (-> *lb-editor-parms* boundary) gp-0)
(set! (-> *lb-editor-parms* vertex) -1)
gp-0
)
)
(defun-debug lb-add-load ((arg0 object) (arg1 object))
(let ((v1-0 (lb-add)))
(set! (-> v1-0 cmd-fwd cmd) (load-boundary-cmd load))
(set! (-> v1-0 cmd-fwd lev0) (the-as basic arg0))
(set! (-> v1-0 cmd-fwd lev1) (the-as basic arg1))
)
0
(none)
)
(defun-debug lb-add-load-plane ((arg0 object) (arg1 object))
(let ((v1-0 (lb-add-plane)))
(set! (-> v1-0 cmd-fwd cmd) (load-boundary-cmd load))
(set! (-> v1-0 cmd-fwd lev0) (the-as basic arg0))
(set! (-> v1-0 cmd-fwd lev1) (the-as basic arg1))
)
0
(none)
)
(defun lb-flip ()
(let ((gp-0 (-> *lb-editor-parms* boundary)))
(when (not gp-0)
(format 0 "No boundary selected~%")
(return 0)
)
(let ((s5-0 (new 'stack 'load-boundary-crossing-command)))
(copy-load-command! s5-0 (-> gp-0 cmd-fwd))
(copy-load-command! (-> gp-0 cmd-fwd) (-> gp-0 cmd-bwd))
(copy-load-command! (-> gp-0 cmd-bwd) s5-0)
)
)
(none)
)
(defun lb-set-camera ()
(let ((v1-1 (-> *lb-editor-parms* boundary)))
(when (not v1-1)
(format 0 "No boundary selected~%")
(return 0)
)
(logclear! (-> v1-1 flags) (load-boundary-flags player))
)
0
(none)
)
(defun lb-set-player ()
(let ((v1-1 (-> *lb-editor-parms* boundary)))
(when (not v1-1)
(format 0 "No boundary selected~%")
(return 0)
)
(logior! (-> v1-1 flags) (load-boundary-flags player))
)
0
(none)
)
(defun-debug lb-copy ()
(let ((s5-0 (-> *lb-editor-parms* boundary)))
(when (not s5-0)
(format 0 "No boundary selected~%")
(return 0)
)
(let
((gp-0 (new 'global 'load-boundary (the-as int (-> s5-0 num-points)) #f #t))
)
(copy-load-boundary! gp-0 s5-0)
(dotimes (v1-4 (the-as int (-> s5-0 num-points)))
(set! (-> gp-0 data v1-4 quad) (-> s5-0 data v1-4 quad))
)
(set! (-> *lb-editor-parms* boundary) gp-0)
)
)
0
(none)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Main Load Render Hook
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun render-boundaries ()
(when (-> *level* border?)
(set! (-> *load-boundary-target* 2 quad) (-> *load-boundary-target* 0 quad))
(set! (-> *load-boundary-target* 3 quad) (-> *load-boundary-target* 1 quad))
(set! (-> *load-boundary-target* 0 quad) (-> (camera-pos) quad))
(set! (-> *load-boundary-target* 1 quad) (-> (target-pos 0) quad))
(let ((gp-2 *load-boundary-list*))
(while gp-2
(when (zero? (-> gp-2 tri-cnt))
(triangulate-boundary gp-2)
(find-bounding-circle gp-2)
)
(if *display-load-boundaries*
(render-boundary gp-2)
)
(check-boundary gp-2)
(set! gp-2 (-> gp-2 next))
)
)
)
(if *display-load-boundaries*
(edit-load-boundaries)
)
0
(none)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The Math Stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun find-bounding-circle ((arg0 load-boundary))
(let ((f1-0 268435460.0)
(f3-0 -268435460.0)
(f0-0 268435460.0)
(f2-0 -268435460.0)
)
(dotimes (v1-0 (the-as int (-> arg0 num-points)))
(if (< (-> arg0 data v1-0 x) f1-0)
(set! f1-0 (-> arg0 data v1-0 x))
)
(if (< f3-0 (-> arg0 data v1-0 x))
(set! f3-0 (-> arg0 data v1-0 x))
)
(if (< (-> arg0 data v1-0 z) f0-0)
(set! f0-0 (-> arg0 data v1-0 z))
)
(if (< f2-0 (-> arg0 data v1-0 z))
(set! f2-0 (-> arg0 data v1-0 z))
)
)
(let* ((f3-2 (* 0.5 (+ f1-0 f3-0)))
(f2-2 (* 0.5 (+ f0-0 f2-0)))
(f1-1 (- f3-2 f1-0))
(f0-1 (- f2-2 f0-0))
(f0-4 (sqrtf (+ (* f1-1 f1-1) (* f0-1 f0-1))))
)
(set-vector! (-> arg0 rejector) f3-2 0.0 f2-2 f0-4)
)
)
0
(none)
)
(define *triangulation-buffer* (the-as (inline-array lbvtx) (malloc 'global 4096)))
(defun triangulate-boundary ((arg0 load-boundary))
(when (zero? (logand (-> arg0 flags) (load-boundary-flags closed)))
(set! (-> arg0 tri-cnt) 1)
(return (the-as object 0))
)
(let ((s5-0 *triangulation-buffer*))
(new 'stack 'lbvtx)
(let ((s4-0 (-> arg0 num-points)))
(set! (-> arg0 tri-cnt) 0)
(dotimes (v1-7 (the-as int s4-0))
(let ((a0-4 (-> arg0 data v1-7 quad)))
(set! (-> s5-0 v1-7 quad) a0-4)
)
(if (zero? v1-7)
(set! (-> s5-0 v1-7 v0) (+ s4-0 -1))
(set! (-> s5-0 v1-7 v0) (the-as uint (+ v1-7 -1)))
)
(cond
((= v1-7 (+ s4-0 -1))
(set! (-> s5-0 v1-7 v1) (the-as uint 0))
0
)
(else
(set! (-> s5-0 v1-7 v1) (the-as uint (+ v1-7 1)))
)
)
(set! (-> s5-0 v1-7 v2) (the-as uint 1))
)
(while #t
(let ((a1-11 -1))
(let ((f0-0 268435460.0))
(dotimes (v1-10 (the-as int s4-0))
(when (nonzero? (-> s5-0 v1-10 v2))
(when
(or
(< (-> s5-0 v1-10 z) f0-0)
(and
(= (-> s5-0 v1-10 z) f0-0)
(< (-> s5-0 v1-10 x) (-> s5-0 a1-11 x))
)
)
(set! f0-0 (-> s5-0 v1-10 z))
(set! a1-11 v1-10)
)
)
)
)
(let* ((v1-14 (-> s5-0 a1-11))
(a2-0 (-> s5-0 (-> v1-14 v0)))
(a0-36 (-> s5-0 (-> v1-14 v1)))
(f0-2 (- (-> v1-14 x) (-> a2-0 x)))
(f1-5 (- (-> v1-14 z) (-> a2-0 z)))
(f2-3 (- (-> a0-36 x) (-> v1-14 x)))
)
(when (< (- (* f0-2 (- (-> a0-36 z) (-> v1-14 z))) (* f2-3 f1-5)) 0.0)
(dotimes (v1-16 (the-as int s4-0))
(let ((a0-39 (-> s5-0 v1-16 v0)))
(set! (-> s5-0 v1-16 v0) (-> s5-0 v1-16 v1))
(set! (-> s5-0 v1-16 v1) a0-39)
)
)
)
)
(let ((s3-0 a1-11)
(a0-40 (-> s5-0 a1-11 v0))
(v1-23 (-> s5-0 a1-11 v1))
)
(let ((a2-6 0))
(while (>= (-> s5-0 a0-40 z) (-> s5-0 s3-0 z))
(set! s3-0 (the-as int a0-40))
(set! a0-40 (-> s5-0 (the-as uint s3-0) v0))
(+! a2-6 1)
(when (= a2-6 10)
(break!)
0
)
)
)
(while (and (!= s3-0 a1-11) (>= (-> s5-0 s3-0 z) (-> s5-0 a0-40 z)))
(set! s3-0 (the-as int a0-40))
(set! a0-40 (-> s5-0 (the-as uint s3-0) v0))
)
(when (= s3-0 a1-11)
(split-monotone-polygon arg0 a1-11)
(fix-boundary-normals arg0)
(return (the-as object 0))
)
(let ((s2-0 a1-11))
(while
(and
(>= (-> s5-0 v1-23 z) (-> s5-0 s2-0 z))
(>= (-> s5-0 s3-0 z) (-> s5-0 v1-23 z))
)
(set! s2-0 (the-as int v1-23))
(set! v1-23 (-> s5-0 (the-as uint s2-0) v1))
)
(let ((s1-0 (-> s5-0 s3-0 v0))
(s0-0 (-> s5-0 s2-0 v1))
)
(set! (-> s5-0 s3-0 v0) (the-as uint s2-0))
(set! (-> s5-0 s2-0 v1) (the-as uint s3-0))
(let ((v1-37 (-> s5-0 s3-0 v1)))
(while (!= v1-37 s2-0)
(set! (-> s5-0 v1-37 v2) (the-as uint 0))
(set! v1-37 (-> s5-0 v1-37 v1))
)
)
(split-monotone-polygon arg0 a1-11)
(set! (-> s5-0 s3-0 v0) s1-0)
(set! (-> s5-0 s2-0 v1) s0-0)
)
(set! (-> s5-0 s2-0 v0) (the-as uint s3-0))
(set! (-> s5-0 s3-0 v1) (the-as uint s2-0))
)
)
)
)
)
)
0
)
(defun try-corner ((arg0 object) (arg1 int))
(let* ((v1-0 *triangulation-buffer*)
(a0-3 (-> v1-0 arg1 v0))
(a1-3 (-> v1-0 arg1 v1))
(f0-1 (- (-> v1-0 a0-3 x) (-> v1-0 a1-3 x)))
(f1-2 (- (-> v1-0 a0-3 z) (-> v1-0 a1-3 z)))
(a2-10 (-> v1-0 a1-3 v1))
)
(while (!= a2-10 a0-3)
(let ((f2-2 (- (-> v1-0 a2-10 x) (-> v1-0 a1-3 x)))
(f3-2 (- (-> v1-0 a2-10 z) (-> v1-0 a1-3 z)))
)
(if (< (- (* f2-2 f1-2) (* f0-1 f3-2)) 0.0)
(return #f)
)
)
(set! a2-10 (-> v1-0 a2-10 v1))
)
)
#t
)
(defun split-monotone-polygon ((arg0 load-boundary) (arg1 int))
(let ((s5-0 *triangulation-buffer*))
(while #t
(when (= (-> s5-0 (-> s5-0 (-> s5-0 arg1 v0) v0) v0) arg1)
(let ((v1-10 (-> arg0 tri-cnt)))
(set! (-> arg0 data v1-10 v0) (the-as uint arg1))
(set! (-> arg0 data v1-10 v1) (-> s5-0 arg1 v0))
(set! (-> arg0 data v1-10 v2) (-> s5-0 (-> s5-0 arg1 v0) v0))
)
(+! (-> arg0 tri-cnt) 1)
(return 0)
)
(let ((s3-0 arg1))
(while (not (try-corner arg0 s3-0))
(set! s3-0 (the-as int (-> s5-0 s3-0 v1)))
(when (= (the-as uint s3-0) arg1)
)
)
(let ((a0-13 (-> arg0 tri-cnt)))
(set! arg1 (the-as int (-> s5-0 s3-0 v0)))
(let ((v1-25 (-> s5-0 s3-0 v1)))
(set! (-> arg0 data a0-13 v0) (the-as uint arg1))
(set! (-> arg0 data a0-13 v1) (the-as uint s3-0))
(set! (-> arg0 data a0-13 v2) v1-25)
(+! (-> arg0 tri-cnt) 1)
(set! (-> s5-0 (the-as uint arg1) v1) v1-25)
(set! (-> s5-0 v1-25 v0) (the-as uint arg1))
)
)
)
)
)
0
(none)
)
(defun fix-boundary-normals ((arg0 load-boundary))
(dotimes (s5-0 (-> arg0 tri-cnt))
(let ((a1-0 (-> arg0 data (-> arg0 data s5-0 v0)))
(a2-0 (-> arg0 data (-> arg0 data s5-0 v1)))
(a3-0 (-> arg0 data (-> arg0 data s5-0 v2)))
(s4-0 (new 'stack-no-clear 'vector))
)
(normal-of-plane
s4-0
(the-as vector a1-0)
(the-as vector a2-0)
(the-as vector a3-0)
)
(if (or (!= (-> s4-0 x) 0.0) (!= (-> s4-0 z) 0.0))
(format 0 "ERROR in the load-boundary code : tell Eddie!!!~%")
)
(when (< (-> s4-0 y) 0.0)
(let ((v1-22 (-> arg0 data s5-0 v0)))
(set! (-> arg0 data s5-0 v0) (-> arg0 data s5-0 v1))
(set! (-> arg0 data s5-0 v1) v1-22)
)
)
)
)
0
(none)
)
(defun point-in-polygon ((arg0 load-boundary) (arg1 vector))
(dotimes (v1-0 (-> arg0 tri-cnt))
(let* ((a2-5 (-> arg0 data (-> arg0 data v1-0 v0)))
(t0-0 (-> arg0 data (-> arg0 data v1-0 v1)))
(a3-10 (-> arg0 data (-> arg0 data v1-0 v2)))
(f0-1 (- (-> t0-0 x) (-> a3-10 x)))
(f1-2 (- (-> t0-0 z) (-> a3-10 z)))
(f2-2 (- (-> t0-0 x) (-> arg1 x)))
(f3-2 (- (-> t0-0 z) (-> arg1 z)))
)
(when (>= (- (* f2-2 f1-2) (* f0-1 f3-2)) 0.0)
(let ((f0-5 (- (-> t0-0 x) (-> arg1 x)))
(f1-7 (- (-> t0-0 z) (-> arg1 z)))
(f2-5 (- (-> t0-0 x) (-> a2-5 x)))
(f3-5 (- (-> t0-0 z) (-> a2-5 z)))
)
(when (>= (- (* f2-5 f1-7) (* f0-5 f3-5)) 0.0)
(let ((f0-9 (- (-> arg1 x) (-> a3-10 x)))
(f1-12 (- (-> arg1 z) (-> a3-10 z)))
(f2-8 (- (-> arg1 x) (-> a2-5 x)))
(f3-8 (- (-> arg1 z) (-> a2-5 z)))
)
(if (>= (- (* f2-8 f1-12) (* f0-9 f3-8)) 0.0)
(return #t)
)
)
)
)
)
)
)
#f
)
(defun check-closed-boundary ((arg0 load-boundary) (arg1 lbvtx) (arg2 lbvtx))
(if
(and (< (-> arg0 top-plane) (-> arg1 y)) (< (-> arg0 top-plane) (-> arg2 y)))
(return (the-as symbol 0))
)
(if
(and (< (-> arg1 y) (-> arg0 top-plane)) (< (-> arg2 y) (-> arg0 top-plane)))
(return (the-as symbol 0))
)
(let
((f0-6 (/ (- (-> arg1 y) (-> arg2 y)) (- (-> arg0 top-plane) (-> arg2 y))))
(a1-1 (new 'stack-no-clear 'vector))
)
(set! (-> a1-1 x) (+ (-> arg2 x) (* f0-6 (- (-> arg1 x) (-> arg2 x)))))
(set! (-> a1-1 y) (+ (-> arg2 y) (* f0-6 (- (-> arg1 y) (-> arg2 y)))))
(set! (-> a1-1 z) (+ (-> arg2 z) (* f0-6 (- (-> arg1 z) (-> arg2 z)))))
(when (point-in-polygon arg0 a1-1)
(if (< (-> arg0 top-plane) (-> arg1 y))
(return (the-as symbol 2))
)
(return (the-as symbol 1))
)
)
(the-as symbol 0)
)
(defun check-open-boundary ((arg0 load-boundary) (arg1 lbvtx) (arg2 lbvtx))
(let ((f0-0 (-> arg2 x))
(f1-0 (-> arg2 z))
(f2-0 (-> arg1 x))
(f3-0 (-> arg1 z))
(f6-0 (-> arg0 data 0 x))
(f7-0 (-> arg0 data 0 z))
(a3-0 1)
(v1-0 0)
)
(if (and (= f0-0 f2-0) (= f1-0 f3-0))
(return (the-as symbol 0))
)
(let ((f4-0 (- f2-0 f0-0))
(f5-0 (- f3-0 f1-0))
)
(while (< a3-0 (the-as int (-> arg0 num-points)))
(let ((f8-0 (-> arg0 data a3-0 x))
(f9-0 (-> arg0 data a3-0 z))
)
(let ((f10-2 (- (* (- f7-0 f1-0) f4-0) (* (- f6-0 f0-0) f5-0)))
(f11-4
(- (* (- f7-0 f1-0) (- f8-0 f6-0)) (* (- f6-0 f0-0) (- f9-0 f7-0)))
)
(f12-5 (- (* (- f8-0 f6-0) f5-0) (* (- f9-0 f7-0) f4-0)))
)
(when (!= f12-5 0.0)
(let ((f10-3 (/ f10-2 f12-5))
(f11-5 (/ f11-4 f12-5))
)
(if (and (>= f10-3 0.0) (>= 1.0 f10-3))
0
)
(when (and (>= f10-3 0.0) (>= 1.0 f10-3) (< 0.0 f11-5) (>= 1.0 f11-5))
(let ((f10-5 (+ (-> arg2 y) (* f10-3 (- (-> arg1 y) (-> arg2 y))))))
(when
(and (>= f10-5 (-> arg0 bot-plane)) (>= (-> arg0 top-plane) f10-5))
(let
((f6-3
(-
(* (- f2-0 f6-0) (- f9-0 f7-0))
(* (- f3-0 f7-0) (- f8-0 f6-0))
)
)
)
(if (< 0.0 f6-3)
(+! v1-0 1)
(+! v1-0 -1)
)
)
)
)
)
)
)
)
(set! f6-0 f8-0)
(set! f7-0 f9-0)
)
(+! a3-0 1)
)
)
(if (> v1-0 0)
(return (the-as symbol 1))
)
(if (< v1-0 0)
(return (the-as symbol 2))
)
)
(the-as symbol 0)
)
;;;;;;;;;;;;;;;;;;;;;;;;
;; Load Commands
;;;;;;;;;;;;;;;;;;;;;;;;
(defun command-get-int ((arg0 object) (arg1 int))
(cond
((null? arg0)
arg1
)
((type-type? (rtype-of arg0) binteger)
(/ (the-as int arg0) 8)
)
((type-type? (rtype-of arg0) bfloat)
(the int (-> (the-as bfloat arg0) data))
)
(else
arg1
)
)
)
(defun command-get-float ((arg0 object) (arg1 float))
(cond
((null? arg0)
arg1
)
((type-type? (rtype-of arg0) binteger)
(the float (/ (the-as int arg0) 8))
)
((type-type? (rtype-of arg0) bfloat)
(-> (the-as bfloat arg0) data)
)
(else
arg1
)
)
)
(defun command-get-time ((arg0 object) (arg1 int))
(cond
((null? arg0)
arg1
)
((and (pair? arg0) (= (car arg0) 'seconds))
(the int (* 300.0 (command-get-float (car (cdr arg0)) 0.0)))
)
((type-type? (rtype-of arg0) binteger)
(/ (the-as int arg0) 8)
)
((type-type? (rtype-of arg0) bfloat)
(the int (-> (the-as bfloat arg0) data))
)
(else
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-type? (rtype-of arg0) binteger)
(/ (the-as int arg0) 8)
)
((type-type? (rtype-of 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)
)
)
(defmethod reset! load-state ((obj load-state))
(set! (-> obj want 0 name) #f)
(set! (-> obj want 0 display?) #f)
(set! (-> obj want 0 force-vis?) #f)
(set! (-> obj want 0 force-inside?) #f)
(set! (-> obj want 1 name) #f)
(set! (-> obj want 1 display?) #f)
(set! (-> obj want 1 force-vis?) #f)
(set! (-> obj want 1 force-inside?) #f)
(set! (-> obj command-list) '())
(dotimes (v1-1 256)
(set! (-> obj object-name v1-1) #f)
(set! (-> obj object-status v1-1) (the-as basic 0))
)
obj
)
(defmethod want-levels load-state ((obj load-state) (arg0 symbol) (arg1 symbol))
(dotimes (v1-0 2)
(cond
((= (-> obj want v1-0 name) arg0)
(set! arg0 #f)
)
((= (-> obj want v1-0 name) arg1)
(set! arg1 #f)
)
(else
(set! (-> obj want v1-0 name) #f)
)
)
)
(when arg0
(dotimes (v1-4 2)
(when (not (-> obj want v1-4 name))
(set! (-> obj want v1-4 name) arg0)
(set! (-> obj want v1-4 display?) #f)
(set! (-> obj want v1-4 force-vis?) #f)
(set! (-> obj want v1-4 force-inside?) #f)
(set! v1-4 2)
)
)
)
(when arg1
(dotimes (v1-10 2)
(when (not (-> obj want v1-10 name))
(set! (-> obj want v1-10 name) arg1)
(set! (-> obj want v1-10 display?) #f)
(set! (-> obj want v1-10 force-vis?) #f)
(set! (-> obj want v1-10 force-inside?) #f)
(set! v1-10 2)
)
)
)
0
)
(defmethod want-display-level load-state ((obj load-state) (arg0 symbol) (arg1 symbol))
(dotimes (v1-0 2)
(when (= (-> obj want v1-0 name) arg0)
(set! (-> obj want v1-0 display?) arg1)
(return 0)
)
)
(if arg1
(format 0 "ERROR: can't display ~A because it isn't loaded~%" arg0)
)
0
)
(defmethod want-vis load-state ((obj load-state) (arg0 symbol))
(set! (-> obj vis-nick) arg0)
0
)
(defmethod want-force-vis load-state ((obj load-state) (arg0 symbol) (arg1 symbol))
(dotimes (v1-0 2)
(when (= (-> obj want v1-0 name) arg0)
(set! (-> obj want v1-0 force-vis?) arg1)
(return 0)
)
)
(format 0 "ERROR: can't force vis on ~A because it isn't loaded~%" arg0)
0
)
(defmethod set-force-inside! load-state ((obj load-state) (arg0 symbol) (arg1 symbol))
(dotimes (v1-0 2)
(when (= (-> obj want v1-0 name) arg0)
(set! (-> obj want v1-0 force-inside?) arg1)
(return 0)
)
)
(format 0 "ERROR: can't force inside on ~A because it isn't loaded~%" arg0)
0
(none)
)
(defun load-state-want-levels ((arg0 symbol) (arg1 symbol))
(want-levels *load-state* arg0 arg1)
)
(defun load-state-want-display-level ((arg0 symbol) (arg1 symbol))
(want-display-level *load-state* arg0 arg1)
)
(defun load-state-want-vis ((arg0 symbol))
(want-vis *load-state* arg0)
)
(defun load-state-want-force-vis ((arg0 symbol) (arg1 symbol))
(want-force-vis *load-state* arg0 arg1)
)
(define *display-load-commands* #f)
(define *backup-load-state* (new 'global 'load-state))
(defmethod backup-load-state-and-set-cmds load-state ((obj load-state) (arg0 pair))
(dotimes (s4-0 256)
(when (-> obj object-name s4-0)
(format 0 "WARNING: load state somehow aquired object command ~A~%"
(-> obj object-name s4-0)
)
(set! (-> obj object-name s4-0) #f)
)
)
(mem-copy! (&-> *backup-load-state* type) (&-> obj type) 2092)
(set! (-> *backup-load-state* command-list) '())
(set! (-> obj command-list) arg0)
0
)
(defmethod restore-load-state-and-cleanup load-state ((obj load-state))
(execute-commands-up-to obj 100000.0)
(dotimes (s5-0 256)
(when (-> obj object-name s5-0)
(let ((a0-3 (entity-by-name (the-as string (-> obj object-name s5-0)))))
(set!
(-> a0-3 extra perm status)
(the-as entity-perm-status (-> obj object-status s5-0))
)
(if (-> a0-3 extra process)
(kill! a0-3)
)
)
(set! (-> obj object-name s5-0) #f)
)
)
(mem-copy! (&-> obj type) (&-> *backup-load-state* type) 2092)
0
)
(defmethod restore-load-state load-state ((obj load-state))
(dotimes (v1-0 256)
(if (-> obj object-name v1-0)
(set! (-> obj object-name v1-0) #f)
)
)
(mem-copy! (&-> obj type) (&-> *backup-load-state* type) 2092)
0
)
(defun command-list-get-process ((arg0 object))
(with-pp
(set! arg0 (cond
((null? arg0)
#f
)
((type-type? (rtype-of arg0) process)
(empty)
arg0
)
((= arg0 'target)
*target*
)
((= arg0 'sidekick)
(if *target*
(ppointer->process (-> *target* sidekick))
)
)
((= arg0 'self)
pp
)
((= arg0 'parent)
(ppointer->process (-> pp parent))
)
((= arg0 'camera)
*camera*
)
((type-type? (rtype-of arg0) string)
(let ((v1-14 (process-by-ename (the-as string arg0))))
(cond
(v1-14
(empty)
v1-14
)
(else
(let ((s5-0 (ppointer->process (-> pp child))))
(while s5-0
(let* ((s3-0 s5-0)
(s4-0
(if
(and
(nonzero? s3-0)
(type-type? (-> s3-0 type) process-drawable)
)
s3-0
)
)
)
(when
(and
s4-0
(nonzero? (-> (the-as process-drawable s4-0) draw))
(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)
)
)
(set! arg0 s4-0)
(goto cfg-56)
)
)
(set! s5-0 (ppointer->process (-> s5-0 brother)))
)
)
(the-as process #f)
)
)
)
)
(else
#f
)
)
)
(label cfg-56)
(the-as process arg0)
)
)
(defmethod execute-commands-up-to load-state ((obj load-state) (arg0 float))
(while (not (null? (-> obj command-list)))
(let ((f0-0 (command-get-float (car (car (-> obj command-list))) 0.0))
(s4-0 (cdr (car (-> obj command-list))))
)
(if (< arg0 f0-0)
(return (the-as int #f))
)
(if *display-load-commands*
(format
0
"NOTICE: ~D: ~f: execute command ~A~%"
(-> *display* base-frame-counter)
f0-0
s4-0
)
)
(cond
((pair? (car s4-0))
(let ((a1-3 (car s4-0)))
(while (not (null? s4-0))
(execute-command obj (the-as pair a1-3))
(set! s4-0 (cdr s4-0))
(set! a1-3 (car s4-0))
)
)
)
(else
(execute-command obj s4-0)
)
)
)
(set! (-> obj command-list) (cdr (-> obj command-list)))
)
0
)
(defmethod execute-command load-state ((obj load-state) (arg0 pair))
(local-vars (v1-26 int) (v1-57 int))
(with-pp
(cond
((null? arg0)
)
((pair? arg0)
(let ((v1-4 (car arg0))
(gp-0 (cdr arg0))
)
(cond
((= v1-4 'set!)
(let ((s5-1 (command-get-param (car gp-0) #f)))
(if s5-1
(set!
(-> (the-as symbol s5-1) value)
(command-get-param (car (cdr gp-0)) #f)
)
)
)
)
((= v1-4 'eval)
((the-as (function int) (command-get-param (car gp-0) #f)))
)
((= v1-4 'want-vis)
(want-vis obj (the-as symbol (command-get-param (car gp-0) #f)))
)
((= v1-4 'want-levels)
(want-levels
obj
(the-as symbol (command-get-param (car gp-0) #f))
(the-as symbol (command-get-param (car (cdr gp-0)) #f))
)
)
((= v1-4 'display-level)
(want-display-level
obj
(the-as symbol (command-get-param (car gp-0) #f))
(the-as symbol (command-get-param (car (cdr gp-0)) #f))
)
)
((= v1-4 'want-force-vis)
(want-force-vis
obj
(the-as symbol (command-get-param (car gp-0) #f))
(the-as symbol (command-get-param (car (cdr gp-0)) #f))
)
)
((= v1-4 'want-force-inside)
(set-force-inside!
obj
(the-as symbol (command-get-param (car gp-0) #f))
(the-as symbol (command-get-param (car (cdr gp-0)) #f))
)
)
((= v1-4 'alive)
(let ((s4-5 (command-get-param (car gp-0) #f)))
(when s4-5
(let ((gp-1 (entity-by-name (the-as string s4-5))))
(when gp-1
(dotimes (v1-25 256)
(when (not (-> obj object-name v1-25))
(set! (-> obj object-name v1-25) (the-as symbol s4-5))
(set!
(-> obj object-status v1-25)
(the-as basic (-> gp-1 extra perm status))
)
(set! v1-26 v1-25)
(goto cfg-29)
)
)
(set! v1-26 -1)
(label cfg-29)
(when (>= v1-26 0)
(entity-birth-no-kill gp-1)
(let ((a0-45 (-> gp-1 extra process)))
(when a0-45
(logclear! (-> a0-45 mask) (process-mask actor-pause))
(logclear!
(-> a0-45 mask)
(-> *kernel-context* prevent-from-run)
)
)
)
)
)
)
)
)
)
((= v1-4 'dead)
(let ((s3-4 (command-get-param (car gp-0) #f)))
(when s3-4
(let ((s4-6 (entity-by-name (the-as string s3-4))))
(when s4-6
(dotimes (gp-2 256)
(when
(string=
(the-as string (-> obj object-name gp-2))
(the-as string s3-4)
)
(set!
(-> s4-6 extra perm status)
(the-as entity-perm-status (-> obj object-status gp-2))
)
(if (-> s4-6 extra process)
(kill! s4-6)
)
(set! (-> obj object-name gp-2) #f)
(goto cfg-45)
)
)
)
)
)
)
(label cfg-45)
)
((= v1-4 'kill)
(let ((s4-7 (command-get-param (car gp-0) #f)))
(when s4-7
(let ((gp-3 (entity-by-name (the-as string s4-7))))
(when gp-3
(dotimes (v1-56 256)
(when (not (-> obj object-name v1-56))
(set! (-> obj object-name v1-56) (the-as symbol s4-7))
(set!
(-> obj object-status v1-56)
(the-as basic (-> gp-3 extra perm status))
)
(set! v1-57 v1-56)
(goto cfg-56)
)
)
(set! v1-57 -1)
(label cfg-56)
(when (>= v1-57 0)
(if (-> gp-3 extra process)
(kill! gp-3)
)
(logior! (-> gp-3 extra perm status) (entity-perm-status dead))
)
)
)
)
)
)
((= v1-4 'special)
(let ((a0-70 (command-get-param (car gp-0) #f)))
(when a0-70
(let ((s5-2 (entity-by-name (the-as string a0-70))))
(if s5-2
(dummy-30
(the-as entity-actor s5-2)
(entity-perm-status bit-7)
(the-as symbol (command-get-param (car (cdr gp-0)) #f))
)
)
)
)
)
)
((= v1-4 'active)
(let ((gp-4 (command-get-param (car gp-0) #f)))
(while (!= (level-status *level* (the-as symbol gp-4)) 'active)
(suspend)
)
)
)
((= v1-4 'part-tracker)
(let* ((s5-4 (command-get-param (car gp-0) #f))
(a0-81 (command-get-param (car (cdr gp-0)) #f))
(gp-5 (entity-by-name (the-as string a0-81)))
(s4-9
(lookup-part-group-by-name
(symbol->string (the-as symbol s5-4))
)
)
(s5-5
(if
(and
(nonzero? s4-9)
(type-type? (-> s4-9 type) sparticle-launch-group)
)
s4-9
)
)
)
(when (and gp-5 s5-5)
(let* ((s3-6 (-> gp-5 extra process))
(s4-10
(if
(and
(nonzero? s3-6)
(type-type? (-> s3-6 type) process-drawable)
)
(the-as process-drawable s3-6)
)
)
(s3-7 (get-process *default-dead-pool* part-tracker #x4000))
)
(when s3-7
(let ((t9-41 (method-of-type part-tracker activate))
(a0-86 s3-7)
(a1-40 (the process-tree (ppointer->process (-> *setting-control* current movie))))
)
(set! a1-40
(cond
(a1-40
a1-40
)
(else
*entity-pool*
)
)
)
(t9-41
(the-as part-tracker a0-86)
a1-40
'part-tracker
(the-as pointer #x70004000)
)
)
(run-now-in-process s3-7 part-tracker-init s5-5 -1 #f #f #f (if s4-10
(->
s4-10
root
trans
)
(->
gp-5
extra
trans
)
)
)
(-> s3-7 ppointer)
)
)
)
)
)
((= v1-4 'auto-save)
(auto-save-command
(the-as symbol (command-get-param (car gp-0) #f))
0
0
*default-pool*
)
)
((= v1-4 'shadow)
(let ((s5-7 (command-list-get-process (car gp-0)))
(v1-95 (command-get-quoted-param (car (cdr gp-0)) #f))
)
(send-event s5-7 'shadow v1-95)
)
)
((= v1-4 'time-of-day)
(when *time-of-day-proc*
(let ((v1-99 (command-get-int (car gp-0) 0)))
(cond
((< v1-99 0)
(set! (-> *time-of-day-proc* 0 time-ratio) 300.0)
)
(else
(set! (-> *time-of-day-proc* 0 hour) v1-99)
(set! (-> *time-of-day-proc* 0 minute) 0)
(set! (-> *time-of-day-proc* 0 frame) 0)
(set! (-> *time-of-day-proc* 0 time-ratio) 0.0)
)
)
)
)
)
((= v1-4 'save)
(mem-copy! (&-> *backup-load-state* type) (&-> obj type) 2092)
(set! (-> *backup-load-state* command-list) '())
(dotimes (v1-112 256)
(if (-> *backup-load-state* object-name v1-112)
(set! (-> *backup-load-state* object-name v1-112) #f)
)
)
)
((= v1-4 'setting-reset)
(set-setting!
*setting-control*
pp
(the-as symbol (command-get-param (car gp-0) #f))
(the-as symbol (command-get-param (car (cdr gp-0)) #f))
0.0
0
)
)
((= v1-4 'setting-unset)
(clear-pending-settings-from-process
*setting-control*
pp
(the-as symbol (command-get-param (car gp-0) #f))
)
)
((= v1-4 'blackout)
(set-blackout-frames
(the int (* 5.0000005 (the float (command-get-int (car gp-0) 0))))
)
)
((= v1-4 'teleport)
(set! *teleport* #t)
)
((= v1-4 'joint)
(send-event
(ppointer->process (-> *setting-control* current movie))
'joint
(command-get-param (car gp-0) #f)
)
(set! *teleport-count* 2)
)
((= v1-4 'ambient)
(ambient-hint-spawn
(the-as string (command-get-param (car (cdr gp-0)) #f))
(the-as vector #f)
*entity-pool*
(the-as symbol (command-get-param (car gp-0) #f))
)
)
((= v1-4 'send-event)
(let ((s5-13 (command-list-get-process (car gp-0)))
(s4-14 (command-get-quoted-param (car (cdr gp-0)) #f))
(gp-6 (cdr (cdr gp-0)))
)
(when (and s5-13 (not (null? s4-14)))
(let ((s3-11 (new 'stack-no-clear 'event-message-block)))
(set! (-> s3-11 from) pp)
(let ((a0-142 gp-6))
(set!
(-> s3-11 num-params)
((method-of-type (rtype-of a0-142) length) a0-142)
)
)
(set! (-> s3-11 message) (the-as symbol s4-14))
(set!
(-> s3-11 param 0)
(the-as uint (command-get-quoted-param (car gp-6) #f))
)
(set!
(-> s3-11 param 1)
(the-as uint (command-get-quoted-param (car (cdr gp-6)) #f))
)
(set!
(-> s3-11 param 2)
(the-as uint (command-get-quoted-param (car (cdr (cdr gp-6))) #f))
)
(send-event-function s5-13 s3-11)
)
)
)
)
)
)
)
)
0
(none)
)
)
(defun check-boundary ((arg0 load-boundary))
(local-vars (s5-0 object))
(let ((a1-0 (if (logtest? (-> arg0 flags) (load-boundary-flags player))
(-> *load-boundary-target* 1)
(-> *load-boundary-target* 0)
)
)
(a2-0 (if (logtest? (-> arg0 flags) (load-boundary-flags player))
(-> *load-boundary-target* 3)
(-> *load-boundary-target* 2)
)
)
)
0
(let ((f0-1 (- (-> a1-0 x) (-> arg0 rejector x)))
(f1-2 (- (-> a1-0 z) (-> arg0 rejector z)))
)
(cond
((<
(+ (* f0-1 f0-1) (* f1-2 f1-2))
(* (-> arg0 rejector w) (-> arg0 rejector w))
)
(if (logtest? (-> arg0 flags) (load-boundary-flags closed))
(set! s5-0 (check-closed-boundary arg0 a1-0 a2-0))
(set! s5-0 (check-open-boundary arg0 a1-0 a2-0))
)
)
(else
(set! s5-0 0)
(goto cfg-28)
)
)
)
)
(let ((s4-0 (the-as load-boundary-crossing-command #f)))
(if (= (the-as symbol s5-0) 1)
(set! s4-0 (-> arg0 cmd-fwd))
)
(if (= (the-as symbol s5-0) 2)
(set! s4-0 (-> arg0 cmd-bwd))
)
(when s4-0
(cond
((= (-> s4-0 cmd) (load-boundary-cmd vis))
(load-state-want-vis (the-as symbol (-> s4-0 lev0)))
)
((= (-> s4-0 cmd) (load-boundary-cmd load))
(load-state-want-levels
(the-as symbol (-> s4-0 lev0))
(the-as symbol (-> s4-0 lev1))
)
)
((= (-> s4-0 cmd) (load-boundary-cmd display))
(load-state-want-display-level
(the-as symbol (-> s4-0 lev0))
(the-as symbol (-> s4-0 lev1))
)
)
((= (-> s4-0 cmd) (load-boundary-cmd force-vis))
(load-state-want-force-vis
(the-as symbol (-> s4-0 lev0))
(the-as symbol (-> s4-0 lev1))
)
)
((= (-> s4-0 cmd) (load-boundary-cmd checkpt))
(format 0 "Setting continue to ~A~%" (-> s4-0 lev0))
(set-continue! *game-info* (-> s4-0 lev0))
)
)
)
)
(label cfg-28)
(none)
)
(define-perm *load-state* load-state (new 'global 'load-state))
Reference in a new issue View git blame Copy permalink