jak-project/goal_src/jak2/engine/draw/drawable.gc

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

;; name: drawable.gc
;; name in dgo: drawable
;; dgos: ENGINE, GAME

;; DECOMP BEGINS

;; TODO

(defmacro spr-work ()
  `(the work-area *fake-scratchpad-data*))

(defun sphere-cull ((arg0 vector))
  "Is the given sphere in the view frustum?"
  (local-vars (v1-0 uint128) (v1-1 uint128) (v1-2 uint128))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf10 :class vf)
         (vf16 :class vf)
         (vf17 :class vf)
         (vf18 :class vf)
         (vf19 :class vf)
         (vf9 :class vf)
         )
        ;; modified for PC: these register would be loaded by the draw method of bsp.
        (let ((at-0 *math-camera*))
          (.lvf vf16 (&-> at-0 guard-plane 0 quad))
          (.lvf vf17 (&-> at-0 guard-plane 1 quad))
          (.lvf vf18 (&-> at-0 guard-plane 2 quad))
          (.lvf vf19 (&-> at-0 guard-plane 3 quad))
          )
    (init-vf0-vector)
    (.lvf vf10 (&-> arg0 quad))
    (.mul.x.vf acc vf16 vf10)
    (.add.mul.y.vf acc vf17 vf10 acc)
    (.add.mul.z.vf acc vf18 vf10 acc)
    (.sub.mul.w.vf vf9 vf19 vf0 acc)
    (.add.w.vf vf9 vf9 vf10)
    (.mov v1-0 vf9)
    (.pcgtw v1-1 0 v1-0)
    (.ppach v1-2 (the-as uint128 0) v1-1)
    (zero? (the-as int v1-2))
    )
  )


(defun guard-band-cull ((arg0 vector))
  "Is the given sphere within the guard band, and possibly needs clipping?"
  (local-vars (v1-0 uint128) (v1-1 uint128) (v1-2 uint128))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf10 :class vf)
         (vf20 :class vf)
         (vf21 :class vf)
         (vf22 :class vf)
         (vf23 :class vf)
         (vf9 :class vf)
         )
        (init-vf0-vector)
        ;; modified for PC: these registers would be loaded in dma-add-process-drawable
        (let ((at-0 *math-camera*))
          (.lvf vf20 (&-> at-0 guard-plane 0 quad))
          (.lvf vf21 (&-> at-0 guard-plane 1 quad))
          (.lvf vf22 (&-> at-0 guard-plane 2 quad))
          (.lvf vf23 (&-> at-0 guard-plane 3 quad))
          )
        (.lvf vf10 (&-> arg0 quad))
        (.mul.x.vf acc vf20 vf10)
        (.add.mul.y.vf acc vf21 vf10 acc)
        (.add.mul.z.vf acc vf22 vf10 acc)
        (.sub.mul.w.vf vf9 vf23 vf0 acc)
        (.sub.w.vf vf9 vf9 vf10)
        (.mov v1-0 vf9)
        (.pcgtw v1-1 0 v1-0)
        (.ppach v1-2 (the-as uint128 0) v1-1)
        (nonzero? (the-as int v1-2))
        )
  )

(defun sphere-in-view-frustum? ((arg0 sphere))
  "Is the given sphere in the view frustum?
   Safe to use anywhere (unlike sphere-cull, which only works if service-mouse
   registers are still set from draw bsp.)
   "
  (local-vars (v1-1 uint128) (v1-2 uint128) (v1-3 uint128))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         (vf6 :class vf)
         )
    (init-vf0-vector)
    (let ((v1-0 *math-camera*))
      (.lvf vf6 (&-> arg0 quad))
      (.lvf vf1 (&-> v1-0 plane 0 quad))
      (.lvf vf2 (&-> v1-0 plane 1 quad))
      (.lvf vf3 (&-> v1-0 plane 2 quad))
      (.lvf vf4 (&-> v1-0 plane 3 quad))
      )
    (.mul.x.vf acc vf1 vf6)
    (.add.mul.y.vf acc vf2 vf6 acc)
    (.add.mul.z.vf acc vf3 vf6 acc)
    (.sub.mul.w.vf vf5 vf4 vf0 acc)
    (.add.w.vf vf5 vf5 vf6)
    (.mov v1-1 vf5)
    (.pcgtw v1-2 0 v1-1)
    (.ppach v1-3 (the-as uint128 0) v1-2)
    (zero? (the-as int v1-3))
    )
  )

(defun line-in-view-frustum? ((arg0 vector) (arg1 vector))
  "Is the line segment at least partially in the view frustum?"
  (local-vars (v1-1 uint128) (v1-2 uint128) (v1-3 uint128) (a0-1 uint128) (a0-2 uint128) (a0-3 uint128))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf10 :class vf)
         (vf16 :class vf)
         (vf17 :class vf)
         (vf18 :class vf)
         (vf19 :class vf)
         (vf9 :class vf)
         )
    (init-vf0-vector)
    (let ((v1-0 *math-camera*))
      (.lvf vf9 (&-> arg0 quad))
      (.lvf vf10 (&-> arg1 quad))
      (.lvf vf16 (&-> v1-0 plane 0 quad))
      (.lvf vf17 (&-> v1-0 plane 1 quad))
      (.lvf vf18 (&-> v1-0 plane 2 quad))
      (.lvf vf19 (&-> v1-0 plane 3 quad))
      )
    (.mul.x.vf acc vf16 vf9)
    (.add.mul.y.vf acc vf17 vf9 acc)
    (.add.mul.z.vf acc vf18 vf9 acc)
    (.sub.mul.w.vf vf9 vf19 vf0 acc)
    (.mul.x.vf acc vf16 vf10)
    (.add.mul.y.vf acc vf17 vf10 acc)
    (.add.mul.z.vf acc vf18 vf10 acc)
    (.sub.mul.w.vf vf10 vf19 vf0 acc)
    (.mov v1-1 vf9)
    (.pcgtw v1-2 0 v1-1)
    (.ppach v1-3 (the-as uint128 0) v1-2)
    (.mov a0-1 vf10)
    (.pcgtw a0-2 0 a0-1)
    (.ppach a0-3 (the-as uint128 0) a0-2)
    (zero? (logand (the-as int v1-3) (the-as int a0-3)))
    )
  )

(defun vis-cull ((id int))
  "Is this thing visible in the precomputed visiblity data? By draw-node id.
   Assumes the scratchpad has the vis-list loaded."
  (let* ((vis-byte (-> (spr-work) background vis-list (/ id 8))) ;; vis byte
         (shift-amount (+ 56 (logand id 7)))
         (shifted (shl vis-byte shift-amount))
         )
    (< (the-as int shifted) 0)
    )
  )

(defun-debug vis-cull-debug ((a0-0 work-area) (id int))
  "Like vis-cull, but you can specify a different work-area.
   Unused."
  (let* ((vis-byte (-> a0-0 background vis-list (/ id 8))) ;; vis byte
         (shift-amount (+ 56 (logand id 7)))
         (shifted (shl vis-byte shift-amount))
         )
    (< (the-as int shifted) 0)
    )
  )

(defun error-sphere ((arg0 drawable-error) (arg1 string))
  "Draw a sphere with an error message around this drawable-error."
  (when *artist-error-spheres*
    (when (vis-cull (-> arg0 id))
      (when (sphere-cull (-> arg0 bsphere))
        (add-debug-sphere
          #t
          (bucket-id debug2)
          (-> arg0 bsphere)
          (-> arg0 bsphere w)
          (new 'static 'rgba :r #x80 :a #x80)
          )
        (add-debug-text-3d
          #t
          (bucket-id debug-no-zbuf1)
          arg1
          (-> arg0 bsphere)
          (font-color #dadada)
          (the-as vector2h #f)
          )
        )
      )
    )
  0
  (none)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; drawable methods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; the drawable class is the base class for tons of things
;; basically anything in the a tree-like structure in the level uses this
;; so these methods are super vague and not well defined.
;; Generally, you shouldn't call any of these unless you know the type and
;; what they will do.

(defmethod login drawable ((obj drawable))
  "Initialize a drawable after load."
  obj
  )

(defmethod draw drawable ((obj drawable) (arg0 drawable) (arg1 display-frame))
  "Draw something. The meaning of this depends on the exact drawable class,
   but in general the heavy work isn't here - this just adds stuff to lists."
  0
  (none)
  )

(defmethod drawable-method-11 drawable ()
  0
  (none)
  )

(defmethod drawable-method-12 drawable ()
  0
  (none)
  )

(defmethod collect-regions drawable ((obj drawable) (arg0 sphere) (arg1 int) (arg2 region-prim-list))
  "Collect a list of regions that we're in, recursively."
  0
  (none)
  )

(defmethod collect-stats drawable ((obj drawable))
  "Collect statistics for debugging"
  0
  (none)
  )

(defmethod debug-draw drawable ((obj drawable) (arg0 drawable) (arg1 display-frame))
  "Draw debug visualizations"
  0
  (none)
  )

(defmethod draw drawable-error ((obj drawable-error) (arg0 drawable-error) (arg1 display-frame))
  "Draw a debug sphere."
  (error-sphere arg0 (-> arg0 name))
  0
  (none)
  )

(defmethod unpack-vis drawable ((obj drawable) (arg0 (pointer int8)) (arg1 (pointer int8)))
  "Unpack vis data from arg1 to arg0, unpacking it. Return pointer to next thing."
  arg1
  )

;; instance debug
(define *edit-instance* (the-as string #f))
(when *debug-segment*
  (define *instance-mem-usage* (new 'debug 'memory-usage-block))
  )

;;hack
(defun find-instance-by-name ((a0-0 string))
  (the prototype-bucket #f))

(defun real-main-draw-hook ()
  (local-vars (a0-96 int) (a0-98 int))
  (with-pp
    (when *slow-frame-rate*
      (dotimes (v1-2 #xc35000)
        (nop!)
        (nop!)
        (nop!)
        (nop!)
        (nop!)
        (nop!)
        )
      )
    "Function to be executed to set up for engine dma"

    ;; update render/texture upload masks
    (set! (-> *display* vu1-enable-user) (-> *display* vu1-enable-user-menu))
    (set! (-> *texture-pool* texture-enable-user) (-> *texture-pool* texture-enable-user-menu))

    ;; display memory stats
    ; (when *debug-segment*
    ;   (when (and *stats-memory* (!= *master-mode* 'menu))
    ;     (cond
    ;       (*stats-memory-short*
    ;         (dotimes (gp-0 (-> *level* length))
    ;           (let ((s5-0 (-> *level* level gp-0)))
    ;             (if (= (-> s5-0 status) 'active)
    ;                 (print-mem-usage (compute-memory-usage s5-0 #f) s5-0 *stdcon*)
    ;                 )
    ;             )
    ;           )
    ;         )
    ;       (else
    ;         (let ((gp-1 (-> *level* level *stats-memory-level-index*)))
    ;           (if (and gp-1 (= (-> gp-1 status) 'active))
    ;               (print-mem-usage (compute-memory-usage gp-1 #f) gp-1 *stdcon*)
    ;               )
    ;           )
    ;         )
    ;       )
    ;     )
    ;   (reset! *dma-mem-usage*)
    ;   )

    ;; set up foreground buckets
    ; (foreground-initialize-engines)

    ;; update time of day and wind effects.
    (let ((gp-2 (-> pp clock)))
      (if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
          (set! (-> pp clock) (-> *display* bg-clock))
          (set! (-> pp clock) (-> *display* real-clock))
          )
    ;   (if (not (paused?))
    ;       (update-wind *wind-work* *wind-scales*)
    ;       )
      (update-time-of-day *time-of-day-context*)
      (set! (-> pp clock) gp-2)
      )


    ;; draw the sky
    (with-profiler 'sky *profile-sky-color*
      ; (if (-> *sky-work* draw-vortex)
      ;     (draw-vortex)
      ;     (draw *sky-work*)
      ;     )
      (flush-cache 0)
      )

    ;; draw the ocean
    ; (let ((gp-5 (-> pp clock)))
    ;   (if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
    ;       (set! (-> pp clock) (-> *display* bg-clock))
    ;       (set! (-> pp clock) (-> *display* real-clock))
    ;       )
    ;   (with-profiler 'ocean *profile-ocean-color*
    ;     (draw! *ocean*)
    ;     (if *ocean-map*
    ;         (update-map *ocean*)
    ;         )
    ;     )
    ;   (set! (-> pp clock) gp-5)
    ;   )

    ;; run the foreground system
    ; (foreground-engine-execute *foreground-draw-engine* (-> *display* frames (-> *display* on-screen)))
    ; (let ((gp-6 (-> pp clock)))
    ;   (if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
    ;       (set! (-> pp clock) (-> *display* bg-clock))
    ;       (set! (-> pp clock) (-> *display* real-clock))
    ;       )
    ;   (foreground-execute-cpu-vu0-engines)
    ;   (set! (-> pp clock) gp-6)
    ;   )

    ;; ??
    ; (when *add-sphere*
    ;   )

    ;; run the sprite/particle system.
    (if (not (paused?))
        (execute-part-engine)
        )
    (if (logtest? (vu1-renderer-mask sprite) (-> *display* vu1-enable-user))
        (sprite-draw *display*)
        )

    ;; debug draw collision stuff before processing it.
    (when *debug-segment*
      (debug-draw-actors *level* *display-actor-marks*)
      ; (collide-shape-draw-debug-marks)
      )

    ;; after debug drawing, send events to actors
    ; (send-events-for-touching-shapes *touching-list*)
    ; (free-nodes *touching-list*)
    ; (prepare *collide-rider-pool*)
    (send-all! *event-queue*)

    ;; spawn/update actors
    (with-profiler 'update-actors *profile-update-actors-color*
      ;(actors-update *level*)
      )

    ;; ??
    (with-profiler 'nav *profile-nav-color*
      ;; ((method-of-object *level* level-group-method-18))
      )



    (with-profiler 'background *profile-background-color*
      ;; Run the background renderers!

      ;; first, reset the background-work
      (init-background)

      ;; next, collect all levels that are registered with the engine
      ;; this will call the drawable system's draw method on the levels which adds all
      ;; trees known to the background system to *background-work*.
      (execute-connections *background-draw-engine* (-> *display* frames (-> *display* on-screen)))

      ;; execute all background drawing
      (reset! (-> *perf-stats* data (perf-stat-bucket background)))
      (finish-background)
      (read! (-> *perf-stats* data (perf-stat-bucket background)))

      ;; update VU stats for background draw.
      (update-wait-stats (-> *perf-stats* data (perf-stat-bucket background))
                         (-> *background-work* wait-to-vu0)
                         (the-as uint 0)
                         (the-as uint 0)
                         )
      )

    (end-perf-stat-collection)

    (when (and (!= *master-mode* 'menu) *stats-poly*)
      (dotimes (gp-13 (-> *level* length))
        (let ((v1-307 (-> *level* level gp-13)))
          (if (= (-> v1-307 status) 'active)
              (collect-stats (-> v1-307 bsp))
              )
          )
        )
      (print-terrain-stats)
      )

    (when (not (paused?))
      (if (and (!= *master-mode* 'menu) *stats-perf*)
          (print-perf-stats)
          )
      (if (and (!= *master-mode* 'menu) *stats-collide*)
          (print-collide-stats)
          )
      )
    (start-perf-stat-collection)

    0
    (none)
    )
  )

(defun main-draw-hook ()
  (real-main-draw-hook)
  (none)
  )

(define *draw-hook* main-draw-hook)

(defun default-init-buffer ((arg0 bucket-id) (arg1 gs-zbuf) (arg2 gs-test))
  (let ((v1-6 (-> *display* frames (-> *display* on-screen) bucket-group arg0)))
    (when (!= v1-6 (-> v1-6 last))
      (let* ((a0-8 (-> *display* frames (-> *display* on-screen) global-buf))
             (a3-3 (-> a0-8 base))
             )
        (let* ((t0-0 a0-8)
               (t1-0 (the-as dma-packet (-> t0-0 base)))
               )
          (set! (-> t1-0 dma) (new 'static 'dma-tag :qwc #xa :id (dma-tag-id cnt)))
          (set! (-> t1-0 vif0) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
          (set! (-> t1-0 vif1) (new 'static 'vif-tag :imm #xa :cmd (vif-cmd direct) :msk #x1))
          (set! (-> t0-0 base) (the-as pointer (&+ t1-0 16)))
          )
        (let* ((t0-1 a0-8)
               (t1-2 (the-as object (-> t0-1 base)))
               )
          (set! (-> (the-as gs-gif-tag t1-2) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x9))
          (set! (-> (the-as gs-gif-tag t1-2) regs) (new 'static 'gif-tag-regs
                                                     :regs0 (gif-reg-id a+d)
                                                     :regs1 (gif-reg-id a+d)
                                                     :regs2 (gif-reg-id a+d)
                                                     :regs3 (gif-reg-id a+d)
                                                     :regs4 (gif-reg-id a+d)
                                                     :regs5 (gif-reg-id a+d)
                                                     :regs6 (gif-reg-id a+d)
                                                     :regs7 (gif-reg-id a+d)
                                                     :regs8 (gif-reg-id a+d)
                                                     :regs9 (gif-reg-id a+d)
                                                     :regs10 (gif-reg-id a+d)
                                                     :regs11 (gif-reg-id a+d)
                                                     :regs12 (gif-reg-id a+d)
                                                     :regs13 (gif-reg-id a+d)
                                                     :regs14 (gif-reg-id a+d)
                                                     :regs15 (gif-reg-id a+d)
                                                     )
                )
          (set! (-> t0-1 base) (&+ (the-as pointer t1-2) 16))
          )
        (let* ((t0-2 a0-8)
               (t1-4 (-> t0-2 base))
               )
          (set! (-> (the-as (pointer gs-zbuf) t1-4) 0) arg1)
          (set! (-> (the-as (pointer gs-reg64) t1-4) 1) (gs-reg64 zbuf-1))
          (set! (-> (the-as (pointer gs-test) t1-4) 2) arg2)
          (set! (-> (the-as (pointer gs-reg64) t1-4) 3) (gs-reg64 test-1))
          (set! (-> (the-as (pointer gs-alpha) t1-4) 4) (new 'static 'gs-alpha :b #x1 :d #x1))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 5) (gs-reg64 alpha-1))
          (set! (-> (the-as (pointer uint64) t1-4) 6) (the-as uint 0))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 7) (gs-reg64 pabe))
          (set! (-> (the-as (pointer gs-clamp) t1-4) 8)
                (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp))
                )
          (set! (-> (the-as (pointer gs-reg64) t1-4) 9) (gs-reg64 clamp-1))
          (set! (-> (the-as (pointer gs-tex0) t1-4) 10) (new 'static 'gs-tex0 :tbp0 #x60))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 11) (gs-reg64 tex1-1))
          (set! (-> (the-as (pointer gs-texa) t1-4) 12) (new 'static 'gs-texa :ta1 #x80))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 13) (gs-reg64 texa))
          (set! (-> (the-as (pointer gs-texclut) t1-4) 14) (new 'static 'gs-texclut :cbw #x4))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 15) (gs-reg64 texclut))
          (set! (-> (the-as (pointer uint64) t1-4) 16) (the-as uint *fog-color*))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 17) (gs-reg64 fogcol))
          (set! (-> t0-2 base) (&+ t1-4 144))
          )
        (let ((a1-18 (the-as object (-> a0-8 base))))
          (set! (-> (the-as dma-packet a1-18) dma) (new 'static 'dma-tag :id (dma-tag-id next) :addr (-> v1-6 next)))
          (set! (-> (the-as dma-packet a1-18) vif0) (new 'static 'vif-tag))
          (set! (-> (the-as dma-packet a1-18) vif1) (new 'static 'vif-tag))
          (set! (-> a0-8 base) (&+ (the-as pointer a1-18) 16))
          )
        (set! (-> v1-6 next) (the-as uint a3-3))
        )
      )
    )
  (none)
  )

(defun default-end-buffer ((arg0 bucket-id) (arg1 gs-zbuf) (arg2 gs-test))
  (let ((v1-6 (-> *display* frames (-> *display* on-screen) bucket-group arg0)))
    (when (!= v1-6 (-> v1-6 last))
      (let* ((a3-2 (-> *display* frames (-> *display* on-screen) global-buf))
             (a0-8 (-> a3-2 base))
             )
        (let* ((t0-1 a3-2)
               (t1-0 (the-as dma-packet (-> t0-1 base)))
               )
          (set! (-> t1-0 dma) (new 'static 'dma-tag :qwc #xa :id (dma-tag-id cnt)))
          (set! (-> t1-0 vif0) (new 'static 'vif-tag :cmd (vif-cmd flusha) :msk #x1))
          (set! (-> t1-0 vif1) (new 'static 'vif-tag :imm #xa :cmd (vif-cmd direct) :msk #x1))
          (set! (-> t0-1 base) (the-as pointer (&+ t1-0 16)))
          )
        (let* ((t0-2 a3-2)
               (t1-2 (the-as object (-> t0-2 base)))
               )
          (set! (-> (the-as gs-gif-tag t1-2) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x9))
          (set! (-> (the-as gs-gif-tag t1-2) regs) (new 'static 'gif-tag-regs
                                                     :regs0 (gif-reg-id a+d)
                                                     :regs1 (gif-reg-id a+d)
                                                     :regs2 (gif-reg-id a+d)
                                                     :regs3 (gif-reg-id a+d)
                                                     :regs4 (gif-reg-id a+d)
                                                     :regs5 (gif-reg-id a+d)
                                                     :regs6 (gif-reg-id a+d)
                                                     :regs7 (gif-reg-id a+d)
                                                     :regs8 (gif-reg-id a+d)
                                                     :regs9 (gif-reg-id a+d)
                                                     :regs10 (gif-reg-id a+d)
                                                     :regs11 (gif-reg-id a+d)
                                                     :regs12 (gif-reg-id a+d)
                                                     :regs13 (gif-reg-id a+d)
                                                     :regs14 (gif-reg-id a+d)
                                                     :regs15 (gif-reg-id a+d)
                                                     )
                )
          (set! (-> t0-2 base) (&+ (the-as pointer t1-2) 16))
          )
        (let* ((t0-3 a3-2)
               (t1-4 (-> t0-3 base))
               )
          (set! (-> (the-as (pointer gs-zbuf) t1-4) 0) arg1)
          (set! (-> (the-as (pointer gs-reg64) t1-4) 1) (gs-reg64 zbuf-1))
          (set! (-> (the-as (pointer gs-test) t1-4) 2) arg2)
          (set! (-> (the-as (pointer gs-reg64) t1-4) 3) (gs-reg64 test-1))
          (set! (-> (the-as (pointer gs-alpha) t1-4) 4) (new 'static 'gs-alpha :b #x1 :d #x1))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 5) (gs-reg64 alpha-1))
          (set! (-> (the-as (pointer uint64) t1-4) 6) (the-as uint 0))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 7) (gs-reg64 pabe))
          (set! (-> (the-as (pointer gs-clamp) t1-4) 8)
                (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp))
                )
          (set! (-> (the-as (pointer gs-reg64) t1-4) 9) (gs-reg64 clamp-1))
          (set! (-> (the-as (pointer gs-tex0) t1-4) 10) (new 'static 'gs-tex0 :tbp0 #x60))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 11) (gs-reg64 tex1-1))
          (set! (-> (the-as (pointer gs-texa) t1-4) 12) (new 'static 'gs-texa :ta1 #x80))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 13) (gs-reg64 texa))
          (set! (-> (the-as (pointer gs-texclut) t1-4) 14) (new 'static 'gs-texclut :cbw #x4))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 15) (gs-reg64 texclut))
          (set! (-> (the-as (pointer uint64) t1-4) 16) (the-as uint *fog-color*))
          (set! (-> (the-as (pointer gs-reg64) t1-4) 17) (gs-reg64 fogcol))
          (set! (-> t0-3 base) (&+ t1-4 144))
          )
        (let ((t0-4 (-> a3-2 base)))
          (let ((a1-18 (the-as object (-> a3-2 base))))
            (set! (-> (the-as dma-packet a1-18) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
            (set! (-> (the-as dma-packet a1-18) vif0) (new 'static 'vif-tag))
            (set! (-> (the-as dma-packet a1-18) vif1) (new 'static 'vif-tag))
            (set! (-> a3-2 base) (&+ (the-as pointer a1-18) 16))
            )
          (set! (-> (the-as dma-bucket (-> v1-6 last)) next) (the-as uint a0-8))
          (set! (-> v1-6 last) (the-as (pointer dma-tag) t0-4))
          )
        )
      )
    )
  (none)
  )


(defun display-frame-start ((arg0 display) (arg1 int) (arg2 float))
  "Advance clocks, poll pads/mouse, set up buckets."
  ;; workaround for PS2 HW bug
  ; (set! (-> (the-as vif-bank #x10003c00) err me0) 1)
  ;; tick frame clocks
  (set-time-ratios *display* 1.0)
  (tick! (-> arg0 frame-clock))
  (tick! (-> arg0 real-frame-clock))

  ;; tick other clocks
  (set-time-ratios *display* arg2)
  (tick! (-> arg0 session-clock))
  (tick! (-> arg0 game-clock))
  (tick! (-> arg0 total-game-clock))
  (tick! (-> arg0 base-clock))
  (tick! (-> arg0 real-clock))
  (tick! (-> arg0 target-clock))
  (tick! (-> arg0 camera-clock))
  (tick! (-> arg0 entity-clock))
  (tick! (-> arg0 user0-clock))
  (tick! (-> arg0 bg-clock))
  (set! (-> arg0 bg-clock frame-counter) (the-as time-frame (mod (-> arg0 bg-clock frame-counter) #x69780)))
  (tick! (-> arg0 part-clock))

  ; (when (and (nonzero? *screen-shot-work*) (!= (-> *screen-shot-work* count) -1))
  ;   (let ((v1-43 (-> *screen-shot-work* size)))
  ;     (if (!= (-> *screen-shot-work* count) (* v1-43 v1-43))
  ;         (store-image *screen-shot-work*)
  ;         )
  ;     )
  ;   (+! (-> *screen-shot-work* count) -1)
  ;   (if (= (-> *screen-shot-work* count) -1)
  ;       (set! (-> *screen-shot-work* size) -1)
  ;       )
  ;   )

  (let ((s5-1 (-> arg0 frames arg1)))
    (if *sync-dma*
        (sync-path 0 0)
        )

    (let ((v1-57 (-> s5-1 global-buf)))
      (set! (-> v1-57 base) (-> v1-57 data))
      (set! (-> v1-57 end) (&-> v1-57 data-buffer (-> v1-57 allocated-length)))
      )
    (let ((v1-58 (-> s5-1 global-buf)))
      (&+! (-> v1-58 end) -65536)
      )
    (when *debug-segment*
      (let ((v1-61 (-> s5-1 debug-buf)))
        (set! (-> v1-61 base) (-> v1-61 data))
        (set! (-> v1-61 end) (&-> v1-61 data-buffer (-> v1-61 allocated-length)))
        )
      )
    (let ((v1-62 (-> s5-1 calc-buf)))
      (set! (-> v1-62 base) (-> v1-62 data))
      (set! (-> v1-62 end) (&-> v1-62 data-buffer (-> v1-62 allocated-length)))
      )
    (*pre-draw-hook* (-> s5-1 calc-buf))
    (when (not (paused?))
      (clear *stdcon1*)
      (debug-reset-buffers)
      ;(clear! *simple-sprite-system*)
      )
    (set! (-> s5-1 bucket-group) (dma-buffer-add-buckets (-> s5-1 calc-buf) 327))
    )

  (service-cpads)
  (service-mouse)
  ; (execute-connections *pad-engine* #f)
  (none)
  )

(defun pc-maybe-vsync ()
  "PC Port implementation of the block of code in display-sync that computes frame-time-ratio and maybe vsyncs."
  ;; for now, it's very simple.

  ;; I think the right logic in the future is to always vsync here, but return a more accurate dog ratio.

  (syncv 0) ;; sync always!
  ;(set! *ticks-per-frame* 9765) ;; hack!
  1.0       ;; and report that we run at full speed.
  )

(defun display-sync ((arg0 display))
  "Determine frame timing, possibly vsync, and kick off next DMA.
   This also calls sync-path, but this appears redundant because the display loop did this already."

  ;; The "rendered" frame is the one that has had its DMA processed and is completed and in VRAM.
  ;; The "drawn" frame is the one that has DMA ready, but not sent.
  ;; The "vblank period" is how long in between actual frames on the TV. This is 16.67 ms for NTSC.

  ;; This function will kick off the drawn frame's DMA, possibly vsync, and update timing stuff.
  ;; Currently, I believe the _start_ of the drawn frame's DMA will do the "blit" to move
  ;; the "rendered" frame's image from the drawing buffer to the frame buffer, but it's possible I have this backward.

  ;; apparently useless sync
  ;; everything in here happens after DMA is done.
  (sync-path 0 0)

  (let* ((just-rendered-frame (-> arg0 last-screen))
         (current-time (shl (timer1-time) 48))
         (just-rendered-frame-start-time (shl (-> arg0 frames just-rendered-frame start-time) 48))
         (prev-vblank-time-1 (shl (-> arg0 vblank-start-time 0) 48))
         (prev-vblank-time-2 (shl (-> arg0 vblank-start-time 1) 48))
         )

    ;; measure the actual *ticks-per-frame* by comparing the timings of the last two vblanks.
    ;; I think this should be constant for PAL/NTSC, the vblank interrupt happens no matter what and is based
    ;; on the TV timing stuff.
    ;(set! *ticks-per-frame* (sar (- prev-vblank-time-2 prev-vblank-time-1) 48))
    (set! *ticks-per-frame* 9765) ;; HACK

    (let* ((ticks-per-frame-f (the float *ticks-per-frame*))
           ;; how long we spent on this frame (measured from the dma-send until now)
           (frame-duration (the float (sar (- current-time (the-as uint just-rendered-frame-start-time)) 48)))
           ;; how long we spent on this frame, as a fraction of the time between vblanks (the actual TV framerate)
           (frame-time-ratio (/ frame-duration ticks-per-frame-f))
           )
      (/ (the float (sar (- current-time (the-as uint prev-vblank-time-2)) 48)) ticks-per-frame-f)

      ;; how close we are to the next vblank (should be between 0 and 1)
      (let ((vysnc-progress (/ (the float (sar (- current-time (the-as uint prev-vblank-time-2)) 48)) ticks-per-frame-f))
            ;; the "lag ratio" of the frame that was just drawn.
            (last-dog (fmax 1.0 (fmin 4.0 (-> *display* dog-ratio))))
            )
        (set! (-> arg0 frames just-rendered-frame run-time) (the-as time-frame (the int frame-duration)))

        ;; next, we'll compute this "lag" ratio (will become dog-ratio of the next frame).
        ;; higher numbers = game running slower = bigger timesteps
        #|
        (set! frame-time-ratio
              (cond
                ((-> arg0 run-half-speed)
                 ;; running at half speed flag is likely used for debugging? It forces 1 vsync here always.
                 (syncv 0)

                 ;; do a vysnc if we are both:
                 ;;  - took less than 2 vblank periods to do the last frame (we finished early)
                 ;;  - we have more than 10% of the frame left.
                 ;; see the comments in the next section for a better explanation of why they do this.
                 (if (and (< (/ (the float (sar (- (shl (timer1-time) 48) (the-as uint just-rendered-frame-start-time)) 48))
                                ticks-per-frame-f
                                )
                             2.0
                             )
                          (< vysnc-progress 0.9)
                          )
                     (syncv 0)
                     )

                 ;; report a dog-ratio of exactly 2 always, for this debug mode
                 2.0
                 )
                (else
                  ;; not using the half-speed debug option.

                  (cond
                    ;; case where we're lagging and don't want to vsync usually.
                    ((< 1.0 frame-time-ratio)
                     ;; we're lagging! In this case, we usually don't bother with vsync, and there would be tearing.

                     ;; not sure about this check, but I guess we never vysnc here if we're on the first 2 frames of the game?
                     (when (not (or (zero? prev-vblank-time-1) (zero? prev-vblank-time-2)))
                       ;; if the force sync counter is set, do a vsync and decrease the counter.
                       (when (> (-> arg0 force-sync) 0)
                         (syncv 0)
                         (+! (-> arg0 force-sync) -1)

                         ;; update the frame-time-ratio because we just made this frame longer by vsyncing.
                         (let ((v1-23 (shl (timer1-time) 48)))
                           (the float (sar (- v1-23 (the-as uint just-rendered-frame-start-time)) 48))
                           (set! frame-time-ratio
                                 (/ (the float (sar (- v1-23 (the-as uint just-rendered-frame-start-time)) 48)) ticks-per-frame-f)
                                 )
                           )
                         )
                       )

                     ;; this "dog-count" thing can be set to 1.0 if the game thinks that its running fast enough for full framerate
                     ;; but the frame start time is misaligned with the actual TV's vblank.
                     ;; we are lagging here, so we don't want this, and dog-count should be set to 0
                     (set! (-> arg0 dog-count) 0.0)
                     )

                    ;; case where we're vsyncing.
                    ;; this should happen if the last-dog is 1.0 (was fast enough), or if the dog-count is set
                    ;; the dog-count will be set if the frames are fast enough, but not currently aligned.
                    ((or (= last-dog 1.0) (!= (-> arg0 dog-count) 0.0))
                     ;; still, only do the sync if we have a lot of time. I guess that vsyncing in other cases is not
                     ;; needed, and just wastes time. Might as well start on the next frame early!
                     (if (< vysnc-progress 0.9)
                         (syncv 0)
                         )
                     ;; force no lag
                     (set! frame-time-ratio 1.0)
                     ;; clear dog-count, go back to normal lag/no-lag decisions.
                     (set! (-> arg0 dog-count) 0.0)
                     )
                    (else
                      ;; weird case: last frame was lag (last-dog != 1.0), but this frame wasn't (frame-time-ratio < 1).
                      ;; so we're transition from lag to no lag. In this case, we want to get back aligned with vsyncs.
                      ;; interestingly, we don't vsync immediately, but instead set a flag to vsync on the next frame, if
                      ;; that frame's time is also non-lag. As a result, we only syncrhonize with vsync if we have 2 non-lag frames
                      ;; in a row (both of them misaligned.), and we spread the syncrhonization delays between 2 frames


                      (when (not (or (zero? prev-vblank-time-1) (zero? prev-vblank-time-2))) ;; only if we've done at least 2 syncs..

                        ;; here we wait, recomputing frame-time-ratio/vsync-progress until either:
                        ;; - we're in the first or last third of the frame
                        ;; - we've waited longer than the previous frame lagged.
                        (while (or (< frame-time-ratio last-dog) (and (< 0.333 vysnc-progress) (< vysnc-progress 0.667)))
                          (let ((v1-34 (shl (timer1-time) 48)))
                            (set! frame-time-ratio
                                  (/ (the float (sar (- v1-34 (the-as uint just-rendered-frame-start-time)) 48)) ticks-per-frame-f)
                                  )
                            (if (< frame-time-ratio 0.0) ;; ?? timer wraparound issues?
                                (set! frame-time-ratio last-dog)
                                )
                            (set! vysnc-progress
                                  (/ (the float (sar (- v1-34 (the-as uint (shl (-> arg0 vblank-start-time 1) 48))) 48)) ticks-per-frame-f)
                                  )
                            )
                          )
                        )

                      ;; force next frame to vsync if it didn't lag, then we will be back on framerate!
                      (set! (-> arg0 dog-count) 1.0)
                      )
                    )
                  frame-time-ratio
                  )
                )
              )
        |#

        ;; PC port added: just skip this for now.
        (set! frame-time-ratio (pc-maybe-vsync))

        (if (< frame-time-ratio 0.0)
            (set! frame-time-ratio last-dog)
            )
        )

      ;; never allow faster than full-speed frames (the logic above will prevent running faster than TV framerate)
      (let ((next-dog (fmax 1.0 frame-time-ratio))
            (frame-to-render (-> arg0 on-screen))
            )

        ;; measure time again, after waiting/vsyncing.
        (let ((time-after-vsync (timer1-time)))
          (+! (-> arg0 total-run-time)
              (the-as time-frame (sar (- (shl time-after-vsync 48) (the-as uint just-rendered-frame-start-time)) 48))
              )
          ;; and use this as the start time for the frame we're about to render.
          (set! (-> arg0 frames frame-to-render start-time) (the-as time-frame time-after-vsync))
          )
        ;; while nothing is drawing, update GS/video/magic stuff.
        ;; (set-graphics-mode)

        ;; start DMA
        (let ((next-dma-buf (-> arg0 frames frame-to-render calc-buf)))
          (when (nonzero? (dma-buffer-length next-dma-buf))
            (+! frame-to-render 1)
            (if (< 1 frame-to-render)
                (set! frame-to-render 0)
                )
            ;; swap DMA buffers
            (set! (-> arg0 last-screen) (-> arg0 on-screen))
            (set! (-> arg0 on-screen) frame-to-render)
            ;; reset VU profiler for upcoming chain
            (when *debug-segment*
              (set! *profile-interrupt-segment* (-> *display* frames (-> *display* last-screen) profile-array data 1))
              (set! (-> *profile-interrupt-segment* depth) 0)
              (set! (-> *profile-interrupt-segment* max-depth) 1)
              )
            ;; send the chain!
            (__send-gfx-dma-chain (the-as dma-bank-source #x10009000) (-> next-dma-buf data-buffer))
            )
          )

        ;; screenshot/pause stuff.
        (determine-pause-mode)
        ; (when (and (nonzero? *screen-shot-work*) (= (-> *screen-shot-work* count) -1) (!= (-> *screen-shot-work* size) -1))
        ;   (let ((v1-77 (-> *screen-shot-work* size)))
        ;     (set! (-> *screen-shot-work* count) (* v1-77 v1-77))
        ;     )
        ;   (set-master-mode 'pause)
        ;   )

        ;; prepare engine for the next frame
        (display-frame-start arg0 frame-to-render next-dog)
        )
      )
    )
  (none)
  )

(defun display-frame-finish ((arg0 display))
  "Do final DMA setup after drawing.
   Note that this runs _after_ rendering, while VU1/GS are not doing anything.
   so it's best to keep this code as simple as possible."
  (with-pp
    (let* ((s4-0 (-> arg0 frames (-> arg0 on-screen)))
           (s5-0 (-> s4-0 calc-buf))
           )
      ;(-> s4-0 global-buf)

      ;; post-draw buffer setup
      (tfrag-vu1-init-buffers)
      (tie-vu1-init-buffers)
      ; (merc-vu1-init-buffers)
      ; (emerc-vu1-init-buffers)
      ; (generic-vu1-init-buffers)

      ;; sprite texture remaps
      (when (-> *texture-pool* update-sprites-flag)
        (update-sprites *texture-pool*)
        (particle-adgif-cache-flush)
        (remap-all-particles)
        )

      ;; texture uploads while GS is not doing anything.
      (with-profiler 'texture *profile-texture-color*
        (let ((s3-1 (-> pp clock)))
          (if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
              (set! (-> pp clock) (-> *display* bg-clock))
              (set! (-> pp clock) (-> *display* real-clock))
              )
          (upload-textures *texture-pool*)
          (set! (-> pp clock) s3-1)
          )
        )

      ;; more texture mapping.
      ; (if (-> *texture-pool* update-flag)
      ;     (update-warp-and-hud *texture-pool*)
      ;     )

      ;; unclear why eyes are here... maybe they rely on textures that were just remapped.
      ; (-> *display* frames (-> *display* on-screen) global-buf)
      ; (update-eyes)


      ;; end each normal bucket with the standard GS state reset
      (let ((s3-3 6)
            (s2-2 324)
            )
        (while (>= s2-2 s3-3)
          (default-end-buffer
            (the-as bucket-id s3-3)
            (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24))
            (new 'static 'gs-test :zte #x1 :ztst (gs-ztest greater-equal))
            )
          (+! s3-3 1)
          )
        )

      ;; initialize buckets with weird custom settings (disable z buffer)
      (default-init-buffer
        (bucket-id debug-no-zbuf1)
        (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1)
        (new 'static 'gs-test :zte #x1 :ztst (gs-ztest always))
        )
      (default-init-buffer
        (bucket-id debug-no-zbuf2)
        (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1)
        (new 'static 'gs-test :zte #x1 :ztst (gs-ztest always))
        )
      (default-init-buffer
        (bucket-id screen-filter)
        (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1)
        (new 'static 'gs-test :zte #x1 :ztst (gs-ztest always))
        )
      (*post-draw-hook* (-> arg0 frames (-> arg0 on-screen) calc-buf))

      ;; final flushe
      (let* ((v1-70 s5-0)
             (a0-25 (the-as object (-> v1-70 base)))
             )
        (set! (-> (the-as dma-packet a0-25) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
        (set! (-> (the-as dma-packet a0-25) vif0) (new 'static 'vif-tag :imm #x148 :cmd (vif-cmd mark)))
        (set! (-> (the-as dma-packet a0-25) vif1) (new 'static 'vif-tag :cmd (vif-cmd flushe) :irq #x1 :msk #x1))
        (set! (-> v1-70 base) (the-as pointer (&+ (the-as dma-packet a0-25) 16)))
        )

      ;; link all buckets to build the final massive dma list.
      (dma-buffer-patch-buckets (-> s4-0 bucket-group) 327)

      ;; append the final END
      (let* ((v1-71 s5-0)
             (a0-28 (the-as object (-> v1-71 base)))
             )
        (set! (-> (the-as dma-packet a0-28) dma) (new 'static 'dma-tag :id (dma-tag-id end)))
        (set! (-> (the-as (pointer int64) a0-28) 1) 0)
        (set! (-> v1-71 base) (&+ (the-as pointer a0-28) 16))
        )

      ;; make sure nothing is in cache
      (flush-cache 0)

      ;; list final dma sizes
      (when (not (paused?))
        (when *stats-buffer*
          (let* ((a0-31 (-> s4-0 global-buf))
                 (v1-75 (-> s5-0 base))
                 (a2-4 (-> s5-0 data))
                 (s4-1 (-> a0-31 base))
                 (s5-1 (-> a0-31 data))
                 (s3-4 (-> a0-31 end))
                 )
            (format *stdcon* "~0kvu1 buf = ~d~%" (&- v1-75 (the-as uint a2-4)))
            (format *stdcon* "~0kglobal buf = ~d~%" (&- s4-1 (the-as uint s5-1)))
            (format *stdcon* "~0kbase = #x~x~%" s4-1)
            (format *stdcon* "~0kend = #x~x~%" s3-4)
            )
          )
        )
      ;; now the DMA is ready to send!
      )
    arg0
    )
  )

;; definition for function determine-pause-mode
(defun determine-pause-mode ()
  (when (and (or (not *progress-process*) (can-go-back? (-> *progress-process* 0)))
             (or (!= *master-mode* 'freeze) (and *debug-segment* (cpad-pressed? 0 select start) (cpad-hold? 0 l3)))
             )
    (if (or (cpad-pressed? 0 select start)
            (cond
              ((= *master-mode* 'menu)
               (cpad-pressed? 0 r3 r2 triangle circle)
               )
              (*cam-layout*
                #f
                )
              (else
                #f
                )
              )
            (or (and (logtest? (-> *cpad-list* cpads 0 valid) 128)
                     (= *master-mode* 'game)
                     (>= (-> *display* base-clock frame-counter) (-> *game-info* blackout-time))
                     (= (-> *setting-control* user-current bg-a) 0.0)
                     (and (= (-> *setting-control* user-current bg-a-force) 0.0)
                          (< (seconds 1003) (-> *display* real-clock frame-counter))
                          )
                     )
                (and (cpad-pressed? 0 r2) (or (= *master-mode* 'pause) (= *master-mode* 'menu)))
                *pause-lock*
                )
            )
        (toggle-pause)
        )
    )
  (if (and *progress-process* (!= *master-mode* 'progress))
      (deactivate-progress)
      )
  0
  )

(defun swap-display ((arg0 display))
  (display-frame-finish arg0)
  (display-sync arg0)
  (none)
  )


(define-extern prototypes-game-visible-set! (function pair symbol int))