;;-*-Lisp-*- (in-package goal) ;; this file is debug only (declare-file (debug)) (when *debug-segment* ;; definition of type debug-menu-context (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) ) ) ;; definition for method 3 of type debug-menu-context (defmethod inspect debug-menu-context ((obj debug-menu-context)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tis-active: ~A~%" (-> obj is-active)) (format #t "~Tsel-length: ~D~%" (-> obj sel-length)) (format #t "~Tsel-menu[8] @ #x~X~%" (-> obj sel-menu)) (format #t "~Troot-menu: ~A~%" (-> obj root-menu)) (format #t "~Tjoypad-func: ~A~%" (-> obj joypad-func)) (format #t "~Tjoypad-item: ~A~%" (-> obj joypad-item)) (format #t "~Tfont: ~A~%" (-> obj font)) (format #t "~Tis-hidden: ~A~%" (-> obj is-hidden)) obj ) ;; definition for method 0 of type debug-menu-context (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 (font-color default) (font-flags shadow kerning)) ) gp-0 ) ) ;; definition of type debug-menu-node (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 ) ;; definition for method 3 of type debug-menu-node (defmethod inspect debug-menu-node ((obj debug-menu-node)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tparent: ~A~%" (-> obj parent)) (format #t "~Trefresh-delay: ~D~%" (-> obj refresh-delay)) (format #t "~Trefresh-ctr: ~D~%" (-> obj refresh-ctr)) obj ) ;; definition for method 2 of type debug-menu-node (defmethod print debug-menu-node ((obj debug-menu-node)) (format #t "#<~A ~A @ #x~X>" (-> obj type) (-> obj name) obj) obj ) ;; definition of type debug-menu (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) ) ) ;; definition for method 3 of type debug-menu (defmethod inspect debug-menu ((obj debug-menu)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tparent: ~A~%" (-> obj parent)) (format #t "~Trefresh-delay: ~D~%" (-> obj refresh-delay)) (format #t "~Trefresh-ctr: ~D~%" (-> obj refresh-ctr)) (format #t "~Tcontext: ~A~%" (-> obj context)) (format #t "~Tselected-item: ~A~%" (-> obj selected-item)) (format #t "~Tpix-width: ~D~%" (-> obj pix-width)) (format #t "~Tpix-height: ~D~%" (-> obj pix-height)) (format #t "~Titems: ~A~%" (-> obj items)) obj ) ;; definition for method 0 of type debug-menu (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 ) ) ;; definition of type debug-menu-item (deftype debug-menu-item (debug-menu-node) ((id int32 :offset-assert 20) ) :method-count-assert 9 :size-assert #x18 :flag-assert #x900000018 ) ;; definition for method 3 of type debug-menu-item (defmethod inspect debug-menu-item ((obj debug-menu-item)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tparent: ~A~%" (-> obj parent)) (format #t "~Trefresh-delay: ~D~%" (-> obj refresh-delay)) (format #t "~Trefresh-ctr: ~D~%" (-> obj refresh-ctr)) (format #t "~Tid: #x~X~%" (-> obj id)) obj ) ;; definition of type debug-menu-item-submenu (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) ) ) ;; definition for method 3 of type debug-menu-item-submenu (defmethod inspect debug-menu-item-submenu ((obj debug-menu-item-submenu)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tparent: ~A~%" (-> obj parent)) (format #t "~Trefresh-delay: ~D~%" (-> obj refresh-delay)) (format #t "~Trefresh-ctr: ~D~%" (-> obj refresh-ctr)) (format #t "~Tid: #x~X~%" (-> obj id)) (format #t "~Tsubmenu: ~A~%" (-> obj submenu)) obj ) ;; definition for method 0 of type debug-menu-item-submenu (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 ) ) ;; definition of type debug-menu-item-function (deftype debug-menu-item-function (debug-menu-item) ((activate-func (function object object) :offset-assert 24) (hilite-timer int8 :offset-assert 28) ) :method-count-assert 9 :size-assert #x1d :flag-assert #x90000001d (:methods (new (symbol type string object (function object object)) _type_ 0) ) ) ;; definition for method 3 of type debug-menu-item-function (defmethod inspect debug-menu-item-function ((obj debug-menu-item-function)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tparent: ~A~%" (-> obj parent)) (format #t "~Trefresh-delay: ~D~%" (-> obj refresh-delay)) (format #t "~Trefresh-ctr: ~D~%" (-> obj refresh-ctr)) (format #t "~Tid: #x~X~%" (-> obj id)) (format #t "~Tactivate-func: ~A~%" (-> obj activate-func)) (format #t "~Thilite-timer: ~D~%" (-> obj hilite-timer)) obj ) ;; definition for method 0 of type debug-menu-item-function (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 ) ) ;; definition of type debug-menu-item-flag (deftype debug-menu-item-flag (debug-menu-item) ((activate-func (function object debug-menu-msg object) :offset-assert 24) (is-on object :offset-assert 28) ) :method-count-assert 9 :size-assert #x20 :flag-assert #x900000020 (:methods (new (symbol type string object (function object debug-menu-msg object)) _type_ 0) ) ) ;; definition for method 3 of type debug-menu-item-flag (defmethod inspect debug-menu-item-flag ((obj debug-menu-item-flag)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tparent: ~A~%" (-> obj parent)) (format #t "~Trefresh-delay: ~D~%" (-> obj refresh-delay)) (format #t "~Trefresh-ctr: ~D~%" (-> obj refresh-ctr)) (format #t "~Tid: #x~X~%" (-> obj id)) (format #t "~Tactivate-func: ~A~%" (-> obj activate-func)) (format #t "~Tis-on: ~A~%" (-> obj is-on)) obj ) ;; definition for method 0 of type debug-menu-item-flag (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) (the-as object #f)) v0-0 ) ) ;; definition of type debug-menu-item-var (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 debug-menu-msg 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 debug-menu-msg 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) ) ) ;; definition for method 3 of type debug-menu-item-var (defmethod inspect debug-menu-item-var ((obj debug-menu-item-var)) (format #t "[~8x] ~A~%" obj (-> obj type)) (format #t "~Tname: ~A~%" (-> obj name)) (format #t "~Tparent: ~A~%" (-> obj parent)) (format #t "~Trefresh-delay: ~D~%" (-> obj refresh-delay)) (format #t "~Trefresh-ctr: ~D~%" (-> obj refresh-ctr)) (format #t "~Tid: #x~X~%" (-> obj id)) (format #t "~Tdisplay-str: ~A~%" (-> obj display-str)) (format #t "~Tgrabbed-joypad-p: ~A~%" (-> obj grabbed-joypad-p)) (format #t "~Tfloat-p: ~A~%" (-> obj float-p)) (format #t "~Trange-p: ~A~%" (-> obj range-p)) (format #t "~Tshow-len: ~D~%" (-> obj show-len)) (format #t "~Tinc-delay: ~D~%" (-> obj inc-delay)) (format #t "~Tinc-delay-ctr: ~D~%" (-> obj inc-delay-ctr)) (format #t "~Tstep-delay-ctr: ~D~%" (-> obj step-delay-ctr)) (format #t "~Tinc-dir: ~D~%" (-> obj inc-dir)) (format #t "~Tfval: ~f~%" (-> obj fval)) (format #t "~Tfundo-val: ~f~%" (-> obj fundo-val)) (format #t "~Tfrange-min: ~f~%" (-> obj frange-min)) (format #t "~Tfrange-max: ~f~%" (-> obj frange-max)) (format #t "~Tfstart-inc: ~f~%" (-> obj fstart-inc)) (format #t "~Tfstep: ~f~%" (-> obj fstep)) (format #t "~Tfprecision: ~D~%" (-> obj fprecision)) (format #t "~Tfactivate-func: ~A~%" (-> obj factivate-func)) (format #t "~Tival: ~D~%" (-> obj fval)) (format #t "~Tiundo-val: ~D~%" (-> obj fundo-val)) (format #t "~Tirange-min: ~D~%" (-> obj frange-min)) (format #t "~Tirange-max: ~D~%" (-> obj frange-max)) (format #t "~Tistart-inc: ~D~%" (-> obj fstart-inc)) (format #t "~Tistep: ~D~%" (-> obj fstep)) (format #t "~Tihex-p: ~A~%" (-> obj ihex-p)) (format #t "~Tiactivate-func: ~A~%" (-> obj factivate-func)) (format #t "~Tifloat-p: ~A~%" (-> obj ifloat-p)) obj ) ;; definition for function debug-menu-item-var-update-display-str (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 ) ;; definition for function debug-menu-item-var-make-int (defun debug-menu-item-var-make-int ((item debug-menu-item-var) (callback (function int debug-menu-msg int int int)) (inc int) (has-range symbol) (range-min int) (range-max int) (hex symbol) ) (set! (-> item float-p) #f) (set! (-> item range-p) has-range) (set! (-> item frange-min) (the-as float range-min)) (set! (-> item frange-max) (the-as float range-max)) (set! (-> item fstart-inc) (the-as float inc)) (set! (-> item fstep) (the-as float inc)) (set! (-> item ihex-p) hex) (set! (-> item factivate-func) (the-as (function int debug-menu-msg float float float) callback)) (cond (has-range (set! (-> item fval) (the-as float range-min)) ) (else (set! (-> item fval) (the-as float 0)) 0 ) ) (if callback (set! (-> item fval) (the-as float (callback (-> item id) (debug-menu-msg update) (the-as int (-> item fval)) (the-as int (-> item fval))) ) ) ) (debug-menu-item-var-update-display-str item) item ) ;; definition for function debug-menu-item-var-make-float (defun debug-menu-item-var-make-float ((item debug-menu-item-var) (callback (function int debug-menu-msg float float float)) (inc float) (has-range symbol) (range-min float) (range-max float) (precision int) ) (set! (-> item float-p) #t) (set! (-> item range-p) has-range) (set! (-> item frange-min) range-min) (set! (-> item frange-max) range-max) (set! (-> item fstart-inc) inc) (set! (-> item fstep) inc) (set! (-> item fprecision) precision) (set! (-> item factivate-func) callback) (if has-range (set! (-> item fval) range-min) (set! (-> item fval) 0.0) ) (if callback (set! (-> item fval) (the float (callback (-> item id) (debug-menu-msg update) (-> item fval) (-> item fval))) ) ) (debug-menu-item-var-update-display-str item) item ) ;; definition for method 0 of type debug-menu-item-var (defmethod new debug-menu-item-var ((allocation symbol) (type-to-make type) (name string) (id int) (max-width int)) (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (let ((v1-2 (/ max-width 8))) (set! (-> gp-0 name) name) (set! (-> gp-0 parent) #f) (set! (-> gp-0 refresh-delay) 31) (set! (-> gp-0 refresh-ctr) (-> gp-0 refresh-delay)) (set! (-> gp-0 id) id) (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 ) ) ;; definition for function debug-menu-context-grab-joypad (defun debug-menu-context-grab-joypad ((menu debug-menu-context) (callback-arg basic) (callback-func (function basic none))) (cond ((-> menu joypad-func) #f ) (else (set! (-> menu joypad-func) callback-func) (set! (-> menu joypad-item) callback-arg) #t ) ) ) ;; definition for function debug-menu-context-release-joypad (defun debug-menu-context-release-joypad ((arg0 debug-menu-context)) (set! (-> arg0 joypad-func) #f) (set! (-> arg0 joypad-item) #f) #f ) ;; definition for function debug-menu-item-get-max-width (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 string (the-as debug-menu-item-var (-> (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 ) ;; definition for function debug-menu-context-default-selection (defun debug-menu-context-default-selection ((ctxt debug-menu-context) (keep-current symbol)) (when (or (zero? (-> ctxt sel-length)) (not keep-current)) (let ((menu (-> ctxt root-menu))) (when (and menu (not (null? (-> menu items)))) (let ((currently-active (-> ctxt is-active))) (if currently-active (debug-menu-context-send-msg ctxt (debug-menu-msg deactivate) (debug-menu-dest activation)) ) (set! (-> ctxt sel-length) 1) (set! (-> ctxt sel-menu 0) menu) (set! (-> menu selected-item) (the-as debug-menu-item (car (-> menu items)))) (if currently-active (debug-menu-context-send-msg ctxt (debug-menu-msg activate) (debug-menu-dest activation)) ) ) ) ) ) ctxt ) ;; definition for function debug-menu-rebuild (defun debug-menu-rebuild ((menu debug-menu)) (let ((max-width 0) (entry-count 0) ) (let* ((iter (-> menu items)) (current-item (car iter)) ) (while (not (null? iter)) (+! entry-count 1) (set! (-> (the-as debug-menu-item current-item) parent) menu) (set! max-width (max max-width (debug-menu-item-get-max-width (the-as debug-menu-item current-item) menu))) (set! iter (cdr iter)) (set! current-item (car iter)) ) ) (set! (-> menu pix-width) (+ max-width 18)) (set! (-> menu pix-height) (+ (* entry-count 8) 6)) ) (let ((a0-2 (-> menu context))) (debug-menu-context-default-selection a0-2 #t) ) menu ) ;; definition for function debug-menu-context-set-root-menu (defun debug-menu-context-set-root-menu ((context debug-menu-context) (menu debug-menu)) (let ((active (-> context is-active))) (if active (debug-menu-context-send-msg context (debug-menu-msg deactivate) (debug-menu-dest activation)) ) (set! (-> context root-menu) menu) (debug-menu-context-default-selection context #f) (if active (debug-menu-context-send-msg context (debug-menu-msg activate) (debug-menu-dest activation)) ) ) context ) ;; definition for function debug-menu-append-item (defun debug-menu-append-item ((menu debug-menu) (item debug-menu-node)) (let* ((context (-> menu context)) (was-active (-> context is-active)) ) (if was-active (debug-menu-context-send-msg context (debug-menu-msg deactivate) (debug-menu-dest activation)) ) (set! (-> item parent) menu) (set! (-> menu items) (the-as pair (append! (-> menu items) (cons item '())))) (debug-menu-rebuild menu) (if was-active (debug-menu-context-send-msg context (debug-menu-msg activate) (debug-menu-dest activation)) ) ) item ) ;; definition for function debug-menu-remove-all-items (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 ) ;; definition for function debug-menu-func-decode ;; INFO: Return type mismatch object vs function. (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) ) ) ) ) ) ;; definition for function debug-menu-make-from-template ;; WARN: Stack slot load at 48 mismatch: defined as size 4, got size 16 ;; WARN: Stack slot load at 64 mismatch: defined as size 4, got size 16 ;; WARN: Stack slot load at 80 mismatch: defined as size 4, got size 16 ;; WARN: Stack slot load at 96 mismatch: defined as size 4, got size 16 ;; WARN: Stack slot load at 48 mismatch: defined as size 4, got size 16 ;; WARN: Stack slot load at 64 mismatch: defined as size 4, got size 16 ;; WARN: Stack slot load at 80 mismatch: defined as size 4, got size 16 ;; WARN: Stack slot load at 96 mismatch: defined as size 4, got size 16 ;; Used lq/sq (defun debug-menu-make-from-template ((arg0 debug-menu-context) (arg1 pair)) (local-vars (s5-0 basic) (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 #f) (goto cfg-41) ) (let ((s4-0 (car arg1)) (s5-1 (the-as string (car (cdr 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 (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 s4-1 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 (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 s5-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 s5-0)) ) (else (set! s5-0 (cond ((= s4-0 'flag) (new 'debug 'debug-menu-item-flag s5-1 (car (cdr (cdr arg1))) (the-as (function object debug-menu-msg object) (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) ) ) ((or (= s4-0 0) (= s4-0 'function)) (new 'debug 'debug-menu-item-function s5-1 (car (cdr (cdr arg1))) (the-as (function object object) (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) ) ) ((= s4-0 'var) (new 'debug 'debug-menu-item-var s5-1 (the-as int (car (cdr (cdr arg1)))) (the-as int (car (cdr (cdr (cdr 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 (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 s5-0)) (s1-3 (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) (s0-1 (/ (the-as int (ref arg1 5)) 8)) ) (set! sv-16 (ref arg1 6)) (set! sv-32 (/ (the-as int (ref arg1 7)) 8)) (let ((t1-0 (/ (the-as int (ref arg1 8)) 8)) (t2-0 (= s4-0 'hex-var)) ) (s3-4 s2-3 (the-as (function int debug-menu-msg int int int) s1-3) s0-1 (the-as symbol sv-16) sv-32 t1-0 t2-0) ) ) (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 (car (cdr (cdr arg1)))) (the-as int (ref arg1 4))) ) (let ((s4-5 debug-menu-item-var-make-float) (s3-6 (the-as debug-menu-item-var s5-0)) (s2-5 (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) (s1-5 (the float (/ (the-as int (ref arg1 5)) 8))) (s0-2 (ref arg1 6)) ) (set! sv-48 (the float (/ (the-as int (ref arg1 7)) 8))) (set! sv-64 (the float (/ (the-as int (ref arg1 8)) 8))) (let ((t2-1 (/ (the-as int (ref arg1 9)) 8))) (s4-5 s3-6 (the-as (function int debug-menu-msg float float float) s2-5) s1-5 (the-as symbol s0-2) sv-48 sv-64 t2-1 ) ) ) s5-0 ) ((= s4-0 'float-fixed-var) (set! s5-0 (new 'debug 'debug-menu-item-var s5-1 (the-as int (car (cdr (cdr arg1)))) (the-as int (ref arg1 4))) ) (let ((s4-7 debug-menu-item-var-make-float) (s3-8 (the-as debug-menu-item-var s5-0)) (s2-7 (debug-menu-func-decode (car (cdr (cdr (cdr arg1)))))) (s1-7 (* 0.001 (the float (/ (the-as int (ref arg1 5)) 8)))) (s0-3 (ref arg1 6)) ) (set! sv-80 (* 0.001 (the float (/ (the-as int (ref arg1 7)) 8)))) (set! sv-96 (* 0.001 (the float (/ (the-as int (ref arg1 8)) 8)))) (let ((t2-2 (/ (the-as int (ref arg1 9)) 8))) (s4-7 s3-8 (the-as (function int debug-menu-msg float float float) s2-7) s1-7 (the-as symbol s0-3) sv-80 sv-96 t2-2 ) ) ) s5-0 ) (else #f ) ) ) ) ) ) (label cfg-41) (the-as debug-menu-node s5-0) ) ;; definition for function debug-menu-find-from-template ;; INFO: Return type mismatch object vs debug-menu. (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 (car arg1)) ) (set! arg1 (cdr arg1)) (let ((s5-0 (car s3-0))) (while (not (null? s3-0)) (when (string= (the-as 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) ) ) ;; definition for function debug-menu-item-submenu-render (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) (the-as font-color (cond ((zero? arg3) 12 ) (arg4 11 ) (else 13 ) ) ) ) (let* ((s3-0 (-> *display* frames (-> *display* on-screen) frame debug-buf)) (s4-0 (-> s3-0 base)) ) (draw-string-adv (-> arg0 name) s3-0 s5-0) (draw-string-adv "..." s3-0 s5-0) (let ((a3-1 (-> s3-0 base))) (let ((v1-7 (the-as object (-> s3-0 base)))) (set! (-> (the-as dma-packet v1-7) dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> (the-as dma-packet v1-7) vif0) (new 'static 'vif-tag)) (set! (-> (the-as dma-packet v1-7) vif1) (new 'static 'vif-tag)) (set! (-> s3-0 base) (&+ (the-as pointer v1-7) 16)) ) (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group) (bucket-id debug-draw1) s4-0 (the-as (pointer dma-tag) a3-1) ) ) ) ) arg0 ) ;; definition for function debug-menu-item-function-render (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))) (let ((a0-1 v1-2) (a1-1 arg2) ) (set! (-> a0-1 origin x) (the float arg1)) (set! (-> a0-1 origin y) (the float a1-1)) ) (set! (-> v1-2 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 ) ) ) ) (let* ((s4-0 (-> *display* frames (-> *display* on-screen) frame debug-buf)) (s5-0 (-> s4-0 base)) ) (draw-string (-> arg0 name) s4-0 v1-2) (let ((a3-1 (-> s4-0 base))) (let ((v1-3 (the-as object (-> s4-0 base)))) (set! (-> (the-as dma-packet v1-3) dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> (the-as dma-packet v1-3) vif0) (new 'static 'vif-tag)) (set! (-> (the-as dma-packet v1-3) vif1) (new 'static 'vif-tag)) (set! (-> s4-0 base) (&+ (the-as pointer v1-3) 16)) ) (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group) (bucket-id debug-draw1) s5-0 (the-as (pointer dma-tag) a3-1) ) ) ) ) arg0 ) ;; definition for function debug-menu-item-flag-render (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))) (let ((a0-1 v1-2) (a1-1 arg2) ) (set! (-> a0-1 origin x) (the float arg1)) (set! (-> a0-1 origin y) (the float a1-1)) ) (set! (-> v1-2 color) (the-as font-color (cond ((= (-> arg0 is-on) 'invalid) 19 ) ((-> arg0 is-on) (if (zero? arg3) 15 16 ) ) ((zero? arg3) 17 ) (else 18 ) ) ) ) (let* ((s4-0 (-> *display* frames (-> *display* on-screen) frame debug-buf)) (s5-0 (-> s4-0 base)) ) (draw-string (-> arg0 name) s4-0 v1-2) (let ((a3-1 (-> s4-0 base))) (let ((v1-3 (the-as object (-> s4-0 base)))) (set! (-> (the-as dma-packet v1-3) dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> (the-as dma-packet v1-3) vif0) (new 'static 'vif-tag)) (set! (-> (the-as dma-packet v1-3) vif1) (new 'static 'vif-tag)) (set! (-> s4-0 base) (&+ (the-as pointer v1-3) 16)) ) (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group) (bucket-id debug-draw1) s5-0 (the-as (pointer dma-tag) a3-1) ) ) ) ) arg0 ) ;; definition for function debug-menu-item-var-render (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) (the-as font-color (cond ((zero? arg3) (if (-> arg0 grabbed-joypad-p) 10 12 ) ) (arg4 11 ) (else 13 ) ) ) ) (let* ((s1-0 (-> *display* frames (-> *display* on-screen) frame debug-buf)) (s4-0 (-> s1-0 base)) ) (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 (let ((v1-12 s5-0) (a1-5 20) (a0-10 204) ) (set! (-> v1-12 origin x) (the float a1-5)) (set! (-> v1-12 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) ) ) ) (let ((a3-1 (-> s1-0 base))) (let ((v1-14 (the-as dma-packet (-> s1-0 base)))) (set! (-> v1-14 dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> v1-14 vif0) (new 'static 'vif-tag)) (set! (-> v1-14 vif1) (new 'static 'vif-tag)) (set! (-> s1-0 base) (the-as pointer (&+ v1-14 16))) ) (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group) (bucket-id debug-draw1) s4-0 (the-as (pointer dma-tag) a3-1) ) ) ) ) arg0 ) ;; definition for function debug-menu-item-render (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 ) ;; definition for function debug-menu-render ;; Used lq/sq (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 (* (+ v1-0 -16) 8))) ) ) (let* ((s0-0 (-> *display* frames (-> *display* on-screen) frame debug-buf)) (s1-0 (-> s0-0 base)) ) (draw-sprite2d-xy s0-0 arg1 arg2 (-> arg0 pix-width) (-> arg0 pix-height) (new 'static 'rgba :a #x40)) (let ((a3-2 (-> s0-0 base))) (let ((v1-7 (the-as object (-> s0-0 base)))) (set! (-> (the-as dma-packet v1-7) dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> (the-as dma-packet v1-7) vif0) (new 'static 'vif-tag)) (set! (-> (the-as dma-packet v1-7) vif1) (new 'static 'vif-tag)) (set! (-> s0-0 base) (&+ (the-as pointer v1-7) 16)) ) (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group) (bucket-id debug-draw1) s1-0 (the-as (pointer dma-tag) a3-2) ) ) ) (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) (the-as font-color (if (nonzero? arg4) 13 12 ) ) ) (let ((v1-16 (-> arg0 context font)) (a1-5 s3-1) (a0-18 s2-1) ) (set! (-> v1-16 origin x) (the float a1-5)) (set! (-> v1-16 origin y) (the float a0-18)) ) (set! sv-16 (-> *display* frames (-> *display* on-screen) frame debug-buf)) (set! sv-32 (-> sv-16 base)) (draw-string ">" sv-16 (-> arg0 context font)) (let ((a3-3 (-> sv-16 base))) (let ((v1-26 (the-as object (-> sv-16 base)))) (set! (-> (the-as dma-packet v1-26) dma) (new 'static 'dma-tag :id (dma-tag-id next))) (set! (-> (the-as dma-packet v1-26) vif0) (new 'static 'vif-tag)) (set! (-> (the-as dma-packet v1-26) vif1) (new 'static 'vif-tag)) (set! (-> sv-16 base) (&+ (the-as pointer v1-26) 16)) ) (dma-bucket-insert-tag (-> *display* frames (-> *display* on-screen) frame bucket-group) (bucket-id debug-draw1) 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 8) (set! s1-1 (cdr s1-1)) (set! s0-1 (car s1-1)) ) ) arg0 ) ;; definition for function debug-menu-context-render (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 a3-0 (+ (- -1 s5-0) (-> arg0 sel-length))) ) (set! s4-0 (+ s4-0 3 (-> s3-0 pix-width))) ) ) ) arg0 ) ;; definition for function debug-menu-context-select-next-or-prev-item (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 ) ;; definition for function debug-menu-context-select-new-item (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 ) ;; definition for function debug-menu-context-open-submenu (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)) ) ;; definition for function debug-menu-context-close-submenu (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 ) ;; definition for function debug-menu-item-submenu-msg (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 ) ;; definition for function debug-menu-item-function-msg (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 ) ;; definition for function debug-menu-item-flag-msg (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) ((-> 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) ((-> arg0 activate-func) (-> arg0 id) (debug-menu-msg update))) ) (set! (-> arg0 refresh-ctr) (-> arg0 refresh-delay)) ) ) arg0 ) ;; definition for function debug-menu-item-var-joypad-handler (defun debug-menu-item-var-joypad-handler ((arg0 debug-menu-item-var)) (cond ((zero? (logand (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons 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) (debug-menu-msg press) (-> arg0 fundo-val) (-> arg0 fval)) ) ) ) (else (if (-> arg0 factivate-func) (set! (-> arg0 fval) (the-as float ((the-as (function int int int int int) (-> arg0 factivate-func)) (-> arg0 id) 4 (the-as int (-> arg0 fundo-val)) (the-as int (-> arg0 fval)) ) ) ) ) ) ) (debug-menu-item-var-update-display-str arg0) ) (let ((a0-5 (-> arg0 parent context))) (debug-menu-context-send-msg a0-5 (debug-menu-msg update) (debug-menu-dest open-menus)) ) ) ((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 (< (the-as int (-> arg0 fstep)) #x989680) (set! (-> arg0 fstep) (the-as float (* (the-as int (-> 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) (the-as float ((the-as (function int int int int int) (-> arg0 factivate-func)) (-> arg0 id) 4 a2-4 (the-as int (-> arg0 fval)) ) ) ) ) ) ) ) (debug-menu-item-var-update-display-str arg0) (let ((a0-20 (-> arg0 parent context))) (debug-menu-context-send-msg a0-20 (debug-menu-msg update) (debug-menu-dest current-selection)) ) ) (else (+! (-> arg0 inc-delay-ctr) -1) ) ) ) (else (set! (-> arg0 inc-dir) 0) 0 ) ) arg0 ) ;; definition for function debug-menu-item-var-msg (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 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) (the-as float ((the-as (function int int int int int) (-> arg0 factivate-func)) (-> arg0 id) 3 (the-as int (-> arg0 fval)) (the-as int (-> arg0 fval)) ) ) ) ) ) ) (debug-menu-item-var-update-display-str arg0) (set! (-> arg0 refresh-ctr) (-> arg0 refresh-delay)) ) ) arg0 ) ;; definition for function debug-menu-item-send-msg (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 ) ;; definition for function debug-menu-send-msg (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 ) ;; definition for function debug-menu-context-send-msg (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 ) ;; definition for function debug-menu-context-activate-selection (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 ) ;; definition for function debug-menus-default-joypad-func (defun debug-menus-default-joypad-func ((arg0 debug-menu-context)) (cond ((cpad-pressed? 0 square) (cond ((< 1 (-> arg0 sel-length)) (debug-menu-context-close-submenu arg0) ) (else ) ) ) ((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 ) ;; definition for function debug-menus-active (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 ) ;; definition for function debug-menus-handler (defun debug-menus-handler ((arg0 debug-menu-context)) (if (-> arg0 is-active) (debug-menus-active arg0) ) arg0 ) ;; failed to figure out what this is: 0 )