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

;; name: texture-h.gc
;; name in dgo: texture-h
;; dgos: GAME, ENGINE

;; The texture system manages:
;;  - VRAM allocation and uploads
;;  - the texture page directory
;;  - adgif shaders

;; There are a lot more details, see texture.gc for more info


;;;;;;;;;;;;;;;;;;;;;;
;; Texture Control
;;;;;;;;;;;;;;;;;;;;;;

;; There are different kinds of texture pages for the different renderers
(defenum tpage-kind
    :type uint32
    :bitfield #f
    (tfrag 0)  ;; background
    (pris 1)   ;; foreground
    (shrub 2)  ;; shrubs/sprites
    (alpha 3)  ;; effects
    (water 4)  ;; non-ocean water (fj rivers, water near farmer)
    )

;; bitmask for enabled tpage-kinds (changed in debug menu)
(define *texture-enable-user-menu* #x1f)

;; enabled textures (drawable.gc updates this from reading *texture-enable-user-menu*)
(define *texture-enable-user* 0)

;; Any individual texture can be uniquely identified with a texture-id.
(deftype texture-id (uint32)
  ((index  uint16 :offset 8  :size 12) ;; index of texture in its tpage
   (page   uint16 :offset 20 :size 12) ;; tpage number
   )
  :method-count-assert 9
  :size-assert         #x4
  :flag-assert         #x900000004
  )


;;;;;;;;;;;;;;;;;;;
;; Texture Pool
;;;;;;;;;;;;;;;;;;;

;; A texture-pool-segment is a chunk of VRAM used to store textures
(deftype texture-pool-segment (structure)
  ((dest uint32  :offset-assert 0) ;; VRAM address (4-byte VRAM words)
   (size uint32  :offset-assert 4) ;; size in 4-byte VRAM words
   )
  :pack-me
  :method-count-assert 9
  :size-assert         #x8
  :flag-assert         #x900000008
  )

(declare-type texture-page basic)
(declare-type level basic)

;; There is a single texture-pool which manages storing textures in VRAM
(deftype texture-pool (basic)
  ((top              int32    :offset-assert 4) ;; seems be 0 always, start of VRAM managed by pool
   (cur              int32    :offset-assert 8) ;; highest address in use by the pool

   ;; the allocate function is used to add a texture-page to the pool.
   (allocate-func    (function texture-pool texture-page kheap int texture-page)  :offset-assert 12)

   ;; the location of the color look-up table for font texture (vram word idx)
   (font-palette     int32     :offset-assert 16)
   
   ;; these were reordered
   ;; we have 4 segments, but only the near and common are used.
   (segment-near     texture-pool-segment   :inline :offset-assert 20)
   (segment-common   texture-pool-segment   :inline :offset-assert 28)
   (segment          texture-pool-segment 4 :inline :offset 20)

   ;; tpages that are not part of level textures are stored here.
   (common-page      texture-page  32       :offset-assert 52)
   ;; ??
   (common-page-mask int32                  :offset-assert 180)
   ;; for each pool page, stores the id of the tpage which is currently loaded in VRAM.
   (ids              uint32        126      :offset-assert 184)
   )
  :method-count-assert 23
  :size-assert         #x2b0
  :flag-assert         #x17000002b0
  (:methods
   (new (symbol type) _type_ 0)
   (initialize! (_type_) _type_ 9)
   (print-usage (_type_) _type_ 10)
   (setup-font-texture! (_type_) none 11)
   (allocate-defaults! (_type_) none 12)
   (login-level-textures (_type_ level int (pointer texture-id)) none 13)
   (add-tex-to-dma! (_type_ level int) none 14)
   (allocate-vram-words! (_type_ int) int 15)
   (allocate-segment! (_type_ texture-pool-segment int) texture-pool-segment 16)
   (dummy-17 () none 17)
   (dummy-18 () none 18)
   (dummy-19 () none 19)
   (unload! (_type_ texture-page) int 20)
   (upload-one-common! (_type_ level) symbol 21)
   (lookup-boot-common-id (_type_ int) int 22)
   )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Texture and Texture Page
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; A record for a texture.
;;  The texture can contain multiple levels of detail and also a color lookup table (CLUT)
;; This refers to data stored elsewhere, either in the data of a tpage or VRAM.
;; After a tpage has been allocated, the dest will be the VRAM address of the texture.
(deftype texture (basic)
  ((w            int16     :offset-assert 4)
   (wu           uint16    :offset 4)  ;; inline asm read this as u16
   (h            int16     :offset-assert 6)
   (hu           uint16    :offset 6)
   (num-mips     uint8     :offset-assert 8) ;; number of mipmap levels
   (tex1-control uint8     :offset-assert 9) ;; ?
   (psm          gs-psm    :offset-assert 10) ;; texture format
   (mip-shift    uint8     :offset-assert 11)
   (clutpsm      uint16    :offset-assert 12) ;; color look-up table format
   (dest         uint16 7  :offset-assert 14) ;; per mip VRAM address
   (clutdest     uint16    :offset-assert 28) ;; color look-up table location.
   (width        uint8 7   :offset-assert 30) ;; per mip
   (name         string    :offset-assert 40)
   (size         uint32    :offset-assert 44)
   (uv-dist      float     :offset-assert 48)
   (masks        uint32 3  :offset-assert 52)
   )
  :method-count-assert 9
  :size-assert         #x40
  :flag-assert         #x900000040
  )

;; tpages themselves are divided into segments.
;; some renderers may know ahead of time that they don't need all segments
;; and can skip uploading unused texture data.
(deftype texture-page-segment (structure)
  ((block-data pointer :offset-assert 0) ;; location in EE memory of texture data.
   (size       uint32  :offset-assert 4) ;; ?? units
   (dest       uint32  :offset-assert 8) ;; VRAM destination where it will be loaded to.
   )
  :pack-me
  :method-count-assert 9
  :size-assert         #xc
  :flag-assert         #x90000000c
  )

(defun texture-mip->segment ((arg0 int) (arg1 int))
  "Unknown, not used."
  (if (>= 2 arg1) (+ (- -1 arg0) arg1) (max 0 (- 2 arg0)))
  )

;; The actual texture-page header
;; After the dynamic array of texture is the actual texture data.
;; This may be thrown away if the texture is permanently in VRAM.
(deftype texture-page (basic)
  ((info      file-info        :offset-assert 4)
   (name      basic            :offset-assert 8)
   (id        uint32           :offset-assert 12)
   (length    int32            :offset-assert 16) ;; number of textures.
   (mip0-size uint32           :offset-assert 20)
   (size      uint32           :offset-assert 24) ;; VRAM words
   (segment   texture-page-segment 3 :inline :offset-assert 28)
   (pad       uint32 16       :offset-assert 64)
   (data      texture :dynamic :offset-assert 128)
   )
  :method-count-assert 15
  :size-assert         #x80
  :flag-assert         #xf00000080
  (:methods
    (relocate (_type_ kheap (pointer uint8)) none :replace 7)
    (remove-from-heap (_type_ kheap) _type_ 9)
    (get-leftover-block-count (_type_ int int) int 10)
    (dummy-11 () none 11)
    (relocate-dests! (_type_ int int) none 12)
    (add-to-dma-buffer (_type_ dma-buffer int) int 13)
    (upload-now! (_type_ int) none 14)
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;
;; Texture Shaders
;;;;;;;;;;;;;;;;;;;;;;;

;; The "adgif-shader" is a block of data that can be included in a GS packet
;; to set up GS registers for texturing.
;; There is a linked-list of these per texture that uses the shader-ptr type below

;; A shader-ptr is a reference to an adgif shader.
;; The trick here is that it can fit into unused space in the GS packet.
;; the A+D format only uses bits 0-72, this fits in 72-96. The use of 96-128 is unknown
;; the shader value must be multiplied by 16 first.
(deftype shader-ptr (uint32)
  ((shader uint32 :offset 8 :size 24))
  :method-count-assert 9
  :size-assert         #x4
  :flag-assert         #x900000004
  )

;; This is a dynamic array of shader-ptrs
;; There will be one array per texture-page, and this array will have one entry per texture.
;; These arrays will be allocated by the texture system and stored in level heaps.
(deftype texture-link (structure)
  ((next shader-ptr 1 :offset-assert 0)
   )
  :method-count-assert 9
  :size-assert         #x4
  :flag-assert         #x900000004
  )

;; Each texture-page will have a texture-page-dir-entry for it
(deftype texture-page-dir-entry (structure)
  ((length int16   :offset-assert 0)        ;; number of textures
   (status uint16  :offset-assert 2)        ;; ??
   (page   texture-page   :offset-assert 4) ;; the actual texture page
   (link   texture-link  :offset-assert 8) ;; the array of texture-links, per texture. #f if unallocated
   )
  :pack-me
  :method-count-assert 9
  :size-assert         #xc
  :flag-assert         #x90000000c
  )

;; There is a single texture-page-dir with a slot for each texture-page.
;; It's stored on the DVD and loaded with the engine.
(deftype texture-page-dir (basic)
  ((length int32)
   (entries texture-page-dir-entry 1 :inline)
   )
  (:methods
   (relocate (_type_ kheap (pointer uint8)) none :replace 7)
   (unlink-textures-in-heap! (_type_ kheap) int 9)
   )
  :flag-assert #xa00000014
  )


;;;;;;;;;;;;;;;;;;;;;;
;; Relocate Later
;;;;;;;;;;;;;;;;;;;;;;

;; Part of loading textures involves copying some data in EE RAM.
;; It seems to be too slow to as part of tpage login, so its deferred to a second frame.
;; The texture system will set this up, then the level system will do this when there's time.

(deftype texture-relocate-later (basic)
  ((memcpy symbol                  :offset-assert 4)  ;; set to #t when there's a pending copy
   (dest   uint32                  :offset-assert 8)  ;; destination address
   (source uint32                  :offset-assert 12) ;; source address
   (move   uint32                  :offset-assert 16) ;; size to move
   (entry  texture-page-dir-entry  :offset-assert 20) ;; the entry for the page we're moving
   (page   texture-page            :offset-assert 24) ;; the page header.
   )
  :method-count-assert 9
  :size-assert         #x1c
  :flag-assert         #x90000001c
  )


;; global relocate info
(define *texture-relocate-later* (new 'global 'texture-relocate-later))
(set! (-> *texture-relocate-later* memcpy) #f)

;; set to #f, will be set by texture-page-dir's relocate method on engine load.
(define *texture-page-dir* (the texture-page-dir #f))

;;;;;;;;;;;;;;;;;;;;
;; ADGIF Shader
;;;;;;;;;;;;;;;;;;;;

(defenum link-test-flags
  :type uint32
  :bitfield #t
  ;; note that we start at bit 8 because [0-7] are in use.
  
  (needs-log-in 8)  ;; set if we should attempt to log in, cleared on log-in
  (bit-9 9)         ;; cleared on log-in
  )

;; The actual adgif-shader is a 5 quadwords of A+D for GIF PACKED mode.
;; there is some extra data snuck in.
(deftype adgif-shader (structure)
  ((quad       qword  5 :score -100 :inline  :offset 0)
   (prims      gs-reg64 10 :score -100 :offset 0)

   ;; tex0, contains texture location, size, format, clut settings
   (tex0       gs-tex0     :offset 0)
   ;; prims 1 is the register id
   ;; prims 1 is shared with the link-test bitfield.

   ;; tex1, more texture information (LOD/MIP setup)
   (tex1       gs-tex1     :offset 16)
   ;; prims 3
   ;; prims 3 is shared with texture-id

   ;; miptb1, mip addresses/widths (levels 1 - 3)
   (miptbp1    gs-miptbp     :offset 32)
   ;; prims 5
   ;; prims 5 is shared with the next shader-ptr

   ;; clamp, used for texture wrapping
   (clamp      gs-clamp     :offset 48)
   (clamp-reg  gs-reg64     :offset 56) ;; or prims 7

   ;; alpha blending. NOTE: this can also be miptbp2 (mip 4+ settings)
   (alpha      gs-miptbp     :offset 64)
   ;; prims 9


   ;; sneaky overlays
   (link-test  link-test-flags     :offset 8) ;; don't touch lower 8 bits of this
   (texture-id texture-id     :offset 24)     ;; ok to touch all bits
   (next       shader-ptr :offset 40)         ;; don't touch lower 8 bits of this
   )
  :method-count-assert 9
  :size-assert         #x50
  :flag-assert         #x900000050
  )

(deftype adgif-shader-array (inline-array-class)
  ((data  adgif-shader  :inline :dynamic :offset 16)
   )
  :method-count-assert 9
  :size-assert         #x10
  :flag-assert         #x900000010
  )
(set! (-> adgif-shader-array heap-base) 80)


;;;;;;;;;;;;;;;;;;;;;;;;
;; Fixed VRAM
;;;;;;;;;;;;;;;;;;;;;;;;

;; These are pre-allocated and always in VRAM. 

(define *sky-base-vram-word* 0)
(define *sky-base-block* 0)
(define *sky-base-page* 0)
(define *depth-cue-base-vram-word* 0)
(define *depth-cue-base-block* 0)
(define *depth-cue-base-page* 0)
(define *eyes-base-vram-word* 0)
(define *eyes-base-block* 0)
(define *eyes-base-page* 0)
(define *ocean-base-vram-word* 0)
(define *ocean-base-block* 0)
(define *ocean-base-page* 0)


(defun-extern texture-page-default-allocate texture-pool texture-page kheap int texture-page)
(define-extern texture-page-login (function texture-id (function texture-pool texture-page kheap int texture-page) kheap texture-page-dir-entry))
(define-extern *texture-pool* texture-pool)
(define-extern lookup-texture-by-id (function texture-id texture))
(define-extern adgif-shader<-texture-with-update! (function adgif-shader texture adgif-shader))

(define-extern level-remap-texture (function texture-id texture-id))