mirror of
https://github.com/open-goal/jak-project
synced 2026-08-05 01:30:22 -04:00
Tyler Wilding
322 lines
9.1 KiB
Common Lisp
322 lines
9.1 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: file-io.gc
|
|
;; name in dgo: file-io
|
|
;; dgos: ENGINE, GAME
|
|
|
|
#|@file
|
|
GOAL File I/O
|
|
This is mostly not used in the retail game and was more for loading stuff during development.
|
|
The file-stream is an inefficient way to load data, but is flexible and can load
|
|
from the CD, or over the network in development.
|
|
The file-info type is used in actual game data for checking versions.
|
|
|
|
Represents a file that can be read/written, similar to FILE* in C.
|
|
|
|
NOTE: this is a special type in three ways:
|
|
1). It is used in the C runtime. This must be kept in sync with kmachine.h's FileStream.
|
|
2). This type is built-in to the compiler (see TypeSystem.cpp, add_builtin_types).
|
|
It must be kept up to date with that definition as well.
|
|
3). The C runtime constructs this type before anything is loaded. The sizes
|
|
must be kept up to date there as well.
|
|
|#
|
|
|
|
;; +++file-kind
|
|
(defenum file-kind
|
|
:bitfield #f
|
|
(level-bt 0) ;; aka bsp-header.
|
|
(art-group 1)
|
|
(tpage 2)
|
|
(dir-tpage 3)
|
|
(level-vs 4)
|
|
(tx 5)
|
|
(vis 6)
|
|
(map 7)
|
|
)
|
|
;; ---file-kind
|
|
|
|
(defconstant SCE_SEEK_SET 0)
|
|
(defconstant SCE_SEEK_CUR 1)
|
|
(defconstant SCE_SEEK_END 2)
|
|
|
|
(defconstant LEVEL_BT_FILE_VERSION 36)
|
|
(defglobalconstant ART_GROUP_FILE_VERSION 8)
|
|
(defconstant TPAGE_FILE_VERSION 8) ;; also used for dir
|
|
(defconstant LEVEL_VS_FILE_VERSION 30)
|
|
(defconstant TX_FILE_VERSION 1)
|
|
(defconstant MAP_FILE_VERSION 1)
|
|
|
|
(defmacro file-stream-valid? (fs)
|
|
`(>= (the-as int (-> ,fs file)) 0)
|
|
)
|
|
|
|
(defmacro file-stream-tell (fs)
|
|
`(file-stream-seek ,fs 0 SCE_SEEK_CUR))
|
|
|
|
(define *sqlpipe-file-path-send* #f)
|
|
(define *sqlpipe-file-path-recv* #f)
|
|
(define *sqlpipe-file-buffer* (the-as (pointer uint32) #f))
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(deftype file-stream (basic)
|
|
((flags uint32)
|
|
(mode symbol)
|
|
(name string)
|
|
(file uint32)
|
|
)
|
|
(:methods
|
|
(new (symbol type string symbol) _type_)
|
|
)
|
|
)
|
|
|
|
|
|
(defmethod new file-stream ((allocation symbol) (type-to-make type) (arg0 string) (arg1 symbol))
|
|
(let ((a0-1 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
|
(file-stream-open a0-1 arg0 arg1)
|
|
)
|
|
)
|
|
|
|
(set! (-> file-stream method-table 4) file-stream-length)
|
|
|
|
(defun file-stream-read-string ((arg0 file-stream) (arg1 string))
|
|
(clear arg1)
|
|
(file-stream-read arg0 (-> arg1 data) (length arg0))
|
|
arg1
|
|
)
|
|
|
|
(deftype file-info (basic)
|
|
((file-type (pointer string))
|
|
(file-name string)
|
|
(major-version uint32)
|
|
(minor-version uint32)
|
|
(maya-file-name string)
|
|
(tool-debug string)
|
|
(mdb-file-name string)
|
|
)
|
|
)
|
|
|
|
|
|
(defmethod print ((this file-info))
|
|
(format
|
|
#t
|
|
"#<~A ~A :version ~D.~D @ #x~X>"
|
|
(-> this type)
|
|
(-> this file-name)
|
|
(-> this major-version)
|
|
(-> this minor-version)
|
|
this
|
|
)
|
|
this
|
|
)
|
|
|
|
(define *file-temp-string* (new 'global 'string 128 (the-as string #f)))
|
|
|
|
(defun make-file-name ((arg0 file-kind) (arg1 string) (arg2 int) (arg3 symbol))
|
|
(clear *file-temp-string*)
|
|
(cond
|
|
((= arg0 (file-kind dir-tpage))
|
|
(format *file-temp-string* "texture-page~D/dir-tpages" 8)
|
|
)
|
|
((= arg0 (file-kind tpage))
|
|
(format *file-temp-string* "texture-page~D/tpage-~S" 8 arg1)
|
|
)
|
|
((= arg0 (file-kind level-bt))
|
|
(format *file-temp-string* "level~D/~S-bt" 37 arg1)
|
|
)
|
|
((= arg0 (file-kind tx))
|
|
(format *file-temp-string* "res~D/~S-tx" 1 arg1)
|
|
)
|
|
((= arg0 (file-kind level-vs))
|
|
(format *file-temp-string* "level~D/~S-vs" 37 arg1)
|
|
)
|
|
((= arg0 (file-kind vis))
|
|
(format *file-temp-string* "~S.VIS" arg1)
|
|
)
|
|
((= arg0 (file-kind map))
|
|
(format *file-temp-string* "map~D/~S-mp" 1 arg1)
|
|
)
|
|
((= arg0 (file-kind art-group))
|
|
(format
|
|
*file-temp-string*
|
|
"art-group~D/~S-ag"
|
|
(cond
|
|
((> arg2 0)
|
|
(empty)
|
|
arg2
|
|
)
|
|
(else
|
|
8
|
|
)
|
|
)
|
|
arg1
|
|
)
|
|
)
|
|
)
|
|
*file-temp-string*
|
|
)
|
|
|
|
(defun make-vfile-name ((arg0 file-kind) (arg1 string))
|
|
(clear *file-temp-string*)
|
|
(cond
|
|
((= arg0 (file-kind level-bt))
|
|
(format *file-temp-string* "$LEVEL/~S" arg1)
|
|
)
|
|
((= arg0 (file-kind art-group))
|
|
(format *file-temp-string* "$ART_GROUP/~S" arg1)
|
|
)
|
|
)
|
|
*file-temp-string*
|
|
)
|
|
|
|
(defun file-info-correct-version? ((arg0 file-info) (arg1 file-kind) (arg2 int))
|
|
(let* ((s5-0 (cond
|
|
((zero? arg2)
|
|
(case arg1
|
|
(((file-kind tpage) (file-kind dir-tpage))
|
|
8
|
|
)
|
|
(((file-kind level-bt))
|
|
37
|
|
)
|
|
(((file-kind art-group))
|
|
8
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
arg2
|
|
)
|
|
)
|
|
)
|
|
(v1-1 arg1)
|
|
(s4-0 (cond
|
|
((= v1-1 (file-kind tpage))
|
|
"texture-page"
|
|
)
|
|
((= v1-1 (file-kind level-bt))
|
|
"bsp-header"
|
|
)
|
|
((= v1-1 (file-kind art-group))
|
|
"art-group"
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(cond
|
|
((not (name= (-> arg0 file-type 0) s4-0))
|
|
(format 0 "ERROR: file ~A is of type ~S but needs to be ~S.~%" (-> arg0 file-name) (-> arg0 file-type) s4-0)
|
|
#f
|
|
)
|
|
((!= s5-0 (-> arg0 major-version))
|
|
(format
|
|
0
|
|
"ERROR: file ~A is version ~D.~D, but needs to be ~D.x~%"
|
|
(-> arg0 file-name)
|
|
(-> arg0 major-version)
|
|
(-> arg0 minor-version)
|
|
s5-0
|
|
)
|
|
#f
|
|
)
|
|
(else
|
|
#t
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun file-stream-read-complete ((arg0 file-stream) (arg1 pointer) (arg2 int))
|
|
(let ((gp-0 arg2))
|
|
(while (> arg2 0)
|
|
(let ((v1-0 (file-stream-read arg0 arg1 arg2)))
|
|
(when (<= v1-0 0)
|
|
(set! gp-0 (- gp-0 arg2))
|
|
(goto cfg-7)
|
|
)
|
|
(&+! arg1 v1-0)
|
|
(set! arg2 (- arg2 v1-0))
|
|
)
|
|
)
|
|
(label cfg-7)
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(defun sqlpipe-query ((arg0 string))
|
|
(format 0 "[sqlpipe-query]: ~A~%" arg0)
|
|
(when (not *sqlpipe-file-path-send*)
|
|
(set! *sqlpipe-file-path-send* (the-as symbol (new 'debug 'string 1024 (the-as string #f))))
|
|
(format *sqlpipe-file-path-send* "db/sql/~S.send" *user*)
|
|
)
|
|
(when (not *sqlpipe-file-path-recv*)
|
|
(set! *sqlpipe-file-path-recv* (the-as symbol (new 'debug 'string 1024 (the-as string #f))))
|
|
(format *sqlpipe-file-path-recv* "db/sql/~S.recv" *user*)
|
|
)
|
|
(if (not *sqlpipe-file-buffer*)
|
|
(set! *sqlpipe-file-buffer* (the-as (pointer uint32) (new 'debug 'string #x10000 (the-as string #f))))
|
|
)
|
|
(let ((s5-0 (new 'stack 'file-stream (the-as string *sqlpipe-file-path-send*) 'write)))
|
|
(when (logtest? (-> s5-0 flags) 1)
|
|
(format 0 "ERROR: unable to open file ~S~%" *sqlpipe-file-path-send*)
|
|
(return (the-as sql-result #f))
|
|
)
|
|
(format s5-0 "~S" arg0)
|
|
(file-stream-close s5-0)
|
|
)
|
|
(clear (the-as string *sqlpipe-file-buffer*))
|
|
0
|
|
(let ((s5-1 (new 'stack 'file-stream (the-as string *sqlpipe-file-path-recv*) 'read)))
|
|
(when (logtest? (-> s5-1 flags) 1)
|
|
(format 0 "ERROR: unable to open file ~S~%" *sqlpipe-file-path-recv*)
|
|
(return (the-as sql-result #f))
|
|
)
|
|
(file-stream-read-complete s5-1 (&-> *sqlpipe-file-buffer* 1) 4)
|
|
(let ((gp-1 (-> (&-> *sqlpipe-file-buffer* 1) 0)))
|
|
(file-stream-read-complete s5-1 (&-> *sqlpipe-file-buffer* 1) #x10000)
|
|
(file-stream-close s5-1)
|
|
(let ((s5-2 (new 'debug 'sql-result (the-as int gp-1))))
|
|
(let ((s4-0 0)
|
|
(s2-0 (the-as (pointer uinteger) (&-> *sqlpipe-file-buffer* 1)))
|
|
(s3-0 (string-skip-to-char (the-as (pointer uint8) (&-> *sqlpipe-file-buffer* 1)) (the-as uint 30)))
|
|
)
|
|
(while (and (= (-> s3-0 0) 30) (>= (the-as int gp-1) s4-0))
|
|
(let ((s1-0 (new 'debug 'string (&- s3-0 (the-as uint s2-0)) (the-as string #f))))
|
|
(copyn-string<-charp s1-0 (the-as (pointer uint8) s2-0) (&- s3-0 (the-as uint s2-0)))
|
|
(if (zero? s4-0)
|
|
(set! (-> s5-2 content-type) (the-as type (string->symbol-debug s1-0)))
|
|
(set! (-> s5-2 sql-data (+ s4-0 -1)) s1-0)
|
|
)
|
|
)
|
|
(+! s4-0 1)
|
|
(set! s2-0 (&-> s3-0 1))
|
|
(set! s3-0 (string-skip-to-char (the-as (pointer uint8) s2-0) (the-as uint 30)))
|
|
)
|
|
)
|
|
(set! (-> s5-2 length) (the-as int gp-1))
|
|
(let ((v0-8 s5-2))
|
|
(b! #t cfg-23 :delay (nop!))
|
|
(the-as none 0)
|
|
(set! v0-8 (the-as sql-result #f))
|
|
(label cfg-23)
|
|
v0-8
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(when (not (and (= *kernel-boot-mode* 'listener) #t))
|
|
(set! *sqlpipe-file-path-send* #f)
|
|
(set! *sqlpipe-file-path-recv* #f)
|
|
(set! *sqlpipe-file-buffer* (the-as (pointer uint32) #f))
|
|
;; og:preserve-this stop being weird
|
|
;; (set! file-stream-read-complete L13)
|
|
;; (set! sqlpipe-query L1)
|
|
;; (if (!= sql-query sqlpipe-query)
|
|
;; (set! old-sql-query sql-query)
|
|
;; )
|
|
;; (set! sql-query sqlpipe-query)
|
|
)
|