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

599 lines
22 KiB
Common Lisp
Raw Normal View History

;;-*-Lisp-*-
(in-package goal)
#|
This file contains 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.
|#
(#when PC_PORT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; updates
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod set-fullscreen! pc-settings ((obj pc-settings) (mode symbol))
"toggles fullscreen mode"
(if (= (-> obj fullscreen?) mode) ;; already fullscreen
(return 0))
(set! (-> obj fullscreen?) mode)
(pc-set-fullscreen
(cond ((= mode 'borderless) 2)
(mode 1)
(else 0)
)
0)
0)
(defmethod set-size! pc-settings ((obj pc-settings) (width int) (height int))
"toggles fullscreen mode"
(pc-set-window-size width height)
0)
(defmethod set-aspect! pc-settings ((obj pc-settings) (aw int) (ah int))
(let ((aspect (/ (the float aw) (the float ah))))
(set-aspect-ratio! obj aspect)
(set! (-> obj aspect-ratio-auto?) #f)
(set! (-> obj use-vis?) #f)
)
0)
(defmethod set-aspect-ratio! pc-settings ((obj pc-settings) (aspect float))
(set! (-> obj aspect-ratio) aspect)
(set! (-> obj aspect-ratio-scale) (/ aspect ASPECT_4X3))
(set! (-> obj aspect-ratio-reciprocal) (/ ASPECT_4X3 aspect))
0)
(defmethod update-from-os pc-settings ((obj pc-settings))
"Update settings from the PC kernel to GOAL."
(set! (-> obj os) (pc-get-os))
(pc-get-window-size (&-> obj win-width) (&-> obj win-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 win-width)) (the float (-> obj win-height)))))
(cond
((and (not (-> obj use-vis?)) (-> obj aspect-ratio-auto?))
;; the window determines the resolution
(set-aspect-ratio! obj win-aspect)
(set! (-> obj width) (-> obj win-width))
(set! (-> obj height) (-> obj win-height))
)
((> win-aspect (-> obj aspect-ratio))
;; too wide
(set! (-> obj width) (the int (* (-> obj aspect-ratio) (the float (-> obj win-height)))))
(set! (-> obj height) (-> obj win-height))
)
((< win-aspect (-> obj aspect-ratio))
;; too tall
(set! (-> obj width) (-> obj win-width))
(set! (-> obj height) (the int (/ (the float (-> obj win-width)) (-> obj aspect-ratio))))
)
(else
;; just right
(set! (-> obj width) (-> obj win-width))
(set! (-> obj height) (-> obj win-height))
)
)
)
(none))
(defmethod update-to-os pc-settings ((obj pc-settings))
"Update settings from GOAL to the PC kernel."
(cond
((-> obj letterbox?)
(pc-set-letterbox (-> obj width) (-> obj height))
)
(else
(pc-set-letterbox (-> obj win-width) (-> obj win-height))
)
)
(none))
(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)
(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?))
(when *progress-process*
;; adjust sizes for progress.
;; video.gc sets the sizes in the normal game.
(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)))
)
)
)
(none))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 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 win-width) (-> obj win-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 win-width)) (the float (-> obj win-height))) (-> obj aspect-ratio-auto?) (-> obj use-vis?) (-> obj letterbox?))
(format *pc-temp-string* "fullscreen: ~A ~A~%" (-> obj fullscreen?) (-> obj vsync?))
(draw-string-xy *pc-temp-string* buf 0 (- 224 (* 8 4)) (font-color default) (font-flags shadow kerning))
(none))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 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)
(case-str *pc-temp-string*
(("#f") #f)
(("#t") #t)
(("aspect4x3") 'aspect4x3)
(("aspect16x9") 'aspect16x9)
(("borderless") 'borderless)
(else #t)
)
)
(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 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
(file-stream-seek-past-whitespace ,fs)
(set! c (file-stream-getc ,fs))
(when (!= #x29 c)
(break!)
(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)))
(if (not (file-stream-valid? file))
(return #f))
(let ((version PC_KERNEL_VERSION))
(with-settings-scope (file)
(file-stream-read-word file)
(case-str *pc-temp-string*
(("settings")
(set! version (file-stream-read-int file))
(dosettings (file)
(case-str *pc-temp-string*
(("fps") (set! (-> obj target-fps) (file-stream-read-int file)))
(("size")
(set! (-> obj width) (file-stream-read-int file))
(set! (-> obj height) (file-stream-read-int file))
(set-size! obj (-> obj width) (-> obj height))
(set-aspect! obj (-> obj width) (-> obj height))
)
(("aspect")
(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! (-> obj aspect-setting) (file-stream-read-symbol file)))
(("fullscreen") (set-fullscreen! 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))))
(("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)))
(("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)))
(("scenes-seen")
(dotimes (i 197)
(set! (-> obj scenes-seen i) (file-stream-read-int file))
)
)
(("fixes")
(dosettings (file)
(case-str *pc-temp-string*
(("crash-sagecage") (set! (-> obj fixes crash-sagecage) (file-stream-read-symbol file)))
(("crash-dma") (set! (-> obj fixes crash-dma) (file-stream-read-symbol file)))
(("crash-light-eco") (set! (-> obj fixes crash-light-eco) (file-stream-read-symbol file)))
(("lockout-pelican") (set! (-> obj fixes lockout-pelican) (file-stream-read-symbol file)))
(("lockout-pipegame") (set! (-> obj fixes lockout-pipegame) (file-stream-read-symbol file)))
(("lockout-gambler") (set! (-> obj fixes lockout-gambler) (file-stream-read-symbol file)))
(("fix-movies") (set! (-> obj fixes fix-movies) (file-stream-read-symbol file)))
(("fix-credits") (set! (-> obj fixes fix-credits) (file-stream-read-symbol 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)))
(("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 30)
(set! (-> obj secrets music i) (file-stream-read-int file))
)
)
)
)
)
(("panic")
(when (file-stream-read-symbol file)
(file-stream-close file)
(reset obj)
(write-to-file obj filename)
(set-fullscreen! obj #f)
(return #f)
)
)
)
)
)
)
)
(when (!= PC_KERNEL_VERSION version)
(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)
)
(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 " (size ~D ~D)~%" (-> obj width) (-> obj height))
(format file " (aspect ~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 " (fullscreen ~A)~%" (-> obj fullscreen?))
(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 " (subtitles? ~A)~%" (-> obj subtitles?))
(format file " (hinttitles? ~A)~%" (-> obj hinttitles?))
(format file " (subtitle-language ~D)~%" (-> obj subtitle-language))
(format file " (scenes-seen")
(dotimes (i 197)
(if (zero? (mod i 16))
(format file "~% ")
)
(format file " ~D" (-> obj scenes-seen i))
)
(format file "~% )~%")
(format file " (fixes~%")
(format file " (crash-sagecage ~A)~%" (-> obj fixes crash-sagecage))
(format file " (crash-dma ~A)~%" (-> obj fixes crash-dma))
(format file " (crash-light-eco ~A)~%" (-> obj fixes crash-light-eco))
(format file " (lockout-pelican ~A)~%" (-> obj fixes lockout-pelican))
(format file " (lockout-pipegame ~A)~%" (-> obj fixes lockout-pipegame))
(format file " (lockout-gambler ~A)~%" (-> obj fixes lockout-gambler))
(format file " (fix-movies ~A)~%" (-> obj fixes fix-movies))
(format file " (fix-credits ~A)~%" (-> obj fixes fix-credits))
(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 30)
(if (zero? (mod i 1))
(format file "~% ")
)
(format file " #x~X" (-> obj secrets music i))
)
(format file "~% )~%")
(format file " )~%")
(format file " )~%")
(file-stream-close file)
)
(format 0 "pc settings file write: ~A~%" filename)
#t
)
(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)
obj
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; PC settings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define *pc-settings* (new 'global 'pc-settings))
(read-from-file *pc-settings* PC_SETTINGS_FILE_NAME)
)