jak-project/goal_src/jak3/engine/common-obs/prim-h.gc

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

;; name: prim-h.gc
;; name in dgo: prim-h
;; dgos: GAME

(defenum prim-flags
  :type uint32
  :bitfield #t
  (alpha-blend-enable 0) ;; set by default
  (texture-enable 1) ;; set by default
  (fog-enable 2)
  (pf3 3) ;; auto-clear vertices?
  (pf4 4) ;; has new verts to draw?
  (no-texture-name 5) ;; only has the ID.
  )

(define-extern process-drawable-art-error (state string process-drawable))
(define-extern *prim-engine* engine)

;; DECOMP BEGINS

(deftype prim-vertex (structure)
  "Vertex for the prim renderer. These vertices are generated by
some special effect code, then sent to the prim renderer to be drawn."
  ((stq     vector  :inline)
   (nokick  uint32  :overlay-at (-> stq data 2))
   (col     rgba    :overlay-at (-> stq data 3))
   (pos     vector  :inline)
   )
  )


(deftype prim-base (basic)
  "Base class for prim-strip."
  ()
  (:methods
    (generate-dma! (_type_ matrix) none)
    )
  )


(deftype prim-strip (prim-base)
  "A collection of vertices, all with the same texture and draw settings.
These are owned by the thing submitting to prim, not the prim renderer itself."
  ((flags                prim-flags)
   (tex-name             basic)
   (num-verts            uint16)
   (allocated-num-verts  uint16)
   (tex-id               texture-id)
   (adnops               gs-adcmd     2 :inline)
   (data0                gs-test      :overlay-at (-> adnops 0 word 0))
   (reg0                 gs-reg64     :overlay-at (-> adnops 0 word 2))
   (data1                gs-test      :offset  48)
   (reg1                 gs-reg64     :offset  56)
   (clamp                gs-clamp)
   (alpha                gs-alpha)
   (bucket               bucket-id)
   (sink                 uint32)
   (level                level)
   (texture-index        uint32)
   (data                 prim-vertex  :inline :dynamic)
   )
  (:methods
    (new (symbol type int texture-id string) _type_)
    (setup-dma-and-tex (_type_ draw-control) none)
    )
  )


(defmethod new prim-strip ((allocation symbol) (type-to-make type) (num-vertices int) (tex-id texture-id) (tex-name string))
  "Allocate a new prim-strip and room for vertices. The texture can be specified by name or ID."
  (with-pp
    (let ((s5-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* num-vertices 32))))))
      (if (zero? s5-0)
          (go process-drawable-art-error "prim-strip")
          )
      (add-connection *prim-engine* pp #f pp s5-0 #f)
      (set! (-> s5-0 flags) (prim-flags alpha-blend-enable texture-enable))
      (set! (-> s5-0 num-verts) (the-as uint num-vertices))
      (set! (-> s5-0 allocated-num-verts) (the-as uint num-vertices))
      (set! (-> s5-0 data0) (new 'static 'gs-test))
      (set! (-> s5-0 adnops 0 cmds) (gs-reg64 hack))
      (set! (-> s5-0 data1) (new 'static 'gs-test))
      (set! (-> s5-0 adnops 1 cmds) (gs-reg64 hack))
      (set! (-> s5-0 clamp) (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
      (set! (-> s5-0 alpha) (new 'static 'gs-alpha :b #x1 :d #x1))
      (cond
        (tex-name
          (set! (-> s5-0 tex-id) (lookup-texture-id-by-name tex-name (the-as string #f)))
          (set! (-> s5-0 tex-name) tex-name)
          (logclear! (-> s5-0 flags) (prim-flags no-texture-name))
          )
        (else
          (set! (-> s5-0 tex-id) tex-id)
          (set! (-> s5-0 tex-name) #f)
          (logior! (-> s5-0 flags) (prim-flags no-texture-name))
          )
        )
      (set! (-> s5-0 bucket) (bucket-id gmerc2-lcom-water))
      (set! (-> s5-0 sink) (the-as uint 64))
      (set! (-> s5-0 level) (-> *level* level-default))
      (set! (-> s5-0 texture-index) (the-as uint 4))
      (let ((f0-1 (/ 1.0 (the float (/ (+ num-vertices -1) 2)))))
        (dotimes (v1-24 num-vertices)
          (let ((a0-7 (-> s5-0 data v1-24)))
            (set! (-> a0-7 stq x) (* (the float (/ v1-24 2)) f0-1))
            (set! (-> a0-7 stq y) (the float (logand v1-24 1)))
            (set! (-> a0-7 stq z) 0.0)
            (set! (-> a0-7 col) (the-as rgba 0.0))
            )
          (set! (-> s5-0 data v1-24 col) (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80))
          (set-vector!
            (the-as vector (+ (the-as uint (the-as vector (-> s5-0 data 0 pos))) (* v1-24 32)))
            (* 4096.0 (the float (/ v1-24 2)))
            (* 4096.0 (the float (logand v1-24 1)))
            0.0
            1.0
            )
          )
        )
      s5-0
      )
    )
  )

;; WARN: Return type mismatch uint vs int.
(defmethod asize-of ((this prim-strip))
  (the-as int (+ (-> this type size) (* (-> this allocated-num-verts) 32)))
  )

(deftype prim-sink (structure)
  ((vertex-count   uint8)
   (control-count  uint8)
   )
  :allow-misaligned
  )


(deftype prim-work (structure)
  ((vertex-tmpl   dma-packet       3 :inline)
   (control-tmpl  dma-packet       2 :inline)
   (giftag        generic-gif-tag  :inline)
   (call-scissor  dma-packet       :inline)
   (call-noclip   dma-packet       :inline)
   (shader        adgif-shader     :inline)
   (mask          vector4w         :inline)
   (in-verts      int32)
   (num-verts     int32)
   (vert-ptr      (inline-array prim-vertex))
   (sinks         prim-sink        68 :inline)
   )
  (:methods
    (reset! (_type_) none)
    )
  )