jak-project/goal_src/jak1/pc/pckernel.gc

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

#|

  This file contains new code that we need for the PC port of the game specifically.
  It should be included as part of the game engine package (engine.cgo).

  This file contains various types and functions to store PC-specific information
  and also to communicate between the game (GOAL) and the operating system.
  This way we can poll, change and display information about the system the game
  is running on, such as:
  - display devices and their settings, such as fullscreen, DPI, refresh rate, etc.
  - audio devices and their settings, such as audio latency, channel number, etc.
  - graphics devices and their settings, such as resolution, FPS, anisotropy, shaders, etc.
  - input devices and their settings, such as controllers, keyboards, mice, etc.
  - information about the game window (position, size)
  - PC-specific goodies, enhancements, fixes and settings.
  - whatever else.

  If you do not want to include these PC things, you should exclude it from the build system.

 |#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; global variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; collision renderer things. debug only.
(define *collision-renderer* #f)
(define *collision-wireframe* #f)
(define *collision-mode* (pc-collision-mode mode))

;; todo
(defenum pc-pat-skip-hack
  :bitfield #t
  (noentity 0)
  (nocamera 1)
  (noedge   2)
  (nolineofsight 12)
  (unknowncamera 13)
  (unknown 15)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; updates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defmethod set-display-mode! pc-settings ((obj pc-settings) (mode symbol))
  "sets the game's display mode"

  ;; change the display mode.
  (set! (-> obj display-mode) mode)
  0)

(defmethod set-size! pc-settings ((obj pc-settings) (width int) (height int))
  "sets the size of the display window"
  (format #t "Setting size to ~D x ~D~%" width height)
  (cond
    ((= 'windowed (-> obj display-mode))
      (set! (-> obj win-width) width)
      (set! (-> obj win-height) height)
      )
    (else
      (format 0  "Nope! No changing fullscreen resolution for now!~%")
      (format #t "Nope! No changing fullscreen resolution for now!~%")
      )
    )
  (none))


(defmethod set-aspect! pc-settings ((obj pc-settings) (aw int) (ah int))
  "set the aspect ratio used for rendering. this forces native widescreen and takes width and height ratios."
  (let ((aspect (/ (the float aw) (the float ah))))
    (set-aspect-ratio! obj aspect)
    (set! (-> obj aspect-custom-x) aw)
    (set! (-> obj aspect-custom-y) ah)
    (set! (-> obj aspect-ratio-auto?) #f)
    (set! (-> obj use-vis?) #f)
    )
  (none))

(defmethod set-aspect-ratio! pc-settings ((obj pc-settings) (aspect float))
  "set the aspect ratio used for rendering."
  (set! (-> obj aspect-ratio) aspect)
  (set! (-> obj aspect-ratio-scale) (/ aspect ASPECT_4X3))
  (set! (-> obj aspect-ratio-reciprocal) (/ ASPECT_4X3 aspect))
  (none))

(defmethod set-window-lock! pc-settings ((obj pc-settings) (lock symbol))
  "set the aspect ratio used for rendering."
  (pc-set-window-lock lock)
  (set! (-> obj window-lock?) lock))

(defmethod set-frame-rate! pc-settings ((obj pc-settings) (rate int))
  "set the aspect ratio used for rendering."
  
  (pc-set-frame-rate rate)
  (if (and (!= 'fullscreen (-> obj display-mode))
           (!= (pc-get-screen-rate -1) rate))
      (set! (-> obj vsync?) #f))
  (case rate
    ((60)
      (set! (-> obj target-fps) rate)
      (set! (-> *setting-control* default video-mode) 'ntsc)
      (set-video-mode 'ntsc)
      )
    ((100)
      (set! (-> obj target-fps) rate)
      (set! (-> *setting-control* default video-mode) '100fps)
      (set-video-mode '100fps)
      )
    ((150)
      (set! (-> obj target-fps) rate)
      (set! (-> *setting-control* default video-mode) '150fps)
      (set-video-mode '150fps)
      )
    )
  
  rate)

(defmethod commit-to-file pc-settings ((obj pc-settings))
  "commits the current settings to the file"
  ;; auto load settings if available

  (format (clear *pc-temp-string-1*) "~S/pc-settings.gc" *pc-settings-folder*)
  (pc-mkdir-file-path *pc-temp-string-1*)
  (write-to-file obj *pc-temp-string-1*)
  (none))

(defmethod update-from-os pc-settings ((obj pc-settings))
  "Update settings from the C kernel to GOAL."

  (set! (-> obj os) (pc-get-os))
  (pc-get-window-size (&-> obj real-width) (&-> obj real-height))
  (pc-get-window-scale (&-> obj dpi-x) (&-> obj dpi-y))

  (when (-> obj use-vis?)
    (if (= (-> *setting-control* default aspect-ratio) 'aspect4x3)
        (set-aspect-ratio! obj ASPECT_4X3)
        (set-aspect-ratio! obj ASPECT_16X9)
        )
    )

  (let ((win-aspect (/ (the float (-> obj real-width)) (the float (-> obj real-height)))))
    (cond
      ((and (not (-> obj use-vis?)) (-> obj aspect-ratio-auto?))
       ;; the window determines the resolution
       (set-aspect-ratio! obj win-aspect)
       (set! (-> obj lbox-width) (-> obj real-width))
       (set! (-> obj lbox-height) (-> obj real-height))
       )
      ((> win-aspect (-> obj aspect-ratio))
       ;; too wide
       (set! (-> obj lbox-width) (the int (* (the float (-> obj real-height)) (-> obj aspect-ratio))))
       (set! (-> obj lbox-height) (-> obj real-height))
       )
      ((< win-aspect (-> obj aspect-ratio))
       ;; too tall
       (set! (-> obj lbox-width) (-> obj real-width))
       (set! (-> obj lbox-height) (the int (/ (the float (-> obj real-width)) (-> obj aspect-ratio))))
       )
      (else
       ;; just right
       (set! (-> obj lbox-width) (-> obj real-width))
       (set! (-> obj lbox-height) (-> obj real-height))
       )
      )
    )


  (none))

(defmethod update-to-os pc-settings ((obj pc-settings))
  "Update settings from GOAL to the C kernel."

  (cond
    ((-> obj letterbox?)
     (pc-set-letterbox (-> obj lbox-width) (-> obj lbox-height))
     )
    (else
     (pc-set-letterbox (-> obj real-width) (-> obj real-height))
     )
    )

  (pc-set-fullscreen (-> obj display-mode) 0)
  (when (-> obj window-lock?)
    (pc-set-vsync (-> obj vsync?))

    (when (!= 'fullscreen (-> obj display-mode))
        (if (< (pc-get-screen-rate -1) (-> obj target-fps))
            (pc-set-vsync #f))
        (pc-set-frame-rate (-> obj target-fps)))

    (if (and (= 'windowed (-> obj display-mode))
             (or (!= (-> obj win-width) (-> obj real-width))
                 (!= (-> obj win-height) (-> obj real-height))))
        (pc-set-window-size (max PC_MIN_WIDTH (-> obj win-width)) (max PC_MIN_HEIGHT (-> obj win-height))))
    )

  (pc-discord-rpc-set (if (-> obj discord-rpc?) 1 0))

  (when #t ;; (not (-> obj ps2-lod-dist?))
    (pc-renderer-tree-set-lod (pc-renderer-tree-type tfrag3) (-> obj lod-force-tfrag))
    (pc-renderer-tree-set-lod (pc-renderer-tree-type tie3) (-> obj lod-force-tie))
    )

  (when *debug-segment*
    (pc-set-collision *collision-renderer*)
    (pc-set-collision-wireframe *collision-wireframe*)
    (pc-set-collision-mode *collision-mode*)
    )

  (pc-sound-set-flava-hack (-> obj flava-hack))
  (let ((fade-hack 0))
    (unless (-> obj music-fadein?) (logior! fade-hack 1))
    (unless (-> obj music-fadeout?) (logior! fade-hack 2))
    (pc-sound-set-fade-hack fade-hack)
    )

  (none))

(define *pc-cheat-temp* (the-as (pointer int32) (malloc 'global (* 4 8))))
(defmacro pc-cheat-toggle-and-tune (obj cheat)
  `(begin
    (cpad-clear! 0 r1)
    (logxor! (-> ,obj cheats) (pc-cheats ,cheat))
    (cheats-sound-play (logtest? (-> ,obj cheats) (pc-cheats ,cheat)))
    )
  )

(defun bcd->dec ((bcd uint))
  "Convert a number encoded in BCD to its decimal equivalent"
    (+ (* (shr (logand bcd #xf0) 4) 10) (logand bcd #x0f))
  )

(defmethod update pc-settings ((obj pc-settings))
  "Update settings to/from PC kernel. Call this at the start of every frame.
   This will update things like the aspect-ratio, which will be used for graphics code later."

  (update-from-os obj)
  (update-to-os obj)

  (set! (-> obj movie?) (movie?))

  (let ((info (new 'stack 'discord-info)))
    (set! (-> info fuel) (&-> *game-info* fuel))
    (set! (-> info money-total) (&-> *game-info* money-total))
    (set! (-> info buzzer-total) (&-> *game-info* buzzer-total))
    (set! (-> info deaths) (&-> *game-info* total-deaths))
    (set! (-> info status) "Playing Jak and Daxter: The Precursor Legacy™")
    (set! (-> info level) (symbol->string (-> (level-get-target-inside *level*) name))) ;; grab the name of level we're in
    (set! (-> info cutscene?) (-> obj movie?))
    (set! (-> info ogreboss?) (aif (process-by-ename "ogreboss-1") (case (-> it next-state name) (
                                      ('ogreboss-die
                                       'ogreboss-idle
                                       'ogreboss-stage1
                                       'ogreboss-stage2
                                       'ogreboss-stage3-hit
                                       'ogreboss-stage3-shuffle
                                       'ogreboss-stage3-throw
                                       'ogreboss-wait-for-player) #t))))
    (set! (-> info plant-boss?) (aif (process-by-ename "plant-boss-3") (case (-> it next-state name) (
                                      ('plant-boss-idle
                                       'plant-boss-hit
                                       'plant-boss-vulnerable
                                       'plant-boss-spawn
                                       'plant-boss-reset
                                       'plant-boss-attack) #t))))
    (set! (-> info racer?) (aif *target* (case (-> it next-state name) (
                                      ('target-racing
                                       'target-racing-bounce
                                       'target-racing-death
                                       'target-racing-falling
                                       'target-racing-grab
                                       'target-racing-hit
                                       'target-racing-jump
                                       'target-racing-smack
                                       'target-racing-start) #t))))
    (set! (-> info flutflut?) (aif *target* (case (-> it next-state name) (
                                      ('target-flut-air-attack
                                       'target-flut-air-attack-hit-ground
                                       'target-flut-double-jump
                                       'target-flut-falling
                                       'target-flut-grab
                                       'target-flut-hit
                                       'target-flut-hit-ground
                                       'target-flut-jump
                                       'target-flut-running-attack
                                       'target-flut-stance
                                       'target-flut-start
                                       'target-flut-walk) #t))))
    (set! (-> info time-of-day) (&-> *time-of-day-context* time))

    (with-profiler "discord-update" (pc-discord-rpc-update info))
    )

  (when (not (-> obj use-vis?))
    (set! (-> *video-parms* relative-x-scale) (-> obj aspect-ratio-reciprocal))
    (set! (-> *video-parms* relative-x-scale-reciprical) (-> obj aspect-ratio-scale))
    (set! (-> *font-default-matrix* vector 0 x) (-> *video-parms* relative-x-scale))
    )
  (when (not (-> obj use-vis?))
    (set-hud-aspect-ratio 'aspect4x3 'ntsc) ;; set hud aspect ratios every frame because why not?

    (when *progress-process*
      ;; adjust sizes for progress.
      ;; video.gc sets the sizes in the normal game.
      ;; this is a complete hack and i'm losing it
      (let ((pr (-> *progress-process*))
            ;(wide-adjust (* 4.0 (- (/ (-> obj aspect-ratio-scale) ASPECT_16X9_SCALE) (1/ ASPECT_16X9_SCALE))))
            )
          (set! (-> pr sides-x-scale) 1.0)
          (set! (-> pr sides-y-scale) 13.0)
          ;(set! (-> pr left-x-offset) (+ 59 (the int (* (-> obj aspect-ratio-scale) -59))))
          ;(set! (-> pr right-x-offset) 26)
          ;(set! (-> pr button-scale) (+ 1.0 (* wide-adjust 0.1)))
          )
      )
    )
  (cond
    ((-> obj force-actors?)
      ;; kinda overkill.
      (set! (-> *ACTOR-bank* birth-dist) (meters 10000))
      (set! (-> *ACTOR-bank* pause-dist) (meters 10000))
      (set! (-> *ACTOR-bank* birth-max) 1000)
      )
    ((> (-> *ACTOR-bank* birth-dist) (meters 220)) ;; the original caps at 220m, exceeding that means it was using our hacks
      (set! (-> *ACTOR-bank* birth-dist) (meters 220))
      (set! (-> *ACTOR-bank* pause-dist) (meters 220))
      ))

  ;; cheats.
  (update-cheats obj)
  ;; music.
  (update-music-log obj)

  (none))

(defmethod update-cheats pc-settings ((obj pc-settings))
  "run cheats."

  (when (and (cpad-hold? 0 l2) (cpad-hold? 0 l1) (cpad-hold? 0 r2) (cpad-hold? 0 r1))
    (pc-check-cheat-code (-> *pc-cheat-temp* 0) 0 (s p i r i t) :extra (x)
          (logclear! (-> obj cheats) (pc-cheats eco-red eco-yellow eco-green))
          (pc-cheat-toggle-and-tune obj eco-blue))

    (pc-check-cheat-code (-> *pc-cheat-temp* 1) 0 (s p i r i t) :extra (circle)
          (logclear! (-> obj cheats) (pc-cheats eco-blue eco-yellow eco-green))
          (pc-cheat-toggle-and-tune obj eco-red))

    (pc-check-cheat-code (-> *pc-cheat-temp* 2) 0 (s p i r i t) :extra (triangle)
          (logclear! (-> obj cheats) (pc-cheats eco-red eco-yellow eco-blue))
          (pc-cheat-toggle-and-tune obj eco-green))

    (pc-check-cheat-code (-> *pc-cheat-temp* 3) 0 (s p i r i t) :extra (square)
          (logclear! (-> obj cheats) (pc-cheats eco-red eco-blue eco-green))
          (pc-cheat-toggle-and-tune obj eco-yellow))

    (pc-check-cheat-code (-> *pc-cheat-temp* 4) 0 (s t e e l)
          (logclear! (-> *target* state-flags) 16)
          (pc-cheat-toggle-and-tune obj invinc))

    (pc-check-cheat-code (-> *pc-cheat-temp* 5) 0 (l e a d s)
          (pc-cheat-toggle-and-tune obj sidekick-blue))

    (pc-check-cheat-code (-> *pc-cheat-temp* 6) 0 (t u n e s)
          (pc-cheat-toggle-and-tune obj tunes))

    (pc-check-cheat-code (-> *pc-cheat-temp* 7) 0 (s k y)
          (pc-cheat-toggle-and-tune obj sky))
    )

  (when *target*

      (with-pp (protect ((-> *target* fact-info-target eco-source) *sound-player-enable*)
      ;; act as if this isnt a new source of eco to prevent spamming sounds. then restore the old source!
      (when (< 0 (-> *target* fact-info-target eco-level))
          (set! (-> *target* fact-info-target eco-source) (process->handle pp))
          (false! *sound-player-enable*)
          )

      ;; blue eco!
      (when (and (pc-cheats? obj eco-blue)
                 (or (= (-> *target* fact-info-target eco-type) (pickup-type eco-blue))
                     (<= (-> *target* fact-info-target eco-level) 0.0)))
        (protect ((-> *target* event-hook))
          (set! (-> *target* event-hook) target-generic-event-handler)
          (send-event *target* 'get-pickup (pickup-type eco-blue) (-> *FACT-bank* eco-full-inc))
          )
        (send-event *target* 'boost (-> *FACT-bank* eco-single-inc)))

      ;; yellow eco!
      (when (and (pc-cheats? obj eco-yellow)
                 (or (= (-> *target* fact-info-target eco-type) (pickup-type eco-yellow))
                     (<= (-> *target* fact-info-target eco-level) 0.0)))
        (send-event *target* 'get-pickup (pickup-type eco-yellow) (-> *FACT-bank* eco-full-inc)))

      ;; red eco!
      (when (and (pc-cheats? obj eco-red)
                 (or (= (-> *target* fact-info-target eco-type) (pickup-type eco-red))
                     (<= (-> *target* fact-info-target eco-level) 0.0)))
        (send-event *target* 'get-pickup (pickup-type eco-red) (-> *FACT-bank* eco-full-inc)))

      ;; green eco!
      (when (and (pc-cheats? obj eco-green)
                 (or (= (-> *target* fact-info-target eco-type) (pickup-type eco-green))
                     (<= (-> *target* fact-info-target eco-level) 0.0)))
        (define-extern vent type)
        (protect ((-> pp type) (-> *target* control root-prim prim-core action))
        (set! (-> pp type) vent)
        (logior! (-> *target* control root-prim prim-core action) (collide-action ca-9))
        (send-event *target* 'get-pickup (pickup-type eco-green) (-> *FACT-bank* eco-full-inc)))
        )
      ))

      (when (pc-cheats? obj invinc)
        (logior! (-> *target* state-flags) (state-flags invulnerable))
        )

      )

  (if (pc-cheats? obj tunes)
      (set! (-> obj flava-hack) -1)
      (set! (-> obj flava-hack) 0)
      )

  (if (pc-cheats? obj sky)
      (let ((date (new 'stack 'scf-time)))
          (scf-get-time date)
          (when (zero? (-> date stat))
            (set-time-of-day (+ (the float (bcd->dec (-> date hour))) (/ (the float (bcd->dec (-> date minute))) 60)))
        )
      )
  )

  (logior! (-> obj cheats-known) (-> obj cheats))
  0)


(defmethod add-to-music-log pc-settings ((obj pc-settings) (music symbol) (flava int))
  "add music and flava information to the music log.
   if music already exists, adds flava. if flava already exists, nothing happens."

  ;; go through our music log
  (dotimes (i PC_MUSIC_LOG_LENGTH)
    (cond
      ;; an empty log entry! place the currently playing music there, and fill flava.
      ((not (-> obj secrets music i name))
       (set! (-> obj secrets music i name) music)
       (set! (-> obj secrets music i flava-mask) (ash 1 flava))
       (return 0)
       )
      ;; an existing log entry for the current music. fill flava.
      ((= music (-> obj secrets music i name))
       (logior! (-> obj secrets music i flava-mask) (ash 1 flava))
       (return 0)
       )
      ;; something else. maybe the wrong entry, in which case nothing to do.
      )
    )

  0)

(defmethod update-music-log pc-settings ((obj pc-settings))
  "update music log settings."

  ;; add whatever is playing to the music log.
  (add-to-music-log obj (-> *setting-control* current music) (the int (-> *setting-control* current sound-flava)))

  ;; special cases. for example, npc's that despawn and you can't hear their music anymore.
  (if (task-closed? (game-task beach-ecorocks) (task-status need-introduction))
      (add-to-music-log obj 'village1 1))
  (if (task-closed? (game-task jungle-plant) (task-status need-resolution))
      (add-to-music-log obj 'jungleb 2))
  (if (task-closed? (game-task beach-flutflut) (task-status need-resolution))
      (add-to-music-log obj 'beach (flava-lookup 'beach (music-flava birdlady))))
  (if (task-closed? (game-task beach-flutflut) (task-status need-resolution))
      (add-to-music-log obj 'village1 (flava-lookup 'village1 (music-flava birdlady))))
  (if (task-closed? (game-task misty-warehouse) (task-status need-resolution))
      (add-to-music-log obj 'misty (flava-lookup 'misty (music-flava misty-battle))))
  (if (task-closed? (game-task misty-cannon) (task-status need-resolution))
      (add-to-music-log obj 'misty 4))
  (if (task-closed? (game-task firecanyon-end) (task-status need-resolution))
      (add-to-music-log obj 'firecanyon 2))
  (if (task-closed? (game-task swamp-billy) (task-status need-resolution))
      (add-to-music-log obj 'swamp 1))
  (if (task-closed? (game-task swamp-battle) (task-status need-resolution))
      (add-to-music-log obj 'swamp (flava-lookup 'swamp (music-flava swamp-battle))))
  (if (task-closed? (game-task snow-bunnies) (task-status need-resolution))
      (add-to-music-log obj 'snow (flava-lookup 'snow (music-flava snow-battle))))
  (if (task-closed? (game-task citadel-sage-yellow) (task-status need-resolution))
      (add-to-music-log obj 'citadel (flava-lookup 'citadel (music-flava sage-yellow))))
  (if (task-closed? (game-task citadel-sage-red) (task-status need-resolution))
      (add-to-music-log obj 'citadel (flava-lookup 'citadel (music-flava sage-red))))
  (if (task-closed? (game-task citadel-sage-blue) (task-status need-resolution))
      (add-to-music-log obj 'citadel (flava-lookup 'citadel (music-flava sage-blue))))
  (if (task-closed? (game-task citadel-sage-green) (task-status need-resolution))
      (add-to-music-log obj 'citadel (flava-lookup 'citadel (music-flava sage))))
  (if (task-closed? (game-task citadel-buzzer) (task-status need-resolution))
      (add-to-music-log obj 'citadel (flava-lookup 'citadel (music-flava assistant))))
  (when (and *target* (>= (float->int (send-event *target* 'query 'pickup (pickup-type fuel-cell))) 100))
      (add-to-music-log obj 'credits 0)
      (add-to-music-log obj 'credits 1)
      (add-to-music-log obj 'credits 2)
      )

  0)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(when *debug-segment*

(defmethod draw pc-settings ((obj pc-settings) (buf dma-buffer))
  "debug draw"

  (clear *pc-temp-string*)
  (format *pc-temp-string* "game resolution: ~D x ~D~%" (-> obj width) (-> obj height))
  (format *pc-temp-string* "window size: ~D x ~D (~,,1f x ~,,1f)~%" (-> obj real-width) (-> obj real-height) (-> obj dpi-x) (-> obj dpi-y))
  (format *pc-temp-string* "target aspect: ~,,3f/~,,3f A: ~A/~A L: ~A~%" (-> obj aspect-ratio) (/ (the float (-> obj real-width)) (the float (-> obj real-height))) (-> obj aspect-ratio-auto?) (-> obj use-vis?) (-> obj letterbox?))
  (format *pc-temp-string* "display-type: ~A ~A~%" (-> obj display-mode) (-> obj vsync?))

  (draw-string-xy *pc-temp-string* buf 0 (- 224 (* 8 4)) (font-color default) (font-flags shadow kerning))

  (none))

)


(defun find-music-log ((music symbol))
  "return #t if the given music is logged into the *pc-settings*, #f otherwise."
  (dotimes (i PC_MUSIC_LOG_LENGTH)
    (if (= music (-> *pc-settings* secrets music i name))
        (return #t)))
  #f)

(defun find-flava-log ((music symbol) (flava-idx int))
  "return #t if the given music's flava is logged into the *pc-settings*, #f otherwise."
  (dotimes (i PC_MUSIC_LOG_LENGTH)
    (if (= music (-> *pc-settings* secrets music i name))
        (return (logtest? (-> *pc-settings* secrets music i flava-mask) (ash 1 flava-idx)))))
  #f)

(defun-debug print-music-log ((out object))
  "prints the *pc-settings* music log."

  (dotimes (i PC_MUSIC_LOG_LENGTH)
    (if (-> *pc-settings* secrets music i name)
        (format out "music log ~D: ~A (f #x~x)~%" i (-> *pc-settings* secrets music i name) (-> *pc-settings* secrets music i flava-mask)))
    )

  0)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; file IO
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defmacro file-stream-seek-until (fs func-name)
  `(let ((done? #f)
        (tell -1))

    (until done?

      (let ((read (file-stream-read ,fs (-> *pc-temp-string* data) PC_TEMP_STRING_LEN)))
        (cond
          ((zero? read)
           (set! (-> *pc-temp-string* data read) 0)
           (true! done?)
           )
          (else
           (dotimes (i read)
             (when (,func-name (-> *pc-temp-string* data i))
               (true! done?)
               (set! tell (+ i (- (file-stream-tell ,fs) read)))
               (set! i read)
               )
             )
           )
          )


        )

      )
    (if (!= tell -1)
        (file-stream-seek ,fs tell SCE_SEEK_SET)
        tell
        )
    )
  )

(defmacro file-stream-read-until (fs func-name)
  `(let ((read (file-stream-read ,fs (-> *pc-temp-string* data) PC_TEMP_STRING_LEN)))
    (dotimes (i read)
      (when (,func-name (-> *pc-temp-string* data i))
        (set! (-> *pc-temp-string* data i) 0)
        (file-stream-seek ,fs (+ i (- (file-stream-tell ,fs) read)) SCE_SEEK_SET)
        (set! i read)
        )
      )
    *pc-temp-string*
    )
  )

(defmacro is-whitespace-or-bracket? (c)
  `(or (is-whitespace-char? ,c) (= #x28 ,c) (= #x29 ,c))
  )

(defun file-stream-seek-past-whitespace ((file file-stream))
  (file-stream-seek-until file not-whitespace-char?)
  )

(defun file-stream-read-word ((file file-stream))
  (file-stream-read-until file is-whitespace-or-bracket?)
  ;(format 0 "word ~A~%" *pc-temp-string*)
  )

(defmacro file-stream-getc (fs)
  `(let ((buf 255))
    (file-stream-read ,fs (& buf) 1)
    ;(format 0 "getc got #x~X~%" buf)
    buf
    )
  )

(defun file-stream-read-int ((file file-stream))
  (file-stream-seek-past-whitespace file)
  (file-stream-read-word file)
  (string->int *pc-temp-string*)
  )

(defun file-stream-read-float ((file file-stream))
  (file-stream-seek-past-whitespace file)
  (file-stream-read-word file)
  (string->float *pc-temp-string*)
  )

(defun file-stream-read-symbol ((file file-stream))
  (file-stream-seek-past-whitespace file)
  (file-stream-read-word file)
  (string->symbol *pc-temp-string*)
  )

(defmacro pc-settings-read-throw-error (fs msg)
  "not an actual throw..."
  `(begin
    (format 0 "pc settings read error: ~S~%" ,msg)
    (file-stream-close ,fs)
    (return #f)
    )
  )

(defmacro with-settings-scope (bindings &rest body)
  (let ((fs (first bindings)))
    `(begin
      (file-stream-seek-past-whitespace ,fs)
      (when (!= #x28 (file-stream-getc ,fs))
        (pc-settings-read-throw-error ,fs "invalid char, ( not found")
        )

      ,@body

      (file-stream-seek-past-whitespace ,fs)
      (when (!= #x29 (file-stream-getc ,fs))
        (pc-settings-read-throw-error ,fs "invalid char, ) not found")
        )
      )
    )
  )

(defmacro file-stream-get-next-char-ret (fs)
  `(begin
    (file-stream-seek-past-whitespace ,fs)
    (let ((c (file-stream-getc ,fs)))
      (file-stream-seek ,fs -1 SCE_SEEK_CUR)
      c))
  )

(defmacro file-stream-get-next-char (fs)
  `(begin
    (file-stream-seek-past-whitespace ,fs)
    (file-stream-getc ,fs)
    )
  )

(defmacro dosettings (bindings &rest body)
  "iterate over a list of key-value pairs like so: (<key> <value>) (<key> <value>) ...
   the name of key is stored in *pc-temp-string*"
  (let ((fs (first bindings)))
    `(let ((c -1))
        (while (begin (file-stream-seek-past-whitespace ,fs) (set! c (file-stream-getc ,fs)) (= #x28 c))
            (file-stream-read-word ,fs)

            ,@body

            (set! c (file-stream-get-next-char ,fs))
            (when (!= #x29 c)
              (pc-settings-read-throw-error ,fs (string-format "invalid char, ) not found, got #x~X ~A" c *pc-temp-string*))
              )
            )
        (file-stream-seek ,fs -1 SCE_SEEK_CUR)
        )
    )
  )

(defmethod read-from-file pc-settings ((obj pc-settings) (filename string))
  "read settings from a file"

  (if (not filename)
    (return #f))

  (let ((file (new 'stack 'file-stream filename 'read)))
    (when (not (file-stream-valid? file))
      (return #f))

    (let ((version PC_KERNEL_VERSION))
      (with-settings-scope (file)
        (case-str (file-stream-read-word file)
          (("settings")
            (set! version (file-stream-read-int file))
            (cond
              ((= (logand version #xffffffff00000000) (logand PC_KERNEL_VERSION #xffffffff00000000))
                ;; minor difference
                )
              (else
                ;; major difference
                (format 0 "PC kernel version mismatch! Got ~D.~D vs ~D.~D~%" PC_KERNEL_VERSION_MAJOR PC_KERNEL_VERSION_MINOR (bit-field int version 32 16) (bit-field int version 48 16))
                (file-stream-close file)
                (return #f)
                )
              )
            (dosettings (file)
              (case-str *pc-temp-string*
                (("fps") (set! (-> obj target-fps) (file-stream-read-int file)))
                (("window-size")
                  (set! (-> obj win-width) (file-stream-read-int file))
                  (set! (-> obj win-height) (file-stream-read-int file))
                  )
                (("game-size")
                  (set! (-> obj width) (file-stream-read-int file))
                  (set! (-> obj height) (file-stream-read-int file))
                  )
                (("aspect") (set-aspect! obj (file-stream-read-int file) (file-stream-read-int file)))
                (("aspect-test")
                  (set! (-> obj aspect-custom-x) (file-stream-read-int file))
                  (set! (-> obj aspect-custom-y) (file-stream-read-int file))
                  )
                (("aspect-auto") (set! (-> obj aspect-ratio-auto?) (file-stream-read-symbol file)))
                (("aspect-game") (set! (-> *setting-control* default aspect-ratio) (file-stream-read-symbol file)))
                (("video-mode") (set! (-> *setting-control* default video-mode) (file-stream-read-symbol file)))
                (("display-mode") (set-display-mode! obj (file-stream-read-symbol file)))
                (("letterbox") (set! (-> obj letterbox?) (file-stream-read-symbol file)))
                (("vsync") (set! (-> obj vsync?) (file-stream-read-symbol file)))
                (("font-scale") (set! (-> obj font-scale) (file-stream-read-float file)))
                (("audio-latency-ms") (set! (-> obj audio-latency-ms) (file-stream-read-int file)))
                (("audio-pan-override") (set! (-> obj audio-pan-override) (file-stream-read-float file)))
                (("audio-volume-override") (set! (-> obj audio-volume-override) (file-stream-read-float file)))
                (("audio-channel-nb") (set! (-> obj audio-channel-nb) (file-stream-read-int file)))
                (("gfx-renderer") (set! (-> obj gfx-renderer) (the-as pc-gfx-renderer (file-stream-read-int file))))
                (("gfx-resolution") (set! (-> obj gfx-resolution) (file-stream-read-float file)))
                (("gfx-anisotropy") (set! (-> obj gfx-anisotropy) (file-stream-read-float file)))
                (("shrub-dist-mod") (set! (-> obj shrub-dist-mod) (file-stream-read-float file)))
                (("lod-dist-mod") (set! (-> obj lod-dist-mod) (file-stream-read-float file)))
                (("lod-force-tfrag") (set! (-> obj lod-force-tfrag) (file-stream-read-int file)))
                (("lod-force-tie") (set! (-> obj lod-force-tie) (file-stream-read-int file)))
                (("lod-force-ocean") (set! (-> obj lod-force-ocean) (file-stream-read-int file)))
                (("lod-force-actor") (set! (-> obj lod-force-actor) (file-stream-read-int file)))
                (("subtitle-language") (set! (-> obj subtitle-language) (the-as pc-subtitle-lang (file-stream-read-int file))))
                (("subtitle-speaker") (set! (-> obj subtitle-speaker?) (file-stream-read-symbol file)))
                (("stick-deadzone") (set! (-> obj stick-deadzone) (file-stream-read-float file)))
                (("ps2-read-speed?") (set! (-> obj ps2-read-speed?) (file-stream-read-symbol file)))
                (("ps2-parts?") (set! (-> obj ps2-parts?) (file-stream-read-symbol file)))
                (("ps2-music?") (set! (-> obj ps2-music?) (file-stream-read-symbol file)))
                (("ps2-se?") (set! (-> obj ps2-se?) (file-stream-read-symbol file)))
                (("ps2-hints?") (set! (-> obj ps2-hints?) (file-stream-read-symbol file)))
                (("ps2-lod-dist?") (set! (-> obj ps2-lod-dist?) (file-stream-read-symbol file)))
                (("force-actors?") (set! (-> obj force-actors?) (file-stream-read-symbol file)))
                (("music-fade?") (set! (-> obj music-fade?) (file-stream-read-symbol file)))
                (("use-vis?") (set! (-> obj use-vis?) (file-stream-read-symbol file)))
                (("skip-movies?") (set! (-> obj skip-movies?) (file-stream-read-symbol file)))
                (("subtitles?") (set! (-> obj subtitles?) (file-stream-read-symbol file)))
                (("hinttitles?") (set! (-> obj hinttitles?) (file-stream-read-symbol file)))
                (("discord-rpc?") (set! (-> obj discord-rpc?) (file-stream-read-symbol file)))
                (("first-camera-h-inverted?") (set! (-> obj first-camera-h-inverted?) (file-stream-read-symbol file)))
                (("first-camera-v-inverted?") (set! (-> obj first-camera-v-inverted?) (file-stream-read-symbol file)))
                (("third-camera-h-inverted?") (set! (-> obj third-camera-h-inverted?) (file-stream-read-symbol file)))
                (("third-camera-v-inverted?") (set! (-> obj third-camera-v-inverted?) (file-stream-read-symbol file)))
                (("money-starburst?") (set! (-> obj money-starburst?) (file-stream-read-symbol file)))
                (("extra-hud?") (set! (-> obj extra-hud?) (file-stream-read-symbol file)))
                (("music-fadein?") (set! (-> obj music-fadein?) (file-stream-read-symbol file)))
                (("music-fadeout?") (set! (-> obj music-fadeout?) (file-stream-read-symbol file)))
                (("scenes-seen")
                  (dotimes (i PC_SPOOL_LOG_LENGTH)
                    (set! (-> obj scenes-seen i) (file-stream-read-int file))
                    )
                  )
                (("secrets")
                  (dosettings (file)
                    (case-str *pc-temp-string*
                      (("hard-rats?") (set! (-> obj secrets hard-rats?) (file-stream-read-symbol file)))
                      (("hero-mode?") (set! (-> obj secrets hero-mode?) (file-stream-read-symbol file)))
                      (("hud-map?") (set! (-> obj secrets hud-map?) (file-stream-read-symbol file)))
                      (("hud-counters?") (set! (-> obj secrets hud-counters?) (file-stream-read-symbol file)))
                      (("hud-watch?") (set! (-> obj secrets hud-watch?) (file-stream-read-symbol file)))
                      (("watch-12hr?") (set! (-> obj secrets watch-12hr?) (file-stream-read-symbol file)))
                      (("art") (set! (-> obj secrets art) (the-as pc-jak1-concept-art (file-stream-read-int file))))
                      (("hard-fish-hiscore") (set! (-> obj secrets hard-fish-hiscore) (file-stream-read-int file)))
                      (("hard-rats-hiscore") (set! (-> obj secrets hard-rats-hiscore) (file-stream-read-int file)))
                      (("hard-rats-hiwave") (set! (-> obj secrets hard-rats-hiwave) (file-stream-read-int file)))
                      (("music")
                        (dotimes (i PC_MUSIC_LOG_LENGTH)
                          (when (!= #x29 (file-stream-get-next-char-ret file))
                              (with-settings-scope (file)
                                (set! (-> obj secrets music i name) (file-stream-read-symbol file))
                                (set! (-> obj secrets music i flava-mask) (file-stream-read-int file))
                                )
                            )
                          )
                        )
                      )
                    )
                  )
                (("panic")
                  (when (file-stream-read-symbol file)
                    (file-stream-close file)
                    (reset obj)
                    (write-to-file obj filename)
                    (set-display-mode! obj #f)
                    (return #f)
                    )
                  )
                )
              )
            )
          )
        )

      )

    (file-stream-close file)
    )

  (format 0 "pc settings file read: ~A~%" filename)

  #t
  )

(defmethod write-to-file pc-settings ((obj pc-settings) (filename string))
  "write settings to a file"

  (if (not filename)
    (return #f))

  (let ((file (new 'stack 'file-stream filename 'write)))
    (if (not (file-stream-valid? file))
      (return #f))

    (format file "(settings #x~X~%" (-> obj version))

    (format file "  (fps ~D)~%" (-> obj target-fps))
    (format file "  (game-size ~D ~D)~%" (-> obj width) (-> obj height))
    (format file "  (window-size ~D ~D)~%" (-> obj win-width) (-> obj win-height))
    (format file "  (aspect ~D ~D)~%" (-> obj width) (-> obj height))
    (format file "  (aspect-test ~D ~D)~%" (-> obj aspect-custom-x) (-> obj aspect-custom-y))
    (format file "  (aspect-auto ~A)~%" (-> obj aspect-ratio-auto?))
    (format file "  (aspect-game ~A)~%" (-> *setting-control* default aspect-ratio))
    (format file "  (video-mode ~A)~%" (-> *setting-control* default video-mode))
    (format file "  (display-mode ~A)~%" (-> obj display-mode))
    (format file "  (letterbox ~A)~%" (-> obj letterbox?))
    (format file "  (vsync ~A)~%" (-> obj vsync?))
    (format file "  (font-scale ~f)~%" (-> obj font-scale))

    (format file "  (audio-latency-ms ~D)~%" (-> obj audio-latency-ms))
    (format file "  (audio-pan-override ~f)~%" (-> obj audio-pan-override))
    (format file "  (audio-volume-override ~f)~%" (-> obj audio-volume-override))
    (format file "  (audio-channel-nb ~D)~%" (-> obj audio-channel-nb))

    (format file "  (gfx-renderer ~D)~%" (-> obj gfx-renderer))
    (format file "  (gfx-resolution ~f)~%" (-> obj gfx-resolution))
    (format file "  (gfx-anisotropy ~f)~%" (-> obj gfx-anisotropy))
    (format file "  (shrub-dist-mod ~f)~%" (-> obj shrub-dist-mod))
    (format file "  (lod-dist-mod ~f)~%" (-> obj lod-dist-mod))
    (format file "  (lod-force-tfrag ~D)~%" (-> obj lod-force-tfrag))
    (format file "  (lod-force-tie ~D)~%" (-> obj lod-force-tie))
    (format file "  (lod-force-ocean ~D)~%" (-> obj lod-force-ocean))
    (format file "  (lod-force-actor ~D)~%" (-> obj lod-force-actor))

    (format file "  (stick-deadzone ~f)~%" (-> obj stick-deadzone))

    (format file "  (ps2-read-speed? ~A)~%" (-> obj ps2-read-speed?))
    (format file "  (ps2-parts? ~A)~%" (-> obj ps2-parts?))
    (format file "  (ps2-music? ~A)~%" (-> obj ps2-music?))
    (format file "  (ps2-se? ~A)~%" (-> obj ps2-se?))
    (format file "  (ps2-hints? ~A)~%" (-> obj ps2-hints?))
    (format file "  (ps2-lod-dist? ~A)~%" (-> obj ps2-lod-dist?))
    (format file "  (music-fade? ~A)~%" (-> obj music-fade?))
    (format file "  (use-vis? ~A)~%" (-> obj use-vis?))
    (format file "  (skip-movies? ~A)~%" (-> obj skip-movies?))
    (format file "  (discord-rpc? ~A)~%" (-> obj discord-rpc?))
    (format file "  (first-camera-h-inverted? ~A)~%" (-> obj first-camera-h-inverted?))
    (format file "  (first-camera-v-inverted? ~A)~%" (-> obj first-camera-v-inverted?))
    (format file "  (third-camera-h-inverted? ~A)~%" (-> obj third-camera-h-inverted?))
    (format file "  (third-camera-v-inverted? ~A)~%" (-> obj third-camera-v-inverted?))
    (format file "  (money-starburst? ~A)~%" (-> obj money-starburst?))
    (format file "  (force-actors? ~A)~%" (-> obj force-actors?))
    (format file "  (extra-hud? ~A)~%" (-> obj extra-hud?))
    (format file "  (music-fadein? ~A)~%" (-> obj music-fadein?))
    (format file "  (music-fadeout? ~A)~%" (-> obj music-fadeout?))
    (format file "  (subtitles? ~A)~%" (-> obj subtitles?))
    (format file "  (hinttitles? ~A)~%" (-> obj hinttitles?))
    (format file "  (subtitle-language ~D)~%" (-> obj subtitle-language))
    (format file "  (subtitle-speaker ~A)~%" (-> obj subtitle-speaker?))

    #|
    (format file "  (scenes-seen")
    (dotimes (i PC_SPOOL_LOG_LENGTH)
      (if (zero? (mod i 16))
        (format file "~%   ")
        )
      (format file " ~D" (-> obj scenes-seen i))
      )
    (format file "~%    )~%")
    |#

    (format file "  (secrets~%")
    #|
    (format file "    (art #x~X)~%" (-> obj secrets art))
    (format file "    (hard-rats? ~A)~%" (-> obj secrets hard-rats?))
    (format file "    (hero-mode? ~A)~%" (-> obj secrets hero-mode?))
    (format file "    (hud-map? ~A)~%" (-> obj secrets hud-map?))
    (format file "    (hud-counters? ~A)~%" (-> obj secrets hud-counters?))
    (format file "    (hard-fish-hiscore ~D)~%" (-> obj secrets hard-fish-hiscore))
    (format file "    (hard-rats-hiscore ~D)~%" (-> obj secrets hard-rats-hiscore))
    (format file "    (hard-rats-hiwave ~D)~%" (-> obj secrets hard-rats-hiwave))
    |#

    (format file "    (music~%")
    (dotimes (i PC_MUSIC_LOG_LENGTH)
      (if (-> obj secrets music i name)
    (format file "      (~A #x~X)~%" (-> obj secrets music i name) (-> obj secrets music i flava-mask))
    )
      )

    (format file "      )~%")

    (format file "    )~%")

    (format file "  )~%")
    (file-stream-close file)
    )

  (format 0 "pc settings file write: ~A~%" filename)

  #t
  )

(defmethod load-settings pc-settings ((obj pc-settings))
  "load"

  (format (clear *pc-temp-string-1*) "~S/pc-settings.gc" *pc-settings-folder*)
  (if (pc-filepath-exists? *pc-temp-string-1*)
    (begin
      (format 0 "[PC] PC Settings found at '~S'...loading!~%" *pc-temp-string-1*)
      (unless (read-from-file obj *pc-temp-string-1*)
        (format 0 "[PC] PC Settings found at '~S' but could not be loaded, using defaults!~%" *pc-temp-string-1*)
        (reset obj)))
    (format 0 "[PC] PC Settings not found at '~S'...initializing with defaults!~%" *pc-temp-string-1*))
  0)

(defmethod new pc-settings ((allocation symbol) (type-to-make type))
  "make a new pc-settings"
  (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (reset obj)
    ;; auto load settings if available
    ;; if saved settings are corrupted or not found, use defaults

    (load-settings obj)

    obj))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; PC settings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define *pc-settings* (new 'global 'pc-settings))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; entity debugging
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(when *debug-segment*

(deftype entity-debug-inspect (basic)
  (
   (scroll-y int16)
   (scroll-y-max int16)
   (entity entity)
   (show-actor-info symbol)
   )
  (:methods
    (new (symbol type) _type_)
    (set-entity! (_type_ entity) entity)
    (update-pad (_type_ int) none)
    )
  )

(defmethod new entity-debug-inspect ((allocation symbol) (type-to-make type))
  "make a new entity-debug-inspect object"

  (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))

    (set! (-> obj scroll-y) 0)
    (set! (-> obj scroll-y-max) 0)
    (set! (-> obj entity) (the entity #f))
    (set! (-> obj show-actor-info) #f)
    obj
    )
  )

(defmethod set-entity! entity-debug-inspect ((obj entity-debug-inspect) (e entity))
  "set the entity to inspect"

  (set! (-> obj entity) e)
  (unless e
    (set! *display-actor-anim* (the string #f)))
  (set! (-> obj scroll-y) 0)

  e
  )

(defmethod update-pad entity-debug-inspect ((obj entity-debug-inspect) (pad-idx int))
  "respond to pad inputs"

  ;; scroll up
  (if (cpad-pressed? pad-idx l1)
    (1-! (-> obj scroll-y)))
  ;; scroll down
  (if (cpad-pressed? pad-idx r1)
    (1+! (-> obj scroll-y)))
  ;; toggle actor info
  (if (cpad-pressed? pad-idx l3)
    (not! (-> obj show-actor-info)))

  (minmax! (-> obj scroll-y) 0 (-> obj scroll-y-max))

  (none))


(define *entity-debug-inspect* (new 'debug 'entity-debug-inspect))

) ;; when debug_segment

(defun-debug draw-build-revision ()
  (with-dma-buffer-add-bucket ((buf (-> (current-frame) debug-buf))
                                     (bucket-id debug-no-zbuf))
          (draw-string-xy *pc-settings-built-sha*
                          buf
                          0
                          (* 10 (-> *video-parms* relative-y-scale))
                          (font-color flat-yellow)
                          (font-flags shadow kerning))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; process pools
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; the actor pool for PC processes! it has space for 4 processes, with 16K of space.
(define *pc-dead-pool* (new 'global 'dead-pool 4 (* 16 1024) '*pc-dead-pool*))