mirror of
https://github.com/open-goal/jak-project
synced 2026-08-06 18:03:30 -04:00
water111
248 lines
13 KiB
Common Lisp
248 lines
13 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/ps2/pad.gc")
|
|
(require "engine/draw/drawable-ambient-h.gc")
|
|
(require "engine/gfx/font.gc")
|
|
(require "engine/load/ramdisk.gc")
|
|
|
|
;; This file contains update-vis! which updates the vis-bits string from the loaded VIS file.
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; decompression functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun unpack-comp-rle ((dst (pointer int8)) (src (pointer int8)))
|
|
"Decode signed-control run-length data from src into dst. A positive control n repeats the next
|
|
byte n+1 times, a negative control -n copies the following n bytes literally, and zero
|
|
terminates the stream. Repeated runs store length minus one so every nonzero positive control
|
|
represents at least two bytes."
|
|
(local-vars (control int) (copy-length int))
|
|
(nop!)
|
|
(loop
|
|
(loop
|
|
;; The signed control byte selects a repeated or literal section.
|
|
(set! control (-> src 0))
|
|
(set! src (&-> src 1))
|
|
(b! (<= control 0) cfg-5 :delay (nop!))
|
|
;; A positive control stores the repeated run length minus one.
|
|
(let ((repeated-value (-> src 0)))
|
|
(set! src (&-> src 1))
|
|
(label cfg-3)
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(set! (-> dst 0) repeated-value))
|
|
(set! dst (&-> dst 1))
|
|
(b! (> control 0) cfg-3 :delay (set! control (+ control -1))))
|
|
(label cfg-5)
|
|
;; Zero ends the stream; a negative control introduces that many literal bytes.
|
|
(b! (zero? control) cfg-8 :delay (set! copy-length (- control)))
|
|
(label cfg-6)
|
|
(let ((literal-value (-> src 0))) (set! src (&-> src 1)) (nop!) (nop!) (set! (-> dst 0) literal-value))
|
|
(+! copy-length -1)
|
|
(b! (> copy-length 0) cfg-6 :delay (set! dst (&-> dst 1))))
|
|
(label cfg-8)
|
|
0
|
|
(none))
|
|
|
|
(deftype huf-dictionary-node (structure)
|
|
((zero uint16)
|
|
(one uint16)))
|
|
|
|
(defun unpack-comp-huf ((dst (pointer uint8)) (src (pointer uint8)) (dictionary-base uint) (root huf-dictionary-node))
|
|
"Decode src into dst one most-significant bit first. Child values 0 through 255 emit a byte, 256
|
|
terminates the stream, and values above 256 select another four-byte node relative to
|
|
dictionary-base, which addresses node 257. root is the dictionary's final node; restart there
|
|
after each emitted byte."
|
|
(local-vars (child uint) (node object))
|
|
(nop!)
|
|
(let ((zero-child (-> root zero))
|
|
;; Internal child values start at 257, so index 257 maps to dictionary-base.
|
|
(indexed-node-base (+ dictionary-base -1028))
|
|
(one-child (-> root one)))
|
|
(nop!)
|
|
(label cfg-1)
|
|
(let ((bit-mask 128))
|
|
(nop!)
|
|
(let ((input-byte (-> src 0)))
|
|
(set! src (&-> src 1))
|
|
(label cfg-2)
|
|
(let ((bit (logand input-byte bit-mask)))
|
|
(shift-arith-right-32 bit-mask bit-mask 1)
|
|
(b! (zero? bit) cfg-4 :delay (set! child zero-child))))
|
|
(nop!)
|
|
(set! child one-child)
|
|
(label cfg-4)
|
|
(let ((child-minus-end (+ child -256)))
|
|
;; Values below 256 are leaves, 256 is the terminator, and larger values index nodes.
|
|
(let ((child-offset (* child 4)))
|
|
(b! (< (the-as int child-minus-end) 0)
|
|
cfg-8
|
|
:delay
|
|
(set! node (the-as (pointer uint16) (+ child-offset indexed-node-base)))))
|
|
(b! (zero? child-minus-end) cfg-10 :delay (set! zero-child (-> (the-as (pointer uint16) node) 0))))
|
|
(b! (nonzero? bit-mask) cfg-2 :delay (set! one-child (-> (the-as (pointer uint16) node) 1)))
|
|
(b! #t cfg-1 :delay (nop!))
|
|
(label cfg-8)
|
|
(set! (-> dst 0) child)
|
|
(set! dst (&-> dst 1))
|
|
(nop!)
|
|
(set! zero-child (-> root zero))
|
|
(b! (nonzero? bit-mask) cfg-2 :delay (set! one-child (-> root one)))))
|
|
(b! #t cfg-1 :delay (nop!))
|
|
(label cfg-10)
|
|
(nop!)
|
|
(nop!)
|
|
0
|
|
(none))
|
|
|
|
(defmethod update-vis! ((this level) (vis-info level-vis-info) (unused uint) (bsp-vis-base uint))
|
|
"Update this level's visibility bits for vis-info's current camera leaf. Reuse a
|
|
completed string when possible, wait for an outstanding IOP transfer, or fetch
|
|
the self-level string from its VIS file. Neighbor visibility comes from
|
|
bsp-vis-base. Apply the packed decompression passes, mask nonexistent drawable
|
|
bits, and return false while data is still loading. The third argument is
|
|
unused."
|
|
(local-vars (masked-quad uint128) (vis-data object))
|
|
(let* ((camera-leaf-index (-> vis-info from-bsp current-leaf-idx))
|
|
(current-vis-offset (-> vis-info current-vis-string))
|
|
(desired-vis-offset (-> vis-info vis-string camera-leaf-index)))
|
|
;; These unused expressions were present in the original function.
|
|
0
|
|
(+ 16 #x70000000)
|
|
(+ 2064 #x70000000)
|
|
;; Reuse the previous request when its IOP transfer has completed.
|
|
(when (= current-vis-offset desired-vis-offset)
|
|
(b! (not (logtest? (vis-info-flag waiting-for-iop-to-ee) (-> vis-info flags))) cfg-6 :delay (empty-form))
|
|
(if (check-busy *ramdisk-rpc*) (return #f))
|
|
(logclear! (-> vis-info flags) (vis-info-flag waiting-for-iop-to-ee))
|
|
(set! vis-data (-> this vis-buffer))
|
|
(b! #t cfg-27 :delay (nop!))
|
|
(label cfg-6)
|
|
(return #t))
|
|
;; Finish any older transfer before changing the requested visibility string.
|
|
(when (logtest? (vis-info-flag waiting-for-iop-to-ee) (-> vis-info flags))
|
|
(if (check-busy *ramdisk-rpc*) (return #f))
|
|
(logclear! (-> vis-info flags) (vis-info-flag waiting-for-iop-to-ee)))
|
|
(set! (-> vis-info current-vis-string) desired-vis-offset)
|
|
;; Self visibility lives in the loaded .VIS file. Neighbor strings are embedded in the BSP.
|
|
(b! (logtest? (vis-info-flag from-vis-file) (-> vis-info flags)) cfg-15 :delay (empty-form))
|
|
(set! vis-data (+ bsp-vis-base desired-vis-offset))
|
|
(b! #t cfg-27 :delay (nop!))
|
|
(label cfg-15)
|
|
;; vis-load normally returns the already assigned ramdisk ID. A false result falls back to
|
|
;; the BSP's all-visible mask.
|
|
(let ((ramdisk-id (vis-load this)))
|
|
(b! (nonzero? ramdisk-id) cfg-21 :delay (empty-form))
|
|
(let* ((output-bits (-> vis-info vis-bits))
|
|
(list-length (-> this bsp visible-list-length))
|
|
(all-visible-bits (the-as (pointer uinteger) (-> this bsp all-visible-list)))
|
|
(list-qwc (/ (+ list-length 15) 16)))
|
|
(dotimes (i list-qwc)
|
|
(set! (-> (the-as (pointer uint128) output-bits) 0) (-> (the-as (pointer uint128) all-visible-bits) 0))
|
|
(&+! output-bits 16)
|
|
(set! all-visible-bits (&-> (the-as (pointer uint16) all-visible-bits) 8))))
|
|
(let ((result #f))
|
|
(b! #t cfg-55 :delay (nop!))
|
|
(the-as none 0)
|
|
(label cfg-21)
|
|
;; A busy ramdisk still has the VIS file in flight from DVD to the IOP.
|
|
(when (check-busy *ramdisk-rpc*)
|
|
(set! (-> vis-info current-vis-string) (the-as uint -1))
|
|
(set! (-> this all-visible?) 'loading)
|
|
(if (= *cheat-mode* 'debug) (format *stdcon* "Ramdisk loading~%"))
|
|
(return #f))
|
|
;; Request the selected 2 KiB worst-case visibility string from IOP memory.
|
|
(logior! (-> vis-info flags) (vis-info-flag waiting-for-iop-to-ee))
|
|
(ramdisk-load (the-as int ramdisk-id) ;; file ID in ramdisk
|
|
desired-vis-offset ;; byte offset in the VIS file
|
|
(the-as uint 2048) ;; worst case when the string cannot be compressed
|
|
(-> this vis-buffer)) ;; level-owned transfer buffer
|
|
(set! result #f) ;; The IOP transfer completes on a later call.
|
|
(b! #t cfg-55 :delay (nop!))
|
|
;; Both the asynchronous VIS path and embedded BSP path join here with compressed data.
|
|
(label cfg-27)
|
|
;; The low 29 flag bits pack three-bit decompressor selectors from first to last.
|
|
(let ((lower-flag-bits (the-as int (logand #x1fffffff (-> vis-info flags))))
|
|
(spad-start (the-as object (scratchpad-object object :offset 16)))
|
|
(spad-end (the-as int (scratchpad-object int :offset 2064)))
|
|
(list-length (-> this bsp visible-list-length)))
|
|
(when (zero? (the-as uint lower-flag-bits))
|
|
;; Clear through the next quadword boundary before the exact-length direct copy.
|
|
(let ((list-qwc (/ (+ list-length 15) 16)))
|
|
(dotimes (i list-qwc)
|
|
(set! (-> (the-as (pointer uint128) spad-start) i) (the-as uint128 0))))
|
|
(mem-copy! (the-as pointer spad-start) (the-as pointer vis-data) list-length))
|
|
(while (nonzero? lower-flag-bits)
|
|
(case (the-as vis-decompressor (logand lower-flag-bits 7))
|
|
(((vis-decompressor drawable-tree))
|
|
;; Tree compression omits children of invisible parents, so unpack-vis needs every
|
|
;; drawable tree in the level to restore those skipped zeros.
|
|
(let ((list-qwc (/ (+ list-length 15) 16)))
|
|
(dotimes (i list-qwc)
|
|
(set! (-> (the-as (pointer uint128) spad-start) i) (the-as uint128 0))))
|
|
(unpack-vis (-> this bsp drawable-trees) (the-as (pointer int8) spad-start) (the-as (pointer int8) vis-data)))
|
|
(((vis-decompressor run-length))
|
|
;; Visibility data in shipped levels normally uses the other two encodings.
|
|
(format 0 "hit RLE case in decomp.gc, probably worth checking.~%")
|
|
(unpack-comp-rle (the-as (pointer int8) spad-start) (the-as (pointer int8) vis-data)))
|
|
(((vis-decompressor huffman))
|
|
(unpack-comp-huf (the-as (pointer uint8) spad-start)
|
|
(the-as (pointer uint8) vis-data)
|
|
(-> vis-info dictionary)
|
|
(the-as huf-dictionary-node (+ (-> vis-info dictionary) (-> vis-info dictionary-length) -4)))))
|
|
;; Alternate the two scratchpad buffers between stages. The original reserves three
|
|
;; 2 KiB addresses including the input buffer, though shipped strings usually use two
|
|
;; decompression stages.
|
|
(set! vis-data (the-as int spad-start))
|
|
(set! spad-start spad-end)
|
|
(set! spad-end (the-as int vis-data))
|
|
(shift-arith-right-32 lower-flag-bits lower-flag-bits 3))
|
|
;; Verify that decompression did not set bits for nonexistent drawables. This check only
|
|
;; reports errors; the final mask below makes the output safe.
|
|
(let ((vis-check vis-data)
|
|
(all-visible-check (the-as (pointer uinteger) (-> this bsp all-visible-list)))
|
|
(invalid-bits? #f))
|
|
(dotimes (i list-length)
|
|
(when (!= (logand (-> (the-as (pointer uint8) vis-check) 0) (-> (the-as (pointer uint8) all-visible-check) 0))
|
|
(-> (the-as (pointer uint8) vis-check) 0))
|
|
(format #t
|
|
"ERROR: illegal vis bits set [byte ~X] ~X -> ~X~%"
|
|
i
|
|
(-> (the-as (pointer uint8) vis-check) 0)
|
|
(-> (the-as (pointer uint8) all-visible-check) 0))
|
|
(format #t "bad addr: #x~X~%" vis-check) ;; PC address helps diagnose corrupt VIS data.
|
|
(set! invalid-bits? #t))
|
|
(set! vis-check (&-> (the-as (pointer uint8) vis-check) 1))
|
|
(set! all-visible-check (&+ (the-as (pointer uint16) all-visible-check) 1)))
|
|
(when invalid-bits?
|
|
(format #t
|
|
"src = #x~x dest = #x~x ~s ~s~%"
|
|
vis-data
|
|
(-> vis-info vis-bits)
|
|
(-> vis-info level)
|
|
(-> vis-info from-level))
|
|
(format #t "leaf-index = ~d~%" (-> vis-info from-bsp current-leaf-idx))
|
|
0))
|
|
;; Mask against the BSP's all-visible list while copying into the final visibility bits.
|
|
(let ((vis-data vis-data)
|
|
(output-bits (-> vis-info vis-bits))
|
|
(all-visible-bits (the-as (pointer uinteger) (-> this bsp all-visible-list)))
|
|
(list-qwc (/ (+ list-length 15) 16)))
|
|
(dotimes (i list-qwc)
|
|
(let ((vis-quad (-> (the-as (pointer uint128) vis-data) 0))
|
|
(all-visible-quad (-> (the-as (pointer uint128) all-visible-bits) 0)))
|
|
(.pand masked-quad vis-quad all-visible-quad))
|
|
(set! (-> (the-as (pointer uint128) output-bits) 0) masked-quad)
|
|
(&+! output-bits 16)
|
|
(set! vis-data (&-> (the-as (pointer uint16) vis-data) 8))
|
|
(set! all-visible-bits (&-> (the-as (pointer uint16) all-visible-bits) 8)))))
|
|
;; Visibility is ready for this camera leaf.
|
|
(set! result #t)
|
|
(label cfg-55)
|
|
result))))
|