compiling and running

This commit is contained in:
water111
2026-08-07 21:25:56 -04:00
parent 2929a106aa
commit 3f5d1e2aaf
38 changed files with 281 additions and 233 deletions
+1 -1
View File
@@ -43,7 +43,7 @@
;; - Functions
(define-extern format "Format values to a destination." (function _varargs_ object))
(define-extern format "Format values to a destination." (function _varargs_ string))
(define-extern valid? "Check whether object is a valid GOAL object of expected-type. Passing #f as expected-type only checks for a four-byte-aligned address in GOAL memory. Pass structure for a structure, which also requires 16-byte alignment; packed inline structures therefore do not pass. More specific expected types accept their subtypes. allow-false accepts #f as a null reference. name is used in error output, and a false name suppresses errors." (function object type basic basic object symbol))
(define-extern type-type? "Return true when child-type is parent-type or derives from it. Incomplete types safely return false." (function type type symbol))
(define-extern fact "Return x factorial." (function int int))
-4
View File
@@ -697,10 +697,6 @@
`(- (the-as int ,a) (the-as int ,b))
)
(defmacro &-> (&rest args)
`(& (-> ,@args))
)
(defmacro xor (a b)
"xor for #t and #f"
(with-gensyms (a-temp b-temp)
+6 -3
View File
@@ -14,21 +14,24 @@
;; Debug drawing functions for camera
(define-extern camera-line-setup (function vector4w none))
(define-extern camera-line-draw (function vector vector symbol))
(define-extern camera-line-draw (function vector vector none))
(define-extern camera-line (function vector vector vector4w none))
(define-extern camera-cross (function vector vector vector vector4w meters basic))
(define-extern camera-cross (function vector vector vector vector4w meters none))
(define-extern camera-fov-frame (function matrix vector float float float vector4w none))
(define-extern camera-line-rel (function vector vector vector4w none))
(define-extern camera-line-rel-len (function vector vector meters vector4w none))
(define-extern cam-slave-options->string (function cam-slave-options object string))
(define-extern cam-index-options->string (function cam-index-options object string))
(define-extern debug-set-camera-pos-rot! (function vector matrix vector))
(define-extern camera-slave-debug (function camera-slave none))
(define-extern cam-debug-add-los-tri (function (inline-array collide-cache-tri) vector vector none))
(define-extern cam-debug-add-los-tri (function (inline-array collide-cache-tri) vector vector4w none))
(define-extern cam-collision-record-save (function vector vector int symbol camera-slave none))
(define-extern slave-los-state->string (function slave-los-state string))
(define-extern cam-debug-reset-coll-tri (function none))
;; DECOMP BEGINS
;; Debug-only rolling histories used by the camera plot display. Each color and
+12
View File
@@ -14,6 +14,18 @@
;; changes. The source plane arrays remain authoritative; the derived points are only wireframe data
;; for this editor.
(declare-type clm basic)
(define-extern *clm* clm)
(define-extern *clm-edit* clm)
(define-extern *clm-vol-attr* clm)
(define-extern *clm-spline-attr* clm)
(define-extern *clm-intro-attr* clm)
(define-extern *clm-index-attr* clm)
(define-extern *clm-focalpull-attr* clm)
(define-extern *clm-select* clm)
;; DECOMP BEGINS
;; this file is debug only
+4
View File
@@ -461,3 +461,7 @@
(:states
cam-master-active
list-keeper-active))
(define-extern cam-calc-follow! (function cam-rotation-tracker vector symbol vector))
(define-extern slave-set-rotation! (function cam-rotation-tracker vector cam-slave-options float symbol int))
@@ -2965,7 +2965,7 @@ integer bounds overlap collide-work.collide-box4w."
(method-of-type bsp-header collide-with-box)
(method-of-type collide-cache load-mesh-from-spad-in-box)))
(if (logtest? collide-with (collide-kind water)) (fill-from-water obj (-> proc water)))
(if (logtest? collide-with (collide-kind cak-1 cak-2 cak-3 target)) (fill-from-foreground-using-box obj))
(if (logtest? collide-with (collide-kind hit-by-player usually-hit-by-player hit-by-others target)) (fill-from-foreground-using-box obj))
0
(none)))
@@ -3085,7 +3085,7 @@ integer bounds overlap collide-work.collide-box4w."
(method-of-type bsp-header collide-y-probe)
(method-of-type collide-cache load-mesh-from-spad-in-y-probe)))
(if (logtest? kinds (collide-kind water)) (fill-from-water obj (-> proc water)))
(if (logtest? kinds (collide-kind cak-1 cak-2 cak-3 target)) (fill-from-foreground-using-y-probe obj))
(if (logtest? kinds (collide-kind hit-by-player usually-hit-by-player hit-by-others target)) (fill-from-foreground-using-y-probe obj))
0
(none)))
@@ -3316,7 +3316,7 @@ integer bounds overlap collide-work.collide-box4w."
(method-of-type bsp-header collide-ray)
(method-of-type collide-cache load-mesh-from-spad-in-line-sphere)))
(if (logtest? kinds (collide-kind water)) (fill-from-water obj (-> proc water)))
(if (logtest? kinds (collide-kind cak-1 cak-2 cak-3 target)) (fill-from-foreground-using-line-sphere obj))
(if (logtest? kinds (collide-kind hit-by-player usually-hit-by-player hit-by-others target)) (fill-from-foreground-using-line-sphere obj))
0
(label cfg-13)
(none)))
@@ -164,9 +164,9 @@
:type uint64
:bitfield #t
(background 0)
(cak-1 1) ;; hit by player
(cak-2 2) ;; usually hit by player
(cak-3 3) ;; hit by others
(hit-by-player 1) ;; hit by player
(usually-hit-by-player 2) ;; usually hit by player
(hit-by-others 3) ;; hit by others
(target 4) ;; target
(water 5)
(powerup 6)
@@ -143,8 +143,8 @@
(vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
(send-event (-> this process) 'ridden rider-entry)))
(set! with-mask (-> this root-prim collide-with)))))))))
(when (logtest? with-mask (collide-kind cak-1 cak-2 cak-3))
(when (logtest? with-mask (collide-kind cak-1))
(when (logtest? with-mask (collide-kind hit-by-player usually-hit-by-player hit-by-others))
(when (logtest? with-mask (collide-kind hit-by-player))
(iterate-engine-connections (node *collide-hit-by-player-list*)
(let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
(candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
@@ -164,7 +164,7 @@
(vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
(send-event (-> this process) 'ridden rider-entry)))
(set! with-mask (-> this root-prim collide-with)))))))))
(when (logtest? with-mask (collide-kind cak-2))
(when (logtest? with-mask (collide-kind usually-hit-by-player))
(iterate-engine-connections (node *collide-usually-hit-by-player-list*)
(let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
(candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
@@ -184,7 +184,7 @@
(vector-matrix*! (-> rider-entry rider-local-pos) (-> (the-as collide-shape candidate-shape) trans) inverse-transform))))
(send-event (-> this process) 'ridden rider-entry)))
(set! with-mask (-> this root-prim collide-with)))))))))
(when (logtest? with-mask (collide-kind cak-3))
(when (logtest? with-mask (collide-kind hit-by-others))
(iterate-engine-connections (node *collide-hit-by-others-list*)
(let* ((candidate-shape (the-as object (-> (the-as connection node) param1)))
(candidate-root (-> (the-as collide-shape candidate-shape) root-prim)))
+45 -45
View File
@@ -1256,7 +1256,7 @@
;; no ground. if the hover flag is set, we just hover.
(set! (-> this trans y) (-> this trans-old 0 y)))))))
;; if we need to collide with things.
(when (logtest? (-> this root-prim collide-with) (collide-kind cak-1 cak-2 cak-3 target))
(when (logtest? (-> this root-prim collide-with) (collide-kind hit-by-player usually-hit-by-player hit-by-others target))
(let ((overlap-params (new 'stack-no-clear 'overlaps-others-params)))
(set! (-> overlap-params options) (overlaps-others-options solid-only))
(set! (-> overlap-params tlist) *touching-list*)
@@ -2038,7 +2038,7 @@
(defmethod do-push-aways! ((this collide-shape))
"This is the main function to call to respond"
;; One loop, written out four times, once for each foreground collide list this shape can reach: the
;; player list first, then cak-1, cak-2 and cak-3. Only the list global and the label names differ.
;; player list first, then cak-1, usually-hit-by-player and hit-by-others. Only the list global and the label names differ.
;; A single pass rejects on collide-as, skips this shape's own process, runs the exact overlap test,
;; and when the penetration is deeper than PUSH-AWAY-MIN-OVERLAP fills the collide cache around the
;; other shape and shoves it out with up to PUSH-AWAY-PASSES separating moves.
@@ -2130,9 +2130,9 @@
(set! (-> victim status) saved-status)))
(+! iterations-left -1)))
(set! with-mask (-> this root-prim collide-with)))))))))
(when (logtest? with-mask (collide-kind cak-1 cak-2 cak-3))
;; The same loop again for cak-1, cak-2 and cak-3.
(when (logtest? with-mask (collide-kind cak-1))
(when (logtest? with-mask (collide-kind hit-by-player usually-hit-by-player hit-by-others))
;; The same loop again for cak-1, usually-hit-by-player and hit-by-others.
(when (logtest? with-mask (collide-kind hit-by-player))
(iterate-engine-connections (node *collide-hit-by-player-list*)
(let ((victim (the-as collide-shape-moving (-> (the-as connection node) param1))))
(when (logtest? with-mask (-> victim root-prim prim-core collide-as))
@@ -2160,8 +2160,8 @@
(.add.x.vf.y dot-products dot-products dot-products)
(.add.z.vf.y dot-products dot-products dot-products)
(.mov normal-side-bits dot-products)
(b! (< (the-as int normal-side-bits) 0) dir-ready-cak-1 :likely-delay (.sub.vf push-direction vf0 push-direction))
(label dir-ready-cak-1)
(b! (< (the-as int normal-side-bits) 0) dir-ready-hit-by-player :likely-delay (.sub.vf push-direction vf0 push-direction))
(label dir-ready-hit-by-player)
(.svf (&-> push-vector quad) push-direction)
(vector-normalize! push-vector 1.0)
(vector-float*! push-vector push-vector (- (-> overlap-result best-dist)))
@@ -2177,7 +2177,7 @@
(set! (-> victim status) saved-status)))
(+! iterations-left -1)))
(set! with-mask (-> this root-prim collide-with)))))))))
(when (logtest? with-mask (collide-kind cak-2))
(when (logtest? with-mask (collide-kind usually-hit-by-player))
(iterate-engine-connections (node *collide-usually-hit-by-player-list*)
(let ((victim (the-as collide-shape-moving (-> (the-as connection node) param1))))
(when (logtest? with-mask (-> victim root-prim prim-core collide-as))
@@ -2205,8 +2205,8 @@
(.add.x.vf.y dot-products dot-products dot-products)
(.add.z.vf.y dot-products dot-products dot-products)
(.mov normal-side-bits dot-products)
(b! (< (the-as int normal-side-bits) 0) dir-ready-cak-2 :likely-delay (.sub.vf push-direction vf0 push-direction))
(label dir-ready-cak-2)
(b! (< (the-as int normal-side-bits) 0) dir-ready-usually-hit-by-player :likely-delay (.sub.vf push-direction vf0 push-direction))
(label dir-ready-usually-hit-by-player)
(.svf (&-> push-vector quad) push-direction)
(vector-normalize! push-vector 1.0)
(vector-float*! push-vector push-vector (- (-> overlap-result best-dist)))
@@ -2222,7 +2222,7 @@
(set! (-> victim status) saved-status)))
(+! iterations-left -1)))
(set! with-mask (-> this root-prim collide-with)))))))))
(when (logtest? with-mask (collide-kind cak-3))
(when (logtest? with-mask (collide-kind hit-by-others))
(iterate-engine-connections (node *collide-hit-by-others-list*)
(let ((victim (the-as collide-shape-moving (-> (the-as connection node) param1))))
(when (logtest? with-mask (-> victim root-prim prim-core collide-as))
@@ -2250,8 +2250,8 @@
(.add.x.vf.y dot-products dot-products dot-products)
(.add.z.vf.y dot-products dot-products dot-products)
(.mov normal-side-bits dot-products)
(b! (< (the-as int normal-side-bits) 0) dir-ready-cak-3 :likely-delay (.sub.vf push-direction vf0 push-direction))
(label dir-ready-cak-3)
(b! (< (the-as int normal-side-bits) 0) dir-ready-hit-by-others :likely-delay (.sub.vf push-direction vf0 push-direction))
(label dir-ready-hit-by-others)
(.svf (&-> push-vector quad) push-direction)
(vector-normalize! push-vector 1.0)
(vector-float*! push-vector push-vector (- (-> overlap-result best-dist)))
@@ -2354,9 +2354,9 @@
(label next-player)
0)))
(label after-player-list)
(when (logtest? with-mask (collide-kind cak-1 cak-2 cak-3))
;; The same loop again for cak-1, cak-2 and cak-3.
(when (logtest? with-mask (collide-kind cak-1))
(when (logtest? with-mask (collide-kind hit-by-player usually-hit-by-player hit-by-others))
;; The same loop again for cak-1, usually-hit-by-player and hit-by-others.
(when (logtest? with-mask (collide-kind hit-by-player))
(iterate-engine-connections (node *collide-hit-by-player-list*)
(let* ((other-shape (the-as collide-shape-moving (-> (the-as connection node) param1)))
(other-root (-> other-shape root-prim)))
@@ -2375,13 +2375,13 @@
(let ((our-process (-> this process)))
(.mov sphere-separation-squared delta)
(let ((other-process (-> other-shape process)))
(b! (< zero-distance sphere-separation-squared) next-cak-1 :delay (set! options (-> params options)))
(b! (< zero-distance sphere-separation-squared) next-hit-by-player :delay (set! options (-> params options)))
(b! (= our-process other-process)
next-cak-1
next-hit-by-player
:delay
(set! root-overlap-option (logand options (overlaps-others-options accept-root-sphere-overlap)))))))
(b! (zero? root-overlap-option) leaf-test-cak-1 :delay (set! touching-list (-> params tlist)))
(b! (= touching-list #f) after-test-cak-1 :delay (set! direct-hit? #t))
(b! (zero? root-overlap-option) leaf-test-hit-by-player :delay (set! touching-list (-> params tlist)))
(b! (= touching-list #f) after-test-hit-by-player :delay (set! direct-hit? #t))
(set! hit? direct-hit?)
(add-touching-prims touching-list
our-root
@@ -2389,16 +2389,16 @@
-1.0
(the-as collide-tri-result #f)
(the-as collide-tri-result #f))
(b! #t after-test-cak-1 :delay #t)
(label leaf-test-cak-1)
(b! #t after-test-hit-by-player :delay #t)
(label leaf-test-hit-by-player)
(set! hit? (overlaps-others-test our-root params other-root))
(label after-test-cak-1)
(label after-test-hit-by-player)
(.lvf our-sphere (&-> our-root prim-core world-sphere quad))
(b! (= hit? #f) next-cak-1 :delay (set! with-mask (-> our-root collide-with)))
(b! (= hit? #f) next-hit-by-player :delay (set! with-mask (-> our-root collide-with)))
(b! (= (-> params tlist) #f) finish :delay (set! found-any? 0))
(label next-cak-1)
(label next-hit-by-player)
0))))
(when (logtest? with-mask (collide-kind cak-2))
(when (logtest? with-mask (collide-kind usually-hit-by-player))
(iterate-engine-connections (node *collide-usually-hit-by-player-list*)
(let* ((other-shape (the-as collide-shape-moving (-> (the-as connection node) param1)))
(other-root (-> other-shape root-prim)))
@@ -2417,13 +2417,13 @@
(let ((our-process (-> this process)))
(.mov sphere-separation-squared delta)
(let ((other-process (-> other-shape process)))
(b! (< zero-distance sphere-separation-squared) next-cak-2 :delay (set! options (-> params options)))
(b! (< zero-distance sphere-separation-squared) next-usually-hit-by-player :delay (set! options (-> params options)))
(b! (= our-process other-process)
next-cak-2
next-usually-hit-by-player
:delay
(set! root-overlap-option (logand options (overlaps-others-options accept-root-sphere-overlap)))))))
(b! (zero? root-overlap-option) leaf-test-cak-2 :delay (set! touching-list (-> params tlist)))
(b! (= touching-list #f) after-test-cak-2 :delay (set! direct-hit? #t))
(b! (zero? root-overlap-option) leaf-test-usually-hit-by-player :delay (set! touching-list (-> params tlist)))
(b! (= touching-list #f) after-test-usually-hit-by-player :delay (set! direct-hit? #t))
(set! hit? direct-hit?)
(add-touching-prims touching-list
our-root
@@ -2431,16 +2431,16 @@
-1.0
(the-as collide-tri-result #f)
(the-as collide-tri-result #f))
(b! #t after-test-cak-2 :delay #t)
(label leaf-test-cak-2)
(b! #t after-test-usually-hit-by-player :delay #t)
(label leaf-test-usually-hit-by-player)
(set! hit? (overlaps-others-test our-root params other-root))
(label after-test-cak-2)
(label after-test-usually-hit-by-player)
(.lvf our-sphere (&-> our-root prim-core world-sphere quad))
(b! (= hit? #f) next-cak-2 :delay (set! with-mask (-> our-root collide-with)))
(b! (= hit? #f) next-usually-hit-by-player :delay (set! with-mask (-> our-root collide-with)))
(b! (= (-> params tlist) #f) finish :delay (set! found-any? 0))
(label next-cak-2)
(label next-usually-hit-by-player)
0))))
(when (logtest? with-mask (collide-kind cak-3))
(when (logtest? with-mask (collide-kind hit-by-others))
(iterate-engine-connections (node *collide-hit-by-others-list*)
(let* ((other-shape (the-as collide-shape-moving (-> (the-as connection node) param1)))
(other-root (-> other-shape root-prim)))
@@ -2459,13 +2459,13 @@
(let ((our-process (-> this process)))
(.mov sphere-separation-squared delta)
(let ((other-process (-> other-shape process)))
(b! (< zero-distance sphere-separation-squared) next-cak-3 :delay (set! options (-> params options)))
(b! (< zero-distance sphere-separation-squared) next-hit-by-others :delay (set! options (-> params options)))
(b! (= our-process other-process)
next-cak-3
next-hit-by-others
:delay
(set! root-overlap-option (logand options (overlaps-others-options accept-root-sphere-overlap)))))))
(b! (zero? root-overlap-option) leaf-test-cak-3 :delay (set! touching-list (-> params tlist)))
(b! (= touching-list #f) after-test-cak-3 :delay (set! direct-hit? #t))
(b! (zero? root-overlap-option) leaf-test-hit-by-others :delay (set! touching-list (-> params tlist)))
(b! (= touching-list #f) after-test-hit-by-others :delay (set! direct-hit? #t))
(set! hit? direct-hit?)
(add-touching-prims touching-list
our-root
@@ -2473,14 +2473,14 @@
-1.0
(the-as collide-tri-result #f)
(the-as collide-tri-result #f))
(b! #t after-test-cak-3 :delay #t)
(label leaf-test-cak-3)
(b! #t after-test-hit-by-others :delay #t)
(label leaf-test-hit-by-others)
(set! hit? (overlaps-others-test our-root params other-root))
(label after-test-cak-3)
(label after-test-hit-by-others)
(.lvf our-sphere (&-> our-root prim-core world-sphere quad))
(b! (= hit? #f) next-cak-3 :delay (set! with-mask (-> our-root collide-with)))
(b! (= hit? #f) next-hit-by-others :delay (set! with-mask (-> our-root collide-with)))
(b! (= (-> params tlist) #f) finish :delay (set! found-any? 0))
(label next-cak-3)
(label next-hit-by-others)
0)))))))
(label finish)
(b! (= (the-as int found-any?) #f) done :delay (nop!))
@@ -1193,8 +1193,8 @@
(vector-cross! (-> self tracking inv-mat vector 1)
(-> self tracking inv-mat vector 2)
(the-as vector (-> self tracking)))
(set! (-> self blend-from-type) (the-as uint 0))
(set! (-> self blend-to-type) (the-as uint 0))
(set! (-> self blend-from-type) (camera-blend-to-type direct))
(set! (-> self blend-to-type) (camera-blend-to-type direct))
0))
:trans
(behavior ()
@@ -1245,10 +1245,10 @@
(vector-normalize! (-> self view-flat) 4096.0)
(vector--float*! (-> self trans) (-> *camera* tpos-curr) (-> *camera* local-down) 28672.0)
(vector+! (-> self trans) (-> self trans) (-> self view-flat))
(set! (-> self blend-from-type) (the-as uint 0))
(set! (-> self blend-to-type) (the-as uint 0))
(set! (-> self blend-from-type) (camera-blend-to-type direct))
(set! (-> self blend-to-type) (camera-blend-to-type direct))
(cam-calc-follow! (-> self tracking) (-> self trans) #f)
(slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #f)))
(slave-set-rotation! (-> self tracking) (-> self trans) (-> self options) (-> self fov) #f)))
:trans
(behavior ()
(if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating))
@@ -1290,7 +1290,7 @@
(-> self tracking follow-pt)
(-> *camera* local-down)
(-> *camera* target-height))
(slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #f)
(slave-set-rotation! (-> self tracking) (-> self trans) (-> self options) (-> self fov) #f)
(suspend)))))
;; An idle launcher waits for a nearby target carrying blue eco. If the target
@@ -1540,7 +1540,7 @@
(the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((trigger-sphere (new 'process 'collide-shape-prim-sphere tracker-shape (the-as uint 0))))
(set! (-> trigger-sphere prim-core collide-as) (collide-kind target enemy))
(set! (-> trigger-sphere collide-with) (collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object))
(set! (-> trigger-sphere collide-with) (collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object))
(set! (-> trigger-sphere prim-core offense) (collide-offense indestructible))
(set-vector! (-> trigger-sphere local-sphere) 0.0 0.0 0.0 radius)
(set-root-prim! tracker-shape trigger-sphere))
+3 -3
View File
@@ -173,12 +173,12 @@
;; unlink the current connection without breaking the traversal.
(defmacro iterate-engine-connections (bindings &rest body)
(with-gensyms (next)
`(let* ((,(car bindings) (-> ,(cadr bindings) alive-list next0))
(,next (-> ,(car bindings) next0)))
`(let* ((,(car bindings) (the connection (-> ,(cadr bindings) alive-list next0)))
(,next (the connection (-> ,(car bindings) next0))))
(while (!= ,(car bindings) (-> ,(cadr bindings) alive-list-end))
,@body
(set! ,(car bindings) ,next)
(set! ,next (-> ,next next0))))))
(set! ,next (the connection (-> ,next next0)))))))
(defmethod new engine ((allocation symbol) (type-to-make type) (name basic) (capacity int))
"Allocate a fixed-capacity engine and link every connection slot into its dead list."
+1 -1
View File
@@ -528,7 +528,7 @@
(send-event (ppointer->process tracker)
'eval
(lambda :behavior process-drawable ()
(set! (-> (the-as collide-shape (-> self root)) root-prim collide-with) (collide-kind cak-1 cak-2 cak-3 blue-eco-suck))
(set! (-> (the-as collide-shape (-> self root)) root-prim collide-with) (collide-kind hit-by-player usually-hit-by-player hit-by-others blue-eco-suck))
(none))))
(process-spawn-function process
(lambda ((effect-owner process-drawable))
+1 -1
View File
@@ -684,7 +684,7 @@
(the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((sphere-prim (new 'process 'collide-shape-prim-sphere moving-shape (the-as uint 0))))
(set! (-> sphere-prim prim-core collide-as) (collide-kind projectile))
(set! (-> sphere-prim collide-with) (collide-kind background cak-2 cak-3 crate enemy wall-object ground-object))
(set! (-> sphere-prim collide-with) (collide-kind background usually-hit-by-player hit-by-others crate enemy wall-object ground-object))
(set! (-> sphere-prim prim-core action) (collide-action solid))
(set! (-> sphere-prim prim-core offense) (collide-offense strong-attack))
(set-vector! (-> sphere-prim local-sphere) 0.0 5324.8 0.0 5324.8)
+2 -2
View File
@@ -51,8 +51,8 @@ debug ranges are generated from those planes when volume marks are enabled."
((volume-type symbol)
(point-count int16)
(normal-count int16)
(first-point (pointer vector))
(first-normal (pointer vector))
(first-point (inline-array vector))
(first-normal (inline-array vector))
(num-planes int32)
(plane (inline-array plane)))
:pack-me
+83 -99
View File
@@ -57,107 +57,91 @@
;; centroid from the endpoints lying on it.
(set! (-> this volume-type) volume-type)
(set! (-> this point-count) 0)
(set! (-> this first-point) (the-as (pointer vector) (-> point-array data (-> point-array length))))
(set! (-> this first-point) (&-> point-array data (-> point-array length)))
(set! (-> this normal-count) 0)
(set! (-> this first-normal) (the-as (pointer vector) (-> normal-array data (-> normal-array length))))
(set! (-> this first-normal) (&-> normal-array data (-> normal-array length)))
(dotimes (plane-index (-> this num-planes))
(let ((plane-point (new 'stack-no-clear 'vector)))
(set! (-> plane-point quad) (the-as uint128 0))
(let ((edge-direction (new 'stack-no-clear 'vector)))
(set! (-> edge-direction quad) (the-as uint128 0))
(let ((toward-face (new 'stack-no-clear 'vector)))
(set! (-> toward-face quad) (the-as uint128 0))
(let ((edge-end (new 'stack-no-clear 'vector)))
(set! (-> edge-end quad) (the-as uint128 0))
0.0
0.0
0.0
(set! (-> (new 'stack-no-clear 'vector) quad) (the-as uint128 0))
(let ((centroid-sum (new-stack-vector0))
(endpoint-count 0)
(planes (-> this plane)))
(let ((other-index 0))
(while (< other-index (-> this num-planes))
(when (!= plane-index other-index)
;; A point on the other plane, then the line direction, then the in-plane
;; direction that leads from that point toward this face.
(vector-float*! plane-point (the-as vector (-> planes other-index)) (-> planes other-index w))
(vector-cross! edge-direction (the-as vector (-> planes other-index)) (the-as vector (-> planes plane-index)))
(vector-normalize! edge-direction 1.0)
(vector-cross! toward-face edge-direction (the-as vector (-> planes other-index)))
(vector-normalize! toward-face 1.0)
(let ((to-face-distance (plane-volume-intersect-dist (-> planes plane-index) plane-point toward-face)))
(when (!= to-face-distance (meters 100000))
(vector+float*! edge-end plane-point toward-face to-face-distance)
(let ((edge-start (new-stack-vector0))
(edge-span 0.0)
(clip-count 0))
(let ((clip-plane (new-stack-vector0)))
(set! (-> edge-start quad) (-> edge-end quad))
(let ((clip-index 0))
(while (< clip-index (-> this num-planes))
(when (and (!= clip-index plane-index) (!= clip-index other-index))
(let ((clip-distance (plane-volume-intersect-dist (-> planes clip-index) edge-start edge-direction)))
(cond
;; Parallel to the line, so this plane cannot bound it.
((= clip-distance (meters 100000)))
((zero? clip-count)
(vector+float*! edge-start edge-start edge-direction clip-distance)
(set! (-> clip-plane quad) (-> planes clip-index quad))
(set! edge-span (meters 2000))
(set! clip-count 1))
;; edge-end doubles as the step vector here. A step that agrees
;; with the recorded clipping plane's normal, or with this
;; plane's own, cannot be the one that closes the edge.
((begin (vector-float*! edge-end edge-direction clip-distance) (>= (vector-dot edge-end clip-plane) 0.0)))
((>= (vector-dot edge-end (the-as vector (-> planes clip-index))) 0.0)
(when (< (fabs clip-distance) (fabs edge-span))
(set! edge-span clip-distance)
(+! clip-count 1)))
(else
(vector+float*! edge-start edge-start edge-direction clip-distance)
(set! (-> clip-plane quad) (-> planes clip-index quad))
(+! clip-count 1)
(set! edge-span
(cond
((< (fabs clip-distance) (fabs edge-span)) (set! edge-span (- edge-span clip-distance)) edge-span)
(else 0.0)))))))
(+! clip-index 1))))
(cond
((zero? clip-count))
((= edge-span 0.0))
(else
;; Reject the pair unless the surviving start point is inside every other
;; half-space, allowing a meter of slack for the accumulated rounding.
(dotimes (check-index (-> this num-planes))
(when (and (!= check-index plane-index) (!= check-index other-index))
(if (< (meters 1)
(- (vector-dot edge-start (the-as vector (-> planes check-index))) (the-as float (-> planes check-index w))))
(goto next-plane))))
(vector+float*! edge-end edge-start edge-direction edge-span)
(cond
((< (-> point-array allocated-length) (+ (-> point-array length) 2))
(format 0 "ERROR <AG>: vol-control #x~X out of volume points~%" this))
(else
(set! (-> point-array data (-> point-array length) quad) (-> edge-start quad))
(set! (-> point-array data (+ (-> point-array length) 1) quad) (-> edge-end quad))
(+! (-> point-array length) 2)
(+! (-> this point-count) 2)))
(vector+! centroid-sum centroid-sum edge-start)
(vector+! centroid-sum centroid-sum edge-end)
(+! endpoint-count 2)))))))
(label next-plane)
(+! other-index 1)))
(when (nonzero? endpoint-count)
(vector-float*! centroid-sum centroid-sum (/ 1.0 (the float endpoint-count)))
(cond
((< (-> normal-array allocated-length) (+ (-> normal-array length) 2))
(format 0 "ERROR <AG>: vol-control #x~X out of volume normals~%" this))
(else
(set! (-> normal-array data (-> normal-array length) quad) (-> centroid-sum quad))
(set! (-> normal-array data (+ (-> normal-array length) 1) quad) (-> planes plane-index quad))
(+! (-> normal-array length) 2)
(set! (-> this normal-count) (+ (-> this normal-count) 2)))))))))))
(let ((plane-point (new-stack-vector0))
(edge-direction (new-stack-vector0))
(toward-face (new-stack-vector0))
(edge-end (new-stack-vector0)))
0.0
0.0
0.0
(set! (-> (new 'stack-no-clear 'vector) quad) (the-as uint128 0))
(let ((centroid-sum (new-stack-vector0))
(endpoint-count 0)
(planes (-> this plane)))
(let ((other-index 0))
(while (< other-index (-> this num-planes))
(when (!= plane-index other-index)
(vector-float*! plane-point (the-as vector (-> planes other-index)) (-> planes other-index w))
(vector-cross! edge-direction (the-as vector (-> planes other-index)) (the-as vector (-> planes plane-index)))
(vector-normalize! edge-direction 1.0)
(vector-cross! toward-face edge-direction (the-as vector (-> planes other-index)))
(vector-normalize! toward-face 1.0)
(let ((to-face-distance (plane-volume-intersect-dist (-> planes plane-index) plane-point toward-face)))
(when (!= to-face-distance 409600000.0)
(vector+float*! edge-end plane-point toward-face to-face-distance)
(let ((edge-start (new-stack-vector0))
(edge-span 0.0)
(clip-count 0))
(let ((clip-plane (new-stack-vector0)))
(set! (-> edge-start quad) (-> edge-end quad))
(let ((clip-index 0))
(while (< clip-index (-> this num-planes))
(when (and (!= clip-index plane-index) (!= clip-index other-index))
(let ((clip-distance (plane-volume-intersect-dist (-> planes clip-index) edge-start edge-direction)))
(cond
((= clip-distance 409600000.0))
((zero? clip-count)
(vector+float*! edge-start edge-start edge-direction clip-distance)
(set! (-> clip-plane quad) (-> planes clip-index quad))
(set! edge-span 8192000.0)
(set! clip-count 1))
((begin (vector-float*! edge-end edge-direction clip-distance) (>= (vector-dot edge-end clip-plane) 0.0)))
((>= (vector-dot edge-end (the-as vector (-> planes clip-index))) 0.0)
(when (< (fabs clip-distance) (fabs edge-span))
(set! edge-span clip-distance)
(+! clip-count 1)))
(else
(vector+float*! edge-start edge-start edge-direction clip-distance)
(set! (-> clip-plane quad) (-> planes clip-index quad))
(+! clip-count 1)
(set! edge-span (if (< (fabs clip-distance) (fabs edge-span)) (- edge-span clip-distance) 0.0))))))
(+! clip-index 1))))
(cond
((zero? clip-count))
((= edge-span 0.0))
(else
(dotimes (check-index (-> this num-planes))
(when (and (!= check-index plane-index) (!= check-index other-index))
(if (< 4096.0 (- (vector-dot edge-start (the-as vector (-> planes check-index))) (the-as float (-> planes check-index w))))
(goto cfg-42))))
(vector+float*! edge-end edge-start edge-direction edge-span)
(cond
((< (-> point-array allocated-length) (+ (-> point-array length) 2))
(format 0 "ERROR <AG>: vol-control #x~X out of volume points~%" this))
(else
(set! (-> point-array data (-> point-array length) quad) (-> edge-start quad))
(set! (-> point-array data (+ (-> point-array length) 1) quad) (-> edge-end quad))
(+! (-> point-array length) 2)
(+! (-> this point-count) 2)))
(vector+! centroid-sum centroid-sum edge-start)
(vector+! centroid-sum centroid-sum edge-end)
(+! endpoint-count 2)))))))
(label cfg-42)
(+! other-index 1)))
(when (nonzero? endpoint-count)
(vector-float*! centroid-sum centroid-sum (/ 1.0 (the float endpoint-count)))
(cond
((< (-> normal-array allocated-length) (+ (-> normal-array length) 2))
(format 0 "ERROR <AG>: vol-control #x~X out of volume normals~%" this))
(else
(vector-copy! (-> normal-array data (-> normal-array length)) centroid-sum)
(vector-copy! (-> normal-array data (+ (-> normal-array length) 1)) (-> planes plane-index))
(+! (-> normal-array length) 2)
(set! (-> this normal-count) (+ (-> this normal-count) 2))))))))
#f)
(defmethod debug-draw ((this plane-volume))
+6
View File
@@ -537,6 +537,12 @@
(rlet ((value :class vf :reset-here #t)) (.lvf value src) (.svf dst value))
dst))
(defun vector4w-copy! ((dst vector) (src vector4w))
"Copy the raw quadword from a vector4w source to a vector destination and return dst."
(declare (inline))
(set! (-> dst quad) (-> src quad))
dst)
(defmacro new-stack-vector0 ()
"Allocate a zeroed stack vector without calling the constructor."
(with-gensyms (vec)
+4 -4
View File
@@ -1333,7 +1333,7 @@
(let ((root-group (new 'process 'collide-shape-prim-group control (the-as uint 6) 1)))
(set! (-> root-group prim-core collide-as) (collide-kind target))
(set! (-> root-group collide-with)
(collide-kind background cak-1 cak-2 cak-3 water powerup crate enemy wall-object ground-object mother-spider))
(collide-kind background hit-by-player usually-hit-by-player hit-by-others water powerup crate enemy wall-object ground-object mother-spider))
(set! (-> root-group prim-core offense) (collide-offense touch))
(set! (-> root-group prim-core action) (collide-action solid rider-target))
(set-root-prim! control root-group)
@@ -1341,7 +1341,7 @@
(set! (-> body-sphere-0 prim-core action) (collide-action solid rider-target))
(set! (-> body-sphere-0 prim-core collide-as) (collide-kind target))
(set! (-> body-sphere-0 collide-with)
(collide-kind background cak-1 cak-2 cak-3 water powerup crate enemy wall-object ground-object mother-spider))
(collide-kind background hit-by-player usually-hit-by-player hit-by-others water powerup crate enemy wall-object ground-object mother-spider))
(set! (-> body-sphere-0 prim-core offense) (collide-offense touch))
(append-prim root-group body-sphere-0)
(set! (-> control collision-spheres 0) body-sphere-0))
@@ -1349,7 +1349,7 @@
(set! (-> body-sphere-1 prim-core action) (collide-action solid))
(set! (-> body-sphere-1 prim-core collide-as) (collide-kind target))
(set! (-> body-sphere-1 collide-with)
(collide-kind background cak-1 cak-2 cak-3 water powerup crate enemy wall-object ground-object mother-spider))
(collide-kind background hit-by-player usually-hit-by-player hit-by-others water powerup crate enemy wall-object ground-object mother-spider))
(set! (-> body-sphere-1 prim-core offense) (collide-offense touch))
(append-prim root-group body-sphere-1)
(set! (-> control collision-spheres 1) body-sphere-1))
@@ -1357,7 +1357,7 @@
(set! (-> body-sphere-2 prim-core action) (collide-action solid))
(set! (-> body-sphere-2 prim-core collide-as) (collide-kind target))
(set! (-> body-sphere-2 collide-with)
(collide-kind background cak-1 cak-2 cak-3 water powerup crate enemy wall-object ground-object mother-spider))
(collide-kind background hit-by-player usually-hit-by-player hit-by-others water powerup crate enemy wall-object ground-object mother-spider))
(set! (-> body-sphere-2 prim-core offense) (collide-offense touch))
(append-prim root-group body-sphere-2)
(set! (-> control collision-spheres 2) body-sphere-2))
+1 -1
View File
@@ -53,7 +53,7 @@
(>= (fill-and-probe-using-y-probe *collide-cache*
probe-position
(the-as float 20480.0)
(collide-kind background cak-1 cak-2 cak-3 water powerup crate enemy wall-object ground-object mother-spider)
(collide-kind background hit-by-player usually-hit-by-player hit-by-others water powerup crate enemy wall-object ground-object mother-spider)
target-process
hit
(new 'static 'pat-surface :noentity #x1))
+19 -19
View File
@@ -266,7 +266,7 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
(-> *TARGET-bank* spin-offset)
(-> *TARGET-bank* spin-radius)))
@@ -278,26 +278,26 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
(-> *TARGET-bank* duck-spin-offset)
(-> *TARGET-bank* duck-spin-radius))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere)) *null-vector* (-> *TARGET-bank* duck-spin-radius))
(set! (-> sphere1 transform-index) 32))
(('duck-slide)
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
(-> *TARGET-bank* duck-spin-offset)
(-> *TARGET-bank* duck-spin-radius))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere)) *null-vector* (-> *TARGET-bank* duck-spin-radius))
(set! (-> sphere1 transform-index) 28))
(('wheel-solid)
@@ -306,7 +306,7 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(dotimes (i 3)
(set! (-> self control collision-spheres i prim-core offense) (collide-offense touch)))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
@@ -314,7 +314,7 @@
(+ 819.2 (-> *TARGET-bank* duck-spin-radius)))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere)) *null-vector* (-> *TARGET-bank* duck-spin-radius))
(set! (-> sphere1 transform-index) 7)
(set! (-> self control danger-mode) 'roll))
@@ -322,7 +322,7 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(dotimes (i 3)
(set! (-> self control collision-spheres i prim-core offense) (collide-offense touch)))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
@@ -330,7 +330,7 @@
(+ 819.2 (-> *TARGET-bank* duck-spin-radius)))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere)) *null-vector* (-> *TARGET-bank* duck-spin-radius))
(set! (-> sphere1 transform-index) 7)
(set! (-> self control danger-mode) 'flip))
@@ -341,13 +341,13 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
(-> *TARGET-bank* punch-offset)
(-> *TARGET-bank* punch-radius))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere)) *null-vector* (-> *TARGET-bank* punch-radius))
(set! (-> sphere1 transform-index) 22))
(('uppercut)
@@ -358,18 +358,18 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
(-> *TARGET-bank* uppercut0-offset)
(-> *TARGET-bank* uppercut-radius))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere)) *null-vector* (-> *TARGET-bank* uppercut-radius))
(set! (-> sphere1 transform-index) 22)
(set! (-> sphere2 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere2 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere2 local-sphere))
(-> *TARGET-bank* uppercut1-offset)
(-> *TARGET-bank* uppercut-radius)))
@@ -378,7 +378,7 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(dotimes (i 3)
(set! (-> self control collision-spheres i prim-core offense) (collide-offense strong-attack)))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
@@ -392,7 +392,7 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(dotimes (i 3)
(set! (-> self control collision-spheres i prim-core offense) (collide-offense strong-attack)))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
@@ -400,7 +400,7 @@
(-> *TARGET-bank* flop-radius))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere))
(-> *TARGET-bank* flop1-offset)
(-> *TARGET-bank* flop-radius))
@@ -413,13 +413,13 @@
(logior! (-> self state-flags) (state-flags dangerous))
(set! (-> sphere0 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere0 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere0 local-sphere))
(-> *TARGET-bank* spin-offset)
(+ 2048.0 (-> *TARGET-bank* punch-radius)))
(set! (-> sphere1 prim-core collide-as) (collide-kind target target-attack))
(set! (-> sphere1 collide-with)
(collide-kind cak-1 cak-2 cak-3 powerup crate enemy wall-object ground-object mother-spider))
(collide-kind hit-by-player usually-hit-by-player hit-by-others powerup crate enemy wall-object ground-object mother-spider))
(sphere<-vector+r! (the-as sphere (-> sphere1 local-sphere)) *null-vector* (+ 1228.8 (-> *TARGET-bank* punch-radius)))
(set! (-> sphere1 transform-index) 37)
(dotimes (i 3)
+1 -1
View File
@@ -144,7 +144,7 @@
(define-extern unload (function string none))
(define-extern _format (function _varargs_ object))
(define-extern _format (function _varargs_ string))
(define-extern malloc (function symbol int pointer))
+4
View File
@@ -538,6 +538,10 @@
"Create a pointer to an object on the scratchpad."
`(the-as (pointer ,object-type) (&+ *fake-scratchpad-data* ,offset)))
(defmacro slet (binding &rest body)
"Execute body with a local bound to the scratchpad base at the requested type."
`(let ((,(first binding) (scratchpad-object ,(second binding)))) ,@body))
;; The PC port exposes translated EE assembly routines through these mips2c macros.
(defmacro def-mips2c (name value-type)
"Define a mips2c object (typically a function)."
@@ -88,7 +88,7 @@ and attacks Jak on contact."
:use-proximity-notice #f
:use-jump-blocked #t
:use-jump-patrol #f
:gnd-collide-with (collide-kind background cak-2 ground-object)
:gnd-collide-with (collide-kind background usually-hit-by-player ground-object)
:debug-draw-neck #f
:debug-draw-jump #f))
@@ -35,8 +35,8 @@
(set! *camera-base-mode* cam-robotboss)
(vector-copy! (-> self circular-follow) (-> *camera* tpos-curr-adj))
(set! (-> self pivot-rad) 73728.0)
(set! (-> self blend-from-type) (the-as uint 2))
(set! (-> self blend-to-type) (the-as uint 2)))))
(set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked))
(set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked)))))
:trans
(behavior ()
(when (not (logtest? (-> *camera* master-options) 2))
@@ -571,8 +571,8 @@
(matrix-rotate-yx! (-> self tracking inv-mat)
(-> (the-as periscope (-> v1-2 0)) turn)
(-> (the-as periscope (-> v1-2 0)) tilt)))
(set! (-> self blend-from-type) (the-as uint 0))
(set! (-> self blend-to-type) (the-as uint 0))
(set! (-> self blend-from-type) (camera-blend-to-type direct))
(set! (-> self blend-to-type) (camera-blend-to-type direct))
0))
:trans
(behavior ()
@@ -263,7 +263,7 @@
(set! (-> s5-0 no-reaction) (the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((s4-0 (new 'process 'collide-shape-prim-sphere s5-0 (the-as uint 0))))
(set! (-> s4-0 prim-core collide-as) (collide-kind projectile))
(set! (-> s4-0 collide-with) (collide-kind background cak-2 cak-3 target crate enemy wall-object ground-object))
(set! (-> s4-0 collide-with) (collide-kind background usually-hit-by-player hit-by-others target crate enemy wall-object ground-object))
(set! (-> s4-0 prim-core action) (collide-action solid))
(set! (-> s4-0 prim-core offense) (collide-offense strong-attack))
(set-vector! (-> s4-0 local-sphere) 0.0 0.0 0.0 1228.8)
+4 -4
View File
@@ -731,7 +731,7 @@
(let ((explosion-sphere (-> self root root-prim)))
(set! (-> explosion-sphere local-sphere w) (-> self blast-radius))
(set! (-> explosion-sphere prim-core world-sphere w) (-> self blast-radius))
(set! (-> explosion-sphere collide-with) (collide-kind cak-2 cak-3 target crate enemy wall-object))
(set! (-> explosion-sphere collide-with) (collide-kind usually-hit-by-player hit-by-others target crate enemy wall-object))
(set! (-> explosion-sphere prim-core collide-as) (collide-kind enemy)))
(update-transforms! (-> self root))
(let ((overlap-params (new 'stack-no-clear 'overlaps-others-params)))
@@ -784,7 +784,7 @@
(the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((collision-sphere (new 'process 'collide-shape-prim-sphere moving-shape (the-as uint 0))))
(set! (-> collision-sphere prim-core collide-as) (collide-kind enemy))
(set! (-> collision-sphere collide-with) (collide-kind background cak-2 cak-3 target crate enemy wall-object))
(set! (-> collision-sphere collide-with) (collide-kind background usually-hit-by-player hit-by-others target crate enemy wall-object))
(set! (-> collision-sphere prim-core action) (collide-action solid))
(set! (-> collision-sphere prim-core offense) (collide-offense touch))
(set! (-> collision-sphere transform-index) 0)
@@ -1212,8 +1212,8 @@
:enter
(behavior ()
(when (not (-> self enter-has-run))
(set! (-> self blend-from-type) (the-as uint 1))
(set! (-> self blend-to-type) (the-as uint 1))))
(set! (-> self blend-from-type) (camera-blend-to-type slave-controlled))
(set! (-> self blend-to-type) (camera-blend-to-type slave-controlled))))
:trans
(behavior ()
(if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating)))
@@ -359,7 +359,7 @@
(the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((primitive (new 'process 'collide-shape-prim-sphere collision (the-as uint 0))))
(set! (-> primitive prim-core collide-as) (collide-kind enemy))
(set! (-> primitive collide-with) (collide-kind background cak-2 cak-3 target crate enemy wall-object ground-object))
(set! (-> primitive collide-with) (collide-kind background usually-hit-by-player hit-by-others target crate enemy wall-object ground-object))
(set! (-> primitive prim-core action) (collide-action solid))
(set! (-> primitive prim-core offense) (collide-offense indestructible))
(set-vector! (-> primitive local-sphere) 0.0 0.0 0.0 2867.2)
+2 -2
View File
@@ -263,7 +263,7 @@
(let ((v1-10 (-> self root root-prim)))
(set! (-> v1-10 local-sphere w) (-> self blast-radius))
(set! (-> v1-10 prim-core world-sphere w) (-> self blast-radius))
(set! (-> v1-10 collide-with) (collide-kind cak-2 cak-3 target crate enemy wall-object ground-object))
(set! (-> v1-10 collide-with) (collide-kind usually-hit-by-player hit-by-others target crate enemy wall-object ground-object))
(set! (-> v1-10 prim-core collide-as) (collide-kind enemy)))
(update-transforms! (-> self root))
(let ((a1-1 (new 'stack-no-clear 'overlaps-others-params)))
@@ -293,7 +293,7 @@
(set! (-> s5-0 no-reaction) (the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((s4-0 (new 'process 'collide-shape-prim-sphere s5-0 (the-as uint 3))))
(set! (-> s4-0 prim-core collide-as) (collide-kind enemy))
(set! (-> s4-0 collide-with) (collide-kind background cak-2 target wall-object ground-object))
(set! (-> s4-0 collide-with) (collide-kind background usually-hit-by-player target wall-object ground-object))
(set! (-> s4-0 prim-core action) (collide-action solid))
(set! (-> s4-0 prim-core offense) (collide-offense normal-attack))
(set-vector! (-> s4-0 local-sphere) 0.0 0.0 0.0 12288.0)
+1 -1
View File
@@ -914,7 +914,7 @@
(set! (-> self rotate-speed) (-> self nav-info run-rotate-speed))
(set! (-> self turn-time) (-> self nav-info run-turn-time))
(logclear! (-> self nav flags) (nav-control-flags enable-sphere-avoidance))
(set-root-prim-collide-with! (-> self collide-info) (collide-kind cak-2 cak-3 target crate enemy))
(set-root-prim-collide-with! (-> self collide-info) (collide-kind usually-hit-by-player hit-by-others target crate enemy))
(set! (-> self track-target?) #t)
(set! (-> self slow-down?) #f)
(set! (-> self speed) 81920.0)
+2 -2
View File
@@ -496,7 +496,7 @@
(let ((collision-prim (new 'process 'collide-shape-prim-sphere collision-shape (the-as uint 0))))
(set! (-> collision-prim prim-core collide-as) (collide-kind projectile))
(set! (-> collision-prim collide-with)
(collide-kind background cak-2 cak-3 target crate enemy wall-object ground-object))
(collide-kind background usually-hit-by-player hit-by-others target crate enemy wall-object ground-object))
(set! (-> collision-prim prim-core offense) (collide-offense strong-attack))
(set-vector! (-> collision-prim local-sphere) 0.0 0.0 0.0 1228.8)
(set-root-prim! collision-shape collision-prim))
@@ -980,7 +980,7 @@
eye-position
to-target
1228.8
(collide-kind background cak-2 ground-object)
(collide-kind background usually-hit-by-player ground-object)
this
probe-result
(new 'static 'pat-surface :noentity #x1))
+3 -3
View File
@@ -583,21 +583,21 @@
(set! (-> s4-0 no-reaction) (the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((s3-0 (new 'process 'collide-shape-prim-group s4-0 (the-as uint 2) 0)))
(set! (-> s3-0 prim-core collide-as) (collide-kind enemy))
(set! (-> s3-0 collide-with) (collide-kind cak-2 target crate enemy))
(set! (-> s3-0 collide-with) (collide-kind usually-hit-by-player target crate enemy))
(set! (-> s3-0 prim-core action) (collide-action solid attackable attackable-unused))
(set! (-> s3-0 prim-core offense) (collide-offense normal-attack))
(set-vector! (-> s3-0 local-sphere) 0.0 6144.0 0.0 10240.0)
(set-root-prim! s4-0 s3-0)
(let ((s2-0 (new 'process 'collide-shape-prim-sphere s4-0 (the-as uint 3))))
(set! (-> s2-0 prim-core collide-as) (collide-kind enemy))
(set! (-> s2-0 collide-with) (collide-kind cak-2 target crate enemy))
(set! (-> s2-0 collide-with) (collide-kind usually-hit-by-player target crate enemy))
(set! (-> s2-0 prim-core action) (collide-action solid attackable attackable-unused))
(set! (-> s2-0 prim-core offense) (collide-offense normal-attack))
(set-vector! (-> s2-0 local-sphere) 0.0 4096.0 0.0 6963.2)
(append-prim s3-0 s2-0))
(let ((s2-1 (new 'process 'collide-shape-prim-sphere s4-0 (the-as uint 3))))
(set! (-> s2-1 prim-core collide-as) (collide-kind enemy))
(set! (-> s2-1 collide-with) (collide-kind cak-2 target crate enemy))
(set! (-> s2-1 collide-with) (collide-kind usually-hit-by-player target crate enemy))
(set! (-> s2-1 prim-core action) (collide-action solid attackable attackable-unused))
(set! (-> s2-1 prim-core offense) (collide-offense normal-attack))
(set-vector! (-> s2-1 local-sphere) 0.0 9420.8 0.0 4096.0)
+1 -1
View File
@@ -124,7 +124,7 @@
a1-0
a2-0
8192.0
(collide-kind background cak-3 ground-object)
(collide-kind background hit-by-others ground-object)
this
s5-0
(new 'static 'pat-surface :noentity #x1))
+1 -1
View File
@@ -618,7 +618,7 @@
gp-0
s5-1
409.6
(collide-kind background cak-2 crate enemy wall-object projectile ground-object)
(collide-kind background usually-hit-by-player crate enemy wall-object projectile ground-object)
self
t2-0
(new 'static 'pat-surface :noentity #x1)))
+4 -4
View File
@@ -525,8 +525,8 @@
((= s5-0 3) (ambient-hint-spawn "gamcam03" (the-as vector #f) *entity-pool* 'camera))
((= s5-0 4) (ambient-hint-spawn "gamcam06" (the-as vector #f) *entity-pool* 'camera))))
(let ((s5-1 (entity-by-name (-> gp-0 rock-camera))))
(cam-slave-get-vector-with-offset (the-as entity-actor s5-1) *camera-other-trans* 'trans)
(cam-slave-get-rot (the-as entity-actor s5-1) *camera-other-matrix*)
(cam-slave-get-vector-with-offset (the-as entity-camera s5-1) *camera-other-trans* 'trans)
(cam-slave-get-rot (the-as entity-camera s5-1) *camera-other-matrix*)
(set! (-> *camera-other-fov* data) (cam-slave-get-fov s5-1)))
(vector-copy! *camera-other-root* (-> self root trans))
(set-time! (-> self state-time))
@@ -574,8 +574,8 @@
(suspend))
(when (zero? s5-2)
(let ((gp-1 (entity-by-name (-> gp-0 arm-camera))))
(cam-slave-get-vector-with-offset (the-as entity-actor gp-1) *camera-other-trans* 'trans)
(cam-slave-get-rot (the-as entity-actor gp-1) *camera-other-matrix*)
(cam-slave-get-vector-with-offset (the-as entity-camera gp-1) *camera-other-trans* 'trans)
(cam-slave-get-rot (the-as entity-camera gp-1) *camera-other-matrix*)
(set! (-> *camera-other-fov* data) (cam-slave-get-fov gp-1)))
(vector-copy! *camera-other-root* (-> self root trans))
(set-time! (-> self state-time))
+6 -1
View File
@@ -682,6 +682,11 @@
`(the-as (pointer ,type) (&+ *fake-scratchpad-data* ,offset))
)
(defmacro slet (binding &rest body)
"Execute body with a local bound to the scratchpad base at the requested type."
`(let ((,(first binding) (scratchpad-object ,(second binding)))) ,@body)
)
(defmacro current-time ()
`(-> PP clock frame-counter)
)
@@ -707,4 +712,4 @@
)
(defmacro suspend-for (time &rest body)
`(let ((time (current-time))) (until (time-elapsed? time ,time) ,@body (suspend))))
`(let ((time (current-time))) (until (time-elapsed? time ,time) ,@body (suspend))))
+5
View File
@@ -717,6 +717,11 @@ class Compiler {
Val* compile_deftype(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_defmethod(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_deref(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_addr_deref(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_deref_impl(const goos::Object& form,
const goos::Object& rest,
Env* env,
bool return_address);
Val* compile_the_as(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_the(const goos::Object& form, const goos::Object& rest, Env* env);
Val* compile_print_type(const goos::Object& form, const goos::Object& rest, Env* env);
+1
View File
@@ -207,6 +207,7 @@ const std::unordered_map<std::string, GoalCompilerForm> g_goal_forms = {
{"defmethod", {.form_function = &Compiler::compile_defmethod}},
{"defenum", {.form_function = &Compiler::compile_defenum}},
{"->", {.form_function = &Compiler::compile_deref}},
{"&->", {.form_function = &Compiler::compile_addr_deref}},
{"&", {.form_function = &Compiler::compile_addr_of}},
{"the-as", {.form_function = &Compiler::compile_the_as}},
{"the", {.form_function = &Compiler::compile_the}},
+34 -6
View File
@@ -747,12 +747,34 @@ Val* Compiler::get_field_of_bitfield(const BitFieldType* type,
* The result of this should give something that has enough information to read/write the original
* location. Otherwise set! or & won't work.
*/
Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest, Env* env) {
Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& rest, Env* env) {
return compile_deref_impl(form, rest, env, false);
}
Val* Compiler::compile_addr_deref(const goos::Object& form, const goos::Object& rest, Env* env) {
return compile_deref_impl(form, rest, env, true);
}
Val* Compiler::compile_deref_impl(const goos::Object& form,
const goos::Object& _rest,
Env* env,
bool return_address) {
auto fe = env->function_env();
if (_rest.is_empty_list()) {
throw_compiler_error(form, "-> must get at least one argument");
throw_compiler_error(form, "{} must get at least one argument", return_address ? "&->" : "->");
}
auto finish = [&](Val* value, bool inline_array_address = false) -> Val* {
if (!return_address || inline_array_address) {
return value;
}
if (auto* deref = dynamic_cast<MemoryDerefVal*>(value)) {
return deref->base;
}
throw_compiler_error(form, "Cannot take the address of {}.", value->print());
return nullptr;
};
auto& first_arg = pair_car(_rest);
auto rest = &pair_cdr(_rest);
@@ -773,7 +795,7 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest
} else {
ASSERT(false);
}
return result;
return finish(result);
}
// compound, is field access/nested access
@@ -850,16 +872,22 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest
throw_compiler_error(form, "Cannot dereference an inline-array with type {}",
result->type().print());
}
const auto inline_array_type = result->type();
auto di = m_ts.get_deref_info(result->type());
ASSERT(di.can_deref);
const bool final_inline_array_address = return_address && rest->is_empty_list();
const auto& result_type = final_inline_array_address ? inline_array_type : di.result_type;
if (has_constant_idx) {
result = fe->alloc_val<MemoryOffsetConstantVal>(di.result_type, result,
result = fe->alloc_val<MemoryOffsetConstantVal>(result_type, result,
di.stride * constant_index_value);
} else {
// todo - use shifts if possible?
RegVal* offset = fe->make_gpr(TypeSpec("int"));
compile_constant_product(form, offset, index_value, di.stride, env);
result = fe->alloc_val<MemoryOffsetVal>(di.result_type, result, offset);
result = fe->alloc_val<MemoryOffsetVal>(result_type, result, offset);
}
if (final_inline_array_address) {
return finish(result, true);
}
} else if (result->type().base_type() == "pointer") {
if (!result->type().has_single_arg()) {
@@ -919,7 +947,7 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest
throw_compiler_error(form, "Cannot access array of type {}.", result->type().print());
}
}
return result;
return finish(result);
}
TypeSpec coerce_to_stack_spill_type(const TypeSpec& in) {