;;-*-Lisp-*- (in-package goal) ;; name: file-io.gc ;; name in dgo: file-io ;; dgos: GAME, ENGINE ;; 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. (deftype file-stream (basic) ((flags uint32 :offset-assert 4) (mode basic :offset-assert 8) (name string :offset-assert 12) (file uint32 :offset-assert 16) ) (:methods (new (symbol type string basic) _type_) ) :method-count-assert 9 :size-assert #x14 :flag-assert #x900000014 ) (defmethod new file-stream ((allocation symbol) (type-to-make type) (name string) (mode basic)) "Allocate a file-stream and open it." (let ((stream (object-new allocation type-to-make))) (file-stream-open stream name mode) stream ) ) ;; we already have a length method for a file-stream defined in C. ;; just store that in the method table. (set! (-> file-stream method-table 4) file-stream-length) (defun file-stream-read-string ((stream file-stream) (str string)) "Fill a string with data from a file stream. Note: this function does not work." ;; makes the length of the string 0. (clear str) ;; so this will read nothing. (file-stream-read stream (-> str data) (length str)) str ) ;; A common file header found in GOAL files. (deftype file-info (basic) ((file-type symbol :offset-assert 4) (file-name basic :offset-assert 8) (major-version uint32 :offset-assert 12) (minor-version uint32 :offset-assert 16) (maya-file-name basic :offset-assert 20) (tool-debug basic :offset-assert 24) (mdb-file-name basic :offset-assert 28) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 ) (defmethod print file-info ((obj file-info)) "Print information about a file" (format #t "#<~A ~A :version ~D.~D @ #x~X>" (-> obj type) (-> obj file-name) (-> obj major-version) (-> obj minor-version) obj) obj ) ;; allocate a temporary string (define *file-temp-string* (new 'global 'string 128 (the string #f))) (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) ) (defconstant LEVEL_BT_FILE_VERSION 30) (defconstant ART_GROUP_FILE_VERSION 6) (defconstant TPAGE_FILE_VERSION 7) ;; also used for dir (defconstant LEVEL_VS_FILE_VERSION 30) (defconstant TX_FILE_VERSION 1) (defun make-file-name ((kind file-kind) (name string) (art-group-version int)) "Get a file name to open a file with the given kind and name. The art-group-version argument can be used to override the version of the art-group. Set it to 0 or less to use the default version Similar to MakeFileName in C. Note: file type enum is different between C and GOAL. File versions should match those in versions.h. Uses a single *file-temp-string* buffer, shared with make-vfile-name" (clear *file-temp-string*) (cond ((= kind (file-kind dir-tpage)) (format *file-temp-string* "texture-page~D/dir-tpages" TPAGE_FILE_VERSION) ) ((= kind (file-kind tpage)) (format *file-temp-string* "texture-page~D/tpage-~S" TPAGE_FILE_VERSION name) ) ((= kind (file-kind level-bt)) (format *file-temp-string* "level~D/~S-bt" LEVEL_VS_FILE_VERSION name) ) ((= kind (file-kind tx)) (format *file-temp-string* "res~D/~S-tx" TX_FILE_VERSION name) ) ((= kind (file-kind level-vs)) (format *file-temp-string* "level~D/~S-vs" LEVEL_BT_FILE_VERSION name) ) ((= kind (file-kind vis)) (format *file-temp-string* "~S.VIS" name) ) ((= kind (file-kind art-group)) (format *file-temp-string* "art-group~D/~S-ag" (if (> art-group-version 0) art-group-version ART_GROUP_FILE_VERSION ) name ) ) ) *file-temp-string* ) (defun make-vfile-name ((kind file-kind) (name string)) "Make virtual? file name. This makes a name that the kernel knows how to handle in a specific way. This function is not used." (clear *file-temp-string*) (cond ((= kind (file-kind level-bt)) (format *file-temp-string* "$LEVEL/~S" name) ) ((= kind (file-kind art-group)) (format *file-temp-string* "$ART_GROUP/~S" name) ) ) *file-temp-string* ) (defun file-info-correct-version? ((info file-info) (kind file-kind) (version-override int)) "Check if the version and kind in the info is valid. The version-override can specify a non-default version, or set to 0 for the default version" (let* ((expected-version (if (zero? version-override) (let ((v1-0 kind)) (cond ((or (= v1-0 (file-kind tpage)) (= v1-0 (file-kind dir-tpage))) TPAGE_FILE_VERSION ) ((= kind (file-kind level-vs)) LEVEL_BT_FILE_VERSION ) ((= v1-0 (file-kind art-group)) ART_GROUP_FILE_VERSION ) ) ) version-override ) ) (v1-1 kind) (kind-name (cond ((= v1-1 (file-kind tpage)) "texture-page" ) ((= kind (file-kind level-vs)) "bsp-header" ) ((= v1-1 (file-kind art-group)) "art-group" ) ) ) ) (cond ((not (name= (the-as basic (-> info file-type value)) kind-name)) (format 0 "ERROR: file ~A is of type ~S but needs to be ~S.~%" (-> info file-name) (-> info file-type) kind-name ) #f ) ((!= expected-version (-> info major-version)) (format 0 "ERROR: file ~A is version ~D.~D, but needs to be ~D.x~%" (-> info file-name) (-> info major-version) (-> info minor-version) expected-version ) #f ) (else ;; all checks passed! #t ) ) ) )