Level load test (#656)

* tweaks for loading VI1

* temp

* clean up

goal_src/engine/game/main.gc

@@ -23,6 +23,11 @@
 
 (defun display-loop ()
   ;; this function doesnt decompile right now
+  (while #t
+    (suspend)
+    ;;(format #t "hello from the display loop~%")
+    )
+  
   0
   )
 

goal_src/engine/gfx/texture.gc

@@ -1658,3 +1658,11 @@
 
   (none)
   )
+
+(define *texture-pool* (new 'global 'texture-pool))
+
+;; temp hack for loading:
+(defmethod relocate texture-page ((obj texture-page) (offset int))
+  (format #t "HACK! removing texture page ~A from level heap~%" (-> obj name))
+  (remove-from-heap obj loading-level) 
+  )

goal_src/engine/level/level-h.gc

@@ -174,7 +174,7 @@
 (deftype level-group (basic)
   ((length          int32                :offset-assert 4)
    (unknown-level-1 level                :offset-assert 8)
-   (unknown-level-2 level                :offset-assert 12)
+   (unknown-level-2 level                :offset-assert 12) ;; currently loading
    (entity-link     entity-links         :offset-assert 16) ;; not sure what's going on here
    (border?         basic                :offset-assert 20)
    (vis?            basic                :offset-assert 24)

goal_src/engine/level/level.gc

@@ -93,6 +93,44 @@
   )
 
 ;; relocate bsp-header
+(defmethod relocate bsp-header ((obj bsp-header) (arg0 int))
+  (let ((s5-0 (-> *level* unknown-level-2)))
+    (if s5-0
+        (cond
+          (obj
+           (cond
+             ((not (type-type? (-> obj type) bsp-header))
+              (format 0 "ERROR: level ~A is not a bsp-header.~%" (-> s5-0 name))
+              (the-as bsp-header #f)
+              )
+             ((not (file-info-correct-version? (-> obj info) (file-kind level-bt) 0))
+              (the-as bsp-header #f)
+              )
+             ((< 2048 (-> obj visible-list-length))
+              (format 0 "ERROR: level ~A visible-list-length ~d is greater than 2048 (16384 drawables).~%"
+               (-> s5-0 name)
+               (-> obj visible-list-length)
+               )
+              (the-as bsp-header #f)
+              )
+             (else
+              (load-dbg "bsp login: ~A~%" obj)
+              (set! (-> s5-0 bsp) obj)
+              (set! (-> obj level) s5-0)
+              obj
+              )
+             )
+           )
+          (else
+           (format 0 "ERROR: level ~A is not a valid file.~%"
+            (-> s5-0 name)
+            )
+           (the-as bsp-header #f)
+           )
+          )
+        )
+    )
+  )
 
 (defmethod dummy-24 level ((obj level))
   (unless (or (not (-> obj bsp)) (= *kernel-boot-mode* 'debug-boot))
@@ -448,7 +486,8 @@
   (cond
     ((-> obj bsp)
      (set! (-> *level* unknown-level-1) (the-as level (-> obj bsp)))
-     (login-level-textures *texture-pool* obj (-> obj bsp unk-data-1-len) (the-as (pointer texture-id) (-> obj bsp unk-data-1)))
+     ;; TODO
+     ;;(login-level-textures *texture-pool* obj (-> obj bsp unk-data-1-len) (the-as (pointer texture-id) (-> obj bsp unk-data-1)))
      (let ((bsp (-> obj bsp)))
        (when (nonzero? (-> bsp adgifs))
          (let ((adgifs (-> bsp adgifs)))
@@ -479,6 +518,9 @@
    (current-timer int)
    (initial-timer int)
    )
+  ;; TODO REMOVE
+  (goto skip-hard-stuff)
+
   0
   (let ((level-drawable-trees (-> loaded-level bsp drawable-trees)))
    0
@@ -651,6 +693,8 @@
    (set! (-> *subdivide-settings* close 3) f0-0)
    (set! (-> *subdivide-settings* far 3) f1-0)
    )
+
+  (label skip-hard-stuff)
   (dummy-25 loaded-level)
   (dummy-24 loaded-level)
   (set! (-> loaded-level status) 'loaded)
@@ -676,11 +720,11 @@
          (set! loading-level (-> obj heap))
          (set! (-> *level* unknown-level-1) (the-as level (-> obj bsp)))
          (set! (-> *level* unknown-level-2) obj)
-         (dummy-18 (-> obj bsp))
+         ;; (dummy-18 (-> obj bsp)) TODO
          (set! (-> obj status) 'alive)
-         (dummy-15 *game-info*)
-         (send-event *camera* 'level-activate (-> obj name))
-         (send-event *target* 'level-activate (-> obj name))
+         ;; (dummy-15 *game-info*) TODO
+         ;; (send-event *camera* 'level-activate (-> obj name))
+         ;; (send-event *target* 'level-activate (-> obj name))
          )
      )
     )
@@ -1210,9 +1254,12 @@
     (set! *print-login* #f)
     (level-status-set! (level-get *level* startup-level) 'active)
     )
+
+  (load-dbg "Load complete. Level: ~A. Now starting display!~%" (-> *level* level0))
   (on #t)
+  (load-dbg "Display started: ~A~%" *dproc*)
   (when arg1
-    (dummy-9 *game-info* 'game #f (the-as string #f))
+    ;; (dummy-9 *game-info* 'game #f (the-as string #f)) TODO
     )
   0
   )
@@ -1575,3 +1622,11 @@
 
 
 
+(defmacro test-play ()
+  `(begin
+    ;; before calling play, the C Kernel would set this.
+    (define *kernel-boot-message* 'play)
+    (load-package "game" global)
+    (play #t #t)
+    )
+  )

goal_src/engine/load/file-io.gc

@@ -161,7 +161,7 @@
                   ((or (= v1-0 (file-kind tpage)) (= v1-0 (file-kind dir-tpage)))
                    TPAGE_FILE_VERSION
                    )
-                  ((= kind (file-kind level-vs))
+                  ((= kind (file-kind level-bt))
                    LEVEL_BT_FILE_VERSION
                    )
                   ((= v1-0 (file-kind art-group))
@@ -178,7 +178,7 @@
             ((= v1-1 (file-kind tpage))
              "texture-page"
              )
-            ((= kind (file-kind level-vs))
+            ((= kind (file-kind level-bt))
              "bsp-header"
              )
             ((= v1-1 (file-kind art-group))

goal_src/engine/util/types-h.gc

@@ -96,3 +96,17 @@
   "turn a velocity value into a per-tick value"
   `(* (/ 1.0 ,TICKS_PER_SECOND) ,vel)
   )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Debugging Stuff
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; set to #t to get lots of prints during loading
+(defglobalconstant DEBUG_LOAD #t)
+
+(defmacro load-dbg (fmt-str &rest args)
+  (if DEBUG_LOAD
+      `(format 0 ,(string-append "[LOAD] " fmt-str) ,@args)
+      '(empty)
+      )
+  )