;;-*-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) (offset 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) (usage memory-usage-block) (flags int)) (set! (-> usage length) (max 84 (-> usage length))) (set! (-> usage data 83 name) "string") (+! (-> usage data 83 count) 1) (let ((v1-6 (asize-of this))) (+! (-> usage data 83 used) v1-6) (+! (-> usage data 83 total) (logand -16 (+ v1-6 15))) ) (dotimes (s4-0 (-> this length)) (set! (-> usage length) (max 84 (-> usage length))) (set! (-> usage data 83 name) "string") (+! (-> usage data 83 count) 1) (let ((v1-18 (asize-of (-> this data s4-0 text)))) (+! (-> usage data 83 used) v1-18) (+! (-> usage data 83 total) (logand -16 (+ v1-18 15))) ) ) this ) (defun convert-korean-text ((src-str string)) "Converts the provided [[string]] of [[game-text]] into korean. Returns a [[string]]" (local-vars (v1-21 int)) ;; iterate through the bytes in the string (let ((src-ptr (-> src-str data))) (let ((src-i 0)) (let ((dst-i 0) (src-len (length src-str))) ;; use line0 unless expand flag is set (set! *expand-buf-number* (logxor *expand-buf-number* 1)) (let ((dst (if (zero? *expand-buf-number*) *expanded-text-line0* *expanded-text-line1*))) (let ((dst-max (+ (-> dst allocated-length) -1))) (clear dst) (while (< src-i src-len) (cond ;; code 3 = copy chars into destination until we reach a code 3 or 4 ;; i believe this handles non-syllable blocks, like spaces, which are represented like `0x3 0x20` ((= (-> src-ptr src-i) 3) (+! src-i 1) (while (and (< src-i src-len) (!= (-> src-ptr src-i) 3) (!= (-> src-ptr src-i) 4)) (set! (-> dst data dst-i) (-> src-ptr src-i)) (+! src-i 1) (+! dst-i 1))) ;; any other byte (for example #4, which is the start of all syllable blocks) (else ;; look ahead 1 byte (bounds assumed) (let ((next-byte (+ src-i 1))) (-> src-ptr next-byte) ;; meaningless, left-over code? ;; set the src-index to the value of `next-byte`+1 ;; so this would be...the number of characters (or perhaps the number of syllable elements) + 1 ;; this is very important i feel (set! src-i (+ next-byte 1))) ;; the idea here is we render the jamo all at the same position as the texture for each jamo accounts for their offset ;; and then advance when we're done. ;; we use a code of 4 to mark the beginning of a jamo sequence, a.k.a. one hangeul letter. ;; there is jamo at code-page 1 (#x100-#x1ff) and code-page 3 (#x300-#x3ff), though only a handful are in code-page 1. ;; since this requires two bytes per jamo, we assume the jamo is in code-page 3 by default and thus only have to read 1 byte per jamo. ;; however, if we read a code of '5' then that means it is in code-page 1, which means we read 2 bytes. ;; the jamo sequence terminates when we reach a code 3 (copy chars) or code 4 (new letter). ;; when the sequence terminates, we move the font trans forwards and move on with our life. ;; save font trans (~Y) (set! (-> dst data dst-i) (the-as uint 126)) ;; ~ (let ((v1-19 (+ dst-i 1))) (set! (-> dst data v1-19) (the-as uint 89)) ;; Y (let ((dest-index (+ v1-19 1))) ;; inner while loop, go until 0x3 or 0x4, or end of the string (while (and (< src-i src-len) (< dest-index dst-max) (!= (-> src-ptr src-i) 3) (!= (-> src-ptr src-i) 4)) (cond ;; we hit a 0x5 ((= (-> src-ptr src-i) 5) ;; code-page `0x1` byte (set! (-> dst data dest-index) (the-as uint 1)) ;; increment the src-index since we just manually wrote a `0x1` in place of the `0x5` (+! src-i 1) (set! v1-21 (+ dest-index 1)) ) (else ;; code-page `0x3` byte (set! (-> dst data dest-index) (the-as uint 3)) (set! v1-21 (+ dest-index 1)) ) ) ;; now add the byte that we are looking at the current index (set! (-> dst data v1-21) (-> src-ptr src-i)) (+! src-i 1) ;; restore font trans (~Z) (let ((v1-22 (+ v1-21 1))) (set! (-> dst data v1-22) (the-as uint 126)) ;; ~ (let ((v1-23 (+ v1-22 1))) (set! (-> dst data v1-23) (the-as uint 90)) ;; Z (set! dest-index (+ v1-23 1)) ) ) ) ;; advance font trans by 26 (~+26H) (set! (-> dst data dest-index) (the-as uint 126)) ;; ~ (let ((v1-24 (+ dest-index 1))) (set! (-> dst data v1-24) (the-as uint 43)) ;; + (let ((v1-25 (+ v1-24 1))) (set! (-> dst data v1-25) (the-as uint 50)) ;; 2 (let ((v1-26 (+ v1-25 1))) (set! (-> dst data v1-26) (the-as uint 54)) ;; 6 (let ((v1-27 (+ v1-26 1))) (set! (-> dst data v1-27) (the-as uint 72)) ;; H (set! dst-i (+ v1-27 1)) ) ) ) ) ) ) ) ) ) ) ;; null terminate string (set! (-> dst data dst-i) (the-as uint 0)) dst ) ) ) ) ) ;; og:preserve-this extracted implementation out so that callers of `lookup-text!` were uneffected ;; this implementation is different from the original (has fallback text lookup) (define-extern lookup-text-impl! (function game-text-info text-id symbol symbol string)) (defun lookup-text-impl! ((this game-text-info) (arg0 text-id) (arg1 symbol) (fallback-call? 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 ;; og:preserve-this Added fallback to english is string is not found. (#if PC_PORT (if (and *fallback-text-lookup?* (not fallback-call?)) (aif (lookup-text-impl! *fallback-text* arg0 #t #t) it (the-as string #f)) (the-as string #f)) (the-as string #f)) ) (else ;; og:preserve-this Added fallback to english is string is not found. (#if PC_PORT (if (and *fallback-text-lookup?* (not fallback-call?)) (aif (lookup-text-impl! *fallback-text* arg0 #t #t) it (string-format "UNKNOWN ID ~D" arg0)) (string-format "UNKNOWN ID ~D" arg0)) (string-format "UNKNOWN ID ~D" arg0)) ) ) ) ((= (-> this language-id) 6) (convert-korean-text (-> this data v1-2 text)) ) (else (-> this data v1-2 text) ) ) ) ) )) (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 " ;; og:preserve-this call custom function (lookup-text-impl! this arg0 arg1 #f)) (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) (#if PC_PORT (the language-enum (-> *pc-settings* text-language)) (-> *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 language-enum) (sv-32 int) (sv-40 int)) (set! sv-16 (the-as game-text-info (-> arg1 0))) (set! sv-24 (#if PC_PORT (the language-enum (-> *pc-settings* text-language)) (-> *setting-control* user-current language))) (set! sv-32 0) (set! sv-40 (&- (-> arg2 top) (the-as uint (-> arg2 base)))) ;; english -> UK english in PAL ;; og:preserve-this no longer necessary. (#unless PC_PORT (if (and (= (scf-get-territory) GAME_TERRITORY_SCEE) (= sv-24 (language-enum english)) (not (demo?))) (set! sv-24 (language-enum uk-english)) ) ) (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." ;; og:preserve-this Load in english file to use as a fallback (when (or *level-text-file-load-flag* (>= arg0 0)) (load-game-text-info "common" (&-> '*common-text* value) *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* value) *fallback-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) (/ (-> arg1 width) 2)) ) (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) )