;;-*-Lisp-*- (in-package goal) ;; This file is used for debugging and testing the PC port pad (controller/input) implementation. ;; It contains a function for creating a process for debugging cpad inputs and a function to kill that process. ;; It also contains a function to start a process to map keys to cpad inputs (X, circle, etc.), and another one to kill it. ;; THIS FILE IS DEBUG ONLY and will not work if *debug-segment* is not enabled. ;; To run this: #| (make-group "iso") ;; build the game (lt) ;; connect to the runtime (lg) ;; have the runtime load the game engine (test-play) ;; start the game loop (ml "goal_src/pc_debug/pc-pad-utils.gc") ;; build and load this file. |# (cond (*debug-segment* ;; a structure to hold the handles used in this file (deftype pc-pad-proc-list (structure) ((show handle) (input handle) ) ) (define *pc-pad-proc-list* (new 'static 'pc-pad-proc-list)) (set! (-> *pc-pad-proc-list* show) (the handle #f)) (set! (-> *pc-pad-proc-list* input) (the handle #f)) ;; a pc pad process (deftype pc-pad-proc (process) ((state-time seconds) (input-index uint64) ) :heap-base #x10 ) (define *pc-pad-button-names* (new 'static 'array string 16 "SELECT" "L3" "R3" "START" "UP" "RIGHT" "DOWN" "LEFT" "L2" "R2" "L1" "R1" "TRIANGLE" "CIRCLE" "X" "SQUARE" )) (defenum pc-pad-input-status (disabled) (enabled) (canceled) ) (defun-debug pc-pad-show-start () "Start the PC port pad debug display" (if (not (handle->process (-> *pc-pad-proc-list* show))) (let ((procp (make-function-process *nk-dead-pool* *active-pool* pc-pad-proc :name 'pc-pad-show (lambda :behavior pc-pad-proc () (stack-size-set! (-> self main-thread) 512) (loop (dotimes (ii 2) (format *stdcon* "~3Lcpad ~D~0L~%" ii) (dotimes (i 16) (format *stdcon* " ~S: ~32L~D~0L~%" (-> *pc-pad-button-names* i) (pc-pad-get-mapped-button ii i)) ) ) (suspend) ) ) ) )) (set! (-> *pc-pad-proc-list* show) (ppointer->handle procp)) ) (format #t "That process is already running. :-)~%") ) ) (defun-debug pc-pad-show-stop () "Stop the PC port pad debug display" (kill-by-name 'pc-pad-show *active-pool*) ) (defconstant PC_PAD_INPUT_NOTICE_TIME (seconds 1.5)) (define-extern pc-pi-mapping-button state) (defstate pc-pi-new-mapping (pc-pad-proc) :enter (behavior () (set! (-> self input-index) (pc-pad-input-index-get)) ) :code (behavior () (set-state-time) (until (time-passed? PC_PAD_INPUT_NOTICE_TIME) (with-dma-buffer-add-bucket ((buf (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string-xy (string-format "MAPPED ~D TO ~S!" (pc-pad-input-key-get) (-> *pc-pad-button-names* (1- (-> self input-index)))) buf 256 96 (font-color green) (font-flags shadow kerning large middle)) ) (suspend) ) (go pc-pi-mapping-button) ) :trans (behavior () (if (or (!= (-> self input-index) (pc-pad-input-index-get)) (!= (pc-pad-input-mode-get) (pc-pad-input-status enabled))) ;; something's changed, go back to the main state and check everything (go pc-pi-mapping-button) ) ) ) (defstate pc-pi-canceled (pc-pad-proc) :code (behavior () (set-state-time) (until (time-passed? PC_PAD_INPUT_NOTICE_TIME) (with-dma-buffer-add-bucket ((buf (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string-xy "CANCELED!" buf 256 96 (font-color red-reverse) (font-flags shadow kerning large middle)) ) (suspend) ) ) ) (defstate pc-pi-done (pc-pad-proc) :enter (behavior () (set! (-> self input-index) 16)) :code (behavior () (pc-pad-input-map-save!) (set-state-time) (until (time-passed? PC_PAD_INPUT_NOTICE_TIME) (with-dma-buffer-add-bucket ((buf (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string-xy (string-format "MAPPED ~D TO ~S!" (pc-pad-input-key-get) (-> *pc-pad-button-names* (1- (-> self input-index)))) buf 256 96 (font-color green) (font-flags shadow kerning large middle)) ) (suspend) ) (set-state-time) (until (time-passed? PC_PAD_INPUT_NOTICE_TIME) (with-dma-buffer-add-bucket ((buf (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (draw-string-xy "KEY MAPPING COMPLETE!" buf 256 96 (font-color green) (font-flags shadow kerning large middle)) ) (suspend) ) ) ) (defstate pc-pi-mapping-button (pc-pad-proc) :code (behavior () (set-state-time) (loop (with-dma-buffer-add-bucket ((buf (current-display-frame debug-buf)) (current-display-frame bucket-group) (bucket-id debug-draw1)) (if (< (mod (time-passed) (seconds 2)) (seconds 1)) (draw-string-xy "NOW MAPPING PAD" buf 256 32 (font-color red) (font-flags shadow kerning large middle)) ) (draw-string-xy "PRESS ESCAPE TO EXIT" buf 256 64 (font-color default) (font-flags shadow kerning large middle)) (draw-string-xy (string-format "PRESS KEY FOR ~S" (-> *pc-pad-button-names* (-> self input-index))) buf 256 96 (font-color default) (font-flags shadow kerning large middle)) ) (suspend) ) ) :trans (behavior () (cond ;; canceled ((= (pc-pad-input-mode-get) (pc-pad-input-status canceled)) (go pc-pi-canceled) ) ;; finished ((or (>= (pc-pad-input-index-get) 16) (= (pc-pad-input-mode-get) (pc-pad-input-status disabled))) (go pc-pi-done) ) ;; waiting input ((= (-> self input-index) (pc-pad-input-index-get)) ) ;; one input has been done! ((= (1+ (-> self input-index)) (pc-pad-input-index-get)) (go pc-pi-new-mapping) ) ;; more than one input has been done. go to last mapping. ((< (1+ (-> self input-index)) (pc-pad-input-index-get)) (go pc-pi-new-mapping) ) ) ) ) (defun-debug pc-pad-input-start () "Start the PC port pad debug key mapping" (if (not (handle->process (-> *pc-pad-proc-list* input))) (let ((procp (make-init-process *nk-dead-pool* *active-pool* pc-pad-proc :name 'pc-pad-input (lambda :behavior pc-pad-proc () (pc-pad-input-mode-set #t) (go pc-pi-mapping-button) ) ) )) (set! (-> *pc-pad-proc-list* input) (ppointer->handle procp)) ) (format #t "That process is already running. :-)~%") ) ) (defun-debug pc-pad-input-stop () "Stop the PC port pad debug key mapping" (kill-by-name 'pc-pad-input *active-pool*) ) ) (else (format #t "No debug memory in use. pc-pad-utils not loaded.")))