Files
jak-project/goal_src/jak2/engine/ui/text.gc
T
ManDude cd68cb671e deftype and defmethod syntax major changes (#3094)
Major change to how `deftype` shows up in our code:
- the decompiler will no longer emit the `offset-assert`,
`method-count-assert`, `size-assert` and `flag-assert` parameters. There
are extremely few cases where having this in the decompiled code is
helpful, as the types there come from `all-types` which already has
those parameters. This also doesn't break type consistency because:
  - the asserts aren't compared.
- the first step of the test uses `all-types`, which has the asserts,
which will throw an error if they're bad.
- the decompiler won't emit the `heap-base` parameter unless necessary
now.
- the decompiler will try its hardest to turn a fixed-offset field into
an `overlay-at` field. It falls back to the old offset if all else
fails.
- `overlay-at` now supports field "dereferencing" to specify the offset
that's within a field that's a structure, e.g.:
```lisp
(deftype foobar (structure)
  ((vec    vector  :inline)
   (flags  int32   :overlay-at (-> vec w))
   )
  )
```
in this structure, the offset of `flags` will be 12 because that is the
final offset of `vec`'s `w` field within this structure.
- **removed ID from all method declarations.** IDs are only ever
automatically assigned now. Fixes #3068.
- added an `:overlay` parameter to method declarations, in order to
declare a new method that goes on top of a previously-defined method.
Syntax is `:overlay <method-name>`. Please do not ever use this.
- added `state-methods` list parameter. This lets you quickly specify a
list of states to be put in the method table. Same syntax as the
`states` list parameter. The decompiler will try to put as many states
in this as it can without messing with the method ID order.

Also changes `defmethod` to make the first type definition (before the
arguments) optional. The type can now be inferred from the first
argument. Fixes #3093.

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2023-10-30 03:20:02 +00:00

598 lines
19 KiB
Common Lisp

;;-*-Lisp-*-
(in-package goal)
;; name: text.gc
;; name in dgo: text
;; dgos: ENGINE, GAME
;; DECOMP BEGINS
(kmemopen global "text")
(define *expand-buf-number* 0)
(define *game-text-word* (new 'global 'string 256 (the-as string #f)))
(define *game-text-line* (new 'global 'string 1024 (the-as string #f)))
(define *expanded-text-line0* (new 'global 'string 1024 (the-as string #f)))
(define *expanded-text-line1* (new 'global 'string 1024 (the-as string #f)))
(define *level-text-file-load-flag* #t)
(when (zero? (-> *common-text-heap* base))
(let ((gp-0 *common-text-heap*))
(set! (-> gp-0 base) (kmalloc global #x10000 (kmalloc-flags) "heap"))
(set! (-> gp-0 current) (-> gp-0 base))
(set! (-> gp-0 top-base) (&+ (-> gp-0 base) #x10000))
(set! (-> gp-0 top) (-> gp-0 top-base))
)
)
(kmemclose)
(defmethod relocate ((this game-text-info) (arg0 int))
(let ((v1-1 (-> *level* loading-level)))
(when v1-1
(set! (-> v1-1 loaded-text-info (-> v1-1 loaded-text-info-count)) this)
(+! (-> v1-1 loaded-text-info-count) 1)
)
)
this
)
(defmethod length ((this game-text-info))
(-> this length)
)
;; WARN: Return type mismatch uint vs int.
(defmethod asize-of ((this game-text-info))
(the-as int (+ (-> this type size) (* (-> this length) 8)))
)
(defmethod mem-usage ((this game-text-info) (arg0 memory-usage-block) (arg1 int))
(set! (-> arg0 length) (max 84 (-> arg0 length)))
(set! (-> arg0 data 83 name) "string")
(+! (-> arg0 data 83 count) 1)
(let ((v1-6 (asize-of this)))
(+! (-> arg0 data 83 used) v1-6)
(+! (-> arg0 data 83 total) (logand -16 (+ v1-6 15)))
)
(dotimes (s4-0 (-> this length))
(set! (-> arg0 length) (max 84 (-> arg0 length)))
(set! (-> arg0 data 83 name) "string")
(+! (-> arg0 data 83 count) 1)
(let ((v1-18 (asize-of (-> this data s4-0 text))))
(+! (-> arg0 data 83 used) v1-18)
(+! (-> arg0 data 83 total) (logand -16 (+ v1-18 15)))
)
)
this
)
(defun convert-korean-text ((arg0 string))
"Converts the provided [[string]] of [[game-text]] into korean. Returns a [[string]]"
(local-vars (v1-21 int))
(let ((charp (-> arg0 data)))
*expanded-text-line0*
(let ((s4-0 0))
0
(let ((s1-0 0)
(s5-0 (length arg0))
)
(set! *expand-buf-number* (logxor *expand-buf-number* 1))
(let ((s3-0 (if (zero? *expand-buf-number*)
*expanded-text-line0*
*expanded-text-line1*
)
)
)
(let ((s2-0 (+ (-> s3-0 allocated-length) -1)))
(clear s3-0)
(while (< s4-0 s5-0)
(cond
((= (-> charp s4-0) 3)
(+! s4-0 1)
(while (and (< s4-0 s5-0) (!= (-> charp s4-0) 3) (!= (-> charp s4-0) 4))
(set! (-> s3-0 data s1-0) (-> charp s4-0))
(+! s4-0 1)
(+! s1-0 1)
)
)
(else
(let ((v1-17 (+ s4-0 1)))
(-> charp v1-17)
(set! s4-0 (+ v1-17 1))
)
(set! (-> s3-0 data s1-0) (the-as uint 126))
(let ((v1-19 (+ s1-0 1)))
(set! (-> s3-0 data v1-19) (the-as uint 89))
(let ((v1-20 (+ v1-19 1)))
(while (and (< s4-0 s5-0) (< v1-20 s2-0) (!= (-> charp s4-0) 3) (!= (-> charp s4-0) 4))
(cond
((= (-> charp s4-0) 5)
(set! (-> s3-0 data v1-20) (the-as uint 1))
(+! s4-0 1)
(set! v1-21 (+ v1-20 1))
)
(else
(set! (-> s3-0 data v1-20) (the-as uint 3))
(set! v1-21 (+ v1-20 1))
)
)
(set! (-> s3-0 data v1-21) (-> charp s4-0))
(+! s4-0 1)
(let ((v1-22 (+ v1-21 1)))
(set! (-> s3-0 data v1-22) (the-as uint 126))
(let ((v1-23 (+ v1-22 1)))
(set! (-> s3-0 data v1-23) (the-as uint 90))
(set! v1-20 (+ v1-23 1))
)
)
)
(set! (-> s3-0 data v1-20) (the-as uint 126))
(let ((v1-24 (+ v1-20 1)))
(set! (-> s3-0 data v1-24) (the-as uint 43))
(let ((v1-25 (+ v1-24 1)))
(set! (-> s3-0 data v1-25) (the-as uint 50))
(let ((v1-26 (+ v1-25 1)))
(set! (-> s3-0 data v1-26) (the-as uint 54))
(let ((v1-27 (+ v1-26 1)))
(set! (-> s3-0 data v1-27) (the-as uint 72))
(set! s1-0 (+ v1-27 1))
)
)
)
)
)
)
)
)
)
)
(set! (-> s3-0 data s1-0) (the-as uint 0))
s3-0
)
)
)
)
)
(defmethod lookup-text! ((this game-text-info) (arg0 text-id) (arg1 symbol))
(cond
((= this #f)
(cond
(arg1
(the-as string #f)
)
(else
(format (clear *temp-string*) "NO GAME TEXT")
*temp-string*
)
)
)
(else
(let* ((a1-2 0)
(a3-0 (+ (-> this length) 1))
(v1-2 (/ (+ a1-2 a3-0) 2))
)
(let ((t0-0 -1))
(while (and (!= (-> this data v1-2 id) arg0) (!= v1-2 t0-0))
(if (< (the-as uint arg0) (the-as uint (-> this data v1-2 id)))
(set! a3-0 v1-2)
(set! a1-2 v1-2)
)
(set! t0-0 v1-2)
(set! v1-2 (/ (+ a1-2 a3-0) 2))
)
)
(cond
((!= (-> this data v1-2 id) arg0)
(cond
(arg1
(the-as string #f)
)
(else
(format (clear *temp-string*) "UNKNOWN ID ~X" arg0)
*temp-string*
)
)
)
((= (-> this language-id) 6)
(convert-korean-text (-> this data v1-2 text))
)
(else
(-> this data v1-2 text)
)
)
)
)
)
)
(defmethod lookup-text ((this level) (arg0 text-id) (arg1 symbol))
(let ((v1-0 *common-text*))
(dotimes (a3-0 (-> this loaded-text-info-count))
(if (= (-> this loaded-text-info a3-0 language-id) (-> *setting-control* user-current language))
(set! v1-0 (-> this loaded-text-info a3-0))
)
)
(lookup-text! v1-0 arg0 arg1)
)
)
(define text-is-loading #f)
;; WARN: Found some very strange gotos. Check result carefully, this is not well tested.
(defun load-game-text-info ((arg0 string) (arg1 (pointer object)) (arg2 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-3 int) (sv-16 game-text-info) (sv-24 int) (sv-32 int) (sv-40 int))
(set! sv-16 (the-as game-text-info (-> arg1 0)))
(set! sv-24 (the-as int (-> *setting-control* user-current language)))
(set! sv-32 0)
(set! sv-40 (&- (-> arg2 top) (the-as uint (-> arg2 base))))
(if (and (= (scf-get-territory) 1) (= sv-24 (language-enum english)) (not (demo?)))
(set! sv-24 7)
)
(when (or (= sv-16 #f) (!= (-> sv-16 language-id) sv-24) (not (string= (-> sv-16 group-name) arg0)))
(let ((v1-16 arg2))
(set! (-> v1-16 current) (-> v1-16 base))
)
(b! #t cfg-17 :delay (nop!))
(label cfg-16)
(set! v0-3 0)
(b! #t cfg-30 :delay (nop!))
(label cfg-17)
(let ((s3-0 str-load))
(format (clear *temp-string*) "~D~S.TXT" sv-24 arg0)
(b!
(not (s3-0
*temp-string*
-1
(logand -64 (&+ (-> arg2 current) 63))
(&- (-> arg2 top) (the-as uint (-> arg2 current)))
)
)
cfg-16
:delay (nop!)
)
)
(label cfg-19)
(let ((v1-20 (str-load-status (the-as (pointer int32) (& sv-32)))))
(b! (!= v1-20 'error) cfg-22 :delay (empty-form))
(format 0 "Error loading text~%")
(set! v0-3 0)
(b! #t cfg-30 :delay (nop!))
(the-as none 0)
(b! #t cfg-27 :delay (nop!))
(label cfg-22)
(cond
((>= sv-32 (+ sv-40 -300))
(format 0 "Game text heap overrun!~%")
(return 0)
)
((= v1-20 'busy)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(goto cfg-19)
)
)
)
(label cfg-27)
(let ((s2-1 (logand -64 (&+ (-> arg2 current) 63))))
(flush-cache 0)
(let ((s3-1 link))
(format (clear *temp-string*) "~D~S.TXT" sv-24 arg0)
(set! (-> arg1 0) (s3-1 s2-1 (-> *temp-string* data) sv-32 arg2 0))
)
)
(if (<= (the-as int (-> arg1 0)) 0)
(set! (-> arg1 0) (the-as object #f))
)
)
(set! v0-3 0)
(label cfg-30)
v0-3
)
(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."
(if (or *level-text-file-load-flag* (>= arg0 0))
(load-game-text-info "common" (&-> '*common-text* value) *common-text-heap*)
)
0
(none)
)
(defun draw-debug-text-box ((arg0 font-context))
"Draws some lines"
(when *cheat-mode*
(#when PC_PORT
(if (logtest? (-> arg0 flags) (font-flags right))
(set! (-> arg0 width) (- (-> arg0 width)))))
(let ((s5-0 (new 'static 'vector4w))
(gp-0 (new 'static 'vector4w-4))
)
(set-vector!
(-> gp-0 vector 0)
(the int (+ -256.0 (-> arg0 origin x)))
(the int (+ -208.0 (-> arg0 origin y)))
0
1
)
(set-vector!
(-> gp-0 vector 1)
(the int (+ -256.0 (-> arg0 width) (-> arg0 origin x)))
(the int (+ -208.0 (-> arg0 origin y)))
0
1
)
(set-vector!
(-> gp-0 vector 2)
(the int (+ -256.0 (-> arg0 width) (-> arg0 origin x)))
(the int (+ -208.0 (-> arg0 height) (-> arg0 origin y)))
0
1
)
(set-vector!
(-> gp-0 vector 3)
(the int (+ -256.0 (-> arg0 origin x)))
(the int (+ -208.0 (-> arg0 height) (-> arg0 origin y)))
0
1
)
(set-vector! s5-0 128 128 128 128)
(add-debug-line2d #t (bucket-id debug-no-zbuf1) (the-as vector4w (-> gp-0 vector)) (-> gp-0 vector 1) s5-0)
(add-debug-line2d #t (bucket-id debug-no-zbuf1) (-> gp-0 vector 1) (-> gp-0 vector 2) s5-0)
(add-debug-line2d #t (bucket-id debug-no-zbuf1) (-> gp-0 vector 2) (-> gp-0 vector 3) s5-0)
(add-debug-line2d #t (bucket-id debug-no-zbuf1) (-> gp-0 vector 3) (the-as vector4w (-> gp-0 vector)) s5-0)
)
(#when PC_PORT
(if (logtest? (-> arg0 flags) (font-flags right))
(set! (-> arg0 width) (- (-> arg0 width)))))
)
0
(none)
)
(defun print-game-text-scaled ((arg0 string) (arg1 float) (arg2 font-context) (arg3 bucket-id))
"Print text, with a given scaling"
(let ((f26-0 (-> arg2 width))
(f30-0 (-> arg2 height))
(f24-0 (-> arg2 origin x))
(f22-0 (-> arg2 origin y))
(f28-0 (-> arg2 scale))
)
(let ((f0-1 (* (-> arg2 width) arg1))
(f1-2 (* (-> arg2 height) arg1))
)
(if (logtest? (-> arg2 flags) (font-flags middle))
(+! (-> arg2 origin x) (* 0.5 (- f26-0 f0-1)))
)
(if (logtest? (-> arg2 flags) (font-flags middle-vert))
(+! (-> arg2 origin y) (* 0.5 (- f30-0 f1-2)))
)
(let ((v1-10 arg2))
(set! (-> v1-10 scale) (* f28-0 arg1))
)
(set! (-> arg2 width) f0-1)
(set! (-> arg2 height) f1-2)
)
(print-game-text arg0 arg2 #f 44 (bucket-id progress))
(set! (-> arg2 origin x) f24-0)
(set! (-> arg2 origin y) f22-0)
(set! (-> arg2 width) f26-0)
(set! (-> arg2 height) f30-0)
(set! (-> arg2 scale) f28-0)
)
0
(none)
)
(defun print-game-text ((arg0 string) (arg1 font-context) (arg2 symbol) (arg3 int) (arg4 bucket-id))
"Print text."
(local-vars
(sv-16 float)
(sv-20 float)
(sv-24 font-flags)
(sv-28 font-color)
(sv-32 (pointer uint8))
(sv-36 float)
(sv-40 float)
(sv-44 float)
(sv-48 float)
(sv-52 float)
(sv-56 float)
(sv-64 int)
(sv-72 uint)
(sv-80 int)
(sv-88 int)
(sv-96 int)
(sv-104 uint)
(sv-108 symbol)
(sv-112 int)
(sv-120 int)
)
(cond
((< 0.1 (-> arg1 scale))
(set! sv-16 (-> arg1 origin x))
(set! sv-20 (-> arg1 origin y))
(set! sv-24 (-> arg1 flags))
(set! sv-28 (-> arg1 color))
(when (logtest? (-> arg1 flags) (font-flags middle-vert))
(logclear! (-> arg1 flags) (font-flags middle-vert))
(+! (-> arg1 origin y)
(the float (the int (* 0.5 (- (-> arg1 height) (print-game-text arg0 arg1 #t 44 (bucket-id progress))))))
)
)
(set! sv-32 (-> arg0 data))
(set! sv-36 (-> arg1 origin x))
(set! sv-40 (-> arg1 origin x))
(set! sv-44 (+ (-> arg1 origin x) (-> arg1 width)))
(set! sv-48 (+ (-> arg1 origin y) (-> arg1 height)))
(set! sv-52 (-> (get-string-length " " arg1) length))
(set! sv-56 (* (if (logtest? (-> arg1 flags) (font-flags large))
(the float arg3)
28.0
)
(-> arg1 scale)
)
)
(set! sv-64 0)
(if (logtest? (-> arg1 flags) (font-flags middle))
(+! (-> arg1 origin x) (* 0.5 (-> arg1 width)))
)
(set! sv-72 (-> sv-32 0))
(set! sv-80 0)
(set! sv-88 0)
(set! sv-96 0)
(set! sv-104 (-> sv-32 1))
(set! sv-108 (the-as symbol #f))
(set! sv-112 0)
(set! sv-120 0)
(set! (-> *game-text-line* data 0) (the-as uint 0))
(while (and (not (and (zero? sv-72) (zero? sv-80) (zero? sv-88))) (>= sv-48 (-> arg1 origin y)))
(set! sv-120 0)
(set! sv-32 (&-> sv-32 1))
(set! sv-104 (-> sv-32 0))
(set! sv-32 (&-> sv-32 -1))
(cond
((and (> sv-72 0) (< sv-72 (the-as uint 4)))
(set! (-> *game-text-word* data sv-80) sv-72)
(set! sv-80 (+ sv-80 1))
(set! (-> *game-text-word* data sv-80) sv-104)
(set! sv-80 (+ sv-80 1))
(set! sv-32 (&-> sv-32 1))
)
((= sv-72 32)
(set! (-> *game-text-word* data sv-80) sv-72)
(set! sv-80 (+ sv-80 1))
(set! sv-108 #t)
)
((zero? sv-72)
(if (nonzero? sv-80)
(set! sv-108 #t)
)
(set! sv-112 (+ sv-112 1))
)
((and (= sv-72 92) (= sv-104 92))
(set! sv-32 (&-> sv-32 1))
(if (nonzero? sv-80)
(set! sv-108 #t)
)
(set! sv-112 (+ sv-112 1))
)
((and (= sv-72 95) (= sv-104 95))
(set! sv-32 (&-> sv-32 1))
(set! (-> *game-text-word* data sv-80) (the-as uint 32))
(set! sv-80 (+ sv-80 1))
)
(else
(set! (-> *game-text-word* data sv-80) sv-72)
(set! sv-80 (+ sv-80 1))
)
)
(when sv-108
(set! (-> *game-text-word* data sv-80) (the-as uint 0))
(let ((f30-1 sv-36))
(set! sv-120 (the int (the-as float (-> (get-string-length *game-text-word* arg1) length))))
(let ((f0-26 (+ f30-1 (the float sv-120))))
(if (= (-> *game-text-word* data (+ sv-80 -1)) 32)
(set! f0-26 (- f0-26 (the-as float sv-52)))
)
(cond
((< sv-44 f0-26)
(set! sv-112 (+ sv-112 1))
)
(else
(copy-charp<-charp (&-> *game-text-line* data sv-88) (-> *game-text-word* data))
(set! sv-88 (+ sv-88 sv-80))
(set! sv-80 0)
(set! sv-36 (+ sv-36 (the float sv-120)))
(set! sv-108 (the-as symbol #f))
)
)
)
)
)
(while (> sv-112 0)
(let ((f30-2 (+ (-> arg1 origin y) sv-56)))
(when (and (>= sv-96 (the-as int (-> arg1 start-line))) #t)
(when (= (-> *game-text-line* data (+ sv-88 -1)) 32)
(set! (-> *game-text-line* data (+ sv-88 -1)) (the-as uint 0))
0
)
(if (nonzero? (-> *game-text-line* data 0))
(set! sv-64 (+ sv-64 1))
)
(when (not arg2)
(with-dma-buffer-add-bucket ((s2-1 (-> *display* frames (-> *display* on-screen) global-buf))
arg4
)
(draw-string *game-text-line* s2-1 arg1)
(set! (-> arg1 color) (-> *font-work* last-color))
)
)
(set! (-> arg1 origin y) f30-2)
)
)
(set! sv-96 (+ sv-96 1))
(set! (-> *game-text-line* data 0) (the-as uint 0))
(set! sv-88 0)
(set! sv-112 (+ sv-112 -1))
(set! sv-36 sv-40)
(when sv-108
(copy-charp<-charp (&-> *game-text-line* data sv-88) (-> *game-text-word* data))
(set! sv-88 (+ sv-88 sv-80))
(set! sv-80 0)
(set! sv-108 (the-as symbol #f))
(set! sv-36 (+ sv-36 (the float sv-120)))
)
)
(when (nonzero? sv-72)
(set! sv-32 (&-> sv-32 1))
(set! sv-72 (-> sv-32 0))
)
)
(set! (-> arg1 origin x) sv-16)
(set! (-> arg1 origin y) sv-20)
(set! (-> arg1 flags) sv-24)
(set! (-> arg1 color) sv-28)
;; og:preserve-this
(#when PC_PORT
(if (and *debug-segment* *display-text-box*)
(draw-debug-text-box arg1)))
(if (> sv-64 0)
(* sv-56 (the float sv-64))
0.0
)
)
(else
0.0
)
)
)
(defun disable-level-text-file-loading ()
"Disables [[*level-text-file-load-flag*]]"
(set! *level-text-file-load-flag* #f)
0
(none)
)
(defun enable-level-text-file-loading ()
"Disables [[*level-text-file-load-flag*]]"
(set! *level-text-file-load-flag* #t)
0
(none)
)