jak-project/goal_src/engine/collide/collide-touch-h.gc

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

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

(deftype touching-prim (structure)
  ((cprim    basic                      :offset-assert 0)
   (has-tri? basic                      :offset-assert 4)
   (tri      collide-tri-result :inline :offset-assert 16)
   )
  :method-count-assert 9
  :size-assert         #x64
  :flag-assert         #x900000064
  )

(deftype touching-prims-entry (structure)
  ((next       touching-prims-entry         :offset-assert 0)
   (prev       touching-prims-entry         :offset-assert 4)
   (allocated? basic                        :offset-assert 8)
   (u          float                        :offset-assert 12)
   (prim1      touching-prim        :inline :offset-assert 16)
   (prim2      touching-prim        :inline :offset-assert 128)
   )
  :method-count-assert 13
  :size-assert         #xe4
  :flag-assert         #xd000000e4
  (:methods
   (dummy-9 () none 9)
   (dummy-10 () none 10)
   (dummy-11 () none 11)
   (dummy-12 () none 12)
   )
  )

(deftype touching-prims-entry-pool (structure)
  ((head  touching-prims-entry    :offset-assert 0)
   (nodes touching-prims-entry 64 :inline :offset-assert 16)
   )
  :method-count-assert 13
  :size-assert         #x3c10
  :flag-assert         #xd00003c10
  (:methods
   (new (symbol type) _type_ 0)
   (dummy-9 () none 9)
   (dummy-10 () none 10)
   (init-list! (_type_) none 11)
   (dummy-12 () none 12)
   )
  )

(defmethod init-list! touching-prims-entry-pool ((obj touching-prims-entry-pool))
  "Initialize all entries to be not allocated and in a linked list."
  (local-vars
   (prev touching-prims-entry)
   (idx int)
   (current (inline-array touching-prims-entry))
   (next touching-prims-entry)
   )
  (set! prev #f)
  (set! current (-> obj nodes))
  (set! (-> obj head) (-> current 0))
  (set! idx 64)
  (while (nonzero? idx)
    (+! idx -1)
    (set! (-> current 0 prev) prev)
    (set! next (-> current 1))
    (set! (-> current 0 next) next)
    (set! (-> current 0 allocated?) #f)
    (set! prev (-> current 0))
    (set! current (the (inline-array touching-prims-entry) next))
    )
  (set! (-> prev next) #f)
  (none)
  )

(defmethod new touching-prims-entry-pool ((allocation symbol) (type-to-make type))
  "Allocate a new touching-prims-entry-pool"

  ;; Note - the original code passed (-> type-to-make size) as an argument.
  ;; however, the new method of structure doesn't have this argument.
  ;; it uses the same value for the size so it doesn't really matter.
  (let ((obj (the touching-prims-entry-pool ((method-of-type structure new)
                                             allocation
                                             type-to-make
                                             ;; (-> type-to-make size) see note
                                             )
                  )))
    (init-list! obj)
    obj
    )
  )

(deftype touching-shapes-entry (structure)
  ((cshape1   basic                 :offset-assert 0)
   (cshape2   basic                 :offset-assert 4)
   (resolve-u int8                  :offset-assert 8)
   (head      touching-prims-entry  :offset-assert 12)
   )
  :allow-misaligned
  :method-count-assert 18
  :size-assert         #x10
  :flag-assert         #x1200000010
  (:methods
   (dummy-9 () none 9)
   (dummy-10 () none 10)
   (dummy-11 () none 11)
   (dummy-12 () none 12)
   (dummy-13 () none 13)
   (dummy-14 () none 14)
   (dummy-15 () none 15)
   (get-head (_type_) touching-prims-entry 16)
   (unknown1 (_type_ (pointer uint32)) uint 17)
   )
  )

(deftype touching-list (structure)
  ((num-touching-shapes int32      :offset-assert 0)
   (resolve-u           int8       :offset-assert 4)
   (touching-shapes     touching-shapes-entry 32 :inline :offset-assert 8)
   )
  :method-count-assert 15
  :size-assert         #x208
  :flag-assert         #xf00000208
  (:methods
   (new (symbol type) _type_ 0)
   (dummy-9 () none 9)
   (dummy-10 () none 10)
   (dummy-11 () none 11)
   (dummy-12 () none 12)
   (dummy-13 () none 13)
   (dummy-14 () none 14)
   )
  )

(defmethod new touching-list ((allocation symbol) (type-to-make type))
  "See note in touching-prims-entry-pool"
  (let ((obj (the touching-list ((method-of-type structure new)
                                 allocation
                                 type-to-make
                                 ;; (-> type-to-make size) see note
                                 )
                  )))
    (set! (-> obj num-touching-shapes) 0)
    (set! (-> obj resolve-u) 0)
    obj
    )
  )

(defmethod get-head touching-shapes-entry ((obj touching-shapes-entry))
  (-> obj head)
  )

(defmethod unknown1 touching-shapes-entry ((obj touching-shapes-entry) (arg0 (pointer uint32)))
  (-> arg0 0)
  )


(define-perm *touching-prims-entry-pool* touching-prims-entry-pool (new 'global 'touching-prims-entry-pool))
(define-perm *touching-list* touching-list (new 'global 'touching-list))