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

;; this file is debug only
(declare-file (debug))

;; definition for method 9 of type collide-cache
;; WARN: Return type mismatch int vs none.
(defmethod debug-draw ((this collide-cache))
  (let ((gp-0 (the-as object (-> this tris))))
    (countdown (s4-0 (-> this num-tris))
      (let ((t1-0 (copy-and-set-field (-> *pat-mode-info* (-> (the-as collide-cache-tri gp-0) pat mode) color) a 64)))
        (add-debug-flat-triangle
          #t
          (bucket-id debug-no-zbuf1)
          (the-as vector (-> (the-as collide-cache-tri gp-0) vertex))
          (-> (the-as collide-cache-tri gp-0) vertex 1)
          (-> (the-as collide-cache-tri gp-0) vertex 2)
          t1-0
          )
        )
      (set! gp-0 (&+ (the-as collide-cache-tri gp-0) 64))
      )
    )
  (let ((gp-1 (the-as object (-> this prims))))
    (countdown (s5-1 (-> this num-prims))
      (when (= (-> (the-as collide-cache-prim gp-1) prim-core prim-type) (prim-type sphere))
        (let ((t0-1
                (copy-and-set-field
                  (-> *pat-mode-info*
                      (-> (the-as collide-shape-prim-sphere (-> (the-as collide-shape-prim gp-1) prim-core action)) pat mode)
                      color
                      )
                  a
                  64
                  )
                )
              )
          (add-debug-sphere
            #t
            (bucket-id debug-no-zbuf1)
            (the-as vector (-> (the-as collide-cache-prim gp-1) prim-core))
            (-> (the-as collide-cache-prim gp-1) prim-core world-sphere w)
            t0-1
            )
          )
        )
      (set! gp-1 (&+ (the-as collide-cache-prim gp-1) 48))
      )
    )
  (print-collide-cache-tri-count)
  0
  (none)
  )

;; definition of type col-rend-filter
(deftype col-rend-filter (structure)
  ((show-pat-set    pat-surface)
   (show-pat-clear  pat-surface)
   (event-mask      uint32)
   )
  )

;; definition for method 3 of type col-rend-filter
(defmethod inspect ((this col-rend-filter))
  (when (not this)
    (set! this this)
    (goto cfg-4)
    )
  (format #t "[~8x] ~A~%" this 'col-rend-filter)
  (format #t "~1Tshow-pat-set: ~D~%" (-> this show-pat-set))
  (format #t "~1Tshow-pat-clear: ~D~%" (-> this show-pat-clear))
  (format #t "~1Tevent-mask: ~D~%" (-> this event-mask))
  (label cfg-4)
  this
  )

;; definition for function col-rend-draw
;; INFO: Used lq/sq
;; WARN: Return type mismatch symbol vs none.
(defun col-rend-draw ((arg0 col-rend) (arg1 col-rend-filter))
  (let ((s4-0 (new 'stack-no-clear 'matrix)))
    (set! (-> s4-0 vector 0 quad) (-> (math-camera-matrix) vector 2 quad))
    (vector-normalize! (the-as vector (-> s4-0 vector)) 1.0)
    (let ((s3-1 (the-as collide-cache-tri (-> *collide-cache* tris))))
      (countdown (s2-0 (-> *collide-cache* num-tris))
        (vector-3pt-cross! (-> s4-0 vector 1) (the-as vector (-> s3-1 vertex)) (-> s3-1 vertex 1) (-> s3-1 vertex 2))
        (vector-normalize! (-> s4-0 vector 1) 1.0)
        (when (or (-> arg0 show-back-faces?) (>= 0.0 (vector-dot (the-as vector (-> s4-0 vector)) (-> s4-0 vector 1))))
          (let ((v1-9 (-> s3-1 pat)))
            (cond
              ((and (or (zero? (-> arg1 show-pat-set)) (logtest? v1-9 (-> arg1 show-pat-set)))
                    (or (zero? (-> arg1 show-pat-clear)) (not (logtest? v1-9 (-> arg1 show-pat-clear))))
                    (or (zero? (-> arg1 event-mask)) (logtest? (-> arg1 event-mask) (ash 1 (-> v1-9 event))))
                    )
               (let ((t1-0 (copy-and-set-field (-> *pat-mode-info* (-> v1-9 mode) color) a 64)))
                 (add-debug-flat-triangle
                   #t
                   (bucket-id debug-no-zbuf1)
                   (the-as vector (-> s3-1 vertex))
                   (-> s3-1 vertex 1)
                   (-> s3-1 vertex 2)
                   t1-0
                   )
                 )
               (if (-> arg0 outline?)
                   (add-debug-outline-triangle
                     #t
                     (bucket-id debug-no-zbuf1)
                     (the-as vector (-> s3-1 vertex))
                     (-> s3-1 vertex 1)
                     (-> s3-1 vertex 2)
                     (new 'static 'rgba :r #x10 :g #x10 :b #x10 :a #x80)
                     )
                   )
               (when (-> arg0 show-normals?)
                 (vector+! (-> s4-0 vector 2) (the-as vector (-> s3-1 vertex)) (-> s3-1 vertex 1))
                 (vector+! (-> s4-0 vector 2) (-> s4-0 vector 2) (-> s3-1 vertex 2))
                 (vector-float/! (-> s4-0 vector 2) (-> s4-0 vector 2) 3.0)
                 (add-debug-vector
                   #t
                   (bucket-id debug-no-zbuf1)
                   (-> s4-0 vector 2)
                   (-> s4-0 vector 1)
                   (meters 0.75)
                   (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80)
                   )
                 )
               )
              ((-> arg0 ghost-hidden?)
               (add-debug-flat-triangle
                 #t
                 (bucket-id debug-no-zbuf1)
                 (the-as vector (-> s3-1 vertex))
                 (-> s3-1 vertex 1)
                 (-> s3-1 vertex 2)
                 (new 'static 'rgba :r #x20 :g #x20 :b #x20 :a #x20)
                 )
               (if (-> arg0 outline?)
                   (add-debug-outline-triangle
                     #t
                     (bucket-id debug-no-zbuf1)
                     (the-as vector (-> s3-1 vertex))
                     (-> s3-1 vertex 1)
                     (-> s3-1 vertex 2)
                     (new 'static 'rgba :r #x10 :g #x10 :b #x10 :a #x10)
                     )
                   )
               )
              )
            )
          )
        (&+! s3-1 64)
        )
      )
    )
  (let ((s5-1 (the-as object (-> *collide-cache* prims))))
    (countdown (s4-1 (-> *collide-cache* num-prims))
      (when (= (-> (the-as collide-cache-prim s5-1) prim-core prim-type) (prim-type sphere))
        (let ((v1-37 (-> (the-as collide-shape-prim-sphere (-> (the-as collide-cache-prim s5-1) prim)) pat)))
          (when (and (or (zero? (-> arg1 show-pat-set)) (logtest? v1-37 (-> arg1 show-pat-set)))
                     (or (zero? (-> arg1 show-pat-clear)) (not (logtest? v1-37 (-> arg1 show-pat-clear))))
                     (or (zero? (-> arg1 event-mask)) (logtest? (-> arg1 event-mask) (ash 1 (-> v1-37 event))))
                     )
            (let ((t0-5 (copy-and-set-field (-> *pat-mode-info* (-> v1-37 mode) color) a 64)))
              (add-debug-sphere
                #t
                (bucket-id debug-no-zbuf1)
                (the-as vector (-> (the-as collide-cache-prim s5-1) prim-core))
                (-> (the-as collide-cache-prim s5-1) prim-core world-sphere w)
                t0-5
                )
              )
            )
          )
        )
      (set! s5-1 (&+ (the-as collide-cache-prim s5-1) 48))
      )
    )
  (none)
  )

;; definition for method 9 of type col-rend
;; INFO: Used lq/sq
(defmethod col-rend-method-9 ((this col-rend))
  (let ((s5-0 (new 'stack-no-clear 'collide-query)))
    (let ((f30-0 (-> this bbox-radius)))
      (let ((v1-0 (-> this track)))
        (cond
          ((zero? v1-0)
           (set! (-> this bbox-center quad) (-> (target-pos 0) quad))
           (+! (-> this bbox-center y) (* 0.7 f30-0))
           )
          ((= v1-0 1)
           (position-in-front-of-camera!
             (-> this bbox-center)
             (+ (-> this camera-to-bbox-dist) (-> this bbox-radius))
             0.0
             )
           )
          )
        )
      (set! (-> s5-0 bbox min quad) (-> this bbox-center quad))
      (set! (-> s5-0 bbox min x) (- (-> s5-0 bbox min x) f30-0))
      (set! (-> s5-0 bbox min y) (- (-> s5-0 bbox min y) f30-0))
      (set! (-> s5-0 bbox min z) (- (-> s5-0 bbox min z) f30-0))
      (set! (-> s5-0 bbox max quad) (-> this bbox-center quad))
      (+! (-> s5-0 bbox max x) f30-0)
      (+! (-> s5-0 bbox max y) f30-0)
      (+! (-> s5-0 bbox max z) f30-0)
      )
    (let ((v1-9 -1))
      (let ((a0-9 (-> this cspec)))
        (if (not (logtest? a0-9 (collide-spec crate)))
            (set! v1-9 (logxor v1-9 1))
            )
        (if (not (logtest? a0-9 (collide-spec civilian)))
            (set! v1-9 (logxor v1-9 64))
            )
        (if (not (logtest? a0-9 (collide-spec enemy)))
            (set! v1-9 (logxor #x80000 v1-9))
            )
        (if (not (logtest? a0-9 (collide-spec obstacle)))
            (set! v1-9 (logxor v1-9 2))
            )
        (if (not (logtest? a0-9 (collide-spec vehicle-sphere)))
            (set! v1-9 (logand #x80743 v1-9))
            )
        )
      (set! (-> s5-0 collide-with) (the-as collide-spec v1-9))
      )
    (set! (-> s5-0 ignore-pat) (new 'static 'pat-surface))
    (set! (-> s5-0 ignore-process0) #f)
    (set! (-> s5-0 ignore-process1) #f)
    (add-debug-box
      #t
      (bucket-id debug2)
      (the-as vector (-> s5-0 bbox))
      (-> s5-0 bbox max)
      (if (logtest? (current-time) 128)
          (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x20)
          (new 'static 'rgba :a #x20)
          )
      )
    (fill-using-bounding-box *collide-cache* s5-0)
    )
  (let ((s5-1 (-> this show-only))
        (a1-17 (new 'stack 'col-rend-filter))
        )
    (when (nonzero? s5-1)
      (cond
        ((logtest? s5-1 8)
         (set! (-> a1-17 show-pat-clear) (new 'static 'pat-surface :noboard #x1))
         )
        ((logtest? s5-1 16)
         (set! (-> a1-17 show-pat-clear) (new 'static 'pat-surface :nogrind #x1))
         )
        ((logtest? s5-1 32)
         (set! (-> a1-17 show-pat-clear) (new 'static 'pat-surface :nogrind #x1))
         (set! (-> a1-17 show-pat-set) (new 'static 'pat-surface :nojak #x1))
         )
        (else
          (if (logtest? s5-1 8192)
              (logior! (-> a1-17 show-pat-set) (new 'static 'pat-surface :nolineofsight #x1))
              )
          (if (logtest? s5-1 1024)
              (set! (-> a1-17 show-pat-set noentity) 1)
              )
          (if (logtest? s5-1 64)
              (set! (-> a1-17 show-pat-set noboard) 1)
              )
          (if (logtest? s5-1 2048)
              (set! (-> a1-17 show-pat-set nogrind) 1)
              )
          (if (logtest? s5-1 128)
              (set! (-> a1-17 show-pat-set nocamera) 1)
              )
          (if (logtest? s5-1 4096)
              (set! (-> a1-17 show-pat-set nojak) 1)
              )
          (if (logtest? s5-1 256)
              (set! (-> a1-17 show-pat-set noedge) 1)
              )
          (if (logtest? s5-1 #x8000)
              (set! (-> a1-17 show-pat-set nopilot) 1)
              )
          (if (logtest? s5-1 512)
              (logior! (-> a1-17 show-pat-set) (new 'static 'pat-surface :noendlessfall #x1))
              )
          (if (logtest? s5-1 #x4000)
              (logior! (-> a1-17 show-pat-set) (new 'static 'pat-surface :nomech #x1))
              )
          (if (logtest? #x10000 s5-1)
              (logior! (-> a1-17 show-pat-set) (new 'static 'pat-surface :noproj #x1))
              )
          (if (logtest? #x40000 s5-1)
              (logior! (-> a1-17 show-pat-set) (new 'static 'pat-surface :probe #x1))
              )
          (if (logtest? #x20000 s5-1)
              (logior! (-> a1-17 event-mask) 64)
              )
          )
        )
      )
    (col-rend-draw this a1-17)
    )
  (none)
  )