mirror of
https://github.com/open-goal/jak-project
synced 2026-08-21 06:38:33 -04:00
water111
109 lines
5.0 KiB
Common Lisp
109 lines
5.0 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "kernel/gkernel.gc")
|
|
(require "engine/gfx/hw/gs.gc")
|
|
|
|
;; Functions for taking a screenshot of VRAM.
|
|
;; These are debug-only and leak memory.
|
|
;;
|
|
;; The GS framebuffers live in local VRAM rather than EE memory. A screenshot
|
|
;; therefore uses a local-to-host GS transfer to read both field-sized
|
|
;; framebuffers, then interleaves their scanlines into a full-height raw image.
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; this file is debug only
|
|
(declare-file (debug))
|
|
|
|
;; VIF/GIF packet for transferring a rectangle from GS VRAM to EE memory.
|
|
(deftype gs-store-image-packet (structure)
|
|
((vifcode vif-tag 4)
|
|
(giftag gif-tag)
|
|
(bitbltbuf gs-bitbltbuf)
|
|
(bitbltbuf-addr gs-reg64)
|
|
(trxpos gs-trxpos)
|
|
(trxpos-addr gs-reg64)
|
|
(trxreg gs-trxreg)
|
|
(trxreg-addr gs-reg64)
|
|
(finish int64)
|
|
(finish-addr gs-reg64)
|
|
(trxdir gs-trxdir)
|
|
(trxdir-addr gs-reg64)))
|
|
|
|
(defun gs-set-default-store-image ((packet gs-store-image-packet)
|
|
(source-base int)
|
|
(source-buffer-width int)
|
|
(source-format gs-psm)
|
|
(source-x int)
|
|
(source-y int)
|
|
(read-width int)
|
|
(read-height int))
|
|
"Build the seven-quadword VIF/GIF packet that reads a GS VRAM rectangle into EE memory."
|
|
(set! (-> packet vifcode 0) (new 'static 'vif-tag :cmd (vif-cmd nop)))
|
|
;; Stop background PATH3 traffic from racing the readback.
|
|
(set! (-> packet vifcode 1) (new 'static 'vif-tag :imm #x8000 :cmd (vif-cmd mskpath3)))
|
|
;; Wait for preceding GS work, then send the five A+D register writes.
|
|
(set! (-> packet vifcode 2) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
|
|
(set! (-> packet vifcode 3) (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1))
|
|
(set! (-> packet giftag)
|
|
(the-as gif-tag
|
|
(make-u128 (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)) (new 'static 'gif-tag64 :nloop #x5 :eop #x1 :nreg #x1))))
|
|
(set! (-> packet bitbltbuf)
|
|
(new 'static 'gs-bitbltbuf :sbp source-base :sbw source-buffer-width :spsm (the-as int source-format)))
|
|
(set! (-> packet bitbltbuf-addr) (gs-reg64 bitbltbuf))
|
|
(set! (-> packet trxpos) (new 'static 'gs-trxpos :ssax source-x :ssay source-y))
|
|
(set! (-> packet trxpos-addr) (gs-reg64 trxpos))
|
|
(set! (-> packet trxreg) (new 'static 'gs-trxreg :rrw read-width :rrh read-height))
|
|
(set! (-> packet trxreg-addr) (gs-reg64 trxreg))
|
|
(set! (-> packet finish) 0)
|
|
(set! (-> packet finish-addr) (gs-reg64 finish))
|
|
;; XDIR 1 is local-to-host; this final register starts the transfer.
|
|
(set! (-> packet trxdir) (new 'static 'gs-trxdir :xdir #x1))
|
|
(set! (-> packet trxdir-addr) (gs-reg64 trxdir))
|
|
(.sync.l)
|
|
7)
|
|
|
|
(defun store-image ((field-order int))
|
|
"Capture both interlaced framebuffers and write their scanlines to image.raw in the requested field order."
|
|
(let ((width 512)
|
|
(height (-> *video-parms* screen-sy))
|
|
(output (new 'debug 'file-stream "image.raw" 'write)))
|
|
;; The debug heap arrays remain allocated after this routine returns.
|
|
(let ((field0-buffer (the-as (array uint128) (new 'debug 'boxed-array uint128 (/ (* width height) 4)))))
|
|
(let ((field1-buffer (the-as (array uint128) (new 'debug 'boxed-array uint128 (/ (* width height) 4)))))
|
|
(let ((packet (new 'static 'gs-store-image-packet)))
|
|
;; BITBLTBUF uses a finer base-address unit than FRAME: #x2800 and
|
|
;; #x3000 are the two display buffers at FRAME bases 320 and 384.
|
|
(gs-set-default-store-image packet #x2800 (/ width 64) (gs-psm ct32) 0 0 width height)
|
|
(flush-cache 0)
|
|
(gs-store-image packet (-> field0-buffer data))
|
|
(sync-path 0 0)
|
|
(gs-set-default-store-image packet #x3000 (/ width 64) (gs-psm ct32) 0 0 width height)
|
|
(flush-cache 0)
|
|
(gs-store-image packet (-> field1-buffer data)))
|
|
(sync-path 0 0)
|
|
;; Each buffer contributes alternating scanlines. field-order identifies
|
|
;; which one supplies the first row of the reconstructed image.
|
|
(let ((field0-pixels (-> field0-buffer data))
|
|
(field1-pixels (-> field1-buffer data)))
|
|
(cond
|
|
((zero? field-order)
|
|
(let ((i 0))
|
|
(while (< i height)
|
|
(file-stream-write output (&+ field0-pixels (* i (* width 4))) (the-as uint (* width 4)))
|
|
(file-stream-write output (&+ field1-pixels (* i (* width 4))) (the-as uint (* width 4)))
|
|
(+! i 1))))
|
|
(else
|
|
(let ((i 0))
|
|
(while (< i height)
|
|
(file-stream-write output (&+ field1-pixels (* i (* width 4))) (the-as uint (* width 4)))
|
|
(file-stream-write output (&+ field0-pixels (* i (* width 4))) (the-as uint (* width 4)))
|
|
(+! i 1))))))
|
|
(format #t "oddeven = ~d~%" field-order)
|
|
;; delete does not reclaim debug-heap allocations.
|
|
(delete field1-buffer))
|
|
(delete field0-buffer))
|
|
(file-stream-close output))
|
|
0)
|