;;-*-Lisp-*-
(in-package goal)

;; name: texture-anim-funcs.gc
;; name in dgo: texture-anim-funcs
;; dgos: GAME

(define *fog-texture-work* (new 'static 'fog-texture-work :const (new 'static 'vector :x 0.00390625)))

;; DECOMP BEGINS

(defun noise-texture-anim-layer-func ((arg0 dma-buffer) (arg1 uint) (arg2 int) (arg3 int) (arg4 texture-anim-layer) (arg5 float))
  (format 0 "unsupported noise-texture-anim-layer-func~%")
  (break!)
  0
  )

(defun cloud-texture-anim-layer-func ((arg0 dma-buffer) (arg1 uint) (arg2 int) (arg3 int) (arg4 texture-anim-layer) (arg5 float))
  (format 0 "unsupported cloud-texture-anim-layer-func~%")
  (break!)
  0
  )

(defun cloud-texture-anim-func ((arg0 dma-buffer) (arg1 texture-anim))
  (format 0 "unsupported cloud-texture-anim-func~%")
  (break!)
  0
  )

(defun fog-texture-anim-init ((arg0 texture-anim))
  (let ((gp-0 (new 'loading-level 'fog8x256))
        (s4-0 (new 'loading-level 'clut16x16))
        )
    (when (and gp-0 s4-0)
      (let ((v1-5 (new 'loading-level 'texture)))
        (let ((a0-4 (the int (-> arg0 extra x)))
              (a1-3 (the int (-> arg0 extra y)))
              )
          (set! (-> arg0 tex) v1-5)
          (set! (-> v1-5 pad 0) (the-as uint gp-0))
          (set! (-> v1-5 pad 1) (the-as uint s4-0))
          (set! (-> v1-5 w) 256)
          (set! (-> v1-5 h) 1)
          (set! (-> v1-5 num-mips) (the-as uint 1))
          (set! (-> v1-5 psm) (gs-psm mt8))
          (set! (-> v1-5 clutpsm) (the-as uint 0))
          (set! (-> v1-5 dest 0) (the-as uint (* a0-4 32)))
          (set! (-> v1-5 clutdest) (the-as uint (* a1-3 32)))
          )
        (set! (-> v1-5 width 0) (the-as uint 4))
        (set! (-> v1-5 masks data 0 mask quad) (the-as uint128 0))
        (set! (-> v1-5 masks data 1 mask quad) (the-as uint128 0))
        (set! (-> v1-5 masks data 2 mask quad) (the-as uint128 0))
        )
      0
      (dotimes (v1-7 256)
        (nop!)
        (nop!)
        (nop!)
        (nop!)
        (set! (-> gp-0 image v1-7) (the-as uint v1-7))
        )
      )
    )
  0
  )

(define *fog-texture-work* (new 'static 'fog-texture-work :const (new 'static 'vector :x 0.00390625)))


(defun real-fog-texture-anim-func ((arg0 dma-buffer) (arg1 texture-anim))
  (local-vars (v1-11 float))
  (rlet ((vf1 :class vf)
         (vf2 :class vf)
         )
    (let ((s4-0 (new 'stack-no-clear 'vector))
          (s3-0 (new 'stack-no-clear 'vector))
          (s1-0 *fog-texture-work*)
          (s2-0 (the-as (pointer uint32) (-> arg1 tex pad 1)))
          )
      (let ((v1-1 (-> s1-0 color)))
        (dotimes (a0-1 256)
          (set! (-> s2-0 a0-1) (the-as uint v1-1))
          )
        )
      (vector+! (-> s1-0 max-corner) (the-as vector (-> s1-0 corner)) (-> s1-0 corner 1))
      (vector-float*! (-> s1-0 max-corner) (-> s1-0 max-corner) 0.5)
      (vector+! (-> s1-0 min-corner) (-> s1-0 corner 2) (-> s1-0 corner 3))
      (vector-float*! (-> s1-0 min-corner) (-> s1-0 min-corner) 0.5)
      (when (< (-> s1-0 max-corner y) (-> s1-0 min-corner y))
        (.lvf vf1 (&-> s1-0 min-corner quad))
        (.lvf vf2 (&-> s1-0 max-corner quad))
        (.svf (&-> s1-0 max-corner quad) vf1)
        (.svf (&-> s1-0 min-corner quad) vf2)
        (.mov v1-11 vf2)
        )
      (let* ((f0-3 (-> s1-0 corner 0 y))
             (f2-0 (-> s1-0 corner 1 y))
             (f1-1 (fmin f0-3 f2-0))
             (f2-1 (fmax f0-3 f2-0))
             (f3-0 (-> s1-0 corner 2 y))
             (f0-4 (-> s1-0 corner 3 y))
             (f1-3 (fmin (fmin f1-1 f3-0) f0-4))
             (f0-5 (fmax (fmax f2-1 f3-0) f0-4))
             )
        (set! (-> s1-0 min-corner y) f1-3)
        (set! (-> s1-0 max-corner y) f0-5)
        )
      (set! (-> s4-0 quad) (-> s1-0 min-corner quad))
      (vector-! s3-0 (-> s1-0 max-corner) (-> s1-0 min-corner))
      (vector-float/! s3-0 s3-0 256.0)
      0.0
      0.0
      (let ((f0-9 (fmax 4096.0 (-> *math-camera* trans y)))
            (f1-5 (-> arg1 extra z))
            (f2-3 (-> s1-0 alpha-near))
            (f3-1 (-> s1-0 alpha-far))
            (f4-0 (-> s1-0 alpha-delta))
            (f5-0 (-> s1-0 fog-near))
            (f6-0 (-> s1-0 fog-far))
            (f7-0 (-> s1-0 fog-delta))
            )
        (dotimes (v1-17 256)
          (let* ((f8-0 (-> s4-0 y))
                 (f8-1 (cond
                         ((= f8-0 0.0)
                          f3-1
                          )
                         ((< f8-0 0.0)
                          (let ((f9-4 (fmin f6-0 (/ (* f0-9 (vector-length s4-0)) (- f8-0)))))
                            (+ f2-3 (* f4-0 (/ (fmax 0.0 (- f9-4 f5-0)) f7-0)))
                            )
                          )
                         (else
                           (let ((f9-8 (fmin f6-0 (/ (* f1-5 (vector-length s4-0)) f8-0))))
                             (+ f2-3 (* f4-0 (/ (fmax 0.0 (- f9-8 f5-0)) f7-0)))
                             )
                           )
                         )
                       )
                 )
            (set! (-> s2-0 (-> *clut-translate* v1-17))
                  (logior (logand (-> s2-0 (-> *clut-translate* v1-17)) (the-as uint #xffffffff00ffffff))
                          (shr (shl (the int (* 128.0 f8-1)) 56) 32)
                          )
                  )
            )
          (vector+! s4-0 s4-0 s3-0)
          )
        )
      )
    (let ((s5-1 (-> arg1 tex))
          (v1-20 *display*)
          (a0-26 144)
          )
      (+! (-> v1-20 mem-reserve-size) a0-26)
      (the-as
        int
        (when (not (-> v1-20 dma-buffer-overflow))
          (let ((a2-3 (-> v1-20 frames (-> v1-20 on-screen) global-buf)))
            (if (< (-> a2-3 real-buffer-end) (the-as int (&+ (-> a2-3 base) a0-26)))
                (set! (-> v1-20 dma-buffer-overflow) #t)
                )
            )
          (when (not (-> v1-20 dma-buffer-overflow))
            ;; PC port of texture upload:
            (pc-texture-anim-flag upload-generic-vram arg0 :qwc 1)
            (let ((upload-record (the texture-anim-pc-upload (-> arg0 base))))
              (set! (-> upload-record data) (the-as pointer (-> s5-1 pad 0))) ;; the texture data
              (set! (-> upload-record width) (-> s5-1 w)) ;; see fog-texture-anim-init, there's not cropping.
              (set! (-> upload-record height) (-> s5-1 h))
              (set! (-> upload-record dest) (-> s5-1 dest 0))
              (set! (-> upload-record format) (-> s5-1 psm))
              (set! (-> upload-record force-to-gpu) 1)
              )
            (&+! (-> arg0 base) 16)
            ;; original upload
            ; (dma-buffer-add-gs-set arg0
            ;                        (bitbltbuf
            ;                          (new 'static 'gs-bitbltbuf :dpsm (the-as int (-> s5-1 psm)) :dbp (-> s5-1 dest 0) :dbw (-> s5-1 width 0))
            ;                          )
            ;                        (trxpos (new 'static 'gs-trxpos))
            ;                        (trxreg (new 'static 'gs-trxreg :rrw (-> s5-1 w) :rrh (-> s5-1 h)))
            ;                        (trxdir (new 'static 'gs-trxdir))
            ;                        )
            ; (dma-buffer-add-ref-texture arg0 (the-as pointer (-> s5-1 pad 0)) (-> s5-1 w) (-> s5-1 h) (-> s5-1 psm))


            ;; PC port of clut upload
            ;;(upload-vram-data arg0 (the-as int (-> s5-1 clutdest)) (the-as pointer (-> s5-1 pad 1)) 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 (-> s5-1 pad 1))) ;; the clut16x16 object
              (set! (-> upload-record width) 16)
              (set! (-> upload-record height) 16)
              (set! (-> upload-record dest) (-> s5-1 clutdest))
              (set! (-> upload-record format) (gs-psm ct32))
              )
            (&+! (-> arg0 base) 16)
            (set! (-> *texture-pool* ids (shr (-> s5-1 clutdest) 6)) (the-as uint 0))
            ; (let* ((v1-29 arg0)
            ;        (a0-39 (-> v1-29 base))
            ;        )
            ;   (set! (-> (the-as (pointer int64) a0-39)) #x10000002)
            ;   (s.w! (+ a0-39 8) 0)
            ;   (let ((a1-52 #x50000002))
            ;     (s.w! (+ a0-39 12) a1-52)
            ;     )
            ;   (set! (-> v1-29 base) (&+ a0-39 16))
            ;   )
            ; (let* ((v1-30 arg0)
            ;        (a0-41 (-> v1-30 base))
            ;        )
            ;   (set! (-> (the-as (pointer uint64) a0-41)) (make-u128 0 (the-as uint #x1000000000008001)))
            ;   (let ((a1-55 (the-as uint #xeeeeeeeeeeeeeeee)))
            ;     (s.d! (+ a0-41 8) a1-55)
            ;     )
            ;   (set! (-> v1-30 base) (&+ a0-41 16))
            ;   )
            ; (let ((v1-31 (-> arg0 base)))
            ;   (set! (-> (the-as (pointer int64) v1-31)) 0)
            ;   (let ((a0-43 63))
            ;     (s.d! (+ v1-31 8) a0-43)
            ;     )
            ;   (set! (-> arg0 base) (&+ v1-31 16))
            ;   )
            (let ((v1-34 (shr (-> s5-1 dest 0) 6)))
              (dotimes (a0-44 3)
                (set! (-> *texture-pool* ids (+ v1-34 a0-44)) (the-as uint 0))
                )
              )
            #f
            )
          )
        )
      )
    )
  )

(defun fog-texture-anim-func ((arg0 dma-buffer) (arg1 texture-anim))
  (real-fog-texture-anim-func arg0 arg1)
  )
