mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 21:27:52 -04:00
1313 lines
40 KiB
Common Lisp
1313 lines
40 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: gsound.gc
|
|
;; name in dgo: gsound
|
|
;; dgos: GAME
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(deftype engine-sound-pers (engine-pers)
|
|
()
|
|
)
|
|
|
|
|
|
(defmethod kill-callback ((this engine-sound-pers) (arg0 connection-pers))
|
|
"Called when a connection is removed."
|
|
(let ((v1-0 (the-as sound-rpc-set-param (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command set-param))
|
|
(set! (-> v1-0 id) (the-as sound-id (-> arg0 param-int64 0)))
|
|
(set! (-> v1-0 params volume) -4)
|
|
(set! (-> v1-0 auto-time) 120)
|
|
(set! (-> v1-0 auto-from) 2)
|
|
(set! (-> v1-0 params mask) (the-as uint 17))
|
|
(-> v1-0 id)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(kmemopen global "sound-loop-engine")
|
|
|
|
(define *sound-loop-engine* (new 'global 'engine-sound-pers '*sound-loop-engine* 32 connection-pers))
|
|
|
|
(kmemclose)
|
|
|
|
(kmemopen global "sound-rpc")
|
|
|
|
(define *sound-player-rpc* (new 'global 'rpc-buffer-pair (the-as uint 80) (the-as uint 128) 0))
|
|
|
|
(define *sound-loader-rpc* (new 'global 'rpc-buffer-pair (the-as uint 80) (the-as uint 1) 1))
|
|
|
|
(kmemclose)
|
|
|
|
(defun sound-name= ((a sound-name) (b sound-name))
|
|
"Are two sound names the same?"
|
|
(and (= (the-as uint a) (the-as uint b)) (= (-> a hi) (-> b hi)))
|
|
)
|
|
|
|
(deftype sound-iop-info (structure)
|
|
((frame uint32)
|
|
(strpos int32)
|
|
(str-id uint32)
|
|
(str-id-sign int32 :overlay-at str-id)
|
|
(freemem uint32)
|
|
(chinfo uint8 48)
|
|
(freemem2 uint32)
|
|
(nocd uint32)
|
|
(dirtycd uint32)
|
|
(diskspeed uint32 2)
|
|
(lastspeed uint32)
|
|
(dupseg int32)
|
|
(times int32 41)
|
|
(times-seq uint32)
|
|
(iop-ticks uint32)
|
|
(stream-position uint32 4 :offset 272)
|
|
(stream-status stream-status 4)
|
|
(stream-name sound-stream-name 4 :inline)
|
|
(stream-id sound-id 4)
|
|
(stream-id-signed int32 4 :overlay-at (-> stream-id 0))
|
|
(music-register uint8 17 :offset 512)
|
|
(music-excite int8 :overlay-at (-> music-register 16))
|
|
(ramdisk-name uint8 16)
|
|
(sound-bank0 uint8 16 :offset 592)
|
|
(sound-bank1 uint8 16)
|
|
(sound-bank2 uint8 16)
|
|
(sound-bank3 uint8 16)
|
|
(sound-bank4 uint8 16)
|
|
(sound-bank5 uint8 16)
|
|
(sound-bank6 uint8 16)
|
|
(sound-bank7 uint8 16)
|
|
)
|
|
)
|
|
|
|
|
|
(define *sound-iop-info* (new 'global 'sound-iop-info))
|
|
|
|
(defun str-is-playing? ()
|
|
"Is any streaming audio playing?"
|
|
(countdown (v1-0 4)
|
|
(if (and (>= (the-as uint (-> *sound-iop-info* stream-id v1-0)) 0)
|
|
(logtest? (-> *sound-iop-info* stream-status v1-0) (stream-status ss4))
|
|
)
|
|
(return #t)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defun str-id-is-playing? ((id sound-id))
|
|
"Is any streaming audio with the given ID playing?"
|
|
(countdown (v1-0 4)
|
|
(if (and (= id (-> *sound-iop-info* stream-id v1-0))
|
|
(logtest? (-> *sound-iop-info* stream-status v1-0) (stream-status ss1 ss6))
|
|
)
|
|
(return #t)
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defun current-str-pos ((id sound-id))
|
|
"Get the current stream position of the given sound ID, or -1 if it is not playing."
|
|
(if (>= (-> *setting-control* user-current movie-skip-frame) 0.0)
|
|
(return (the int (* 34.133335 (-> *setting-control* user-current movie-skip-frame))))
|
|
)
|
|
(dotimes (v1-5 4)
|
|
(if (= id (-> *sound-iop-info* stream-id v1-5))
|
|
(return (the-as int (-> *sound-iop-info* stream-position v1-5)))
|
|
)
|
|
)
|
|
-1
|
|
)
|
|
|
|
;; WARN: Return type mismatch int vs stream-status.
|
|
(defun current-str-status ((id sound-id))
|
|
"Get the status of the stream playing the given sound, or 0 if it is not playing."
|
|
(dotimes (v1-0 4)
|
|
(if (= id (-> *sound-iop-info* stream-id v1-0))
|
|
(return (the-as stream-status (-> *sound-iop-info* stream-status v1-0)))
|
|
)
|
|
)
|
|
(the-as stream-status 0)
|
|
)
|
|
|
|
(defun is-ramdisk-loaded? ((name symbol))
|
|
"Check if the ramdisk-name is set to this (unused)."
|
|
(let ((gp-0 (-> *sound-iop-info* ramdisk-name))
|
|
(s5-0 (symbol->string name))
|
|
)
|
|
(and (charp-prefix= (-> s5-0 data) gp-0) (= (-> gp-0 (length s5-0)) 46))
|
|
)
|
|
)
|
|
|
|
(defun is-cd-in? ()
|
|
"Is the CD/DVD in the ps2?"
|
|
(zero? (-> *sound-iop-info* nocd))
|
|
)
|
|
|
|
(defun new-sound-id ()
|
|
"Allocate a new sound ID, used to identify a unique playback of a sound."
|
|
(set! *current-sound-id* (+ *current-sound-id* 1))
|
|
(if (< (the-as int *current-sound-id*) #x10000)
|
|
(set! *current-sound-id* (the-as sound-id #x10000))
|
|
)
|
|
*current-sound-id*
|
|
)
|
|
|
|
(defun check-irx-version ()
|
|
"Confirm OVERLORD version is correct and set up the sound-iop-info address so the OVERLORD can report back to the EE."
|
|
(let ((gp-0 (the-as sound-rpc-get-irx-version (add-element *sound-loader-rpc*))))
|
|
(set! (-> gp-0 command) (sound-command get-irx-version))
|
|
(set! (-> gp-0 ee-addr) (&-> *sound-iop-info* frame))
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer gp-0) (the-as uint 80))
|
|
(sync *sound-loader-rpc* #f)
|
|
(format 0 "IRX version ~D.~D~%" (-> gp-0 major) (-> gp-0 minor))
|
|
(when (or (!= (-> gp-0 major) 4) (nonzero? (-> gp-0 minor)))
|
|
(format 0 "ERROR: IRX is the wrong version - need ~D.~D~%" 4 0)
|
|
(format 0 "~%~%Please do (:mch) then mkee on linux-dog~%~%~%")
|
|
(crash!)
|
|
0
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-bank-iop-store ((name sound-name))
|
|
"Send a iop-store RPC to loader with the given name"
|
|
(let ((gp-0 (new-sound-id)))
|
|
(let ((v1-1 (the-as sound-rpc-bank-cmd (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command iop-store))
|
|
(set! (-> v1-1 bank-name) name)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun sound-bank-iop-free ((name sound-name))
|
|
"Send a iop-free RPC to loader with the given name"
|
|
(let ((gp-0 (new-sound-id)))
|
|
(let ((v1-1 (the-as sound-rpc-bank-cmd (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command iop-free))
|
|
(set! (-> v1-1 bank-name) name)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun sound-bank-load ((name sound-name) (mode int) (priority int))
|
|
"Send RPC to load a sound bank."
|
|
(let ((gp-0 (new-sound-id)))
|
|
(let ((v1-1 (the-as sound-rpc-load-bank (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command load-bank))
|
|
(set! (-> v1-1 bank-name) name)
|
|
(set! (-> v1-1 mode) (the-as uint mode))
|
|
(set! (-> v1-1 priority) (the-as uint priority))
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun sound-bank-load-from-iop ((name sound-name))
|
|
"Send load-bank-from-iop rpc to loader"
|
|
(let ((gp-0 (new-sound-id)))
|
|
(let ((v1-1 (the-as sound-rpc-load-bank (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command load-bank-from-iop))
|
|
(set! (-> v1-1 bank-name) name)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun sound-bank-load-from-ee ((name sound-name) (addr pointer))
|
|
"Send load-bank-from-ee rpc to loader"
|
|
(let ((gp-0 (new-sound-id)))
|
|
(let ((v1-1 (the-as sound-rpc-load-bank (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command load-bank-from-ee))
|
|
(set! (-> v1-1 bank-name) name)
|
|
(set! (-> v1-1 ee-addr) addr)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun sound-bank-unload ((name sound-name))
|
|
"Send unload-bank rpc to loader"
|
|
(let ((v1-1 (the-as sound-rpc-unload-bank (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command unload-bank))
|
|
(set! (-> v1-1 bank-name) name)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
0
|
|
)
|
|
|
|
(defun sound-music-load ((name sound-name))
|
|
"Send load-music rpc to loader"
|
|
(let ((v1-1 (the-as sound-rpc-load-music (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command load-music))
|
|
(set! (-> v1-1 bank-name) name)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
0
|
|
)
|
|
|
|
(defun sound-music-unload ()
|
|
"Send unload-music rpc to loader."
|
|
(let ((v1-1 (the-as sound-rpc-unload-music (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command unload-music))
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
0
|
|
)
|
|
|
|
(defun set-language ((lang language-enum))
|
|
"Send set-language rpc to loader. Note this is only for sound, no game text is changed."
|
|
(let ((v1-1 (the-as sound-rpc-set-language (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command set-language))
|
|
(set! (-> v1-1 lang) (the-as uint lang))
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
0
|
|
)
|
|
|
|
(defun sound-set-stereo-mode ((mode int))
|
|
"Send set-stereo-mode rpc to loader."
|
|
(let ((v1-1 (the-as sound-rpc-set-stereo-mode (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command set-stereo-mode))
|
|
(set! (-> v1-1 mode) mode)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun list-sounds ()
|
|
"Send list-sounds rpc to loader."
|
|
(let ((v1-1 (the-as sound-rpc-list-sounds (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) (sound-command list-sounds))
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
(syncv 0)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun sound-command->string ((cmd sound-command))
|
|
"Convert sound-command enum to string."
|
|
(case cmd
|
|
(((sound-command num-sectors))
|
|
"num-sectors"
|
|
)
|
|
(((sound-command read-spr-nom))
|
|
"read-spr-nom"
|
|
)
|
|
(((sound-command shutdown))
|
|
"shutdown"
|
|
)
|
|
(((sound-command set-flava))
|
|
"set-flava"
|
|
)
|
|
(((sound-command set-language))
|
|
"set-language"
|
|
)
|
|
(((sound-command set-falloff-curve))
|
|
"set-falloff-curve"
|
|
)
|
|
(((sound-command set-sound-falloff))
|
|
"set-sound-falloff"
|
|
)
|
|
(((sound-command get-irx-version))
|
|
"get-irx-version"
|
|
)
|
|
(((sound-command stop-group))
|
|
"stop-group"
|
|
)
|
|
(((sound-command set-param))
|
|
"set-param"
|
|
)
|
|
(((sound-command play))
|
|
"play"
|
|
)
|
|
(((sound-command continue-group))
|
|
"continue-group"
|
|
)
|
|
(((sound-command set-stereo-mode))
|
|
"set-stereo-mode"
|
|
)
|
|
(((sound-command load-music))
|
|
"load-music"
|
|
)
|
|
(((sound-command track-pitch))
|
|
"track-pitch"
|
|
)
|
|
(((sound-command num-tests))
|
|
"num-tests"
|
|
)
|
|
(((sound-command unload-music))
|
|
"unload-music"
|
|
)
|
|
(((sound-command continue-sound))
|
|
"continue-sound"
|
|
)
|
|
(((sound-command load-bank-from-ee))
|
|
"load-bank-from-ee"
|
|
)
|
|
(((sound-command seek-stm))
|
|
"seek-stm"
|
|
)
|
|
(((sound-command seek-nom))
|
|
"seek-nom"
|
|
)
|
|
(((sound-command set-reverb))
|
|
"set-reverb"
|
|
)
|
|
(((sound-command read-spr-stm))
|
|
"read-spr-stm"
|
|
)
|
|
(((sound-command linvel-stm))
|
|
"linvel-stm"
|
|
)
|
|
(((sound-command boot-load))
|
|
"boot-load"
|
|
)
|
|
(((sound-command rand-nom-abort))
|
|
"rand-nom-abort"
|
|
)
|
|
(((sound-command read-seq-nom))
|
|
"read-seq-nom"
|
|
)
|
|
(((sound-command cancel-dgo))
|
|
"cancel-dgo"
|
|
)
|
|
(((sound-command iop-store))
|
|
"iop-store"
|
|
)
|
|
(((sound-command read-spr-strn-nom))
|
|
"read-spr-strn-nom"
|
|
)
|
|
(((sound-command num-streamsectors))
|
|
"num-streamsectors"
|
|
)
|
|
(((sound-command game-load))
|
|
"game-load"
|
|
)
|
|
(((sound-command set-fps))
|
|
"set-fps"
|
|
)
|
|
(((sound-command stop-sound))
|
|
"stop-sound"
|
|
)
|
|
(((sound-command pause-sound))
|
|
"pause-sound"
|
|
)
|
|
(((sound-command load-bank))
|
|
"load-bank"
|
|
)
|
|
(((sound-command load-bank-from-iop))
|
|
"load-bank-from-iop"
|
|
)
|
|
(((sound-command unload-bank))
|
|
"unload-bank"
|
|
)
|
|
(((sound-command set-midi-reg))
|
|
"set-midi-reg"
|
|
)
|
|
(((sound-command num-streambanks))
|
|
"num-streambanks"
|
|
)
|
|
(((sound-command set-ear-trans))
|
|
"set-ear-trans"
|
|
)
|
|
(((sound-command read-seq-stm))
|
|
"read-seq-stm"
|
|
)
|
|
(((sound-command iop-free))
|
|
"iop-free"
|
|
)
|
|
(((sound-command list-sounds))
|
|
"list-sounds"
|
|
)
|
|
(((sound-command set-master-volume))
|
|
"set-master-volume"
|
|
)
|
|
(((sound-command rand-stm-abort))
|
|
"rand-stm-abort"
|
|
)
|
|
(((sound-command iop-mem))
|
|
"iop-mem"
|
|
)
|
|
(((sound-command linvel-nom))
|
|
"linvel-nom"
|
|
)
|
|
(((sound-command reload-info))
|
|
"reload-info"
|
|
)
|
|
(((sound-command pause-group))
|
|
"pause-group"
|
|
)
|
|
(((sound-command num-testruns))
|
|
"num-testruns"
|
|
)
|
|
(else
|
|
"*unknown*"
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun sound-buffer-dump ()
|
|
"Print out all sound-commands in the buffer."
|
|
(let ((gp-0 (-> *sound-player-rpc* current elt-used))
|
|
(s5-0 (-> *sound-player-rpc* current elt-size))
|
|
)
|
|
(dotimes (s4-0 (the-as int gp-0))
|
|
(let* ((s3-0 (the-as sound-rpc-play (&+ (-> *sound-player-rpc* current base) (* s5-0 (the-as uint s4-0)))))
|
|
(a3-0 (sound-command->string (-> s3-0 command)))
|
|
)
|
|
(case (-> s3-0 command)
|
|
(((sound-command play))
|
|
(format #t "~D ~A ~G~%" s4-0 a3-0 (&-> s3-0 name))
|
|
)
|
|
(else
|
|
(format #t "~D ~A~%" s4-0 a3-0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(define *sound-player-enable* #t)
|
|
|
|
(defun swap-sound-buffers ((arg0 vector) (arg1 vector) (arg2 vector) (arg3 vector) (arg4 vector) (arg5 float))
|
|
"Per-frame update of sound system - update loop-engine, update ear trans, send player RPC, check for missing/dirty CD."
|
|
(run-pending-updates! *sound-loop-engine* (-> *display* base-clock frame-counter))
|
|
(cond
|
|
((check-busy *sound-player-rpc*)
|
|
(set! *sound-player-enable* #f)
|
|
)
|
|
(else
|
|
(let ((a0-3 (-> *sound-player-rpc* current)))
|
|
(if (< (-> a0-3 elt-used) (-> a0-3 elt-count))
|
|
(sound-set-ear-trans arg0 arg1 arg2 arg3 arg4 arg5)
|
|
)
|
|
)
|
|
(call *sound-player-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
(set! *sound-player-enable* #t)
|
|
)
|
|
)
|
|
(cond
|
|
((not (-> *setting-control* user-current allow-error))
|
|
)
|
|
((nonzero? (-> *sound-iop-info* nocd))
|
|
(if (or (not *progress-process*) (!= (-> *progress-process* 0 current) 'error-disc-removed))
|
|
(activate-progress *dproc* 'error-disc-removed)
|
|
)
|
|
)
|
|
((nonzero? (-> *sound-iop-info* dirtycd))
|
|
(if (or (not *progress-process*) (!= (-> *progress-process* 0 current) 'error-reading))
|
|
(activate-progress *dproc* 'error-reading)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun get-sound-buffer-entry ()
|
|
"Allocate a new entry in the player RPC queue, to be flushed on the next frame."
|
|
(add-element *sound-player-rpc*)
|
|
)
|
|
|
|
(defun free-last-sound-buffer-entry ()
|
|
"Remove the last thing added with get-sound-buffer-entry."
|
|
(decrement-elt-used *sound-player-rpc*)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun sound-basic-cb ((arg0 int) (arg1 (pointer int32)))
|
|
"Unknown and unused callback."
|
|
(set! (-> arg1 0) arg0)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun sound-trans-convert ((int-trans (pointer int32)) (meter-trans vector))
|
|
"Convert a GOAL translation (meters) to integer format for the IOP"
|
|
(let ((v1-0 (if meter-trans
|
|
meter-trans
|
|
(ear-trans 0)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> int-trans 0) (the int (* 0.0625 (-> v1-0 x))))
|
|
(set! (-> int-trans 1) (the int (* 0.0625 (-> v1-0 y))))
|
|
(set! (-> int-trans 2) (the int (* 0.0625 (-> v1-0 z))))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-unit-vector-convert ((int-unit-vector (pointer int32)) (float-unit-vector vector))
|
|
"Convert a GOAL unit-vector (float) to integer format for the IOP"
|
|
(set! (-> int-unit-vector 0) (the int (* 256.0 (-> float-unit-vector x))))
|
|
(set! (-> int-unit-vector 1) (the int (* 256.0 (-> float-unit-vector y))))
|
|
(set! (-> int-unit-vector 2) (the int (* 256.0 (-> float-unit-vector z))))
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun sound-angle-convert ((float-angle float))
|
|
"Convert a GOAL angle to integer format for the iop"
|
|
(let* ((f0-3 (the float (sar (shl (the int float-angle) 48) 48)))
|
|
(v0-0 (the int (* 0.005493164 f0-3)))
|
|
)
|
|
(if (< v0-0 0)
|
|
(+! v0-0 360)
|
|
)
|
|
(if (< 359 v0-0)
|
|
(+! v0-0 -360)
|
|
)
|
|
v0-0
|
|
)
|
|
)
|
|
|
|
(defun string->sound-name ((str string))
|
|
"Create a sound-name from a string"
|
|
(let ((v1-0 (new 'stack-no-clear 'array 'sound-name 1)))
|
|
(set! (-> v1-0 0) (the-as sound-name 0))
|
|
(let ((a1-0 (the-as (pointer uint8) v1-0))
|
|
(a2-0 (-> str data))
|
|
)
|
|
(while (and (nonzero? (-> a2-0 0)) (< (&- a2-0 (the-as uint (-> str data))) 15))
|
|
(set! (-> a1-0 0) (-> a2-0 0))
|
|
(set! a1-0 (&-> a1-0 1))
|
|
(set! a2-0 (&-> a2-0 1))
|
|
)
|
|
)
|
|
(-> v1-0 0)
|
|
)
|
|
)
|
|
|
|
(defun sound-name->string ((name sound-name))
|
|
"Create a string from a sound-name. Returns pointer to a single shared static string."
|
|
(let ((v1-0 (new 'static 'boxed-array :type string "0123456789abcdef")))
|
|
(let ((a1-0 (the-as (pointer uinteger) (new 'stack-no-clear 'array 'uint8 16))))
|
|
(set! (-> (the-as (pointer sound-name) a1-0) 0) name)
|
|
(let ((a0-2 (-> v1-0 0 data)))
|
|
(while (and (nonzero? (-> (the-as (pointer uint8) a1-0) 0)) (< (&- a0-2 (the-as uint (-> v1-0 0 data))) 15))
|
|
(set! (-> a0-2 0) (-> (the-as (pointer uint8) a1-0) 0))
|
|
(set! a0-2 (&-> a0-2 1))
|
|
(set! a1-0 (&-> (the-as (pointer uint8) a1-0) 1))
|
|
)
|
|
(while (< (&- a0-2 (the-as uint (-> v1-0 0 data))) 16)
|
|
(set! (-> a0-2 0) (the-as uint 0))
|
|
(set! a0-2 (&-> a0-2 1))
|
|
)
|
|
)
|
|
)
|
|
(-> v1-0 0)
|
|
)
|
|
)
|
|
|
|
(defun sound-set-volume ((group sound-group) (vol float))
|
|
"Send set-master-volume rpc."
|
|
(let ((v1-0 (the-as sound-rpc-set-master-volume (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command set-master-volume))
|
|
(set! (-> v1-0 group) (the-as uint group))
|
|
(set! (-> v1-0 volume) (the int (* 1024.0 vol)))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-set-reverb ((reverb int) (left float) (right float) (core uint))
|
|
"Send set-reverb rpc"
|
|
(let ((v1-0 (the-as sound-rpc-set-reverb (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command set-reverb))
|
|
(set! (-> v1-0 core) core)
|
|
(set! (-> v1-0 reverb) reverb)
|
|
(set! (-> v1-0 left) (the-as uint (the int (* 32767.0 left))))
|
|
(set! (-> v1-0 right) (the-as uint (the int (* 32767.0 right))))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-set-ear-trans ((ear0 vector) (ear1 vector) (cam vector) (fwd vector) (left vector) (scale float))
|
|
"Send set-ear-trans rpc"
|
|
(let ((gp-0 (the-as sound-rpc-set-ear-trans (get-sound-buffer-entry))))
|
|
(set! (-> gp-0 command) (sound-command set-ear-trans))
|
|
(sound-trans-convert (-> gp-0 ear-trans0) ear0)
|
|
(sound-trans-convert (-> gp-0 ear-trans1) ear1)
|
|
(sound-trans-convert (-> gp-0 cam-trans) cam)
|
|
(sound-unit-vector-convert (-> gp-0 cam-forward) fwd)
|
|
(sound-unit-vector-convert (-> gp-0 cam-left) left)
|
|
(set! (-> gp-0 cam-scale) (the int (* 65536.0 scale)))
|
|
(set! (-> gp-0 cam-inverted) (if (logtest? (-> *game-info* secrets) (game-secrets hflip-screen))
|
|
1
|
|
0
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defbehavior sound-play-by-name process-drawable ((name sound-name) (id sound-id) (vol int) (pitch int) (bend int) (group sound-group) (trans object))
|
|
"Send play rpc to play a sound!"
|
|
(local-vars (sv-16 sound-group))
|
|
(set! sv-16 group)
|
|
(let ((s4-0 trans))
|
|
(when *sound-player-enable*
|
|
(let ((s5-0 (the-as sound-rpc-play (get-sound-buffer-entry))))
|
|
(set! (-> s5-0 command) (sound-command play))
|
|
(set! (-> s5-0 id) id)
|
|
(set! (-> s5-0 name) name)
|
|
(set! (-> s5-0 params mask) (the-as uint 0))
|
|
(set! (-> s5-0 params group) (the-as uint sv-16))
|
|
(set! (-> s5-0 params volume) vol)
|
|
(set! (-> s5-0 params pitch-mod) pitch)
|
|
(set! (-> s5-0 params bend) bend)
|
|
(let ((s3-1 self))
|
|
(when (= s4-0 #t)
|
|
(if (and s3-1 (type? s3-1 process-drawable) (nonzero? (-> s3-1 root)))
|
|
(set! s4-0 (-> s3-1 root trans))
|
|
(set! s4-0 #f)
|
|
)
|
|
)
|
|
)
|
|
(sound-trans-convert (-> s5-0 params trans) (the-as vector s4-0))
|
|
)
|
|
)
|
|
)
|
|
id
|
|
)
|
|
|
|
(defbehavior sound-play-by-spec process-drawable ((spec sound-spec) (name sound-id) (trans vector))
|
|
"Send play rpc to play a sound!"
|
|
(when *sound-player-enable*
|
|
(let ((s5-0 (the-as sound-rpc-play (get-sound-buffer-entry))))
|
|
(set! (-> s5-0 command) (sound-command play))
|
|
(set! (-> s5-0 id) name)
|
|
(set! (-> s5-0 name) (-> spec sound-name))
|
|
(set! (-> s5-0 params mask) (the-as uint (-> spec mask)))
|
|
(set! (-> s5-0 params group-and-reg) (-> spec group-and-reg))
|
|
(set! (-> s5-0 params volume) (-> spec volume))
|
|
(set! (-> s5-0 params pitch-mod) (-> spec pitch-mod))
|
|
(set! (-> s5-0 params bend) (-> spec bend))
|
|
(set! (-> s5-0 params fo-min) (-> spec fo-min))
|
|
(set! (-> s5-0 params fo-max) (-> spec fo-max))
|
|
(set! (-> s5-0 params fo-curve) (-> spec fo-curve))
|
|
(set! (-> s5-0 params priority) (-> spec priority))
|
|
(let ((s3-1 self))
|
|
(when (= trans #t)
|
|
(if (and s3-1 (type? s3-1 process-drawable) (nonzero? (-> s3-1 root)))
|
|
(set! trans (-> s3-1 root trans))
|
|
(set! trans (the-as vector #f))
|
|
)
|
|
)
|
|
)
|
|
(sound-trans-convert (-> s5-0 params trans) trans)
|
|
)
|
|
)
|
|
name
|
|
)
|
|
|
|
(defun sound-pause ((id sound-id))
|
|
"Send pause-sound rpc to pause by id"
|
|
(when (nonzero? id)
|
|
(let ((v1-1 (the-as sound-rpc-pause-sound (get-sound-buffer-entry))))
|
|
(set! (-> v1-1 command) (sound-command pause-sound))
|
|
(set! (-> v1-1 id) id)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-stop ((id sound-id))
|
|
"Send stop-sound rpc to stop by id"
|
|
(when (nonzero? id)
|
|
(let ((v1-1 (the-as sound-rpc-stop-sound (get-sound-buffer-entry))))
|
|
(set! (-> v1-1 command) (sound-command stop-sound))
|
|
(set! (-> v1-1 id) id)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-continue ((id sound-id))
|
|
"Send continue-sound rpc to continue by id"
|
|
(when (nonzero? id)
|
|
(let ((v1-1 (the-as sound-rpc-continue-sound (get-sound-buffer-entry))))
|
|
(set! (-> v1-1 command) (sound-command continue-sound))
|
|
(set! (-> v1-1 id) id)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-group-pause ((group sound-group))
|
|
"Send pause-group rpc"
|
|
(let ((v1-0 (the-as sound-rpc-pause-group (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command pause-group))
|
|
(set! (-> v1-0 group) (the-as uint group))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-group-stop ((group sound-group))
|
|
"Send stop-group rpc"
|
|
(let ((v1-0 (the-as sound-rpc-stop-group (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command stop-group))
|
|
(set! (-> v1-0 group) (the-as uint group))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-group-continue ((group sound-group))
|
|
"Send continue-group rpc"
|
|
(let ((v1-0 (the-as sound-rpc-continue-group (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command continue-group))
|
|
(set! (-> v1-0 group) (the-as uint group))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-set-flava ((flava uint) (excitement uint))
|
|
"Send set-flava rpc"
|
|
(let ((v1-0 (the-as sound-rpc-set-flava (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command set-flava))
|
|
(set! (-> v1-0 flava) flava)
|
|
(set! (-> v1-0 excitement) excitement)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-set-midi-reg ((reg int) (val int))
|
|
"Send set-midi-reg rpc"
|
|
(let ((v1-0 (the-as sound-rpc-set-midi-reg (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command set-midi-reg))
|
|
(set! (-> v1-0 reg) reg)
|
|
(set! (-> v1-0 value) val)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-set-fps ((fps int))
|
|
"Send set-fps rpc"
|
|
(let ((v1-0 (the-as sound-rpc-set-fps (get-sound-buffer-entry))))
|
|
(set! (-> v1-0 command) (sound-command set-fps))
|
|
(set! (-> v1-0 fps) (the-as uint fps))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun sound-volume-off ()
|
|
"Adjust settings to turn all sound volume off"
|
|
(set-setting! 'music-volume 'abs 0.0 0)
|
|
(set-setting! 'sfx-volume 'abs 0.0 0)
|
|
(set-setting! 'ambient-volume 'abs 0.0 0)
|
|
0
|
|
)
|
|
|
|
(define *ambient-spec* (new 'static 'sound-spec))
|
|
|
|
(defmethod new ambient-sound ((allocation symbol) (type-to-make type) (spec basic) (trans vector) (lump-time float))
|
|
"Set up ambient-sound. Can use an entity-actor (grabs from lump), sound-spec, or name as a string."
|
|
(local-vars
|
|
(sv-16 sound-spec)
|
|
(sv-32 sound-name)
|
|
(sv-48 (pointer float))
|
|
(sv-52 pointer)
|
|
(sv-56 int)
|
|
(sv-64 res-tag)
|
|
)
|
|
(set! sv-16 (the-as sound-spec #f))
|
|
(set! sv-32 (the-as sound-name 0))
|
|
(set! sv-48 (the-as (pointer float) #f))
|
|
(set! sv-52 (the-as pointer #f))
|
|
(set! sv-56 0)
|
|
(case (-> spec type)
|
|
((entity-actor)
|
|
(let* ((a0-3 ((method-of-type res-lump get-property-struct)
|
|
(the-as res-lump spec)
|
|
'effect-name
|
|
'exact
|
|
lump-time
|
|
(the-as structure #f)
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
(v1-2 (when a0-3
|
|
(case (rtype-of a0-3)
|
|
((symbol)
|
|
(symbol->string (the-as symbol a0-3))
|
|
)
|
|
((string)
|
|
a0-3
|
|
)
|
|
(else
|
|
"unknown"
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when v1-2
|
|
(set! sv-32 (string->sound-name (the-as string v1-2)))
|
|
(set! sv-48 (res-lump-data (the-as res-lump spec) 'cycle-speed (pointer float)))
|
|
(set! sv-16 *ambient-spec*)
|
|
(set! sv-64 (new 'static 'res-tag))
|
|
(let ((v1-9 ((method-of-type res-lump get-property-data)
|
|
(the-as res-lump spec)
|
|
'effect-param
|
|
'exact
|
|
lump-time
|
|
(the-as pointer #f)
|
|
(& sv-64)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
)
|
|
(when v1-9
|
|
(set! sv-52 v1-9)
|
|
(set! sv-56 (the-as int (-> sv-64 elt-count)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((sound-spec)
|
|
(set! sv-16 (the-as sound-spec spec))
|
|
)
|
|
((string)
|
|
(set! sv-32 (string->sound-name (the-as string spec)))
|
|
)
|
|
(else
|
|
(format 0 "ERROR: ambient sound was told to play an unknown ~A.~%" spec)
|
|
)
|
|
)
|
|
(cond
|
|
((or sv-16 (nonzero? sv-32))
|
|
(let ((s5-1 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
|
(set! (-> s5-1 spec) sv-16)
|
|
(set! (-> s5-1 name) sv-32)
|
|
(set! (-> s5-1 playing-id) (new-sound-id))
|
|
(set! (-> s5-1 params) (the-as (pointer float) sv-52))
|
|
(set! (-> s5-1 param-count) sv-56)
|
|
(set! (-> s5-1 entity) #f)
|
|
(set! (-> s5-1 sound-count) 1)
|
|
(set! (-> s5-1 volume) 1024)
|
|
(set! (-> s5-1 pitch) 0)
|
|
(when (and sv-16 (!= sv-16 *ambient-spec*))
|
|
(if (logtest? (-> (the-as sound-spec sv-16) mask) (sound-mask volume))
|
|
(set! (-> s5-1 volume) (-> (the-as sound-spec sv-16) volume))
|
|
)
|
|
(if (logtest? (-> (the-as sound-spec sv-16) mask) (sound-mask pitch))
|
|
(set! (-> s5-1 pitch) (-> (the-as sound-spec sv-16) pitch-mod))
|
|
)
|
|
)
|
|
(cond
|
|
(sv-48
|
|
(set! (-> s5-1 time-base) (the-as time-frame (the int (* 300.0 (-> sv-48 0)))))
|
|
(set! (-> s5-1 time-random) (the-as time-frame (the int (* 300.0 (-> sv-48 1)))))
|
|
)
|
|
(else
|
|
(set! (-> s5-1 time-base) -1)
|
|
)
|
|
)
|
|
(set! (-> s5-1 trans quad) (-> trans quad))
|
|
s5-1
|
|
)
|
|
)
|
|
(else
|
|
(the-as ambient-sound 0)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmethod update! ((this ambient-sound))
|
|
"Per-frame update of ambient sound."
|
|
(local-vars (a0-9 vector) (a0-18 vector))
|
|
(with-pp
|
|
(if (not *ambient-sound-class*)
|
|
(return (the-as int #f))
|
|
)
|
|
(cond
|
|
((-> this spec)
|
|
(when (or (< (-> this time-base) 0) (>= (current-time) (-> this play-time)))
|
|
(when (>= (-> this time-base) 0)
|
|
(set! (-> this play-time)
|
|
(+ (current-time) (-> this time-base) (rand-vu-int-count (the-as int (-> this time-random))))
|
|
)
|
|
(set! (-> this playing-id) (new-sound-id))
|
|
)
|
|
(let ((s5-1 (-> this spec)))
|
|
(when (= s5-1 *ambient-spec*)
|
|
(set! (-> s5-1 volume) (-> this volume))
|
|
(set! (-> s5-1 pitch-mod) (-> this pitch))
|
|
(set! (-> s5-1 bend) 0)
|
|
(set! (-> s5-1 sound-name) (-> this name))
|
|
(set! (-> s5-1 fo-max) (-> this falloff-far))
|
|
(set! (-> s5-1 fo-curve) (-> this falloff-mode))
|
|
(set! (-> s5-1 mask) (sound-mask))
|
|
(if (-> this params)
|
|
(effect-param->sound-spec s5-1 (-> this params) (-> this param-count) (the-as process-focusable pp))
|
|
)
|
|
)
|
|
(case (-> s5-1 fo-curve)
|
|
((9 11)
|
|
(set! a0-9 (ear-trans 1))
|
|
)
|
|
(else
|
|
(set! a0-9 (ear-trans 0))
|
|
)
|
|
)
|
|
(let ((v1-29 (-> s5-1 fo-max)))
|
|
(when (and (nonzero? v1-29) (< (* 4096.0 (the float v1-29)) (vector-vector-distance a0-9 (-> this trans))))
|
|
(when (zero? (-> this sound-state))
|
|
(sound-stop (-> this playing-id))
|
|
(set! (-> this sound-state) 1)
|
|
)
|
|
(return 0)
|
|
)
|
|
)
|
|
(when (and *debug-effect-control* (>= (-> this time-base) 0))
|
|
(format #t "(~5D) effect sound ~A ~G " (current-time) (-> pp name) (-> s5-1 sound-name-char))
|
|
(format
|
|
#t
|
|
"volume: ~f pitch-mod: ~f~%"
|
|
(* 0.09765625 (the float (-> s5-1 volume)))
|
|
(* 0.000656168 (the float (-> s5-1 pitch-mod)))
|
|
)
|
|
)
|
|
(let ((s4-1 (-> s5-1 volume)))
|
|
(set! (-> s5-1 volume) (-> this volume))
|
|
(set! (-> this sound-state) 0)
|
|
(set! (-> this playing-id) (sound-play-by-spec s5-1 (-> this playing-id) (-> this trans)))
|
|
(set! (-> s5-1 volume) s4-1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((< (-> this time-base) 0)
|
|
(let ((s5-2 (-> this falloff-far)))
|
|
(case (-> this falloff-mode)
|
|
((9 11)
|
|
(set! a0-18 (ear-trans 1))
|
|
)
|
|
(else
|
|
(set! a0-18 (ear-trans 0))
|
|
)
|
|
)
|
|
(when (and (nonzero? s5-2) (< (* 4096.0 (the float s5-2)) (vector-vector-distance a0-18 (-> this trans))))
|
|
(when (zero? (-> this sound-state))
|
|
(sound-stop (-> this playing-id))
|
|
(set! (-> this sound-state) 1)
|
|
)
|
|
(return 0)
|
|
)
|
|
)
|
|
(set! (-> this sound-state) 0)
|
|
(set! (-> this playing-id) (sound-play-by-name
|
|
(-> this name)
|
|
(-> this playing-id)
|
|
(-> this volume)
|
|
(-> this pitch)
|
|
0
|
|
(sound-group)
|
|
(-> this trans)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(when (>= (current-time) (-> this play-time))
|
|
(set! (-> this sound-state) 0)
|
|
(set! (-> this playing-id)
|
|
(sound-play-by-name
|
|
(-> this name)
|
|
(new-sound-id)
|
|
(-> this volume)
|
|
(-> this pitch)
|
|
0
|
|
(sound-group)
|
|
(-> this trans)
|
|
)
|
|
)
|
|
(set! (-> this play-time)
|
|
(+ (current-time) (-> this time-base) (rand-vu-int-count (the-as int (-> this time-random))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
)
|
|
)
|
|
|
|
(defmethod stop! ((this ambient-sound))
|
|
(sound-stop (-> this playing-id))
|
|
0
|
|
)
|
|
|
|
(defmethod update-trans! ((this ambient-sound) (new-trans vector))
|
|
"Change the trans of the sound."
|
|
(set! (-> this trans quad) (-> new-trans quad))
|
|
0
|
|
)
|
|
|
|
(defmethod update-vol! ((this ambient-sound) (new-vol float))
|
|
"Change the volume of the sound."
|
|
(set! (-> this volume) (the int (* 1024.0 new-vol)))
|
|
0
|
|
)
|
|
|
|
(defmethod update-pitch-mod! ((this ambient-sound) (arg0 float))
|
|
(set! (-> this pitch) (the int (* 1524.0 arg0)))
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod set-falloff-far! ((this ambient-sound) (arg0 float))
|
|
(set! (-> this falloff-far) (the int (* 0.00024414062 arg0)))
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod set-falloff-mode! ((this ambient-sound) (arg0 int))
|
|
(set! (-> this falloff-mode) arg0)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod change-sound! ((this ambient-sound) (new-sound sound-name))
|
|
"Change the sound being played."
|
|
(when (not (and (= (the-as uint (-> this name)) (the-as uint new-sound)) (= (-> new-sound hi) (-> this name hi))))
|
|
(stop! this)
|
|
(set! (-> this playing-id) (new-sound-id))
|
|
(set! (-> this name) new-sound)
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun show-iop-info ((dma dma-buffer))
|
|
"Display iop info on screen."
|
|
(dotimes (s5-0 24)
|
|
(draw-string-xy
|
|
(if (zero? (-> *sound-iop-info* chinfo s5-0))
|
|
"."
|
|
"X"
|
|
)
|
|
dma
|
|
(+ (* s5-0 16) 16)
|
|
48
|
|
(font-color default)
|
|
(font-flags shadow)
|
|
)
|
|
)
|
|
(dotimes (s5-1 24)
|
|
(draw-string-xy
|
|
(if (zero? (-> *sound-iop-info* chinfo (+ s5-1 24)))
|
|
"."
|
|
"X"
|
|
)
|
|
dma
|
|
(+ (* s5-1 16) 16)
|
|
64
|
|
(font-color default)
|
|
(font-flags shadow)
|
|
)
|
|
)
|
|
(let ((s5-2 draw-string-xy))
|
|
(format
|
|
(clear *temp-string*)
|
|
"banks: ~15S ~15S ~15S"
|
|
(-> *level* sound-bank 0 name)
|
|
(-> *level* sound-bank 2 name)
|
|
(-> *level* sound-bank 4 name)
|
|
)
|
|
(s5-2 *temp-string* dma 16 88 (font-color default) (font-flags shadow))
|
|
)
|
|
(let ((s5-3 draw-string-xy))
|
|
(format
|
|
(clear *temp-string*)
|
|
" ~15S ~15S ~15S"
|
|
(-> *level* sound-bank 1 name)
|
|
(-> *level* sound-bank 3 name)
|
|
(-> *level* sound-bank 5 name)
|
|
)
|
|
(s5-3 *temp-string* dma 16 104 (font-color default) (font-flags shadow))
|
|
)
|
|
(let ((s5-4 draw-string-xy))
|
|
(format
|
|
(clear *temp-string*)
|
|
"music: ~15S fl:~1D/~2D ex:~4,,2f/~4,,2f ~10S"
|
|
(-> *setting-control* user-current music)
|
|
(-> *setting-control* user-current sound-flava)
|
|
(-> *setting-control* user-current sound-stinger)
|
|
(-> *setting-control* user-target sound-excitement)
|
|
(-> *setting-control* user-current sound-excitement)
|
|
(-> *setting-control* user-current mode-sound-bank)
|
|
)
|
|
(s5-4 *temp-string* dma 16 118 (font-color default) (font-flags shadow))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun show-iop-memory ((dma dma-buffer))
|
|
"Display iop memory stats on screen"
|
|
(let ((s5-0 draw-string-xy))
|
|
(format
|
|
(clear *temp-string*)
|
|
"~8D [~4D]"
|
|
(-> *sound-iop-info* freemem)
|
|
(shr (-> *sound-iop-info* freemem) 10)
|
|
)
|
|
(s5-0 *temp-string* dma 32 96 (font-color default) (font-flags shadow))
|
|
)
|
|
(let ((s5-1 draw-string-xy))
|
|
(format
|
|
(clear *temp-string*)
|
|
"~8D [~4D]"
|
|
(-> *sound-iop-info* freemem2)
|
|
(shr (-> *sound-iop-info* freemem2) 10)
|
|
)
|
|
(s5-1 *temp-string* dma 32 64 (font-color default) (font-flags shadow))
|
|
)
|
|
0
|
|
)
|
|
|
|
(defun ear-trans ((mode int))
|
|
"Get the current location of the ear. Use 1 for the settings ear-handle, or 0 for the camera."
|
|
(let ((gp-0 (the-as process-focusable #f)))
|
|
(cond
|
|
((or (movie?) *external-cam-mode*)
|
|
(math-camera-pos)
|
|
)
|
|
((and (= mode 1) (begin
|
|
(let ((s5-1 (handle->process (-> *setting-control* user-current sound-ear))))
|
|
(set! gp-0 (if (type? s5-1 process-focusable)
|
|
(the-as process-focusable s5-1)
|
|
)
|
|
)
|
|
)
|
|
gp-0
|
|
)
|
|
)
|
|
(get-trans gp-0 11)
|
|
)
|
|
(else
|
|
(camera-pos)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun-debug make-sqrt-table ()
|
|
"Generate integer square-root table used in the IOP."
|
|
(format #t "static int sqrt_table[256] =~%{~%")
|
|
(dotimes (gp-0 256)
|
|
(let* ((f0-2 (sqrtf (* 16777216.0 (the float gp-0))))
|
|
(a2-0 (the int (+ 0.5 f0-2)))
|
|
)
|
|
(format #t "~D,~%" a2-0)
|
|
)
|
|
)
|
|
(format #t "};~%")
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(check-irx-version)
|
|
|
|
(sound-bank-load (static-sound-name "common") 2 10)
|
|
|
|
(dotimes (gp-0 3)
|
|
(let* ((v1-61 gp-0)
|
|
(s5-0 (cond
|
|
((zero? v1-61)
|
|
'empty0
|
|
)
|
|
((= v1-61 1)
|
|
'empty1
|
|
)
|
|
((= v1-61 2)
|
|
'empty2
|
|
)
|
|
((= v1-61 3)
|
|
'empty3
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(sound-bank-load (string->sound-name (symbol->string s5-0)) 4 10)
|
|
(set! (-> *level* sound-bank (* gp-0 2) name) s5-0)
|
|
)
|
|
(set! (-> *level* sound-bank (* gp-0 2) mode) (sound-bank-mode full))
|
|
)
|
|
|
|
(defun loader-test-command ((cmd sound-command) (param uint))
|
|
"Send a command to loader by ID."
|
|
(let ((v1-1 (the-as sound-rpc-test-cmd (add-element *sound-loader-rpc*))))
|
|
(set! (-> v1-1 command) cmd)
|
|
(set! (-> v1-1 ee-addr) (the-as pointer 0))
|
|
(set! (-> v1-1 param0) param)
|
|
)
|
|
(call *sound-loader-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
|
|
(sync *sound-loader-rpc* #f)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun doppler-pitch-shift ((sound-pos vector) (sound-vel vector))
|
|
"Compute pitch shift for the doppler effect. This is done assuming the listener is *target* and has *target*'s velocity."
|
|
(let ((gp-0 (new 'stack-no-clear 'inline-array 'vector 2)))
|
|
(vector-! (-> gp-0 0) (target-pos 0) sound-pos)
|
|
(if *target*
|
|
(vector-! (-> gp-0 1) sound-vel (-> *target* control transv))
|
|
(set! (-> gp-0 1 quad) (-> sound-vel quad))
|
|
)
|
|
(vector-normalize! (-> gp-0 0) 1.0)
|
|
(let ((f0-1 (/ 1228800.0 (fmax 0.1 (- 1228800.0 (vector-dot (-> gp-0 0) (-> gp-0 1)))))))
|
|
(log2f f0-1)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun sound-bank-reload ()
|
|
"Start a background process to unload all sound banks, then load them again."
|
|
(process-spawn-function
|
|
process
|
|
(lambda ()
|
|
(let ((gp-0 (new 'static 'boxed-array :type symbol :length 0 :allocated-length 6)))
|
|
(dotimes (v1-0 6)
|
|
(set! (-> gp-0 v1-0) (-> *level* sound-bank v1-0 name))
|
|
)
|
|
(let ((a1-3 (new 'stack-no-clear 'array 'symbol 4)))
|
|
(set! (-> a1-3 2) 'empty2)
|
|
(set! (-> a1-3 1) 'empty1)
|
|
(set! (-> a1-3 0) 'empty0)
|
|
(want-sound-banks *load-state* a1-3)
|
|
)
|
|
(let ((s5-0 (current-time)))
|
|
(until (time-elapsed? s5-0 (seconds 1))
|
|
(suspend)
|
|
)
|
|
)
|
|
(let ((a1-4 (new 'stack-no-clear 'array 'symbol 4)))
|
|
(set! (-> a1-4 2) (-> gp-0 4))
|
|
(set! (-> a1-4 1) (-> gp-0 2))
|
|
(set! (-> a1-4 0) (-> gp-0 0))
|
|
(want-sound-banks *load-state* a1-4)
|
|
)
|
|
)
|
|
(none)
|
|
)
|
|
:to *display-pool*
|
|
)
|
|
0
|
|
(none)
|
|
)
|