mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-07-29 07:33:59 -04:00
Code Issues Packages Projects Releases Wiki Activity
Files
48cb9bb7871c8d566176ededec42327c3dfd6086
jak-project/goal_src/jak2/engine/gfx/texture/texture-anim.gc
T
Tyler Wilding 6f093f98ff gsrc: Add convenience macros for masking VF operations (#3824) 
Migrates all code, there should be no change in the compilation output
(linter should check this)

At first i was considering making these builtins, which short of a bunch
of code generation, would require some sort of dynamic definition in
`Atoms.cpp`. This isn't hard but, i figured it would be better to keep
it simple and just generate the OG macros.

Fixes https://github.com/open-goal/jak-project/issues/233
2025-01-11 12:16:05 -05:00

1939 lines
76 KiB
Common Lisp
Raw Blame History

;;-*-Lisp-*-
(in-package goal)
;; name: texture-anim.gc
;; name in dgo: texture-anim
;; dgos: ENGINE, GAME
;; DECOMP BEGINS
;; og:preserve-this
;; The "texture animation" system modifies a texture according to a series of layers.
(define *texture-anim-work*
(new 'static 'texture-anim-work
:erase-tmpl (new 'static 'dma-gif-packet
:dma-vif (new 'static 'dma-packet
:dma (new 'static 'dma-tag :qwc #x4 :id (dma-tag-id cnt))
:vif1 (new 'static 'vif-tag :imm #x4 :cmd (vif-cmd direct) :msk #x1)
)
:gif0 (new 'static 'gif-tag64
:nloop #x1
:eop #x1
:pre #x1
:prim (new 'static 'gs-prim :prim (gs-prim-type sprite))
:nreg #x3
)
:gif1 (new 'static 'gif-tag-regs :regs0 (gif-reg-id rgbaq) :regs1 (gif-reg-id xyz2) :regs2 (gif-reg-id xyz2))
)
:draw-tmpl (new 'static 'dma-gif-packet
:dma-vif (new 'static 'dma-packet
:dma (new 'static 'dma-tag :qwc #xa :id (dma-tag-id cnt))
:vif1 (new 'static 'vif-tag :imm #xa :cmd (vif-cmd direct) :msk #x1)
)
:gif0 (new 'static 'gif-tag64
:nloop #x1
:eop #x1
:pre #x1
:prim (new 'static 'gs-prim :prim (gs-prim-type tri-strip) :tme #x1 :abe #x1)
:nreg #x9
)
:gif1 (new 'static 'gif-tag-regs
:regs0 (gif-reg-id rgbaq)
:regs1 (gif-reg-id st)
:regs2 (gif-reg-id xyz2)
:regs3 (gif-reg-id st)
:regs4 (gif-reg-id xyz2)
:regs5 (gif-reg-id st)
:regs6 (gif-reg-id xyz2)
:regs7 (gif-reg-id st)
:regs8 (gif-reg-id xyz2)
)
)
:draw2-tmpl (new 'static 'dma-gif-packet
:dma-vif (new 'static 'dma-packet
:dma (new 'static 'dma-tag :qwc #x6 :id (dma-tag-id cnt))
:vif1 (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1)
)
:gif0 (new 'static 'gif-tag64
:nloop #x1
:eop #x1
:pre #x1
:prim (new 'static 'gs-prim :prim (gs-prim-type sprite) :tme #x1)
:nreg #x5
)
:gif1 (new 'static 'gif-tag-regs
:regs0 (gif-reg-id rgbaq)
:regs1 (gif-reg-id st)
:regs2 (gif-reg-id xyz2)
:regs3 (gif-reg-id st)
:regs4 (gif-reg-id xyz2)
)
)
:fill-tmpl (new 'static 'dma-gif-packet
:dma-vif (new 'static 'dma-packet
:dma (new 'static 'dma-tag :qwc #x4 :id (dma-tag-id cnt))
:vif1 (new 'static 'vif-tag :imm #x4 :cmd (vif-cmd direct) :msk #x1)
)
:gif0 (new 'static 'gif-tag64
:nloop #x1
:eop #x1
:pre #x1
:prim (new 'static 'gs-prim :prim (gs-prim-type sprite))
:nreg #x3
)
:gif1 (new 'static 'gif-tag-regs :regs0 (gif-reg-id rgbaq) :regs1 (gif-reg-id xyz2) :regs2 (gif-reg-id xyz2))
)
:adgif-tmpl (new 'static 'dma-gif-packet
:dma-vif (new 'static 'dma-packet
:dma (new 'static 'dma-tag :qwc #x6 :id (dma-tag-id cnt))
:vif1 (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd direct) :msk #x1)
)
:gif0 (new 'static 'gif-tag64 :nloop #x5 :eop #x1 :nreg #x1)
:gif1 (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d))
)
:corner0 (new 'static 'vector :x -0.5 :y -0.5 :w 1.0)
:corner1 (new 'static 'vector :x 0.5 :y -0.5 :w 1.0)
:corner2 (new 'static 'vector :x -0.5 :y 0.5 :w 1.0)
:corner3 (new 'static 'vector :x 0.5 :y 0.5 :w 1.0)
:const (new 'static 'vector :x 128.0 :z 1.9921 :w 1.0)
:random (new 'static 'inline-array vector4w 8
(new 'static 'vector4w :x #x17181920 :y #x13141516 :z -1995435758 :w #x1234567)
(new 'static 'vector4w :x #x23878237 :y #x32048778 :z -1740074601 :w -2021050320)
(new 'static 'vector4w :x #x62024762 :y -1876389256 :z #x28724781 :w #x68712983)
(new 'static 'vector4w :x #x62176128 :y #x12387487 :z #x12780983 :w -2139999882)
(new 'static 'vector4w :x #x34987239 :y #x78699872 :z -2087161499 :w #x1982397)
(new 'static 'vector4w :x -1737344873 :y -1742502109 :z #x20987293 :w #x62102981)
(new 'static 'vector4w :x -2110229208 :y -2022559591 :z -1743517309 :w #x29874310)
(new 'static 'vector4w :x -2030034041 :y -1743611880 :z -2094950384 :w #x71623790)
)
)
)
(defun texture-anim-layer-interp ((arg0 texture-anim-layer) (arg1 float))
"Interpolate between start and end, and store the results in layer's interpolated-vectors array."
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf10 :class vf)
(vf11 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(set! (-> *texture-anim-work* const y)
(/ (- arg1 (-> arg0 start-time)) (- (-> arg0 end-time) (-> arg0 start-time)))
)
(.lvf vf1 (&-> *texture-anim-work* const quad))
(.lvf vf2 (&-> arg0 start-color quad))
(.lvf vf3 (&-> arg0 start-vectors 1 quad))
(.lvf vf4 (&-> arg0 start-vectors 2 quad))
(.lvf vf5 (&-> arg0 start-qs quad))
(.lvf vf6 (&-> arg0 start-vectors 4 quad))
(.lvf vf7 (&-> arg0 end-color quad))
(.lvf vf8 (&-> arg0 end-scale-offset quad))
(.lvf vf9 (&-> arg0 end-vectors 2 quad))
(.lvf vf10 (&-> arg0 end-qs quad))
(.lvf vf11 (&-> arg0 end-vectors 4 quad))
(.sub.vf vf7 vf7 vf2)
(.sub.vf vf8 vf8 vf3)
(.sub.vf vf9 vf9 vf4)
(.sub.vf vf10 vf10 vf5)
(.sub.vf vf11 vf11 vf6)
(.mul.y.vf acc vf7 vf1)
(.add.mul.w.vf vf2 vf2 vf0 acc)
(.mul.y.vf acc vf8 vf1)
(.add.mul.w.vf vf3 vf3 vf0 acc)
(.mul.y.vf acc vf9 vf1)
(.add.mul.w.vf vf4 vf4 vf0 acc)
(.mul.y.vf acc vf10 vf1)
(.add.mul.w.vf vf5 vf5 vf0 acc)
(.mul.y.vf acc vf11 vf1)
(.add.mul.w.vf vf6 vf6 vf0 acc)
(.max.x.vf vf2 vf2 vf0)
(.min.z.vf vf2 vf2 vf1)
(.svf (&-> arg0 interpolated-color quad) vf2)
(.svf (&-> arg0 interpolated-scale-offset quad) vf3)
(.svf (&-> arg0 interpolated-st-scale-offset quad) vf4)
(.svf (&-> arg0 interpolated-qs quad) vf5)
(.svf (&-> arg0 interpolated-rot quad) vf6)
(none)
)
)
;; og:preserve-this
(defenum texture-anim-pc
(start-anim-array 12)
(finish-anim-array 13)
(erase-and-init 14)
(upload-clut-16-16 15)
(upload-generic-vram 16)
(set-shader 17)
(draw 18)
(move-rg-to-ba 19)
(set-clut-alpha 20)
(copy-clut-alpha 21)
(darkjak 22)
(prison-jak 23)
(oracle-jak 24)
(nest-jak 25)
(kor-transform 26)
(skull-gem 27)
(bomb 28)
(cas-conveyor 29)
(security 30)
(waterfall 31)
(waterfall-b 32)
(lava 33)
(lava-b 34)
(stadiumb 35)
(fortress-pris 36)
(fortress-warp 37)
(metkor 38)
(shield 39)
(krew-holo 40)
(clouds-and-fog 41)
(slime 42)
(clouds-hires 43)
)
(deftype texture-anim-pc-upload (structure)
((data pointer)
(width uint16)
(height uint16)
(dest uint32)
(format gs-psm)
(force-to-gpu uint8)
(pad uint8 2)
)
:size-assert 16
)
(deftype texture-anim-pc-texture-transform (structure)
((src-tbp uint32)
(dest-tbp uint32)
(pad0 uint32)
(pad1 uint32)
)
)
(defmacro pc-texture-anim-flag (kind buf &key (qwc 0))
`(dma-buffer-add-cnt-vif2
,buf
,qwc
(new 'static 'vif-tag :cmd (vif-cmd pc-port) :imm (texture-anim-pc ,kind))
(new 'static 'vif-tag)
)
)
(defmacro pc-texture-anim-flag-id (kind buf &key (qwc 0))
`(dma-buffer-add-cnt-vif2
,buf
,qwc
(new 'static 'vif-tag :cmd (vif-cmd pc-port) :imm ,kind)
(new 'static 'vif-tag)
)
)
(defun texture-anim-layer-add-shader ((arg0 dma-buffer) (arg1 texture-anim-layer) (arg2 int))
"Add DMA to set the GS to use the given shader. This can be used to read from the texture."
(let ((s5-0 (-> arg1 tex)))
(when s5-0
;; og:preserve-this
(pc-texture-anim-flag set-shader arg0)
(dma-buffer-add-gs-set arg0
(tex0-1 (new 'static 'gs-tex0
:cld #x1
:psm (the-as int (-> s5-0 psm))
:cpsm (-> s5-0 clutpsm)
:cbp (-> s5-0 clutdest)
:tcc arg2
:th (log2 (-> s5-0 h))
:tw (log2 (-> s5-0 w))
:tbw (-> s5-0 width 0)
:tbp0 (-> s5-0 dest 0)
)
)
(tex1-1 (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
(test-1 (-> arg1 test))
(clamp-1 (-> arg1 clamp))
(alpha-1 (-> arg1 alpha))
)
)
)
(none)
)
(defun texture-anim-layer-add-clut-shader ((arg0 dma-buffer) (arg1 texture-anim-layer) (arg2 int))
"Add DMA to set the GS to use the clut as a ct32 texture. This is used to abuse the GS to blend cluts by pretending they are ct32's."
(let ((a1-1 (-> arg1 tex)))
(when a1-1
;; og:preserve-this
(pc-texture-anim-flag set-shader arg0)
(dma-buffer-add-gs-set arg0
(tex0-1 (new 'static 'gs-tex0 :tbw #x1 :tw #x4 :th #x4 :tcc arg2 :tbp0 (-> a1-1 clutdest)))
(tex1-1 (new 'static 'gs-tex1))
(test-1 (new 'static 'gs-test :ate #x1 :afail #x1 :zte #x1 :ztst (gs-ztest always)))
(clamp-1 (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
(alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1))
)
)
)
(none)
)
(defun texture-anim-layer-draw ((dma-buf dma-buffer) (width int) (height int) (layer texture-anim-layer))
"Add DMA to do a rectangular draw.
Uses the interpolated quantities for sizes/rotations/positions.
Always draws a tristrip with two triangles.
"
(local-vars (v1-27 float) (sv-224 matrix) (sv-228 matrix) (sv-232 matrix) (sv-236 matrix))
;; og:preserve-this added
(pc-texture-anim-flag draw dma-buf)
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf10 :class vf)
(vf11 :class vf)
(vf12 :class vf)
(vf14 :class vf)
(vf15 :class vf)
(vf16 :class vf)
(vf18 :class vf)
(vf19 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(let ((s4-0 (the-as (pointer uint128) (-> dma-buf base))))
(set! (-> s4-0 0) (-> *texture-anim-work* draw-tmpl dma-vif quad))
(set! (-> s4-0 1) (-> *texture-anim-work* draw-tmpl quad 1))
(set! sv-224 (new 'stack-no-clear 'matrix))
(set! sv-228 (new 'stack-no-clear 'matrix))
(set! sv-232 (new 'stack-no-clear 'matrix))
(let ((v1-7 (new 'stack-no-clear 'matrix)))
(set! (-> v1-7 quad 0) (the-as uint128 0))
(set! sv-236 v1-7)
)
(let ((s3-0 *texture-anim-work*))
(.lvf vf1 (&-> s3-0 const quad))
(.lvf vf2 (&-> layer interpolated-color quad))
(.mul.x.vf vf2 vf2 vf1)
(.ftoi.vf vf2 vf2)
(.svf (&-> s4-0 2) vf2)
(matrix-rotate-z! sv-224 (-> layer interpolated-rot x))
(set! (-> sv-236 vector 0 x) (* (-> layer interpolated-scale-offset x) (the float width)))
(set! (-> sv-236 vector 0 y) (* (-> layer interpolated-scale-offset y) (the float height)))
(matrix-scale! sv-232 (the-as vector sv-236))
(matrix*! sv-224 sv-232 sv-224)
(set! (-> sv-224 trans x) (+ 2048.0 (* (-> layer interpolated-scale-offset z) (the float width))))
(set! (-> sv-224 trans y) (+ 2048.0 (* (-> layer interpolated-scale-offset w) (the float height))))
(set! (-> sv-224 trans z) 1048575.94)
(matrix-rotate-z! sv-228 (-> layer interpolated-rot y))
(set! (-> sv-236 vector 0 x) (-> layer interpolated-st-scale-offset x))
(set! (-> sv-236 vector 0 y) (-> layer interpolated-st-scale-offset y))
(matrix-scale! sv-232 (the-as vector sv-236))
(matrix*! sv-228 sv-232 sv-228)
(set! (-> sv-228 trans x) (-> layer interpolated-st-scale-offset z))
(set! (-> sv-228 trans y) (-> layer interpolated-st-scale-offset w))
(.lvf vf11 (&-> sv-224 quad 0))
(.lvf vf12 (&-> sv-224 quad 1))
(.lvf vf14 (&-> sv-224 trans quad))
(.lvf vf15 (&-> sv-228 quad 0))
(.lvf vf16 (&-> sv-228 quad 1))
(.lvf vf18 (&-> sv-228 trans quad))
(.lvf vf7 (&-> s3-0 corner0 quad))
(.lvf vf8 (&-> s3-0 corner1 quad))
(.lvf vf9 (&-> s3-0 corner2 quad))
(.lvf vf10 (&-> s3-0 corner3 quad))
)
(.lvf vf19 (&-> layer interpolated-qs quad))
(.mul.x.vf acc vf11 vf7)
(.add.mul.y.vf acc vf12 vf7 acc)
(.add.mul.w.vf vf3 vf14 vf0 acc)
(.mul.x.vf acc vf11 vf8)
(.add.mul.y.vf acc vf12 vf8 acc)
(.add.mul.w.vf vf4 vf14 vf0 acc)
(.mul.x.vf acc vf11 vf9)
(.add.mul.y.vf acc vf12 vf9 acc)
(.add.mul.w.vf vf5 vf14 vf0 acc)
(.mul.x.vf acc vf11 vf10)
(.add.mul.y.vf acc vf12 vf10 acc)
(.add.mul.w.vf vf6 vf14 vf0 acc)
(.mul.x.vf acc vf15 vf7)
(.add.mul.y.vf acc vf16 vf7 acc)
(.add.mul.w.vf vf7 vf18 vf0 acc)
(vftoi4.xyzw vf3 vf3)
(.mul.x.vf acc vf15 vf8)
(.add.mul.y.vf acc vf16 vf8 acc)
(.add.mul.w.vf vf8 vf18 vf0 acc)
(vftoi4.xyzw vf4 vf4)
(.mul.x.vf acc vf15 vf9)
(.add.mul.y.vf acc vf16 vf9 acc)
(.add.mul.w.vf vf9 vf18 vf0 acc)
(vftoi4.xyzw vf5 vf5)
(.mul.x.vf acc vf15 vf10)
(.add.mul.y.vf acc vf16 vf10 acc)
(.add.mul.w.vf vf10 vf18 vf0 acc)
(vftoi4.xyzw vf6 vf6)
(.add.x.vf.z vf7 vf0 vf19)
(.add.y.vf.z vf8 vf0 vf19)
(.add.z.vf.z vf9 vf0 vf19)
(.add.w.vf.z vf10 vf0 vf19)
(.mul.z.vf.xy vf7 vf7 vf7)
(.mul.z.vf.xy vf8 vf8 vf8)
(.mul.z.vf.xy vf9 vf9 vf9)
(.mul.z.vf.xy vf10 vf10 vf10)
(.svf (&-> s4-0 3) vf7)
(.svf (&-> s4-0 4) vf3)
(.svf (&-> s4-0 5) vf8)
(.svf (&-> s4-0 6) vf4)
(.svf (&-> s4-0 7) vf9)
(.svf (&-> s4-0 8) vf5)
(.svf (&-> s4-0 9) vf10)
(.svf (&-> s4-0 10) vf6)
)
(.mov v1-27 vf6)
(&+! (-> dma-buf base) 176)
(none)
)
)
(defun default-texture-anim-layer-func ((dma-buf dma-buffer) (arg1 uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Apply texture animation layer. This interpolates the layer given the time, sets up the GS to _read_ from the given texture, then
does the draw."
(when (and (>= time (-> layer start-time)) (>= (-> layer end-time) time))
(texture-anim-layer-interp layer time)
(when (!= (-> layer interpolated-color w) 0.0)
(texture-anim-layer-add-shader dma-buf layer 1)
(texture-anim-layer-draw dma-buf width height layer)
)
)
0
)
(defun blend-clut-texture-anim-layer-func ((dma-buf dma-buffer) (arg1 uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Apply texture animation layer to the clut. This interpolates the layer, sets up the GS to _read_ from the given texture's
clut as a 16x16 psm32, then does the draw."
(format 0 "before blend-clut-texture-anim-layer-func ~X~%" (-> dma-buf base))
(when (and (>= time (-> layer start-time)) (>= (-> layer end-time) time))
(texture-anim-layer-interp layer time)
(when (!= (-> layer interpolated-color w) 0.0)
(texture-anim-layer-add-clut-shader dma-buf layer 0)
(texture-anim-layer-draw dma-buf 16 16 layer)
)
)
;; og:preserve-this
(format 0 "after blend-clut-texture-anim-layer-func ~X~%" (-> dma-buf base))
0
)
(defun move-rg-to-ba-texture-anim-layer-func ((dma-buf dma-buffer) (fbp-to-draw uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Some cursed texture drawing."
;; og:preserve-this HACK added:
(pc-texture-anim-flag move-rg-to-ba dma-buf :qwc 1)
(let ((transform (the texture-anim-pc-texture-transform (-> dma-buf base))))
(set! (-> transform src-tbp) (-> layer tex dest 0))
(set! (-> transform dest-tbp) (* 32 fbp-to-draw))
(set! (-> transform pad0) 0)
(set! (-> transform pad1) 0)
)
(&+! (-> dma-buf base) 16)
(return 0)
;; og:preserve-this end added
(-> layer tex)
(let ((tw (log2 (* width 2)))
(th (log2 height))
(tbp (-> layer tex dest 0))
(tbw (/ (+ (* width 2) 63) 64))
(fbmask #x3fff)
)
(dma-buffer-add-gs-set-flusha dma-buf
(xyoffset-1 (new 'static 'gs-xy-offset))
(frame-1 (new 'static 'gs-frame :psm (gs-psm ct16) :fbmsk fbmask :fbw tbw :fbp fbp-to-draw))
(scissor-1 (new 'static 'gs-scissor :scax1 (+ width -1) :scay1 (+ height -1)))
(test-1 (new 'static 'gs-test :ate #x1 :afail #x1 :zte #x1 :ztst (gs-ztest always)))
(alpha-1 (new 'static 'gs-alpha :a #x2 :b #x2 :c #x2 :fix #x80))
(tex0-1 (new 'static 'gs-tex0 :psm #x2 :tcc #x1 :tfx #x1 :th th :tw tw :tbw tbw :tbp0 tbp))
(fba-1 0)
(texa (new 'static 'gs-texa :ta1 #x80))
(tex1-1 (new 'static 'gs-tex1 :lcm #x1))
(texflush 0)
(prim (new 'static 'gs-prim :prim (gs-prim-type sprite) :tme #x1 :abe #x1 :fst #x1))
)
(let ((a3-4 height))
(dotimes (t0-7 (/ width 16))
(dma-buffer-add-gs-set dma-buf
(uv (new 'static 'gs-uv :v #x8 :u (+ (* t0-7 256) 8)))
(xyz2 (new 'static 'gs-xyz :x (+ (* t0-7 256) 128)))
(uv (new 'static 'gs-uv :u (+ (* t0-7 256) 136) :v (+ (* a3-4 16) 8)))
(xyz2 (new 'static 'gs-xyz :y (* a3-4 16) :x (+ (* t0-7 256) 256)))
)
)
)
(let ((t1-40 (/ width 64)))
(dma-buffer-add-gs-set dma-buf
(frame-1 (new 'static 'gs-frame :psm (gs-psm ct16) :fbmsk fbmask :fbw tbw :fbp (+ fbp-to-draw t1-40)))
(tex0-1 (new 'static 'gs-tex0 :psm #x2 :tcc #x1 :tfx #x1 :th th :tw tw :tbw tbw :tbp0 (+ tbp (* t1-40 32))))
(prim (new 'static 'gs-prim :prim (gs-prim-type sprite) :tme #x1 :abe #x1 :fst #x1))
)
)
)
(dotimes (v1-8 (/ width 16))
(dma-buffer-add-gs-set dma-buf
(uv (new 'static 'gs-uv :v #x8 :u (+ (* v1-8 256) 8)))
(xyz2 (new 'static 'gs-xyz :x (+ (* v1-8 256) 128)))
(uv (new 'static 'gs-uv :u (+ (* v1-8 256) 136) :v (+ (* height 16) 8)))
(xyz2 (new 'static 'gs-xyz :y (* height 16) :x (+ (* v1-8 256) 256)))
)
)
;; og:preserve-this manually done from the stuff below.
(dma-buffer-add-gs-set-flusha dma-buf
(xyoffset-1 (new 'static 'gs-xy-offset :ofx #x7000 :ofy #x7300))
(frame-1 (new 'static 'gs-frame :fbw (/ (+ width 63) 64) :fbp fbp-to-draw))
)
#|
;; not sure why this doesn't become a macro
(let* ((v1-11 dma-buf)
(a0-15 (the-as dma-packet (-> v1-11 base)))
)
(set! (-> a0-15 dma) (new 'static 'dma-tag :qwc #x3 :id (dma-tag-id cnt)))
(set! (-> a0-15 vif0) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
(set! (-> a0-15 vif1) (new 'static 'vif-tag :imm #x3 :cmd (vif-cmd direct) :msk #x1))
(set! (-> v1-11 base) (the-as pointer (&+ a0-15 16)))
)
(let* ((v1-12 dma-buf)
(a0-17 (the-as gs-gif-tag (-> v1-12 base)))
)
(set! (-> a0-17 tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x2))
(set! (-> a0-17 regs) GIF_REGS_ALL_AD)
(set! (-> v1-12 base) (the-as pointer (&+ a0-17 16)))
)
(let ((v1-13 (-> dma-buf base)))
(set! (-> (the-as (pointer gs-xy-offset) v1-13) 0) (new 'static 'gs-xy-offset :ofx #x7000 :ofy #x7300))
(set! (-> (the-as (pointer gs-reg64) v1-13) 1) (gs-reg64 xyoffset-1))
(set! (-> (the-as (pointer gs-frame) v1-13) 2)
(new 'static 'gs-frame :fbw (/ (+ width 63) 64) :fbp fbp-to-draw)
)
(set! (-> (the-as (pointer gs-reg64) v1-13) 3) (gs-reg64 frame-1))
(set! (-> dma-buf base) (&+ v1-13 32))
)
|#
0
)
(defun fill-rgb-texture-anim-layer-func ((dma-buf dma-buffer) (fbp-to-draw uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Layer function to just draw RGB. This uses a full size sprite and ignores the offset/rotations."
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(let ((s5-0 (/ (+ width 63) 64)))
;; og:preserve-this
;; set frame to mask alpha
(dma-buffer-add-gs-set-flusha dma-buf
(frame-1 (new 'static 'gs-frame :fbmsk #xff000000 :fbw s5-0 :fbp fbp-to-draw))
(texflush 0)
)
;; make sure interp is up to date
(texture-anim-layer-interp layer time)
;; sprite coordinates.
(let ((v1-4 (-> dma-buf base))
(a3-1 2048)
(a2-5 2048)
(a0-8 (+ width 2048))
(a1-15 (+ height 2048))
)
(set! (-> (the-as (pointer uint128) v1-4)) (-> *texture-anim-work* fill-tmpl dma-vif quad))
(set! (-> (the-as (pointer uint128) v1-4) 1) (-> *texture-anim-work* fill-tmpl quad 1))
(.lvf vf1 (&-> *texture-anim-work* const quad))
(.lvf vf2 (&-> layer interpolated-color quad))
(.mul.x.vf vf2 vf2 vf1)
(.ftoi.vf vf2 vf2)
(.svf (&-> (the-as (pointer uint128) v1-4) 2) vf2)
(set-vector! (the-as vector4w (&+ v1-4 48)) (* a3-1 16) (* a2-5 16) 0 0)
(set-vector! (the-as vector4w (&+ v1-4 64)) (* a0-8 16) (* a1-15 16) 0 0)
)
(&+! (-> dma-buf base) 80)
;; og:preserve-this
;; reset frame.
(dma-buffer-add-gs-set-flusha dma-buf
(frame-1 (new 'static 'gs-frame :fbw s5-0 :fbp fbp-to-draw))
(texflush 0)
)
; (let* ((v1-8 dma-buf)
; (a0-11 (the-as dma-packet (-> v1-8 base)))
; )
; (set! (-> a0-11 dma) (new 'static 'dma-tag :qwc #x3 :id (dma-tag-id cnt)))
; (set! (-> a0-11 vif0) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
; (set! (-> a0-11 vif1) (new 'static 'vif-tag :imm #x3 :cmd (vif-cmd direct) :msk #x1))
; (set! (-> v1-8 base) (the-as pointer (&+ a0-11 16)))
; )
; (let* ((v1-9 dma-buf)
; (a0-13 (the-as gs-gif-tag (-> v1-9 base)))
; )
; (set! (-> a0-13 tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x2))
; (set! (-> a0-13 regs) GIF_REGS_ALL_AD)
; (set! (-> v1-9 base) (the-as pointer (&+ a0-13 16)))
; )
; (let ((v1-10 (-> dma-buf base)))
; (set! (-> (the-as (pointer gs-frame) v1-10) 0) (new 'static 'gs-frame :fbw s5-0 :fbp fbp-to-draw))
; (set! (-> (the-as (pointer gs-reg64) v1-10) 1) (gs-reg64 frame-1))
; (set! (-> (the-as (pointer uint64) v1-10) 2) (the-as uint 0))
; (set! (-> (the-as (pointer gs-reg64) v1-10) 3) (gs-reg64 texflush))
; (set! (-> dma-buf base) (&+ v1-10 32))
; )
)
0
)
)
;; og:preserve-this
(define-extern *sky-texture-anim-array* (texture-anim-array texture-anim))
(#when PC_PORT
(define-extern *sky-hires-texture-anim-array* (texture-anim-array texture-anim)))
(define-extern *darkjak-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *jakb-prison-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *darkjak-hires-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *darkjak-hires-nest-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *kor-transform-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *skull-gem-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *bomb-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *cas-conveyor-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *security-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *waterfall-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *waterfall-b-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *lava-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *lava-b-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *stadiumb-energy-wall-anim-array* (texture-anim-array texture-anim))
(define-extern *fortress-pris-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *fortress-warp-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *metkor-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *shield-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *krew-holo-texture-anim-array* (texture-anim-array texture-anim))
(define-extern *toxic-slime-texture-anim-array* (texture-anim-array texture-anim))
(defun pc-update-anim-frame-time ((anim texture-anim))
(when (not (paused?))
(with-pp
(let ((f0-2 (+ (-> anim frame-time) (* (-> anim frame-delta) (seconds-per-frame))))
(f1-2 (-> anim frame-mod))
)
(set! (-> anim frame-time) (- f0-2 (* (the float (the int (/ f0-2 f1-2))) f1-2)))
)
(if (< (-> anim frame-time) 0.0)
(+! (-> anim frame-time) (-> anim frame-mod))
)
)
)
)
;; og:preserve-this
(defun pc-update-fixed-anim ((bucket bucket-id) (anim-id texture-anim-pc) (anim-array texture-anim-array))
"Run a 'fixed' texture-anim, which should run entirely in C++."
(with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) global-buf))
bucket
)
;; determine how many texture we have:
(let ((num-anims 0)
(num-qwc-floats 0))
(dotimes (i (-> anim-array length))
(when (-> anim-array array-data i tex)
(+! num-anims 1)
(+! num-qwc-floats 1) ;; for times
(+! num-qwc-floats (* 10 (-> anim-array array-data i num-layers)))
)
)
;; (format 0 "pc-update-fixed-anim: ~d layers~%" num)
(pc-texture-anim-flag start-anim-array dma-buf)
(pc-texture-anim-flag-id anim-id dma-buf :qwc num-qwc-floats)
(let ((out-ptr (the (inline-array vector) (-> dma-buf base)))
)
(dotimes (i num-anims)
(let ((anim (-> anim-array array-data i))
(out-slot (the (pointer float) (&+ (-> dma-buf base) (* 11 16 i))))
)
(set! (-> out-ptr 0 x) (-> anim frame-time))
(set! (-> out-ptr 0 y) (the-as float (if (-> anim tex)
(-> anim tex dest 0)
-1
)
)
)
(&+! out-ptr 16)
(dotimes (j (-> anim num-layers))
(quad-copy! (the pointer out-ptr) (the pointer (-> anim data j start-vectors)) 5)
(&+! out-ptr 80)
(quad-copy! (the pointer out-ptr) (the pointer (-> anim data j end-vectors)) 5)
(&+! out-ptr 80)
)
(when (-> anim func)
((-> anim func) dma-buf anim)
)
(pc-update-anim-frame-time anim)
)
)
)
(&+! (-> dma-buf base) (* 16 num-qwc-floats))
(pc-texture-anim-flag finish-anim-array dma-buf)
)
)
(none)
)
(deftype sky-input (structure)
((fog-height float)
(cloud-min float)
(cloud-max float)
(times float 11)
(max-times float 6)
(scales float 6)
(cloud-dest int32)
)
)
(defun make-sky-input ((si sky-input))
(set! (-> si fog-height) (-> (the-as (array texture-anim) *sky-texture-anim-array*) 8 extra z))
(set! (-> si cloud-min) (-> *sky-texture-anim-array* array-data 7 extra y))
(set! (-> si cloud-max) (-> *sky-texture-anim-array* array-data 7 extra z))
(set! (-> si cloud-dest) (the int (-> *sky-texture-anim-array* array-data 6 tex dest 0)))
(dotimes (i (-> *sky-texture-anim-array* array-data 5 num-layers))
(set! (-> si scales i) (-> *sky-texture-anim-array* array-data 5 data i start-color w))
(set! (-> si max-times i) (-> *sky-texture-anim-array* array-data (1+ i) frame-mod))
)
(dotimes (i 9)
(set! (-> si times i)
(-> *sky-texture-anim-array* array-data i frame-time)
)
)
)
(defun make-sky-hires-input ((si sky-input))
(set! (-> si fog-height) (-> (the-as (array texture-anim) *sky-hires-texture-anim-array*) 10 extra z))
(set! (-> si cloud-min) (-> *sky-hires-texture-anim-array* array-data 9 extra y))
(set! (-> si cloud-max) (-> *sky-hires-texture-anim-array* array-data 9 extra z))
(set! (-> si cloud-dest) (the int (-> *sky-hires-texture-anim-array* array-data 8 tex dest 0)))
(dotimes (i (-> *sky-hires-texture-anim-array* array-data 7 num-layers))
(set! (-> si scales i) (-> *sky-hires-texture-anim-array* array-data 7 data i start-color w))
(set! (-> si max-times i) (-> *sky-hires-texture-anim-array* array-data (1+ i) frame-mod))
)
(dotimes (i 11)
(set! (-> si times i)
(-> *sky-hires-texture-anim-array* array-data i frame-time)
)
)
)
#|
struct SlimeInput {
float alphas[4];
float times[9];
int32_t dest;
int32_t scroll_dest;
};
|#
(deftype slime-input (structure)
(;(alphas float 4)
(times float 9)
(dest int32)
(scroll-dest int32)
)
)
(defun make-slime-input ((si slime-input))
(dotimes (i 9)
(set! (-> si times i)
(-> *toxic-slime-texture-anim-array* array-data i frame-time)
)
)
(set! (-> si dest)
(the int (-> *toxic-slime-texture-anim-array* array-data 6 tex dest 0)))
(set! (-> si scroll-dest)
(the int (-> *toxic-slime-texture-anim-array* array-data 8 tex dest 0)))
)
(defun pc-clut-blender ((bucket bucket-id) (id texture-anim-pc) (anim-array texture-anim-array))
(let* ((sz (-> anim-array length))
(qwc (+ 1 (/ (+ 3 sz) 4))))
(with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) global-buf))
bucket
)
(pc-texture-anim-flag start-anim-array dma-buf)
(pc-texture-anim-flag-id id dma-buf :qwc qwc)
(let ((morph (-> anim-array array-data 0 frame-time))
(vec (the vector (-> dma-buf base)))
)
(set! (-> vec x) morph)
)
(&+! (-> dma-buf base) 16)
(dotimes (i sz)
(let ((tex (-> anim-array array-data i tex)))
(set! (-> (the (pointer uint32) (-> dma-buf base)) i)
(if tex (-> tex dest 0)
-1)
)
)
)
(&+! (-> dma-buf base) (- (* 16 qwc) 16))
(pc-texture-anim-flag finish-anim-array dma-buf)
)
)
(none)
)
(defun update-texture-anim ((bucket bucket-id) (anim-array texture-anim-array))
"Generate all DMA to update all textures in the given list for the given bucket."
(let ((anim-idx 0))
(cond
((= anim-array *toxic-slime-texture-anim-array*)
(with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) global-buf))
bucket
)
(pc-texture-anim-flag start-anim-array dma-buf)
(pc-texture-anim-flag slime dma-buf :qwc 4)
(make-slime-input (the slime-input (-> dma-buf base)))
(&+! (-> dma-buf base) 64)
(pc-texture-anim-flag finish-anim-array dma-buf)
(dotimes (i 9)
(pc-update-anim-frame-time (-> *toxic-slime-texture-anim-array* array-data i))
)
)
(return #f)
)
((= anim-array *sky-texture-anim-array*)
(when (= bucket (bucket-id tex-lcom-sky-post))
;; og:preserve-this
;; skip. I believe this is only used to generate the envmap texture for the ocean.
;; it generates the exact same thing, so if we want this on PC one day, we can just
;; steal if from the beginning of the frame.
(return #f)
)
(with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) global-buf))
bucket
)
(pc-texture-anim-flag start-anim-array dma-buf)
(pc-texture-anim-flag clouds-and-fog dma-buf :qwc (/ (psize-of sky-input) 16))
(make-sky-input (the sky-input (-> dma-buf base)))
(&+! (-> dma-buf base) (psize-of sky-input))
(pc-texture-anim-flag finish-anim-array dma-buf)
(dotimes (i 8) ;; intentially skipping fog here!!
(pc-update-anim-frame-time (-> *sky-texture-anim-array* array-data i))
)
)
;; falling through on purpose
(set! anim-idx 8) ;; fog
;(return #f)
)
((= anim-array *sky-hires-texture-anim-array*)
(when (= bucket (bucket-id tex-lcom-sky-post))
;; skip. I believe this is only used to generate the envmap texture for the ocean.
;; it generates the exact same thing, so if we want this on PC one day, we can just
;; steal if from the beginning of the frame.
(return #f)
)
(with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) global-buf))
bucket
)
(pc-texture-anim-flag start-anim-array dma-buf)
(pc-texture-anim-flag clouds-hires dma-buf :qwc (/ (psize-of sky-input) 16))
(make-sky-hires-input (the sky-input (-> dma-buf base)))
(&+! (-> dma-buf base) (psize-of sky-input))
(pc-texture-anim-flag finish-anim-array dma-buf)
(dotimes (i 10) ;; intentially skipping fog here!!
(pc-update-anim-frame-time (-> *sky-hires-texture-anim-array* array-data i))
)
)
;; falling through on purpose
(set! anim-idx 10) ;; fog
;(return #f)
)
((= anim-array *skull-gem-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc skull-gem) anim-array)
(return #f)
)
((= anim-array *bomb-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc bomb) anim-array)
(return #f)
)
((= anim-array *cas-conveyor-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc cas-conveyor) anim-array)
(return #f)
)
((= anim-array *security-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc security) anim-array)
(return #f)
)
((= anim-array *waterfall-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc waterfall) anim-array)
(return #f)
)
((= anim-array *waterfall-b-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc waterfall-b) anim-array)
(return #f)
)
((= anim-array *lava-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc lava) anim-array)
(return #f)
)
((= anim-array *lava-b-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc lava-b) anim-array)
(return #f)
)
((= anim-array *stadiumb-energy-wall-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc stadiumb) anim-array)
(return #f)
)
((= anim-array *fortress-pris-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc fortress-pris) anim-array)
(return #f)
)
((= anim-array *fortress-warp-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc fortress-warp) anim-array)
(return #f)
)
((= anim-array *metkor-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc metkor) anim-array)
(return #f)
)
((= anim-array *shield-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc shield) anim-array)
(return #f)
)
((= anim-array *krew-holo-texture-anim-array*)
(pc-update-fixed-anim bucket (texture-anim-pc krew-holo) anim-array)
(return #f)
)
((= anim-array *darkjak-texture-anim-array*)
(pc-clut-blender bucket (texture-anim-pc darkjak) anim-array)
(return #f)
)
((= anim-array *jakb-prison-texture-anim-array*)
(pc-clut-blender bucket (texture-anim-pc prison-jak) anim-array)
(return #f)
)
((= anim-array *darkjak-hires-texture-anim-array*)
(pc-clut-blender bucket (texture-anim-pc oracle-jak) anim-array)
(return #f)
)
((= anim-array *darkjak-hires-nest-texture-anim-array*)
(pc-clut-blender bucket (texture-anim-pc nest-jak) anim-array)
(return #f)
)
((= anim-array *kor-transform-texture-anim-array*)
; (pc-clut-blender bucket (texture-anim-pc kor-transform) anim-array)
(return #f)
)
(else
(format 0 "Unhandled texture animation!~%")
(break!)
(return #f)
)
)
;;
;; (return #f)
;;
(local-vars (tex-height int) (fbp-for-tex uint) (layer-idx int))
(if (-> *blit-displays-work* menu-mode)
(return #f)
)
(with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) global-buf))
bucket
)
;; og:preserve-this
;; added: flag for the PC port to indicate start of texture anim data:
(pc-texture-anim-flag start-anim-array dma-buf)
;; loop over animated textures. Each will produce a single texture.
;(dotimes (anim-idx (-> anim-array length))
(while (< anim-idx (-> anim-array length))
(let* ((anim (-> anim-array array-data anim-idx))
(dest-tex (-> anim tex))
)
(when dest-tex
0
(let ((tex-width (-> dest-tex w)))
(set! tex-height (-> dest-tex h))
(cond
((or (= (-> dest-tex psm) (gs-psm ct32)) (= (-> dest-tex psm) (gs-psm mt8h)))
;; animating the actual texture data.
(set! fbp-for-tex (shr (-> dest-tex dest 0) 5))
fbp-for-tex
)
(else
;; not really sure why, but for non-mt8h and non-ct32's we clear the clut here...
(set! fbp-for-tex (shr (-> dest-tex clutdest) 5))
(set! tex-width 16)
(set! tex-height 16)
tex-height
)
)
(when (and (nonzero? tex-width) (nonzero? tex-height))
;; configure for drawing to this texture.
(pc-texture-anim-flag erase-and-init dma-buf)
(dma-buffer-add-gs-set-flusha dma-buf
(scissor-1 (new 'static 'gs-scissor :scax1 (+ tex-width -1) :scay1 (+ tex-height -1)))
(xyoffset-1 (new 'static 'gs-xy-offset :ofx #x8000 :ofy #x8000))
;; setting fbp here is what makes it draw to the texture, not frambeuffer.
(frame-1 (new 'static 'gs-frame :fbw (/ (+ tex-width 63) 64) :fbp fbp-for-tex))
(test-1 (-> anim test))
(alpha-1 (-> anim alpha))
(clamp-1 (-> anim clamp))
(texa (new 'static 'gs-texa :ta0 #x80 :ta1 #x80))
(zbuf-1 (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1))
(texflush 0)
)
;; erase whatever was here previously
(let ((a1-32 (-> dma-buf base))
(a3-0 2048)
(a2-7 2048)
(v1-25 (+ tex-width 2048))
(a0-16 (+ tex-height 2048))
)
(set! (-> (the-as (pointer uint128) a1-32)) (-> *texture-anim-work* erase-tmpl dma-vif quad))
(set! (-> (the-as (pointer uint128) a1-32) 1) (-> *texture-anim-work* erase-tmpl quad 1))
(set-vector!
(the-as vector4w (&+ a1-32 32))
(the-as int (-> anim color r))
(the-as int (-> anim color g))
(the-as int (-> anim color b))
(the-as int (-> anim color a))
)
(set-vector! (the-as vector4w (&+ a1-32 48)) (* a3-0 16) (* a2-7 16) #xffffff 0)
(set-vector! (the-as vector4w (&+ a1-32 64)) (* v1-25 16) (* a0-16 16) #xffffff 0)
)
(&+! (-> dma-buf base) 80)
)
;; this animated texture may overlap with other textures from other pages.
;; we're writing over this from outside of the usual texture page upload system.
;; so we should manually clear the id arrays for our pages, to make sure the texture
;; system re-uploads textures if needed.
(let ((v1-32 (/ (the-as int fbp-for-tex) 2))
(a0-19 (* (/ (+ tex-width 63) 64) (/ (+ tex-height 63) 64)))
)
(if (and (logtest? fbp-for-tex 1) (< 32 tex-width))
(+! a0-19 1)
)
(dotimes (a1-43 a0-19)
(set! (-> *texture-pool* ids (+ v1-32 a1-43)) (the-as uint 0))
)
)
;; loop over layers
(set! layer-idx 0)
(while (< layer-idx (the-as int (-> anim num-layers)))
(let ((layer (-> anim data layer-idx)))
; (format 0 " running layer ~D, dma at #x~X~%" layer-idx (-> dma-buf base))
;; generate DMA for this layer's effect
((-> layer func) dma-buf fbp-for-tex tex-width tex-height layer (-> anim frame-time))
)
(set! layer-idx (+ layer-idx 1))
)
)
;; some sort of final function (TODO args here)
(when (-> anim func)
; (format 0 " running final, dma at #x~X~%" layer-idx (-> dma-buf base))
((-> anim func) dma-buf anim)
)
;; advance animation.
(when (not (paused?))
(let ((f0-2 (+ (-> anim frame-time) (* (-> anim frame-delta) (seconds-per-frame))))
(f1-2 (-> anim frame-mod))
)
(set! (-> anim frame-time) (- f0-2 (* (the float (the int (/ f0-2 f1-2))) f1-2)))
)
(if (< (-> anim frame-time) 0.0)
(+! (-> anim frame-time) (-> anim frame-mod))
)
)
)
)
(+! anim-idx 1)
)
;; reset GS registers - we messed with frame/scissor.
;(reset-display-gs-state *display* dma-buf)
;; added: flag for the PC port to indicate end of texture anim data:
(dma-buffer-add-cnt-vif2
dma-buf
0
(new 'static 'vif-tag :cmd (vif-cmd pc-port) :imm (texture-anim-pc finish-anim-array))
(new 'static 'vif-tag :cmd (vif-cmd pc-port))
)
)
0
(none)
)
)
(defun no-alpha-texture-anim-layer-func ((dma-buf dma-buffer) (fbp-to-draw uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Like others, but the tcc value is 0"
(when (and (>= time (-> layer start-time)) (>= (-> layer end-time) time))
(texture-anim-layer-interp layer time)
(when (!= (-> layer interpolated-color w) 0.0)
(texture-anim-layer-add-shader dma-buf layer 0)
(texture-anim-layer-draw dma-buf width height layer)
)
)
0
)
(defun copy-alpha-texture-anim-layer-func ((dma-buf dma-buffer) (fbp-to-draw uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Copy only alpha from the layer source texture. Does a draw, possibly blending if that's how the layer is configured.
Draw is always axis aligned, full size."
(when (and (>= time (-> layer start-time)) (>= (-> layer end-time) time))
;; compute layer values for this frame
(texture-anim-layer-interp layer time)
(let ((s4-0 (/ (+ width 63) 64)))
;; set up fbmask for alpha only
(dma-buffer-add-gs-set dma-buf (frame-1 (new 'static 'gs-frame :fbmsk #xffffff :fbw s4-0 :fbp fbp-to-draw)))
;; set up shader to sample from the layer's texture
(texture-anim-layer-add-shader dma-buf layer 1)
(let ((v1-7 (-> dma-buf base))
(a2-6 #x8000)
(a3-1 #x8000)
(a0-10 (* (+ width 2048) 16))
(a1-14 (* (+ height 2048) 16))
)
;; generate drawing.
(set! (-> (the-as (pointer uint128) v1-7)) (-> *texture-anim-work* draw-tmpl dma-vif quad))
(set! (-> (the-as (pointer uint128) v1-7) 1) (-> *texture-anim-work* draw-tmpl quad 1))
(set-vector! (the-as vector4w (&+ v1-7 32)) 128 128 128 (the int (* 128.0 (-> layer interpolated-color w))))
(set-vector! (the-as vector (&+ v1-7 48)) 0.0 0.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ v1-7 64)) a2-6 a3-1 #xffffff 0)
(set-vector! (the-as vector (&+ v1-7 80)) 1.0 0.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ v1-7 96)) a0-10 a3-1 #xffffff 0)
(set-vector! (the-as vector (&+ v1-7 112)) 0.0 1.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ v1-7 128)) a2-6 a1-14 #xffffff 0)
(set-vector! (the-as vector (&+ v1-7 144)) 1.0 1.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ v1-7 160)) a0-10 a1-14 #xffffff 0)
)
(&+! (-> dma-buf base) 176)
;; reset frame.
(dma-buffer-add-gs-set dma-buf
(frame-1 (new 'static 'gs-frame :fbw s4-0 :fbp fbp-to-draw))
)
; (let* ((v1-11 dma-buf)
; (a0-12 (the-as dma-packet (-> v1-11 base)))
; )
; (set! (-> a0-12 dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
; (set! (-> a0-12 vif0) (new 'static 'vif-tag))
; (set! (-> a0-12 vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
; (set! (-> v1-11 base) (the-as pointer (&+ a0-12 16)))
; )
; (let* ((v1-12 dma-buf)
; (a0-14 (the-as object (-> v1-12 base)))
; )
; (set! (-> (the-as gs-gif-tag a0-14) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
; (set! (-> (the-as gs-gif-tag a0-14) regs) GIF_REGS_ALL_AD)
; (set! (-> v1-12 base) (&+ (the-as pointer a0-14) 16))
; )
; (let ((v1-13 (-> dma-buf base)))
; (set! (-> (the-as (pointer gs-frame) v1-13) 0) (new 'static 'gs-frame :fbw s4-0 :fbp fbp-to-draw))
; (set! (-> (the-as (pointer gs-reg64) v1-13) 1) (gs-reg64 frame-1))
; (set! (-> dma-buf base) (&+ v1-13 16))
; )
)
)
0
)
(defun copy-clut-alpha-texture-anim-layer-func ((dma-buf dma-buffer) (fbp-to-draw uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Copy only alpha from the layer source clut."
(pc-texture-anim-flag copy-clut-alpha dma-buf :qwc 1)
(let ((transform (the texture-anim-pc-texture-transform (-> dma-buf base))))
(set! (-> transform src-tbp) (-> layer tex dest 0))
(set! (-> transform dest-tbp) (* 32 fbp-to-draw))
(set! (-> transform pad0) 0)
(set! (-> transform pad1) 0)
)
(&+! (-> dma-buf base) 16)
(return 0)
(when (and (>= time (-> layer start-time)) (>= (-> layer end-time) time))
(texture-anim-layer-interp layer time)
(let ((s4-0 1))
(dma-buffer-add-gs-set dma-buf (frame-1 (new 'static 'gs-frame :fbmsk #xffffff :fbw s4-0 :fbp fbp-to-draw)))
(texture-anim-layer-add-clut-shader dma-buf layer 1)
(let ((a1-13 (-> dma-buf base))
(a2-6 #x8000)
(a3-1 #x8000)
(v1-6 #x8100)
(a0-9 #x8100)
)
(set! (-> (the-as (pointer uint128) a1-13)) (-> *texture-anim-work* draw-tmpl dma-vif quad))
(set! (-> (the-as (pointer uint128) a1-13) 1) (-> *texture-anim-work* draw-tmpl quad 1))
(set-vector! (the-as vector4w (&+ a1-13 32)) 128 128 128 (the int (* 128.0 (-> layer interpolated-color w))))
(set-vector! (the-as vector (&+ a1-13 48)) 0.0 0.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ a1-13 64)) a2-6 a3-1 #xffffff 0)
(set-vector! (the-as vector (&+ a1-13 80)) 1.0 0.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ a1-13 96)) v1-6 a3-1 #xffffff 0)
(set-vector! (the-as vector (&+ a1-13 112)) 0.0 1.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ a1-13 128)) a2-6 a0-9 #xffffff 0)
(set-vector! (the-as vector (&+ a1-13 144)) 1.0 1.0 1.0 0.0)
(set-vector! (the-as vector4w (&+ a1-13 160)) v1-6 a0-9 #xffffff 0)
)
(&+! (-> dma-buf base) 176)
(dma-buffer-add-gs-set dma-buf
(frame-1 (new 'static 'gs-frame :fbw s4-0 :fbp fbp-to-draw))
)
; (let* ((v1-10 dma-buf)
; (a0-10 (the-as dma-packet (-> v1-10 base)))
; )
; (set! (-> a0-10 dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
; (set! (-> a0-10 vif0) (new 'static 'vif-tag))
; (set! (-> a0-10 vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
; (set! (-> v1-10 base) (the-as pointer (the-as dma-packet (&+ a0-10 16))))
; )
; (let* ((v1-11 dma-buf)
; (a0-12 (the-as object (-> v1-11 base)))
; )
; (set! (-> (the-as gs-gif-tag a0-12) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
; (set! (-> (the-as gs-gif-tag a0-12) regs) GIF_REGS_ALL_AD)
; (set! (-> v1-11 base) (&+ (the-as pointer a0-12) 16))
; )
; (let ((v1-12 (-> dma-buf base)))
; (set! (-> (the-as (pointer gs-frame) v1-12) 0) (new 'static 'gs-frame :fbw s4-0 :fbp fbp-to-draw))
; (set! (-> (the-as (pointer gs-reg64) v1-12) 1) (gs-reg64 frame-1))
; (set! (-> dma-buf base) (&+ v1-12 16))
; )
)
)
0
)
(defun set-alpha-texture-anim-layer-func ((dma-buf dma-buffer) (fbp-to-draw uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Set alpha to 128 for the texture."
(let ((v1-1 (/ (+ width 63) 64)))
;; make sure alpha test is off, and set frame to allow only alpha writes
(dma-buffer-add-gs-set dma-buf
(test-1 (new 'static 'gs-test :ate #x1 :afail #x1 :zte #x1 :ztst (gs-ztest always)))
(frame-1 (new 'static 'gs-frame :fbmsk #xffffff :fbw v1-1 :fbp fbp-to-draw))
)
;; draw the sprite.
(let ((t0-4 (-> dma-buf base))
(t2-12 2048)
(t1-7 2048)
(a2-1 (+ width 2048))
(a3-1 (+ height 2048))
)
(set! (-> (the-as (pointer uint128) t0-4)) (-> *texture-anim-work* erase-tmpl dma-vif quad))
(set! (-> (the-as (pointer uint128) t0-4) 1) (-> *texture-anim-work* erase-tmpl quad 1))
(set-vector! (the-as vector4w (&+ t0-4 32)) 0 0 0 128) ;; rgba
(set-vector! (the-as vector4w (&+ t0-4 48)) (* t2-12 16) (* t1-7 16) #xffffff 0)
(set-vector! (the-as vector4w (&+ t0-4 64)) (* a2-1 16) (* a3-1 16) #xffffff 0)
)
(&+! (-> dma-buf base) 80)
(dma-buffer-add-gs-set dma-buf
(frame-1 (new 'static 'gs-frame :fbw v1-1 :fbp fbp-to-draw))
)
0
; (let* ((a2-7 dma-buf)
; (a3-2 (the-as object (-> a2-7 base)))
; )
; (set! (-> (the-as dma-packet a3-2) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
; (set! (-> (the-as dma-packet a3-2) vif0) (new 'static 'vif-tag))
; (set! (-> (the-as dma-packet a3-2) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
; (set! (-> a2-7 base) (&+ (the-as pointer a3-2) 16))
; )
; (let* ((a2-8 dma-buf)
; (a3-4 (the-as object (-> a2-8 base)))
; )
; (set! (-> (the-as gs-gif-tag a3-4) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
; (set! (-> (the-as gs-gif-tag a3-4) regs) GIF_REGS_ALL_AD)
; (set! (-> a2-8 base) (&+ (the-as pointer a3-4) 16))
; )
; (let ((a2-9 (-> dma-buf base)))
; (set! (-> (the-as (pointer gs-frame) a2-9) 0) (new 'static 'gs-frame :fbw v1-1 :fbp fbp-to-draw))
; (set! (-> (the-as (pointer gs-reg64) a2-9) 1) (gs-reg64 frame-1))
; (let ((v0-0 (&+ a2-9 16)))
; (set! (-> dma-buf base) v0-0)
; (the-as int v0-0)
; )
; )
)
)
(defun set-clut-alpha-texture-anim-layer-func ((dma-buf dma-buffer) (fbp-to-draw uint) (width int) (height int) (layer texture-anim-layer) (time float))
"Set clut alpha to 128."
;; PC version
(pc-texture-anim-flag set-clut-alpha dma-buf :qwc 1)
(let ((transform (the texture-anim-pc-texture-transform (-> dma-buf base))))
(set! (-> transform src-tbp) (* 32 fbp-to-draw))
(set! (-> transform dest-tbp) (* 32 fbp-to-draw))
(set! (-> transform pad0) 0)
(set! (-> transform pad1) 0)
)
(&+! (-> dma-buf base) 16)
(return 0)
(let ((v1-0 1))
(dma-buffer-add-gs-set dma-buf
(test-1 (new 'static 'gs-test :ate #x1 :afail #x1 :zte #x1 :ztst (gs-ztest always)))
(frame-1 (new 'static 'gs-frame :fbmsk #xffffff :fbw v1-0 :fbp fbp-to-draw))
)
(let ((t0-13 (-> dma-buf base))
(t2-0 2048)
(t1-5 2048)
(a3-7 2064)
(a2-4 2064)
)
(set! (-> (the-as (pointer uint128) t0-13)) (-> *texture-anim-work* erase-tmpl dma-vif quad))
(set! (-> (the-as (pointer uint128) t0-13) 1) (-> *texture-anim-work* erase-tmpl quad 1))
(set-vector! (the-as vector4w (&+ t0-13 32)) 0 0 0 128)
(set-vector! (the-as vector4w (&+ t0-13 48)) (* t2-0 16) (* t1-5 16) #xffffff 0)
(set-vector! (the-as vector4w (&+ t0-13 64)) (* a3-7 16) (* a2-4 16) #xffffff 0)
)
(&+! (-> dma-buf base) 80)
(dma-buffer-add-gs-set dma-buf
(frame-1 (new 'static 'gs-frame :fbw v1-0 :fbp fbp-to-draw))
)
0
; (let* ((a2-9 dma-buf)
; (a3-9 (the-as object (-> a2-9 base)))
; )
; (set! (-> (the-as dma-packet a3-9) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
; (set! (-> (the-as dma-packet a3-9) vif0) (new 'static 'vif-tag))
; (set! (-> (the-as dma-packet a3-9) vif1) (new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1))
; (set! (-> a2-9 base) (&+ (the-as pointer a3-9) 16))
; )
; (let* ((a2-10 dma-buf)
; (a3-11 (the-as object (-> a2-10 base)))
; )
; (set! (-> (the-as gs-gif-tag a3-11) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
; (set! (-> (the-as gs-gif-tag a3-11) regs) GIF_REGS_ALL_AD)
; (set! (-> a2-10 base) (&+ (the-as pointer a3-11) 16))
; )
; (let ((a2-11 (-> dma-buf base)))
; (set! (-> (the-as (pointer gs-frame) a2-11) 0) (new 'static 'gs-frame :fbw v1-0 :fbp fbp-to-draw))
; (set! (-> (the-as (pointer gs-reg64) a2-11) 1) (gs-reg64 frame-1))
; (let ((v0-0 (&+ a2-11 16)))
; (set! (-> dma-buf base) v0-0)
; (the-as int v0-0)
; )
; )
)
)
(defun dest-texture-init ((tex-anim texture-anim))
"Set up the texture object to hold the destination (result) texture."
(let ((dest-tex (new 'loading-level 'texture)))
(let ((size (the int (-> tex-anim extra x))))
(let ((dest (the int (-> tex-anim extra y)))) ;; dest vram addr is stashed here.
(set! (-> tex-anim tex) dest-tex)
(set! (-> dest-tex w) size)
(set! (-> dest-tex h) size)
(set! (-> dest-tex num-mips) (the-as uint 1))
(set! (-> dest-tex psm) (gs-psm ct32))
(set! (-> dest-tex dest 0) (the-as uint (* dest 32)))
)
(set! (-> dest-tex width 0) (the-as uint (/ (+ size 63) 64)))
)
(set! (-> dest-tex masks data 0 mask quad) (the-as uint128 0))
(set! (-> dest-tex masks data 1 mask quad) (the-as uint128 0))
(set! (-> dest-tex masks data 2 mask quad) (the-as uint128 0))
)
0
0
(none)
)
(defun src-texture-init ((layer texture-anim-layer))
"Allocate a texture object to hold a source texture. This is only used for source textures that are generated at runtime,
like random noise. Layers may include a reference to an existing texture instead. Always psm32."
(let ((tex (new 'loading-level 'texture)))
(let ((size (the int (-> layer extra x))))
(let ((addr (the int (-> layer extra y))))
(set! (-> layer tex) tex)
(set! (-> tex w) size)
(set! (-> tex h) size)
(set! (-> tex num-mips) (the-as uint 1))
(set! (-> tex psm) (gs-psm ct32))
(set! (-> tex dest 0) (the-as uint (* addr 32)))
)
(set! (-> tex width 0) (the-as uint (/ (+ size 63) 64)))
)
(set! (-> tex masks data 0 mask quad) (the-as uint128 0))
(set! (-> tex masks data 1 mask quad) (the-as uint128 0))
(set! (-> tex masks data 2 mask quad) (the-as uint128 0))
)
0
0
(none)
)
(defun src-texture-init-mt8 ((layer texture-anim-layer))
"Like src-texture-init, but sets up a mt8 (pallete) texture."
(let ((tex (new 'loading-level 'texture)))
(let ((width (the int (-> layer extra x))))
(let ((height (the int (-> layer extra y)))
(dest (the int (-> layer extra z)))
(clutdest (the int (-> layer extra w)))
)
(set! (-> layer tex) tex)
(set! (-> tex w) width)
(set! (-> tex h) height)
(set! (-> tex num-mips) (the-as uint 1))
(set! (-> tex psm) (gs-psm mt8))
(set! (-> tex dest 0) (the-as uint (* dest 32)))
(set! (-> tex clutpsm) (the-as uint 0))
(set! (-> tex clutdest) (the-as uint (* clutdest 32)))
)
(set! (-> tex width 0) (the-as uint (/ (+ width 63) 64)))
)
(set! (-> tex masks data 0 mask quad) (the-as uint128 0))
(set! (-> tex masks data 1 mask quad) (the-as uint128 0))
(set! (-> tex masks data 2 mask quad) (the-as uint128 0))
)
0
0
(none)
)
(defun make-noise-texture ((arg0 pointer) (arg1 int) (arg2 int) (arg3 int))
"Generate 'random' noise texture."
(local-vars (t4-5 uint128) (t5-3 uint128))
(let ((v1-0 (/ arg1 16))
(a3-1 (/ arg3 16))
)
(when (< arg1 16)
(set! a3-1 1)
(set! v1-0 1)
(set! arg2 (/ (* arg2 arg1) 16))
)
(let* ((a1-5 *texture-anim-work*)
(v0-0 (-> a1-5 random-index))
)
(dotimes (t0-1 arg2)
(let ((t1-0 0))
(goto cfg-6)
(until (>= t1-0 v1-0)
(let* ((t2-0 (* t0-1 a3-1))
(t3-0 (+ v0-0 3))
(t4-0 (+ v0-0 5))
(t5-0 (+ v0-0 7))
(t3-1 (logand t3-0 7))
(t4-1 (logand t4-0 7))
(t7-0 (logand t5-0 7))
(t6-0 (* v0-0 16))
(t5-1 (* t3-1 16))
(t4-2 (* t4-1 16))
(t3-2 (* t7-0 16))
(t2-1 (+ t2-0 t1-0))
(t6-1 (the-as object (+ t6-0 (the-as uint a1-5))))
(t2-2 (* t2-1 16))
(t7-1 (the-as object (+ t5-1 (the-as uint a1-5))))
(t5-2 (-> (the-as (pointer uint128) t6-1) 15))
(t4-3 (the-as object (+ t4-2 (the-as uint a1-5))))
(t6-2 (-> (the-as (pointer uint128) t7-1) 15))
(t3-3 (the-as object (+ t3-2 (the-as uint a1-5))))
)
(let ((t4-4 (-> (the-as (pointer uint128) t4-3) 15)))
(.paddb t5-3 t5-2 t6-2)
(nop!)
(.paddb t4-5 t5-3 t4-4)
)
(nop!)
(let ((t2-3 (+ t2-2 (the-as int arg0))))
(set! (-> (the-as (pointer uint128) t3-3) 15) t4-5)
(let ((t3-4 (+ v0-0 1)))
(set! (-> (the-as (pointer uint128) t2-3) 0) t4-5)
(set! v0-0 (logand t3-4 7))
)
)
)
(nop!)
(+! t1-0 1)
(label cfg-6)
)
)
)
(set! (-> a1-5 random-index) v0-0)
)
)
(none)
)
(defun make-cloud-clut ((arg0 (pointer uint32)) (arg1 float) (arg2 float))
"Generate clut for the cloud texture."
(local-vars (v1-10 int))
0
(let* ((s5-0 (the int (* 255.0 arg1)))
(s4-1 (max (the int (* 255.0 arg2)) s5-0))
(f30-0 (/ 128.0 (the float (- s4-1 s5-0))))
)
(dotimes (s3-0 256)
(let ((s2-0 (-> *clut-translate* s3-0)))
(cond
((and (>= s5-0 s3-0) (nonzero? s4-1))
(set! v1-10 0)
)
((>= s3-0 s4-1)
(set! v1-10 128)
)
(else
(let* ((f0-9 (sin (* 128.0 (fmin 128.0 (* (the float (- s3-0 s5-0)) f30-0)))))
(f0-11 (* f0-9 f0-9))
)
(set! v1-10 (the int (* 128.0 f0-11)))
)
)
)
(set! (-> arg0 s2-0) (logior (logand (-> arg0 s2-0) -256) 128))
(set! (-> arg0 s2-0) (logior (logand (-> arg0 s2-0) -65281) #x8000))
(set! (-> arg0 s2-0) (logior (logand (-> arg0 s2-0) -16711681) #x800000))
(set! (-> arg0 s2-0)
(logior (logand (-> arg0 s2-0) (the-as uint #xffffffff00ffffff)) (shr (shl v1-10 56) 32))
)
)
)
)
(none)
)
(defun texture-anim-cloud-clut-upload ((arg0 dma-buffer) (arg1 texture-anim))
"Upload the clut for the clouds."
(when (-> arg1 tex)
(make-cloud-clut (the-as (pointer uint32) (-> arg1 tex pad 0)) (-> arg1 extra y) (-> arg1 extra z))
;(upload-vram-data arg0 (the-as int (-> arg1 tex clutdest)) (the-as pointer (-> arg1 tex pad 0)) 16 16)
(pc-texture-anim-flag upload-clut-16-16 arg0 :qwc 1)
(let ((upload-record (the texture-anim-pc-upload (-> arg0 base))))
(set! (-> upload-record data) (the-as pointer (-> arg1 tex pad 0))) ;; the clut16x16 object
(set! (-> upload-record width) 16)
(set! (-> upload-record height) 16)
(set! (-> upload-record dest) (-> arg1 tex clutdest))
(set! (-> upload-record format) (gs-psm ct32))
)
(&+! (-> arg0 base) 16)
(set! (-> *texture-pool* ids (shr (-> arg1 tex clutdest) 6)) (the-as uint 0))
0
)
(none)
)
(defun texture-anim-cloud-clut-init ((arg0 texture-anim))
(let ((s5-0 (new 'loading-level 'texture))
(s4-0 (the int (-> arg0 extra x)))
(v1-2 (new 'loading-level 'clut16x16))
)
(set! (-> arg0 tex) s5-0)
(set! (-> s5-0 clutdest) (the-as uint (* s4-0 32)))
(set! (-> s5-0 pad 0) (the-as uint v1-2))
)
0
(none)
)
;; definition for function make-slime-clut
;; WARN: Return type mismatch symbol vs none.
(define-extern *slime-clut* clut16x16)
(defun make-slime-clut ((arg0 (pointer uint32)))
(dotimes (v1-0 256)
(let ((a1-2 (-> *clut-translate* v1-0))
(a2-2 (-> *slime-clut* clut v1-0))
)
(set! (-> arg0 a1-2) (logior (logand (-> arg0 a1-2) -256) (shr (shl (-> a2-2 r) 56) 56)))
(set! (-> arg0 a1-2) (logior (logand (-> arg0 a1-2) -65281) (shr (shl (-> a2-2 g) 56) 48)))
(set! (-> arg0 a1-2) (logior (logand (-> arg0 a1-2) -16711681) (shr (shl (-> a2-2 b) 56) 40)))
(set! (-> arg0 a1-2)
(logior (logand (-> arg0 a1-2) (the-as uint #xffffffff00ffffff)) (shr (shl (-> a2-2 a) 56) 32))
)
)
)
(none)
)
(defun texture-anim-slime-clut-upload ((arg0 dma-buffer) (arg1 texture-anim))
(when (-> arg1 tex)
(make-slime-clut (the-as (pointer uint32) (-> arg1 tex pad 0)))
(upload-vram-data arg0 (the-as int (-> arg1 tex clutdest)) (the-as pointer (-> arg1 tex pad 0)) 16 16)
(set! (-> *texture-pool* ids (shr (-> arg1 tex clutdest) 6)) (the-as uint 0))
0
)
(none)
)
(defun texture-anim-slime-clut-init ((arg0 texture-anim))
(let ((s5-0 (new 'loading-level 'texture))
(s4-0 (the int (-> arg0 extra x)))
(v1-2 (new 'loading-level 'clut16x16))
)
(set! (-> arg0 tex) s5-0)
(set! (-> s5-0 clutdest) (the-as uint (* s4-0 32)))
(set! (-> s5-0 pad 0) (the-as uint v1-2))
)
0
(none)
)
;; WARN: Return type mismatch symbol vs none.
(defun make-ramp-clut ((arg0 (pointer uint32)) (arg1 pointer) (arg2 object))
(dotimes (v1-0 256)
(let ((a1-3 (-> *clut-translate* v1-0)))
(set! (-> arg0 a1-3) (logior (logand (-> arg0 a1-3) -256) (shr (shl v1-0 56) 56)))
(set! (-> arg0 a1-3) (logior (logand (-> arg0 a1-3) -65281) (shr (shl v1-0 56) 48)))
(set! (-> arg0 a1-3) (logior (logand (-> arg0 a1-3) -16711681) (shr (shl v1-0 56) 40)))
(set! (-> arg0 a1-3) (logior (logand (-> arg0 a1-3) (the-as uint #xffffffff00ffffff)) (shr (shl v1-0 56) 32)))
)
)
(none)
)
(defun make-alpha-ramp-clut ((arg0 (pointer uint32)))
(dotimes (v1-0 256)
(let ((a1-2 (-> *clut-translate* v1-0)))
(set! (-> arg0 a1-2) (logior (logand (-> arg0 a1-2) -256) 128))
(set! (-> arg0 a1-2) (logior (logand (-> arg0 a1-2) -65281) #x8000))
(set! (-> arg0 a1-2) (logior (logand (-> arg0 a1-2) -16711681) #x800000))
(set! (-> arg0 a1-2) (logior (logand (-> arg0 a1-2) (the-as uint #xffffffff00ffffff)) (shr (shl v1-0 56) 32)))
)
)
(none)
)
(defun noise-texture-init ((arg0 texture-anim-layer))
(let ((gp-0 (the int (-> arg0 extra x)))
(s4-0 (the-as structure #f))
)
(case gp-0
((8)
(set! s4-0 (new 'loading-level 'noise8x8))
)
((16)
(set! s4-0 (new 'loading-level 'noise16x16))
)
((32)
(set! s4-0 (new 'loading-level 'noise32x32))
)
((64)
(set! s4-0 (new 'loading-level 'noise64x64))
)
((128)
(set! s4-0 (new 'loading-level 'noise128x128))
)
;; og:preserve-this added these two cases
((256)
(set! s4-0 (new 'loading-level 'noise256x256))
)
((512)
(set! s4-0 (new 'loading-level 'noise512x512))
)
)
(when s4-0
(let ((v1-14 (new 'loading-level 'texture)))
(let ((a0-16 (the int (-> arg0 extra y)))
(a1-6 (the int (-> arg0 extra z)))
)
(set! (-> arg0 tex) v1-14)
(set! (-> v1-14 pad 0) (the-as uint s4-0))
(set! (-> v1-14 w) gp-0)
(set! (-> v1-14 h) gp-0)
(set! (-> v1-14 num-mips) (the-as uint 1))
(set! (-> v1-14 psm) (gs-psm mt8))
(set! (-> v1-14 clutpsm) (the-as uint 0))
(set! (-> v1-14 dest 0) (the-as uint (* a0-16 32)))
(set! (-> v1-14 clutdest) (the-as uint (* a1-6 32)))
)
(set! (-> v1-14 width 0) (the-as uint 1))
(set! (-> v1-14 masks data 0 mask quad) (the-as uint128 0))
(set! (-> v1-14 masks data 1 mask quad) (the-as uint128 0))
(set! (-> v1-14 masks data 2 mask quad) (the-as uint128 0))
(make-noise-texture (the-as pointer (-> v1-14 pad 0)) gp-0 gp-0 gp-0)
)
)
)
0
(none)
)
(defun texture-anim-alpha-ramp-clut-upload ((arg0 dma-buffer) (arg1 texture-anim))
(when (-> arg1 tex)
;; og:preserve-this
;(upload-vram-data arg0 (the-as int (-> arg1 tex clutdest)) (the-as pointer (-> arg1 tex pad 0)) 16 16)
(pc-texture-anim-flag upload-clut-16-16 arg0 :qwc 1)
(let ((upload-record (the texture-anim-pc-upload (-> arg0 base))))
(set! (-> upload-record data) (the-as pointer (-> arg1 tex pad 0))) ;; the clut16x16 object
(set! (-> upload-record width) 16)
(set! (-> upload-record height) 16)
(set! (-> upload-record dest) (-> arg1 tex clutdest))
(set! (-> upload-record format) (gs-psm ct32))
)
(&+! (-> arg0 base) 16)
(set! (-> *texture-pool* ids (shr (-> arg1 tex clutdest) 6)) (the-as uint 0))
0
)
(none)
)
(defun texture-anim-alpha-ramp-clut-init ((arg0 texture-anim))
(let ((s5-0 (new 'loading-level 'texture))
(s4-0 (the int (-> arg0 extra x)))
(a0-3 (new 'loading-level 'clut16x16))
)
(set! (-> arg0 tex) s5-0)
(set! (-> s5-0 clutdest) (the-as uint (* s4-0 32)))
(set! (-> s5-0 pad 0) (the-as uint a0-3))
(make-alpha-ramp-clut (the-as (pointer uint32) a0-3))
)
0
(none)
)
(defun texture-anim-overide-size-init ((arg0 texture-anim))
(when (-> arg0 tex-name)
(let ((v1-2 (lookup-level-texture-by-name
(-> arg0 tex-name)
(-> *level* loading-level)
(the-as (pointer texture-page) #f)
)
)
)
(when v1-2
(let ((a0-2 (the int (-> arg0 extra x))))
(let ((a1-1 (the int (-> arg0 extra y))))
(set! (-> v1-2 w) a0-2)
(set! (-> v1-2 h) a1-1)
)
(set! (-> v1-2 dest 0) (the-as uint 1))
(set! (-> v1-2 width 0) (the-as uint (/ a0-2 64)))
)
(set! (-> v1-2 masks data 0 mask quad) (the-as uint128 0))
(set! (-> v1-2 masks data 1 mask quad) (the-as uint128 0))
(set! (-> v1-2 masks data 2 mask quad) (the-as uint128 0))
0
)
)
)
(none)
)
(defun texture-anim-change-mt8h-init ((arg0 texture-anim))
(when (-> arg0 tex-name)
(let ((v1-2 (lookup-level-texture-by-name
(-> arg0 tex-name)
(-> *level* loading-level)
(the-as (pointer texture-page) #f)
)
)
)
(when v1-2
(let ((a0-2 (the int (-> arg0 extra x)))
(a1-1 (the int (-> arg0 extra y)))
(a2-1 (the int (-> arg0 extra z)))
)
(let ((a3-0 (the int (-> arg0 extra w))))
(set! (-> v1-2 clutdest) (the-as uint (* a0-2 32)))
(set! (-> v1-2 clutpsm) (the-as uint 0))
(set! (-> v1-2 dest 0) (the-as uint (* a1-1 32)))
(set! (-> v1-2 psm) (gs-psm mt8h))
(set! (-> v1-2 w) a2-1)
(set! (-> v1-2 h) a3-0)
)
(set! (-> v1-2 width 0) (the-as uint (/ a2-1 64)))
)
(set! (-> v1-2 masks data 0 mask quad) (the-as uint128 0))
(set! (-> v1-2 masks data 1 mask quad) (the-as uint128 0))
(set! (-> v1-2 masks data 2 mask quad) (the-as uint128 0))
0
)
)
)
(none)
)
(defmethod init! ((this texture-anim-array))
(dotimes (s5-0 (-> this length))
(init-textures! (-> this array-data s5-0))
)
this
)
(defmethod clear! ((this texture-anim-array))
(dotimes (s5-0 (-> this length))
(clear-textures! (-> this array-data s5-0))
)
this
)
;; og:preserve-this added macro
(defmacro assert-symbol-is-function (sym)
`(begin
(let ((sym-val (-> (the symbol ,sym) value)))
(when (zero? sym-val)
(format 0 "symbol ~A is 0~%" ,sym)
(break!)
)
(when (and sym-val (!= function (rtype-of sym-val)))
(format 0 "symbol ~A is not a function~%" ,sym)
(break!)
)
)
)
)
;; definition for method 9 of type texture-anim
;; INFO: Used lq/sq
(defmethod init-textures! ((this texture-anim))
(local-vars (a3-3 uint128) (sv-16 texture-page))
(when (logtest? (the-as int (-> this func)) 1)
(assert-symbol-is-function (-> this func)) ;; added
(set! (-> this func) (the-as (function dma-buffer texture-anim int) (-> (the-as symbol (-> this func)) value)))
)
(when (logtest? (the-as int (-> this init-func)) 1)
;; og:preserve-this added
(assert-symbol-is-function (-> this init-func))
(set! (-> this init-func) (the-as (function texture-anim int) (-> (the-as symbol (-> this init-func)) value)))
(if (-> this init-func)
((-> this init-func) this)
)
)
(when (-> this tex-name)
(set! sv-16 (the-as texture-page #f))
(let ((a0-3 (lookup-level-texture-by-name (-> this tex-name) (-> *level* loading-level) (& sv-16))))
(set! (-> this tex) a0-3)
(when (and a0-3 sv-16)
0
(cond
((= (-> a0-3 psm) (gs-psm mt8))
(let ((v1-20 (-> a0-3 clutdest)))
(when (!= v1-20 (* (/ (the-as int v1-20) 32) 32))
(let* ((v1-22 (-> sv-16 segment 2))
(a1-5 (+ (-> v1-22 dest) (-> v1-22 size)))
(a0-7 2048)
)
(set! (-> this tex clutdest) (* (shr (+ a1-5 2047) 11) 32))
(+! (-> sv-16 size) a0-7)
(+! (-> v1-22 size) a0-7)
)
)
)
)
((= (-> a0-3 psm) (gs-psm ct32))
(let ((v1-24 (-> a0-3 dest 0)))
(when (!= v1-24 (* (/ (the-as int v1-24) 32) 32))
(let* ((v1-26 (-> sv-16 segment 2))
(a1-19 (+ (-> v1-26 dest) (-> v1-26 size)))
(a0-12 (shl (sar (+ (* (-> a0-3 w) (-> a0-3 h)) 2047) 11) 11))
)
(set! (-> this tex dest 0) (* (shr (+ a1-19 2047) 11) 32))
(+! (-> sv-16 size) a0-12)
(+! (-> v1-26 size) a0-12)
)
)
)
)
)
)
)
)
(dotimes (s5-0 (the-as int (-> this num-layers)))
(initialize-texture! (-> this data s5-0))
)
(let ((v1-34 (-> this tex)))
(when v1-34
(dotimes (a0-15 3)
(set! (-> v1-34 masks data a0-15 mask quad) (the-as uint128 0))
)
(dotimes (a0-18 (the-as int (-> this num-layers)))
(let ((a1-33 (-> this data a0-18 tex)))
(when a1-33
(dotimes (a2-8 3)
(let ((a3-2 (-> v1-34 masks data a2-8 mask quad))
(t0-2 (-> a1-33 masks data a2-8 mask quad))
)
(.por a3-3 a3-2 t0-2)
)
(set! (-> v1-34 masks data a2-8 mask quad) a3-3)
)
)
)
)
)
)
this
)
(defmethod clear-textures! ((this texture-anim))
(set! (-> this tex) #f)
(dotimes (s5-0 (the-as int (-> this num-layers)))
(clear-texture! (-> this data s5-0))
)
this
)
(defmethod initialize-texture! ((this texture-anim-layer))
(when (logtest? (the-as int (-> this func)) 1)
;; og:preserve-this added
(assert-symbol-is-function (-> this func))
(set! (-> this func) (the-as
(function dma-buffer uint int int texture-anim-layer float int)
(-> (the-as symbol (-> this func)) value)
)
)
)
(when (logtest? (the-as int (-> this init-func)) 1)
;; og:preserve-this added
(assert-symbol-is-function (-> this init-func))
(set! (-> this init-func)
(the-as (function texture-anim-layer int) (-> (the-as symbol (-> this init-func)) value))
)
(if (-> this init-func)
((-> this init-func) this)
)
)
(if (-> this tex-name)
(set! (-> this tex)
(lookup-level-texture-by-name (-> this tex-name) (-> *level* loading-level) (the-as (pointer texture-page) #f))
)
)
this
)
(defmethod clear-texture! ((this texture-anim-layer))
(set! (-> this tex) #f)
this
)
Reference in New Issue View Git Blame Copy Permalink