;;-*-Lisp-*- (in-package goal) ;; name: menu.gc ;; name in dgo: menu ;; dgos: GAME ;; +++debug-menu-msg (defenum debug-menu-msg :type int32 (activate 1) (deactivate 2) (update 3) (press 4) ) ;; ---debug-menu-msg ;; +++debug-menu-dest (defenum debug-menu-dest :type int32 (activation 0) (root 1) (open-menus 2) (current-selection 3) ) ;; ---debug-menu-dest (declare-type debug-menu-node basic) (declare-type debug-menu-context basic) (declare-type debug-menu debug-menu-node) (declare-type debug-menu-item debug-menu-node) (define-extern debug-menu-context-send-msg (function debug-menu-context debug-menu-msg debug-menu-dest 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 debug-menu-msg debug-menu-item)) (define-extern debug-menu-send-msg (function debug-menu debug-menu-msg symbol debug-menu)) ;; DECOMP BEGINS ;; this file is debug only (declare-file (debug)) (deftype debug-menu-context (basic) ((is-active symbol) (sel-length int32) (sel-menu debug-menu 8) (root-menu debug-menu) (joypad-func (function basic int none)) (joypad-item debug-menu-item) (font font-context) (is-hidden symbol) (joypad-number int32) ) (:methods (new (symbol type) _type_) ) ) (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) ;; og:preserve-this pc flag (new 'debug 'font-context *font-default-matrix* 0 0 0.0 (font-color default) (font-flags shadow kerning pc-hack)) ) (set! (-> gp-0 joypad-number) 0) gp-0 ) ) (deftype debug-menu-node (basic) ((name string) (parent debug-menu) (refresh-delay int32) (refresh-ctr int32) ) ) (defmethod print ((this debug-menu-node)) (format #t "#<~A ~A @ #x~X>" (-> this type) (-> this name) this) this ) (deftype debug-menu (debug-menu-node) ((context debug-menu-context) (selected-item debug-menu-item) (pix-width int32) (pix-height int32) (items pair) ) (:methods (new (symbol type debug-menu-context string) _type_) ) ) (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) ) ) (deftype debug-menu-item-submenu (debug-menu-item) ((submenu debug-menu) ) (:methods (new (symbol type string debug-menu) _type_) ) ) (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 object object)) (hilite-timer int8) ) (:methods (new (symbol type string object (function object object)) _type_) ) ) (defmethod new debug-menu-item-function ((allocation symbol) (type-to-make type) (arg0 string) (arg1 object) (arg2 (function object object))) (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) (the-as int arg1)) (set! (-> v0-0 activate-func) arg2) (set! (-> v0-0 hilite-timer) 0) v0-0 ) ) (deftype debug-menu-item-flag (debug-menu-item) ((activate-func (function object debug-menu-msg object)) (is-on symbol) ) (:methods (new (symbol type string object (function object debug-menu-msg object)) _type_) ) ) (defmethod new debug-menu-item-flag ((allocation symbol) (type-to-make type) (arg0 string) (arg1 object) (arg2 (function object debug-menu-msg object)) ) (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) arg2) (set! (-> v0-0 is-on) #f) v0-0 ) ) (deftype debug-menu-item-var (debug-menu-item) ((display-str string) (grabbed-joypad-p symbol) (float-p symbol) (range-p symbol) (show-len int32) (inc-delay int32) (inc-delay-ctr int32) (step-delay-ctr int32) (inc-dir int32) (fval float) (fundo-val float) (frange-min float) (frange-max float) (fstart-inc float) (fstep float) (fprecision int32) (factivate-func (function int debug-menu-msg float float float)) (ival int32 :overlay-at fval) (iundo-val int32 :overlay-at fundo-val) (irange-min int32 :overlay-at frange-min) (irange-max int32 :overlay-at frange-max) (istart-inc int32 :overlay-at fstart-inc) (istep int32 :overlay-at fstep) (ihex-p symbol) (iactivate-func (function int debug-menu-msg int int int) :overlay-at factivate-func) (ifloat-p symbol) ) (:methods (new (symbol type string int int) _type_) ) ) (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 ((s5-2 format) (a0-8 (clear (-> arg0 display-str))) (a1-2 "-0.~1d") (v1-8 (abs (the-as int (-> arg0 fval)))) ) (s5-2 a0-8 a1-2 (/ (mod v1-8 100) 10)) ) ) (else (let ((s5-3 format) (a0-10 (clear (-> arg0 display-str))) (a1-3 "~2d.~1d") (a2-6 (/ (the-as int (-> arg0 fval)) 100)) (v1-12 (abs (the-as int (-> arg0 fval)))) ) (s5-3 a0-10 a1-3 a2-6 (/ (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 debug-menu-msg 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 frange-min) (the-as float arg4)) (set! (-> arg0 frange-max) (the-as float arg5)) (set! (-> arg0 fstart-inc) (the-as float arg2)) (set! (-> arg0 fstep) (the-as float arg2)) (set! (-> arg0 ihex-p) arg6) (set! (-> arg0 factivate-func) (the-as (function int debug-menu-msg float float float) arg1)) (cond (arg3 (set! (-> arg0 fval) (the-as float arg4)) ) (else (set! (-> arg0 fval) 0.0) 0 ) ) (if arg1 (set! (-> arg0 fval) (the-as float (arg1 (-> arg0 id) (debug-menu-msg update) (the-as int (-> arg0 fval)) (the-as int (-> arg0 fval))) ) ) ) (debug-menu-item-var-update-display-str arg0) arg0 ) (defun debug-menu-item-var-make-float ((arg0 debug-menu-item-var) (arg1 (function int debug-menu-msg 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 (the-as int (arg1 (-> arg0 id) (debug-menu-msg update) (-> 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 (cond ((< 3 v1-2) (empty) v1-2 ) (else 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 debug-menu-msg 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 basic int none))) (cond ((-> arg0 joypad-func) #f ) (else (set! (-> arg0 joypad-func) arg2) (set! (-> arg0 joypad-item) (the-as debug-menu-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 (-> (the-as debug-menu-item-submenu arg0) name) (-> arg1 context font)) length) ) 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)) length) ) ) ) (else (set! v0-1 (+ (the int (-> (get-string-length (-> arg0 name) (-> arg1 context font)) length)) 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 (debug-menu-msg deactivate) (debug-menu-dest activation)) ) (set! (-> arg0 sel-length) 1) (set! (-> arg0 sel-menu 0) s5-0) (set! (-> s5-0 selected-item) (the-as debug-menu-item (-> s5-0 items car))) (if s4-0 (debug-menu-context-send-msg arg0 (debug-menu-msg activate) (debug-menu-dest activation)) ) ) ) ) ) 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) (+ (* 15 s5-0) 10)) ) (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 (debug-menu-msg deactivate) (debug-menu-dest activation)) ) (set! (-> arg0 root-menu) arg1) (debug-menu-context-default-selection arg0 #f) (if s4-0 (debug-menu-context-send-msg arg0 (debug-menu-msg activate) (debug-menu-dest activation)) ) ) arg0 ) (defun debug-menu-append-item ((arg0 debug-menu) (arg1 debug-menu-node)) (let* ((gp-0 (-> arg0 context)) (s4-0 (-> gp-0 is-active)) ) (if s4-0 (debug-menu-context-send-msg gp-0 (debug-menu-msg deactivate) (debug-menu-dest activation)) ) (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 (debug-menu-msg activate) (debug-menu-dest activation)) ) ) 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 (debug-menu-msg deactivate) (debug-menu-dest activation)) ) (set! (-> arg0 items) '()) (set! (-> arg0 selected-item) #f) (debug-menu-rebuild arg0) (if s4-0 (debug-menu-context-send-msg gp-0 (debug-menu-msg activate) (debug-menu-dest activation)) ) ) arg0 ) ;; WARN: Return type mismatch object vs function. (defun debug-menu-func-decode ((arg0 object)) (let ((v1-2 (rtype-of arg0))) (the-as function (cond ((or (= v1-2 symbol) (= v1-2 type)) (-> (the-as symbol arg0) value) ) ((= v1-2 function) arg0 ) (else nothing ) ) ) ) ) ;; ERROR: Stack slot load at 96 mismatch: defined as size 4, got size 16 ;; ERROR: Stack slot load at 128 mismatch: defined as size 4, got size 16 ;; ERROR: Stack slot load at 96 mismatch: defined as size 4, got size 16 ;; ERROR: Stack slot load at 128 mismatch: defined as size 4, got size 16 ;; ERROR: Stack slot load at 96 mismatch: defined as size 4, got size 16 ;; ERROR: Stack slot load at 128 mismatch: defined as size 4, got size 16 ;; ERROR: Stack slot load at 96 mismatch: defined as size 4, got size 16 ;; ERROR: Stack slot load at 128 mismatch: defined as size 4, got size 16 (defun debug-menu-make-from-template ((arg0 debug-menu-context) (arg1 pair)) (local-vars (s4-0 debug-menu-node) (sv-16 object) (sv-32 (function object int int)) (sv-48 int) (sv-64 (function object int int)) (sv-80 (function object float float)) (sv-96 float) (sv-112 (function object float float)) (sv-128 float) (sv-144 (function object int int)) ) (when (or (not arg1) (null? arg1)) (set! s4-0 (the-as debug-menu-node #f)) (goto cfg-39) ) (let ((s5-0 (car arg1)) (s4-1 (car (cdr arg1))) ) (cond ((= s5-0 'menu) (let ((s5-1 (new 'debug 'debug-menu arg0 (the-as string s4-1)))) (set! s4-0 (new 'debug 'debug-menu-item-submenu (the-as string s4-1) s5-1)) (let* ((gp-1 (cdr (cdr 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 s5-1 a1-4) ) ) (set! gp-1 (cdr gp-1)) (set! a1-3 (car gp-1)) ) ) ) ) ((= s5-0 'main-menu) (set! s4-0 (new 'debug 'debug-menu arg0 (the-as string s4-1))) (let* ((gp-2 (cdr (cdr 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 s4-0) 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 s4-0)) ) (else (set! s4-0 (cond ((= s5-0 'flag) (new 'debug 'debug-menu-item-flag (the-as string s4-1) (car (cdr (cdr arg1))) (the-as (function object debug-menu-msg object) (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) ) ) ((or (= s5-0 0) (= s5-0 'function)) (new 'debug 'debug-menu-item-function (the-as string s4-1) (car (cdr (cdr arg1))) (the-as (function object object) (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) ) ) ((= s5-0 'var) (new 'debug 'debug-menu-item-var (the-as string s4-1) (the-as int (car (cdr (cdr arg1)))) (the-as int (car (cdr (cdr (cdr arg1))))) ) ) ((or (= s5-0 'int-var) (= s5-0 'int-var-gat1) (= s5-0 'hex-var)) (set! s4-0 (new 'debug 'debug-menu-item-var (the-as string s4-1) (the-as int (car (cdr (cdr arg1)))) (the-as int (ref arg1 4)) ) ) (let ((s3-4 debug-menu-item-var-make-int) (s2-3 (the-as debug-menu-item-var s4-0)) (s1-3 (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) (s0-2 (command-get-int (ref arg1 5) 0)) ) (set! sv-16 (ref arg1 6)) (set! sv-32 command-get-int) (let ((a0-24 (ref arg1 7)) (a1-18 0) ) (set! sv-48 (sv-32 a0-24 a1-18)) ) (set! sv-64 command-get-int) (let* ((a0-26 (ref arg1 8)) (a1-20 0) (t1-0 (sv-64 a0-26 a1-20)) (t2-0 (= s5-0 'hex-var)) ) (s3-4 s2-3 (the-as (function int debug-menu-msg int int int) s1-3) s0-2 (the-as symbol sv-16) sv-48 t1-0 t2-0) ) ) s4-0 ) ((= s5-0 'float-var) (set! s4-0 (new 'debug 'debug-menu-item-var (the-as string s4-1) (the-as int (car (cdr (cdr arg1)))) (the-as int (ref arg1 4)) ) ) (let ((s5-5 debug-menu-item-var-make-float) (s3-6 (the-as debug-menu-item-var s4-0)) (s2-5 (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) (s1-6 (command-get-float (ref arg1 5) 0.0)) (s0-3 (ref arg1 6)) ) (set! sv-80 command-get-float) (let ((a0-35 (ref arg1 7)) (a1-28 0.0) ) (set! sv-96 (sv-80 a0-35 a1-28)) ) (set! sv-112 command-get-float) (let ((a0-37 (ref arg1 8)) (a1-30 0.0) ) (set! sv-128 (sv-112 a0-37 a1-30)) ) (set! sv-144 command-get-int) (let* ((a0-39 (ref arg1 9)) (a1-32 0) (t2-1 (sv-144 a0-39 a1-32)) ) (s5-5 s3-6 (the-as (function int debug-menu-msg float float float) s2-5) s1-6 (the-as symbol s0-3) sv-96 sv-128 t2-1 ) ) ) s4-0 ) (else (the-as debug-menu-node #f) ) ) ) ) ) ) (label cfg-39) s4-0 ) ;; WARN: Return type mismatch object vs debug-menu. (defun debug-menu-find-from-template ((arg0 debug-menu-context) (arg1 pair)) (let ((s5-0 (the-as object (-> arg0 root-menu)))) (while (begin (label cfg-12) (and s5-0 (type? s5-0 debug-menu) (not (null? arg1)))) (let ((s3-0 (-> (the-as debug-menu s5-0) items)) (s5-1 (car arg1)) ) (set! arg1 (cdr arg1)) (let ((s4-0 (car s3-0))) (while (not (null? s3-0)) (when (string= (the-as string s5-1) (-> (the-as debug-menu-item s4-0) name)) (if (type? s4-0 debug-menu-item-submenu) (set! s5-0 (-> (the-as debug-menu-item-submenu s4-0) submenu)) (set! s5-0 s4-0) ) (goto cfg-12) ) (set! s3-0 (cdr s3-0)) (set! s4-0 (car s3-0)) ) ) ) (set! s5-0 #f) (goto cfg-19) ) (label cfg-19) (the-as debug-menu s5-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))) (let ((v1-2 s5-0) (a0-1 arg2) ) (set! (-> v1-2 origin x) (the float arg1)) (set! (-> v1-2 origin y) (the float a0-1)) ) (set! (-> s5-0 color) (cond ((zero? arg3) (font-color menu) ) (arg4 (font-color menu-selected-parent) ) (else (font-color menu-parent) ) ) ) (with-dma-buffer-add-bucket ((s3-0 (-> *display* frames (-> *display* on-screen) debug-buf)) (bucket-id debug-menu) ) (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 ((s5-0 (-> arg0 parent context font))) (let ((v1-2 s5-0) (a0-1 arg2) ) (set! (-> v1-2 origin x) (the float arg1)) (set! (-> v1-2 origin y) (the float a0-1)) ) (set! (-> s5-0 color) (the-as font-color (cond ((> (-> arg0 hilite-timer) 0) (+! (-> arg0 hilite-timer) -1) 10 ) ((< (-> arg0 hilite-timer) 0) (+! (-> arg0 hilite-timer) 1) 14 ) ((nonzero? arg3) 13 ) (else 12 ) ) ) ) (with-dma-buffer-add-bucket ((s3-0 (-> *display* frames (-> *display* on-screen) debug-buf)) (bucket-id debug-menu) ) (set-context! *font-work* s5-0) (draw-string (-> arg0 name) s3-0 s5-0) ) ) arg0 ) (defun debug-menu-item-flag-render ((arg0 debug-menu-item-flag) (arg1 int) (arg2 int) (arg3 int) (arg4 symbol)) (let ((s5-0 (-> arg0 parent context font))) (let ((v1-2 s5-0) (a0-1 arg2) ) (set! (-> v1-2 origin x) (the float arg1)) (set! (-> v1-2 origin y) (the float a0-1)) ) (set! (-> s5-0 color) (cond ((= (-> arg0 is-on) 'invalid) (font-color menu-invalid) ) ((-> arg0 is-on) (if (zero? arg3) (font-color menu-flag-on) (font-color menu-flag-on-parent) ) ) ((zero? arg3) (font-color menu-flag-off) ) (else (font-color menu-flag-off-parent) ) ) ) (with-dma-buffer-add-bucket ((s3-0 (-> *display* frames (-> *display* on-screen) debug-buf)) (bucket-id debug-menu) ) (set-context! *font-work* s5-0) (draw-string (-> arg0 name) s3-0 s5-0) ) ) 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))) (let ((v1-2 s5-0) (a0-1 arg2) ) (set! (-> v1-2 origin x) (the float arg1)) (set! (-> v1-2 origin y) (the float a0-1)) ) (set! (-> s5-0 color) (cond ((zero? arg3) (if (-> arg0 grabbed-joypad-p) (font-color menu-selected) (font-color menu) ) ) (arg4 (font-color menu-selected-parent) ) (else (font-color menu-parent) ) ) ) (with-dma-buffer-add-bucket ((s1-0 (-> *display* frames (-> *display* on-screen) debug-buf)) (bucket-id debug-menu) ) (draw-string-adv (-> arg0 name) s1-0 s5-0) (draw-string-adv ":" s1-0 s5-0) (cond ((>= (-> arg0 show-len) (length (-> arg0 display-str))) (set-context! *font-work* s5-0) (draw-string (-> arg0 display-str) s1-0 s5-0) ) (else (set-context! *font-work* s5-0) (draw-string "..." s1-0 s5-0) (set! arg4 (and (zero? arg3) arg4)) (when arg4 (let ((v1-18 s5-0) (a1-7 20) (a0-10 379) ) (set! (-> v1-18 origin x) (the float a1-7)) (set! (-> v1-18 origin y) (the float a0-10)) ) (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 (debug-menu-msg update)) ) ) (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 debug-menu-node) (arg4 int)) (local-vars (sv-16 dma-buffer) (sv-32 pointer)) (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 (* 15 (+ v1-0 -16)))) ) ) (with-dma-buffer-add-bucket ((s0-0 (-> *display* frames (-> *display* on-screen) debug-buf)) (bucket-id debug-menu) ) ;; og:preserve-this fixed for widescreen (draw-sprite2d-xy s0-0 (correct-x-int arg1) arg2 (correct-x-int (-> arg0 pix-width)) (-> arg0 pix-height) (new 'static 'rgba :a #x40) #x3fffff ) ) (let* ((s3-1 (+ arg1 3)) (s2-1 (+ arg2 5)) (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) (font-color menu-parent) (font-color menu) ) ) (let ((v1-20 (-> arg0 context font)) (a1-5 s3-1) (a0-15 s2-1) ) (set! (-> v1-20 origin x) (the float a1-5)) (set! (-> v1-20 origin y) (the float a0-15)) ) (set! sv-16 (-> *display* frames (-> *display* on-screen) debug-buf)) (set! sv-32 (-> sv-16 base)) (set-context! *font-work* (-> arg0 context font)) (draw-string ">" sv-16 (-> arg0 context font)) (let ((a3-3 (-> sv-16 base))) (when (!= sv-32 a3-3) (let ((v1-35 (the-as object (-> sv-16 base)))) (set! (-> (the-as dma-packet v1-35) dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> (the-as dma-packet v1-35) vif0) (new 'static 'vif-tag)) (set! (-> (the-as dma-packet v1-35) vif1) (new 'static 'vif-tag)) (set! (-> sv-16 base) (&+ (the-as pointer v1-35) 16)) ) (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) bucket-group) (bucket-id debug-menu) sv-32 (the-as (pointer dma-tag) a3-3) ) ) ) ) (debug-menu-item-render (the-as debug-menu-item s0-1) (+ s3-1 12) s2-1 arg4 (= s0-1 arg3)) (+! s2-1 15) (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 52 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)) (when (= (car a3-0) a2-0) (set! v1-4 a3-0) (goto cfg-7) ) (set! a0-1 a3-0) (set! a3-0 (cdr a3-0)) ) ) (label cfg-7) (when (null? v1-4) (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) ) ) (when (= v1-4 -1) (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 (debug-menu-msg activate) (debug-menu-dest current-selection)) ) (defun debug-menu-context-close-submenu ((arg0 debug-menu-context)) (debug-menu-context-send-msg arg0 (debug-menu-msg deactivate) (debug-menu-dest current-selection)) (if (< 1 (-> arg0 sel-length)) (+! (-> arg0 sel-length) -1) ) arg0 ) (defun debug-menu-item-submenu-msg ((arg0 debug-menu-item-submenu) (arg1 debug-menu-msg)) (when (= arg1 (debug-menu-msg press)) (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 debug-menu-msg)) (cond ((= arg1 (debug-menu-msg press)) (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 (debug-menu-msg deactivate)) (set! (-> arg0 hilite-timer) 0) 0 ) ) arg0 ) (defun debug-menu-item-flag-msg ((arg0 debug-menu-item-flag) (arg1 debug-menu-msg)) (cond ((= arg1 (debug-menu-msg press)) (if (-> arg0 activate-func) (set! (-> arg0 is-on) (the-as symbol ((-> arg0 activate-func) (-> arg0 id) (debug-menu-msg press)))) ) (let ((a0-2 (-> arg0 parent context))) (debug-menu-context-send-msg a0-2 (debug-menu-msg update) (debug-menu-dest open-menus)) ) ) ((or (= arg1 (debug-menu-msg update)) (= arg1 (debug-menu-msg activate))) (if (-> arg0 activate-func) (set! (-> arg0 is-on) (the-as symbol ((-> arg0 activate-func) (-> arg0 id) (debug-menu-msg update)))) ) (set! (-> arg0 refresh-ctr) (-> arg0 refresh-delay)) ) ) arg0 ) (defun debug-menu-item-var-joypad-handler ((arg0 debug-menu-item-var) (arg1 int)) (cond ((not (cpad-hold? arg1 x)) (let ((a0-2 (-> arg0 parent context))) (debug-menu-context-release-joypad a0-2) ) (set! (-> arg0 grabbed-joypad-p) #f) (when (cpad-pressed? arg1 square) (cond ((-> arg0 float-p) (if (-> arg0 factivate-func) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) (debug-menu-msg press) (-> arg0 fundo-val) (-> arg0 fval)) ) ) ) (else (if (-> arg0 factivate-func) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) (debug-menu-msg press) (-> arg0 fundo-val) (-> arg0 fval)) ) ) ) ) (debug-menu-item-var-update-display-str arg0) ) (let ((a0-7 (-> arg0 parent context))) (debug-menu-context-send-msg a0-7 (debug-menu-msg update) (debug-menu-dest open-menus)) ) ) ((or (cpad-hold? arg1 right) (cpad-hold? arg1 left) (cpad-hold? arg1 down) (cpad-hold? arg1 up)) (let ((v1-45 (cond ((cpad-hold? arg1 right) 10 ) ((cpad-hold? arg1 up) 1 ) ((cpad-hold? arg1 down) -1 ) (else -10 ) ) ) ) (when (!= v1-45 (-> arg0 inc-dir)) (set! (-> arg0 inc-dir) v1-45) (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 (< (the-as int (-> arg0 fstep)) #x989680) (set! (-> arg0 fstep) (the-as float (* (-> arg0 fstep) 2))) ) ) ) ) (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) (debug-menu-msg press) f0-8 (-> arg0 fval))) ) ) ) (else (when (-> arg0 factivate-func) (let ((a2-4 (+ (the-as int (-> arg0 fval)) (* (-> arg0 inc-dir) (the-as int (-> arg0 fstep)))))) (if (-> arg0 range-p) (set! a2-4 (min (max a2-4 (the-as int (-> arg0 frange-min))) (the-as int (-> arg0 frange-max)))) ) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) (debug-menu-msg press) (the-as float a2-4) (-> arg0 fval)) ) ) ) ) ) (debug-menu-item-var-update-display-str arg0) (let ((a0-29 (-> arg0 parent context))) (debug-menu-context-send-msg a0-29 (debug-menu-msg update) (debug-menu-dest current-selection)) ) ) (else (+! (-> arg0 inc-delay-ctr) -1) ) ) ) (else (set! (-> arg0 inc-dir) 0) 0 ) ) arg0 ) (defun debug-menu-item-var-msg ((arg0 debug-menu-item-var) (arg1 debug-menu-msg)) (cond ((= arg1 (debug-menu-msg deactivate)) (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 (debug-menu-msg press)) (when (not (-> arg0 grabbed-joypad-p)) (let ((a0-2 (-> arg0 parent context))) (when (debug-menu-context-grab-joypad a0-2 arg0 (the-as (function basic int none) 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) 0 ) ) ) ) ((or (= arg1 (debug-menu-msg update)) (= arg1 (debug-menu-msg activate))) (cond ((-> arg0 float-p) (if (-> arg0 factivate-func) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) (debug-menu-msg update) (-> arg0 fval) (-> arg0 fval)) ) ) ) (else (if (-> arg0 factivate-func) (set! (-> arg0 fval) ((-> arg0 factivate-func) (-> arg0 id) (debug-menu-msg update) (-> arg0 fval) (-> arg0 fval)) ) ) ) ) (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 debug-menu-msg)) (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) 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 debug-menu-msg) (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 debug-menu-msg) (arg2 debug-menu-dest)) (cond ((= arg2 (debug-menu-dest root)) (debug-menu-send-msg (-> arg0 root-menu) arg1 #t) ) ((= arg2 (debug-menu-dest open-menus)) (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 (debug-menu-dest current-selection)) (when (-> arg0 is-active) (if (nonzero? (-> arg0 sel-length)) (debug-menu-send-msg (-> arg0 sel-menu (+ (-> arg0 sel-length) -1)) arg1 #f) ) ) ) ((= arg2 (debug-menu-dest activation)) (cond ((= arg1 (debug-menu-msg activate)) (when (not (-> arg0 is-active)) (set! (-> arg0 is-active) #t) (debug-menu-context-send-msg arg0 (debug-menu-msg activate) (debug-menu-dest open-menus)) ) ) ((= arg1 (debug-menu-msg deactivate)) (when (-> arg0 is-active) (debug-menu-context-send-msg arg0 (debug-menu-msg deactivate) (debug-menu-dest open-menus)) (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 (debug-menu-msg press)) ) arg0 ) (defun debug-menus-default-joypad-func ((arg0 debug-menu-context)) (cond ((cpad-pressed? (-> arg0 joypad-number) square) (cond ((< 1 (-> arg0 sel-length)) (debug-menu-context-close-submenu arg0) ) (else ) ) ) ((cpad-pressed? (-> arg0 joypad-number) x) (debug-menu-context-activate-selection arg0) ) ((cpad-pressed? (-> arg0 joypad-number) up) (debug-menu-context-select-new-item arg0 -1) ) ((cpad-pressed? (-> arg0 joypad-number) down) (debug-menu-context-select-new-item arg0 1) ) ((cpad-pressed? (-> arg0 joypad-number) left) (debug-menu-context-select-new-item arg0 -5) ) ((cpad-pressed? (-> arg0 joypad-number) 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) (-> arg0 joypad-number)) (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 )