jak-project/goal_src/pc_debug/pc-pad-utils.gc

;;-*-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.")))