Files
water111 637990314b wip: better stack var support (#4222)
Closes #736

---------

Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
2026-04-19 00:14:44 +02:00

610 lines
21 KiB
Common Lisp
Vendored
Generated

;;-*-Lisp-*-
(in-package goal)
;; failed to figure out what this is:
(kmemopen global "text-buffers")
;; definition for symbol *expand-buf-number*, type int
(define *expand-buf-number* 0)
;; definition for symbol *game-text-word*, type string
(define *game-text-word* (new 'global 'string 256 (the-as string #f)))
;; definition for symbol *game-text-line*, type string
(define *game-text-line* (new 'global 'string 1024 (the-as string #f)))
;; definition for symbol *expanded-text-line0*, type string
(define *expanded-text-line0* (new 'global 'string 1024 (the-as string #f)))
;; definition for symbol *expanded-text-line1*, type string
(define *expanded-text-line1* (new 'global 'string 1024 (the-as string #f)))
;; definition for symbol *level-text-file-load-flag*, type symbol
(define *level-text-file-load-flag* #t)
;; failed to figure out what this is:
(when (zero? (-> *common-text-heap* base))
(let ((gp-0 *common-text-heap*))
(set! (-> gp-0 base) (kmalloc global #x12000 (kmalloc-flags) "heap"))
(set! (-> gp-0 current) (-> gp-0 base))
(set! (-> gp-0 top-base) (&+ (-> gp-0 base) #x12000))
(set! (-> gp-0 top) (-> gp-0 top-base))
)
)
;; failed to figure out what this is:
(kmemclose)
;; definition for method 7 of type game-text-info
(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
)
;; definition for method 4 of type game-text-info
(defmethod length ((this game-text-info))
(-> this length)
)
;; definition for method 5 of type game-text-info
;; WARN: Return type mismatch uint vs int.
(defmethod asize-of ((this game-text-info))
(the-as int (+ (-> this type size) (* (-> this length) 8)))
)
;; definition for method 3 of type game-text-info
(defmethod inspect ((this game-text-info))
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~Tlength: ~D~%" (-> this length))
(format #t "~Tlanguage-id: ~D~%" (-> this language-id))
(format #t "~Tgroup-name: ~A~%" (-> this group-name))
(format #t "~Tdata[~D]: @ #x~X~%" (-> this length) (-> this data))
(dotimes (s5-0 (-> this length))
(format #t "~T [~D] #x~X ~A~%" s5-0 (-> this data s5-0 id) (-> this data s5-0 text))
)
this
)
;; definition for method 8 of type game-text-info
(defmethod mem-usage ((this game-text-info) (usage memory-usage-block) (flags int))
(set! (-> usage length) (max 85 (-> usage length)))
(set! (-> usage data 84 name) "string")
(+! (-> usage data 84 count) 1)
(let ((v1-6 (asize-of this)))
(+! (-> usage data 84 used) v1-6)
(+! (-> usage data 84 total) (logand -16 (+ v1-6 15)))
)
(dotimes (s4-0 (-> this length))
(set! (-> usage length) (max 85 (-> usage length)))
(set! (-> usage data 84 name) "string")
(+! (-> usage data 84 count) 1)
(let ((v1-18 (asize-of (-> this data s4-0 text))))
(+! (-> usage data 84 used) v1-18)
(+! (-> usage data 84 total) (logand -16 (+ v1-18 15)))
)
)
this
)
;; definition for function convert-korean-text
(defun convert-korean-text ((arg0 string))
(local-vars (v1-21 int))
(let ((gp-0 (-> 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
((= (-> gp-0 s4-0) 3)
(+! s4-0 1)
(while (and (< s4-0 s5-0) (!= (-> gp-0 s4-0) 3) (!= (-> gp-0 s4-0) 4))
(set! (-> s3-0 data s1-0) (-> gp-0 s4-0))
(+! s4-0 1)
(+! s1-0 1)
)
)
(else
(let ((v1-17 (+ s4-0 1)))
(-> gp-0 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) (!= (-> gp-0 s4-0) 3) (!= (-> gp-0 s4-0) 4))
(cond
((= (-> gp-0 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) (-> gp-0 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
)
)
)
)
)
;; definition for method 9 of type game-text-info
(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) 7)
(convert-korean-text (-> this data v1-2 text))
)
(else
(-> this data v1-2 text)
)
)
)
)
)
)
;; definition for method 23 of type level
(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)
)
)
;; definition for symbol text-is-loading, type symbol
(define text-is-loading #f)
;; definition for function load-game-text-info
;; 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))
(local-vars (v0-4 int))
(let ((sv-16 (-> arg1 0))
(sv-20 (the-as int (-> *setting-control* user-current language)))
(sv-24 0)
(sv-32 (&- (-> arg2 top) (the-as uint (-> arg2 base))))
)
(if (and (= (scf-get-territory) 1) (= (the-as language-enum sv-20) (language-enum english)) (not (demo?)))
(set! sv-20 11)
)
(when (and (or (= sv-16 #f)
(!= (-> (the-as game-text-info sv-16) language-id) sv-20)
(not (string= (-> (the-as game-text-info sv-16) group-name) arg0))
)
(not (load-in-progress? *level*))
)
(let ((v1-19 arg2))
(set! (-> v1-19 current) (-> v1-19 base))
)
(b! #t cfg-21 :delay (nop!))
(label cfg-20)
(set! v0-4 0)
(b! #t cfg-34 :delay (nop!))
(label cfg-21)
(let ((s3-0 str-load))
(format (clear *temp-string*) "~D~S.TXT" sv-20 arg0)
(b!
(not (s3-0
*temp-string*
-1
(logand -64 (&+ (-> arg2 current) 63))
(&- (-> arg2 top) (the-as uint (-> arg2 current)))
)
)
cfg-20
:delay (nop!)
)
)
(label cfg-23)
(let ((v1-23 (str-load-status (the-as (pointer int32) (& sv-24)))))
(cond
((= v1-23 'error)
(format 0 "Error loading text~%")
(return 0)
)
((>= sv-24 (+ sv-32 -300))
(format 0 "Game text heap overrun!~%")
(return 0)
)
((= v1-23 'busy)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(goto cfg-23)
)
)
)
(let ((s2-1 (logand -64 (&+ (-> arg2 current) 63))))
(flush-cache 0)
(let ((s3-1 link))
(format (clear *temp-string*) "~D~S.TXT" sv-20 arg0)
(set! (-> arg1 0) (s3-1 s2-1 (-> *temp-string* data) sv-24 arg2 0))
)
)
(if (<= (the-as int (-> arg1 0)) 0)
(set! (-> arg1 0) (the-as object #f))
)
)
)
(set! v0-4 0)
(label cfg-34)
v0-4
)
;; definition for function load-level-text-files
;; WARN: Return type mismatch int vs none.
(defun load-level-text-files ((arg0 int))
(if (or *level-text-file-load-flag* (>= arg0 0))
(load-game-text-info "common" (&-> '*common-text* value) *common-text-heap*)
)
0
(none)
)
;; definition for function draw-debug-text-box
;; WARN: Return type mismatch int vs none.
(defun draw-debug-text-box ((arg0 font-context))
(when *cheat-mode*
(let ((s5-0 (new 'static 'vector4w))
(gp-0
(new 'static 'inline-array vector4w 4
(new 'static 'vector4w)
(new 'static 'vector4w)
(new 'static 'vector4w)
(new 'static 'vector4w)
)
)
)
(set-vector! (-> gp-0 0) (the int (+ -256.0 (-> arg0 origin x))) (the int (+ -208.0 (-> arg0 origin y))) 0 1)
(set-vector!
(-> gp-0 1)
(the int (+ -256.0 (-> arg0 width) (-> arg0 origin x)))
(the int (+ -208.0 (-> arg0 origin y)))
0
1
)
(set-vector!
(-> gp-0 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 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) (-> gp-0 0) (-> gp-0 1) s5-0)
(add-debug-line2d #t (bucket-id debug-no-zbuf1) (-> gp-0 1) (-> gp-0 2) s5-0)
(add-debug-line2d #t (bucket-id debug-no-zbuf1) (-> gp-0 2) (-> gp-0 3) s5-0)
(add-debug-line2d #t (bucket-id debug-no-zbuf1) (-> gp-0 3) (-> gp-0 0) s5-0)
)
)
0
(none)
)
;; definition for function print-game-text-scaled
;; WARN: Return type mismatch int vs none.
(defun print-game-text-scaled ((arg0 string) (arg1 float) (arg2 font-context) (arg3 bucket-id))
(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)))
)
(set-scale! arg2 (* f28-0 arg1))
(set! (-> arg2 width) f0-1)
(set! (-> arg2 height) f1-2)
)
(print-game-text arg0 arg2 #f 44 (bucket-id hud-draw-hud-alpha))
(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)
)
;; definition for function print-game-text
(defun print-game-text ((arg0 string) (arg1 font-context) (arg2 symbol) (arg3 int) (arg4 bucket-id))
(cond
((< 0.1 (-> arg1 scale))
(let ((sv-16 (-> arg1 origin x))
(sv-20 (-> arg1 origin y))
(sv-24 (-> arg1 flags))
(sv-28 (-> arg1 color))
)
(set-context! *font-work* arg1)
(set! (-> arg1 max-x) sv-16)
(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 hud-draw-hud-alpha)))))
)
)
)
(let ((sv-32 (-> arg0 data))
(sv-36 (-> arg1 origin x))
(sv-40 (-> arg1 origin x))
(sv-44 (+ (-> arg1 origin x) (-> arg1 width)))
(sv-48 (+ (-> arg1 origin y) (-> arg1 height)))
(sv-52 (-> (get-string-length " " arg1) length))
(sv-56 (* (if (logtest? (-> arg1 flags) (font-flags large))
(the float arg3)
28.0
)
(-> arg1 scale)
)
)
(sv-64 0)
)
(if (logtest? (-> arg1 flags) (font-flags middle))
(+! (-> arg1 origin x) (/ (-> arg1 width) 2))
)
(let ((sv-72 (-> sv-32 0))
(sv-80 0)
(sv-88 0)
(sv-96 0)
(sv-104 (-> sv-32 1))
(sv-108 (the-as symbol #f))
(sv-112 0)
(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))
(set! sv-108 (cond
((and (> sv-72 0) (< sv-72 (the-as uint 4)))
(set! (-> *game-text-word* data sv-80) sv-72)
(+! sv-80 1)
(set! (-> *game-text-word* data sv-80) sv-104)
(+! sv-80 1)
(set! sv-32 (&-> sv-32 1))
sv-108
)
((or (= sv-72 32) (= sv-72 47) (and (= sv-72 45) (!= (-> sv-32 -1) 126)))
(set! (-> *game-text-word* data sv-80) sv-72)
(+! sv-80 1)
#t
)
(else
(cond
((zero? sv-72)
(if (nonzero? sv-80)
(set! sv-108 #t)
)
(+! sv-112 1)
)
((and (= sv-72 92) (= sv-104 92))
(set! sv-32 (&-> sv-32 1))
(if (nonzero? sv-80)
(set! sv-108 #t)
)
(+! 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))
(+! sv-80 1)
)
(else
(set! (-> *game-text-word* data sv-80) sv-72)
(+! sv-80 1)
)
)
sv-108
)
)
)
(when sv-108
(set! (-> *game-text-word* data sv-80) (the-as uint 0))
(let ((f30-1 sv-36))
(set! sv-120 (the int (-> (get-string-length *game-text-word* arg1) length)))
(let ((f0-27 (+ f30-1 (the float sv-120))))
(if (= (-> *game-text-word* data (+ sv-80 -1)) 32)
(set! f0-27 (- f0-27 sv-52))
)
(cond
((< sv-44 f0-27)
(set! (-> arg1 max-x) (fmax (-> arg1 max-x) sv-36))
(+! sv-112 1)
)
(else
(copy-charp<-charp (&-> *game-text-line* data sv-88) (-> *game-text-word* data))
(+! sv-88 sv-80)
(set! sv-80 0)
(+! sv-36 (the float sv-120))
(set! (-> arg1 max-x) (fmax (-> arg1 max-x) sv-36))
(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))
(+! 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 origin y) f30-2)
)
)
(+! sv-96 1)
(set! (-> *game-text-line* data 0) (the-as uint 0))
(set! sv-88 0)
(+! sv-112 -1)
(set! sv-36 sv-40)
(when sv-108
(copy-charp<-charp (&-> *game-text-line* data sv-88) (-> *game-text-word* data))
(+! sv-88 sv-80)
(set! sv-80 0)
(set! sv-108 (the-as symbol #f))
(+! 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)
(if (> sv-64 0)
(* sv-56 (the float sv-64))
0.0
)
)
)
)
(else
0.0
)
)
)
;; definition for function disable-level-text-file-loading
;; WARN: Return type mismatch int vs none.
(defun disable-level-text-file-loading ()
(set! *level-text-file-load-flag* #f)
0
(none)
)
;; definition for function enable-level-text-file-loading
;; WARN: Return type mismatch int vs none.
(defun enable-level-text-file-loading ()
(set! *level-text-file-load-flag* #t)
0
(none)
)