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

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

;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Letterbox and blackout
;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun set-letterbox-frames ((arg0 time-frame))
  "Set the letterbox frame counter for arg0 frames in the future"
  (set! (-> *game-info* letterbox-time) (+ (current-time) arg0))
  (none)
  )

(defun letterbox ()
  "Draw the letterbox black rectangles"
  (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf))
                               (bucket-id debug-draw1)) ;; debug-draw1 is one of the last buckets
    ;; draw the two sprites
    (#cond
      ((not PC_PORT)
        (draw-sprite2d-xy dma-buf 0 0 512 25 (new 'static 'rgba :a #x80))
        (draw-sprite2d-xy dma-buf 0 199 512 26 (new 'static 'rgba :a #x80))
        )
      (#t
        (if (-> *pc-settings* use-vis?)
            ;; original game mode. dont do anything.
            (begin
              (draw-sprite2d-xy dma-buf 0 0 512 25 (new 'static 'rgba :a #x80))
              (draw-sprite2d-xy dma-buf 0 199 512 26 (new 'static 'rgba :a #x80)))
            ;; native mode. force 16x9 letterboxing always.
            (begin
              (cond
                ((< (-> *pc-settings* aspect-ratio) ASPECT_16X9)
                  ;; too tall. needs vertical letterboxing.
                  (let ((lbx-h (the int (* 112.0 (- 1.0 (/ (-> *pc-settings* aspect-ratio) ASPECT_16X9))))))
                    (draw-sprite2d-xy dma-buf 0 0 512 lbx-h (new 'static 'rgba :a #x80))
                    (draw-sprite2d-xy dma-buf 0 (- 224 lbx-h) 512 lbx-h (new 'static 'rgba :a #x80))
                      )
                  )
                ((> (-> *pc-settings* aspect-ratio) ASPECT_16X9)
                  ;; too wide. needs horizontal letterboxing.
                  (let ((lbx-w (the int (* 256.0 (- 1.0 (/ ASPECT_16X9 (-> *pc-settings* aspect-ratio)))))))
                    (draw-sprite2d-xy dma-buf 0 0 lbx-w 224 (new 'static 'rgba :a #x80))
                    (draw-sprite2d-xy dma-buf (- 512 lbx-w) 0 lbx-w 224 (new 'static 'rgba :a #x80))
                      )
                  )
                )
              )
            )
        )
      )
    )
  (none)
  )

(defun set-blackout-frames ((arg0 time-frame))
  "Set the blackout frame counter. If arg0 is 0, disables blackout immediately.
   Otherwise, this can only be used to increase the blackout period."
  (cond
    ((zero? arg0)
     (set! (-> *game-info* blackout-time) (current-time))
     )
    (else
     (set! (-> *game-info* blackout-time) (max (-> *game-info* blackout-time)
                                               (+ (current-time) arg0)))
     )
    )
  (none)
  )

(defun blackout ()
  "Draw the blackout rectangle, convering the entire screen in darkness."
  (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf))
                               (bucket-id debug-draw1)) ;; debug-draw1 is one of the last buckets
    (draw-sprite2d-xy dma-buf 0 0 512 224 (new 'static 'rgba :a #x80))
    )
  (none)
  )


;;;;;;;;;;;;;;;;;;;;;
;; Pause/Master Mode
;;;;;;;;;;;;;;;;;;;;;

(defun paused? ()
  "Are we paused? True if *master-mode* = pause, progress is not hidden, or *master-mode* = menu"
  (the-as symbol
          (or (= *master-mode* 'pause)
              (or (and *progress-process* (not (hidden? (-> *progress-process* 0))))
                  (= *master-mode* 'menu)
                  )
              )
          )
  )

(defun movie? ()
  "Are we in a movie?"
  (logtest? (-> *kernel-context* prevent-from-run) (process-mask movie))
  )

(defun set-master-mode ((new-mode symbol))
  "Update pause masks for the given mode, and set *master-mode*"
  (set! *master-mode* new-mode)
  (if *debug-segment*
      (menu-respond-to-pause)
      )
  (case *master-mode*
    (('pause)

     ;; request the pause mask to be set in prevent-from-run.
     ;; this will block any process with pause from running, pausing most game objects.
     (if (not *debug-pause*)
         (logior! (-> *setting-control* default process-mask) (process-mask pause))
         )

     ;; allow the menu to run.
     (logclear! (-> *setting-control* default process-mask) (process-mask menu))

     ;; ??
     (set! *pause-lock* #f)
     (sound-group-pause (the-as uint 255))
     (hide-progress-screen)
     )
    (('menu)
     ;; I believe these masks are just to make the progress go away work.
     (logior! (-> *setting-control* default process-mask) (process-mask menu))
     (logclear! (-> *setting-control* default process-mask) (process-mask pause progress))
     (set! *pause-lock* #f)
     (hide-progress-screen)
     )
    (('progress)
     ;; allow menu to run while in progress.
     (logclear! (-> *setting-control* default process-mask) (process-mask menu))

     ;; activate the progress menu.
     (when (not *progress-process*)
       (activate-progress *dproc* (progress-screen fuel-cell))
       (if (not *progress-process*) ;; if it doesn't want to activate, back to game.
           (set-master-mode 'game)
           )
       )
     )
    (('game)
     ;; allow pausable/menu to run.
     (logclear! (-> *setting-control* default process-mask) (process-mask pause menu))
     (sound-group-continue (the-as uint 255))
     (hide-progress-screen)
     )
    )
  ;; apply settings now.
  (copy-settings-from-target! *setting-control*)
  0
  (none)
  )

(define *last-master-mode* 'game)

(defun toggle-pause ()
  "Do pause/menu/progress transitions"
  (case *master-mode*
    (('game)
     ;; coming from normal gameplay
     (set! *last-master-mode* *master-mode*)
     (set-master-mode
      (cond
        ;; first, check if the controller fell out, and jak is spawned
        ((and (nonzero? (logand (-> *cpad-list* cpads 0 valid) 128)) *target*)
         (if (or *progress-process* (not (-> *setting-control* current allow-pause)))
             *master-mode*
             'pause ;; no controller, jak spawned, no progress open, pause allowed.
             )
         )
        (else
         (cond
           ;; try to open the debug menu:
           ((cpad-hold? 0 r3)
            ;; R3 pushed, no target.
            (if *debug-segment*
                'menu ;; go to debug menu, when in debug mode.
                *master-mode*
                )
            )
           (else
            (cond
              ;; debug mode pause allowed with select or R2.
              ((and (or (cpad-hold? 0 select)
                        (cpad-hold? 0 r2)
                        )
                    *debug-segment*
                    )
               ;; pushing select or R2, and debug. allow pause.
               'pause
               )
              (else
               (cond
                 ;; ignore anything below here, unless we are pressing start, or debug.
                 ((and (not *debug-segment*)
                       (zero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons start)))
                       )
                  *master-mode*
                  )

                 ;; if you pressed start, and progress isn't allowed, but pause is, do a pause.
                 ((not (progress-allowed?))
                  (if (pause-allowed?)
                      'pause
                      *master-mode*
                      )
                  )

                 ;; pushing start.
                 ((cpad-hold? 0 start)
                  ;; toggle between progress/game
                  (if *progress-process*
                      'game
                      'progress
                      )
                  )
                 (else
                  ;; nothing requested, stay in game.
                  *master-mode*
                  )
                 )
               )
              )
            )
           )
         )
        )
      )
     )
    (('menu)
     ;; in debug menu
     (set-master-mode
      (cond
        ;; push R3 to exit to previous master mode.
        ((cpad-hold? 0 r3)
         *last-master-mode*
         )
        ;; select/R2 to pause.
        ((cpad-hold? 0 select r2)
         (if *debug-segment*
             'pause
             *master-mode* ;; not sure we can get to menu in non-debug...
             )
         )
        (else
         (cond
           ((and (not (movie?)) (not *progress-process*))
            (if (not *target*)
                'pause
                'progress
                )
            )
           (else
            'game
            )
           )
         )
        )
      )
     (set! *pause-lock* (and *cheat-mode* (cpad-hold? 0 r2)))
     )
    (('pause)
     (set! *last-master-mode* *master-mode*)
     (set-master-mode
      (cond
        ;; pause -> debug menu
        ((cpad-hold? 0 r3)
         (if *debug-segment*
             'menu
             *master-mode*
             )
         )
        (else
         (cond
           ;; pause -> single frame advance (R2)
           ((and *cheat-mode*
                 (cpad-hold? 0 select r2)
                 )
            'game
            )
           ;; pause -> game
           ((cpad-hold? 0 start)
            'game
            )
           (else
            *master-mode*
            )
           )
         )
        )
      )
     (set! *pause-lock* (and *cheat-mode* (cpad-hold? 0 r2)))
     )
    (('progress)
     (set-master-mode
      (cond
        ;; progress -> debug
        ((cpad-hold? 0 r3)
         (if *debug-segment*
             'menu
             *master-mode*
             )
         )
        (else
         ;; un-progress
         (if (cpad-hold? 0 start)
             *last-master-mode*
             *master-mode*
             )
         )
        )
      )
     (set! *pause-lock* (and *cheat-mode* (cpad-hold? 0 r2)))
     )
    )
  0
  )

(define *screen-filter*
    (new 'static 'screen-filter
         :draw? #f
         :color (new 'static 'rgba :g #x20 :b #x40 :a #x50)
         )
  )

(defmethod draw screen-filter ((obj screen-filter))
  (with-dma-buffer-add-bucket ((buf (-> (current-frame) global-buf)) (bucket-id debug-draw1))
    (draw-sprite2d-xy buf -256 (- (-> *video-parms* screen-hy)) 512 (-> *video-parms* screen-sy) (-> obj color))
    )
  (none)
  )

;;;;;;;;;;;;;;;;;;;;;;
;; Cheat Codes
;;;;;;;;;;;;;;;;;;;;;;

(define *cheat-temp* (the-as (pointer int32) (malloc 'global 20))) ;; 16 -> 20 (PAL)
(define *master-exit* #f)
(define *progress-cheat* #f)
(define *first-boot* #t) ;; PAL

(defun main-cheats ()
  "Handle cheat codes and timeout"

  ;; look for codes when L3 is pushed
  (when (and (cpad-hold? 0 l3)
             (or *cheat-mode* (= *kernel-boot-message* 'play)) ;; not in demo
             )

    ;; cheat mode
    (check-cheat-code (-> *cheat-temp* 0) 0
        (up up down down left right left right x x square circle square circle)
          (cpad-clear! 0 r1)
          ;; toggle!
          (not! *cheat-mode*)
          (cheats-sound-play *cheat-mode*)
        )

    ;; debug mode
    (when *cheat-mode*
      (check-cheat-code (-> *cheat-temp* 1) 0
          (circle square circle square x x right left right left down down up up)
            (cpad-clear! 0 r1)
            ;; toggle between #t and debug.
            (set! *cheat-mode* (if (= *cheat-mode* 'debug)
                                        #t
                                        'debug
                                        ))
            (cheats-sound-play *cheat-mode*)
          )
      )

    ;; language cheat
    (case (scf-get-territory)
      ;; japan-only
      ((GAME_TERRITORY_SCEI)
        (check-cheat-code (-> *cheat-temp* 2) 0
            (l1 r1 l1 r1 triangle circle x square)
              (cpad-clear! 0 r1)
              (set! *progress-cheat* (if *progress-cheat*
                                           #f
                                           'language
                                           ))
              (cheats-sound-play *progress-cheat*)
            )
       )
      )


    ;; debug only PAL cheat
    (when *debug-segment*
      (check-cheat-code (-> *cheat-temp* 3) 0
          (x square triangle circle x square triangle circle)
            (cpad-clear! 0 r1)
            (set! *progress-cheat* (if *progress-cheat*
                                         #f
                                         'pal
                                         ))
            (cheats-sound-play *progress-cheat*)
          )

      ;; added in PAL
      (check-cheat-code (-> *cheat-temp* 4) 0 ;; they erroneously used (-> *cheat-temp* 5) here!
          (triangle x circle square triangle x circle square)
            (cpad-clear! 0 r1)
            (set! *cheat-mode* (if (= *cheat-mode* 'camera)
                                        #f
                                        'camera
                                        ))
            (cond
             (*cheat-mode*
              (if (not *external-cam-mode*)
               (external-cam-reset!)
               )
              (set! *external-cam-mode* 'pad-1)
              (sound-play-by-name (static-sound-name "select-menu") (new-sound-id) 1024 0 0 1 #t)
              )
             (else
              (set! *external-cam-mode* #f)
              (sound-play-by-name (static-sound-name "cursor-options") (new-sound-id) 1024 0 0 1 #t)
              )
             )
          )
      )
    )


  ;; debug cheats on retail builds
  (when (and (= *cheat-mode* 'debug) (not *debug-segment*))

    ;; target start/stop with l1/r1/l2/r2
    (when (and (cpad-hold? 0 l1)
               (cpad-hold? 0 l2)
               (cpad-hold? 0 r1)
               (cpad-pressed? 0 r2)
               )
      (if *target*
          (stop 'debug)
          (start 'play (get-or-create-continue! *game-info*))
          )
      )


    ;; reinitialize to title-start with left, up, select
    (if (and (cpad-hold? 0 left)
             (cpad-hold? 0 up)
             (cpad-pressed? 0 select)
             )
        (initialize! *game-info* 'game (the-as game-save #f) "title-start")
        )

    ;; push R3 to print global heap status. not very useful.
    (if (cpad-pressed? 1 r3)
     (inspect global)
     )

    ;; push R3 to display IOP memory stats
    (when (cpad-hold? 1 r3)
      ;; grab a dma buffer
      (with-dma-buffer-add-bucket ((dma-buff (if *debug-segment*
                                               (-> (current-frame) debug-buf)
                                               (-> (current-frame) global-buf)
                                               ))
                                   (bucket-id debug-draw0))
        (show-iop-memory dma-buff)
        )
      )


    ;; push triangle to see level info
    (if (cpad-pressed? 1 triangle)
      (not! *display-level-border*)
      )
    )

  ;; handle timeouts
  (when (!= *kernel-boot-message* 'play) ;; not regular game mode?
    (let ((timeout (scf-get-timeout))
          (inactive-timeout (scf-get-inactive-timeout))
          )
      (when (and (or
                  ;; aboslute timout elapsed.
                  (and (nonzero? timeout)
                       (>= (the-as int (+ -300000 (the-as int (-> *display* real-frame-counter))))
                           (the int (* 300.0 (the float timeout)))
                           )
                       )
                  (and (nonzero? inactive-timeout)
                       (>= (the-as int (- (current-time) (cpad-change-time 0)))
                           (the int (* 300.0 (the float inactive-timeout)))
                           )
                       )
                  (= *master-exit* 'force)
                  )
                 (progress-allowed?)
                 (!= *master-exit* #t)
                 )

        ;; spawn a process that blacks out the screen, turns things off, and kills the game.
        (if (make-function-process process :stack *scratch-memory-top*
              (lambda :behavior process ()
                (set-blackout-frames (seconds 100))
                (set! (-> *setting-control* default allow-pause) #f)
                (set! (-> *setting-control* default allow-progress) #f)
                (copy-settings-from-target! *setting-control*)
                (set! (-> *setting-control* default sfx-volume) 0.0)
                (set! (-> *setting-control* default music-volume) 0.0)
                (set! (-> *setting-control* default dialog-volume) 0.0)
                (set! (-> *setting-control* default ambient-volume) 0.0)
                (let ((gp-0 (current-time)))
                  (until (>= (the-as int (- (current-time) gp-0)) (seconds 0.1))
                    (suspend)
                    )
                  )
                (kernel-shutdown)
                (none)
                )
              )

            (set! *master-exit* #t) ;; process created successfully, set to exit
            )
        )
      )
    )
  0
  )

(defconstant MEM_BAR_WIDTH 152)
(defconstant MEM_BAR_HEIGHT 8)
(defconstant MEM_BAR_NUM 7)
(defconstant MEM_BAR_BG_COL (static-rgba 64 64 64 64))
(defconstant MEM_BAR_X (- 480 MEM_BAR_WIDTH))
(defconstant MEM_BAR_Y (- 224 4 (* MEM_BAR_HEIGHT MEM_BAR_NUM)))
(defmacro draw-memory-bar-generic (buf &key remain &key total &key name &key idx &key color)
  `(let* (
        (total  (the float ,total))
        (remain (the float ,remain))
        (used-p (/ (- total remain) total))
        (used-x (the int (* used-p MEM_BAR_WIDTH)))
        (used-y (+ MEM_BAR_Y (* ,idx MEM_BAR_HEIGHT)))
        )
      (draw-sprite2d-xy ,buf    MEM_BAR_X         used-y used-x MEM_BAR_HEIGHT ,color)
      (draw-sprite2d-xy ,buf (+ MEM_BAR_X used-x) used-y (- MEM_BAR_WIDTH used-x) MEM_BAR_HEIGHT MEM_BAR_BG_COL)
      (draw-string-xy ,name ,buf MEM_BAR_X used-y (font-color red) (font-flags shadow kerning right))
      (draw-string-xy (string-format "~,,2f%" (* used-p 100)) ,buf (+ MEM_BAR_X used-x) used-y (font-color red) (font-flags shadow kerning middle))
      (draw-string-xy (string-format "~,,1fM" (/ total (* 1024 1024))) ,buf (+ MEM_BAR_X MEM_BAR_WIDTH) used-y (font-color red) (font-flags shadow kerning left))
      )
  )
(defmacro draw-memory-bar-kheap (buf heap &key (name #f) &key idx &key color)
  `(let ((heap ,heap))
      (draw-memory-bar-generic ,buf
              :remain (&- (-> heap top) (-> heap current))
              :total  (&- (-> heap top) (-> heap base))
              :name ,(if name name (symbol->string heap))
              :idx ,idx
              :color ,color)
      )
  )
(defmacro draw-memory-bar-dead-pool-heap (buf heap &key (name #f) &key idx &key color)
  `(let* ((heap ,heap) (pool-total (memory-total heap)))
      (draw-memory-bar-generic ,buf
              :remain (- pool-total (memory-used heap))
              :total  pool-total
              :name ,(if name name (symbol->string heap))
              :idx ,idx
              :color ,color)
      )
  )

(defbehavior display-loop process ()
  "This is in progress..."

  ;; increase our stack size.
  (stack-size-set! (-> self main-thread) 512)

  (let ((disp *display*))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;; Pre loop initialization
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    ;; the size is 0, so this doesn't actually do anything.
    ;; (dma-send-to-spr (the-as uint #x70000000) (the-as uint *terrain-context*) (the-as uint 0) #t)
    (set! *teleport* #t)
    (update-per-frame-settings! *setting-control*)
    (init-time-of-day-context *time-of-day-context*)
    (display-sync disp)
    (swap-display disp)
    (free-all-prim-nodes *touching-list*)
    (blerc-init)
    ;; collide dma
    (suspend)


    (while *run*
      ;; start immediately after all process updates finish.
      (profiler-instant-event "display-loop-top")

      ;; drawing effects to be used in foreground drawing.
      (with-profiler "foreground-effects"
        (blerc-execute)
        (blerc-init)
        (texscroll-execute)
        (ripple-execute)
        )

      ;;;;;;;;;;;;;;;;;;;;
      ;; AMBIENT
      ;;;;;;;;;;;;;;;;;;;;

      ;; set defaults for weather/music/flava.
      (with-profiler "ambients"
        (set! *weather-off* #f)
        (let ((v1-13 (-> *game-info* current-continue level)))
          (dotimes (a0-8 (-> *level* length))
            (let ((a1-6 (-> *level* level a0-8)))
              (when (= (-> a1-6 status) 'active)
                (if (and (= (-> a1-6 name) v1-13) (-> *level* play?))
                    (set! (-> *setting-control* default music) (-> a1-6 info music-bank))
                    )
                )
              )
            )
          )

        (set! (-> *setting-control* default sound-flava) (the-as uint 49))
        (set! (-> *setting-control* default sound-flava-priority) 0.0)

        ;; find any ambients, and execute them.
        (when (and *execute-ambients* (not (paused?)))
          (if *target*
              (set! (-> *target* draw secondary-interp) 0.0)
              )
          (let ((s5-1 (sphere<-vector+r! (new 'stack 'sphere) (ear-trans) 0.0)))
            (let ((v1-28 (scratchpad-object terrain-context)))
              (set! (-> v1-28 work ambient ambient-list num-items) 0)
              )
            (dotimes (s4-1 (-> *level* length))
              (let ((v1-32 (-> *level* level s4-1)))
                (when (= (-> v1-32 status) 'active)
                    (collect-ambients (-> v1-32 bsp) s5-1 0 (-> (scratchpad-object terrain-context) work ambient ambient-list))
                    )
                )
              )

            (countdown (s4-2 (-> (scratchpad-object terrain-context) work ambient ambient-list num-items))
              (execute-ambient (-> (scratchpad-object terrain-context) work ambient ambient-list items s4-2) s5-1)
              )
            )
          )
        )
      (add-ee-profile-frame 'draw :r #x40 :b #x40) ;; actor update

      ;; do math, before drawing
      (with-profiler "math-engine" (execute-math-engine))
      ;; DEBUG PROF
      (add-ee-profile-frame 'draw :r #x80)
      (add-ee-profile-frame 'draw :r #x40 :b #x40)
      ;; debug hook
      (with-profiler "debug" (*debug-hook*) (main-cheats))
      (add-ee-profile-frame 'draw :r #x20 :g #x20)
      (with-profiler "camera" (update-camera))
      (add-ee-profile-frame 'draw :r #x40 :b #x40)
      (with-profiler "draw-hook" (*draw-hook*))
      (add-ee-profile-frame 'draw :g #x80)

      (with-profiler "menu"
        (with-pc
          (if (-> *pc-settings* display-sha)
              (draw-build-revision)))

        (*menu-hook*)
        (add-ee-profile-frame 'draw :g #x40)

        ;; finally, update hints/text
        (make-current-level-available-to-progress)
        (update-task-hints)
        (load-level-text-files -1)

        (add-ee-profile-frame 'unknown-cpu-time)
        ;; collect perf stats
        (read! (-> *perf-stats* data (perf-stat-bucket all-code)))
        )

      (with-profiler "dma-sync"
        (when (nonzero? (sync-path 0 0))
          (*dma-timeout-hook*)
          (reset-vif1-path)
          (if *debug-segment*
              (format 0 "profile bar at ~D.~%" (-> (current-frame) profile-bar 1 profile-frame-count))
              )
          )
        (reset! (-> *perf-stats* data (perf-stat-bucket all-code)))
        )

      ;; depth cue
      ;; screen filter

      (with-profiler "post-sync-draw"
      ;; add letterbox effect
      (when (or (movie?) (< (-> *display* base-frame-counter) (-> *game-info* letterbox-time)))
        (if (< (-> *game-info* letterbox-time) (-> *display* base-frame-counter))
            (set! (-> *game-info* letterbox-time) (-> *display* base-frame-counter))
            )
        (if (#if (not PC_PORT)
                 (= (-> *setting-control* current aspect-ratio) 'aspect4x3)
                 (or (not (-> *pc-settings* use-vis?)) (and (-> *pc-settings* use-vis?) (= (-> *setting-control* current aspect-ratio) 'aspect4x3))))
            (letterbox)
            )
        )

      ;; add blackout effect
      (if (< (-> *display* base-frame-counter) (-> *game-info* blackout-time))
          (set! (-> *setting-control* default bg-a-force) 1.0)
          (set! (-> *setting-control* default bg-a-force) 0.0)
          )
      (read! (-> *perf-stats* data (perf-stat-bucket all-code)))

      ;; grab a buffer for drawing debug stuff.
      ;; we might draw even outside of debug mode if cheat-mode is disabled.
      (let ((debug-txt-buf
             (-> (if *debug-segment*
                     (-> disp frames (-> disp on-screen) frame debug-buf)
                     (-> disp frames (-> disp on-screen) frame global-buf)
                     )
                 base
                 )
              )
            )

        ;; debug drawing
        (when *debug-segment*
          (#when PC_PORT
            (if (-> *pc-settings* debug-pad-display)
              (debug-pad-display (-> *cpad-list* cpads 0))
              )
            (when (and (or (= *master-mode* 'game) (= *master-mode* 'pause)) (-> *entity-debug-inspect* entity))
              (define-extern entity-inspect-draw (function entity-debug-inspect object))
              (entity-inspect-draw *entity-debug-inspect*)
              )
            )

          (debug-draw-buffers) ;; lines/text

          ;; debug dma
          (with-dma-buffer-add-bucket ((debug-buf (-> disp frames (-> disp on-screen) frame debug-buf))
                                       (bucket-id debug-draw1))
            (when *display-profile*
              (dma-buffer-add-gs-set debug-buf
                      (alpha-1 (new 'static 'gs-alpha :b 1 :d 1))
                      (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24) :zmsk 1))
                      (test-1 (new 'static 'gs-test :zte 1 :ztst (gs-ztest always)))
                      (pabe 0)
                      (clamp-1 (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
                      (tex1-1 (new 'static 'gs-tex1 :mmag 1 :mmin 1))
                      (texa (new 'static 'gs-texa :ta1 #x80))
                      (texclut (new 'static 'gs-texclut :cbw 4))
                      (fogcol *fog-color*)
                      )

              ;; draw the profile bars
              (dotimes (s2-0 2)
                (let ((s1-0 (-> disp frames (-> disp on-screen) frame profile-bar s2-0)))
                  (add-end-frame s1-0 'end-draw (static-rgba #x40 #x40 #x40 #x40))
                  (draw s1-0 debug-buf (* 10 s2-0))
                  )
                0
                )
              ) ;; end profiler draw


            (when *display-deci-count*
              (draw-string-xy (string-format "~D" *deci-count*) debug-buf 448 210 (font-color default) (font-flags shadow kerning))
              )

            ;; added
            (#when PC_PORT
              (when (-> *pc-settings* debug?)
                (draw *pc-settings* debug-buf)
                )
              (when (-> *pc-settings* display-actor-bank)
                (draw-string-xy (string-format "Actor Bank: ~,,1m/~,,1m (~D)" (-> *ACTOR-bank* pause-dist) (-> *ACTOR-bank* birth-dist) (-> *ACTOR-bank* birth-max)) debug-buf 512 (- 224 8) (font-color default) (font-flags shadow kerning right))
                )
              (when (-> *pc-settings* display-bug-report)
                (format *stdcon* "bug-report ~A~%" *user*)
                (format *stdcon* "nick ~A continue ~S~%" (-> *load-state* vis-nick) (-> *game-info* current-continue name))
                (dotimes (i LEVEL_COUNT)
                  (format *stdcon* "level ~D ~12A ~A~%" i (-> *level* level i name) (-> *level* level i display?))
                  )
                (format *stdcon* "music ~A (f: ~D/~S) sound ~A ~A~%"
                    (-> *setting-control* current music) (-> *setting-control* current sound-flava) (enum->string music-flava (-> *setting-control* default sound-flava))
                    *sound-bank-1* *sound-bank-2*)
                (let ((pos (target-pos 0)))
                    (format *stdcon* "target ~m ~m ~m~%" (-> pos x) (-> pos y) (-> pos z))
                    )
                (let ((pos (camera-pos)))
                    (format *stdcon* "cam-trans ~m ~m ~m~%" (-> pos x) (-> pos y) (-> pos z))
                    )
                (let ((rot (new 'stack 'quaternion)))
                    (matrix->quaternion rot (-> *math-camera* camera-rot))
                    (format *stdcon* "cam-rot ~f ~f ~f ~f~%" (-> rot x) (-> rot y) (-> rot z) (-> rot w))
                    )
                )
              (when (-> *pc-settings* display-heap-status)
                (draw-memory-bar-kheap debug-buf global :idx 0 :color (static-rgba 32 32 255 64))
                (draw-memory-bar-kheap debug-buf debug :idx 1 :color (static-rgba 255 32 32 64))
                (draw-memory-bar-kheap debug-buf (-> *level* level 0 heap) :name "l0" :idx 2 :color (static-rgba 32 255 255 64))
                (draw-memory-bar-kheap debug-buf (-> *level* level 1 heap) :name "l1" :idx 3 :color (static-rgba 255 32 255 64))
                (draw-memory-bar-dead-pool-heap debug-buf *nk-dead-pool* :name "actor" :idx 4 :color (static-rgba 32 255 32 64))
                (draw-memory-bar-generic debug-buf
                        :remain (* 16 (dma-buffer-free (-> disp frames (-> disp on-screen) frame global-buf)))
                        :total  (length (-> disp frames (-> disp on-screen) frame global-buf))
                        :name "dma-global" :idx 5 :color (static-rgba 32 32 255 64))
                (draw-memory-bar-generic debug-buf
                        :remain (* 16 (dma-buffer-free (-> disp frames (-> disp on-screen) frame debug-buf)))
                        :total  (length (-> disp frames (-> disp on-screen) frame debug-buf))
                        :name "dma-debug" :idx 6 :color (static-rgba 255 32 32 64))
                )
              )

            #|
            (format *stdcon* "~3Lfree DMA global: ~d debug: ~d~0L~%"
                    (dma-buffer-free (-> disp frames (-> disp on-screen) frame global-buf))
                    (dma-buffer-free (-> disp frames (-> disp on-screen) frame debug-buf))
                    )
            ;; added, prints some level status.
            (dotimes (i 2)
              (let ((level-heap (-> *level* level i heap)))
                (format *stdcon* "~17Llevel ~d: ~A ~A ~,,2fK remaining~0L~%"
                        i
                        (-> *level* level i name)
                        (-> *level* level i status)
                        (* (1/ 1024) (&- (-> level-heap top) (-> level-heap current)))
                        )
                )
              )
              |#

            (display-file-info)
            ) ;; end dma let
          ) ;; end debug-segment

        ;; draw pause text.
        (with-dma-buffer-add-bucket ((s3-1 (if *debug-segment*
                                               (-> disp frames (-> disp on-screen) frame debug-buf)
                                               (-> disp frames (-> disp on-screen) frame global-buf)
                                               ))
                                     (bucket-id debug-draw0))
          (if (and (= *master-mode* 'pause) (!= *cheat-mode* 'camera))
              (draw-string-xy (lookup-text! *common-text* (game-text-id pause) #f)
               s3-1 256 160 (font-color orange-red) (font-flags shadow kerning middle large))
              )

          ;; draw console text on screen
          (let ((a3-8 (the int (draw-string *stdcon0* s3-1 *font-context*))))
            (draw-string-xy *stdcon1* s3-1 (the int (-> *font-context* origin x)) a3-8 (font-color default) (font-flags shadow kerning))
            )

          ;; draw misc info
          (if *display-iop-info*
              (show-iop-info s3-1)
              )
          (if *display-memcard-info*
              (show-mc-info s3-1)
              )
          )
        (let ((v1-220 *dma-mem-usage*))
          (when (nonzero? v1-220)
            (set! (-> v1-220 length) (max 85 (-> v1-220 length)))
            (set! (-> v1-220 data 84 name) "debug")
            (+! (-> v1-220 data 84 count) 1)
            (+! (-> v1-220 data 84 used)
                (&- (-> (if *debug-segment*
                            (-> disp frames (-> disp on-screen) frame debug-buf)
                            (-> disp frames (-> disp on-screen) frame global-buf)
                            )
                        base
                        )
                    (the-as uint debug-txt-buf)
                    )
                )
            (set! (-> v1-220 data 84 total) (-> v1-220 data 84 used))
            )
          )
        )

      ;; console buffers
      (set! *stdcon* (clear *stdcon0*))
      )

      ;; <--------------------------- SWAP DISPLAY!
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      (with-profiler "swap-display" (swap-display disp))
      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

      (set! (-> *time-of-day-context* title-updated) #f)
      (set! *teleport* #f)
      (when (nonzero? *teleport-count*)
        (set! *teleport* #t)
        (set! *teleport-count* (+ *teleport-count* -1))
        )

      ;; perf stats

      (with-profiler "process-particles" (process-particles))

      ;; vif0 collide
      ;; swap sound
      ;; str play
      (with-profiler "sound-update"
                     (swap-sound-buffers (ear-trans) (camera-pos) (camera-angle))
                     (str-play-kick)
                     )

      (with-profiler "level-and-save"
         (level-update *level*) ;; also updates settings.
         (mc-run)
         (auto-save-check)

         (#when PC_PORT
           (update *pc-settings*)
           )
         )


      ;; suspend
      (suspend)
      )
    )


  0
  )

(defun on ((release-mode symbol))
  "Turn the game on."

  (when (not *dproc*)
    (unless release-mode
      (if (= (-> *level* level0 status) 'inactive)
        (bg 'halfpipe)
        )
      )
    (set! *run* #t)
    (let ((new-dproc (make-function-process process display-loop :name 'display
                                                                 :from *4k-dead-pool* :to *display-pool*)))
      (set! *dproc* (the process (ppointer->process new-dproc)))
      )
    (cond
      ((or (level-get-with-status *level* 'loaded)
           (level-get-with-status *level* 'alive)
           (level-get-with-status *level* 'active)
           )
       (activate-levels! *level*)
       (when (not release-mode)
         (let ((entity-cam (entity-by-type camera-start)))
             (if (and entity-cam (type-type? (-> entity-cam type) entity-actor))
               (camera-teleport-to-entity entity-cam)
               )
             )
         )
       )
      (else
       (kill-by-name 'display *active-pool*)
       (set! *dproc* #f)
       )
      )
    *dproc*
    )
  )

(defun off ()
  "Turn the game off."

  ;; stop the game and set the mode to debug
  (stop 'debug)
  ;; deactivate the levels
  (dotimes (i (-> *level* length))
    (let ((lev (-> *level* level i)))
        (if (= (-> lev status) 'active)
          (deactivate lev)
          )
        )
    )
  (set! *run* #f)
  0
  )