mirror of
https://github.com/open-goal/jak-project
synced 2026-07-09 23:01:56 -04:00
jak2: add back some pc port debugging tools and add palace-scenes to gsrc (#2240)
Ports some of the custom PC port debugging code from Jak 1, such as the entity debugger, Anim Tester X and part tester, to Jak 2 and gives the PC menu code the same treatment Jak 1 received recently in #2216. Some adjustments have been made to make things work in Jak 2 and some stuff is still incomplete. The majority of the default PC menu code has been left commented out in preparation for @ManDude's plan to port the rest of the Jak 1 `pckernel` features to Jak 2. Also adds the code for `palace-scenes` to gsrc as that seems to have been missed.
This commit is contained in:
Hat Kid
@@ -371,4 +371,7 @@
|
||||
"nav-graph-editor.o"
|
||||
"sampler.o"
|
||||
"default-menu.o"
|
||||
"anim-tester-x.o" ;; added
|
||||
"entity-debug.o" ;; added
|
||||
"default-menu-pc.o" ;; added
|
||||
))
|
||||
|
||||
@@ -232,7 +232,6 @@
|
||||
"game-task.o"
|
||||
"game-save.o"
|
||||
"settings.o"
|
||||
"pckernel.o" ;; added
|
||||
"mood-tables.o"
|
||||
"mood-tables2.o"
|
||||
"mood.o"
|
||||
@@ -372,6 +371,9 @@
|
||||
"nav-graph-editor.o"
|
||||
"sampler.o"
|
||||
"default-menu.o"
|
||||
"anim-tester-x.o" ;; added
|
||||
"entity-debug.o" ;; added
|
||||
"default-menu-pc.o" ;; added
|
||||
"dir-tpages.go"
|
||||
"tpage-11.go"
|
||||
"tpage-31.go"
|
||||
|
||||
@@ -5947,18 +5947,6 @@
|
||||
)
|
||||
(debug-menu-append-item s5-0 (debug-menu-make-task-menu arg0))
|
||||
(debug-menu-append-item s5-0 (debug-menu-make-play-menu arg0))
|
||||
(debug-menu-append-item
|
||||
s5-0
|
||||
(debug-menu-make-from-template
|
||||
arg0
|
||||
'(menu
|
||||
"PC Settings"
|
||||
(flag "Discord RPC" #t ,(dm-lambda-boolean-flag (-> *pc-settings* discord-rpc?)))
|
||||
(flag "Jetboard Trick String" #t ,(dm-lambda-boolean-flag (-> *pc-settings* jetboard-trick-text?)))
|
||||
(function "Save" #f ,(lambda () (commit-to-file *pc-settings*)))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
arg0
|
||||
)
|
||||
|
||||
@@ -5,6 +5,10 @@
|
||||
;; name in dgo: part-tester
|
||||
;; dgos: ENGINE, GAME
|
||||
|
||||
(#when PC_PORT
|
||||
(define *part-tester-id* 127)
|
||||
)
|
||||
|
||||
(define-extern *part-tester* (pointer process))
|
||||
|
||||
;; DECOMP BEGINS
|
||||
@@ -64,8 +68,12 @@
|
||||
(-> self root trans)
|
||||
(new 'static 'rgba :r #xff :g #xff :b #xff :a #x80)
|
||||
)
|
||||
;(let ((gp-1 (-> *part-group-id-table* 127)))
|
||||
(let ((gp-1 (-> *part-group-id-table* 96)))
|
||||
(let ((gp-1 (-> *part-group-id-table* 127)))
|
||||
(#when PC_PORT
|
||||
(if (nonzero? (-> *part-group-id-table* *part-tester-id*))
|
||||
(set! gp-1 (-> *part-group-id-table* *part-tester-id*))
|
||||
)
|
||||
)
|
||||
(let ((s5-1 (-> self root trans)))
|
||||
(when (!= gp-1 (-> self old-group))
|
||||
(when (nonzero? (-> self part))
|
||||
|
||||
@@ -1276,6 +1276,48 @@
|
||||
;; - display-frame-start
|
||||
;; )
|
||||
|
||||
(defconstant MEM_BAR_WIDTH 152)
|
||||
(defconstant MEM_BAR_HEIGHT 15)
|
||||
(defconstant MEM_BAR_NUM 11)
|
||||
(defconstant MEM_BAR_BG_COL (static-rgba 64 64 64 64))
|
||||
(defconstant MEM_BAR_X (- 475 MEM_BAR_WIDTH))
|
||||
(defconstant MEM_BAR_Y (- 424 4 (* MEM_BAR_HEIGHT MEM_BAR_NUM)))
|
||||
(defmacro draw-memory-bar-generic (buf &key remain &key total &key name &key idx &key color)
|
||||
`(let* (
|
||||
(total (the float ,total))
|
||||
(remain (the float ,remain))
|
||||
(used-p (/ (- total remain) total))
|
||||
(used-x (the int (* used-p MEM_BAR_WIDTH)))
|
||||
(used-y (+ MEM_BAR_Y (* ,idx MEM_BAR_HEIGHT)))
|
||||
)
|
||||
(draw-sprite2d-xy ,buf MEM_BAR_X used-y used-x MEM_BAR_HEIGHT ,color)
|
||||
(draw-sprite2d-xy ,buf (+ MEM_BAR_X used-x) used-y (- MEM_BAR_WIDTH used-x) MEM_BAR_HEIGHT MEM_BAR_BG_COL)
|
||||
(draw-string-xy ,name ,buf MEM_BAR_X used-y (font-color precursor-#ec3b00) (font-flags shadow kerning right))
|
||||
(draw-string-xy (string-format "~,,2f%" (* used-p 100)) ,buf (+ MEM_BAR_X used-x) used-y (font-color precursor-#ec3b00) (font-flags shadow kerning middle))
|
||||
(draw-string-xy (string-format "~,,1fM" (/ total (* 1024 1024))) ,buf (+ MEM_BAR_X MEM_BAR_WIDTH) used-y (font-color precursor-#ec3b00) (font-flags shadow kerning left))
|
||||
)
|
||||
)
|
||||
(defmacro draw-memory-bar-kheap (buf heap &key (name #f) &key idx &key color)
|
||||
`(let ((heap ,heap))
|
||||
(draw-memory-bar-generic ,buf
|
||||
:remain (&- (-> heap top) (-> heap current))
|
||||
:total (&- (-> heap top) (-> heap base))
|
||||
:name ,(if name name (symbol->string heap))
|
||||
:idx ,idx
|
||||
:color ,color)
|
||||
)
|
||||
)
|
||||
(defmacro draw-memory-bar-dead-pool-heap (buf heap &key (name #f) &key idx &key color)
|
||||
`(let* ((heap ,heap) (pool-total (memory-total heap)))
|
||||
(draw-memory-bar-generic ,buf
|
||||
:remain (- pool-total (memory-used heap))
|
||||
:total pool-total
|
||||
:name ,(if name name (symbol->string heap))
|
||||
:idx ,idx
|
||||
:color ,color)
|
||||
)
|
||||
)
|
||||
|
||||
(defun end-display ((arg0 display))
|
||||
"Update debug drawing:
|
||||
- debug draws (triangles, spheres, etc)
|
||||
@@ -1301,6 +1343,15 @@
|
||||
;; debug draw, profile bars, deci count, file info
|
||||
(when *debug-segment*
|
||||
;; do all debug drawing.
|
||||
(#when PC_PORT
|
||||
;; (if (-> *pc-settings* debug-pad-display)
|
||||
;; (debug-pad-display (-> *cpad-list* cpads 0))
|
||||
;; )
|
||||
(when (and (or (= *master-mode* 'game) (= *master-mode* 'pause)) (-> *entity-debug-inspect* entity))
|
||||
(define-extern entity-inspect-draw (function entity-debug-inspect object))
|
||||
(entity-inspect-draw *entity-debug-inspect*)
|
||||
)
|
||||
)
|
||||
(debug-draw-buffers)
|
||||
(with-dma-buffer-add-bucket ((s3-0 (-> arg0 frames (-> arg0 on-screen) debug-buf)) (bucket-id debug-no-zbuf2))
|
||||
(when (or *display-profile* *stats-profile-bars*)
|
||||
@@ -1320,6 +1371,42 @@
|
||||
(s2-0 *temp-string* s3-0 448 210 (font-color default-#cddbcd) (font-flags shadow))
|
||||
)
|
||||
)
|
||||
|
||||
(#when PC_PORT
|
||||
(when (-> *pc-settings* display-heap-status)
|
||||
(let ((idx 0))
|
||||
(draw-memory-bar-kheap s3-0 global :idx idx :color (static-rgba 32 32 255 64))
|
||||
(draw-memory-bar-kheap s3-0 debug :idx (+! idx 1) :color (static-rgba 255 32 32 64))
|
||||
(if (!= (-> *level* level 0 status) 'inactive)
|
||||
(draw-memory-bar-kheap s3-0 (-> *level* level 0 heap) :name "l0" :idx (+! idx 1) :color (static-rgba 32 255 255 64))
|
||||
)
|
||||
(if (!= (-> *level* level 1 status) 'inactive)
|
||||
(draw-memory-bar-kheap s3-0 (-> *level* level 1 heap) :name "l1" :idx (+! idx 1) :color (static-rgba 255 32 255 64))
|
||||
)
|
||||
(if (!= (-> *level* level 2 status) 'inactive)
|
||||
(draw-memory-bar-kheap s3-0 (-> *level* level 2 heap) :name "l2" :idx (+! idx 1) :color (static-rgba 255 255 32 64))
|
||||
)
|
||||
(if (!= (-> *level* level 3 status) 'inactive)
|
||||
(draw-memory-bar-kheap s3-0 (-> *level* level 3 heap) :name "l3" :idx (+! idx 1) :color (static-rgba 32 255 255 64))
|
||||
)
|
||||
(if (!= (-> *level* level 4 status) 'inactive)
|
||||
(draw-memory-bar-kheap s3-0 (-> *level* level 4 heap) :name "l4" :idx (+! idx 1) :color (static-rgba 255 32 255 64))
|
||||
)
|
||||
(if (!= (-> *level* level 5 status) 'inactive)
|
||||
(draw-memory-bar-kheap s3-0 (-> *level* level 5 heap) :name "l5" :idx (+! idx 1) :color (static-rgba 255 255 32 64))
|
||||
)
|
||||
(draw-memory-bar-dead-pool-heap s3-0 *nk-dead-pool* :name "actor" :idx (+! idx 1) :color (static-rgba 32 255 32 64))
|
||||
(draw-memory-bar-generic s3-0
|
||||
:remain (* 16 (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
|
||||
:total (length (-> *display* frames (-> *display* on-screen) global-buf))
|
||||
:name "dma-global" :idx (+! idx 1) :color (static-rgba 32 32 255 64))
|
||||
(draw-memory-bar-generic s3-0
|
||||
:remain (* 16 (dma-buffer-free (-> *display* frames (-> *display* on-screen) debug-buf)))
|
||||
:total (length (-> *display* frames (-> *display* on-screen) debug-buf))
|
||||
:name "dma-debug" :idx (+! idx 1) :color (static-rgba 255 32 32 64))
|
||||
)
|
||||
)
|
||||
)
|
||||
(display-file-info)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -7,6 +7,11 @@
|
||||
|
||||
(declare-type fuel-cell basic) ;; TODO!!
|
||||
|
||||
(#when PC_PORT
|
||||
|
||||
(define *display-bones* #f)
|
||||
(define *display-joint-names* #f)
|
||||
|
||||
(defun-debug draw-bone-lines ((obj process-drawable))
|
||||
"Added in PC port to debug bones"
|
||||
(dotimes (i (-> obj node-list length))
|
||||
@@ -19,7 +24,7 @@
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
))
|
||||
|
||||
;; DECOMP BEGINS
|
||||
|
||||
@@ -452,7 +457,12 @@
|
||||
)
|
||||
)
|
||||
)
|
||||
; (draw-bone-lines (-> obj process))
|
||||
(#when PC_PORT (when *debug-segment*
|
||||
(if *display-bones*
|
||||
(draw-bone-lines (the-as process-drawable (-> obj process))))
|
||||
;; (if *display-joint-names*
|
||||
;; (draw-joint-spheres obj))
|
||||
))
|
||||
0
|
||||
(none)
|
||||
)
|
||||
|
||||
@@ -7,3 +7,724 @@
|
||||
|
||||
;; DECOMP BEGINS
|
||||
|
||||
(deftype throne-throne (process-drawable)
|
||||
()
|
||||
:heap-base #x50
|
||||
:method-count-assert 21
|
||||
:size-assert #xc8
|
||||
:flag-assert #x15005000c8
|
||||
(:methods
|
||||
(idle () _type_ :state 20)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(defskelgroup skel-throne-throne throne-throne throne-throne-lod0-jg throne-throne-idle-ja
|
||||
((throne-throne-lod0-mg (meters 999999)))
|
||||
:bounds (static-spherem 0 0 0 20)
|
||||
)
|
||||
|
||||
(defstate idle (throne-throne)
|
||||
:virtual #t
|
||||
:code (behavior ()
|
||||
(until #f
|
||||
(ja-no-eval :group! (ja-group)
|
||||
:num! (seek! (the float (+ (-> (ja-group) frames num-frames) -1)))
|
||||
:frame-num 0.0
|
||||
)
|
||||
(until (ja-done? 0)
|
||||
(suspend)
|
||||
(ja :num! (seek!))
|
||||
)
|
||||
)
|
||||
#f
|
||||
(none)
|
||||
)
|
||||
:post (the-as (function none :behavior throne-throne) ja-post)
|
||||
)
|
||||
|
||||
;; WARN: Return type mismatch object vs none.
|
||||
(defmethod init-from-entity! throne-throne ((obj throne-throne) (entity entity-actor))
|
||||
"Typically the method that does the initial setup on the process, potentially using the [[entity-actor]] provided as part of that.
|
||||
This commonly includes things such as:
|
||||
- stack size
|
||||
- collision information
|
||||
- loading the skeleton group / bones
|
||||
- sounds"
|
||||
(let ((cshape (new 'process 'collide-shape obj (collide-list-enum hit-by-player))))
|
||||
(let ((prim-group (new 'process 'collide-shape-prim-group cshape (the-as uint 1) 0)))
|
||||
(set! (-> cshape total-prims) (the-as uint 2))
|
||||
(set! (-> prim-group prim-core collide-as) (collide-spec obstacle))
|
||||
(set! (-> prim-group prim-core collide-with) (collide-spec jak player-list))
|
||||
(set! (-> prim-group prim-core action) (collide-action solid))
|
||||
(set-vector! (-> prim-group local-sphere) 0.0 0.0 0.0 81920.0)
|
||||
(set! (-> cshape root-prim) prim-group)
|
||||
)
|
||||
(let ((prim-mesh (new 'process 'collide-shape-prim-mesh cshape (the-as uint 0) (the-as uint 0))))
|
||||
(set! (-> prim-mesh prim-core collide-as) (collide-spec obstacle))
|
||||
(set! (-> prim-mesh prim-core collide-with) (collide-spec jak player-list))
|
||||
(set! (-> prim-mesh prim-core action) (collide-action solid))
|
||||
(set! (-> prim-mesh transform-index) 3)
|
||||
(set-vector! (-> prim-mesh local-sphere) 0.0 0.0 0.0 81920.0)
|
||||
)
|
||||
(set! (-> cshape nav-radius) (* 0.75 (-> cshape root-prim local-sphere w)))
|
||||
(let ((root-prim (-> cshape root-prim)))
|
||||
(set! (-> cshape backup-collide-as) (-> root-prim prim-core collide-as))
|
||||
(set! (-> cshape backup-collide-with) (-> root-prim prim-core collide-with))
|
||||
)
|
||||
(set! (-> obj root) cshape)
|
||||
)
|
||||
(process-drawable-from-entity! obj entity)
|
||||
(initialize-skeleton
|
||||
obj
|
||||
(the-as skeleton-group (art-group-get-by-name *level* "skel-throne-throne" (the-as (pointer uint32) #f)))
|
||||
(the-as pair 0)
|
||||
)
|
||||
(go (method-of-object obj idle))
|
||||
(none)
|
||||
)
|
||||
|
||||
(defpartgroup group-palroof-snot
|
||||
:id 1139
|
||||
:duration (seconds 0.035)
|
||||
:flags (use-local-clock)
|
||||
:bounds (static-bspherem 0 0 0 2)
|
||||
:parts ((sp-item 4926 :flags (bit7)) (sp-item 4927 :flags (bit7)) (sp-item 4928 :flags (bit7)))
|
||||
)
|
||||
|
||||
(defpart 4927
|
||||
:init-specs ((sp-tex spt-texture (new 'static 'texture-id :index #x21 :page #xc))
|
||||
(sp-flt spt-num 10.0)
|
||||
(sp-flt spt-z (meters -0.06))
|
||||
(sp-rnd-flt spt-scale-x (meters 0.1) (meters 0.05) 1.0)
|
||||
(sp-rnd-flt spt-scale-y (meters 0.1) (meters 0.05) 1.0)
|
||||
(sp-rnd-flt spt-r 64.0 128.0 1.0)
|
||||
(sp-rnd-flt spt-g 128.0 64.0 1.0)
|
||||
(sp-rnd-flt spt-b 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-a 8.0 8.0 1.0)
|
||||
(sp-flt spt-omega 0.4096)
|
||||
(sp-flt spt-vel-z (meters -0.05))
|
||||
(sp-int spt-timer 1200)
|
||||
(sp-cpuinfo-flags sp-cpuinfo-flag-2 sp-cpuinfo-flag-3 sp-cpuinfo-flag-12 use-global-acc)
|
||||
(sp-int spt-next-time 10)
|
||||
(sp-launcher-by-id spt-next-launcher 4929)
|
||||
(sp-rnd-flt spt-launchrot-x (degrees -60.0) (degrees 120.0) 1.0)
|
||||
(sp-rnd-flt spt-launchrot-z (degrees 0.0) (degrees 3600.0) 1.0)
|
||||
(sp-flt spt-rotate-y (degrees 0.0))
|
||||
)
|
||||
)
|
||||
|
||||
(defpart 4928
|
||||
:init-specs ((sp-flt spt-num 20.0)
|
||||
(sp-flt spt-z (meters -0.06))
|
||||
(sp-int spt-rot-x 6)
|
||||
(sp-flt spt-r 614.4)
|
||||
(sp-flt spt-g 471.04)
|
||||
(sp-flt spt-b 491.52)
|
||||
(sp-flt spt-vel-z (meters -0.05))
|
||||
(sp-int spt-timer 1200)
|
||||
(sp-cpuinfo-flags distort)
|
||||
(sp-int spt-next-time 10)
|
||||
(sp-launcher-by-id spt-next-launcher 4930)
|
||||
(sp-rnd-flt spt-launchrot-x (degrees -30.0) (degrees 60.0) 1.0)
|
||||
(sp-rnd-flt spt-launchrot-z (degrees 0.0) (degrees 3600.0) 1.0)
|
||||
(sp-flt spt-rotate-y (degrees 0.0))
|
||||
)
|
||||
)
|
||||
|
||||
(defpart 4930
|
||||
:init-specs ((sp-flt spt-vel-x (meters 0)) (sp-flt spt-vel-y (meters 0)) (sp-flt spt-vel-z (meters 0)))
|
||||
)
|
||||
|
||||
(defpart 4926
|
||||
:init-specs ((sp-tex spt-texture (new 'static 'texture-id :index #x21 :page #xc))
|
||||
(sp-flt spt-num 64.0)
|
||||
(sp-flt spt-z (meters -0.06))
|
||||
(sp-rnd-flt spt-scale-x (meters 0.01) (meters 0.03) 1.0)
|
||||
(sp-rnd-flt spt-scale-y (meters 0.01) (meters 0.03) 1.0)
|
||||
(sp-rnd-flt spt-r 64.0 128.0 1.0)
|
||||
(sp-rnd-flt spt-g 128.0 64.0 1.0)
|
||||
(sp-rnd-flt spt-b 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-a 8.0 8.0 1.0)
|
||||
(sp-flt spt-omega 0.4096)
|
||||
(sp-flt spt-vel-z (meters -0.05))
|
||||
(sp-int spt-timer 1200)
|
||||
(sp-cpuinfo-flags sp-cpuinfo-flag-2 sp-cpuinfo-flag-3 sp-cpuinfo-flag-12 use-global-acc)
|
||||
(sp-int spt-next-time 10)
|
||||
(sp-launcher-by-id spt-next-launcher 4929)
|
||||
(sp-rnd-flt spt-launchrot-x (degrees -60.0) (degrees 120.0) 1.0)
|
||||
(sp-rnd-flt spt-launchrot-z (degrees 0.0) (degrees 3600.0) 1.0)
|
||||
(sp-flt spt-rotate-y (degrees 0.0))
|
||||
)
|
||||
)
|
||||
|
||||
(defpart 4929
|
||||
:init-specs ((sp-flt spt-vel-x (meters 0))
|
||||
(sp-flt spt-vel-y (meters 0))
|
||||
(sp-flt spt-vel-z (meters 0))
|
||||
(sp-rnd-flt spt-scalevel-x (meters 0.0033333334) (meters 0.006666667) 1.0)
|
||||
(sp-copy-from-other spt-scalevel-y -4)
|
||||
(sp-int spt-next-time 5)
|
||||
(sp-launcher-by-id spt-next-launcher 4931)
|
||||
)
|
||||
)
|
||||
|
||||
(defpart 4931
|
||||
:init-specs ((sp-flt spt-scalevel-x (meters 0)) (sp-copy-from-other spt-scalevel-y -4))
|
||||
)
|
||||
|
||||
(defpartgroup group-palroof-rain0
|
||||
:id 1140
|
||||
:duration (seconds 0.017)
|
||||
:linger-duration (seconds 1.5)
|
||||
:bounds (static-bspherem 0 0 0 128)
|
||||
:parts ((sp-item 4932) (sp-item 4933))
|
||||
)
|
||||
|
||||
(defpart 4932
|
||||
:init-specs ((sp-tex spt-texture (new 'static 'texture-id :index #x21 :page #xc))
|
||||
(sp-func spt-birth-func 'birth-func-rain)
|
||||
(sp-flt spt-num 1.0)
|
||||
(sp-rnd-flt spt-x (meters -30) (meters 45) 1.0)
|
||||
(sp-flt spt-y (meters 16))
|
||||
(sp-rnd-flt spt-scale-x (meters 0.03) (meters 0.03) 1.0)
|
||||
(sp-rnd-flt spt-scale-y (meters 0.5) (meters 0.5) 1.0)
|
||||
(sp-rnd-flt spt-r 32.0 32.0 1.0)
|
||||
(sp-copy-from-other spt-g -1)
|
||||
(sp-rnd-flt spt-b 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-a 32.0 64.0 1.0)
|
||||
(sp-rnd-flt spt-vel-y (meters -0.06666667) (meters -0.13333334) 1.0)
|
||||
(sp-int spt-timer 300)
|
||||
(sp-cpuinfo-flags sp-cpuinfo-flag-2 sp-cpuinfo-flag-3 sp-cpuinfo-flag-14)
|
||||
(sp-flt spt-userdata 0.0)
|
||||
(sp-func spt-func 'check-drop-level-palace-roof-rain)
|
||||
(sp-rnd-flt spt-rotate-y (degrees 0.0) (degrees 3600.0) 1.0)
|
||||
)
|
||||
)
|
||||
|
||||
(defpart 4934
|
||||
:init-specs ((sp-tex spt-texture (new 'static 'texture-id :index #x21 :page #xc))
|
||||
(sp-rnd-flt spt-num 1.0 1.0 1.0)
|
||||
(sp-rnd-flt spt-scale-x (meters 0.08) (meters 0.03) 1.0)
|
||||
(sp-int spt-rot-x 4)
|
||||
(sp-copy-from-other spt-scale-y -4)
|
||||
(sp-rnd-flt spt-r 32.0 32.0 1.0)
|
||||
(sp-copy-from-other spt-g -1)
|
||||
(sp-rnd-flt spt-b 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-a 32.0 64.0 1.0)
|
||||
(sp-rnd-flt spt-omega 1.6384 0.8192 1.0)
|
||||
(sp-rnd-flt spt-vel-y (meters 0.033333335) (meters 0.06666667) 1.0)
|
||||
(sp-rnd-flt spt-fade-a -1.2 -1.2 1.0)
|
||||
(sp-rnd-flt spt-accel-y -20.48 -2.7306666 1.0)
|
||||
(sp-flt spt-friction 0.98)
|
||||
(sp-int spt-timer 600)
|
||||
(sp-cpuinfo-flags sp-cpuinfo-flag-2 sp-cpuinfo-flag-3 sp-cpuinfo-flag-14 use-global-acc)
|
||||
(sp-func spt-func 'sparticle-motion-blur)
|
||||
(sp-int-plain-rnd spt-next-time 0 99 1)
|
||||
(sp-launcher-by-id spt-next-launcher 63)
|
||||
(sp-rnd-flt spt-conerot-x (degrees 0.0) (degrees 30.0) 1.0)
|
||||
(sp-rnd-flt spt-conerot-y (degrees 0.0) (degrees 3600.0) 1.0)
|
||||
(sp-flt spt-rotate-x (degrees 0.0))
|
||||
(sp-flt spt-rotate-y (degrees 0.0))
|
||||
)
|
||||
)
|
||||
|
||||
(defun check-drop-level-palace-roof-rain ((arg0 sparticle-system) (arg1 sparticle-cpuinfo) (arg2 matrix))
|
||||
"Ensure the rain on the palace roof doesn't go through the roof and displays the splash effect when it makes impact"
|
||||
(when (< (-> arg2 vector 0 y) (+ 4096.0 (-> arg1 user-float)))
|
||||
(let ((s4-0 (new 'stack-no-clear 'vector))
|
||||
(s5-0 (new 'stack-no-clear 'matrix))
|
||||
)
|
||||
(sp-kill-particle arg0 arg1)
|
||||
(set-vector! s4-0 (-> arg2 vector 0 x) (-> arg1 user-float) (-> arg2 vector 0 z) 1.0)
|
||||
(-> arg1 omega)
|
||||
(set-vector!
|
||||
(-> s5-0 vector 1)
|
||||
(* 0.007874016 (the float (-> arg1 datab 0)))
|
||||
(* 0.007874016 (the float (-> arg1 datab 1)))
|
||||
(* 0.007874016 (the float (-> arg1 datab 2)))
|
||||
0.0
|
||||
)
|
||||
(set-vector! (-> s5-0 vector 2) 0.0 0.0 1.0 0.0)
|
||||
(vector-cross! (the-as vector (-> s5-0 vector)) (-> s5-0 vector 1) (-> s5-0 vector 2))
|
||||
(set! (-> s5-0 trans quad) (-> s4-0 quad))
|
||||
(set! (-> *part-id-table* 4934 init-specs 22 initial-valuef) (vector-y-angle (-> s5-0 vector 1)))
|
||||
(set! (-> *part-id-table* 4934 init-specs 21 initial-valuef) (- 16384.0 (vector-x-angle (-> s5-0 vector 1))))
|
||||
(sp-launch-particles-var
|
||||
*sp-particle-system-2d*
|
||||
(-> *part-id-table* 4934)
|
||||
s5-0
|
||||
(the-as sparticle-launch-state #f)
|
||||
(the-as sparticle-launch-control #f)
|
||||
1.0
|
||||
)
|
||||
(set! (-> *part-id-table* 64 init-specs 10 initial-valuef) (-> arg1 omega))
|
||||
(sp-launch-particles-var
|
||||
*sp-particle-system-3d*
|
||||
(-> *part-id-table* 64)
|
||||
s5-0
|
||||
(the-as sparticle-launch-state #f)
|
||||
(the-as sparticle-launch-control #f)
|
||||
1.0
|
||||
)
|
||||
)
|
||||
)
|
||||
(none)
|
||||
)
|
||||
|
||||
(defpartgroup group-palroof-rain1
|
||||
:id 1141
|
||||
:duration (seconds 0.017)
|
||||
:linger-duration (seconds 1.5)
|
||||
:bounds (static-bspherem 0 0 0 128)
|
||||
:parts ((sp-item 4935) (sp-item 4936))
|
||||
)
|
||||
|
||||
(defpart 4935
|
||||
:init-specs ((sp-tex spt-texture (new 'static 'texture-id :index #x21 :page #xc))
|
||||
(sp-flt spt-num 2.0)
|
||||
(sp-rnd-flt spt-x (meters 0) (meters 30) 1.0)
|
||||
(sp-flt spt-y (meters 32))
|
||||
(sp-rnd-flt spt-z (meters -8) (meters 12) 1.0)
|
||||
(sp-rnd-flt spt-scale-x (meters 0.03) (meters 0.03) 1.0)
|
||||
(sp-rnd-flt spt-scale-y (meters 0.5) (meters 0.5) 1.0)
|
||||
(sp-rnd-flt spt-r 32.0 32.0 1.0)
|
||||
(sp-copy-from-other spt-g -1)
|
||||
(sp-rnd-flt spt-b 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-a 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-vel-y (meters -0.06666667) (meters -0.033333335) 1.0)
|
||||
(sp-int spt-timer 390)
|
||||
(sp-cpuinfo-flags sp-cpuinfo-flag-2 sp-cpuinfo-flag-3 sp-cpuinfo-flag-14)
|
||||
(sp-flt spt-rotate-y (degrees 0.0))
|
||||
)
|
||||
)
|
||||
|
||||
(defpart 4936
|
||||
:init-specs ((sp-tex spt-texture (new 'static 'texture-id :index #x21 :page #xc))
|
||||
(sp-flt spt-num 4.0)
|
||||
(sp-rnd-flt spt-x (meters -60) (meters 60) 1.0)
|
||||
(sp-flt spt-y (meters 32))
|
||||
(sp-rnd-flt spt-z (meters -10) (meters 12) 1.0)
|
||||
(sp-rnd-flt spt-scale-x (meters 0.03) (meters 0.03) 1.0)
|
||||
(sp-rnd-flt spt-scale-y (meters 0.5) (meters 0.5) 1.0)
|
||||
(sp-rnd-flt spt-r 32.0 32.0 1.0)
|
||||
(sp-copy-from-other spt-g -1)
|
||||
(sp-rnd-flt spt-b 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-a 64.0 32.0 1.0)
|
||||
(sp-rnd-flt spt-vel-y (meters -0.06666667) (meters -0.033333335) 1.0)
|
||||
(sp-int spt-timer 390)
|
||||
(sp-cpuinfo-flags sp-cpuinfo-flag-2 sp-cpuinfo-flag-3 sp-cpuinfo-flag-14)
|
||||
(sp-flt spt-rotate-y (degrees 45.0))
|
||||
)
|
||||
)
|
||||
|
||||
(defskelgroup skel-metalkor-head metalkor-head metalkor-head-lod0-jg metalkor-head-idle-ja
|
||||
((metalkor-head-lod0-mg (meters 999999)))
|
||||
:bounds (static-spherem 0 0 0 10)
|
||||
:origin-joint-index 3
|
||||
)
|
||||
|
||||
(define *metalkor-head-lightning-shock-skel* (new 'static 'lightning-spec
|
||||
:name #f
|
||||
:flags (lightning-spec-flags lsf0)
|
||||
:rand-func #x2
|
||||
:start-color (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80)
|
||||
:end-color (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80)
|
||||
:fade-to-color (new 'static 'rgba :r #xbf :b #x8f :a #x5)
|
||||
:fade-start-factor 0.2
|
||||
:fade-time 120.0
|
||||
:texture (new 'static 'texture-id :index #x83 :page #xc)
|
||||
:reduction 0.5
|
||||
:num-points 32
|
||||
:box-size 2048.0
|
||||
:merge-factor 0.5
|
||||
:merge-count 2
|
||||
:radius 4096.0
|
||||
:duration 30.0
|
||||
:sound #f
|
||||
)
|
||||
)
|
||||
|
||||
(scene-method-16
|
||||
(new 'static 'scene
|
||||
:name "palace-outside-window-res"
|
||||
:extra #f
|
||||
:info #f
|
||||
:mask-to-clear #x1282000
|
||||
:entity "scene-stage-54"
|
||||
:art-group "scenecamera"
|
||||
:anim "palace-outside-window-res"
|
||||
:parts 23
|
||||
:command-list '((0
|
||||
(fadein (seconds (new 'static 'bfloat :data 0.5)))
|
||||
(kill "pal-lowrez-throne-1")
|
||||
(fadein (frame-time-30 10))
|
||||
(apply ,(lambda :behavior scene-player () (set-setting! 'rain 'abs 0 0) (none)))
|
||||
(send-event
|
||||
"metalkor-head"
|
||||
'trans-hook
|
||||
,(lambda :behavior scene-player
|
||||
()
|
||||
(let ((frame-num (ja-aframe-num 0)))
|
||||
(if (or (and (< 416.0 frame-num) (< frame-num 440.0))
|
||||
(and (< 462.0 frame-num) (< frame-num 473.0))
|
||||
(and (< 620.0 frame-num) (< frame-num 640.0))
|
||||
(and (< 665.0 frame-num) (< frame-num 670.0))
|
||||
(and (< 860.0 frame-num) (< frame-num 880.0))
|
||||
)
|
||||
(process-drawable-shock-skel-effect
|
||||
self
|
||||
*metalkor-head-lightning-shock-skel*
|
||||
lightning-probe-callback
|
||||
(-> *part-id-table* 166)
|
||||
8192.0
|
||||
-1
|
||||
-1
|
||||
)
|
||||
)
|
||||
(cond
|
||||
((>= frame-num 950.0)
|
||||
(set! (-> self draw force-fade) (the-as uint (the int (lerp-scale 0.0 128.0 frame-num 950.0 980.0))))
|
||||
(logior! (-> self draw status) (draw-control-status force-fade warp-cross-fade))
|
||||
)
|
||||
(else
|
||||
(logclear! (-> self draw status) (draw-control-status force-fade warp-cross-fade))
|
||||
)
|
||||
)
|
||||
)
|
||||
(none)
|
||||
)
|
||||
)
|
||||
(part-tracker
|
||||
"group-palroof-rain0"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleB"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat) (new 'static 'bfloat :data 150.0))
|
||||
)
|
||||
)
|
||||
(145
|
||||
(part-tracker
|
||||
"group-palroof-rain0"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleB"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 145.0) (new 'static 'bfloat :data 280.0))
|
||||
)
|
||||
)
|
||||
(401 (want-display 'palcab #f))
|
||||
(490
|
||||
(want-display 'palcab 'display)
|
||||
(part-tracker
|
||||
"group-palroof-rain1"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleC"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 490.0) (new 'static 'bfloat :data 595.0))
|
||||
)
|
||||
)
|
||||
(650 (part-tracker
|
||||
"group-palroof-rain0"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleB"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 650.0) (new 'static 'bfloat :data 840.0))
|
||||
)
|
||||
)
|
||||
(1100 (part-tracker
|
||||
"group-palroof-rain1"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleC"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 1100.0) (new 'static 'bfloat :data 1285.0))
|
||||
)
|
||||
)
|
||||
(1450 (part-tracker
|
||||
"group-palroof-rain1"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleC"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 1450.0) (new 'static 'bfloat :data 1890.0))
|
||||
)
|
||||
)
|
||||
(2055 (part-tracker
|
||||
"group-palroof-rain0"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleB"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 2055.0) (new 'static 'bfloat :data 2240.0))
|
||||
)
|
||||
)
|
||||
(2235 (part-tracker
|
||||
"group-palroof-rain0"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleB"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 2235.0) (new 'static 'bfloat :data 2365.0))
|
||||
)
|
||||
)
|
||||
(2360 (part-tracker
|
||||
"group-palroof-rain0"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleB"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 2360.0) (new 'static 'bfloat :data 2615.0))
|
||||
)
|
||||
)
|
||||
(2604 (part-tracker "group-palroof-snot" entity "particleman" joint "particleA" track #t))
|
||||
(2660 (part-tracker
|
||||
"group-palroof-rain0"
|
||||
entity
|
||||
"particleman"
|
||||
joint
|
||||
"particleB"
|
||||
track
|
||||
#t
|
||||
duration
|
||||
(frame-range (new 'static 'bfloat :data 2660.0) (new 'static 'bfloat :data 2750.0))
|
||||
)
|
||||
)
|
||||
(10000 (task-close! "palace-cable-resolution"))
|
||||
)
|
||||
:cut-list '(151 281 401 501 596 716 841 1136 1286 1490 1671 1781 1891 2061 2241 2366 2616 2666)
|
||||
:wait-ground-time (seconds 1)
|
||||
:draw-target #f
|
||||
:abort #t
|
||||
:actor (new 'static 'boxed-array :type scene-actor
|
||||
(new 'static 'scene-actor
|
||||
:name "scenecamera"
|
||||
:level #f
|
||||
:art-group "skel-scenecamera"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:camera 4
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "particleman"
|
||||
:level 'throne
|
||||
:art-group "skel-particleman"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "sidekick-highres"
|
||||
:level 'throne
|
||||
:art-group "skel-sidekick-highres"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "jak-highres"
|
||||
:level 'throne
|
||||
:art-group "skel-jak-highres"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "baron-highres"
|
||||
:level 'lbrnermk
|
||||
:art-group "skel-baron-highres"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '((1286 1489))
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "errol-highres"
|
||||
:level 'lbrnermk
|
||||
:art-group "skel-errol-highres"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "metalkor-head"
|
||||
:level 'lbrnermk
|
||||
:art-group "skel-metalkor-head"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
)
|
||||
:load-point-obj "palroof-throne"
|
||||
:end-point-obj "palroof-throne"
|
||||
:borrow '((throne 0 lbrnermk special))
|
||||
:sfx-volume -1.0
|
||||
:ambient-volume -1.0
|
||||
:music-volume -1.0
|
||||
:blackout-end #t
|
||||
:peaceful #t
|
||||
:music-delay 1500.0
|
||||
:save #t
|
||||
)
|
||||
)
|
||||
|
||||
(scene-method-16
|
||||
(new 'static 'scene
|
||||
:name "palace-sneak-in-res"
|
||||
:extra #f
|
||||
:info #f
|
||||
:mask-to-clear #x1282000
|
||||
:entity "scene-stage-54"
|
||||
:art-group "scenecamera"
|
||||
:anim "palace-sneak-in-res"
|
||||
:parts 21
|
||||
:command-list '((0 (fadein (seconds 1)) (apply ,(lambda :behavior scene-player () (set-setting! 'rain 'abs 0 0) (none))))
|
||||
(10000
|
||||
(unless (task-closed? "palace-sneak-in-meeting") (talker-spawn "miss010"))
|
||||
(task-close! "palace-sneak-in-meeting")
|
||||
)
|
||||
)
|
||||
:cut-list '(65 105 251 296 419 483 589 645 735 891 1029 1499 1660 1708 1851 2047 2151 2261 2421)
|
||||
:wait-ground-time (seconds 1)
|
||||
:draw-target #f
|
||||
:abort #t
|
||||
:actor (new 'static 'boxed-array :type scene-actor
|
||||
(new 'static 'scene-actor
|
||||
:name "scenecamera"
|
||||
:level #f
|
||||
:art-group "skel-scenecamera"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:camera 4
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "sidekick-highres"
|
||||
:level 'throne
|
||||
:art-group "skel-sidekick-highres"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "jak-highres"
|
||||
:level 'throne
|
||||
:art-group "skel-jak-highres"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "ashelin-highres"
|
||||
:level 'lashthrn
|
||||
:art-group "skel-ashelin-highres"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
(new 'static 'scene-actor
|
||||
:name "palmpilot"
|
||||
:level 'lashthrn
|
||||
:art-group "skel-palmpilot"
|
||||
:prefix ""
|
||||
:draw-frames '((min max))
|
||||
:scissor-frames '()
|
||||
:flags #x1
|
||||
:shadow-flags -1
|
||||
:shadow-volume-joint #f
|
||||
)
|
||||
)
|
||||
:load-point-obj "throne-ashelin"
|
||||
:end-point-obj (new 'static 'continue-point
|
||||
:name "throne-ashelin"
|
||||
:level #f
|
||||
:trans (new 'static 'vector :x 657938.44 :y 1414076.9 :z 2301379.5 :w 1.0)
|
||||
:quat (new 'static 'vector :y 0.9228 :w 0.3851)
|
||||
:camera-trans (new 'static 'vector :x 632095.94 :y 1433352.2 :z 2337665.8 :w 1.0)
|
||||
:camera-rot (new 'static 'inline-array vector3s 3
|
||||
(new 'static 'vector3s :data (new 'static 'array float 3 -0.81 0.0 -0.5863))
|
||||
(new 'static 'vector3s :data (new 'static 'array float 3 0.0757 0.9916 -0.1046))
|
||||
(new 'static 'vector3s :data (new 'static 'array float 3 0.5814 -0.1291 -0.8032))
|
||||
)
|
||||
:on-goto #f
|
||||
:vis-nick 'throne
|
||||
:want (new 'static 'inline-array level-buffer-state 6
|
||||
(new 'static 'level-buffer-state :name 'palent :display? 'display :force-vis? #f :force-inside? #f)
|
||||
(new 'static 'level-buffer-state :name 'throne :display? 'display :force-vis? #f :force-inside? #f)
|
||||
(new 'static 'level-buffer-state :name 'palout :display? 'display :force-vis? #f :force-inside? #f)
|
||||
(new 'static 'level-buffer-state :name #f :display? #f :force-vis? #f :force-inside? #f)
|
||||
(new 'static 'level-buffer-state :name #f :display? #f :force-vis? #f :force-inside? #f)
|
||||
(new 'static 'level-buffer-state :name #f :display? #f :force-vis? #f :force-inside? #f)
|
||||
)
|
||||
:want-sound (new 'static 'array symbol 3 'palent1 'palent2 'palent3)
|
||||
)
|
||||
:borrow '((throne 0 lashthrn special))
|
||||
:sfx-volume -1.0
|
||||
:ambient-volume -1.0
|
||||
:music-volume -1.0
|
||||
:blackout-end #t
|
||||
:peaceful #t
|
||||
:music-delay 1500.0
|
||||
:save #t
|
||||
)
|
||||
)
|
||||
|
||||
@@ -0,0 +1,694 @@
|
||||
;;-*-Lisp-*-
|
||||
(in-package goal)
|
||||
|
||||
#|
|
||||
|
||||
Code for the PC port anim tester. It's like their original anim tester tool, but actually functional, and with
|
||||
different features.
|
||||
|
||||
|#
|
||||
|
||||
;; debug-only file!
|
||||
(declare-file (debug))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; constants
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; types and enums
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
;;;------------------------
|
||||
;; settings
|
||||
;;;------------------------
|
||||
|
||||
|
||||
(deftype atx-item (basic)
|
||||
((next atx-item :offset-assert 4)
|
||||
(text string)
|
||||
|
||||
(extra basic)
|
||||
(group art-group :overlay-at extra)
|
||||
(jgeo art-joint-geo :overlay-at extra)
|
||||
(janim art-joint-anim :overlay-at extra)
|
||||
(mgeo merc-ctrl :overlay-at extra)
|
||||
)
|
||||
(:methods
|
||||
(new (symbol type string basic) _type_ 0)
|
||||
)
|
||||
)
|
||||
|
||||
(defmethod new atx-item ((allocation symbol) (type-to-make type) (text string) (extra basic))
|
||||
"make a new atx-item"
|
||||
|
||||
(let ((obj (object-new allocation type-to-make (the int (-> type-to-make size)))))
|
||||
(set! (-> obj next) #f)
|
||||
(set! (-> obj text) text)
|
||||
(set! (-> obj extra) extra)
|
||||
|
||||
obj)
|
||||
)
|
||||
|
||||
(deftype atx-list (structure)
|
||||
((head atx-item :offset-assert 0)
|
||||
(tail atx-item)
|
||||
(selection int16)
|
||||
(offset int16)
|
||||
(func (function atx-item object))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(defenum atx-flags
|
||||
:bitfield #t
|
||||
:type int32
|
||||
(eye)
|
||||
(blerc)
|
||||
(show-joints)
|
||||
)
|
||||
|
||||
(deftype anim-tester-x-settings (structure)
|
||||
(
|
||||
(speed float)
|
||||
(frame-num float)
|
||||
(mode symbol)
|
||||
(flags atx-flags)
|
||||
(list-ctrl atx-list :inline)
|
||||
)
|
||||
)
|
||||
|
||||
(define *ATX-settings* (new 'static 'anim-tester-x-settings :speed 1.0
|
||||
:mode 'loop
|
||||
:flags (atx-flags)))
|
||||
|
||||
|
||||
(deftype atx-item-art-group (atx-item)
|
||||
((ja-list atx-list :inline)
|
||||
(jg-list atx-list :inline)
|
||||
(mg-list atx-list :inline)
|
||||
)
|
||||
(:methods
|
||||
(new (symbol type string art-group) _type_ 0)
|
||||
)
|
||||
)
|
||||
|
||||
;;;----------------------------------
|
||||
;; process
|
||||
;;;----------------------------------
|
||||
|
||||
|
||||
(defenum atx-edit-mode
|
||||
:type uint8
|
||||
(none)
|
||||
(art-group)
|
||||
(anim)
|
||||
(mgeo)
|
||||
(jgeo)
|
||||
)
|
||||
|
||||
|
||||
(deftype anim-tester-x (process-drawable)
|
||||
(
|
||||
(edit-mode atx-edit-mode)
|
||||
(cur-list atx-list)
|
||||
(selected-art-group atx-item-art-group)
|
||||
|
||||
(cur-art-group art-group)
|
||||
(cur-joint-geo art-joint-geo)
|
||||
(cur-mesh-geo merc-ctrl)
|
||||
(cur-joint-anim art-joint-anim)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; list functions and macros
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defmacro do-atx-list (bindings &rest body)
|
||||
"iterate through an atx-list."
|
||||
(with-gensyms (next)
|
||||
`(let ((,(car bindings) (-> ,(cadr bindings) head)))
|
||||
(while ,(car bindings)
|
||||
(let ((,next (-> ,(car bindings) next)))
|
||||
|
||||
,@body
|
||||
|
||||
(set! ,(car bindings) ,next)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun atx-list-init! ((lst atx-list))
|
||||
"initialize an atx-list"
|
||||
(set! (-> lst head) #f)
|
||||
(set! (-> lst tail) #f)
|
||||
(set! (-> lst selection) 0)
|
||||
(set! (-> lst offset) 0)
|
||||
(set! (-> lst func) (the (function atx-item object) nothing))
|
||||
lst)
|
||||
|
||||
(defun atx-list-size ((lst atx-list))
|
||||
"return size of an atx-list"
|
||||
(let ((items 0))
|
||||
(do-atx-list (item lst) (1+! items))
|
||||
items)
|
||||
)
|
||||
|
||||
(defun atx-list-append ((lst atx-list) (item atx-item))
|
||||
"append an item to a list. returns the added item."
|
||||
|
||||
(if (not (-> lst head)) (set! (-> lst head) item))
|
||||
(if (-> lst tail) (set! (-> lst tail next) item))
|
||||
(set! (-> lst tail) item)
|
||||
item)
|
||||
|
||||
(defun atx-list-remove ((lst atx-list) (item atx-item))
|
||||
"remove an item from a list. removes all instances of that item. but it's weird if you have multiple..."
|
||||
|
||||
(cond
|
||||
((= (-> lst head) item)
|
||||
(set! (-> lst head) (-> item next))
|
||||
(if (= (-> lst tail) item)
|
||||
(set! (-> lst tail) #f)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(let ((last (the atx-item #f))
|
||||
(i 0))
|
||||
(do-atx-list (it lst)
|
||||
(when (= it item)
|
||||
(if (>= (-> lst selection) i)
|
||||
(1-! (-> lst selection)))
|
||||
(set! (-> last next) (-> it next))
|
||||
(set! it last)
|
||||
)
|
||||
(set! last it)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
0)
|
||||
|
||||
(defun atx-list-remove-by-object ((lst atx-list) (obj basic))
|
||||
"remove all items with a specific object from a list."
|
||||
|
||||
(do-atx-list (it lst)
|
||||
(if (= (-> it extra) obj)
|
||||
(atx-list-remove lst it)
|
||||
)
|
||||
)
|
||||
0)
|
||||
|
||||
(defun atx-list-get-by-index ((lst atx-list) (idx int))
|
||||
"get an item by its index."
|
||||
|
||||
(let ((items 0))
|
||||
(do-atx-list (item lst)
|
||||
(if (= items idx)
|
||||
(return item))
|
||||
(1+! items))
|
||||
items)
|
||||
(the atx-item #f))
|
||||
|
||||
(defun atx-list-get-by-name ((lst atx-list) (name string))
|
||||
"get an item by its index."
|
||||
|
||||
(do-atx-list (item lst)
|
||||
(if (string= (-> item text) name)
|
||||
(return item))
|
||||
)
|
||||
(the atx-item #f))
|
||||
|
||||
|
||||
(defmacro atx-interface-square-to-menu ()
|
||||
`(when (cpad-pressed? 0 square)
|
||||
(cpad-clear! 0 square)
|
||||
;; (true! *camera-read-buttons*)
|
||||
(logclear! (-> *camera* settings master-options) (cam-master-options READ_BUTTONS))
|
||||
(set! (-> self edit-mode) (atx-edit-mode none))
|
||||
(set! (-> *debug-menu-context* is-hidden) #f)
|
||||
)
|
||||
)
|
||||
|
||||
(defun atx-list-interface ((lst atx-list) (title string) (warning string) (sel-obj basic))
|
||||
"run interface and draw an atx-list"
|
||||
|
||||
(let ((items-drawn (-> lst offset))
|
||||
(i 0)
|
||||
(color (font-color white-#ffffff))
|
||||
(text-len (the draw-string-result 0)))
|
||||
|
||||
(with-dma-buffer-add-bucket ((buf (-> (current-frame) debug-buf))
|
||||
(bucket-id debug-no-zbuf1))
|
||||
|
||||
(when (nonzero? (length title))
|
||||
(set! text-len (draw-string-xy title buf 9 (+ 28 4 (* items-drawn 14)) (font-color white-#ffffff) (font-flags shadow kerning)))
|
||||
(1+! items-drawn)
|
||||
)
|
||||
|
||||
(do-atx-list (item lst)
|
||||
(let ((selected? (= i (-> lst selection))))
|
||||
|
||||
(set! color (if (= (-> item extra) sel-obj) (font-color green-#3df23d) (font-color white-#ffffff)))
|
||||
|
||||
(let ((this-len (draw-string-xy (-> item group name) buf 21 (+ 28 4 (* items-drawn 14)) color (font-flags shadow kerning))))
|
||||
(if (> this-len text-len)
|
||||
(set! text-len this-len)))
|
||||
|
||||
(if selected?
|
||||
(draw-string-xy ">" buf 9 (+ 28 4 (* items-drawn 14)) color (font-flags shadow kerning)))
|
||||
|
||||
(1+! items-drawn)
|
||||
(1+! i)
|
||||
|
||||
))
|
||||
|
||||
(when (not (-> lst head))
|
||||
(draw-string-xy warning buf 21 (+ 28 4 14) (font-color precursor-#ec3b00) (font-flags shadow kerning))
|
||||
(1+! items-drawn))
|
||||
|
||||
)
|
||||
|
||||
(with-dma-buffer-add-bucket ((buf (-> (current-frame) debug-buf))
|
||||
(bucket-id debug2))
|
||||
|
||||
|
||||
(draw-sprite2d-xy buf 6 (+ 28 (* (-> lst offset) 14))
|
||||
(+ 6 14 14 (the int text-len)) (+ 14 (* 14 (- items-drawn (-> lst offset))))
|
||||
(static-rgba 0 0 0 64))
|
||||
|
||||
)
|
||||
)
|
||||
|
||||
(when (-> lst head)
|
||||
(if (cpad-pressed? 0 down)
|
||||
(+! (-> lst selection) 1))
|
||||
(if (cpad-pressed? 0 right)
|
||||
(+! (-> lst selection) 5))
|
||||
(if (cpad-pressed? 0 up)
|
||||
(-! (-> lst selection) 1))
|
||||
(if (cpad-pressed? 0 left)
|
||||
(-! (-> lst selection) 5))
|
||||
(if (< (-> lst selection) 0)
|
||||
(set! (-> lst selection) (1- (atx-list-size lst))))
|
||||
(if (>= (-> lst selection) (atx-list-size lst))
|
||||
(set! (-> lst selection) 0))
|
||||
(if (cpad-pressed? 0 x)
|
||||
((-> lst func) (atx-list-get-by-index lst (-> lst selection)))
|
||||
)
|
||||
|
||||
(when (< 16 (+ (-> lst selection) (-> lst offset)))
|
||||
(set! (-> lst offset) (- 16 (-> lst selection)))
|
||||
)
|
||||
(when (< (+ (-> lst selection) (-> lst offset)) 0)
|
||||
(set! (-> lst offset) (- 0 (-> lst selection)))
|
||||
)
|
||||
)
|
||||
0)
|
||||
|
||||
|
||||
(defbehavior atx-list-art-group-func anim-tester-x ((item atx-item-art-group))
|
||||
|
||||
(if (not (and (type-type? (-> item type) atx-item-art-group)
|
||||
(-> item group)
|
||||
(-> item ja-list head)
|
||||
(-> item jg-list head)
|
||||
(-> item mg-list head)
|
||||
))
|
||||
(return #f))
|
||||
|
||||
(set! (-> self selected-art-group) item)
|
||||
(set! (-> self edit-mode) (atx-edit-mode anim))
|
||||
(set! (-> self cur-art-group) (-> item group))
|
||||
(set! (-> self cur-joint-anim) (-> item ja-list head janim))
|
||||
(set! (-> self cur-joint-geo) (-> item jg-list head jgeo))
|
||||
(set! (-> self cur-mesh-geo) (-> item mg-list head mgeo))
|
||||
(ja-no-eval :frame-num 0.0)
|
||||
0)
|
||||
|
||||
(defbehavior atx-list-joint-anim-func anim-tester-x ((item atx-item))
|
||||
|
||||
(if (not (-> item janim))
|
||||
(return #f))
|
||||
(set! (-> self cur-joint-anim) (-> item janim))
|
||||
(ja-no-eval :frame-num 0.0)
|
||||
0)
|
||||
(defbehavior atx-list-joint-geo-func anim-tester-x ((item atx-item))
|
||||
|
||||
(if (not (-> item janim))
|
||||
(return #f))
|
||||
(set! (-> self cur-joint-geo) (-> item jgeo))
|
||||
0)
|
||||
(defbehavior atx-list-mesh-geo-func anim-tester-x ((item atx-item))
|
||||
|
||||
(if (not (-> item janim))
|
||||
(return #f))
|
||||
(set! (-> self cur-mesh-geo) (-> item mgeo))
|
||||
0)
|
||||
|
||||
|
||||
|
||||
(defmethod new atx-item-art-group ((allocation symbol) (type-to-make type) (text string) (ag art-group))
|
||||
"make a new atx-item"
|
||||
|
||||
(let ((obj (object-new allocation type-to-make (the int (-> type-to-make size)))))
|
||||
(set! (-> obj next) #f)
|
||||
(set! (-> obj text) text)
|
||||
(set! (-> obj group) ag)
|
||||
|
||||
(atx-list-init! (-> obj ja-list))
|
||||
(atx-list-init! (-> obj jg-list))
|
||||
(atx-list-init! (-> obj mg-list))
|
||||
(set! (-> obj ja-list func) atx-list-joint-anim-func)
|
||||
(set! (-> obj jg-list func) atx-list-joint-geo-func)
|
||||
(set! (-> obj mg-list func) atx-list-mesh-geo-func)
|
||||
|
||||
obj)
|
||||
)
|
||||
|
||||
|
||||
|
||||
;;;----------------------------------------------
|
||||
;; globals
|
||||
;;;----------------------------------------------
|
||||
|
||||
;; initialize the lists in the static defs
|
||||
(atx-list-init! (-> *ATX-settings* list-ctrl))
|
||||
(set! (-> *ATX-settings* list-ctrl func) atx-list-art-group-func)
|
||||
|
||||
;; the actual process.
|
||||
(define-perm *atx* (pointer anim-tester-x) #f)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; states
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
|
||||
|
||||
(defbehavior anim-tester-x-reset anim-tester-x ()
|
||||
"reset the anim tester to default settings"
|
||||
|
||||
(format #t "resetting anim tester~%")
|
||||
(set! (-> self edit-mode) (atx-edit-mode none))
|
||||
(set! (-> self selected-art-group) #f)
|
||||
(set! (-> self cur-art-group) #f)
|
||||
(set! (-> self cur-joint-anim) #f)
|
||||
(set! (-> self cur-joint-geo) #f)
|
||||
(set! (-> self cur-mesh-geo) #f)
|
||||
0)
|
||||
|
||||
|
||||
(defbehavior clean-art-groups anim-tester-x ()
|
||||
"purge possible invalid art groups automatically."
|
||||
(do-atx-list (it (-> *ATX-settings* list-ctrl))
|
||||
(when (!= (-> it group type) art-group)
|
||||
(when (= it (-> self selected-art-group))
|
||||
(anim-tester-x-reset)
|
||||
)
|
||||
(atx-list-remove (-> *ATX-settings* list-ctrl) it)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(defbehavior anim-tester-x-interface anim-tester-x ()
|
||||
"UI controls for anim tester"
|
||||
|
||||
(set! (-> *debug-menu-context* is-hidden) #t)
|
||||
(set! (-> self cur-list) #f)
|
||||
|
||||
(case (-> self edit-mode)
|
||||
(((atx-edit-mode none))
|
||||
(set! (-> *debug-menu-context* is-hidden) #f))
|
||||
(((atx-edit-mode art-group))
|
||||
(set! (-> self cur-list) (-> *ATX-settings* list-ctrl))
|
||||
(atx-list-interface (-> self cur-list) "---- pick art group ----" "Add an art group with atx-add-group" (-> self cur-art-group))
|
||||
(atx-interface-square-to-menu)
|
||||
)
|
||||
(((atx-edit-mode anim))
|
||||
(set! (-> self cur-list) (-> self selected-art-group ja-list))
|
||||
(atx-list-interface (-> self cur-list) "---- pick anim ----" "" (-> self cur-joint-anim))
|
||||
(atx-interface-square-to-menu)
|
||||
)
|
||||
(((atx-edit-mode jgeo))
|
||||
(set! (-> self cur-list) (-> self selected-art-group jg-list))
|
||||
(atx-list-interface (-> self cur-list) "---- pick skeleton ----" "" (-> self cur-joint-geo))
|
||||
(atx-interface-square-to-menu)
|
||||
)
|
||||
(((atx-edit-mode mgeo))
|
||||
(set! (-> self cur-list) (-> self selected-art-group mg-list))
|
||||
(atx-list-interface (-> self cur-list) "---- pick mesh ----" "" (-> self cur-mesh-geo))
|
||||
(atx-interface-square-to-menu)
|
||||
)
|
||||
)
|
||||
|
||||
0)
|
||||
|
||||
(defstate anim-tester-x-process (anim-tester-x)
|
||||
|
||||
:trans (behavior ()
|
||||
(clean-art-groups)
|
||||
|
||||
(if (= *master-mode* 'menu)
|
||||
(anim-tester-x-interface)
|
||||
;; (set! *camera-read-buttons* #t)
|
||||
(logclear! (-> *camera* settings master-options) (cam-master-options READ_BUTTONS))
|
||||
)
|
||||
(when (!= *master-mode* 'menu)
|
||||
(add-debug-x #t (bucket-id debug-no-zbuf1) (-> self root trans) *color-white*)
|
||||
)
|
||||
(none))
|
||||
|
||||
:code (behavior ()
|
||||
|
||||
(loop
|
||||
|
||||
(when (and (-> self cur-joint-geo) (!= (-> self cur-joint-geo) (-> self draw jgeo)))
|
||||
(process-disconnect self)
|
||||
(set! (-> self draw art-group) (-> self cur-art-group))
|
||||
(set! (-> self draw cur-lod) -1)
|
||||
(set! (-> self draw jgeo) (-> self cur-joint-geo))
|
||||
;; (set! (-> self draw sink-group) (-> *level* default-level foreground-sink-group 1))
|
||||
(set! (-> self draw lod-set lod 0 geo) (-> self cur-mesh-geo))
|
||||
(set! (-> self draw lod-set lod 0 dist) (meters 999999))
|
||||
(set! (-> self draw bounds w) (meters 10))
|
||||
(set! (-> self draw data-format) (draw-control-data-format merc))
|
||||
(vector-copy! (-> self draw color-mult) (new 'static 'vector :x 1.0 :y 1.0 :z 1.0 :w 1.0))
|
||||
(vector-copy! (-> self draw color-emissive) (new 'static 'vector))
|
||||
;; (set! (-> self draw secondary-interp) 0.0)
|
||||
(set! (-> self draw shadow) #f)
|
||||
(set! (-> self draw shadow-ctrl) #f)
|
||||
(set! (-> self draw ripple) #f)
|
||||
(set! (-> self draw level-index) (the-as uint 2))
|
||||
;; (set! (-> self node-list) (make-nodes-from-jg (-> self draw jgeo) *default-skel-template* 'debug))
|
||||
(set! (-> self node-list) (setup-cspace-and-add (-> self draw) (-> self draw jgeo) 'debug))
|
||||
(if (not (-> self skel effect))
|
||||
(set! (-> self skel effect) (new 'process 'effect-control self)))
|
||||
;; (fill-skeleton-cache self)
|
||||
(lod-set! (-> self draw) 0)
|
||||
(ja-channel-set! 0)
|
||||
)
|
||||
|
||||
(cond
|
||||
((-> self cur-joint-geo)
|
||||
(if (> 1 (-> self skel active-channels))
|
||||
(ja-channel-set! 1))
|
||||
(set! (-> self draw lod-set lod 0 geo) (-> self cur-mesh-geo))
|
||||
(ja-no-eval :group! (-> self cur-joint-anim))
|
||||
(when (!= *master-mode* 'menu)
|
||||
(case (-> *ATX-settings* mode)
|
||||
(('loop)
|
||||
(ja :num! (loop! (-> *ATX-settings* speed)))
|
||||
)
|
||||
(('identity)
|
||||
(ja :num! (identity (-> *ATX-settings* frame-num)))
|
||||
)
|
||||
(('seek)
|
||||
(ja :num! (seek! max (-> *ATX-settings* speed)))
|
||||
)
|
||||
)
|
||||
)
|
||||
(compute-alignment! (-> self align))
|
||||
(align! (-> self align) (align-opts adjust-x-vel adjust-y-vel adjust-xz-vel keep-other-velocities adjust-quat)
|
||||
1.0 1.0 1.0)
|
||||
)
|
||||
(else
|
||||
(if (!= *master-mode* 'menu)
|
||||
(format *stdcon* "~%~%no art selected~%")
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(suspend))
|
||||
)
|
||||
|
||||
:post (behavior ()
|
||||
(when (-> self cur-joint-geo)
|
||||
(ja-post)
|
||||
(when (!= *master-mode* 'menu)
|
||||
;; (when (logtest? (-> *ATX-settings* flags) (atx-flags show-joints))
|
||||
;; (draw-joint-spheres self)
|
||||
;; )
|
||||
(format *stdcon* "~%~%")
|
||||
(debug-print-channels (-> self skel) (the-as symbol *stdcon*))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; helper functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(defbehavior anim-tester-x-init-by-other anim-tester-x ()
|
||||
"external initializer for anim-tester-x process"
|
||||
|
||||
(logclear! (-> self mask) (process-mask menu))
|
||||
(set! (-> self root) (new 'process 'trsqv))
|
||||
(set! (-> self draw) (new 'process 'draw-control self #f))
|
||||
(set! (-> self draw dma-add-func) dma-add-process-drawable)
|
||||
(set! (-> self skel) (new 'process 'joint-control 24)) ;; allocate 24 anim channels
|
||||
(set! (-> self align) (new 'process 'align-control self))
|
||||
(quaternion-identity! (-> self root quat))
|
||||
(vector-identity! (-> self root scale))
|
||||
(position-in-front-of-camera! (-> self root trans) (meters 10) (meters 1))
|
||||
(anim-tester-x-reset)
|
||||
(go anim-tester-x-process)
|
||||
(none)
|
||||
)
|
||||
|
||||
|
||||
(defun atx-stop ()
|
||||
"kill the anim tester process"
|
||||
|
||||
(kill-by-type anim-tester-x *default-pool*)
|
||||
(set! *atx* (the (pointer anim-tester-x) #f)))
|
||||
|
||||
(defun atx-start ()
|
||||
"start the anim tester process"
|
||||
|
||||
(when *atx*
|
||||
(atx-stop)
|
||||
)
|
||||
|
||||
(if *target*
|
||||
(stop 'play))
|
||||
(set! *atx* (process-spawn anim-tester-x :from *pc-dead-pool*))
|
||||
;; (set! *camera-orbit-target* *atx*)
|
||||
(send-event *camera* 'change-state cam-free-floating 0)
|
||||
)
|
||||
|
||||
|
||||
(defun atx-add-new-art-group ((ag art-group))
|
||||
|
||||
(let ((ag-item (the atx-item-art-group (atx-list-append (-> *ATX-settings* list-ctrl)
|
||||
(new 'debug 'atx-item-art-group (-> ag name) ag)))))
|
||||
(dotimes (i (-> ag length))
|
||||
(when (-> ag data i)
|
||||
(case (-> ag data i type)
|
||||
((art-joint-geo) (atx-list-append (-> ag-item jg-list) (new 'debug 'atx-item (-> ag name) (-> ag data i))))
|
||||
((merc-ctrl) (atx-list-append (-> ag-item mg-list) (new 'debug 'atx-item (-> ag name) (-> ag data i))))
|
||||
((art-joint-anim) (atx-list-append (-> ag-item ja-list) (new 'debug 'atx-item (-> ag name) (-> ag data i))))
|
||||
)
|
||||
)
|
||||
)
|
||||
ag-item)
|
||||
)
|
||||
|
||||
(defun atx-add-group ((name string) (level-name symbol))
|
||||
|
||||
(protect ((-> *level* log-in-level-bsp))
|
||||
(set! (-> *level* log-in-level-bsp) (aif (level-get *level* level-name) (-> it bsp)))
|
||||
(let ((ag (load-to-heap-by-name (-> *level* default-level art-group) name #t debug 0)))
|
||||
(cond
|
||||
(ag
|
||||
(if (not *atx*) (atx-start))
|
||||
|
||||
(atx-add-new-art-group ag)
|
||||
)
|
||||
(else
|
||||
(format #t "ERROR: no art-group ~A~%" name)
|
||||
)
|
||||
)
|
||||
))
|
||||
0)
|
||||
|
||||
(defun atx-append-group ((append-to string) (name string) (level-name symbol))
|
||||
|
||||
(protect ((-> *level* log-in-level-bsp))
|
||||
(set! (-> *level* log-in-level-bsp) (aif (level-get *level* level-name) (-> it bsp)))
|
||||
(let ((ag (load-to-heap-by-name (-> *level* default-level art-group) name #t debug 0)))
|
||||
(cond
|
||||
(ag
|
||||
(if (not *atx*) (atx-start))
|
||||
|
||||
(let ((ag-item (the atx-item-art-group (atx-list-get-by-name (-> *ATX-settings* list-ctrl) append-to))))
|
||||
(when (not ag-item)
|
||||
(format #t "ERROR: art-group ~A not loaded~%" append-to)
|
||||
(return #f)
|
||||
)
|
||||
(dotimes (i (-> ag length))
|
||||
(when (-> ag data i)
|
||||
(case (-> ag data i type)
|
||||
((art-joint-geo) (atx-list-append (-> ag-item jg-list) (new 'debug 'atx-item (-> ag name) (-> ag data i))))
|
||||
((merc-ctrl) (atx-list-append (-> ag-item mg-list) (new 'debug 'atx-item (-> ag name) (-> ag data i))))
|
||||
((art-joint-anim) (atx-list-append (-> ag-item ja-list) (new 'debug 'atx-item (-> ag name) (-> ag data i))))
|
||||
)
|
||||
)
|
||||
))
|
||||
)
|
||||
(else
|
||||
(format #t "ERROR: no art-group ~A~%" name)
|
||||
)
|
||||
)
|
||||
))
|
||||
0)
|
||||
|
||||
(defun atx-add-level-group ()
|
||||
|
||||
(if (not *atx*) (atx-start))
|
||||
|
||||
(do-atx-list (item (-> *ATX-settings* list-ctrl))
|
||||
(if (or (and (>= (-> item group) (-> *level* level 0 heap base)) (< (-> item group) (-> *level* level 0 heap top)))
|
||||
(and (>= (-> item group) (-> *level* level 1 heap base)) (< (-> item group) (-> *level* level 1 heap top)))
|
||||
(and (>= (-> item group) (-> *level* level 2 heap base)) (< (-> item group) (-> *level* level 2 heap top)))
|
||||
(and (>= (-> item group) (-> *level* level 3 heap base)) (< (-> item group) (-> *level* level 3 heap top)))
|
||||
(and (>= (-> item group) (-> *level* level 4 heap base)) (< (-> item group) (-> *level* level 4 heap top)))
|
||||
(and (>= (-> item group) (-> *level* level 5 heap base)) (< (-> item group) (-> *level* level 5 heap top))))
|
||||
(atx-list-remove (-> *ATX-settings* list-ctrl) item)
|
||||
)
|
||||
)
|
||||
(dotimes (i 6)
|
||||
(doarray (ag (-> *level* level i art-group data-array))
|
||||
(atx-add-new-art-group (the art-group ag))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun atx-add-common-group ()
|
||||
|
||||
(if (not *atx*) (atx-start))
|
||||
(doarray (ag (-> *level* level 2 art-group data-array))
|
||||
(atx-add-new-art-group (the art-group ag))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,861 @@
|
||||
;;-*-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-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-pick-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)
|
||||
)
|
||||
|
||||
(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-display-part*) (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-pick-func))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
;; camera entities
|
||||
(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-pick-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 "Show part entities" *entity-debug-display-part* 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! *vu1-enable-user-menu* (vu1-renderer-mask tfrag trans-tfrag tie tie-near))
|
||||
;; (true! *generic-tie*)
|
||||
;; )
|
||||
;; (else
|
||||
;; (true! (-> arg value))
|
||||
;; (logclear! *vu1-enable-user-menu* (vu1-renderer-mask tfrag trans-tfrag tie tie-near))
|
||||
;; (false! *generic-tie*)
|
||||
;; )
|
||||
;; )
|
||||
;; )
|
||||
;; (-> 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 debug-menu-make-collision-renderer-menu ((ctx debug-menu-context))
|
||||
;; (let ((menu (new 'debug 'debug-menu ctx "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 "Collision renderer mode menu")))
|
||||
;; (doenum (name val pc-collision-mode)
|
||||
;; (debug-menu-append-item mode-menu (new-dm-flag name val 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 "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 "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 "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 "Collision renderer filter skip menu")))
|
||||
;; (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)))
|
||||
;;
|
||||
;; (new-dm-submenu "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-subtitle-language ((blang int) (msg debug-menu-msg))
|
||||
;; (let ((lang (the pc-subtitle-lang (/ blang 8))))
|
||||
;; (when (= msg (debug-menu-msg press))
|
||||
;; (set! (-> *pc-settings* subtitle-language) lang))
|
||||
;; (= (-> *pc-settings* subtitle-language) lang)
|
||||
;; )
|
||||
;; )
|
||||
;;
|
||||
;; (defun dm-text-language ((blang int) (msg debug-menu-msg))
|
||||
;; (let ((lang (the pc-subtitle-lang (/ 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-mood-override-palette-pick-func ((bpal int) (msg debug-menu-msg))
|
||||
;; (let* ((pal (/ bpal 8))
|
||||
;; (cur-val (-> *pc-settings* mood-overrides pal)))
|
||||
;;
|
||||
;; (when (= msg (debug-menu-msg press))
|
||||
;; (set! (-> *pc-settings* mood-overrides pal) (if (= cur-val 0.0) 1.0 0.0))
|
||||
;;
|
||||
;; (when (not (= 'mult (-> *pc-settings* mood-override?)))
|
||||
;; (set! (-> *pc-settings* mood-override?) #f)
|
||||
;; (dotimes (i 8)
|
||||
;; (if (!= (-> *pc-settings* mood-overrides i) 0.0)
|
||||
;; (set! (-> *pc-settings* mood-override?) 'copy)))
|
||||
;; ))
|
||||
;;
|
||||
;; (= (-> *pc-settings* mood-overrides pal) 1.0)
|
||||
;; )
|
||||
;; )
|
||||
;;
|
||||
;; (defun dm-mood-override-pick-func ((kind symbol) (msg debug-menu-msg))
|
||||
;; (when (= msg (debug-menu-msg press))
|
||||
;; (if (= kind (-> *pc-settings* mood-override?))
|
||||
;; (set! (-> *pc-settings* mood-override?) #f)
|
||||
;; (set! (-> *pc-settings* mood-override?) kind)))
|
||||
;; (= kind (-> *pc-settings* mood-override?))
|
||||
;; )
|
||||
;;
|
||||
;; (defun dm-mood-palette-float ((pal int) (arg1 debug-menu-msg) (newval float) (val float))
|
||||
;; (when (= arg1 (debug-menu-msg press))
|
||||
;; (set! (-> *pc-settings* mood-overrides (/ pal 8)) newval))
|
||||
;; (-> *pc-settings* mood-overrides (/ pal 8))
|
||||
;; )
|
||||
|
||||
(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-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 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-lambda-float-var (-> *ATX-settings* speed)) 0.01 -10.0 10.0))
|
||||
(debug-menu-append-item menu (new-dm-var-float "Frame Num" (the int #f) (dm-lambda-float-var (-> *ATX-settings* frame-num)) 0.1 0.0 99999.0))
|
||||
(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 (game-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 (game-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)
|
||||
;; )
|
||||
;; )
|
||||
|
||||
(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*))
|
||||
;; Scene menu TODO
|
||||
|
||||
(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* default aspect-ratio) 'aspect4x3)
|
||||
;; (set! (-> *setting-control* default aspect-ratio) 'aspect16x9)
|
||||
;; )
|
||||
;; (else
|
||||
;; (set! (-> *setting-control* default aspect-ratio) 'aspect4x3)
|
||||
;; )
|
||||
;; )
|
||||
;; (set-aspect-ratio (-> *setting-control* 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)))
|
||||
;; (function "Fullscreen" #f ,(lambda () (set-display-mode! *pc-settings* 'fullscreen)))
|
||||
;; (function "Borderless" #f ,(lambda () (set-display-mode! *pc-settings* 'borderless)))
|
||||
;; )
|
||||
;; (menu "Sizes"
|
||||
;; (function "640 x 480" #f ,(lambda () (set-size! *pc-settings* 640 480)))
|
||||
;; (function "640 x 360" #f ,(lambda () (set-size! *pc-settings* 640 360)))
|
||||
;; (function "720 x 540" #f ,(lambda () (set-size! *pc-settings* 720 540)))
|
||||
;; (function "960 x 540" #f ,(lambda () (set-size! *pc-settings* 960 540)))
|
||||
;; (function "800 x 600" #f ,(lambda () (set-size! *pc-settings* 800 600)))
|
||||
;; (function "960 x 720" #f ,(lambda () (set-size! *pc-settings* 960 720)))
|
||||
;; (function "1280 x 720" #f ,(lambda () (set-size! *pc-settings* 1280 720)))
|
||||
;; (function "1024 x 768" #f ,(lambda () (set-size! *pc-settings* 1024 768)))
|
||||
;; (function "1366 x 768" #f ,(lambda () (set-size! *pc-settings* 1366 768)))
|
||||
;; (function "1280 x 960" #f ,(lambda () (set-size! *pc-settings* 1280 960)))
|
||||
;; (function "1440 x 1080" #f ,(lambda () (set-size! *pc-settings* 1440 1080)))
|
||||
;; (function "1920 x 1080" #f ,(lambda () (set-size! *pc-settings* 1920 1080)))
|
||||
;; (function "1920 x 1440" #f ,(lambda () (set-size! *pc-settings* 1920 1440)))
|
||||
;; (function "2560 x 1440" #f ,(lambda () (set-size! *pc-settings* 2560 1440)))
|
||||
;; (function "2880 x 2160" #f ,(lambda () (set-size! *pc-settings* 2880 2160)))
|
||||
;; (function "3840 x 2160" #f ,(lambda () (set-size! *pc-settings* 3840 2160)))
|
||||
;; (function "512 x 224" #f ,(lambda () (set-size! *pc-settings* 512 224)))
|
||||
;; (function "512 x 256" #f ,(lambda () (set-size! *pc-settings* 512 256)))
|
||||
;; (function "512 x 448" #f ,(lambda () (set-size! *pc-settings* 512 448)))
|
||||
;; (function "512 x 512" #f ,(lambda () (set-size! *pc-settings* 512 512)))
|
||||
;; )
|
||||
;; (flag "Letterbox" #f ,(dm-lambda-boolean-flag (-> *pc-settings* letterbox?)))
|
||||
;; (flag "Skip movies" #f ,(dm-lambda-boolean-flag (-> *pc-settings* skip-movies?)))
|
||||
;; (flag "Money starburst" #f ,(dm-lambda-boolean-flag (-> *pc-settings* money-starburst?)))
|
||||
;; (flag "Subtitles" #f ,(dm-lambda-boolean-flag (-> *pc-settings* subtitles?)))
|
||||
;; (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 "Subtitle language"
|
||||
;; (flag "english" 0 dm-subtitle-language)
|
||||
;; (flag "french" 1 dm-subtitle-language)
|
||||
;; (flag "german" 2 dm-subtitle-language)
|
||||
;; (flag "spanish" 3 dm-subtitle-language)
|
||||
;; (flag "uk-english" 6 dm-subtitle-language)
|
||||
;; (flag "br-portuguese" 13 dm-subtitle-language)
|
||||
;; )
|
||||
;; (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 "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 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?)))
|
||||
;; )
|
||||
;; (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 "60" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set-frame-rate! *pc-settings* 60))
|
||||
;; (= (-> *pc-settings* target-fps) 60)))
|
||||
;; (flag "100" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set-frame-rate! *pc-settings* 100))
|
||||
;; (= (-> *pc-settings* target-fps) 100)))
|
||||
;; (flag "150" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set-frame-rate! *pc-settings* 150))
|
||||
;; (= (-> *pc-settings* target-fps) 150)))
|
||||
;; )
|
||||
;; (menu "MSAA"
|
||||
;; (flag "Off" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set! (-> *pc-settings* gfx-msaa) 1))
|
||||
;; (= (-> *pc-settings* gfx-msaa) 1)))
|
||||
;; (flag "x2" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set! (-> *pc-settings* gfx-msaa) 2))
|
||||
;; (= (-> *pc-settings* gfx-msaa) 2)))
|
||||
;; (flag "x4" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set! (-> *pc-settings* gfx-msaa) 4))
|
||||
;; (= (-> *pc-settings* gfx-msaa) 4)))
|
||||
;; (flag "x8" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set! (-> *pc-settings* gfx-msaa) 8))
|
||||
;; (= (-> *pc-settings* gfx-msaa) 8)))
|
||||
;; (flag "x16" #f ,(lambda (arg (msg debug-menu-msg)) (when (= msg (debug-menu-msg press)) (set! (-> *pc-settings* gfx-msaa) 16))
|
||||
;; (= (-> *pc-settings* gfx-msaa) 16)))
|
||||
;; )
|
||||
;; (flag "V-sync" #f ,(dm-lambda-boolean-flag (-> *pc-settings* vsync?)))
|
||||
;; ;(flag "Alt load boundaries" #f ,(dm-lambda-boolean-flag (-> *pc-settings* new-lb?)))
|
||||
;; (flag "All actors" #f ,(dm-lambda-boolean-flag (-> *pc-settings* force-actors?)))
|
||||
;; (flag "Display actor counts" #f ,(dm-lambda-boolean-flag (-> *pc-settings* display-actor-counts)))
|
||||
;; (flag "Display git commit" #f ,(dm-lambda-boolean-flag (-> *pc-settings* display-sha)))
|
||||
;; (flag "Extra hud elements" #f ,(dm-lambda-boolean-flag (-> *pc-settings* extra-hud?)))
|
||||
;; (flag "Music fadein" #f ,(dm-lambda-boolean-flag (-> *pc-settings* music-fadein?)))
|
||||
;; (flag "Music fadeout" #f ,(dm-lambda-boolean-flag (-> *pc-settings* music-fadeout?)))
|
||||
;; (function "Reset" #f ,(lambda () (reset *pc-settings*)))
|
||||
(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" #f ,(dm-lambda-boolean-flag (-> *pc-settings* debug-pad-display)))
|
||||
;; (flag "Display actor bank" #f ,(dm-lambda-boolean-flag (-> *pc-settings* display-actor-bank)))
|
||||
(flag "Heap status" #f ,(dm-lambda-boolean-flag (-> *pc-settings* display-heap-status)))
|
||||
;; (flag "Bug report" #f ,(dm-lambda-boolean-flag (-> *pc-settings* display-bug-report)))
|
||||
;; (flag "Text boxes" #f ,(dm-lambda-boolean-flag (-> *pc-settings* display-text-box)))
|
||||
(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)
|
||||
;; (menu "Mood override"
|
||||
;; (function "-- SIMPLE OVERRIDE" #f nothing)
|
||||
;; (flag "Palette 0" 0 dm-mood-override-palette-pick-func)
|
||||
;; (flag "Palette 1" 1 dm-mood-override-palette-pick-func)
|
||||
;; (flag "Palette 2" 2 dm-mood-override-palette-pick-func)
|
||||
;; (flag "Palette 3" 3 dm-mood-override-palette-pick-func)
|
||||
;; (flag "Palette 4" 4 dm-mood-override-palette-pick-func)
|
||||
;; (flag "Palette 5" 5 dm-mood-override-palette-pick-func)
|
||||
;; (flag "Palette 6" 6 dm-mood-override-palette-pick-func)
|
||||
;; (flag "Palette 7" 7 dm-mood-override-palette-pick-func)
|
||||
;; (menu "Advanced"
|
||||
;; (flag "Overwrite" copy dm-mood-override-pick-func)
|
||||
;; (flag "Multiply" mult dm-mood-override-pick-func)
|
||||
;; (float-fixed-var "Palette 0 Amt" 0 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; (float-fixed-var "Palette 1 Amt" 1 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; (float-fixed-var "Palette 2 Amt" 2 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; (float-fixed-var "Palette 3 Amt" 3 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; (float-fixed-var "Palette 4 Amt" 4 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; (float-fixed-var "Palette 5 Amt" 5 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; (float-fixed-var "Palette 6 Amt" 6 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; (float-fixed-var "Palette 7 Amt" 7 dm-mood-palette-float 0 10 #t 0 1000 3)
|
||||
;; )
|
||||
;; )
|
||||
(flag "Joint names" *display-joint-names* dm-boolean-toggle-pick-func)
|
||||
(flag "Bone lines" *display-bones* dm-boolean-toggle-pick-func)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; (debug-menu-append-item (-> (the debug-menu-item-submenu (ref (-> *debug-menu-context* root-menu items) 4)) submenu)
|
||||
;; (debug-menu-make-collision-renderer-menu *debug-menu-context*))
|
||||
|
||||
(debug-menu-append-item (-> (the debug-menu-item-submenu (car (-> *debug-menu-context* root-menu items))) submenu)
|
||||
(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))
|
||||
;; )
|
||||
;; )
|
||||
;; )
|
||||
@@ -0,0 +1,258 @@
|
||||
;;-*-Lisp-*-
|
||||
(in-package goal)
|
||||
|
||||
#|
|
||||
|
||||
Entity debugging utilities.
|
||||
|
||||
|#
|
||||
|
||||
(declare-file (debug))
|
||||
|
||||
(define *debug-temp-string* (new 'debug 'string 4096 (the string #f)))
|
||||
|
||||
;; custom entity functions for pc port
|
||||
(defun-debug entity-inspect-draw ((inspect-info entity-debug-inspect))
|
||||
"draw text about an entity on screen"
|
||||
|
||||
(update-pad inspect-info 0)
|
||||
(let* ((e (-> inspect-info entity)) (name (res-lump-struct e 'name string)))
|
||||
(set! *debug-actor* (the string (and (-> inspect-info show-actor-info) name)))
|
||||
;; draw trans
|
||||
(add-debug-x #t (bucket-id debug-no-zbuf1) (-> e trans) (static-rgba 255 255 0 128))
|
||||
(if (or (not (-> inspect-info show-actor-info)) (!= (-> e type) entity-actor) (and (= (-> e type) entity-actor) (not (-> (the entity-actor e) extra process))))
|
||||
(add-debug-text-3d #t (bucket-id debug-no-zbuf1) name (-> e trans) (font-color precursor-#ec3b00) (new 'static 'vector2h :y 8)))
|
||||
|
||||
;; start writing text
|
||||
(let* ((begin-y (- 16 (* (-> inspect-info scroll-y) 16))) (cur-y begin-y) (y-adv 16))
|
||||
(with-dma-buffer-add-bucket ((debug-buf (-> (current-frame) debug-buf))
|
||||
(bucket-id debug-no-zbuf1))
|
||||
;; basic info, actor id, etc
|
||||
(draw-string-xy
|
||||
(string-format "~3L~A~0L ~A~%tags: ~D size: ~D aid: #x~x~%R1/L1 scroll L3 toggle display-actor-info~%--------------------" (-> e type) name (length e) (asize-of e) (-> e aid))
|
||||
debug-buf 352 cur-y (font-color default-#cddbcd) (font-flags shadow kerning middle))
|
||||
(+! cur-y (* 10 6))
|
||||
(cond
|
||||
((type-type? (-> e type) entity-actor)
|
||||
(let ((actor (the entity-actor e)))
|
||||
;; print info for entity-actors
|
||||
(draw-string-xy
|
||||
(string-format "etype: ~A~%vis: ~D task: ~S" (-> actor etype) (-> actor vis-id) (game-task->string (-> actor task)))
|
||||
debug-buf 352 cur-y (font-color default-#cddbcd) (font-flags shadow kerning middle))
|
||||
(+! cur-y (* 10 3))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; draw each tag in entity
|
||||
(dotimes (i (length e))
|
||||
(let ((data (get-tag-index-data e i)))
|
||||
|
||||
;; tag info
|
||||
(format (clear *debug-temp-string*) "~3L~2D)~0L ~20L~A~0L:" i (-> e tag i name) (-> e tag i elt-type))
|
||||
|
||||
;; tag data - special cases first
|
||||
(cond
|
||||
;; some water-height info
|
||||
((and (= (-> e tag i name) 'water-height) (= (-> e tag i elt-count) 4) (= (-> e tag i elt-type) float))
|
||||
(+! y-adv (* 14 1))
|
||||
(format *debug-temp-string* " ~mm ~mm ~mm~%(~S)"
|
||||
(-> (the (pointer float) data) 0)
|
||||
(-> (the (pointer float) data) 1)
|
||||
(-> (the (pointer float) data) 2)
|
||||
(begin (bit-enum->string water-flags (the int (-> (the (pointer float) data) 3)) (clear *temp-string*)) *temp-string*)
|
||||
)
|
||||
)
|
||||
;; some water-height info but with 5 elts
|
||||
((and (= (-> e tag i name) 'water-height) (= (-> e tag i elt-count) 4) (= (-> e tag i elt-type) float))
|
||||
(+! y-adv (* 10 3))
|
||||
(format *debug-temp-string* " ~mm ~mm ~mm~%(~S)~%~mm"
|
||||
(-> (the (pointer float) data) 0)
|
||||
(-> (the (pointer float) data) 1)
|
||||
(-> (the (pointer float) data) 2)
|
||||
(begin (bit-enum->string water-flags (the int (-> (the (pointer float) data) 3)) (clear *temp-string*)) *temp-string*)
|
||||
(-> (the (pointer float) data) 4)
|
||||
)
|
||||
)
|
||||
;; text id (can be hint ambient)
|
||||
;; ((and (= (-> e tag i name) 'text-id) (= (-> e tag i elt-count) 1) (= (-> e tag i elt-type) int32))
|
||||
;; (format *debug-temp-string* " (game-text-id ~S)" (game-text-id->string (-> (the (pointer game-text-id) data) 0)))
|
||||
;; )
|
||||
;; eco-info, like in vents, crates, or collectables in general
|
||||
((and (= (-> e tag i name) 'eco-info) (= (-> e tag i elt-count) 2) (= (-> e tag i elt-type) int32))
|
||||
(format *debug-temp-string* " ~S " (pickup-type->string (the-as pickup-type (-> (the (pointer int32) data) 0))))
|
||||
(if (= (pickup-type fuel-cell) (-> (the (pointer int32) data) 0))
|
||||
(format *debug-temp-string* "~S" (game-task->string (the-as game-task (-> (the (pointer int32) data) 1))))
|
||||
(format *debug-temp-string* "~D" (-> (the (pointer int32) data) 1))
|
||||
)
|
||||
(if (= (pickup-type buzzer) (-> (the (pointer int32) data) 0))
|
||||
(format *debug-temp-string* " ~S" (game-task->string (the-as game-task (logand #xffff (-> (the (pointer int32) data) 1)))))
|
||||
)
|
||||
)
|
||||
;; fact options, usually enemies or crates
|
||||
;; ((and (= (-> e tag i name) 'options) (= (-> e tag i elt-count) 1) (= (-> e tag i elt-type) uint32))
|
||||
;; (format *debug-temp-string* " (fact-options ")
|
||||
;; (bit-enum->string fact-options (-> (the (pointer uint32) data) 0) *debug-temp-string*)
|
||||
;; (format *debug-temp-string* ")")
|
||||
;; )
|
||||
;; these can be displayed visually with other tools.
|
||||
((and (= (-> e tag i name) 'visvol) (= (-> e tag i elt-count) 2) (= (-> e tag i elt-type) vector))
|
||||
(format *debug-temp-string* " display actor-vis!")
|
||||
)
|
||||
((and (= (-> e tag i name) 'path) (= (-> e tag i elt-type) vector))
|
||||
(format *debug-temp-string* " display path marks!")
|
||||
)
|
||||
((and (= (-> e tag i name) 'vol) (= (-> e tag i elt-type) vector))
|
||||
(format *debug-temp-string* " display vol marks!")
|
||||
)
|
||||
(else
|
||||
;; more generic tag info
|
||||
(dotimes (ii (-> e tag i elt-count))
|
||||
(format *debug-temp-string* " ")
|
||||
(case (-> e tag i elt-type)
|
||||
((string symbol type)
|
||||
(format *debug-temp-string* "~A" (-> (the (pointer basic) data) ii)))
|
||||
((float)
|
||||
(case (-> e tag i name)
|
||||
;; meters are better here
|
||||
(('spring-height 'vis-dist 'height-info 'distance 'cam-notice-dist 'cam-vert 'cam-horz 'idle-distance
|
||||
'nearest-y-threshold 'center-point 'center-radius 'notice-dist 'trigger-height 'notice-top)
|
||||
(format *debug-temp-string* "~mm" (-> (the (pointer float) data) ii))
|
||||
)
|
||||
;; degrees are better for these
|
||||
(('rotoffset 'fov 'rotmin 'rotmax 'tiltmin 'tiltmax 'rotspeed 'spinup-angle)
|
||||
(format *debug-temp-string* "~rdeg" (-> (the (pointer float) data) ii))
|
||||
)
|
||||
(else
|
||||
(format *debug-temp-string* "~f" (-> (the (pointer float) data) ii))
|
||||
)
|
||||
)
|
||||
)
|
||||
((int8) (format *debug-temp-string* "~D" (-> (the (pointer int8) data) ii)))
|
||||
((int16) (format *debug-temp-string* "~D" (-> (the (pointer int16) data) ii)))
|
||||
((int32)
|
||||
(case (-> e tag i name)
|
||||
(('final-pickup 'pickup-type)
|
||||
(format *debug-temp-string* "~S" (pickup-type->string (the-as pickup-type (-> (the (pointer int32) data) ii))))
|
||||
)
|
||||
(('alt-task)
|
||||
(format *debug-temp-string* "~S" (game-task->string (the-as game-task (-> (the (pointer int32) data) ii))))
|
||||
)
|
||||
(else
|
||||
(format *debug-temp-string* "~D" (-> (the (pointer int32) data) ii))
|
||||
)
|
||||
)
|
||||
)
|
||||
((uint8)
|
||||
(case (-> e tag i name)
|
||||
;; not sure
|
||||
(('shadow-mask)
|
||||
(format *debug-temp-string* "#b~b" (-> (the (pointer uint8) data) ii))
|
||||
)
|
||||
(('task)
|
||||
(format *debug-temp-string* "~S" (game-task->string (the-as game-task (-> (the (pointer uint8) data) ii))))
|
||||
)
|
||||
(('task-actor)
|
||||
(format *debug-temp-string* "~S" (game-task-actor->string (the-as game-task-actor (-> (the (pointer uint8) data) ii))))
|
||||
)
|
||||
(else
|
||||
(format *debug-temp-string* "#x~x" (-> (the (pointer uint8) data) ii))
|
||||
)
|
||||
)
|
||||
)
|
||||
((uint16) (format *debug-temp-string* "#x~x" (-> (the (pointer uint16) data) ii)))
|
||||
((uint32)
|
||||
(case (-> e tag i name)
|
||||
;; actually actor-id
|
||||
(('nav-mesh-actor 'open-actor 'trigger-actor 'path-actor 'state-actor 'alt-actor 'next-actor 'prev-actor
|
||||
'spawner-blocker-actor 'spawner-trigger-actor 'kill-actor 'fade-actor 'water-actor 'target-actor 'formation-actor)
|
||||
(format *debug-temp-string* "~%#x~x (~S)" (-> (the (pointer uint32) data) ii)
|
||||
(res-lump-struct (entity-by-aid (-> (the (pointer uint32) data) ii)) 'name string))
|
||||
(+! y-adv 14)
|
||||
)
|
||||
(('enemy-options)
|
||||
(format *debug-temp-string* "~%(~S)" (begin (bit-enum->string enemy-option (-> (the (pointer uint32) data) ii) (clear *temp-string*)) *temp-string*))
|
||||
(+! y-adv 14)
|
||||
)
|
||||
(else
|
||||
(format *debug-temp-string* "#x~x" (-> (the (pointer uint32) data) ii))
|
||||
)
|
||||
)
|
||||
)
|
||||
((uint128)
|
||||
(case (-> e tag i name)
|
||||
(('task)
|
||||
(format *debug-temp-string* "~S" (game-task->string (the-as game-task (-> (the (pointer uint128) data) ii))))
|
||||
)
|
||||
(('task-actor)
|
||||
(format *debug-temp-string* "~S" (game-task-actor->string (the-as game-task-actor (-> (the (pointer uint128) data) ii))))
|
||||
)
|
||||
)
|
||||
)
|
||||
((vector)
|
||||
(case (-> e tag i name)
|
||||
;; guess
|
||||
(('movie-pos)
|
||||
(format *debug-temp-string* "~%(~mm ~mm ~mm ~rdeg)"
|
||||
(-> (the (inline-array vector) data) ii x)
|
||||
(-> (the (inline-array vector) data) ii y)
|
||||
(-> (the (inline-array vector) data) ii z)
|
||||
(-> (the (inline-array vector) data) ii w)
|
||||
)
|
||||
)
|
||||
;; not super useful
|
||||
(('nav-mesh-sphere 'intro)
|
||||
(format *debug-temp-string* "~%(~mm ~mm ~mm ~mm)"
|
||||
(-> (the (inline-array vector) data) ii x)
|
||||
(-> (the (inline-array vector) data) ii y)
|
||||
(-> (the (inline-array vector) data) ii z)
|
||||
(-> (the (inline-array vector) data) ii w)
|
||||
)
|
||||
)
|
||||
(else
|
||||
(format *debug-temp-string* "~%(~f ~f ~f ~f)"
|
||||
(-> (the (inline-array vector) data) ii x)
|
||||
(-> (the (inline-array vector) data) ii y)
|
||||
(-> (the (inline-array vector) data) ii z)
|
||||
(-> (the (inline-array vector) data) ii w)
|
||||
)
|
||||
)
|
||||
)
|
||||
(+! y-adv 14))
|
||||
((pair)
|
||||
(format *debug-temp-string* "~%~A" (-> (the (pointer pair) data) 0))
|
||||
(+! y-adv 14)
|
||||
)
|
||||
((actor-group)
|
||||
(let* ((group (-> (the (pointer actor-group) data) ii))
|
||||
(len (-> group length)))
|
||||
(format *debug-temp-string* "~%group ~D:" ii len)
|
||||
(dotimes (iii len)
|
||||
(format *debug-temp-string* " ~S" (res-lump-struct (entity-by-aid (-> group data iii id)) 'name string))
|
||||
)
|
||||
)
|
||||
(+! y-adv 14)
|
||||
)
|
||||
;; no clue! please report this.
|
||||
(else
|
||||
(format *debug-temp-string* "<unknown res-tag type ~A>" (-> e tag i elt-type))
|
||||
(set! ii (the int (-> e tag i elt-count)))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; draw a string for each tag instead of all at once. allows using smaller strings.
|
||||
(draw-string-xy *debug-temp-string* debug-buf 352 cur-y (font-color default-#cddbcd) (font-flags shadow kerning middle))
|
||||
(+! cur-y y-adv)
|
||||
(set! y-adv 14)
|
||||
|
||||
))
|
||||
;; set max scroll based on how large the whole text was, ignore first 20 lines.
|
||||
(set! (-> inspect-info scroll-y-max) (max 0 (+ -20 (/ (- cur-y begin-y) 14))))
|
||||
|
||||
)
|
||||
)))
|
||||
|
||||
|
||||
@@ -38,8 +38,8 @@
|
||||
|
||||
(defmacro static-pckernel-version (major minor rev build)
|
||||
`(new 'static 'pckernel-version :major ,major :minor ,minor :revision ,rev :build ,build))
|
||||
;; version: 0.0.0.1
|
||||
(defglobalconstant PC_KERNEL_VERSION (static-pckernel-version 0 0 0 1))
|
||||
;; version: 0.0.0.2
|
||||
(defglobalconstant PC_KERNEL_VERSION (static-pckernel-version 0 0 0 2))
|
||||
(defconstant PC_KERNEL_VER_MAJOR (-> PC_KERNEL_VERSION major))
|
||||
(defconstant PC_KERNEL_VER_MINOR (-> PC_KERNEL_VERSION minor))
|
||||
|
||||
@@ -51,6 +51,7 @@
|
||||
|
||||
(discord-rpc? symbol) ;; enable discord rich presence integration
|
||||
(jetboard-trick-text? symbol) ;; enable rendering jetboard trick combo during minigame
|
||||
(display-heap-status symbol)
|
||||
)
|
||||
|
||||
(:methods
|
||||
@@ -92,6 +93,7 @@
|
||||
(set! (-> obj version) PC_KERNEL_VERSION)
|
||||
(set! (-> obj discord-rpc?) #t)
|
||||
(set! (-> obj jetboard-trick-text?) #t)
|
||||
(set! (-> obj display-heap-status) #f)
|
||||
(none))
|
||||
|
||||
(defmacro with-pc (&rest body)
|
||||
|
||||
@@ -318,3 +318,75 @@
|
||||
|
||||
|
||||
(define *pc-settings* (new 'global 'pc-settings))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; entity debugging
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(when *debug-segment*
|
||||
|
||||
(deftype entity-debug-inspect (basic)
|
||||
((scroll-y int16)
|
||||
(scroll-y-max int16)
|
||||
(entity entity)
|
||||
(show-actor-info symbol)
|
||||
)
|
||||
(:methods
|
||||
(new (symbol type) _type_)
|
||||
(set-entity! (_type_ entity) entity)
|
||||
(update-pad (_type_ int) none)
|
||||
)
|
||||
)
|
||||
|
||||
(defmethod new entity-debug-inspect ((allocation symbol) (type-to-make type))
|
||||
"make a new entity-debug-inspect object"
|
||||
|
||||
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
||||
|
||||
(set! (-> obj scroll-y) 0)
|
||||
(set! (-> obj scroll-y-max) 0)
|
||||
(set! (-> obj entity) (the entity #f))
|
||||
(set! (-> obj show-actor-info) #f)
|
||||
obj
|
||||
)
|
||||
)
|
||||
|
||||
(defmethod set-entity! entity-debug-inspect ((obj entity-debug-inspect) (e entity))
|
||||
"set the entity to inspect"
|
||||
|
||||
(set! (-> obj entity) e)
|
||||
(unless e
|
||||
(set! *debug-actor* (the string #f)))
|
||||
(set! (-> obj scroll-y) 0)
|
||||
|
||||
e
|
||||
)
|
||||
|
||||
(defmethod update-pad entity-debug-inspect ((obj entity-debug-inspect) (pad-idx int))
|
||||
"respond to pad inputs"
|
||||
|
||||
;; scroll up
|
||||
(if (cpad-pressed? pad-idx l1)
|
||||
(1-! (-> obj scroll-y)))
|
||||
;; scroll down
|
||||
(if (cpad-pressed? pad-idx r1)
|
||||
(1+! (-> obj scroll-y)))
|
||||
;; toggle actor info
|
||||
(if (cpad-pressed? pad-idx l3)
|
||||
(not! (-> obj show-actor-info)))
|
||||
|
||||
(minmax! (-> obj scroll-y) 0 (-> obj scroll-y-max))
|
||||
|
||||
(none))
|
||||
|
||||
(define *entity-debug-display-part* #f) ;; toggle for displaying part ents in the entity list
|
||||
(define *entity-debug-inspect* (new 'debug 'entity-debug-inspect))
|
||||
|
||||
) ;; when debug_segment
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;; process pools
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; the actor pool for PC processes! it has space for 4 processes, with 16K of space.
|
||||
(define *pc-dead-pool* (new 'global 'dead-pool 4 (* 16 1024) "*pc-dead-pool*"))
|
||||
Reference in New Issue
Block a user