;;-*-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 *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 *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 (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 *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 *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! (-> *pc-settings* territory) terr)) (= (-> *pc-settings* territory) terr))) (defun dm-size-pick-func ((size pair)) (set-window-size! *pc-settings* (/ (the int (car size)) 8) (/ (the int (cadr size)) 8))) (defun dm-screen-shot-preset-pick-func ((args pair) (msg debug-menu-msg)) (let ((w (/ (the int (car args)) 8)) (h (/ (the int (cadr args)) 8)) (m (/ (the int (caddr args)) 8)) ) (when (= msg (debug-menu-msg press)) (set! (-> *screen-shot-settings* width) w) (set! (-> *screen-shot-settings* height) h) (set! (-> *screen-shot-settings* msaa) m) ) (and (= (-> *screen-shot-settings* width) w) (= (-> *screen-shot-settings* height) h) (= (-> *screen-shot-settings* msaa) m)))) (define *screen-shot-capture-profile* #f) (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 () (pc-set-display-mode! 'windowed))) (function "Fullscreen" #f ,(lambda () (pc-set-display-mode! 'fullscreen))) (function "Borderless" #f ,(lambda () (pc-set-display-mode! 'borderless))) ) (menu "Sizes" (function "640 x 480" (640 480) dm-size-pick-func) (function "640 x 360" (640 360) dm-size-pick-func) (function "720 x 540" (720 540) dm-size-pick-func) (function "960 x 540" (960 540) dm-size-pick-func) (function "800 x 600" (800 600) dm-size-pick-func) (function "960 x 720" (960 720) dm-size-pick-func) (function "1280 x 720" (1280 720) dm-size-pick-func) (function "1024 x 768" (1024 768) dm-size-pick-func) (function "1366 x 768" (1366 768) dm-size-pick-func) (function "1280 x 960" (1280 960) dm-size-pick-func) (function "1440 x 1080" (1440 1080) dm-size-pick-func) (function "1920 x 1080" (1920 1080) dm-size-pick-func) (function "1920 x 1440" (1920 1440) dm-size-pick-func) (function "2560 x 1440" (2560 1440) dm-size-pick-func) (function "2880 x 2160" (2880 2160) dm-size-pick-func) (function "3840 x 2160" (3840 2160) dm-size-pick-func) (function "512 x 416" (512 416) dm-size-pick-func) (function "512 x 208" (512 208) dm-size-pick-func) ) (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" ;; TODO macro (flag "english" (the binteger (pc-language english)) dm-text-language) (flag "french" (the binteger (pc-language french)) dm-text-language) (flag "german" (the binteger (pc-language german)) dm-text-language) (flag "spanish" (the binteger (pc-language spanish)) dm-text-language) (flag "italian" (the binteger (pc-language italian)) dm-text-language) (flag "japanese" (the binteger (pc-language japanese)) dm-text-language) (flag "korean" (the binteger (pc-language korean)) dm-text-language) (flag "uk-english" (the binteger (pc-language uk-english)) 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 "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 "90" 90 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 "Automatic" -1 dm-territory-pick-func) (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) ) (menu "Minimap" (flag "Non-PS2 coordinates" #f ,(dm-lambda-boolean-flag (-> *pc-settings* smooth-minimap?))) (flag "Always face north" #f ,(dm-lambda-boolean-flag (-> *pc-settings* minimap-force-north))) ) (menu "Screen shot" (flag "Hud enable" #f ,(dm-lambda-boolean-flag (-> *screen-shot-work* hud-enable))) (flag "Capture profile" *screen-shot-capture-profile* dm-boolean-toggle-pick-func) (menu "Presets" (flag "1080p (default)" (1920 1080 16) dm-screen-shot-preset-pick-func) (flag "2K" (2160 1440 16) dm-screen-shot-preset-pick-func) (flag "4K" (3840 2160 16) dm-screen-shot-preset-pick-func) (flag "Maximum (anamorphic 16K)" (16384 16384 16) dm-screen-shot-preset-pick-func) ) (function "Capture now" #f ,(lambda () (screen-shot) (if *screen-shot-capture-profile* (set! *display-profile* #t)))) ) (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)) ;; ) ;; ) ;; )