Files
jak-project/goal_src/jak2/pc/debug/default-menu-pc.gc

1056 lines
49 KiB
Common Lisp

;;-*-Lisp-*-
(in-package goal)
#|
Extra debug menus for PC port.
|#
(declare-file (debug))
(defmacro new-dm-func (text var func)
`(new 'debug 'debug-menu-item-function ,text ,var (the-as (function int object) ,func))
)
(defmacro new-dm-flag (text var func)
`(new 'debug 'debug-menu-item-flag ,text ,var (the-as (function int debug-menu-msg object) ,func))
)
(defmacro new-dm-bool (text sym func)
`(new-dm-flag ,text (quote ,sym) ,func)
)
(defmacro new-dm-submenu (text menu)
`(new 'debug 'debug-menu-item-submenu ,text ,menu)
)
(defmacro new-dm-var-float (text var func inc min max)
`(debug-menu-item-var-make-float (new 'debug 'debug-menu-item-var ,text ,var (* 8 20))
(the-as (function int debug-menu-msg float float float) ,func)
,inc #t ,min ,max 1)
)
(defun dm-int-var-func ((var symbol) (msg debug-menu-msg) (val int) (undo-val int))
(when (= msg (debug-menu-msg press))
(set! (-> var value) val)
)
(-> var value)
)
;; (defun dm-want-level-toggle-pick-func ((arg0 pair) (arg1 debug-menu-msg))
;; (let* ((levname (the-as symbol (car arg0)))
;; (info (the-as level-load-info (-> levname value)))
;; (idx (the int (cdr arg0)))
;; (the-level (level-get *level* (-> info name)))
;; )
;; (if (and the-level (!= the-level (-> *level* level idx)))
;; (return 'invalid)
;; )
;; (if (= arg1 (debug-menu-msg press))
;; (load-state-want-levels
;; (if (= idx 0) (-> info name) (-> *level* level 0 name))
;; (if (= idx 1) (-> info name) (-> *level* level 1 name))
;; )
;; )
;; (eq? (-> *level* level idx name) (-> info name))
;; )
;; )
;;
;; (defun dm-display-level-toggle-pick-func ((arg0 symbol) (arg1 debug-menu-msg))
;; (let ((the-level (level-get *level* arg0)))
;; (if (not the-level)
;; (return 'invalid)
;; )
;; (if (= arg1 (debug-menu-msg press))
;; (when the-level
;; (load-state-want-display-level arg0
;; (if (-> the-level display?) #f 'display)
;; )
;; )
;; )
;; (and the-level (-> the-level display?))
;; )
;; )
;;
;; (defun debug-menu-make-load-want-menu ((ctx debug-menu-context) (lev-idx int))
;;
;; (let ((want-menu (new 'debug 'debug-menu ctx "Level want menu")))
;;
;; (let ((iter *level-load-list*))
;; (while (not (or (null? iter) (null? (cdr iter)) (null? (cddr iter))))
;; (debug-menu-append-item want-menu (new-dm-flag (symbol->string (the-as symbol (car iter))) (dcons (car iter) lev-idx) dm-want-level-toggle-pick-func))
;;
;; (set! iter (cdr iter))
;; )
;; )
;;
;; (new-dm-submenu (new 'debug 'string 0 (string-format "Want ~D" lev-idx)) want-menu)
;; )
;; )
;;
;; (defun debug-menu-make-load-display-menu ((ctx debug-menu-context))
;;
;; (let ((display-menu (new 'debug 'debug-menu ctx "Level display menu")))
;;
;; (let ((iter *level-load-list*))
;; (while (not (or (null? iter) (null? (cdr iter)) (null? (cddr iter))))
;; (debug-menu-append-item display-menu (new-dm-flag (symbol->string (the-as symbol (car iter))) (car iter) dm-display-level-toggle-pick-func))
;;
;; (set! iter (cdr iter))
;; )
;; )
;;
;; (new-dm-submenu "Display" display-menu)
;; )
;; )
;;
;; (defun debug-menu-make-load-teleport-menu ((ctx debug-menu-context))
;;
;; (let ((teleport-menu (new 'debug 'debug-menu ctx "Camera teleport menu")))
;;
;; (let ((iter *level-load-list*))
;; (while (not (or (null? iter) (null? (cdr iter)) (null? (cddr iter))))
;; (debug-menu-append-item teleport-menu
;; (new-dm-func (symbol->string (the-as symbol (car iter)))
;; (-> (the-as symbol (car iter)) value)
;; (lambda ((info level-load-info))
;; (let ((tf (new 'stack-no-clear 'transformq)))
;; (set! (-> tf trans x) (-> info bsphere x))
;; (set! (-> tf trans y) (-> info bsphere y))
;; (set! (-> tf trans z) (-> info bsphere z))
;; (quaternion-identity! (-> tf quat))
;; (vector-identity! (-> tf scale))
;; (send-event *camera* 'teleport-to-transformq tf)
;; )
;; )
;; ))
;;
;; (set! iter (cdr iter))
;; )
;; )
;;
;; (new-dm-submenu "Camera teleport" teleport-menu)
;; )
;; )
;;
;; (defun debug-menu-make-load-menu ((ctx debug-menu-context))
;; (let ((load-menu (new 'debug 'debug-menu ctx "Load menu")))
;; (debug-menu-append-item load-menu (new-dm-bool "Level Border" *display-level-border* dm-boolean-toggle-pick-func))
;; (debug-menu-append-item load-menu (debug-menu-make-from-template ctx '(flag
;; "border-mode"
;; #f
;; ,(lambda ((arg0 int) (arg1 debug-menu-msg))
;; (if (= arg1 (debug-menu-msg press))
;; (set! (-> *setting-control* default border-mode) (not (-> *setting-control* default border-mode)))
;; )
;; (-> *setting-control* default border-mode)
;; )
;; )))
;;
;; (debug-menu-append-item load-menu (debug-menu-make-load-want-menu ctx 0)) ;; Want 0
;; (debug-menu-append-item load-menu (debug-menu-make-load-want-menu ctx 1)) ;; Want 1
;; (debug-menu-append-item load-menu (debug-menu-make-load-display-menu ctx)) ;; Display
;; (debug-menu-append-item load-menu (debug-menu-make-load-teleport-menu ctx)) ;; Camera teleport
;;
;; (new-dm-submenu "Load" load-menu)
;; )
;; )
(define *part-pick-menu* (the-as debug-menu #f))
(define *spawn-part-test* #t)
(defun dm-part-pick-func ((id int) (msg debug-menu-msg))
(if (zero? (-> *part-group-id-table* id))
(return 'invalid))
(when (= msg (debug-menu-msg press))
(set! *part-tester-id* id)
(if *spawn-part-test*
(start-part)
)
)
(= *part-tester-id* id)
)
(defun build-particles-list ()
(debug-menu-remove-all-items *part-pick-menu*)
(dotimes (i (-> *part-group-id-table* length))
(let ((part (-> *part-group-id-table* i)))
(when (and (nonzero? part))
(debug-menu-append-item *part-pick-menu* (new-dm-flag (-> part name) i dm-part-pick-func))
)
)
)
(set! (-> *part-pick-menu* items) (sort (-> *part-pick-menu* items) debug-menu-node<?))
)
(defun debug-menu-make-part-menu ((ctx debug-menu-context))
(let ((part-menu (new 'debug 'debug-menu ctx "Particles menu")))
(let ((pick-menu (new 'debug 'debug-menu ctx "Particle group pick menu")))
(set! *part-pick-menu* pick-menu)
(debug-menu-append-item part-menu (new-dm-submenu "Pick Particle group" pick-menu))
)
(debug-menu-append-item part-menu (new-dm-func "Refresh" #f build-particles-list))
(debug-menu-append-item part-menu (new-dm-bool "Spawn part tester" *spawn-part-test* dm-boolean-toggle-pick-func))
(new-dm-submenu "Particles" part-menu)
)
)
(define *entity-pick-menu* (the-as debug-menu #f))
(defun dm-entity-flag-func ((e entity) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(if (= (-> *entity-debug-inspect* entity) e)
(set-entity! *entity-debug-inspect* (the entity #f))
(set-entity! *entity-debug-inspect* e))
)
(= (-> *entity-debug-inspect* entity) e)
)
(define *entity-debug-include-part-spawner* #f)
(define *entity-debug-include-cameras* #f)
(define *entity-debug-include-nav-meshes* #f)
(define *entity-debug-include-race-meshes* #f)
(defun build-entity-list ()
"Fill the entity pick menu"
;; clear old list
(debug-menu-remove-all-items *entity-pick-menu*)
;; go through active levels
(dotimes (s5-0 (-> *level* length))
(let ((s4-0 (-> *level* level s5-0)))
(when (= (-> s4-0 status) 'active)
;; actor entities
(let ((s3-0 (-> s4-0 bsp actors)))
(when (nonzero? s3-0)
(dotimes (s2-0 (-> s3-0 length))
(let ((s1-0 (-> s3-0 data s2-0 actor)))
(unless (and (not *entity-debug-include-part-spawner*)
(type-type? (-> s1-0 etype) part-spawner))
(debug-menu-append-item *entity-pick-menu* (new-dm-flag (res-lump-struct s1-0 'name string) s1-0 dm-entity-flag-func))
)
)
)
)
)
;; camera entities
(when *entity-debug-include-cameras*
(let ((s4-1 (-> s4-0 bsp cameras)))
(when (nonzero? s4-1)
(dotimes (s3-2 (-> s4-1 length))
(let ((s2-2 (-> s4-1 s3-2)))
(debug-menu-append-item *entity-pick-menu* (new-dm-flag (res-lump-struct s2-2 'name string) s2-2 dm-entity-flag-func))
)
)
)
)
)
;; nav mesh entities
(when *entity-debug-include-nav-meshes*
(let ((s4-1 (-> s4-0 bsp nav-meshes)))
(when (nonzero? s4-1)
(dotimes (s3-2 (-> s4-1 length))
(let ((s2-2 (-> s4-1 s3-2)))
(debug-menu-append-item *entity-pick-menu* (new-dm-flag (res-lump-struct s2-2 'name string) s2-2 dm-entity-flag-func))
)
)
)
)
)
;; race mesh entities
(when *entity-debug-include-race-meshes*
(let ((s4-1 (-> s4-0 bsp race-meshes)))
(when (nonzero? s4-1)
(dotimes (s3-2 (-> s4-1 length))
(let ((s2-2 (-> s4-1 s3-2)))
(debug-menu-append-item *entity-pick-menu* (new-dm-flag (res-lump-struct s2-2 'name string) s2-2 dm-entity-flag-func))
)
)
)
)
)
)
)
)
(set! (-> *entity-pick-menu* items) (sort (-> *entity-pick-menu* items) debug-menu-node<?))
)
(defun dm-display-entities-pick-func ((arg0 symbol))
(debug-print-entities *level* arg0 (the-as type #f))
)
(defmacro dm-lambda-boolean-flag (val)
"helper macro for making boolean buttons that don't just access symbols directly"
`,(lambda (arg (msg debug-menu-msg))
(if (= msg (debug-menu-msg press))
(not! ,val)
)
,val)
)
(defun debug-menu-make-entity-menu ((ctx debug-menu-context))
(let ((entity-menu (new 'debug 'debug-menu ctx "Entity menu")))
(let ((pick-menu (new 'debug 'debug-menu ctx "Pick entity menu")))
(set! *entity-pick-menu* pick-menu)
(debug-menu-append-item entity-menu (new-dm-submenu "Pick Entity" pick-menu))
)
(debug-menu-append-item entity-menu (new-dm-func "Refresh" #f build-entity-list))
(debug-menu-append-item entity-menu (new-dm-func "Go to entity" #f
(lambda ()
(unless (-> *entity-debug-inspect* entity) (return #f))
(let ((tf (new 'stack 'transformq)))
(vector-copy! (-> tf trans) (-> *entity-debug-inspect* entity trans))
(quaternion-identity! (-> tf quat))
(vector-identity! (-> tf scale))
(send-event *camera* 'teleport-to-transformq tf)
))))
(debug-menu-append-item entity-menu (new-dm-func "Print entity info" #t dm-display-entities-pick-func))
(debug-menu-append-item entity-menu (new-dm-func "Print entity info (ag)" 'art-group dm-display-entities-pick-func))
(debug-menu-append-item entity-menu (new-dm-func "Print entity info (meters)" 'entity-meters dm-display-entities-pick-func))
(debug-menu-append-item entity-menu (new-dm-func "Print entity info (perm)" 'entity-perm dm-display-entities-pick-func))
(debug-menu-append-item entity-menu (new-dm-bool "Include part-spawner" *entity-debug-include-part-spawner* dm-boolean-toggle-pick-func))
(debug-menu-append-item entity-menu (new-dm-bool "Include cameras" *entity-debug-include-cameras* dm-boolean-toggle-pick-func))
(debug-menu-append-item entity-menu (new-dm-bool "Include nav meshes" *entity-debug-include-nav-meshes* dm-boolean-toggle-pick-func))
(debug-menu-append-item entity-menu (new-dm-bool "Include race meshes" *entity-debug-include-race-meshes* dm-boolean-toggle-pick-func))
(new-dm-submenu "Entity" entity-menu)
)
)
(defmacro dm-lambda-int-var (val)
"helper macro for making int buttons"
`,(lambda (arg (msg debug-menu-msg) (newval int))
(cond
((= msg (debug-menu-msg press))
(set! ,val newval)
)
(else
,val
)
))
)
(defmacro dm-lambda-float-var (val)
"helper macro for making float buttons"
`,(lambda (arg (msg debug-menu-msg) (newval float))
(cond
((= msg (debug-menu-msg press))
(set! ,val newval)
)
(else
,val
)
))
)
(defmacro dm-lambda-meters-var (val)
"helper macro for making meters buttons"
`,(lambda (arg (msg debug-menu-msg) (newval float))
(cond
((= msg (debug-menu-msg press))
(set! ,val (meters newval))
)
(else
(* (1/ METER_LENGTH) ,val)
)
))
)
(defun dm-toggle-collision-pick-func ((arg symbol) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(cond
((-> arg value)
(false! (-> arg value))
(logior! (-> *display* vu1-enable-user-menu) (vu1-renderer-mask shrubbery tfrag tfrag-trans tfrag-water tie tie-envmap))
)
(else
(true! (-> arg value))
(logclear! (-> *display* vu1-enable-user-menu) (vu1-renderer-mask shrubbery tfrag tfrag-trans tfrag-water tie tie-envmap))
)
)
)
(-> arg value)
)
(defun dm-collision-mode-pick-func ((arg pc-collision-mode) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(set! *collision-mode* arg)
)
(= *collision-mode* arg)
)
(defun dm-collision-filter-mode-pick-func ((arg int) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(pc-set-collision-mask (pc-collision-mode mode) arg (not (pc-get-collision-mask (pc-collision-mode mode) arg)))
)
(pc-get-collision-mask (pc-collision-mode mode) arg)
)
(defun dm-collision-filter-event-pick-func ((arg int) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(pc-set-collision-mask (pc-collision-mode event) arg (not (pc-get-collision-mask (pc-collision-mode event) arg)))
)
(pc-get-collision-mask (pc-collision-mode event) arg)
)
(defun dm-collision-filter-material-pick-func ((arg int) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(pc-set-collision-mask (pc-collision-mode material) arg (not (pc-get-collision-mask (pc-collision-mode material) arg)))
)
(pc-get-collision-mask (pc-collision-mode material) arg)
)
(defun dm-collision-filter-skip-pick-func ((arg int) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(pc-set-collision-mask (pc-collision-mode skip) arg (not (pc-get-collision-mask (pc-collision-mode skip) arg)))
)
(pc-get-collision-mask (pc-collision-mode skip) arg)
)
(defun dm-collision-filter-skiphide-pick-func ((arg int) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(pc-set-collision-mask (pc-collision-mode skiphide) arg (not (pc-get-collision-mask (pc-collision-mode skiphide) arg)))
)
(pc-get-collision-mask (pc-collision-mode skiphide) arg)
)
(defun debug-menu-make-collision-renderer-menu ((ctx debug-menu-context))
(let ((menu (new 'debug 'debug-menu ctx "OpenGOAL collision renderer menu")))
;; master toggle
(debug-menu-append-item menu (new-dm-bool "Enable" *collision-renderer* dm-toggle-collision-pick-func))
(debug-menu-append-item menu (new-dm-bool "Wireframe" *collision-wireframe* dm-boolean-toggle-pick-func))
(debug-menu-append-item menu (new-dm-submenu "Mode"
(let ((mode-menu (new 'debug 'debug-menu ctx "OpenGOAL collision renderer mode menu")))
(debug-menu-append-item mode-menu (new-dm-flag "none" (pc-collision-mode none) dm-collision-mode-pick-func))
(debug-menu-append-item mode-menu (new-dm-flag "mode" (pc-collision-mode mode) dm-collision-mode-pick-func))
(debug-menu-append-item mode-menu (new-dm-flag "event" (pc-collision-mode event) dm-collision-mode-pick-func))
(debug-menu-append-item mode-menu (new-dm-flag "material" (pc-collision-mode material) dm-collision-mode-pick-func))
mode-menu)))
(debug-menu-append-item menu (new-dm-submenu "Filter mode"
(let ((filter-menu (new 'debug 'debug-menu ctx "OpenGOAL collision renderer filter mode menu")))
(doenum (name val pat-mode)
(debug-menu-append-item filter-menu (new-dm-flag name val dm-collision-filter-mode-pick-func))
)
filter-menu)))
(debug-menu-append-item menu (new-dm-submenu "Filter event"
(let ((filter-menu (new 'debug 'debug-menu ctx "OpenGOAL collision renderer filter event menu")))
(doenum (name val pat-event)
(debug-menu-append-item filter-menu (new-dm-flag name val dm-collision-filter-event-pick-func))
)
filter-menu)))
(debug-menu-append-item menu (new-dm-submenu "Filter material"
(let ((filter-menu (new 'debug 'debug-menu ctx "OpenGOAL collision renderer filter material menu")))
(doenum (name val pat-material)
(debug-menu-append-item filter-menu (new-dm-flag name val dm-collision-filter-material-pick-func))
)
filter-menu)))
(debug-menu-append-item menu (new-dm-submenu "Filter skip"
(let ((filter-menu (new 'debug 'debug-menu ctx "OpenGOAL collision renderer filter skip menu")))
(debug-menu-append-item filter-menu (new-dm-flag "(no skip)" -1 dm-collision-filter-skip-pick-func))
(doenum (name val pc-pat-skip-hack)
(debug-menu-append-item filter-menu (new-dm-flag name val dm-collision-filter-skip-pick-func))
)
filter-menu)))
(debug-menu-append-item menu (new-dm-submenu "Hide skip"
(let ((filter-menu (new 'debug 'debug-menu ctx "OpenGOAL collision renderer hide skip menu")))
(doenum (name val pc-pat-skip-hack)
(debug-menu-append-item filter-menu (new-dm-flag name val dm-collision-filter-skiphide-pick-func))
)
filter-menu)))
(new-dm-submenu "OpenGOAL collision renderer" menu)
)
)
(defun dm-lod-int ((arg0 int) (arg1 debug-menu-msg) (arg2 int) (arg3 int))
(when (= arg1 (debug-menu-msg press))
(case (/ arg0 8)
((0) (set! (-> *pc-settings* lod-force-tfrag) arg2))
((1) (set! (-> *pc-settings* lod-force-tie) arg2))
((2) (set! (-> *pc-settings* lod-force-ocean) arg2))
((3) (set! (-> *pc-settings* lod-force-actor) arg2))
)
)
(case (/ arg0 8)
((0) (-> *pc-settings* lod-force-tfrag))
((1) (-> *pc-settings* lod-force-tie))
((2) (-> *pc-settings* lod-force-ocean))
((3) (-> *pc-settings* lod-force-actor))
(else arg3)
)
)
;; (defun dm-text-language ((blang int) (msg debug-menu-msg))
;; (let ((lang (the pc-language (/ blang 8))))
;; (when (= msg (debug-menu-msg press))
;; (set! (-> *pc-settings* text-language) lang))
;; (= (-> *pc-settings* text-language) lang)
;; )
;; )
;;
(defun dm-subtitle-setting ((setting symbol) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(set! (-> *pc-settings* subtitle-speaker?) setting))
(= (-> *pc-settings* subtitle-speaker?) setting)
)
(defun dm-anim-tester-x-flag-func ((action symbol) (msg debug-menu-msg))
(case action
(('at-show-joint-info)
(if (= msg (debug-menu-msg press))
(logxor! (-> *ATX-settings* flags) (atx-flags show-joints)))
(return (logtest? (-> *ATX-settings* flags) (atx-flags show-joints)))
)
)
#f)
(defun dm-anim-tester-x-refresh ()
(atx-start)
(atx-list-init! (-> *ATX-settings* list-ctrl))
(set! (-> *ATX-settings* list-ctrl func) atx-list-art-group-func)
(atx-add-common-group)
(atx-add-level-group)
)
(defun dm-anim-tester-x-func ((action symbol))
(unless *atx*
(atx-start))
(case action
(('pick-art-group)
(set! (-> *atx* 0 edit-mode) (atx-edit-mode art-group))
;; (false! *camera-read-buttons*)
(logclear! (-> *camera* settings master-options) (cam-master-options READ_BUTTONS))
)
(('at-pick-joint-anim)
(when (-> *atx* 0 cur-art-group)
(set! (-> *atx* 0 edit-mode) (atx-edit-mode anim))
;; (false! *camera-read-buttons*)
(logclear! (-> *camera* settings master-options) (cam-master-options READ_BUTTONS))
)
)
(('pick-mesh-geo)
(when (-> *atx* 0 cur-art-group)
(set! (-> *atx* 0 edit-mode) (atx-edit-mode mgeo))
;; (false! *camera-read-buttons*)
(logclear! (-> *camera* settings master-options) (cam-master-options READ_BUTTONS))
)
)
(('pick-joint-geo)
(when (-> *atx* 0 cur-art-group)
(set! (-> *atx* 0 edit-mode) (atx-edit-mode jgeo))
;; (false! *camera-read-buttons*)
(logclear! (-> *camera* settings master-options) (cam-master-options READ_BUTTONS))
)
)
(('at-cam-free-floating)
(send-event *camera* 'change-state cam-free-floating 0)
)
;; (('at-cam-orbit)
;; (send-event *camera* 'change-state cam-orbit 0)
;; )
)
0)
(defun dm-anim-tester-x-speed-var-func (arg (msg debug-menu-msg) (newval float))
(if (= msg (debug-menu-msg press))
(set! (-> *ATX-settings* speed) newval)
(-> *ATX-settings* speed))
)
(defun dm-anim-tester-x-frame-num-var-func (arg (msg debug-menu-msg) (newval float))
(if (= msg (debug-menu-msg press))
(set! (-> *ATX-settings* frame-num) newval)
(-> *ATX-settings* frame-num))
)
(defun debug-menu-make-anim-tester-x-menu ((ctx debug-menu-context))
(let ((menu (new 'debug 'debug-menu ctx "Anim Tester X menu")))
;; master toggle
(debug-menu-append-item menu (new-dm-func "Start" #f atx-start))
(debug-menu-append-item menu (new-dm-func "Stop" #f atx-stop))
(debug-menu-append-item menu (new-dm-var-float "Speed" (the int #f) dm-anim-tester-x-speed-var-func 0.01 -10.0 10.0))
(debug-menu-append-item menu (new-dm-var-float "Frame Num" (the int #f) dm-anim-tester-x-frame-num-var-func 0.1 0.0 99999.0))
(debug-menu-append-item menu (new-dm-func "Refresh" #f dm-anim-tester-x-refresh))
(debug-menu-append-item menu (new-dm-func "Pick Art Group" 'pick-art-group dm-anim-tester-x-func))
(debug-menu-append-item menu (new-dm-func "Pick Anim" 'at-pick-joint-anim dm-anim-tester-x-func))
(debug-menu-append-item menu (new-dm-func "Pick Mesh" 'pick-mesh-geo dm-anim-tester-x-func))
(debug-menu-append-item menu (new-dm-func "Pick Skeleton" 'pick-joint-geo dm-anim-tester-x-func))
(debug-menu-append-item menu (new-dm-flag "Show Joint Info" 'at-show-joint-info dm-anim-tester-x-flag-func))
(debug-menu-append-item menu (new-dm-func "Free Floating cam" 'at-cam-free-floating dm-anim-tester-x-func))
;; (debug-menu-append-item menu (new-dm-func "Orbit cam" 'at-cam-orbit dm-anim-tester-x-func))
(new-dm-submenu "Anim Tester X" menu)
)
)
;; (defun dm-music-player-func ((lst object))
;; (kill-by-name 'dm-player *active-pool*)
;; (set! *progress-flava* -1)
;; (process-spawn-function process :name 'dm-player
;; (lambda :behavior process ((lst pair))
;; (loop
;; (suspend)
;; (set-setting! 'music (the-as symbol (car lst)) 0.0 0)
;; (set! *progress-flava* (the-as int (cdr lst)))
;; )
;; )
;; lst
;; )
;; )
;;
;; (defun debug-menu-make-music-player-menu ((ctx debug-menu-context))
;; (let ((music-menu (new 'debug 'debug-menu ctx "Music player menu")))
;; (dotimes (i (-> *music-flava-name-list* length))
;; (let* ((flava-list (-> *music-flava-name-list* i))
;; (level-name (new 'debug 'string 30 (text-id->string (-> flava-list 0))))
;; (lvl-menu (new 'debug 'debug-menu ctx (the-as string #f)))
;; )
;; (dotimes (j (-> flava-list length))
;; (let ((flava-name (new 'debug 'string 30 (text-id->string (-> flava-list j)))))
;; (when (and (string= (substring! *temp-string* level-name (- (length level-name) 11) (length level-name)) "-level-name")
;; (string= (substring! *temp-string* flava-name (- (length flava-name) 11) (length flava-name)) "-level-name"))
;; (copy-string<-string flava-name (symbol->string (ref *music-list* i)))
;; )
;; (unless (string= flava-name "zero")
;; (debug-menu-append-item lvl-menu (new-dm-func flava-name (dcons (ref *music-list* i) j) dm-music-player-func))
;; )
;; )
;; )
;; (let ((menu-name (new 'debug 'string 30 (symbol->string (ref *music-list* i)))))
;; (debug-menu-append-item music-menu (new-dm-submenu menu-name lvl-menu))
;; )
;; )
;; )
;; (debug-menu-append-item music-menu (new-dm-func "Reset" #f (lambda () (kill-by-name 'dm-player *active-pool*) (set! *progress-flava* -1))))
;; (new-dm-submenu "Music player" music-menu)
;; )
;; )
(define *region-pick-menu* (the debug-menu #f))
(defun dm-region-pick-func ((r drawable-region-prim) (msg debug-menu-msg))
(when (= msg (debug-menu-msg press))
(if (= *region-debug-inspect* r)
(set! *region-debug-inspect* #f)
(set! *region-debug-inspect* r))
)
(= *region-debug-inspect* r)
)
(defun debug-menu-node-region<? ((arg0 debug-menu-item) (arg1 debug-menu-item))
(<= (-> (the-as drawable-region-prim (-> arg0 id)) region id) (-> (the-as drawable-region-prim (-> arg1 id)) region id))
)
(defun array-uint32-value? ((arr (array uint32)) (val uint))
(dotimes (i (-> arr length))
(if (= val (-> arr i)) (return #t)))
#f)
(define *region-debug-id-list* (new 'static 'boxed-array :type uint32 :length 0 :allocated-length 2000))
(defun build-regions-list ((merge-prims? symbol))
"Fill the region pick menu"
;; clear old list
(debug-menu-remove-all-items *region-pick-menu*)
(set! *region-debug-inspect* #f)
(set! *merge-region-prims* merge-prims?)
(dotimes (i (-> *region-debug-id-list* allocated-length))
(set! (-> *region-debug-id-list* i) -1))
(set! (-> *region-debug-id-list* length) 0)
;; go through active levels
(dotimes (lev-i (-> *level* length))
(let ((lev (-> *level* level lev-i)))
(when (= (-> lev status) 'active)
(let ((region-trees (-> lev bsp region-trees)))
(when (nonzero? region-trees)
(let* ((s3-5 (-> region-trees length))
(tree-i 0)
(region-tree (-> region-trees tree-i))
)
(while (< tree-i s3-5)
(let* ((s0-4 (-> region-tree data2 (+ (-> region-tree length) -1) length))
(i 0)
(region (-> (the-as drawable-inline-array-region-prim (-> region-tree data2 (+ (-> region-tree length) -1))) data i))
)
(while (< i s0-4)
(when (or (not merge-prims?) (not (array-uint32-value? *region-debug-id-list* (-> region region id))))
(debug-menu-append-item *region-pick-menu* (new-dm-flag (new 'debug 'string 0 (string-format "region-~D" (-> region region id))) region dm-region-pick-func))
(when merge-prims?
(set! (-> *region-debug-id-list* (-> *region-debug-id-list* length)) (-> region region id))
(1+! (-> *region-debug-id-list* length))
)
)
(1+! i)
(set! region (-> (the-as drawable-inline-array-region-prim (-> region-tree data2 (+ (-> region-tree length) -1))) data i))
)
)
(1+! tree-i)
(set! region-tree (-> region-trees tree-i))
)
)
)
)
)
)
)
(set! (-> *region-pick-menu* items) (sort (-> *region-pick-menu* items) debug-menu-node-region<?))
)
(defun dm-print-region-pick-func ((kind symbol))
(unless *region-debug-inspect* (return #f))
(case kind
(('on-enter) (format #t "on-enter: ~A~%" (-> *region-debug-inspect* region on-enter)))
(('on-inside) (format #t "on-inside: ~A~%" (-> *region-debug-inspect* region on-inside)))
(('on-exit) (format #t "on-exit: ~A~%" (-> *region-debug-inspect* region on-exit)))
)
)
(defun debug-menu-make-regions-menu ((ctx debug-menu-context))
(let ((regions-menu (new 'debug 'debug-menu ctx "Regions menu")))
(let ((pick-menu (new 'debug 'debug-menu ctx "Pick region menu")))
(set! *region-pick-menu* pick-menu)
(debug-menu-append-item regions-menu (new-dm-submenu "Pick Region" pick-menu))
)
(debug-menu-append-item regions-menu (new-dm-func "Refresh (merge prims)" #t build-regions-list))
(debug-menu-append-item regions-menu (new-dm-func "Refresh" #f build-regions-list))
(debug-menu-append-item regions-menu (new-dm-func "Go to region" #f
(lambda ()
(unless *region-debug-inspect* (return #f))
(let ((tf (new 'stack 'transformq)))
(vector-copy! (-> tf trans) (-> *region-debug-inspect* bsphere))
(quaternion-identity! (-> tf quat))
(vector-identity! (-> tf scale))
(send-event *camera* 'teleport-to-transformq tf)
))))
(debug-menu-append-item regions-menu (new-dm-func "Print on-enter" 'on-enter dm-print-region-pick-func))
(debug-menu-append-item regions-menu (new-dm-func "Print on-inside" 'on-inside dm-print-region-pick-func))
(debug-menu-append-item regions-menu (new-dm-func "Print on-exit" 'on-exit dm-print-region-pick-func))
(debug-menu-append-item regions-menu (new-dm-bool "Display region inside" *display-region-inside* dm-boolean-toggle-pick-func))
(debug-menu-append-item regions-menu (new-dm-bool "Show non-sphere bsphere" *debug-region-show-bsphere* dm-boolean-toggle-pick-func))
(debug-menu-append-item regions-menu (new-dm-bool "Hide water regions" *debug-region-hide-water* dm-boolean-toggle-pick-func))
(debug-menu-append-item regions-menu (new-dm-bool "Hide empty regions" *debug-region-hide-empty* dm-boolean-toggle-pick-func))
(debug-menu-append-item regions-menu (new-dm-bool "Region Marks" *display-region-marks* dm-boolean-toggle-pick-func))
(debug-menu-append-item regions-menu (new-dm-bool "region-mode" #f
(lambda (arg (msg debug-menu-msg))
(if (= msg (debug-menu-msg press))
(not! (-> *setting-control* user-default region-mode))
)
(-> *setting-control* user-default region-mode))))
(new-dm-submenu "Regions" regions-menu)
)
)
(define *made-vag-list* #f)
(defun build-vag-list ((menu debug-menu))
"Fill the vag play menu"
(if *made-vag-list*
(return #f))
(true! *made-vag-list*)
;; clear old list
(debug-menu-remove-all-items menu)
;; make button for each vag, we use an index
(dotimes (i (-> *vag-list* allocated-length))
(debug-menu-append-item menu (new-dm-func (-> *vag-list* i) i vag-player-play-from-index))
)
;; sort by vag name - note: already sorted from before
;(set! (-> menu items) (sort (-> menu items) debug-menu-node<?))
#t)
(define *vag-play-menu* (the debug-menu #f))
(defun debug-menu-make-vag-menu ((ctx debug-menu-context))
(let ((vag-menu (new 'debug 'debug-menu ctx "Vag menu")))
(let ((play-menu (new 'debug 'debug-menu ctx "Play Vag menu")))
(set! *vag-play-menu* play-menu)
(debug-menu-append-item vag-menu (new-dm-submenu "Play" play-menu))
)
(debug-menu-append-item vag-menu (new-dm-func "Make List" *vag-play-menu* build-vag-list))
(debug-menu-append-item vag-menu (new-dm-bool "subtitle" #f
(lambda (arg (msg debug-menu-msg))
(if (= msg (debug-menu-msg press))
(not! (-> *setting-control* user-default subtitle)))
(-> *setting-control* user-default subtitle))))
;; pick channel
(new-dm-submenu "Vag" vag-menu)
)
)
(defun dm-frame-rate-pick-func ((bfps int) (msg debug-menu-msg))
(let ((fps (/ bfps 8)))
(when (= msg (debug-menu-msg press))
(set-frame-rate! *pc-settings* fps #t))
(= (-> *pc-settings* target-fps) fps)))
(defun dm-msaa-pick-func ((bmsaa int) (msg debug-menu-msg))
(let ((msaa (/ bmsaa 8)))
(when (= msg (debug-menu-msg press))
(set! (-> *pc-settings* gfx-msaa) msaa))
(= (-> *pc-settings* gfx-msaa) msaa)))
(defun dm-territory-pick-func ((bterr int) (msg debug-menu-msg))
(let ((terr (/ bterr 8)))
(when (= msg (debug-menu-msg press))
(set! *debug-territory* terr))
(= *debug-territory* terr)))
(when (-> *debug-menu-context* root-menu)
;; (debug-menu-append-item (-> *debug-menu-context* root-menu) (debug-menu-make-load-menu *debug-menu-context*))
(debug-menu-append-item (-> *debug-menu-context* root-menu) (debug-menu-make-part-menu *debug-menu-context*))
(debug-menu-append-item (-> *debug-menu-context* root-menu) (debug-menu-make-entity-menu *debug-menu-context*))
(debug-menu-append-item (-> *debug-menu-context* root-menu) (debug-menu-make-regions-menu *debug-menu-context*))
(debug-menu-append-item (-> *debug-menu-context* root-menu) (debug-menu-make-vag-menu *debug-menu-context*))
(debug-menu-append-item (-> *debug-menu-context* root-menu)
(debug-menu-make-from-template *debug-menu-context*
'(menu "PC Settings"
(flag "Debug" #f ,(dm-lambda-boolean-flag (-> *pc-settings* debug?)))
(flag "Use native vis" #f ,(dm-lambda-boolean-flag (-> *pc-settings* use-vis?)))
(function "Toggle game aspect" #f ,(lambda ()
(cond
((= (-> *setting-control* user-default aspect-ratio) 'aspect4x3)
(set! (-> *setting-control* user-default aspect-ratio) 'aspect16x9)
)
(else
(set! (-> *setting-control* user-default aspect-ratio) 'aspect4x3)
)
)
(set-aspect-ratio (-> *setting-control* user-default aspect-ratio))
))
(flag "Auto aspect" #f ,(dm-lambda-boolean-flag (-> *pc-settings* aspect-ratio-auto?)))
(menu "Aspect test"
(function "4 x 3" #f ,(lambda () (set-aspect! *pc-settings* 4 3)))
(function "16 x 9" #f ,(lambda () (set-aspect! *pc-settings* 16 9)))
(function "64 x 27 (21:9)" #f ,(lambda () (set-aspect! *pc-settings* 64 27)))
(function "16 x 10" #f ,(lambda () (set-aspect! *pc-settings* 16 10)))
(function "2 x 1" #f ,(lambda () (set-aspect! *pc-settings* 2 1)))
(function "37 x 20" #f ,(lambda () (set-aspect! *pc-settings* 37 20)))
(function "21 x 9" #f ,(lambda () (set-aspect! *pc-settings* 21 9)))
(function "64 x 18" #f ,(lambda () (set-aspect! *pc-settings* 64 18)))
(int-var "Custom aspect X" #f ,(dm-lambda-int-var (-> *pc-settings* aspect-custom-x)) 20 1 #t 1 1000)
(int-var "Custom aspect Y" #f ,(dm-lambda-int-var (-> *pc-settings* aspect-custom-y)) 20 1 #t 1 1000)
(function "Custom" #f ,(lambda () (set-aspect! *pc-settings* (-> *pc-settings* aspect-custom-x) (-> *pc-settings* aspect-custom-y))))
)
(menu "Fullscreen"
(function "Windowed" #f ,(lambda () (set-display-mode! *pc-settings* 'windowed #t)))
(function "Fullscreen" #f ,(lambda () (set-display-mode! *pc-settings* 'fullscreen #t)))
(function "Borderless" #f ,(lambda () (set-display-mode! *pc-settings* 'borderless #t)))
)
(menu "Sizes"
(function "640 x 480" #f ,(lambda () (set-size! *pc-settings* 640 480 #t)))
(function "640 x 360" #f ,(lambda () (set-size! *pc-settings* 640 360 #t)))
(function "720 x 540" #f ,(lambda () (set-size! *pc-settings* 720 540 #t)))
(function "960 x 540" #f ,(lambda () (set-size! *pc-settings* 960 540 #t)))
(function "800 x 600" #f ,(lambda () (set-size! *pc-settings* 800 600 #t)))
(function "960 x 720" #f ,(lambda () (set-size! *pc-settings* 960 720 #t)))
(function "1280 x 720" #f ,(lambda () (set-size! *pc-settings* 1280 720 #t)))
(function "1024 x 768" #f ,(lambda () (set-size! *pc-settings* 1024 768 #t)))
(function "1366 x 768" #f ,(lambda () (set-size! *pc-settings* 1366 768 #t)))
(function "1280 x 960" #f ,(lambda () (set-size! *pc-settings* 1280 960 #t)))
(function "1440 x 1080" #f ,(lambda () (set-size! *pc-settings* 1440 1080 #t)))
(function "1920 x 1080" #f ,(lambda () (set-size! *pc-settings* 1920 1080 #t)))
(function "1920 x 1440" #f ,(lambda () (set-size! *pc-settings* 1920 1440 #t)))
(function "2560 x 1440" #f ,(lambda () (set-size! *pc-settings* 2560 1440 #t)))
(function "2880 x 2160" #f ,(lambda () (set-size! *pc-settings* 2880 2160 #t)))
(function "3840 x 2160" #f ,(lambda () (set-size! *pc-settings* 3840 2160 #t)))
(function "512 x 416" #f ,(lambda () (set-size! *pc-settings* 512 416 #t)))
(function "512 x 208" #f ,(lambda () (set-size! *pc-settings* 512 208 #t)))
)
(flag "Letterbox" #f ,(dm-lambda-boolean-flag (-> *pc-settings* letterbox?)))
(flag "Hinttitles" #f ,(dm-lambda-boolean-flag (-> *pc-settings* hinttitles?)))
(menu "Subtitle speaker"
(flag "Off" #f dm-subtitle-setting)
(flag "On" #t dm-subtitle-setting)
(flag "Auto" auto dm-subtitle-setting)
)
;; (menu "Text language"
;; (flag "english" 0 dm-text-language)
;; (flag "french" 1 dm-text-language)
;; (flag "german" 2 dm-text-language)
;; (flag "spanish" 3 dm-text-language)
;; (flag "italian" 4 dm-text-language)
;; (flag "japanese" 5 dm-text-language)
;; (flag "uk-english" 6 dm-text-language)
;; (flag "br-portuguese" 13 dm-text-language)
;; (flag "hungarian" 14 dm-text-language)
;; )
(flag "Discord RPC" #t ,(dm-lambda-boolean-flag (-> *pc-settings* discord-rpc?)))
(flag "Speedrunner Mode" #t ,(dm-lambda-boolean-flag (-> *pc-settings* speedrunner-mode?)))
(flag "Jetboard Trick String" #t ,(dm-lambda-boolean-flag (-> *pc-settings* jetboard-trick-text?)))
;; (flag "Speedrunner Mode" #t ,(dm-lambda-boolean-flag (-> *pc-settings* speedrunner-mode?)))
(menu "PS2 settings"
;(flag "PS2 Load speed" #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-read-speed?)))
(flag "PS2 Particles" #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-parts?)))
(flag "PS2 Shadows" #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-shadow?)))
;(flag "PS2 Music" #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-music?)))
;(flag "PS2 Sound effects" #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-se?)))
;(flag "PS2 Hints" #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-hints?)))
(flag "Highres Clouds" #f ,(dm-lambda-boolean-flag (-> *pc-settings* hires-clouds?)))
(flag "Faster airlocks" #f ,(dm-lambda-boolean-flag (-> *pc-settings* fast-airlock?)))
(flag "Faster elevators" #f ,(dm-lambda-boolean-flag (-> *pc-settings* fast-elevator?)))
(flag "Faster progress" #f ,(dm-lambda-boolean-flag (-> *pc-settings* fast-progress?)))
)
(menu "Level of detail"
(flag "PS2 LOD " #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-lod-dist?)))
(flag "Force Envmap" #f ,(dm-lambda-boolean-flag (-> *pc-settings* force-envmap?)))
(int-var "LOD Tfrag" 0 dm-lod-int 0 1 #t 0 2)
(int-var "LOD Tie" 1 dm-lod-int 0 1 #t 0 3)
;(int-var "LOD Ocean" 2 dm-lod-int 0 1 #t 0 3)
(int-var "LOD Actor" 3 dm-lod-int 0 1 #t 0 3)
(function "Best quality" #f ,(lambda () (set! (-> *pc-settings* lod-force-tfrag) 0)
(set! (-> *pc-settings* lod-force-tie) 0)
;(set! (-> *pc-settings* lod-force-ocean) 0)
(set! (-> *pc-settings* lod-force-actor) 0)
))
(function "Worst quality" #f ,(lambda () (set! (-> *pc-settings* lod-force-tfrag) 2)
(set! (-> *pc-settings* lod-force-tie) 3)
;(set! (-> *pc-settings* lod-force-ocean) 2)
(set! (-> *pc-settings* lod-force-actor) 3)
))
)
(menu "Framerate"
(flag "30" 30 dm-frame-rate-pick-func)
(flag "50" 50 dm-frame-rate-pick-func)
(flag "60" 60 dm-frame-rate-pick-func)
(flag "75" 75 dm-frame-rate-pick-func)
(flag "120" 120 dm-frame-rate-pick-func)
(flag "144" 144 dm-frame-rate-pick-func)
(flag "165" 165 dm-frame-rate-pick-func)
(flag "240" 240 dm-frame-rate-pick-func)
(flag "disclaimer" #f ,(dm-lambda-boolean-flag *frame-rate-disclaimer-seen?*))
)
(menu "MSAA"
(flag "Off" 1 dm-msaa-pick-func)
(flag "x2" 2 dm-msaa-pick-func)
(flag "x4" 4 dm-msaa-pick-func)
(flag "x8" 8 dm-msaa-pick-func)
(flag "x16" 16 dm-msaa-pick-func)
)
(menu "LED"
(flag "hp" #f ,(dm-lambda-boolean-flag (-> *pc-settings* controller-led-hp?)))
(flag "status" #f ,(dm-lambda-boolean-flag (-> *pc-settings* controller-led-status?)))
)
(menu "Territory"
(flag "GAME_TERRITORY_SCEA" (the binteger GAME_TERRITORY_SCEA) dm-territory-pick-func)
(flag "GAME_TERRITORY_SCEE" (the binteger GAME_TERRITORY_SCEE) dm-territory-pick-func)
(flag "GAME_TERRITORY_SCEI" (the binteger GAME_TERRITORY_SCEI) dm-territory-pick-func)
(flag "GAME_TERRITORY_SCEK" (the binteger GAME_TERRITORY_SCEK) dm-territory-pick-func)
)
(flag "V-sync" #f ,(dm-lambda-boolean-flag (-> *pc-settings* vsync?)))
(flag "PS2 actor vis" #f ,(dm-lambda-boolean-flag (-> *pc-settings* ps2-actor-vis?)))
(flag "Display actor counts" *display-actor-counts* dm-boolean-toggle-pick-func)
(flag "Display git commit" *display-sha* dm-boolean-toggle-pick-func)
(flag "Music fadein" #f ,(dm-lambda-boolean-flag (-> *pc-settings* music-fadein?)))
(flag "Music fadeout" #f ,(dm-lambda-boolean-flag (-> *pc-settings* music-fadeout?)))
(flag "Track skill" *debug-track-skill* dm-boolean-toggle-pick-func)
(function "Reset" #f ,(lambda () (reset *pc-settings* #t)))
(function "Save" #f ,(lambda () (commit-to-file *pc-settings*)))
(function "Load" #f ,(lambda () (load-settings *pc-settings*)))
)
)
)
(debug-menu-append-item (-> *debug-menu-context* root-menu)
(debug-menu-make-from-template *debug-menu-context*
'(menu "Other"
(flag "DECI Count" *display-deci-count* dm-boolean-toggle-pick-func)
(flag "Actor graph" *display-actor-graph* dm-boolean-toggle-pick-func)
(flag "Update vis outside bsp" *update-leaf-when-outside-bsp* dm-boolean-toggle-pick-func)
;; (flag "Pad display" *display-pad-debug* dm-boolean-toggle-pick-func)
(flag "Heap status" *display-heap-status* dm-boolean-toggle-pick-func)
(flag "Text boxes" *display-text-box* dm-boolean-toggle-pick-func)
(flag "Display actor bank" *display-actor-bank* dm-boolean-toggle-pick-func)
(float-var "Actor birth dist" #f ,(dm-lambda-meters-var (-> *ACTOR-bank* birth-dist)) 20 1 #t 0 10000 1)
(float-var "Actor pause dist" #f ,(dm-lambda-meters-var (-> *ACTOR-bank* pause-dist)) 20 1 #t 0 10000 1)
(flag "Display city info" *display-city-info* dm-boolean-toggle-pick-func)
(int-var "City info x" *city-info-x* dm-int-var-func 10 1 #t 0 255 1)
(int-var "City info y" *city-info-y* dm-int-var-func 10 1 #t 0 255 1)
(int-var "City info z" *city-info-z* dm-int-var-func 10 1 #t 0 255 1)
(flag "Joint names" *display-joint-names* dm-boolean-toggle-pick-func)
(flag "Bone lines" *display-bones* dm-boolean-toggle-pick-func)
(flag "Entity Lights" *display-lights* dm-boolean-toggle-pick-func)
(flag "Debug Font Auto-Scale" #f ,(dm-lambda-boolean-flag (-> *pc-settings* debug-font-scale-auto?)))
(float-var "Debug Font Scale" #f ,(dm-lambda-float-var (-> *pc-settings* debug-font-scale)) 2 (new 'static 'bfloat :data 0.01) #t (new 'static 'bfloat :data 0.1) 2 0)
)
)
)
(debug-menu-append-item (debug-menu-find-from-template *debug-menu-context* '("Collision"))
(debug-menu-make-collision-renderer-menu *debug-menu-context*))
(debug-menu-append-item (debug-menu-find-from-template *debug-menu-context* '("Artist"))
(debug-menu-make-anim-tester-x-menu *debug-menu-context*))
)
;; (defun bg-custom ((level-name symbol))
;; "Modified version of bg for the PC Port custom levels."
;;
;; ;; lookup info
;; (format 0 "(bg-custom ~A)%" level-name)
;; (let ((lev-info (lookup-level-info level-name)))
;; (when (= lev-info default-level)
;; (format 0 "Unable to (bg-custom ~A), the level was not found in *level-load-list*~%" level-name)
;; (return #f)
;; )
;;
;; ;; kill jak (rip)
;; (format 0 "doing stop~%")
;; (stop 'play)
;;
;; ;; kill levels
;; (dotimes (i 2)
;; (unload! (-> *level* data i))
;; )
;;
;; ;; enable visiblity. the custom level won't use it, but we want it on so other levels can be loaded.
;; (set! (-> *level* vis?) #t)
;;
;; ;; disable border and play mode to prevent loading levels
;; (set! (-> *level* border?) #f)
;; (set! (-> *setting-control* default border-mode) #f)
;; (set! (-> *level* play?) #f)
;;
;; ;; disable actor vis
;; (set! *vis-actors* #f)
;;
;; (format 0 "doing level load~%")
;; ;; allocate level. This may start the loading process, but won't finish it.
;; (let ((lev (level-get-for-use *level* level-name 'active)))
;; (when (not lev)
;; (format 0 "Unable to load level, could not level-get-for-use~%")
;; (return #f)
;; )
;; (format 0 "about to start load loop, game will freeze and hopefully come back soon~%")
;;
;; ;; spin in a loop and load it. This will cause the game to freeze during the load,
;; ;; but this is good enough for now.
;; (while (or (= (-> lev status) 'loading)
;; (= (-> lev status) 'loading-bt)
;; (= (-> lev status) 'login)
;; )
;; (load-continue lev)
;; )
;;
;; (when (not (-> lev info continues))
;; (format 0 "level info has no continues, can't load it.~%")
;; )
;;
;; (let ((cont (car (-> lev info continues))))
;; (start 'play (the continue-point cont))
;; )
;;
;; (vis-load lev)
;; (set! (-> lev all-visible?) #f)
;; (set! (-> lev force-all-visible?) #t)
;;
;; ;; reset things
;; ;(initialize! *game-info* 'game (the-as game-save #f) (the-as string #f))
;; )
;; )
;; )