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

;; name: bsp.gc
;; name in dgo: bsp
;; dgos: GAME

;; DECOMP BEGINS

;; WARN: Return type mismatch bsp-header vs none.
(defun mem-usage-bsp-tree ((arg0 bsp-header) (arg1 bsp-node) (arg2 memory-usage-block) (arg3 int))
  "Recursively compute memory usage of bsp-tree."
  (cond
    ((zero? arg1)
     )
    (else
      (+! (-> arg2 data 61 count) 1)
      (let ((v1-3 20))
        (+! (-> arg2 data 61 used) v1-3)
        (+! (-> arg2 data 61 total) v1-3)
        )
      (if (zero? (-> arg1 front-box-min w))
          (mem-usage-bsp-tree arg0 (-> arg0 nodes (-> arg1 front)) arg2 arg3)
          )
      (when (zero? (-> arg1 back-box-min w))
        (if (> (-> arg1 back) 0)
            (mem-usage-bsp-tree arg0 (-> arg0 nodes (-> arg1 back)) arg2 arg3)
            )
        )
      )
    )
  (none)
  )

(defmethod mem-usage ((this bsp-header) (usage memory-usage-block) (flags int))
  (set! (-> usage work-bsp) this)
  (when (nonzero? (-> this info))
    (set! (-> usage length) (max 86 (-> usage length)))
    (set! (-> usage data 85 name) "array")
    (+! (-> usage data 85 count) 1)
    (let ((v1-8 (asize-of (-> this info))))
      (+! (-> usage data 85 used) v1-8)
      (+! (-> usage data 85 total) (logand -16 (+ v1-8 15)))
      )
    )
  (if (nonzero? (-> this drawable-trees))
      (mem-usage (-> this drawable-trees) usage flags)
      )
  (if (nonzero? (-> this collide-hash))
      (mem-usage (-> this collide-hash) usage flags)
      )
  (set! (-> usage length) (max 66 (-> usage length)))
  (set! (-> usage data 44 name) "entity")
  (set! (-> usage data 45 name) "camera")
  (set! (-> usage data 65 name) "pat")
  (set! (-> usage data 61 name) "bsp-node")
  (set! (-> usage length) (max 60 (-> usage length)))
  (set! (-> usage data 59 name) "bsp-main")
  (+! (-> usage data 59 count) 1)
  (let ((v1-31 400))
    (+! (-> usage data 59 used) v1-31)
    (+! (-> usage data 59 total) (logand -16 (+ v1-31 15)))
    )
  (set! (-> usage length) (max 63 (-> usage length)))
  (set! (-> usage data 62 name) "bsp-leaf-vis-self")
  (+! (-> usage data 62 count) 1)
  (let ((v1-40 (-> this visible-list-length)))
    (+! (-> usage data 62 used) v1-40)
    (+! (-> usage data 62 total) (logand -16 (+ v1-40 15)))
    )
  (set! (-> usage length) (max 61 (-> usage length)))
  (set! (-> usage data 60 name) "bsp-misc")
  (+! (-> usage data 60 count) 1)
  (let ((v1-50 (* (-> this texture-remap-table-len) 8)))
    (+! (-> usage data 60 used) v1-50)
    (+! (-> usage data 60 total) (logand -16 (+ v1-50 15)))
    )
  (set! (-> usage length) (max 61 (-> usage length)))
  (set! (-> usage data 60 name) "bsp-misc")
  (+! (-> usage data 60 count) 1)
  (let ((v1-60 (* (-> this texture-page-count) 4)))
    (+! (-> usage data 60 used) v1-60)
    (+! (-> usage data 60 total) (logand -16 (+ v1-60 15)))
    )
  (when (nonzero? (-> this unknown-basic))
    (set! (-> usage length) (max 61 (-> usage length)))
    (set! (-> usage data 60 name) "bsp-misc")
    (+! (-> usage data 60 count) 1)
    (let ((v1-72 (asize-of (-> this unknown-basic))))
      (+! (-> usage data 60 used) v1-72)
      (+! (-> usage data 60 total) (logand -16 (+ v1-72 15)))
      )
    )
  (when (nonzero? (-> this actor-birth-order))
    (set! (-> usage length) (max 61 (-> usage length)))
    (set! (-> usage data 60 name) "bsp-misc")
    (+! (-> usage data 60 count) 1)
    (let ((v1-85 (* (-> this actors length) 4)))
      (+! (-> usage data 60 used) v1-85)
      (+! (-> usage data 60 total) (logand -16 (+ v1-85 15)))
      )
    )
  (+! (-> usage data 65 count) (-> this pat-length))
  (let ((v1-92 (* (-> this pat-length) 4)))
    (+! (-> usage data 65 used) v1-92)
    (+! (-> usage data 65 total) (logand -16 (+ v1-92 15)))
    )
  (if (nonzero? (-> this hfrag-drawable))
      (mem-usage (-> this hfrag-drawable) usage flags)
      )
  (when (nonzero? (-> this region-trees))
    (let* ((s3-0 (-> this region-trees length))
           (s2-0 0)
           (a0-40 (-> this region-trees s2-0))
           )
      (while (< s2-0 s3-0)
        (mem-usage a0-40 usage (logior flags 128))
        (+! s2-0 1)
        (set! a0-40 (-> this region-trees s2-0))
        )
      )
    )
  (let ((s3-1 (-> this cameras)))
    (when (nonzero? s3-1)
      (dotimes (s2-1 (-> s3-1 length))
        (mem-usage (-> s3-1 s2-1) usage (logior flags 256))
        )
      )
    )
  (if (nonzero? (-> this nodes))
      (mem-usage-bsp-tree this (-> this nodes 0) usage flags)
      )
  this
  )

(defmethod login ((this bsp-header))
  "Initialize the object after it is loaded."
  (if (nonzero? (-> this drawable-trees))
      (login (-> this drawable-trees))
      )
  (set! (-> this level tfrag-gs-test)
        (if (logtest? (-> this texture-flags 0) (texture-page-flag alpha-enable))
            (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest greater-equal))
            (new 'static 'gs-test
              :ate #x1
              :atst (gs-atest greater-equal)
              :aref #x26
              :zte #x1
              :ztst (gs-ztest greater-equal)
              )
            )
        )
  (if (nonzero? (-> this hfrag-drawable))
      (login (-> this hfrag-drawable))
      )
  this
  )

(define *test-shrub* 0)

(defmethod draw ((this bsp-header))
  "Draw the drawable, and typically its children.
  This usually means adding stuff to a list to be drawn later, rather than expensive drawing here."

  ;; og:preserve-this
  ;; a lot re-written here.
  (local-vars (a3-4 uint128) (a3-5 uint128))

  (let ((v1-0 (-> this level)))
    (when (-> v1-0 render?)
      (set! *draw-index* (-> v1-0 draw-index))
      (set! (-> *prototype-tie-work* mood) (-> v1-0 mood-context))

      ;; no more artist subdivide settings??

      (let ((a2-0 (/ (+ (-> this visible-list-length) 15) 16)))
        ;; upload vis bits, though I think nothing uses this.
        (__mem-move
          (-> (scratchpad-object terrain-context) work background vis-list)
          (-> v1-0 vis-bits)
          (the uint (* 16 a2-0)))
        ; (dma-send-to-spr-no-flush
        ;   (the-as uint (+ #x3800 #x70000000))
        ;   (the-as uint (-> v1-0 vis-bits))
        ;   (the-as uint a2-0)
        ;   #f
        ;   )
        )

      ;; debug option to flip visibilty
      (when *artist-flip-visible*
        (let ((v1-6 (/ (+ (-> this visible-list-length) 15) 16))
              (a0-10 (-> (scratchpad-object terrain-context) work background vis-list))
              (a1-4 (-> this all-visible-list))
              )
          (dotimes (a2-1 v1-6)
            (let ((a3-3 (-> (the-as (pointer uint128) (+ (the-as uint a0-10) (* a2-1 16))))))
              (.pnor a3-4 a3-3 0)
              )
            (let ((t0-2 (-> (the-as (pointer uint128) (&+ a1-4 (* a2-1 16))))))
              (.pand a3-5 a3-4 t0-2)
              )
            (set! (-> (the-as (pointer uint128) (+ (the-as uint a0-10) (* a2-1 16)))) a3-5)
            )
          )
        )

      ;; load registers. I believe that very very old stuff used this in Jak 1's development,
      ;; but now this is mostly unused. The sphere-cull, guard-band-cull functions rely on these
      ;; being loaded. The only known use is for culling the drawable-error spheres.
      (let ((at-0 *math-camera*))
        (with-vf (vf16 vf17 vf18 vf19 vf20 vf21 vf22 vf23 vf24 vf25 vf26 vf27 vf28 vf29 vf30 vf31)
                 :rw 'write
                 (.lvf vf16 (&-> at-0 plane 0 quad))
                 (.lvf vf17 (&-> at-0 plane 1 quad))
                 (.lvf vf18 (&-> at-0 plane 2 quad))
                 (.lvf vf19 (&-> at-0 plane 3 quad))
                 (.lvf vf20 (&-> at-0 shrub-mat vector 0 quad))
                 (.lvf vf21 (&-> at-0 shrub-mat vector 1 quad))
                 (.lvf vf22 (&-> at-0 shrub-mat vector 2 quad))
                 (.lvf vf23 (&-> at-0 shrub-mat trans quad))
                 (.lvf vf24 (&-> at-0 camera-rot vector 0 quad))
                 (.lvf vf25 (&-> at-0 camera-rot vector 1 quad))
                 (.lvf vf26 (&-> at-0 camera-rot vector 2 quad))
                 (.lvf vf27 (&-> at-0 camera-rot trans quad))
                 (.lvf vf28 (&-> at-0 camera-temp vector 0 quad))
                 (.lvf vf29 (&-> at-0 camera-temp vector 1 quad))
                 (.lvf vf30 (&-> at-0 camera-temp vector 2 quad))
                 (.lvf vf31 (&-> at-0 camera-temp trans quad))
                 )
        )

      (if (nonzero? (-> this drawable-trees))
          (draw (-> this drawable-trees))
          )
      )
    )
  0
  (none)
  )

(defmethod debug-draw ((this bsp-header))
  "Debug-draw a drawable and its children. Typically uses the debug-draw functions."

  ;; This is mostly useless, as almost nothing has debug-draw methods that do anything.
  ;; tfrag/tie might, but they rely on "debug" data in the level that is not present.

  (let ((v1-0 (-> this level)))
    (set! *draw-index* (-> v1-0 draw-index))
    (set! (-> *prototype-tie-work* mood) (-> v1-0 mood-context))
    (let ((a2-0 (/ (+ (-> this visible-list-length) 15) 16)))
      (__mem-move
        (-> (scratchpad-object terrain-context) work background vis-list)
        (-> v1-0 vis-bits)
        (the uint (* a2-0 16)))

      ; (dma-send-to-spr-no-flush
      ;   (the-as uint (+ #x3800 #x70000000))
      ;   (the-as uint (-> v1-0 vis-bits))
      ;   (the-as uint a2-0)
      ;   #f
      ;   )
      )
    )

  (let ((at-0 *math-camera*))
    (with-vf (vf16 vf17 vf18 vf19 vf20 vf21 vf22 vf23 vf24 vf25 vf26 vf27 vf28 vf29 vf30 vf31)
             :rw 'write
             (.lvf vf16 (&-> at-0 plane 0 quad))
             (.lvf vf17 (&-> at-0 plane 1 quad))
             (.lvf vf18 (&-> at-0 plane 2 quad))
             (.lvf vf19 (&-> at-0 plane 3 quad))
             (.lvf vf20 (&-> at-0 shrub-mat vector 0 quad))
             (.lvf vf21 (&-> at-0 shrub-mat vector 1 quad))
             (.lvf vf22 (&-> at-0 shrub-mat vector 2 quad))
             (.lvf vf23 (&-> at-0 shrub-mat trans quad))
             (.lvf vf24 (&-> at-0 camera-rot vector 0 quad))
             (.lvf vf25 (&-> at-0 camera-rot vector 1 quad))
             (.lvf vf26 (&-> at-0 camera-rot vector 2 quad))
             (.lvf vf27 (&-> at-0 camera-rot trans quad))
             (.lvf vf28 (&-> at-0 camera-temp vector 0 quad))
             (.lvf vf29 (&-> at-0 camera-temp vector 1 quad))
             (.lvf vf30 (&-> at-0 camera-temp vector 2 quad))
             (.lvf vf31 (&-> at-0 camera-temp trans quad))
             )
    )

  (if (nonzero? (-> this drawable-trees))
      (debug-draw (-> this drawable-trees))
      )
  0
  (none)

  )

(defmethod collect-stats ((this bsp-header))
  "Collect triangle/perf statistics for rendering.
  This is only called when viewing stats.
  The vis-bits and culling registers are loaded during this time."
  (let ((v1-0 (-> this level))
        (a2-0 (/ (+ (-> this visible-list-length) 15) 16))
        )
    (__mem-move
      (-> (scratchpad-object terrain-context) work background vis-list)
      (-> v1-0 vis-bits)
      (the uint (* a2-0 16)))
    ; (dma-send-to-spr-no-flush
    ;   (the-as uint (+ #x3800 #x70000000))
    ;   (the-as uint (-> v1-0 vis-bits))
    ;   (the-as uint a2-0)
    ;   #f
    ;   )
    )

  ;; these are actually used to cull stuff for computing stats.
  ;; interestingly, while tfrag/tie/shrub drawing is in the "background" system,
  ;; their stat collection is still in drawable.
  (let ((at-0 *math-camera*))
    (with-vf (vf16 vf17 vf18 vf19 vf20 vf21 vf22 vf23 vf24 vf25 vf26 vf27 vf28 vf29 vf30 vf31)
             :rw 'write
             (.lvf vf16 (&-> at-0 plane 0 quad))
             (.lvf vf17 (&-> at-0 plane 1 quad))
             (.lvf vf18 (&-> at-0 plane 2 quad))
             (.lvf vf19 (&-> at-0 plane 3 quad))
             (.lvf vf20 (&-> at-0 shrub-mat vector 0 quad))
             (.lvf vf21 (&-> at-0 shrub-mat vector 1 quad))
             (.lvf vf22 (&-> at-0 shrub-mat vector 2 quad))
             (.lvf vf23 (&-> at-0 shrub-mat trans quad))
             (.lvf vf24 (&-> at-0 camera-rot vector 0 quad))
             (.lvf vf25 (&-> at-0 camera-rot vector 1 quad))
             (.lvf vf26 (&-> at-0 camera-rot vector 2 quad))
             (.lvf vf27 (&-> at-0 camera-rot trans quad))
             (.lvf vf28 (&-> at-0 camera-temp vector 0 quad))
             (.lvf vf29 (&-> at-0 camera-temp vector 1 quad))
             (.lvf vf30 (&-> at-0 camera-temp vector 2 quad))
             (.lvf vf31 (&-> at-0 camera-temp trans quad))
             )
    )
  (if (nonzero? (-> this drawable-trees))
      (collect-stats (-> this drawable-trees))
      )
  (if (nonzero? (-> this hfrag-drawable))
      (collect-stats (-> this hfrag-drawable))
      )
  0
  (none)
  )

;; ERROR: Unsupported inline assembly instruction kind - [srl t3, t3, 24]
;; ERROR: Unsupported inline assembly instruction kind - [srl t2, t2, 24]
(defun bsp-camera-asm ((arg0 bsp-header) (arg1 vector))
  "Determine which 'bsp' leaf cell the camera is in, for precomputed vis.
   The result is stored in the bsp itself."
  (local-vars
    (a2-1 object)
    (a3-0 uint128)
    (a3-1 uint128)
    (a3-2 uint128)
    (a3-3 uint128)
    (t0-5 uint)
    (t2-1 uint)
    (t3-1 int)
    (t4-0 uint128)
    (t5-0 uint128)
    (t6-0 uint128)
    (t7-0 uint128)
    )
  (rlet ((Q :class vf)
         (vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         )
    (init-vf0-vector)
    (nop!)
    (.lvf vf3 (&-> arg0 bsp-scale quad))
    (let ((v1-0 (the-as object (-> arg0 nodes))))
      (.lvf vf1 (&-> arg1 quad))
      (.lvf vf2 (&-> arg0 bsp-offset quad))
      (.sub.vf vf1 vf1 vf2 :mask #b111)
      (.div.vf Q vf0 vf3 :fsf #b11 :ftf #b0)
      (.wait.vf)
      (.mul.vf vf1 vf1 Q :mask #b1)
      (.div.vf Q vf0 vf3 :fsf #b11 :ftf #b1)
      (.wait.vf)
      (.mul.vf vf1 vf1 Q :mask #b10)
      (.div.vf Q vf0 vf3 :fsf #b11 :ftf #b10)
      (.wait.vf)
      (.mul.vf vf1 vf1 Q :mask #b100)
      (let ((a1-1 #xffffff)
            (a2-0 (the-as uint 0))
            )
        (vftoi15.xyzw vf1 vf1)
        (.mov a3-0 vf1)
        (.pw.sra a3-1 a3-0 15)
        (.ppach a3-2 (the-as uint128 0) a3-1)
        (.ppacb a3-3 (the-as uint128 0) a3-2)
        (let ((a3-4 (the-as uint128 (logand (the-as int a3-3) a1-1))))
          (label cfg-1)
          (let ((t1-1 (the-as bsp-node (&+ (the-as pointer v1-0) (+ (* a2-0 16) (* a2-0 4))))))
            (nop!)
            (let ((t3-0 (the-as uint128 (-> t1-1 front-box-min clr))))
              (.pcgtb t6-0 t3-0 a3-4)
              (let ((t0-2 (the-as uint128 (-> t1-1 front-box-max clr))))
                (.pcgtb t4-0 t0-2 a3-4)
                )
              (let ((t2-0 (the-as uint128 (-> t1-1 back-box-min clr))))
                (.pcgtb t7-0 t2-0 a3-4)
                (let ((t0-3 (the-as uint128 (-> t1-1 back-box-max clr))))
                  (.pcgtb t5-0 t0-3 a3-4)
                  )
                (let* ((t0-4 (-> t1-1 front))
                       (t6-1 (lognot (the-as int t6-0)))
                       (t7-1 (lognot (the-as int t7-0)))
                       (t4-1 (logand t6-1 (the-as int t4-0)))
                       (t5-1 (logand t7-1 (the-as int t5-0)))
                       (t4-2 (logand t4-1 a1-1))
                       (t5-2 (logand t5-1 a1-1))
                       )
                  ;(.srl t3-1 (the-as uint t3-0) 24)
                  (set! t3-1 (logand #xffffffff (shr t3-0 24)))
                  (let ((t1-2 (the-as bsp-node (-> t1-1 back))))
                    (b! (= t4-2 a1-1) cfg-4 :delay
                        ;(.srl t2-1 (the-as int t2-0) 24)
                        (set! t2-1 (the uint (logand #xffffffff (shr t2-0 24))))
                        )
                    (b! (= t5-2 a1-1) cfg-7 :delay (set! t0-5 (the-as uint 1)))
                    (b! #t cfg-11 :delay (set! (-> arg0 cam-outside-bsp) t0-5))
                    (label cfg-4)
                    (b! (zero? t3-1) cfg-1 :likely-delay (set! a2-0 (the uint t0-4)))
                    (let ((v1-1 a2-0))
                      (set! (-> arg0 cam-using-back) (the-as uint 0))
                      (b! #t cfg-10 :delay (set! a2-1 t0-4))
                      (label cfg-7)
                      (b! (zero? t2-1) cfg-1 :likely-delay (set! a2-0 (the-as uint t1-2)))
                      (set! v1-1 a2-0)
                      (set! a2-1 t1-2)
                      (set! (-> arg0 cam-using-back) (the-as uint 1))
                      (label cfg-10)
                      (set! (-> arg0 current-leaf-idx) (the-as uint a2-1))
                      (set! (-> arg0 cam-box-idx) (the-as uint v1-1))
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    (set! (-> arg0 cam-outside-bsp) (the-as uint 0))
    (label cfg-11)
    0
    (none)
    )
  )

(defmethod collect-regions ((this bsp-header) (arg0 sphere) (arg1 int) (arg2 region-prim-list))
  "Fill the region-prim-list with regions that intersect the sphere."
  (let ((s3-0 (-> this region-trees)))
    (dotimes (s2-0 (-> s3-0 length))
      ;; note: the use of arg1 here is a bug. it's ignored, so it doesn't matter
      (collect-regions (-> s3-0 s2-0) arg0 arg1 arg2)
      )
    )
  0
  (none)
  )

(defun print-collide-stats ()
  (format *stdcon* "~0k~%count  cycles     instr  icache dcache  vu0/to/from~%")
  (print-to-stream (-> *perf-stats* data 3) "collide" *stdcon*)
  (print-to-stream (-> *perf-stats* data 4) "collide-list" *stdcon*)
  (print-to-stream (-> *perf-stats* data 5) "collide-fill" *stdcon*)
  (format *stdcon* "~0k---------------------------------------------------------------~%")
  (format *stdcon* "~0kcalls  = ~d~%" (-> *collide-stats* calls))
  (format
    *stdcon*
    "~0kspheres  = ~d~256hspheres/call = ~f~%"
    (-> *collide-stats* spheres)
    (/ (the float (-> *collide-stats* spheres)) (the float (-> *collide-stats* calls)))
    )
  (format
    *stdcon*
    "~0knodes    = ~d~256hnodes/call   = ~f~%"
    (-> *collide-stats* nodes)
    (/ (the float (-> *collide-stats* nodes)) (the float (-> *collide-stats* calls)))
    )
  (format
    *stdcon*
    "~0kfrags    = ~d~256hfrags/call   = ~f~%"
    (-> *collide-stats* frags)
    (/ (the float (-> *collide-stats* frags)) (the float (-> *collide-stats* calls)))
    )
  (format
    *stdcon*
    "~0ktris     = ~d~256htris/frag    = ~f~%"
    (-> *collide-stats* tris)
    (/ (the float (-> *collide-stats* tris)) (the float (-> *collide-stats* frags)))
    )
  (format
    *stdcon*
    "~0koutput   = ~d~256houtput/call  = ~f~%"
    (-> *collide-stats* output)
    (/ (the float (-> *collide-stats* output)) (the float (-> *collide-stats* calls)))
    )
  (format *stdcon* "~0k---------------------------------------------------------------~%")
  (let ((gp-0 (stopwatch-elapsed-ticks (the-as stopwatch (&-> *collide-stats* junk 1))))
        (s4-0 (stopwatch-elapsed-ticks (the-as stopwatch (&-> *collide-stats* junk 9))))
        (s5-0 (stopwatch-elapsed-ticks (the-as stopwatch (&-> *collide-stats* junk 17))))
        )
    (format *stdcon* "~0ktotal-target      ~D~%" gp-0)
    (format *stdcon* "~0ktarget-cache-fill ~D ~0,,2f%~%" s4-0 (/ (* 100.0 (the float s4-0)) (the float gp-0)))
    (format *stdcon* "~0ktarget-ray-poly   ~D ~0,,2f%~%" s5-0 (/ (* 100.0 (the float s5-0)) (the float gp-0)))
    )
  (set! (-> *collide-stats* calls) (the-as uint 0))
  (set! (-> *collide-stats* spheres) (the-as uint 0))
  (set! (-> *collide-stats* nodes) (the-as uint 0))
  (set! (-> *collide-stats* frags) (the-as uint 0))
  (set! (-> *collide-stats* tris) (the-as uint 0))
  (set! (-> *collide-stats* output) (the-as uint 0))
  (stopwatch-init (the-as stopwatch (&-> *collide-stats* junk 1)))
  (stopwatch-init (the-as stopwatch (&-> *collide-stats* junk 9)))
  (stopwatch-init (the-as stopwatch (&-> *collide-stats* junk 17)))
  0
  (none)
  )

;; WARN: Return type mismatch uint vs texture-id.
(defun level-remap-texture ((arg0 texture-id))
  "Level tpages combine the tpages of many individual actors.
   Given a texture ID for a texture in an individual actor,
   determine the texture ID for this texture in the level's
   combined page."
  (let ((v1-1 (-> *level* log-in-level-bsp)))
    (when v1-1
      (let* ((a3-0 (-> v1-1 texture-remap-table-len))
             (v1-2 (the-as object (-> v1-1 texture-remap-table)))
             (t0-0 (the-as (pointer uint64) v1-2))
             (a1-1 (the-as uint #xfffffff8))
             (a2-1 (logand (new 'static 'texture-id :index #xfff :page #xfff) arg0))
             (a3-2 (the-as object (&+ t0-0 (* a3-0 8))))
             )
        (label cfg-2)
        (b! (= v1-2 a3-2) cfg-8 :delay (nop!))
        (let ((t0-3 (the-as object (logand (/ (+ (the-as int v1-2) (the-as int a3-2)) 2) a1-1))))
          (let ((t1-1 (- (-> (the-as (pointer uint32) t0-3) 0) a2-1)))
            (b! (zero? t1-1) cfg-7 :delay (nop!))
            (b! (< (the-as int t1-1) 0) cfg-6 :delay (nop!))
            )
          (b! #t cfg-2 :delay (set! a3-2 (the-as (pointer uint64) t0-3)))
          (label cfg-6)
          (b! #t cfg-2 :delay (set! v1-2 (+ (the-as int t0-3) 8)))
          (label cfg-7)
          (set! arg0 (the-as texture-id (logior (-> (the-as (pointer uint32) t0-3) 1) 20)))
          )
        )
      (label cfg-8)
      0
      )
    )
  (the-as texture-id arg0)
  )

(defun build-masks ((arg0 bsp-header))
  "Allocate and assign texture masks, and closest object arrays.
   These are used at runtime to only upload the texture chunks and
   mip levels that are actually needed."
  (let ((v1-0 (-> arg0 drawable-trees))
        (s2-0 (-> arg0 tfrag-mask-count))
        (s3-0 (-> arg0 shrub-mask-count))
        (s4-0 (-> arg0 alpha-mask-count))
        (gp-0 (-> arg0 water-mask-count))
        )
    (when (zero? (+ s2-0 s3-0 s4-0 gp-0))
      (dotimes (a0-5 (-> v1-0 length))
        (let ((a1-2 (-> v1-0 trees a0-5)))
          (cond
            ((= (-> a1-2 type) drawable-tree-tfrag)
             (let* ((a2-5 (-> (the-as drawable-tree-tfrag a1-2) arrays (+ (-> (the-as drawable-tree-tfrag a1-2) length) -1)))
                    (a1-4 (-> a2-5 length))
                    (a2-6 (-> (the-as drawable-inline-array-tfrag a2-5) data))
                    )
               (dotimes (a3-1 a1-4)
                 (set! (-> a2-6 0 texture-masks-index) (the-as uint s2-0))
                 (+! s2-0 1)
                 (set! a2-6 (the-as (inline-array tfragment) (-> a2-6 1)))
                 )
               )
             )
            ((= (-> a1-2 type) drawable-tree-tfrag-trans)
             (let* ((a2-13
                      (-> (the-as drawable-tree-tfrag-trans a1-2) arrays (+ (-> (the-as drawable-tree-tfrag-trans a1-2) length) -1))
                      )
                    (a1-7 (-> a2-13 length))
                    (a2-14 (-> (the-as drawable-inline-array-tfrag a2-13) data))
                    )
               (dotimes (a3-3 a1-7)
                 (set! (-> a2-14 0 texture-masks-index) (the-as uint s4-0))
                 (+! s4-0 1)
                 (set! a2-14 (the-as (inline-array tfragment) (-> a2-14 1)))
                 )
               )
             )
            ((= (-> a1-2 type) drawable-tree-tfrag-water)
             (let* ((a2-21
                      (-> (the-as drawable-tree-tfrag-water a1-2) arrays (+ (-> (the-as drawable-tree-tfrag-water a1-2) length) -1))
                      )
                    (a1-10 (-> a2-21 length))
                    (a2-22 (-> (the-as drawable-inline-array-tfrag a2-21) data))
                    )
               (dotimes (a3-5 a1-10)
                 (set! (-> a2-22 0 texture-masks-index) (the-as uint gp-0))
                 (+! gp-0 1)
                 (set! a2-22 (the-as (inline-array tfragment) (-> a2-22 1)))
                 )
               )
             )
            ((= (-> a1-2 type) drawable-tree-instance-tie)
             (let* ((a1-13 (-> (the-as drawable-tree-instance-tie a1-2) prototypes prototype-array-tie))
                    (a2-26 (-> a1-13 length))
                    )
               (dotimes (a3-7 a2-26)
                 (cond
                   ((logtest? (-> a1-13 array-data a3-7 flags) (prototype-flags tpage-water))
                    (set! (-> a1-13 array-data a3-7 texture-masks-index) (the-as uint gp-0))
                    (+! gp-0 1)
                    )
                   ((logtest? (-> a1-13 array-data a3-7 flags) (prototype-flags tpage-alpha))
                    (set! (-> a1-13 array-data a3-7 texture-masks-index) (the-as uint s4-0))
                    (+! s4-0 1)
                    )
                   (else
                     (set! (-> a1-13 array-data a3-7 texture-masks-index) (the-as uint s2-0))
                     (+! s2-0 1)
                     )
                   )
                 )
               )
             )
            ((= (-> a1-2 type) drawable-tree-instance-shrub)
             (let* ((a2-30 (-> (the-as drawable-tree-instance-shrub a1-2) info prototype-inline-array-shrub))
                    (a1-16 (-> a2-30 length))
                    (a2-31 (-> a2-30 data))
                    )
               (dotimes (a3-9 a1-16)
                 (set! (-> a2-31 0 texture-masks-index) (the-as uint s3-0))
                 (+! s3-0 1)
                 (set! a2-31 (the-as (inline-array prototype-bucket-shrub) (-> a2-31 1)))
                 )
               )
             )
            )
          )
        )
      )
    (when (nonzero? s2-0)
      (set! (-> arg0 tfrag-masks) (new 'loading-level 'texture-masks-array (the-as int s2-0)))
      (set! (-> arg0 tfrag-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* s2-0 4)))))
      (let ((v1-5 (-> arg0 tfrag-masks)))
        (dotimes (a0-8 (the-as int s2-0))
          (let ((a1-24 (-> v1-5 data a0-8)))
            (dotimes (a2-34 3)
              (set! (-> a1-24 data a2-34 mask quad) (the-as uint128 0))
              )
            )
          )
        )
      )
    (when (nonzero? s3-0)
      (set! (-> arg0 shrub-masks) (new 'loading-level 'texture-masks-array (the-as int s3-0)))
      (set! (-> arg0 shrub-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* s3-0 4)))))
      (let ((v1-10 (-> arg0 shrub-masks)))
        (dotimes (a0-11 (the-as int s3-0))
          (let ((a1-32 (-> v1-10 data a0-11)))
            (dotimes (a2-36 3)
              (set! (-> a1-32 data a2-36 mask quad) (the-as uint128 0))
              )
            )
          )
        )
      )
    (when (nonzero? s4-0)
      (set! (-> arg0 alpha-masks) (new 'loading-level 'texture-masks-array (the-as int s4-0)))
      (set! (-> arg0 alpha-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* s4-0 4)))))
      (let ((v1-15 (-> arg0 alpha-masks)))
        (dotimes (a0-14 (the-as int s4-0))
          (let ((a1-40 (-> v1-15 data a0-14)))
            (dotimes (a2-38 3)
              (set! (-> a1-40 data a2-38 mask quad) (the-as uint128 0))
              )
            )
          )
        )
      )
    (when (nonzero? gp-0)
      (set! (-> arg0 water-masks) (new 'loading-level 'texture-masks-array (the-as int gp-0)))
      (set! (-> arg0 water-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* gp-0 4)))))
      (let ((v1-20 (-> arg0 water-masks)))
        (dotimes (a0-17 (the-as int gp-0))
          (let ((a1-48 (-> v1-20 data a0-17)))
            (dotimes (a2-40 3)
              (set! (-> a1-48 data a2-40 mask quad) (the-as uint128 0))
              )
            )
          )
        )
      )
    )
  0
  (none)
  )