Files
jak-project/goal_src/jak1/engine/ui/text.gc
T
Tyler Wilding d1ece445d4 Dependency graph work - Part 1 - Preliminary work (#3505)
Relates to #1353 

This adds no new functionality or overhead to the compiler, yet. This is
the preliminary work that has:
- added code to the compiler in several spots to flag when something is
used without being properly required/imported/whatever (disabled by
default)
- that was used to generate project wide file dependencies (some
circulars were manually fixed)
- then that graph underwent a transitive reduction and the result was
written to all `jak1` source files.

The next step will be making this actually produce and use a dependency
graph. Some of the reasons why I'm working on this:
- eliminates more `game.gp` boilerplate. This includes the `.gd` files
to some extent (`*-ag` files and `tpage` files will still need to be
handled) this is the point of the new `bundles` form. This should make
it even easier to add a new file into the source tree.
- a build order that is actually informed from something real and
compiler warnings that tell you when you are using something that won't
be available at build time.
- narrows the search space for doing LSP actions -- like searching for
references. Since it would be way too much work to store in the compiler
every location where every symbol/function/etc is used, I have to do
ad-hoc searches. By having a dependency graph i can significantly reduce
that search space.
- opens the doors for common shared code with a legitimate pattern.
Right now jak 2 shares code from the jak 1 folder. This is basically a
hack -- but by having an explicit require syntax, it would be possible
to reference arbitrary file paths, such as a `common` folder.

Some stats:
- Jak 1 has about 2500 edges between files, including transitives
- With transitives reduced at the source code level, each file seems to
have a modest amount of explicit requirements.

Known issues:
- Tracking the location for where `defmacro`s and virtual state
definitions were defined (and therefore the file) is still problematic.
Because those forms are in a macro environment, the reader does not
track them. I'm wondering if a workaround could be to search the
reader's text_db by not just the `goos::Object` but by the text
position. But for the purposes of finishing this work, I just statically
analyzed and searched the code with throwaway python code.
2024-05-12 12:37:59 -04:00

601 lines
21 KiB
Common Lisp

;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/ui/text-h.gc")
(require "engine/debug/debug.gc")
(require "engine/load/load-dgo.gc")
;; name: text.gc
;; name in dgo: text
;; dgos: GAME, ENGINE
;; This file contains functions for:
;; - loading text files containing translated game text
;; - managing the memory for text
;; - looking up strings from text
;; - helpers to draw text on the screen
;; It seems like there it would be possible to have multiple "groups" of text,
;; but in practice, only the COMMON group is used.
;; DECOMP BEGINS
;; State of text drawing.
(define *game-text-word* (new 'global 'string 128 (the string '#f)))
(define *game-text-line* (new 'global 'string 256 (the string '#f)))
(define *level-text-file-load-flag* #t)
;; allocate the game text heap if it isn't already allocated.
(when (zero? (-> *common-text-heap* base))
(kheap-alloc *common-text-heap* (* 64 1024)) ;; changed from 34K -> 64K
)
;; The game-text-info stores records for each string in the loaded text on the text heap.
(defmethod length ((this game-text-info))
"Get the length (number of strings) in a game-text-info."
(-> this length)
)
(defmethod asize-of ((this game-text-info))
"Get the size in memory of the game-text-info"
;; each record is 8 bytes
(the-as int (+ (-> this type size) (* (-> this length) 8)))
)
(defmethod inspect ((this game-text-info))
"Print a game text info, including all strings"
(format '#t "[~8x] ~A~%" this (-> this type))
(format '#t "~Tlength: ~D~%" (-> this length))
(format '#t "~Tdata[~D]: @ #x~X~%" (-> this length) (-> this data))
(let ((i 0))
(while (< i (-> this length))
(format '#t "~T [~D] #x~X ~A~%" i (-> this data i id) (-> this data i text))
(+! i 1)
)
)
this
)
(defmethod mem-usage ((this game-text-info) (arg0 memory-usage-block) (arg1 int))
"Get the memory usage."
(set! (-> arg0 length) (max 81 (-> arg0 length)))
(set! (-> arg0 data 80 name) "string")
(+! (-> arg0 data 80 count) 1)
;; get the size of this structure
(let ((v1-6 (asize-of this)))
(+! (-> arg0 data 80 used) v1-6)
(+! (-> arg0 data 80 total) (logand -16 (+ v1-6 15)))
)
;; get the size of all the strings
(dotimes (s4-0 (-> this length))
(set! (-> arg0 length) (max 81 (-> arg0 length)))
(set! (-> arg0 data 80 name) "string")
(+! (-> arg0 data 80 count) 1)
(let ((v1-18 (asize-of (-> this data s4-0 text))))
(+! (-> arg0 data 80 used) v1-18)
(+! (-> arg0 data 80 total) (logand -16 (+ v1-18 15)))
)
)
this
)
(defmethod lookup-text! ((this game-text-info) (arg0 text-id) (arg1 symbol))
"Look up text by ID. Will return the string.
If the ID can't be found, and arg1 is #t, it will return #f,
otherwise the temp string UNKNOWN ID <id number>"
;; binary search for it
(let* ((a1-1 0) ;; min
(a3-0 (+ (-> this length) 1)) ;; max
(v1-2 (/ (+ a1-1 a3-0) 2)) ;; mid
)
(let ((t0-0 -1)) ;; last time's lookup
(while (and (!= (-> this data v1-2 id) arg0) (!= v1-2 t0-0)) ;; while we haven't found it/not the same as last time
(if (< arg0 (-> this data v1-2 id))
(set! a3-0 v1-2) ;; bisect, right
(set! a1-1 v1-2) ;; bisect, left
)
(set! t0-0 v1-2) ;; remeber last time
(set! v1-2 (/ (+ a1-1 a3-0) 2)) ;; midpoint for next time
)
)
(cond
((!= (-> this data v1-2 id) arg0) ;; didn't find it :(
(cond
(arg1
(the-as string #f)
)
(else
;; First, look up the id in the fallback
(#if PC_PORT
(if *fallback-text-lookup?*
(let ((fallback-result (lookup-text! *fallback-text* arg0 #t)))
(if (!= fallback-result #f)
fallback-result
(string-format "UNKNOWN ID ~D" arg0)))
(string-format "UNKNOWN ID ~D" arg0))
(string-format "UNKNOWN ID ~D" arg0))
)
)
)
(else
(-> this data v1-2 text) ;; found it!
)
)
)
)
;; Game text loading.
;; The implementation of loading is blocking.
;; If you change languages, the game will freeze for a second while it loads
;; This loading flag is never used.
;; loading is complete once load-game-text-info returns
(define text-is-loading #f)
;; WARN: Found some very strange gotos. Check result carefully, this is not well tested.
(defun load-game-text-info ((txt-name string) (curr-text symbol) (heap kheap))
"Load text, if needed. txt-name is the group name, curr-text is the _symbol_ for
the game-text-info, and heap is the heap to load to. The heap will be cleared."
(local-vars (v0-2 int) (heap-sym-heap game-text-info) (lang language-enum) (load-status int) (heap-free int))
(set! heap-sym-heap (the-as game-text-info (-> curr-text value)))
;; split languages in PC port
(set! lang (#if PC_PORT (the language-enum (-> *pc-settings* text-language))
(-> *setting-control* current language)))
(set! load-status 0)
(set! heap-free (&- (-> heap top) (the-as uint (-> heap base))))
;; english -> UK english in PAL
;; og:preserve-this no longer necessary.
(#unless PC_PORT
(if (and (= (scf-get-territory) GAME_TERRITORY_SCEE) (= lang (language-enum english)))
(set! lang (language-enum uk-english))
)
)
;; only load if we actually need to
(when (or (= heap-sym-heap #f) ;; nothing loaded
(!= (-> heap-sym-heap language-id) (the-as uint lang)) ;; loaded, but wrong lang
(not (string= (-> heap-sym-heap group-name) txt-name)) ;; loaded, but wrong group
)
;; clear the heap!
(let ((v1-16 heap))
(set! (-> v1-16 current) (-> v1-16 base))
)
(b! #t cfg-14)
(label cfg-13)
(load-dbg "Strange error during text load.~%")
(set! v0-2 0)
(b! #t cfg-27)
(label cfg-14)
;; call str-load to start loading the TXT file to the heap
(let ((s3-0 str-load))
(format (clear *temp-string*) "~D~S.TXT" lang txt-name)
;; this branch is super weird.
(b! (not (s3-0
*temp-string*
-1
(logand -64 (&+ (-> heap current) 63))
(&- (-> heap top) (the-as uint (-> heap current)))
)
)
cfg-13
)
)
;; loop to wait until loading is complete
(label cfg-16)
(let ((v1-20 (str-load-status (the-as (pointer int32) (& load-status)))))
(cond
((= v1-20 'error)
(format 0 "Error loading text~%")
(return 0)
)
((>= load-status (+ heap-free -300))
(format 0 "Game text heap overrun!~%")
(return 0)
)
((= v1-20 'busy)
(begin
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(goto cfg-16)
)
)
)
)
;; loading is done. now we link.
(let ((s2-1 (logand -64 (&+ (-> heap current) 63))))
(flush-cache 0)
(let ((s3-1 link))
(format (clear *temp-string*) "~D~S.TXT" lang txt-name)
(set! (-> curr-text value)
(s3-1 s2-1 (-> *temp-string* data) load-status heap 0)
)
)
)
;; linking error occured?
(if (<= (the-as int (-> curr-text value)) 0)
(set! (-> curr-text value) (the-as object #f))
)
)
(set! v0-2 0)
(label cfg-27)
v0-2
)
(defun load-level-text-files ((arg0 int))
"Load the text files needed for level idx.
This function made more sense back when text files were split up, but in the end they put everything
in a single text group and file."
(when (or *level-text-file-load-flag* (>= arg0 0))
(load-game-text-info "common" '*common-text* *common-text-heap*)
(#when PC_PORT
(protect ((-> *pc-settings* text-language))
(set! (-> *pc-settings* text-language) (pc-language english))
(load-game-text-info "common" '*fallback-text* *fallback-text-heap*))))
(none)
)
(defun draw-debug-text-box ((arg0 font-context))
"Not used outside of a single thing in progress.
Draws some lines"
(let ((s5-0 (new 'static 'vector4w))
(gp-0 (new 'static 'matrix))
)
(#when PC_PORT
(if (logtest? (-> arg0 flags) (font-flags right))
(set! (-> arg0 width) (- (-> arg0 width)))))
(let ((s4-0 (new 'static 'vector)))
(set-vector! s4-0 (-> arg0 origin x) (-> arg0 origin y) 0.0 1.0)
(set! (-> s4-0 x) (* (-> s4-0 x) (-> *video-parms* relative-x-scale-reciprical)))
(vector-matrix*! s4-0 s4-0 (-> arg0 mat))
(set-vector!
(-> gp-0 vector 0)
(the-as float (the int (-> s4-0 x)))
(the-as float (the int (-> s4-0 y)))
(the-as float (the int (-> s4-0 z)))
(the-as float 1)
)
(set-vector! s4-0 (+ (-> arg0 origin x) (-> arg0 width)) (-> arg0 origin y) 0.0 1.0)
(set! (-> s4-0 x) (* (-> s4-0 x) (-> *video-parms* relative-x-scale-reciprical)))
(vector-matrix*! s4-0 s4-0 (-> arg0 mat))
(set-vector!
(-> gp-0 vector 1)
(the-as float (the int (-> s4-0 x)))
(the-as float (the int (-> s4-0 y)))
(the-as float (the int (-> s4-0 z)))
(the-as float 1)
)
(set-vector! s4-0 (+ (-> arg0 origin x) (-> arg0 width)) (+ (-> arg0 origin y) (-> arg0 height)) 0.0 1.0)
(set! (-> s4-0 x) (* (-> s4-0 x) (-> *video-parms* relative-x-scale-reciprical)))
(vector-matrix*! s4-0 s4-0 (-> arg0 mat))
(set-vector!
(-> gp-0 vector 2)
(the-as float (the int (-> s4-0 x)))
(the-as float (the int (-> s4-0 y)))
(the-as float (the int (-> s4-0 z)))
(the-as float 1)
)
(set-vector! s4-0 (-> arg0 origin x) (+ (-> arg0 origin y) (-> arg0 height)) 0.0 1.0)
(set! (-> s4-0 x) (* (-> s4-0 x) (-> *video-parms* relative-x-scale-reciprical)))
(vector-matrix*! s4-0 s4-0 (-> arg0 mat))
(set-vector!
(-> gp-0 vector 3)
(the-as float (the int (-> s4-0 x)))
(the-as float (the int (-> s4-0 y)))
(the-as float (the int (-> s4-0 z)))
(the-as float 1)
)
)
(set-vector! s5-0 128 128 128 128)
(add-debug-line2d
#t
(bucket-id debug-no-zbuf)
(the-as vector (-> gp-0 vector))
(-> gp-0 vector 1)
(the-as vector s5-0)
)
(add-debug-line2d #t (bucket-id debug-no-zbuf) (-> gp-0 vector 1) (-> gp-0 vector 2) (the-as vector s5-0))
(add-debug-line2d #t (bucket-id debug-no-zbuf) (-> gp-0 vector 2) (-> gp-0 vector 3) (the-as vector s5-0))
(add-debug-line2d
#t
(bucket-id debug-no-zbuf)
(-> gp-0 vector 3)
(the-as vector (-> gp-0 vector))
(the-as vector s5-0)
)
(#when PC_PORT
(if (logtest? (-> arg0 flags) (font-flags right))
(set! (-> arg0 width) (- (-> arg0 width)))))
)
0
(none)
)
(defun set-font-color-alpha ((idx font-color) (alpha int))
"Set the alpha for a given color index"
(set! (-> *font-work* color-table idx color 0 a) alpha)
(set! (-> *font-work* color-table idx color 1 a) alpha)
(set! (-> *font-work* color-table idx color 2 a) alpha)
(set! (-> *font-work* color-table idx color 3 a) alpha)
(set! (-> *font-work* color-shadow w) alpha)
0
(none)
)
(defun print-game-text-scaled ((str string) (scale float) (font-ctxt font-context) (alpha int))
"Print text, with a given scaling"
(let ((orig-width (-> font-ctxt width))
(orig-height (-> font-ctxt height))
(orig-x (-> font-ctxt origin x))
(orig-y (-> font-ctxt origin y))
(orig-scale (-> font-ctxt scale))
)
(let ((scaled-width (* (-> font-ctxt width) scale))
(scaled-height (* (-> font-ctxt height) scale))
)
(if (logtest? (-> font-ctxt flags) (font-flags middle))
(+! (-> font-ctxt origin x) (* 0.5 (- orig-width scaled-width)))
)
(if (logtest? (-> font-ctxt flags) (font-flags middle-vert))
;; this code is really weird. it does the divide with an int, but fails
;; to convert it back to a float before adding??
(+! (-> font-ctxt origin y) (the-as float (/ (the int (- orig-height scaled-height)) 2)))
)
(set! (-> font-ctxt scale) (* orig-scale scale))
(set! (-> font-ctxt width) scaled-width)
(set! (-> font-ctxt height) scaled-height)
)
(print-game-text str font-ctxt #f alpha 22)
(set! (-> font-ctxt origin x) orig-x)
(set! (-> font-ctxt origin y) orig-y)
(set! (-> font-ctxt width) orig-width)
(set! (-> font-ctxt height) orig-height)
(set! (-> font-ctxt scale) orig-scale)
)
0
(none)
)
(defun print-game-text ((str string) (font-ctxt font-context) (no-draw symbol) (alpha int) (line-height int))
"Print text. Not worth commenting until we get stack variables in lets, I think"
(local-vars
(sv-112 float)
(sv-116 float)
(sv-120 float)
(sv-124 float)
(sv-128 float)
(sv-132 float)
(sv-136 float)
(sv-140 (pointer uint8))
(sv-144 float)
(sv-148 float)
(sv-152 float)
(sv-156 float)
(sv-160 float)
(sv-164 float)
(sv-168 int)
(sv-176 int)
(sv-184 int)
(sv-192 int)
(sv-200 int)
(sv-208 symbol)
(sv-212 symbol)
)
(let ((gp-0 (new
'stack
'font-context
*font-default-matrix*
(the int (-> font-ctxt origin x))
(the int (-> font-ctxt origin y))
0.0
(font-color default)
(font-flags shadow kerning)
)
)
)
(when (< 0.1 (-> font-ctxt scale))
(set! sv-112 (-> font-ctxt mat vector 0 x))
(set! sv-116 (-> font-ctxt mat vector 1 y))
(set! sv-120 (-> *video-parms* relative-x-scale))
(set! sv-124 (-> *video-parms* relative-y-scale))
(set! sv-128 (-> *video-parms* relative-x-scale-reciprical))
(set! sv-132 (-> *video-parms* relative-y-scale-reciprical))
(set! sv-136 (-> font-ctxt scale))
(set! (-> gp-0 origin z) (-> font-ctxt origin z))
(set! (-> gp-0 flags) (-> font-ctxt flags))
(set! (-> gp-0 color) (-> font-ctxt color))
(set! (-> gp-0 scale) sv-136)
(when (logtest? (-> gp-0 flags) (font-flags middle-vert))
(logclear! (-> gp-0 flags) (font-flags middle-vert))
(let ((f30-0 (-> gp-0 width))
(f28-0 (-> gp-0 height))
)
(set! (-> gp-0 width) (-> font-ctxt width))
(set! (-> gp-0 height) (-> font-ctxt height))
(+! (-> gp-0 origin y)
(the float (the int (* 0.5 (- (-> gp-0 height) (print-game-text str gp-0 #t 128 22)))))
)
(set! (-> gp-0 width) f30-0)
(set! (-> gp-0 height) f28-0)
)
)
(set! (-> gp-0 mat vector 0 x) (* (-> gp-0 mat vector 0 x) sv-136))
(set! (-> gp-0 mat vector 1 y) (* (-> gp-0 mat vector 1 y) sv-136))
(set! (-> *video-parms* relative-x-scale) (* (-> *video-parms* relative-x-scale) sv-136))
(set! (-> *video-parms* relative-y-scale) (* (-> *video-parms* relative-y-scale) sv-136))
(set! (-> *video-parms* relative-x-scale-reciprical) (/ 1.0 (-> *video-parms* relative-x-scale)))
(set! (-> *video-parms* relative-y-scale-reciprical) (/ 1.0 sv-136))
(set! sv-140 (-> str data))
(set! sv-144 (-> gp-0 origin x))
(set! sv-148 (-> gp-0 origin x))
(set! sv-152 (+ (-> gp-0 origin x) (-> font-ctxt width)))
(set! sv-156 (+ (-> gp-0 origin y) (-> font-ctxt height)))
(set! sv-160 (* (get-string-length " " gp-0) (-> *video-parms* relative-x-scale)))
(set! sv-164 (* (if (logtest? (-> gp-0 flags) (font-flags large))
(the float line-height)
14.0
)
sv-136
)
)
(set! sv-168 0)
(if (logtest? (-> gp-0 flags) (font-flags middle))
(+! (-> gp-0 origin x) (* 0.5 (-> font-ctxt width)))
)
(set! sv-176 (the-as int (-> sv-140 0)))
(set! sv-184 0)
(set! sv-192 0)
(set! sv-200 0)
(set! sv-208 (the-as symbol #f))
(set! sv-212 (the-as symbol #f))
(set! (-> *game-text-line* data 0) (the-as uint 0))
(while (or (not (and (zero? sv-176) (zero? sv-184) (zero? sv-192))) (>= sv-156 (-> gp-0 origin y)))
(cond
((= sv-176 32)
(set! (-> *game-text-word* data sv-184) (the-as uint sv-176))
(set! sv-184 (+ sv-184 1))
(set! sv-208 #t)
)
((zero? sv-176)
(if (zero? sv-184)
(set! sv-212 #t)
(set! sv-208 #t)
)
)
(else
;; og:preserve-this PAL patch here
(if (= sv-176 3)
(set! sv-176 32)
)
(set! (-> *game-text-word* data sv-184) (the-as uint sv-176))
(set! sv-184 (+ sv-184 1))
)
)
(when (= sv-208 #t)
(set! (-> *game-text-word* data sv-184) (the-as uint 0))
(let* ((f30-1 sv-144)
(f0-49 (* (get-string-length *game-text-word* gp-0) (-> *video-parms* relative-x-scale)))
(f1-14 (+ f30-1 f0-49))
)
(if (= (-> *game-text-word* data (+ sv-184 -1)) 32)
(set! f1-14 (- f1-14 sv-160))
)
(cond
((< sv-152 f1-14)
(set! sv-144 (+ sv-148 f0-49))
(set! sv-212 #t)
)
(else
(set! sv-144 (+ sv-144 f0-49))
)
)
)
)
(when (= sv-212 #t)
(when (>= sv-200 (the-as int (-> gp-0 start-line)))
(let ((f30-2 (+ (-> gp-0 origin y) sv-164)))
(when (>= sv-156 f30-2)
(when (= (-> *game-text-line* data (+ sv-192 -1)) 32)
(set! (-> *game-text-line* data (+ sv-192 -1)) (the-as uint 0))
(when (and (= (-> *game-text-line* data (+ sv-192 -5)) 126) (= (-> *game-text-line* data (+ sv-192 -2)) 72))
(set! (-> *game-text-line* data (+ sv-192 -5)) (the-as uint 0))
0
)
)
)
(when (and (= (-> *game-text-line* data (+ sv-192 -4)) 126) (= (-> *game-text-line* data (+ sv-192 -1)) 72))
(set! (-> *game-text-line* data (+ sv-192 -4)) (the-as uint 0))
0
)
(if (nonzero? (-> *game-text-line* data 0))
(set! sv-168 (+ sv-168 1))
)
(when (not no-draw)
(let* ((s1-1 (-> *display* frames (-> *display* on-screen) frame global-buf))
(s2-1 (-> s1-1 base))
)
(set-font-color-alpha (-> font-ctxt color) alpha)
(draw-string *game-text-line* s1-1 gp-0)
(set-font-color-alpha (-> font-ctxt color) 128)
(set! (-> gp-0 color) (-> *font-work* last-color))
(let ((a3-3 (-> s1-1 base)))
(let ((v1-127 (the-as object (-> s1-1 base))))
(set! (-> (the-as dma-packet v1-127) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet v1-127) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet v1-127) vif1) (new 'static 'vif-tag))
(set! (-> s1-1 base) (&+ (the-as pointer v1-127) 16))
)
(dma-bucket-insert-tag
(-> *display* frames (-> *display* on-screen) frame bucket-group)
(bucket-id debug)
s2-1
(the-as (pointer dma-tag) a3-3)
)
)
)
)
(set! (-> gp-0 origin y) f30-2)
)
)
(set! sv-200 (+ sv-200 1))
(set! (-> *game-text-line* data 0) (the-as uint 0))
(set! sv-192 0)
(set! sv-212 (the-as symbol #f))
)
(when (= sv-208 #t)
(copy-charp<-charp (&-> *game-text-line* data sv-192) (-> *game-text-word* data))
(set! sv-192 (+ sv-192 sv-184))
(set! sv-184 0)
(set! sv-208 (the-as symbol #f))
)
(when (nonzero? sv-176)
(set! sv-140 (&-> sv-140 1))
(set! sv-176 (the-as int (-> sv-140 0)))
)
)
(set! (-> gp-0 mat vector 0 x) sv-112)
(set! (-> gp-0 mat vector 1 y) sv-116)
(set! (-> *video-parms* relative-x-scale) sv-120)
(set! (-> *video-parms* relative-y-scale) sv-124)
(set! (-> *video-parms* relative-x-scale-reciprical) sv-128)
(set! (-> *video-parms* relative-y-scale-reciprical) sv-132)
(#when PC_PORT
(if (and *debug-segment* *display-text-box*)
(draw-debug-text-box font-ctxt)))
(if (> sv-168 0)
(* sv-164 (the float sv-168))
0.0
)
)
)
)
(defun disable-level-text-file-loading ()
(set! *level-text-file-load-flag* #f)
0
(none)
)
(defun enable-level-text-file-loading ()
(set! *level-text-file-load-flag* #t)
0
(none)
)