;;-*-Lisp-*- (in-package goal) ;; name: menu.gc ;; name in dgo: menu ;; dgos: GAME, ENGINE ;; this file is debug only (when *debug-segment* ;; Added manually! (declare-type debug-menu basic) (declare-type debug-menu-item basic) (deftype debug-menu-context (basic) ((is-active symbol :offset-assert 4) (sel-length int32 :offset-assert 8) (sel-menu debug-menu 8 :offset-assert 12) (root-menu debug-menu :offset-assert 44) (joypad-func (function basic none) :offset-assert 48) (joypad-item basic :offset-assert 52) (font font-context :offset-assert 56) (is-hidden symbol :offset-assert 60) ) :method-count-assert 9 :size-assert #x40 :flag-assert #x900000040 (:methods (new (symbol type) _type_ 0) ) ) (defmethod new debug-menu-context ((allocation symbol) (type-to-make type)) (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> gp-0 is-active) #f) (set! (-> gp-0 is-hidden) #f) (set! (-> gp-0 sel-length) 0) (set! (-> gp-0 root-menu) #f) (set! (-> gp-0 joypad-func) #f) (set! (-> gp-0 joypad-item) #f) (set! (-> gp-0 font) (new 'debug 'font-context *font-default-matrix* 0 0 0.0 0 (the-as uint 3))) gp-0 ) ) (deftype debug-menu-node (basic) ((name string :offset-assert 4) (parent debug-menu :offset-assert 8) (refresh-delay int32 :offset-assert 12) (refresh-ctr int32 :offset-assert 16) ) :method-count-assert 9 :size-assert #x14 :flag-assert #x900000014 ) (defmethod print debug-menu-node ((obj debug-menu-node)) (format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj) obj ) (deftype debug-menu (debug-menu-node) ((context debug-menu-context :offset-assert 20) (selected-item debug-menu-item :offset-assert 24) (pix-width int32 :offset-assert 28) (pix-height int32 :offset-assert 32) (items pair :offset-assert 36) ) :method-count-assert 9 :size-assert #x28 :flag-assert #x900000028 (:methods (new (symbol type debug-menu-context string) _type_ 0) ) ) (defmethod new debug-menu ((allocation symbol) (type-to-make type) (arg0 debug-menu-context) (arg1 string)) (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> v0-0 context) arg0) (set! (-> v0-0 name) arg1) (set! (-> v0-0 parent) #f) (set! (-> v0-0 selected-item) #f) (set! (-> v0-0 items) '()) v0-0 ) ) (deftype debug-menu-item (debug-menu-node) ((id int32 :offset-assert 20) ) :method-count-assert 9 :size-assert #x18 :flag-assert #x900000018 ) (deftype debug-menu-item-submenu (debug-menu-item) ((submenu debug-menu :offset-assert 24) ) :method-count-assert 9 :size-assert #x1c :flag-assert #x90000001c (:methods (new (symbol type string debug-menu) _type_ 0) ) ) (defmethod new debug-menu-item-submenu ((allocation symbol) (type-to-make type) (arg0 string) (arg1 debug-menu)) (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> v0-0 name) arg0) (set! (-> v0-0 parent) #f) (set! (-> v0-0 refresh-delay) 0) (set! (-> v0-0 refresh-ctr) (-> v0-0 refresh-delay)) (set! (-> v0-0 submenu) arg1) (set! (-> v0-0 submenu parent) (the-as debug-menu v0-0)) v0-0 ) ) (deftype debug-menu-item-function (debug-menu-item) ((activate-func (function int int) :offset-assert 24) (hilite-timer int8 :offset-assert 28) ) :method-count-assert 9 :size-assert #x1d :flag-assert #x90000001d (:methods (new (symbol type string int function) _type_ 0) ) ) (defmethod new debug-menu-item-function ((allocation symbol) (type-to-make type) (arg0 string) (arg1 int) (arg2 function)) (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> v0-0 name) arg0) (set! (-> v0-0 parent) #f) (set! (-> v0-0 refresh-delay) 0) (set! (-> v0-0 refresh-ctr) (-> v0-0 refresh-delay)) (set! (-> v0-0 id) arg1) (set! (-> v0-0 activate-func) (the-as (function int int) arg2)) (set! (-> v0-0 hilite-timer) 0) v0-0 ) ) (deftype debug-menu-item-flag (debug-menu-item) ((activate-func (function int int symbol) :offset-assert 24) (is-on symbol :offset-assert 28) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 (:methods (new (symbol type string symbol function) _type_ 0) ) ) (defmethod new debug-menu-item-flag ((allocation symbol) (type-to-make type) (arg0 string) (arg1 symbol) (arg2 function)) (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> v0-0 name) arg0) (set! (-> v0-0 parent) #f) (set! (-> v0-0 refresh-delay) 23) (set! (-> v0-0 refresh-ctr) (-> v0-0 refresh-delay)) (set! (-> v0-0 id) (the-as int arg1)) (set! (-> v0-0 activate-func) (the-as (function int int symbol) arg2)) (set! (-> v0-0 is-on) #f) v0-0 ) ) (deftype debug-menu-item-var (debug-menu-item) ((display-str string :offset-assert 24) (grabbed-joypad-p symbol :offset-assert 28) (float-p symbol :offset-assert 32) (range-p symbol :offset-assert 36) (show-len int32 :offset-assert 40) (inc-delay int32 :offset-assert 44) (inc-delay-ctr int32 :offset-assert 48) (step-delay-ctr int32 :offset-assert 52) (inc-dir int32 :offset-assert 56) (fval float :offset-assert 60) (fundo-val float :offset-assert 64) (frange-min float :offset-assert 68) (frange-max float :offset-assert 72) (fstart-inc float :offset-assert 76) (fstep float :offset-assert 80) (fprecision int32 :offset-assert 84) (factivate-func (function int int float float float) :offset-assert 88) (ival int32 :offset 60) (iundo-val int32 :offset 64) (irange-min int32 :offset 68) (irange-max int32 :offset 72) (istart-inc int32 :offset 76) (istep int32 :offset 80) (ihex-p symbol :offset-assert 92) (iactivate-func (function int int int int int) :offset 88) (ifloat-p symbol :offset-assert 96) ) :method-count-assert 9 :size-assert #x64 :flag-assert #x900000064 (:methods (new (symbol type string int int) _type_ 0) ) ) ;; TODO - added manually (define-extern debug-menu-context-send-msg (function debug-menu-context int int debug-menu-context)) (define-extern debug-menu-make-from-template (function debug-menu-context pair debug-menu-node)) (define-extern debug-menu-item-send-msg (function debug-menu-item int debug-menu-item)) (define-extern debug-menu-item-var-render (function debug-menu-item-var int int int symbol debug-menu-item-var)) (define-extern debug-menu-send-msg (function debug-menu int symbol debug-menu)) (defun debug-menu-item-var-update-display-str ((arg0 debug-menu-item-var)) (cond ((-> arg0 float-p) (format (clear (-> arg0 display-str)) "~f" (-> arg0 fval)) ) ((-> arg0 ihex-p) (format (clear (-> arg0 display-str)) "x~X" (-> arg0 fval)) ) ((-> arg0 ifloat-p) (cond ((and (< (the-as int (-> arg0 fval)) 0) (< -100 (the-as int (-> arg0 fval))) ) (let ((v1-8 (abs (the-as int (-> arg0 fval))))) (format (clear (-> arg0 display-str)) "-0.~1d" (/ (mod v1-8 100) 10)) ) ) (else (let ((v1-12 (abs (the-as int (-> arg0 fval))))) (format (clear (-> arg0 display-str)) "~2d.~1d" (/ (the-as int (-> arg0 fval)) 100) (/ (mod v1-12 100) 10)) ) ) ) ) (else (format (clear (-> arg0 display-str)) "~D" (-> arg0 fval)) ) ) arg0 ) (defun debug-menu-item-var-make-int ((arg0 debug-menu-item-var) (arg1 (function int int int int int)) (arg2 int) (arg3 symbol) (arg4 int) (arg5 int) (arg6 symbol) ) (set! (-> arg0 float-p) #f) (set! (-> arg0 range-p) arg3) (set! (-> arg0 irange-min) arg4) (set! (-> arg0 irange-max) arg5) (set! (-> arg0 istart-inc) arg2) (set! (-> arg0 istep) arg2) (set! (-> arg0 ihex-p) arg6) (set! (-> arg0 iactivate-func) arg1) (if arg3 (set! (-> arg0 ival) arg4) (set! (-> arg0 ival) 0) ) (if arg1 (set! (-> arg0 ival) (arg1 (-> arg0 id) 3 (-> arg0 ival) (-> arg0 ival))) ) (debug-menu-item-var-update-display-str arg0) arg0 ) (defun debug-menu-item-var-make-float ((arg0 debug-menu-item-var) (arg1 (function int int float float float)) (arg2 float) (arg3 symbol) (arg4 float) (arg5 float) (arg6 int) ) (set! (-> arg0 float-p) #t) (set! (-> arg0 range-p) arg3) (set! (-> arg0 frange-min) arg4) (set! (-> arg0 frange-max) arg5) (set! (-> arg0 fstart-inc) arg2) (set! (-> arg0 fstep) arg2) (set! (-> arg0 fprecision) arg6) (set! (-> arg0 factivate-func) arg1) (if arg3 (set! (-> arg0 fval) arg4) (set! (-> arg0 fval) 0.0) ) (if arg1 (set! (-> arg0 fval) (the float (arg1 (-> arg0 id) 3 (-> arg0 fval) (-> arg0 fval)))) ) (debug-menu-item-var-update-display-str arg0) arg0 ) (defmethod new debug-menu-item-var ((allocation symbol) (type-to-make type) (arg0 string) (arg1 int) (arg2 int)) (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (let ((v1-2 (/ arg2 8))) (set! (-> gp-0 name) arg0) (set! (-> gp-0 parent) #f) (set! (-> gp-0 refresh-delay) 31) (set! (-> gp-0 refresh-ctr) (-> gp-0 refresh-delay)) (set! (-> gp-0 id) arg1) (set! v1-2 (if (< 3 v1-2) v1-2 3 ) ) (set! (-> gp-0 show-len) v1-2) ) (set! (-> gp-0 grabbed-joypad-p) #f) (set! (-> gp-0 ifloat-p) #f) (set! (-> gp-0 display-str) (new 'debug 'string 64 (the-as string #f))) (debug-menu-item-var-make-int gp-0 (the-as (function int int int int int) #f) 1 #t 0 0 #f) gp-0 ) ) (defun debug-menu-context-grab-joypad ((arg0 debug-menu-context) (arg1 basic) (arg2 function)) (cond ((-> arg0 joypad-func) #f ) (else (set! (-> arg0 joypad-func) (the-as (function basic none) arg2)) (set! (-> arg0 joypad-item) arg1) #t ) ) ) (defun debug-menu-context-release-joypad ((arg0 debug-menu-context)) (set! (-> arg0 joypad-func) #f) (set! (-> arg0 joypad-item) #f) #f ) (defun debug-menu-item-get-max-width ((arg0 debug-menu-item) (arg1 debug-menu)) (local-vars (v0-1 int)) 0 (cond ((= (-> arg0 type) debug-menu-item-submenu) (set! v0-1 (+ (the int (get-string-length (-> arg0 name) (-> arg1 context font))) 16)) ) ((= (-> arg0 type) debug-menu-item-var) (set! v0-1 (the int (get-string-length (-> (the-as debug-menu-item-var arg0) display-str) (-> arg1 context font)))) ) (else (set! v0-1 (+ (the int (get-string-length (-> arg0 name) (-> arg1 context font))) 6)) ) ) v0-1 ) (defun debug-menu-context-default-selection ((arg0 debug-menu-context) (arg1 symbol)) (when (or (zero? (-> arg0 sel-length)) (not arg1)) (let ((s5-0 (-> arg0 root-menu))) (when (and s5-0 (not (null? (-> s5-0 items)))) (let ((s4-0 (-> arg0 is-active))) (if s4-0 (debug-menu-context-send-msg arg0 2 0) ) (set! (-> arg0 sel-length) 1) (set! (-> arg0 sel-menu 0) s5-0) (set! (-> s5-0 selected-item) (the-as debug-menu-item (car (-> s5-0 items)))) (if s4-0 (debug-menu-context-send-msg arg0 1 0) ) ) ) ) ) arg0 ) (defun debug-menu-rebuild ((arg0 debug-menu)) (let ((s4-0 0) (s5-0 0) ) (let* ((s3-0 (-> arg0 items)) (a0-1 (car s3-0)) ) (while (not (null? s3-0)) (+! s5-0 1) (set! (-> (the-as debug-menu-item a0-1) parent) arg0) (set! s4-0 (max s4-0 (debug-menu-item-get-max-width (the-as debug-menu-item a0-1) arg0))) (set! s3-0 (cdr s3-0)) (set! a0-1 (car s3-0)) ) ) (set! (-> arg0 pix-width) (+ s4-0 18)) (set! (-> arg0 pix-height) (+ (* s5-0 8) 6)) ) (let ((a0-2 (-> arg0 context))) (debug-menu-context-default-selection a0-2 #t) ) arg0 ) (defun debug-menu-context-set-root-menu ((arg0 debug-menu-context) (arg1 debug-menu)) (let ((s4-0 (-> arg0 is-active))) (if s4-0 (debug-menu-context-send-msg arg0 2 0) ) (set! (-> arg0 root-menu) arg1) (debug-menu-context-default-selection arg0 #f) (if s4-0 (debug-menu-context-send-msg arg0 1 0) ) ) arg0 ) (defun debug-menu-append-item ((arg0 debug-menu) (arg1 debug-menu-item)) (let* ((gp-0 (-> arg0 context)) (s4-0 (-> gp-0 is-active)) ) (if s4-0 (debug-menu-context-send-msg gp-0 2 0) ) (set! (-> arg1 parent) arg0) (set! (-> arg0 items) (the-as pair (append! (-> arg0 items) (cons arg1 '())))) (debug-menu-rebuild arg0) (if s4-0 (debug-menu-context-send-msg gp-0 1 0) ) ) arg1 ) (defun debug-menu-remove-all-items ((arg0 debug-menu)) (let* ((gp-0 (-> arg0 context)) (s4-0 (-> gp-0 is-active)) ) (if s4-0 (debug-menu-context-send-msg gp-0 2 0) ) (set! (-> arg0 items) '()) (set! (-> arg0 selected-item) #f) (debug-menu-rebuild arg0) (if s4-0 (debug-menu-context-send-msg gp-0 1 0) ) ) arg0 ) (defun debug-menu-func-decode ((arg0 object)) (let ((v1-1 (rtype-of arg0))) (the-as function (cond ((or (= v1-1 symbol) (= v1-1 type)) (the-as symbol (-> (the-as symbol arg0) value)) ) ((= v1-1 function) (the-as symbol arg0) ) (else (the-as symbol nothing) ) ) ) ) ) (defun debug-menu-make-from-template ((arg0 debug-menu-context) (arg1 pair)) (local-vars (s5-0 debug-menu-node) (sv-16 object) (sv-32 int) (sv-48 float) (sv-64 float) (sv-80 float) (sv-96 float) ) (when (or (not arg1) (null? arg1)) (set! s5-0 (the-as debug-menu-node #f)) (goto cfg-41) ) (let ((s4-0 (car arg1)) (s5-1 (the-as string (cadr arg1))) ) (cond ((= s4-0 'menu) (let ((s4-1 (new 'debug 'debug-menu arg0 s5-1))) (set! s5-0 (new 'debug 'debug-menu-item-submenu s5-1 s4-1)) (let* ((gp-1 (cddr arg1)) (a1-3 (car gp-1)) ) (while (not (null? gp-1)) (let ((a1-4 (debug-menu-make-from-template arg0 (the-as pair a1-3)))) (if a1-4 (debug-menu-append-item s4-1 (the-as debug-menu-item a1-4)) ) ) (set! gp-1 (cdr gp-1)) (set! a1-3 (car gp-1)) ) ) ) ) ((= s4-0 'main-menu) (set! s5-0 (new 'debug 'debug-menu arg0 s5-1)) (let* ((gp-2 (cddr arg1)) (a1-6 (car gp-2)) ) (while (not (null? gp-2)) (let ((a1-7 (debug-menu-make-from-template arg0 (the-as pair a1-6)))) (if a1-7 (debug-menu-append-item (the-as debug-menu s5-0) (the-as debug-menu-item a1-7)) ) ) (set! gp-2 (cdr gp-2)) (set! a1-6 (car gp-2)) ) ) (debug-menu-context-set-root-menu arg0 (the-as debug-menu s5-0)) ) (else (set! s5-0 (cond ((= s4-0 'flag) (new 'debug 'debug-menu-item-flag s5-1 (the-as symbol (caddr arg1)) (debug-menu-func-decode (cadddr arg1))) ) ((or (= s4-0 0) (= s4-0 'function)) (new 'debug 'debug-menu-item-function s5-1 (the-as int (caddr arg1)) (debug-menu-func-decode (cadddr arg1))) ) ((= s4-0 'var) (new 'debug 'debug-menu-item-var s5-1 (the-as int (caddr arg1)) (the-as int (cadddr arg1))) ) ((or (= s4-0 'int-var) (= s4-0 'int-var-gat1) (= s4-0 'hex-var) ) (set! s5-0 (new 'debug 'debug-menu-item-var s5-1 (the-as int (caddr arg1)) (the-as int (ref arg1 4)))) (debug-menu-item-var-make-int (the-as debug-menu-item-var s5-0) (the-as (function int int int int int) (debug-menu-func-decode (cadddr arg1))) (/ (the-as int (ref arg1 5)) 8) (the-as symbol (ref arg1 6)) (/ (the-as int (ref arg1 7)) 8) (/ (the-as int (ref arg1 8)) 8) (= s4-0 'hex-var) ) (set! (-> (the-as debug-menu-item-var s5-0) ifloat-p) #t) s5-0 ) ((= s4-0 'float-var) (set! s5-0 (new 'debug 'debug-menu-item-var s5-1 (the-as int (cddr arg1)) (the-as int (ref arg1 4)))) (debug-menu-item-var-make-float (the-as debug-menu-item-var s5-0) (the-as (function int int float float float) (debug-menu-func-decode (cadddr arg1))) (the float (/ (the-as int (ref arg1 5)) 8)) (the-as symbol (ref arg1 6)) (the float (/ (the-as int (ref arg1 7)) 8)) (the float (/ (the-as int (ref arg1 8)) 8)) (/ (the-as int (ref arg1 9)) 8) ) s5-0 ) ((= s4-0 'float-fixed-var) (set! s5-0 (new 'debug 'debug-menu-item-var s5-1 (the-as int (caddr arg1)) (the-as int (ref arg1 4)))) (debug-menu-item-var-make-float (the-as debug-menu-item-var s5-0) (the-as (function int int float float float) (debug-menu-func-decode (cadddr arg1))) (* 0.001 (the float (/ (the-as int (ref arg1 5)) 8))) (the-as symbol (ref arg1 6)) (* 0.001 (the float (/ (the-as int (ref arg1 7)) 8))) (* 0.001 (the float (/ (the-as int (ref arg1 8)) 8))) (/ (the-as int (ref arg1 9)) 8) ) s5-0 ) (else (the-as debug-menu-node #f) ) ) ) ) ) ) (label cfg-41) s5-0 ) (defun debug-menu-find-from-template ((arg0 debug-menu-context) (arg1 pair)) (let ((s4-0 (the-as object (-> arg0 root-menu)))) (while (begin (label cfg-17) (and s4-0 (type-type? (-> (the-as debug-menu-node s4-0) type) debug-menu) (not (null? arg1)) ) ) (let ((s3-0 (-> (the-as debug-menu s4-0) items)) (s4-1 (the-as string (car arg1))) ) (set! arg1 (cdr arg1)) (let ((s5-0 (car s3-0))) (while (not (null? s3-0)) (when (string= s4-1 (-> (the-as debug-menu-item s5-0) name)) (if (type-type? (rtype-of s5-0) debug-menu-item-submenu) (set! s4-0 (-> (the-as debug-menu-item-submenu s5-0) submenu)) (set! s4-0 s5-0) ) (goto cfg-17) ) (set! s3-0 (cdr s3-0)) (set! s5-0 (car s3-0)) ) ) ) (set! s4-0 #f) (goto cfg-24) ) (label cfg-24) (the-as debug-menu s4-0) ) ) (defun debug-menu-item-submenu-render ((arg0 debug-menu-item-submenu) (arg1 int) (arg2 int) (arg3 int) (arg4 symbol)) (let ((s5-0 (-> arg0 parent context font))) (set-origin! s5-0 arg1 arg2) (set! (-> s5-0 color) (cond ((zero? arg3) 12) (arg4 11) (else 13) )) (with-dma-buffer-add-bucket ((s3-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string-adv (-> arg0 name) s3-0 s5-0) (draw-string-adv "..." s3-0 s5-0) ) ) arg0 ) (defun debug-menu-item-function-render ((arg0 debug-menu-item-function) (arg1 int) (arg2 int) (arg3 int) (arg4 symbol)) (let ((v1-2 (-> arg0 parent context font))) (set-origin! v1-2 arg1 arg2) (set! (-> v1-2 color) (cond ((> (-> arg0 hilite-timer) 0) (1-! (-> arg0 hilite-timer)) 10 ) ((< (-> arg0 hilite-timer) 0) (1+! (-> arg0 hilite-timer)) 14 ) ((nonzero? arg3) 13 ) (else 12 ) ) ) (with-dma-buffer-add-bucket ((s4-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string (-> arg0 name) s4-0 v1-2) ) ) arg0 ) (defun debug-menu-item-flag-render ((arg0 debug-menu-item-flag) (arg1 int) (arg2 int) (arg3 int) (arg4 symbol)) (let ((v1-2 (-> arg0 parent context font))) (set-origin! v1-2 arg1 arg2) (set! (-> v1-2 color) (cond ((= (-> arg0 is-on) 'invalid) 19 ) ((-> arg0 is-on) (if (zero? arg3) 15 16 ) ) ((zero? arg3) 17 ) (else 18 ) ) ) (with-dma-buffer-add-bucket ((s4-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string (-> arg0 name) s4-0 v1-2) ) ) arg0 ) (defun debug-menu-item-var-render ((arg0 debug-menu-item-var) (arg1 int) (arg2 int) (arg3 int) (arg4 symbol)) (let ((s5-0 (-> arg0 parent context font))) (set-origin! s5-0 arg1 arg2) (set! (-> s5-0 color) (cond ((zero? arg3) (if (-> arg0 grabbed-joypad-p) 10 12 ) ) (arg4 11 ) (else 13 ) ) ) (with-dma-buffer-add-bucket ((s1-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string-adv (-> arg0 name) s1-0 s5-0) (draw-string-adv ":" s1-0 s5-0) (cond ((>= (-> arg0 show-len) (length (-> arg0 display-str))) (draw-string (-> arg0 display-str) s1-0 s5-0) ) (else (draw-string "..." s1-0 s5-0) (set! arg4 (and (zero? arg3) arg4)) (when arg4 (set-origin! s5-0 20 204) (draw-string-adv (-> arg0 name) s1-0 s5-0) (draw-string-adv ":" s1-0 s5-0) (draw-string (-> arg0 display-str) s1-0 s5-0) ) ) ) ) ) arg0 ) (defun debug-menu-item-render ((arg0 debug-menu-item) (arg1 int) (arg2 int) (arg3 int) (arg4 symbol)) (when (> (-> arg0 refresh-delay) 0) (+! (-> arg0 refresh-ctr) -1) (when (<= (-> arg0 refresh-ctr) 0) (set! (-> arg0 refresh-ctr) (-> arg0 refresh-delay)) (debug-menu-item-send-msg arg0 3) ) ) (cond ((= (-> arg0 type) debug-menu-item-submenu) (debug-menu-item-submenu-render (the-as debug-menu-item-submenu arg0) arg1 arg2 arg3 arg4) ) ((= (-> arg0 type) debug-menu-item-function) (debug-menu-item-function-render (the-as debug-menu-item-function arg0) arg1 arg2 arg3 arg4) ) ((= (-> arg0 type) debug-menu-item-flag) (debug-menu-item-flag-render (the-as debug-menu-item-flag arg0) arg1 arg2 arg3 arg4) ) ((= (-> arg0 type) debug-menu-item-var) (debug-menu-item-var-render (the-as debug-menu-item-var arg0) arg1 arg2 arg3 arg4) ) (else (format 0 "ERROR: Found unknown item type!~%") ) ) arg0 ) (defun debug-menu-render ((arg0 debug-menu) (arg1 int) (arg2 int) (arg3 int) (arg4 int)) (let ((v1-0 0)) (let* ((a0-1 (-> arg0 items)) (a1-1 (car a0-1)) ) (while (not (null? a0-1)) (if (= a1-1 arg3) (goto cfg-7) ) (+! v1-0 1) (set! a0-1 (cdr a0-1)) (set! a1-1 (car a0-1)) ) ) (label cfg-7) (if (< 16 v1-0) (set! arg2 (- arg2 (* (+ v1-0 -16) 8))) ) ) (with-dma-buffer-add-bucket ((s0-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-sprite2d-xy s0-0 arg1 arg2 (-> arg0 pix-width) (-> arg0 pix-height) (static-rgba #x00 #x00 #x00 #x40)) ) (let* ((s3-1 (+ arg1 3)) (s2-1 (+ arg2 3)) (s1-1 (-> arg0 items)) (s0-1 (car s1-1)) ) (while (not (null? s1-1)) (when (= s0-1 arg3) (set! (-> arg0 context font color) (if (nonzero? arg4) 13 12 ) ) (set-origin! (-> arg0 context font) s3-1 s2-1) (with-dma-buffer-add-bucket ((sv-16 (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string ">" sv-16 (-> arg0 context font)) ) ) (debug-menu-item-render (the-as debug-menu-item s0-1) (+ s3-1 12) s2-1 arg4 (= s0-1 arg3)) (+! s2-1 8) (set! s1-1 (cdr s1-1)) (set! s0-1 (car s1-1)) ) ) arg0 ) (defun debug-menu-context-render ((arg0 debug-menu-context)) (let ((s4-0 6)) (dotimes (s5-0 (-> arg0 sel-length)) (let ((s3-0 (-> arg0 sel-menu s5-0))) (let ((a3-0 (-> s3-0 selected-item))) (debug-menu-render s3-0 s4-0 28 (the-as int a3-0) (+ (- -1 s5-0) (-> arg0 sel-length))) ) (set! s4-0 (+ (+ s4-0 3) (-> s3-0 pix-width))) ) ) ) arg0 ) (defun debug-menu-context-select-next-or-prev-item ((arg0 debug-menu-context) (arg1 int)) (local-vars (v1-6 object)) (let ((s5-0 (-> arg0 sel-menu (+ (-> arg0 sel-length) -1)))) (let ((a2-0 (-> s5-0 selected-item)) (a0-1 '()) (v1-4 '()) ) (let ((a3-0 (-> s5-0 items))) (while (not (null? a3-0)) (if (= (car a3-0) a2-0) (begin (set! v1-4 a3-0) (goto cfg-7) ) ) (set! a0-1 a3-0) (set! a3-0 (cdr a3-0)) ) ) (label cfg-7) (if (null? v1-4) (begin (format 0 "ERROR: Couldn't find selected item in menu.~%") (set! arg0 arg0) (goto cfg-19) ) ) (cond ((>= arg1 0) (if (null? (cdr v1-4)) (set! v1-6 (car (-> s5-0 items))) (set! v1-6 (car (cdr v1-4))) ) ) ((null? a0-1) (set! v1-6 (car (last (-> s5-0 items)))) ) (else (set! v1-6 (car a0-1)) ) ) ) (set! (-> s5-0 selected-item) (the-as debug-menu-item v1-6)) ) (label cfg-19) arg0 ) (defun debug-menu-context-select-new-item ((arg0 debug-menu-context) (arg1 int)) (let* ((a2-0 (-> arg0 sel-menu (+ (-> arg0 sel-length) -1))) (a1-1 (-> a2-0 selected-item)) (a0-1 0) (v1-4 -1) ) (let ((a2-1 (-> a2-0 items))) (while (not (null? a2-1)) (if (= (car a2-1) a1-1) (set! v1-4 a0-1) ) (set! a2-1 (cdr a2-1)) (+! a0-1 1) ) ) (if (= v1-4 -1) (begin (format 0 "ERROR: Couldn't find selected item in menu.~%") (set! arg0 arg0) (goto cfg-25) ) ) (cond ((>= arg1 0) (cond ((= v1-4 (+ a0-1 -1)) (set! arg1 1) ) ((>= (+ v1-4 arg1) a0-1) (set! arg1 (+ (- -1 v1-4) a0-1)) ) ) (dotimes (s4-0 arg1) (debug-menu-context-select-next-or-prev-item arg0 1) ) ) (else (cond ((zero? v1-4) (set! arg1 -1) ) ((< (+ v1-4 arg1) 0) (set! arg1 (- v1-4)) ) ) (dotimes (s4-1 (- arg1)) (debug-menu-context-select-next-or-prev-item arg0 -1) ) ) ) ) (label cfg-25) arg0 ) (defun debug-menu-context-open-submenu ((arg0 debug-menu-context) (arg1 debug-menu)) (let ((v1-0 (-> arg0 sel-length))) (when (>= v1-0 8) (format 0 "ERROR: Trying to exceed maximum menu depth!") (return arg1) ) (when (null? (-> arg1 items)) (format 0 "ERROR: Submenu has no items!") (return arg1) ) (set! (-> arg0 sel-menu v1-0) arg1) (if (not (-> arg1 selected-item)) (set! (-> arg1 selected-item) (the-as debug-menu-item (-> arg1 items car))) ) (set! (-> arg0 sel-length) (+ v1-0 1)) ) (debug-menu-context-send-msg arg0 1 3) ) (defun debug-menu-context-close-submenu ((arg0 debug-menu-context)) (debug-menu-context-send-msg arg0 2 3) (if (< 1 (-> arg0 sel-length)) (+! (-> arg0 sel-length) -1) ) arg0 ) (defun debug-menu-item-submenu-msg ((arg0 debug-menu-item-submenu) (arg1 int)) (when (= arg1 4) (let ((a0-1 (-> arg0 parent context))) (debug-menu-context-open-submenu a0-1 (-> arg0 submenu)) ) ) arg0 ) (defun debug-menu-item-function-msg ((arg0 debug-menu-item-function) (arg1 symbol)) (cond ((= arg1 4) (cond ((-> arg0 activate-func) (if ((-> arg0 activate-func) (-> arg0 id)) (set! (-> arg0 hilite-timer) 6) (set! (-> arg0 hilite-timer) -6) ) ) (else (set! (-> arg0 hilite-timer) -6) ) ) ) ((= arg1 2) (set! (-> arg0 hilite-timer) 0) ) ) arg0 ) (defun debug-menu-item-flag-msg ((arg0 debug-menu-item-flag) (arg1 int)) (cond ((= arg1 4) (if (-> arg0 activate-func) (set! (-> arg0 is-on) ((-> arg0 activate-func) (-> arg0 id) 4)) ) (let ((a0-2 (-> arg0 parent context))) (debug-menu-context-send-msg a0-2 3 2) ) ) ((or (= arg1 3) (= arg1 1)) (if (-> arg0 activate-func) (set! (-> arg0 is-on) ((-> arg0 activate-func) (-> arg0 id) 3)) ) (set! (-> arg0 refresh-ctr) (-> arg0 refresh-delay)) ) ) arg0 ) (defun debug-menu-item-var-joypad-handler ((arg0 debug-menu-item-var)) (cond ((not (cpad-hold? 0 x)) (let ((a0-1 (-> arg0 parent context))) (debug-menu-context-release-joypad a0-1) ) (set! (-> arg0 grabbed-joypad-p) #f) (when (cpad-pressed? 0 circle) (cond ((-> arg0 float-p) (if (-> arg0 factivate-func) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) 4 (-> arg0 fundo-val) (-> arg0 fval))) ) ) (else (if (-> arg0 iactivate-func) (set! (-> arg0 ival) ((-> arg0 iactivate-func) (-> arg0 id) 4 (-> arg0 iundo-val) (-> arg0 ival))) ) ) ) (debug-menu-item-var-update-display-str arg0) ) (let ((a0-5 (-> arg0 parent context))) (debug-menu-context-send-msg a0-5 3 2) ) ) ((or (cpad-hold? 0 right) (cpad-hold? 0 left) (cpad-hold? 0 down) (cpad-hold? 0 up) ) (let ((v1-39 (cond ((cpad-hold? 0 right) 10) ((cpad-hold? 0 up) 1) ((cpad-hold? 0 down) -1) (else -10) ))) (when (!= v1-39 (-> arg0 inc-dir)) (set! (-> arg0 inc-dir) v1-39) (set! (-> arg0 inc-delay) 15) (set! (-> arg0 inc-delay-ctr) 0) (set! (-> arg0 step-delay-ctr) 30) (set! (-> arg0 fstep) (-> arg0 fstart-inc)) (set! (-> arg0 fstep) (-> arg0 fstart-inc)) ) ) (cond ((<= (-> arg0 inc-delay-ctr) 0) (if (> (-> arg0 inc-delay) 0) (+! (-> arg0 inc-delay) -1) ) (when (zero? (-> arg0 inc-delay)) (cond ((<= (-> arg0 step-delay-ctr) 0) (set! (-> arg0 step-delay-ctr) 30) (cond ((-> arg0 float-p) (if (< (-> arg0 fstep) 10000000.0) (set! (-> arg0 fstep) (* 2.0 (-> arg0 fstep))) ) ) (else (if (< (-> arg0 istep) 10000000) (set! (-> arg0 istep) (* 2 (-> arg0 istep))) ) ) ) ) (else (+! (-> arg0 step-delay-ctr) -1) ) ) ) (set! (-> arg0 inc-delay-ctr) (-> arg0 inc-delay)) (cond ((-> arg0 float-p) (when (-> arg0 factivate-func) (let ((f0-8 (+ (-> arg0 fval) (* (the float (-> arg0 inc-dir)) (-> arg0 fstep))))) (if (-> arg0 range-p) (set! f0-8 (fmin (fmax f0-8 (-> arg0 frange-min)) (-> arg0 frange-max)) ) ) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) 4 f0-8 (-> arg0 fval))) ) ) ) (else (when (-> arg0 iactivate-func) (let ((a2-4 (+ (-> arg0 ival) (* (-> arg0 inc-dir) (-> arg0 istep))))) (if (-> arg0 range-p) (set! a2-4 (min (max a2-4 (-> arg0 irange-min)) (-> arg0 irange-max))) ) (set! (-> arg0 ival) ((-> arg0 iactivate-func) (-> arg0 id) 4 a2-4 (-> arg0 ival))) ) ) ) ) (debug-menu-item-var-update-display-str arg0) (let ((a0-20 (-> arg0 parent context))) (debug-menu-context-send-msg a0-20 3 3) ) ) (else (+! (-> arg0 inc-delay-ctr) -1) ) ) ) (else (set! (-> arg0 inc-dir) 0) ) ) arg0 ) (defun debug-menu-item-var-msg ((arg0 debug-menu-item-var) (arg1 int)) (cond ((= arg1 2) (when (-> arg0 grabbed-joypad-p) (let ((a0-1 (-> arg0 parent context))) (debug-menu-context-release-joypad a0-1) ) (set! (-> arg0 grabbed-joypad-p) #f) ) ) ((= arg1 4) (when (not (-> arg0 grabbed-joypad-p)) (let ((a0-2 (-> arg0 parent context))) (when (debug-menu-context-grab-joypad a0-2 arg0 debug-menu-item-var-joypad-handler) (set! (-> arg0 grabbed-joypad-p) #t) (set! (-> arg0 fundo-val) (-> arg0 fval)) (set! (-> arg0 fundo-val) (-> arg0 fval)) (set! (-> arg0 inc-dir) 0) ) ) ) ) ((or (= arg1 3) (= arg1 1)) (cond ((-> arg0 float-p) (if (-> arg0 factivate-func) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) 3 (-> arg0 fval) (-> arg0 fval))) ) ) (else (if (-> arg0 iactivate-func) (set! (-> arg0 ival) ((-> arg0 iactivate-func) (-> arg0 id) 3 (-> arg0 ival) (-> arg0 ival))) ) ) ) (debug-menu-item-var-update-display-str arg0) (set! (-> arg0 refresh-ctr) (-> arg0 refresh-delay)) ) ) arg0 ) (defun debug-menu-item-send-msg ((arg0 debug-menu-item) (arg1 int)) (cond ((= (-> arg0 type) debug-menu-item-submenu) (debug-menu-item-submenu-msg (the-as debug-menu-item-submenu arg0) arg1) ) ((= (-> arg0 type) debug-menu-item-function) (debug-menu-item-function-msg (the-as debug-menu-item-function arg0) (the-as symbol arg1)) ) ((= (-> arg0 type) debug-menu-item-flag) (debug-menu-item-flag-msg (the-as debug-menu-item-flag arg0) arg1) ) ((= (-> arg0 type) debug-menu-item-var) (debug-menu-item-var-msg (the-as debug-menu-item-var arg0) arg1) ) (else (format 0 "ERROR: Found unknown item type!~%") ) ) arg0 ) (defun debug-menu-send-msg ((arg0 debug-menu) (arg1 int) (arg2 symbol)) (let* ((s3-0 (-> arg0 items)) (s2-0 (car s3-0)) ) (while (not (null? s3-0)) (debug-menu-item-send-msg (the-as debug-menu-item s2-0) arg1) (if (and arg2 (= (-> (the-as debug-menu-item s2-0) type) debug-menu-item-submenu)) (debug-menu-send-msg (-> (the-as debug-menu-item-submenu s2-0) submenu) arg1 #t) ) (set! s3-0 (cdr s3-0)) (set! s2-0 (car s3-0)) ) ) arg0 ) (defun debug-menu-context-send-msg ((arg0 debug-menu-context) (arg1 int) (arg2 int)) (cond ((= arg2 1) (debug-menu-send-msg (-> arg0 root-menu) arg1 #t) ) ((= arg2 2) (when (-> arg0 is-active) (dotimes (s4-0 (-> arg0 sel-length)) (let ((a0-2 (-> arg0 sel-menu s4-0))) (debug-menu-send-msg a0-2 arg1 #f) ) ) ) ) ((= arg2 3) (when (-> arg0 is-active) (if (nonzero? (-> arg0 sel-length)) (debug-menu-send-msg (-> arg0 sel-menu (+ (-> arg0 sel-length) -1)) arg1 #f) ) ) ) ((= arg2 0) (cond ((= arg1 1) (when (not (-> arg0 is-active)) (set! (-> arg0 is-active) #t) (debug-menu-context-send-msg arg0 1 2) ) ) ((= arg1 2) (when (-> arg0 is-active) (debug-menu-context-send-msg arg0 2 2) (set! (-> arg0 is-active) #f) ) ) ) ) ) arg0 ) (defun debug-menu-context-activate-selection ((arg0 debug-menu-context)) (let ((a0-1 (-> arg0 sel-menu (+ (-> arg0 sel-length) -1) selected-item))) (debug-menu-item-send-msg a0-1 4) ) arg0 ) (defun debug-menus-default-joypad-func ((arg0 debug-menu-context)) (cond ((cpad-pressed? 0 square) (if (< 1 (-> arg0 sel-length)) (debug-menu-context-close-submenu arg0) ) ) ((cpad-pressed? 0 x) (debug-menu-context-activate-selection arg0) ) ((cpad-pressed? 0 up) (debug-menu-context-select-new-item arg0 -1) ) ((cpad-pressed? 0 down) (debug-menu-context-select-new-item arg0 1) ) ((cpad-pressed? 0 left) (debug-menu-context-select-new-item arg0 -5) ) ((cpad-pressed? 0 right) (debug-menu-context-select-new-item arg0 5) ) ) arg0 ) (defun debug-menus-active ((arg0 debug-menu-context)) (when (not (-> arg0 is-hidden)) (if (-> arg0 joypad-func) ((-> arg0 joypad-func) (-> arg0 joypad-item)) (debug-menus-default-joypad-func arg0) ) (debug-menu-context-render arg0) ) arg0 ) (defun debug-menus-handler ((arg0 debug-menu-context)) (if (-> arg0 is-active) (debug-menus-active arg0) ) arg0 ) )