jak-project/goal_src/engine/load/file-io.gc

;;-*-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
       )
      )
    )
  )