mirror of
https://github.com/open-goal/jak-project
synced 2026-08-20 22:35:07 -04:00
water111
595 lines
40 KiB
Common Lisp
595 lines
40 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/common-obs/generic-obs-h.gc")
|
|
(require "engine/gfx/merc/merc-death.gc")
|
|
(require "engine/common-obs/process-drawable-h.gc")
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(define *footstep-surface* 448)
|
|
|
|
(define *debug-effect-control* #f)
|
|
|
|
(defun sound-name-with-material ((base-name symbol) (ground-surface pat-surface) (suffix string))
|
|
"Build a sound name from base, the collision material's sound-family name, and suffix. Materials
|
|
that share audio use the pcmetal, metal, or grass family, and waterbottom and deepsnow use the
|
|
shortened water and dpsnow names."
|
|
(let ((format-fn format)
|
|
(name-buffer (clear *temp-string*))
|
|
(name-template "~S-~S~S")
|
|
(material (-> ground-surface material)))
|
|
(format-fn name-buffer
|
|
name-template
|
|
base-name
|
|
(cond
|
|
((= material (pat-material sand)) "sand")
|
|
((= material (pat-material wood)) "wood")
|
|
((= material (pat-material crwood)) "crwood")
|
|
((or (= material (pat-material tube)) (= material (pat-material pcmetal))) "pcmetal")
|
|
((or (= material (pat-material metal)) (= material (pat-material rotate))) "metal")
|
|
((= material (pat-material snow)) "snow")
|
|
((= material (pat-material deepsnow)) "dpsnow")
|
|
((= material (pat-material gravel)) "gravel")
|
|
((= material (pat-material dirt)) "dirt")
|
|
((= material (pat-material stone)) "stone")
|
|
((= material (pat-material waterbottom)) "water")
|
|
((= material (pat-material tar)) "tar")
|
|
((= material (pat-material straw)) "straw")
|
|
((= material (pat-material ice)) "ice")
|
|
((= material (pat-material swamp)) "swamp")
|
|
((= material (pat-material neutral)) "neutral")
|
|
(else "grass"))
|
|
suffix))
|
|
(string->sound-name *temp-string*))
|
|
|
|
(defun effect-param->sound-spec ((specification sound-spec) (parameters (pointer float)) (value-count int))
|
|
"Apply opcode/value pairs to spec. Opcodes set or randomly add volume, pitch, and bend; set falloff
|
|
minimum, maximum, and curve; or set priority. value-count counts floats and is consumed two at a
|
|
time."
|
|
(while (> value-count 0)
|
|
(case (the int (-> parameters 0))
|
|
((3)
|
|
(logior! (-> specification mask) (sound-mask volume))
|
|
(set! (-> specification volume) (the int (* 10.24 (-> parameters 1)))))
|
|
((4)
|
|
(logior! (-> specification mask) (sound-mask volume))
|
|
(+! (-> specification volume) (the int (* 10.24 (* (-> parameters 1) (rand-vu))))))
|
|
((5)
|
|
(logior! (-> specification mask) (sound-mask pitch))
|
|
(set! (-> specification pitch-mod) (the int (* 1524.0 (-> parameters 1)))))
|
|
((6)
|
|
(logior! (-> specification mask) (sound-mask pitch))
|
|
(+! (-> specification pitch-mod) (the int (* 1524.0 (* (-> parameters 1) (rand-vu))))))
|
|
((9)
|
|
(logior! (-> specification mask) (sound-mask bend))
|
|
(set! (-> specification bend) (the int (* 327.66998 (-> parameters 1)))))
|
|
((10)
|
|
(logior! (-> specification mask) (sound-mask bend))
|
|
(+! (-> specification bend) (the int (* 327.66998 (* (-> parameters 1) (rand-vu))))))
|
|
((11)
|
|
(logior! (-> specification mask) (sound-mask fo-min))
|
|
(set! (-> specification fo-min) (the int (-> parameters 1))))
|
|
((12)
|
|
(logior! (-> specification mask) (sound-mask fo-max))
|
|
(set! (-> specification fo-max) (the int (-> parameters 1))))
|
|
((13)
|
|
(logior! (-> specification mask) (sound-mask fo-curve))
|
|
(set! (-> specification fo-curve) (the int (-> parameters 1))))
|
|
((19) (set! (-> specification priority) (the int (-> parameters 1)))))
|
|
(+! value-count -2)
|
|
(set! parameters (&-> parameters 2)))
|
|
specification)
|
|
|
|
;; Effect tags are authored in the animation's artist-frame domain rather than its internal frame
|
|
;; indices. The selected channel supplies the conversion, while root channel zero supplies the
|
|
;; frame-advance function that determines whether the interval moved, sought, wrapped, or held.
|
|
(defmethod update-effects ((this effect-control))
|
|
"Track the selected animation channel in artist-frame units and dispatch every
|
|
effect tag crossed since the previous update. Handle forward and backward seeking, loop wraps, and
|
|
held frames without firing a tag twice."
|
|
(let* ((skel-controller (-> this process skel))
|
|
(channel (if (< (-> this channel-offset) (-> skel-controller active-channels))
|
|
(-> skel-controller root-channel (-> this channel-offset))
|
|
(the-as joint-control-channel #f))))
|
|
(cond
|
|
((and channel (-> channel frame-group))
|
|
(let* ((frame-group (-> channel frame-group))
|
|
(artist-frame (+ (* (-> channel frame-num) (-> frame-group artist-step)) (-> frame-group artist-base))))
|
|
(let ((frame-function (-> skel-controller root-channel 0 num-func)))
|
|
(cond
|
|
((!= frame-group (-> this last-frame-group))
|
|
(set! (-> this res) (-> frame-group extra))
|
|
(let ((first-effect-tag-index (-> (lookup-tag-idx (-> frame-group extra) 'effect-name 'base -1000000000.0) lo)))
|
|
(set! (-> this name)
|
|
(if (>= (the-as int first-effect-tag-index) 0)
|
|
(&-> frame-group extra tag first-effect-tag-index)
|
|
(the-as (pointer res-tag) #f))))
|
|
(if (and (-> this name) (= (-> this name 0 key-frame) -1000000000.0)) (set! (-> this name) (&-> this name 1)))
|
|
(play-effects-from-res-lump this artist-frame artist-frame artist-frame))
|
|
((or (not (-> this name)) (= artist-frame (-> this last-frame-num))))
|
|
(else
|
|
(let ((previous-frame (-> this last-frame-num))
|
|
(current-frame artist-frame))
|
|
(cond
|
|
((= frame-function num-func-seek!)
|
|
(let ((seek-frame (+ (* (-> channel param 0) (-> frame-group artist-step)) (-> frame-group artist-base))))
|
|
(cond
|
|
((< current-frame previous-frame)
|
|
(if (>= previous-frame seek-frame) (play-effects-from-res-lump this current-frame previous-frame artist-frame)))
|
|
(else (if (>= seek-frame previous-frame) (play-effects-from-res-lump this previous-frame current-frame artist-frame))))))
|
|
((= frame-function num-func-loop!)
|
|
(cond
|
|
((>= (-> channel param 0) 0.0)
|
|
(cond
|
|
((< current-frame previous-frame)
|
|
(play-effects-from-res-lump this previous-frame 9999999.0 artist-frame)
|
|
(play-effects-from-res-lump this -100000000.0 current-frame 9999999.0))
|
|
(else (play-effects-from-res-lump this previous-frame current-frame artist-frame))))
|
|
((< previous-frame current-frame)
|
|
(play-effects-from-res-lump this current-frame 9999999.0 artist-frame)
|
|
(play-effects-from-res-lump this -100000000.0 previous-frame 9999999.0))
|
|
(else (play-effects-from-res-lump this current-frame previous-frame artist-frame))))
|
|
((= frame-function num-func-+!)
|
|
(if (>= (-> channel param 0) 0.0)
|
|
(play-effects-from-res-lump this previous-frame current-frame artist-frame)
|
|
(play-effects-from-res-lump this current-frame previous-frame artist-frame)))
|
|
((= frame-function num-func-identity) (play-effects-from-res-lump this artist-frame artist-frame artist-frame)))))))
|
|
(set! (-> this last-frame-group) frame-group)
|
|
(set! (-> this last-frame-num) artist-frame)))
|
|
(else (set! (-> this last-frame-group) #f))))
|
|
0
|
|
(none))
|
|
|
|
(defmethod play-effects-from-res-lump ((this effect-control) (lower-frame float) (upper-frame float) (exact-frame float))
|
|
"Dispatch each consecutive effect-name tag strictly between the
|
|
lower and upper frame bounds, plus a tag exactly equal to exact-frame."
|
|
;; note: this check was added. I believe in the original game name could be false, and then the
|
|
;; effect-name check below would fail. This did not cause a crash on original hardware because
|
|
;; misaligned 16-byte loads silently align. This causes a crash in opengoal, so we skip it manually.
|
|
(when (-> this name)
|
|
(let ((tag-cursor (-> this name)))
|
|
(while (= (-> tag-cursor 0 name) 'effect-name)
|
|
(let ((key-frame (-> tag-cursor 0 key-frame)))
|
|
(when (or (and (< key-frame upper-frame) (< lower-frame key-frame)) (= key-frame exact-frame))
|
|
(let* ((controller this)
|
|
(dispatch-effect (method-of-object controller do-effect))
|
|
(resource-lump (-> this res))
|
|
(tag-data (-> tag-cursor 0)))
|
|
(dispatch-effect controller
|
|
(the-as symbol (-> (the-as (pointer uint32) (&+ (-> resource-lump data-base) (-> tag-data data-offset)))))
|
|
key-frame
|
|
-1))))
|
|
(set! tag-cursor (&-> tag-cursor 1)))))
|
|
0
|
|
(none))
|
|
|
|
;; An effect-name symbol doubles as the dispatch key and, when bound, the effect object. The
|
|
;; effect- and group- prefixes provide two data-driven families; the remaining cases accept direct
|
|
;; particle launchers, particle groups, sound specifications, death effects, and ordinary sounds.
|
|
(defmethod do-effect ((this effect-control) (effect-name symbol) (frame float) (joint-index int))
|
|
"Dispatch one named animation effect. Give the owning process first chance to consume
|
|
it as an event, then resolve material effects, particle launchers or groups, sounds, camera shake,
|
|
and death effects. A negative joint selects the effect-joint property at frame."
|
|
(let ((effect-value (-> effect-name value))
|
|
(resolved-joint-index (cond
|
|
((< joint-index 0)
|
|
(let ((joint-property (get-property-value (-> this res)
|
|
'effect-joint
|
|
'exact
|
|
frame
|
|
(the-as uint128 0)
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*)))
|
|
(if (zero? joint-property) 0 (the-as int (+ joint-property 1)))))
|
|
(else (empty) joint-index))))
|
|
(when (logtest? (-> this flags) (effect-control-flag event))
|
|
(if (send-event (-> this process) 'effect effect-name frame resolved-joint-index) (return (the-as object 0))))
|
|
(let ((effect-name-string (symbol->string effect-name)))
|
|
(cond
|
|
((and (= (-> effect-name-string data 0) 101)
|
|
(= (-> effect-name-string data 1) 102)
|
|
(= (-> effect-name-string data 2) 102)
|
|
(= (-> effect-name-string data 3) 101)
|
|
(= (-> effect-name-string data 4) 99)
|
|
(= (-> effect-name-string data 5) 116)
|
|
(= (-> effect-name-string data 6) 45))
|
|
(let* ((root-transform (-> this process root))
|
|
(moving-root (if (and (nonzero? root-transform) (type-type? (-> root-transform type) collide-shape-moving)) root-transform))
|
|
(ground-surface-value (if moving-root (the-as int (-> (the-as collide-shape-moving moving-root) ground-pat)) *footstep-surface*)))
|
|
(do-effect-for-surface this
|
|
effect-name
|
|
frame
|
|
resolved-joint-index
|
|
(-> this res)
|
|
(the-as pat-surface ground-surface-value))))
|
|
((let ((group-name-string (symbol->string effect-name)))
|
|
(and (= (-> group-name-string data 0) 103)
|
|
(= (-> group-name-string data 1) 114)
|
|
(= (-> group-name-string data 2) 111)
|
|
(= (-> group-name-string data 3) 117)
|
|
(= (-> group-name-string data 4) 112)
|
|
(= (-> group-name-string data 5) 45)))
|
|
(set! effect-value
|
|
(cond
|
|
((zero? effect-value)
|
|
(let ((launch-group-pointer (lookup-part-group-pointer-by-name (symbol->string effect-name))))
|
|
(when launch-group-pointer
|
|
(set! (-> effect-name value) launch-group-pointer)
|
|
(set! effect-value (-> launch-group-pointer 0))))
|
|
effect-value)
|
|
(else (-> (the-as (pointer sparticle-launch-group) effect-value) 0))))
|
|
(when (and (nonzero? effect-value) (= (-> (the-as sparticle-launch-group effect-value) type) sparticle-launch-group))
|
|
(if *debug-effect-control*
|
|
(format #t
|
|
"(~5D) effect group ~A ~A frame ~F joint ~D~%"
|
|
(current-time)
|
|
(-> this process name)
|
|
effect-name
|
|
frame
|
|
resolved-joint-index))
|
|
(process-spawn part-tracker
|
|
:init
|
|
part-tracker-init
|
|
(the-as sparticle-launch-group effect-value)
|
|
-1
|
|
(the-as symbol #f)
|
|
(the-as symbol #f)
|
|
(the-as symbol #f)
|
|
(vector<-cspace! (new 'stack-no-clear 'vector) (-> this process node-list data resolved-joint-index))
|
|
:to (-> this process))))
|
|
((= effect-name 'camera-shake) (activate! *camera-smush-control* 819.2 37 600 1.0 0.995))
|
|
((zero? effect-value)
|
|
(play-effect-sound this
|
|
effect-name
|
|
frame
|
|
resolved-joint-index
|
|
(-> this res)
|
|
(string->sound-name (symbol->string effect-name))))
|
|
((= (-> (the-as basic effect-value) type) sparticle-launcher)
|
|
(if *debug-effect-control*
|
|
(format #t
|
|
"(~5D) effect part ~A ~A frame ~F joint ~D~%"
|
|
(current-time)
|
|
(-> this process name)
|
|
effect-name
|
|
frame
|
|
resolved-joint-index))
|
|
(format #t
|
|
"-----> (~5D) effect part ~A ~A frame ~F joint ~D~%"
|
|
(current-time)
|
|
(-> this process name)
|
|
effect-name
|
|
frame
|
|
resolved-joint-index)
|
|
(launch-particles (the-as sparticle-launcher effect-value)
|
|
(vector<-cspace! (new 'stack-no-clear 'vector) (-> this process node-list data resolved-joint-index))))
|
|
((= (-> (the-as basic effect-value) type) sparticle-launch-group)
|
|
(if *debug-effect-control*
|
|
(format #t
|
|
"(~5D) effect group ~A ~A frame ~F joint ~D~%"
|
|
(current-time)
|
|
(-> this process name)
|
|
effect-name
|
|
frame
|
|
resolved-joint-index))
|
|
(process-spawn part-tracker
|
|
:init
|
|
part-tracker-init
|
|
effect-value
|
|
-1
|
|
(the-as symbol #f)
|
|
(the-as symbol #f)
|
|
(the-as symbol #f)
|
|
(vector<-cspace! (new 'stack-no-clear 'vector) (-> this process node-list data resolved-joint-index))
|
|
:to (-> this process)))
|
|
((= (-> (the-as basic effect-value) type) sound-spec)
|
|
(sound-play-by-spec (the-as sound-spec effect-value)
|
|
(new-sound-id)
|
|
(vector<-cspace! (new 'stack-no-clear 'vector) (-> this process node-list data resolved-joint-index))))
|
|
((= (-> (the-as basic effect-value) type) death-info)
|
|
(let ((draw-state (-> this process draw)))
|
|
(let ((vertex-skip (-> (the-as death-info effect-value) vertex-skip))
|
|
(death-timer (max 2 (the-as int (/ (-> (the-as death-info effect-value) timer) (the-as uint (the int (-> *display* time-factor))))))))
|
|
(when (= (-> *setting-control* current video-mode) 'pal)
|
|
(if (< (the-as uint 1) vertex-skip) (set! vertex-skip (/ (the-as uint (* (the-as uint 50) vertex-skip)) (the-as uint 60)))))
|
|
(let ((run-time (-> *display* frames (-> *display* last-screen) frame run-time)))
|
|
(cond
|
|
((< 9000 run-time) (set! vertex-skip (* vertex-skip 4)))
|
|
((< 7000 run-time) (set! vertex-skip (* vertex-skip 2)))))
|
|
(set! (-> draw-state death-vertex-skip) vertex-skip)
|
|
(set! (-> draw-state death-effect) (-> (the-as death-info effect-value) effect))
|
|
(set! (-> draw-state death-timer) (+ death-timer 1)))
|
|
(set! (-> draw-state death-timer-org) (-> draw-state death-timer))
|
|
(set! (-> draw-state death-draw-overlap) (-> (the-as death-info effect-value) overlap)))
|
|
(if (-> (the-as death-info effect-value) sound)
|
|
(play-effect-sound this
|
|
(-> (the-as death-info effect-value) sound)
|
|
frame
|
|
resolved-joint-index
|
|
(-> this res)
|
|
(string->sound-name (symbol->string (-> (the-as death-info effect-value) sound)))))
|
|
(send-event (-> this process) 'death-start (the-as death-info effect-value)))
|
|
(else
|
|
(play-effect-sound this
|
|
effect-name
|
|
frame
|
|
resolved-joint-index
|
|
(-> this res)
|
|
(string->sound-name (symbol->string effect-name)))))))
|
|
0)
|
|
|
|
;; Surface effects share authored event names but select their particle and sound assets from the
|
|
;; collision material. Materials without a specialized asset use the grass family.
|
|
(defmethod do-effect-for-surface ((this effect-control) (effect-name symbol) (frame float) (joint-index int) (resource-lump basic) (ground-surface pat-surface))
|
|
"Resolve a footstep, landing, slide, footprint, or droppings effect from
|
|
the supplied collision material, launch its material-specific particles when applicable, and play
|
|
its material-specific sound."
|
|
(let ((effect-sound (the-as sound-name #f)))
|
|
(let ((run-time (-> *display* frames (-> *display* last-screen) frame run-time)))
|
|
(case effect-name
|
|
(('effect-walk-step-left 'effect-run-step-left) (set! effect-sound (sound-name-with-material 'walk ground-surface "1")))
|
|
(('effect-walk-step-right 'effect-run-step-right) (set! effect-sound (sound-name-with-material 'walk ground-surface "2")))
|
|
(('effect-roll) (set! effect-sound (sound-name-with-material 'roll ground-surface "")))
|
|
(('effect-slide) (set! effect-sound (sound-name-with-material 'slide ground-surface "")))
|
|
(('effect-land) (set! effect-sound (sound-name-with-material 'land ground-surface "")))
|
|
(('effect-zoom-land) (set! effect-sound (sound-name-with-material 'zoom-land ground-surface "")))
|
|
(('effect-zoom-hit) (set! effect-sound (sound-name-with-material 'zoom-hit ground-surface "")))
|
|
(('effect-flut-land) (set! effect-sound (sound-name-with-material 'flut-land ground-surface "")))
|
|
(('effect-land-poof)
|
|
(when (< run-time 9000)
|
|
(let* ((land-poof-controller this)
|
|
(dispatch-land-poof (method-of-object land-poof-controller do-effect))
|
|
(land-poof-material (-> ground-surface material)))
|
|
(dispatch-land-poof land-poof-controller
|
|
(cond
|
|
((= land-poof-material (pat-material sand)) 'group-land-poof-sand)
|
|
((= land-poof-material (pat-material wood)) 'group-land-poof-wood)
|
|
((= land-poof-material (pat-material crwood)) 'group-land-poof-crwood)
|
|
((or (= land-poof-material (pat-material tube)) (= land-poof-material (pat-material pcmetal))) 'group-land-poof-pcmetal)
|
|
((or (= land-poof-material (pat-material metal)) (= land-poof-material (pat-material rotate))) 'group-land-poof-metal)
|
|
((= land-poof-material (pat-material ice)) 'group-land-poof-ice)
|
|
((= land-poof-material (pat-material snow)) 'group-land-poof-snow)
|
|
((= land-poof-material (pat-material deepsnow)) 'group-land-poof-dpsnow)
|
|
((= land-poof-material (pat-material gravel)) 'group-land-poof-gravel)
|
|
((= land-poof-material (pat-material dirt)) 'group-land-poof-dirt)
|
|
((= land-poof-material (pat-material stone)) 'group-land-poof-stone)
|
|
((= land-poof-material (pat-material waterbottom)) 'group-land-poof-water)
|
|
((= land-poof-material (pat-material tar)) 'group-land-poof-tar)
|
|
((= land-poof-material (pat-material straw)) 'group-land-poof-straw)
|
|
((= land-poof-material (pat-material swamp)) 'group-land-poof-swamp)
|
|
((= land-poof-material (pat-material neutral)) 'group-land-poof-neutral)
|
|
(else 'group-land-poof-grass))
|
|
frame
|
|
-1))))
|
|
(('effect-run-poof)
|
|
(when (< run-time 9000)
|
|
(let* ((run-poof-controller this)
|
|
(dispatch-run-poof (method-of-object run-poof-controller do-effect))
|
|
(run-poof-material (-> ground-surface material)))
|
|
(dispatch-run-poof run-poof-controller
|
|
(cond
|
|
((= run-poof-material (pat-material sand)) 'group-run-poof-sand)
|
|
((= run-poof-material (pat-material wood)) 'group-run-poof-wood)
|
|
((= run-poof-material (pat-material crwood)) 'group-run-poof-crwood)
|
|
((or (= run-poof-material (pat-material tube)) (= run-poof-material (pat-material pcmetal))) 'group-run-poof-pcmetal)
|
|
((or (= run-poof-material (pat-material metal)) (= run-poof-material (pat-material rotate))) 'group-run-poof-metal)
|
|
((= run-poof-material (pat-material ice)) 'group-run-poof-ice)
|
|
((= run-poof-material (pat-material snow)) 'group-run-poof-snow)
|
|
((= run-poof-material (pat-material deepsnow)) 'group-run-poof-dpsnow)
|
|
((= run-poof-material (pat-material gravel)) 'group-run-poof-gravel)
|
|
((= run-poof-material (pat-material dirt)) 'group-run-poof-dirt)
|
|
((= run-poof-material (pat-material stone)) 'group-run-poof-stone)
|
|
((= run-poof-material (pat-material waterbottom)) 'group-run-poof-water)
|
|
((= run-poof-material (pat-material tar)) 'group-run-poof-tar)
|
|
((= run-poof-material (pat-material straw)) 'group-run-poof-straw)
|
|
((= run-poof-material (pat-material swamp)) 'group-run-poof-swamp)
|
|
((= run-poof-material (pat-material neutral)) 'group-run-poof-neutral)
|
|
(else 'group-run-poof-grass))
|
|
frame
|
|
-1))))
|
|
(('effect-just-footprint)
|
|
(let* ((footprint-controller this)
|
|
(dispatch-footprint (method-of-object footprint-controller do-effect))
|
|
(footprint-material (-> ground-surface material)))
|
|
(dispatch-footprint footprint-controller
|
|
(cond
|
|
((= footprint-material (pat-material sand)) 'group-just-footprint-sand)
|
|
((= footprint-material (pat-material wood)) 'group-just-footprint-wood)
|
|
((= footprint-material (pat-material crwood)) 'group-just-footprint-crwood)
|
|
((or (= footprint-material (pat-material tube)) (= footprint-material (pat-material pcmetal)))
|
|
'group-just-footprint-pcmetal)
|
|
((or (= footprint-material (pat-material metal)) (= footprint-material (pat-material rotate)))
|
|
'group-just-footprint-metal)
|
|
((= footprint-material (pat-material ice)) 'group-just-footprint-ice)
|
|
((= footprint-material (pat-material snow)) 'group-just-footprint-snow)
|
|
((= footprint-material (pat-material deepsnow)) 'group-just-footprint-dpsnow)
|
|
((= footprint-material (pat-material gravel)) 'group-just-footprint-gravel)
|
|
((= footprint-material (pat-material dirt)) 'group-just-footprint-dirt)
|
|
((= footprint-material (pat-material stone)) 'group-just-footprint-stone)
|
|
((= footprint-material (pat-material waterbottom)) 'group-just-footprint-water)
|
|
((= footprint-material (pat-material tar)) 'group-just-footprint-tar)
|
|
((= footprint-material (pat-material straw)) 'group-just-footprint-straw)
|
|
((= footprint-material (pat-material swamp)) 'group-just-footprint-swamp)
|
|
((= footprint-material (pat-material neutral)) 'group-just-footprint-neutral)
|
|
(else 'group-just-footprint-grass))
|
|
frame
|
|
-1)))
|
|
(('effect-just-poof)
|
|
(when (< run-time 9000)
|
|
(let* ((just-poof-controller this)
|
|
(dispatch-just-poof (method-of-object just-poof-controller do-effect))
|
|
(just-poof-material (-> ground-surface material)))
|
|
(dispatch-just-poof just-poof-controller
|
|
(cond
|
|
((= just-poof-material (pat-material sand)) 'group-just-poof-sand)
|
|
((= just-poof-material (pat-material wood)) 'group-just-poof-wood)
|
|
((= just-poof-material (pat-material crwood)) 'group-just-poof-crwood)
|
|
((or (= just-poof-material (pat-material tube)) (= just-poof-material (pat-material pcmetal))) 'group-just-poof-pcmetal)
|
|
((or (= just-poof-material (pat-material metal)) (= just-poof-material (pat-material rotate))) 'group-just-poof-metal)
|
|
((= just-poof-material (pat-material ice)) 'group-just-poof-ice)
|
|
((= just-poof-material (pat-material snow)) 'group-just-poof-snow)
|
|
((= just-poof-material (pat-material deepsnow)) 'group-just-poof-dpsnow)
|
|
((= just-poof-material (pat-material gravel)) 'group-just-poof-gravel)
|
|
((= just-poof-material (pat-material dirt)) 'group-just-poof-dirt)
|
|
((= just-poof-material (pat-material stone)) 'group-just-poof-stone)
|
|
((= just-poof-material (pat-material waterbottom)) 'group-just-poof-water)
|
|
((= just-poof-material (pat-material tar)) 'group-just-poof-tar)
|
|
((= just-poof-material (pat-material straw)) 'group-just-poof-straw)
|
|
((= just-poof-material (pat-material swamp)) 'group-just-poof-swamp)
|
|
((= just-poof-material (pat-material neutral)) 'group-just-poof-neutral)
|
|
(else 'group-just-poof-grass))
|
|
frame
|
|
-1))))
|
|
(('effect-slide-poof)
|
|
(let* ((slide-poof-controller this)
|
|
(dispatch-slide-poof (method-of-object slide-poof-controller do-effect))
|
|
(slide-poof-material (-> ground-surface material)))
|
|
(dispatch-slide-poof slide-poof-controller
|
|
(cond
|
|
((= slide-poof-material (pat-material sand)) 'group-slide-poof-sand)
|
|
((= slide-poof-material (pat-material wood)) 'group-slide-poof-wood)
|
|
((= slide-poof-material (pat-material crwood)) 'group-slide-poof-crwood)
|
|
((or (= slide-poof-material (pat-material tube)) (= slide-poof-material (pat-material pcmetal)))
|
|
'group-slide-poof-pcmetal)
|
|
((or (= slide-poof-material (pat-material metal)) (= slide-poof-material (pat-material rotate))) 'group-slide-poof-metal)
|
|
((= slide-poof-material (pat-material ice)) 'group-slide-poof-ice)
|
|
((= slide-poof-material (pat-material snow)) 'group-slide-poof-snow)
|
|
((= slide-poof-material (pat-material deepsnow)) 'group-slide-poof-dpsnow)
|
|
((= slide-poof-material (pat-material gravel)) 'group-slide-poof-gravel)
|
|
((= slide-poof-material (pat-material dirt)) 'group-slide-poof-dirt)
|
|
((= slide-poof-material (pat-material stone)) 'group-slide-poof-stone)
|
|
((= slide-poof-material (pat-material waterbottom)) 'group-slide-poof-water)
|
|
((= slide-poof-material (pat-material tar)) 'group-slide-poof-tar)
|
|
((= slide-poof-material (pat-material straw)) 'group-slide-poof-straw)
|
|
((= slide-poof-material (pat-material swamp)) 'group-slide-poof-swamp)
|
|
((= slide-poof-material (pat-material neutral)) 'group-slide-poof-neutral)
|
|
(else 'group-slide-poof-grass))
|
|
frame
|
|
-1)))
|
|
(('effect-droppings)
|
|
(let* ((droppings-material (-> ground-surface material))
|
|
(droppings-particle (cond
|
|
((= droppings-material (pat-material sand)) (-> *part-id-table* 95))
|
|
((= droppings-material (pat-material wood)) (-> *part-id-table* 97))
|
|
((= droppings-material (pat-material crwood)) (-> *part-id-table* 99))
|
|
((or (= droppings-material (pat-material tube)) (= droppings-material (pat-material pcmetal)))
|
|
(-> *part-id-table* 2248))
|
|
((or (= droppings-material (pat-material metal)) (= droppings-material (pat-material rotate)))
|
|
(-> *part-id-table* 2334))
|
|
((= droppings-material (pat-material ice)) (-> *part-id-table* 2249))
|
|
((= droppings-material (pat-material snow)) (-> *part-id-table* 2250))
|
|
((= droppings-material (pat-material deepsnow)) (-> *part-id-table* 2251))
|
|
((= droppings-material (pat-material gravel)) (-> *part-id-table* 2252))
|
|
((= droppings-material (pat-material dirt)) (-> *part-id-table* 2253))
|
|
((= droppings-material (pat-material stone)) (-> *part-id-table* 98))
|
|
((= droppings-material (pat-material waterbottom)) (-> *part-id-table* 2254))
|
|
((= droppings-material (pat-material tar)) (-> *part-id-table* 2255))
|
|
((= droppings-material (pat-material straw)) (-> *part-id-table* 2256))
|
|
((= droppings-material (pat-material swamp)) (-> *part-id-table* 2257))
|
|
((= droppings-material (pat-material neutral)) (-> *part-id-table* 2773))
|
|
(else (-> *part-id-table* 96)))))
|
|
(if (nonzero? droppings-particle)
|
|
(launch-particles droppings-particle
|
|
(vector<-cspace! (new 'stack-no-clear 'vector) (-> this process node-list data joint-index))))))
|
|
(('effect-jump-droppings)
|
|
(let* ((jump-droppings-material (-> ground-surface material))
|
|
(jump-droppings-particle (cond
|
|
((= jump-droppings-material (pat-material sand)) (-> *part-id-table* 106))
|
|
((= jump-droppings-material (pat-material wood)) (-> *part-id-table* 2258))
|
|
((= jump-droppings-material (pat-material crwood)) (-> *part-id-table* 2259))
|
|
((or (= jump-droppings-material (pat-material tube)) (= jump-droppings-material (pat-material pcmetal)))
|
|
(-> *part-id-table* 2260))
|
|
((or (= jump-droppings-material (pat-material metal)) (= jump-droppings-material (pat-material rotate)))
|
|
(-> *part-id-table* 2335))
|
|
((= jump-droppings-material (pat-material ice)) (-> *part-id-table* 2261))
|
|
((= jump-droppings-material (pat-material snow)) (-> *part-id-table* 2262))
|
|
((= jump-droppings-material (pat-material deepsnow)) (-> *part-id-table* 2263))
|
|
((= jump-droppings-material (pat-material gravel)) (-> *part-id-table* 2264))
|
|
((= jump-droppings-material (pat-material dirt)) (-> *part-id-table* 2265))
|
|
((= jump-droppings-material (pat-material stone)) (-> *part-id-table* 2266))
|
|
((= jump-droppings-material (pat-material waterbottom)) (-> *part-id-table* 2267))
|
|
((= jump-droppings-material (pat-material tar)) (-> *part-id-table* 2268))
|
|
((= jump-droppings-material (pat-material straw)) (-> *part-id-table* 2269))
|
|
((= jump-droppings-material (pat-material swamp)) (-> *part-id-table* 2270))
|
|
((= jump-droppings-material (pat-material neutral)) (-> *part-id-table* 2774))
|
|
(else (-> *part-id-table* 107)))))
|
|
(if (nonzero? jump-droppings-particle)
|
|
(launch-particles jump-droppings-particle
|
|
(vector<-cspace! (new 'stack-no-clear 'vector) (-> this process node-list data joint-index))))))))
|
|
(if effect-sound (play-effect-sound this effect-name frame joint-index resource-lump effect-sound)))
|
|
0
|
|
(none))
|
|
|
|
;; Each sound starts at full volume with a small random bend. An exact-frame effect-param array may
|
|
;; replace or perturb that base specification before the falloff test and playback.
|
|
(defmethod play-effect-sound ((this effect-control) (effect-name symbol) (frame float) (joint-index int) (resource-lump basic) (effect-sound sound-name))
|
|
"Build a default sound specification, apply exact-frame effect-param pairs,
|
|
skip sounds beyond their falloff maximum, and play the result at the selected joint or without a
|
|
position when joint is negative."
|
|
(let ((lump resource-lump)
|
|
(sound-to-play effect-sound)
|
|
(specification (new 'stack 'sound-spec))
|
|
(joint-position (if (< joint-index 0)
|
|
(the-as vector #f)
|
|
(vector<-cspace! (new 'stack-no-clear 'vector) (-> this process node-list data joint-index)))))
|
|
(set! (-> specification sound-name) sound-to-play)
|
|
(logior! (-> specification mask) (sound-mask volume))
|
|
(set! (-> specification volume) 1024)
|
|
(logior! (-> specification mask) (sound-mask bend))
|
|
(set! (-> specification bend) (the int (* 327.66998 (rand-vu-float-range -100.0 100.0))))
|
|
(let* ((parameter-tag (new 'static 'res-tag))
|
|
(parameter-data ((method-of-type res-lump get-property-data)
|
|
(the-as res-lump lump)
|
|
'effect-param
|
|
'exact
|
|
frame
|
|
(the-as pointer #f)
|
|
(& parameter-tag)
|
|
*res-static-buf*)))
|
|
(if parameter-data
|
|
(effect-param->sound-spec specification
|
|
(the-as (pointer float) parameter-data)
|
|
(the-as int (-> parameter-tag elt-count)))))
|
|
(if (and (nonzero? (-> specification fo-max))
|
|
(< (* 4096.0 (the float (-> specification fo-max))) (vector-vector-distance (ear-trans) joint-position)))
|
|
(return 0))
|
|
(when *debug-effect-control*
|
|
(let ((sound-name-address sound-to-play))
|
|
(string<-charp (clear *temp-string*) (the-as (pointer uint8) (& sound-name-address))))
|
|
(format #t
|
|
"(~5D) effect sound ~A ~A (~S) frame ~F joint ~D "
|
|
(current-time)
|
|
(-> this process name)
|
|
effect-name
|
|
*temp-string*
|
|
frame
|
|
joint-index)
|
|
(format #t
|
|
"volume: ~f pitch-mod: ~f~%"
|
|
(* 0.09765625 (the float (-> specification volume)))
|
|
(* 0.000656168 (the float (-> specification pitch-mod)))))
|
|
(sound-play-by-spec specification (new-sound-id) joint-position))
|
|
0)
|
|
|
|
(defbehavior target-land-effect target ()
|
|
"Play landing effects for the target's current movement and surface. Flut launches its landing
|
|
poof and sound, racer plays an impact-scaled zoom sound, water uses the water landing effect, and
|
|
ordinary landings launch a poof and material sound."
|
|
(cond
|
|
((logtest? (-> self control root-prim prim-core action) (collide-action flut))
|
|
(do-effect (-> self skel effect) 'effect-land-poof -1.0 -1)
|
|
(do-effect (-> self skel effect) 'effect-flut-land -1.0 -1))
|
|
((logtest? (-> self control root-prim prim-core action) (collide-action racer))
|
|
(sound-play-by-name (sound-name-with-material 'zoom-land (-> self control ground-pat) "")
|
|
(new-sound-id)
|
|
(the int (* 10.24 (* 100.0 (the float (the int (* 10.24 (/ (-> self control ground-impact-vel) (meters 15))))))))
|
|
0
|
|
0
|
|
(sound-group sfx)
|
|
#t))
|
|
((logtest? (-> self water flag) (water-flag touch-water)) (do-effect (-> self skel effect) 'effect-land-water -1.0 -1))
|
|
(else (do-effect (-> self skel effect) 'effect-land-poof -1.0 -1) (do-effect (-> self skel effect) 'effect-land -1.0 -1)))
|
|
0
|
|
(none))
|