;;-*-Lisp-*-
(in-package goal)

;; name: pad.gc
;; name in dgo: pad
;; dgos: ENGINE, GAME

#|@file
Interface for game controllers.
the *cpad-list* contains both game controllers.
Use the service-cpads functions once per frame to update the data and vibration control
The cpad-set-buzz! function can be used for vibration.
|#

(define-extern get-current-time (function time-frame))
(define-extern get-integral-current-time (function uint))
(define-extern get-current-language (function language-enum))


(defenum pad-buttons
    :bitfield #t
    :type uint32
    (select   0)
    (l3       1)
    (r3       2)
    (start    3)
    (up       4)
    (right    5)
    (down     6)
    (left     7)
    (l2       8)
    (r2       9)
    (l1       10)
    (r1       11)
    (triangle 12)
    (circle   13)
    (x        14)
    (square   15)
    ;; only 16 buttons are mapped to hardware, the rest are 'actions' or something else
    (l-analog-up 16)
    (l-analog-right 17)
    (l-analog-down 18)
    (l-analog-left 19)
    (r-analog-up 20)
    (r-analog-right 21)
    (r-analog-down 22)
    (r-analog-left 23)
    (confirm 24)
    )

(defenum abutton-idx
  :type uint8
  (right 0)
  (left 1)
  (up 2)
  (down 3)
  (triangle 4)
  (circle 5)
  (x 6)
  (square 7)
  (l1 8)
  (r1 9)
  (l2 10)
  (r2 11))

(defenum pad-type
  (normal 4)
  (analog 5)
  (dualshock 7)
  (negcon 2)
  (namco-gun 6)
  )


(defenum mouse-buttons
    :bitfield #t
    :type uint32
    (left)
    (right)
    (middle)
    )

(define-extern add-debug-cursor (function symbol bucket-id int int mouse-buttons int))


(#when PC_PORT

;; redefined from C kernel
(defun scf-get-territory ()
  "redefined from C kernel for convenience"
  (if (= (-> *pc-settings* territory) -1)
      *default-territory*
      (-> *pc-settings* territory))
  )
)

;; decomp begins

(deftype scf-time (structure)
  ((stat    uint8)
   (second  uint8)
   (minute  uint8)
   (hour    uint8)
   (week    uint8)
   (day     uint8)
   (month   uint8)
   (year    uint8)
   )
  )

(define-extern scf-get-time (function scf-time none))

;; this gets set to #f later on.
(define *cheat-mode* #t)

;; data that comes directly from hardware. it's 32 bytes + type tag (ignored in C kernel).
(deftype hw-cpad (basic)
  (;; BASIC CONTROLLER data
   ;; status = 0x40 | (data length / 2)
   (valid   uint8) ;; 0 if success, 255 if fail
   (status  uint8) ;; depends on controller
   (button0 uint16) ;; binary button states!
   ;; DUALSHOCK or JOYSTICK data
   ;; status (dualshock) = 0x70 | (data length / 2)
   ;; status (joystick)  = 0x50 | (data length / 2)
   (rightx  uint8) ;; right stick xdir
   (righty  uint8) ;; right stick ydir
   (leftx   uint8) ;; left stick xdir
   (lefty   uint8) ;; left stick ydir
   ;; DUALSHOCK 2 data
   ;; status = 0x70 | (data length / 2)
   (abutton uint8  12) ;; pressure sensitivity information

   ;; pad buffer needs to be 32 bytes large.
   (dummy   uint8  12)
   )
  )

;; data from hardware + additional info calculated here.
(deftype cpad-info (hw-cpad)
  ((number              int32)
   (cpad-file           int32)
   (button0-abs         pad-buttons  3)
   (button0-shadow-abs  pad-buttons  1)
   (button0-rel         pad-buttons  3)
   (stick0-dir          float)
   (stick0-speed        float)
   (new-pad             int32)
   (state               int32)
   (align               uint8        6)
   (direct              uint8        6)
   (buzz-val            uint8        2)
   (buzz-pause-val      uint8        1)
   (buzz-pause-time     uint8)
   (buzz-time           time-frame   2)
   (buzz                basic)
   (buzz-act            int32)
   (change-time         time-frame)
   (old-rightx          uint8        2)
   (old-righty          uint8        2)
   (old-leftx           uint8        2)
   (old-lefty           uint8        2)
   )
  (:methods
    (new (symbol type int) _type_)
    (adjust-to-screen-flip (_type_) int)
    )
  )

(defmacro cpad-type? (type)
  `(= (shr (-> pad status) 4) (cpad-type ,type))
  )

(defun cpad-invalid! ((arg0 cpad-info))
 "Reset all data in a cpad-info"
  (logior! (-> arg0 valid) 128)
  (set! (-> arg0 button0) (the-as uint 0))
  (set! (-> arg0 button0-abs 0) (pad-buttons))
  (set! (-> arg0 button0-shadow-abs 0) (pad-buttons))
  (set! (-> arg0 button0-rel 0) (pad-buttons))
  (dotimes (v1-2 12)
    (nop!)
    (set! (-> arg0 abutton v1-2) (the-as uint 0))
    )
  (set! (-> arg0 stick0-dir) 0.0)
  (set! (-> arg0 stick0-speed) 0.0)
  (set! (-> arg0 rightx) (the-as uint 128))
  (set! (-> arg0 righty) (the-as uint 128))
  (set! (-> arg0 leftx) (the-as uint 128))
  (set! (-> arg0 lefty) (the-as uint 128))
  (set! (-> arg0 align 0) (the-as uint 0))
  (set! (-> arg0 align 1) (the-as uint 1))
  (set! (-> arg0 align 2) (the-as uint 255))
  (set! (-> arg0 align 3) (the-as uint 255))
  (set! (-> arg0 align 4) (the-as uint 255))
  (set! (-> arg0 align 5) (the-as uint 255))
  (dotimes (v1-14 6)
    (nop!)
    (set! (-> arg0 direct v1-14) (the-as uint 0))
    )
  ;; hey, this was fixed from jak 1!
  (dotimes (v1-17 2)
    (nop!)
    (set! (-> arg0 buzz-val v1-17) (the-as uint 0))
    (set! (-> arg0 buzz-time v1-17) 0)
    )
  (set! (-> arg0 buzz-pause-val 0) (the-as uint 0))
  (set! (-> arg0 buzz-time 0) 0)
  arg0
  )

(defmethod new cpad-info ((allocation symbol) (type-to-make type) (arg0 int))
  "Allocate a new cpad-info and open the pad itself through the kernel"
  (let ((s5-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (set! (-> s5-0 number) arg0)
    (set! (-> s5-0 buzz) #f)
    (cpad-open s5-0 arg0)
    (cpad-invalid! s5-0)
    )
  )

;; List of controllers. It always has 2 controllers.
(deftype cpad-list (basic)
  ((num-cpads  int32)
   (cpads      cpad-info  2)
   )
  (:methods
    (new (symbol type) _type_)
    )
  )

(defmethod new cpad-list ((allocation symbol) (type-to-make type))
  "Create a cpad-list for 2 controllers. It's fine to do this even if one or both controllers
   aren't connected yet."
  (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (set! (-> gp-0 num-cpads) 2)
    (set! (-> gp-0 cpads 0) (new 'global 'cpad-info 0))
    (set! (-> gp-0 cpads 1) (new 'global 'cpad-info 1))
    gp-0
    )
  )

  ;; Allocates enough input frames to support counting 50ms of time at 300fps.
(deftype cpad-history (basic)
  ((button0-abs pad-buttons 15) ;; bitmask of buttons, pressed or not, with history
   (button0-rel pad-buttons 15) ;; bitmask of if button going down.
  )
)

;; List of extended history for controllers at high fps. It always has 4 controllers.
(deftype cpad-history-list (basic)
  ((num-cpads  int32)
   (cpads cpad-history 4)  ;; modified from 2->4 for PC 4-pad support
   )
  (:methods
   (new (symbol type) _type_)
   )
  )

(defmethod new cpad-history-list ((allocation symbol) (type-to-make type))
  "Create a cpad-history-list for 4 controllers. It's fine to do this even if controllers
   aren't connected yet. "
  (let ((this (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (set! (-> this num-cpads) 4)
    (set! (-> this cpads 0) (new 'global 'cpad-history))
    (set! (-> this cpads 1) (new 'global 'cpad-history))
    (set! (-> this cpads 2) (new 'global 'cpad-history))
    (set! (-> this cpads 3) (new 'global 'cpad-history))
    this
    )
  )

(defun analog-input ((arg0 int) (arg1 float) (arg2 float) (arg3 float) (arg4 float))
  "Convert integer input from pad into a float between -out-range and +out-range.
   The offset is applied directly to the input.
   The center val is the expected value for 0, after applying offset.
   The max val is the expected value with the stick pushed all the way"
  (let* ((f1-1 (- (the float arg0) arg1))
         (f0-3 (- (fabs f1-1) arg2))
         (v1-0 (- arg3 arg2))
         )
    (if (< f1-1 0.0)
        (set! arg4 (- arg4))
        )
    (cond
      ((>= 0.0 f0-3)
       0.0
       )
      ((>= f0-3 v1-0)
       arg4
       )
      (else
        (/ (* f0-3 arg4) v1-0)
        )
      )
    )
  )

;; og:preserve-this macros
(defmacro analog-input-horizontal-first (in offset center-val max-val out-range)
  "Same as analog-input but respects First-Person Horizontal camera control setting."
  `(#if PC_PORT ;; first-person horizontal is NOT inverted in original game
        (* (if (-> *pc-settings* first-camera-h-inverted?) -1.0 1.0)
           (analog-input ,in ,offset ,center-val ,max-val ,out-range))
        (analog-input ,in ,offset ,center-val ,max-val ,out-range)
        )
  )

(defmacro analog-input-vertical-first (in offset center-val max-val out-range)
  "Same as analog-input but respects First-Person Vertical camera control setting."
  `(#if PC_PORT ;; first-person vertical is already inverted in original game
        (* (if (-> *pc-settings* first-camera-v-inverted?) 1.0 -1.0)
           (analog-input ,in ,offset ,center-val ,max-val ,out-range))
        (analog-input ,in ,offset ,center-val ,max-val ,out-range)
        )
  )

(defmacro analog-input-horizontal-third (in offset center-val max-val out-range)
  "Same as analog-input but respects Third-Person Horizontal camera control setting."
  `(#if PC_PORT ;; third-person horizontal is already inverted in original game
        (* (if (-> *pc-settings* third-camera-h-inverted?) 1.0 -1.0)
           (analog-input ,in ,offset ,center-val ,max-val ,out-range))
        (analog-input ,in ,offset ,center-val ,max-val ,out-range)
        )
  )

(defmacro analog-input-vertical-third (in offset center-val max-val out-range)
  "Same as analog-input but respects Third-Person Vertical camera control setting."
  `(#if PC_PORT ;; third-person vertical is already inverted in original game
        (* (if (-> *pc-settings* third-camera-v-inverted?) 1.0 -1.0)
           (analog-input ,in ,offset ,center-val ,max-val ,out-range))
        (analog-input ,in ,offset ,center-val ,max-val ,out-range)
        )
  )

(defun cpad-set-buzz! ((arg0 cpad-info) (arg1 int) (arg2 int) (arg3 time-frame))
  "Turn on vibration motor 'buzz-idx' for duration, at magnitude buzz-amount."
  (cond
    ((zero? arg2)
     (set! (-> arg0 buzz-val arg1) (the-as uint 0))
     0
     )
    ((= arg2 (-> arg0 buzz-val arg1))
     (set! (-> arg0 buzz-time arg1) (the-as time-frame (max (-> arg0 buzz-time arg1) (+ (get-current-time) arg3))))
     )
    ((< (-> arg0 buzz-val arg1) (the-as uint arg2))
     (set! (-> arg0 buzz-val arg1) (the-as uint arg2))
     (set! (-> arg0 buzz-time arg1) (+ (get-current-time) arg3))
     )
    )
  0
  (none)
  )

;; the two controllers
(define *cpad-list* (new 'global 'cpad-list))
;; the cpad-history for each controller
(define *cpad-history-list* (new 'global 'cpad-history-list))

(desfun generate-frame-checks (pad-idx frames)
  (if (= frames 0)
       0
      `(logior (-> *cpad-history-list* cpads ,pad-idx button0-rel ,(- frames 1))
               ,(generate-frame-checks pad-idx (- frames 1))
        )
  )
)

;; weird leftover debug thing, enabling overrides the x position of both sticks on both controllers.
(define *cpad-debug* #f)

(#if PC_PORT
    (defconstant STICK_DEADZONE (-> *pc-settings* stick-deadzone))
    (defconstant STICK_DEADZONE 0.3)
    )

(defun service-cpads ()
  "Read from cpads and update vibration"
  (let ((pads *cpad-list*))
    (dotimes (i (-> pads num-cpads))
      (let ((pad (-> *cpad-list* cpads i))
            ;; og:preserve-this high fps fix
            (history (-> *cpad-history-list* cpads i)))
        (set! (-> pad old-leftx 1) (-> pad old-leftx 0))
        (set! (-> pad old-leftx 0) (-> pad leftx))
        (set! (-> pad old-lefty 1) (-> pad old-lefty 0))
        (set! (-> pad old-lefty 0) (-> pad lefty))
        (set! (-> pad old-rightx 1) (-> pad old-rightx 0))
        (set! (-> pad old-rightx 0) (-> pad rightx))
        (set! (-> pad old-righty 1) (-> pad old-righty 0))
        (set! (-> pad old-righty 0) (-> pad righty))
        (cpad-get-data pad)
        (adjust-to-screen-flip pad)
        (cond
          ((not (logtest? (-> pad valid) 128))
           (dotimes (buzz-i 2)
             (cond
               ((and (-> pad buzz) (< (get-current-time) (-> pad buzz-time buzz-i)) (= *master-mode* 'game))
                (let ((v1-20 buzz-i))
                  (cond
                    ((zero? v1-20)
                     (set! (-> pad direct buzz-i)
                           (logand (ash (-> pad buzz-val buzz-i) (- (the-as int (logand (get-integral-current-time) 7)))) 1)
                           )
                     )
                    ((= v1-20 1)
                     (set! (-> pad direct buzz-i) (-> pad buzz-val buzz-i))
                     )
                    )
                  )
                )
               ((and (zero? buzz-i) (> (-> pad buzz-pause-time) 0))
                (set! (-> pad direct buzz-i)
                      (logand (ash (-> pad buzz-pause-val buzz-i) (- (the-as int (logand (get-integral-current-time) 7)))) 1)
                      )
                (+! (-> pad buzz-pause-time) -1)
                )
               (else
                 (set! (-> pad buzz-val buzz-i) (the-as uint 0))
                 (set! (-> pad direct buzz-i) (the-as uint 0))
                 (when (zero? buzz-i)
                   (set! (-> pad buzz-pause-time) (the-as uint 0))
                   0
                   )
                 )
               )
             )
           (when (< (the-as uint 192) (-> pad direct 1))
             (set! (-> pad direct 0) (the-as uint 0))
             )
           (set! (-> pad button0-abs 2) (-> pad button0-abs 1))
           (set! (-> pad button0-abs 1) (-> pad button0-shadow-abs 0))
           (set! (-> pad button0-rel 2) (-> pad button0-rel 1))
           (set! (-> pad button0-rel 1) (-> pad button0-rel 0))

           ;; og:preserve-this high fps fix
           (when (>= (-> *pc-settings* target-fps) 300)
              (set! (-> history button0-abs 14) (-> history button0-abs 13))
              (set! (-> history button0-abs 13) (-> history button0-abs 12))
              (set! (-> history button0-abs 12) (-> history button0-abs 11))

              (set! (-> history button0-rel 14) (-> history button0-rel 13))
              (set! (-> history button0-rel 13) (-> history button0-rel 12))
              (set! (-> history button0-rel 12) (-> history button0-rel 11))
            )
           (when (>= (-> *pc-settings* target-fps) 240)
              (set! (-> history button0-abs 11) (-> history button0-abs 10))
              (set! (-> history button0-abs 10) (-> history button0-abs 9))
              (set! (-> history button0-abs  9) (-> history button0-abs 8))
              (set! (-> history button0-rel 11) (-> history button0-rel 10))
              (set! (-> history button0-rel 10) (-> history button0-rel 9))
              (set! (-> history button0-rel  9) (-> history button0-rel 8))
            )
           (when (>= (-> *pc-settings* target-fps) 165)
              (set! (-> history button0-abs 8) (-> history button0-abs 7))
              (set! (-> history button0-abs 7) (-> history button0-abs 6))
              (set! (-> history button0-abs 6) (-> history button0-abs 5))
              (set! (-> history button0-rel 8) (-> history button0-rel 7))
              (set! (-> history button0-rel 7) (-> history button0-rel 6))
              (set! (-> history button0-rel 6) (-> history button0-rel 5))
            )
           (when (>= (-> *pc-settings* target-fps) 120)
              (set! (-> history button0-abs 5) (-> history button0-abs 4))
              (set! (-> history button0-abs 4) (-> history button0-abs 3))
              (set! (-> history button0-rel 5) (-> history button0-rel 4))
              (set! (-> history button0-rel 4) (-> history button0-rel 3))
            )
           (when (>= (-> *pc-settings* target-fps) 75)
              (set! (-> history button0-abs 3) (-> history button0-abs 2))
              (set! (-> history button0-rel 3) (-> history button0-rel 2))
            )
           (set! (-> history button0-abs 2) (-> history button0-abs 1))
           (set! (-> history button0-abs 1) (-> pad button0-shadow-abs 0))
           (set! (-> history button0-rel 2) (-> history button0-rel 1))
           (set! (-> history button0-rel 1) (-> pad button0-rel 0))

           (when (= (-> pad status) 115)
             (set! (-> pad abutton (abutton-idx right)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons right)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx left)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons left)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx up)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons up)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx down)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons down)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx x)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons x)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx circle)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons circle)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx triangle)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons triangle)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx square)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons square)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx l1)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons l1)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx l2)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons l2)) ;; og:preserve-this abutton indexing
                                                        255
                                                        0
                                                        )
                                               )
                   )
             (set! (-> pad abutton (abutton-idx r1)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons r1)) ;; og:preserve-this abutton indexing
                                                       255
                                                       0
                                                       )
                                              )
                   )
             (set! (-> pad abutton (abutton-idx r2)) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons r2)) ;; og:preserve-this abutton indexing
                                                        255
                                                        0
                                                        )
                                               )
                   )
             )
           (let ((buttons-pushed (the-as pad-buttons (-> pad button0))))
             (cond
               ((< (-> pad lefty) (the-as uint 30))
                (set! buttons-pushed (logior (pad-buttons l-analog-up) buttons-pushed))
                )
               ((< (the-as uint 225) (-> pad lefty))
                (set! buttons-pushed (logior (pad-buttons l-analog-down) buttons-pushed))
                )
               )
             (cond
               ((< (-> pad leftx) (the-as uint 30))
                (set! buttons-pushed (logior (pad-buttons l-analog-left) buttons-pushed))
                )
               ((< (the-as uint 225) (-> pad leftx))
                (set! buttons-pushed (logior (pad-buttons l-analog-right) buttons-pushed))
                )
               )
             (cond
               ((< (-> pad righty) (the-as uint 30))
                (set! buttons-pushed (logior (pad-buttons r-analog-up) buttons-pushed))
                )
               ((< (the-as uint 225) (-> pad righty))
                (set! buttons-pushed (logior (pad-buttons r-analog-down) buttons-pushed))
                )
               )
             (cond
               ((< (-> pad rightx) (the-as uint 30))
                (set! buttons-pushed (logior (pad-buttons r-analog-left) buttons-pushed))
                )
               ((< (the-as uint 225) (-> pad rightx))
                (set! buttons-pushed (logior (pad-buttons r-analog-right) buttons-pushed))
                )
               )
             (let ((v1-123 (get-current-language)))
               (cond
                 ((or (= v1-123 (language-enum japanese)) (= v1-123 (language-enum korean)))
                  (case (scf-get-territory)
                    ((GAME_TERRITORY_SCEI GAME_TERRITORY_SCEK)
                     (if (logtest? buttons-pushed (pad-buttons circle))
                         (set! buttons-pushed (logior (pad-buttons confirm) buttons-pushed))
                         )
                     )
                    (else
                      (if (logtest? buttons-pushed (pad-buttons circle x))
                          (set! buttons-pushed (logior (pad-buttons confirm) buttons-pushed))
                          )
                      )
                    )
                  )
                 ((let ((v1-135 (scf-get-territory)))
                    (or (= v1-135 GAME_TERRITORY_SCEI) (= v1-135 GAME_TERRITORY_SCEK))
                    )
                  (if (logtest? buttons-pushed (pad-buttons circle x))
                      (set! buttons-pushed (logior (pad-buttons confirm) buttons-pushed))
                      )
                  )
                 (else
                   (if (logtest? buttons-pushed (pad-buttons x))
                       (set! buttons-pushed (logior (pad-buttons confirm) buttons-pushed))
                       )
                   )
                 )
               )
             (set! (-> pad button0-shadow-abs 0) buttons-pushed)
             (set! (-> pad button0-abs 0) buttons-pushed)
             (set! (-> history button0-abs 0) (-> pad button0-abs 0))
             )
           (set! (-> pad button0-rel 0) (logclear (-> pad button0-abs 0) (-> pad button0-abs 1)))
           (set! (-> history button0-rel 0) (-> pad button0-rel 0))


           (when *cpad-debug*
             (set! (-> pad leftx) (the-as uint 255))
             (set! (-> pad rightx) (the-as uint 255))
             )
           (set! (-> pad stick0-speed) 1.0)
           (cond
             ((= (shr (-> pad status) 4) 7)
              (let ((f30-0 (* 0.0078125 (the float (+ (-> pad leftx) -128))))
                    (f28-0 (* 0.0078125 (the float (- 127 (the-as int (-> pad lefty))))))
                    )
                (set! (-> pad stick0-dir) (atan (- f30-0) f28-0))
                (set! (-> pad stick0-speed) (fmin 1.0 (sqrtf (+ (* f30-0 f30-0) (* f28-0 f28-0)))))
                )
              (if (< (-> pad stick0-speed) STICK_DEADZONE)
                  (set! (-> pad stick0-speed) 0.0)
                  )
              )
             (else
               (set! (-> pad leftx) (the-as uint 128))
               (set! (-> pad lefty) (the-as uint 128))
               (set! (-> pad rightx) (the-as uint 128))
               (set! (-> pad righty) (the-as uint 128))
               (set! (-> pad stick0-dir) 0.0)
               (set! (-> pad stick0-speed) 0.0)
               )
             )
           (if (or (!= (-> pad button0-abs 0) (-> pad button0-abs 1))
                   (or (< STICK_DEADZONE (-> pad stick0-speed)) (zero? (-> pad change-time)))
                   )
               (set! (-> pad change-time) (get-current-time))
               )
           )
          (else
            (cpad-invalid! pad)
            )
          )
        )
      )
    )
  *cpad-list*
  )

(defun buzz-stop! ((arg0 int))
  "Set the buzz to 0 on both vibration motors of the given cpad."
  (cpad-set-buzz! (-> *cpad-list* cpads arg0) 0 0 0)
  (cpad-set-buzz! (-> *cpad-list* cpads arg0) 1 0 0)
  0
  (none)
  )

(defmacro cpad-pressed (pad-idx)
  `(-> *cpad-list* cpads ,pad-idx button0-rel 0)
  )

(defmacro cpad-hold (pad-idx)
  `(-> *cpad-list* cpads ,pad-idx button0-abs 0)
  )

(defmacro cpad-pressed? (pad-idx &rest buttons)
  `(logtest? (cpad-pressed ,pad-idx) (pad-buttons ,@buttons))
  )

(defmacro recently-pressed? (&key (pad-idx (-> self control cpad number)) &key (frames 15) &rest buttons)
  "Checks if a (pad-button) was pressed within the last 50ms, based on frames"
  `(logtest? ,(generate-frame-checks pad-idx frames) (pad-buttons ,@buttons))
)

(defmacro cpad-hold? (pad-idx &rest buttons)
  `(logtest? (cpad-hold ,pad-idx) (pad-buttons ,@buttons))
  )

(defmacro cpad-clear! (pad-idx &rest buttons)
  `(begin
      (logclear! (cpad-pressed ,pad-idx) (pad-buttons ,@buttons))
      (logclear! (cpad-hold ,pad-idx) (pad-buttons ,@buttons))
      )
  )

(defmacro cpad-change-time (pad-idx)
  `(-> *cpad-list* cpads ,pad-idx change-time)
  )

(deftype mouse-info (basic)
  ((active              symbol)
   (cursor              basic)
   (valid               symbol)
   (id                  uint8)
   (status              uint16)
   (button0             uint16)
   (deltax              int8)
   (deltay              int8)
   (wheel               uint8)
   (change-time         time-frame)
   (button0-abs         mouse-buttons  3)
   (button0-shadow-abs  mouse-buttons  1)
   (button0-rel         mouse-buttons  3)
   (pos                 vector         2 :inline)
   (posx                float          :overlay-at (-> pos 0 data 0))
   (posy                float          :overlay-at (-> pos 0 data 1))
   (oldposx             float          :offset  96)
   (oldposy             float          :offset 100)
   (speedx              float          :overlay-at (-> pos 0 data 3))
   (speedy              float          :offset 108)
   )
  (:methods
    (new (symbol type) _type_)
    )
  )


(defmethod new mouse-info ((allocation symbol) (type-to-make type))
  "Allocate a new mouse."
  (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (set! (-> v0-0 active) #f)
    (set! (-> v0-0 valid) #f)
    (set! (-> v0-0 cursor) #f)
    v0-0
    )
  )

(define *mouse* (new 'global 'mouse-info))
(#when PC_PORT
;; added so we can hide the mouse
(define *disable-mouse* #f)
)

;; WARN: Return type mismatch mouse-info vs none.
(defun service-mouse ()
  "Update the mouse, and draw the cursor."
  (let ((gp-0 *mouse*))
    (mouse-get-data gp-0)
    (set! (-> gp-0 pos 1 quad) (-> gp-0 pos 0 quad))
    (set! (-> gp-0 button0-abs 2) (-> gp-0 button0-abs 1))
    (set! (-> gp-0 button0-abs 1) (-> gp-0 button0-shadow-abs 0))
    (set! (-> gp-0 button0-rel 2) (-> gp-0 button0-rel 1))
    (set! (-> gp-0 button0-rel 1) (-> gp-0 button0-rel 0))
    (set! (-> gp-0 button0-rel 0) (mouse-buttons))
    (set! (-> gp-0 speedx) 0.0)
    (set! (-> gp-0 speedy) 0.0)
    (cond
      ((or (not (-> gp-0 valid)) (not (-> gp-0 active)))
       (set! (-> gp-0 valid) #f)
       (set! (-> gp-0 status) (the-as uint 0))
       (set! (-> gp-0 pos 0 quad) (the-as uint128 0))
       (set! (-> gp-0 pos 1 quad) (the-as uint128 0))
       )
      ((logtest? (-> gp-0 status) 1)
       (set! (-> gp-0 change-time) (get-current-time))
       (set! (-> gp-0 speedx) (* (sign (the float (-> gp-0 deltax))) (pow (fabs (the float (-> gp-0 deltax))) 1.3)))
       (set! (-> gp-0 speedy) (* (sign (the float (-> gp-0 deltay))) (pow (fabs (the float (-> gp-0 deltay))) 1.3)))
       (set! (-> gp-0 posx) (fmax -256.0 (fmin 256.0 (+ (-> gp-0 posx) (-> gp-0 speedx)))))
       (set! (-> gp-0 posy) (fmax -208.0 (fmin 208.0 (+ (-> gp-0 posy) (-> gp-0 speedy)))))
       (let ((v1-22 (-> gp-0 button0)))
         (set! (-> gp-0 button0-shadow-abs 0) (the-as mouse-buttons v1-22))
         (set! (-> gp-0 button0-abs 0) (the-as mouse-buttons v1-22))
         )
       (set! (-> gp-0 button0-rel 0) (logclear (-> gp-0 button0-abs 0) (-> gp-0 button0-abs 1)))
       )
      )
    (if (and (-> gp-0 active) (-> gp-0 valid) (-> gp-0 cursor) (#if PC_PORT (not *disable-mouse*) #t))
        (add-debug-cursor
          #t
          (bucket-id debug-no-zbuf2)
          (+ (the int (-> gp-0 posx)) 256)
          (+ (the int (-> gp-0 posy)) 208)
          (-> gp-0 button0-abs 0)
          )
        )
    )
  (none)
  )

(defmacro mouse-pressed ()
  `(-> *mouse* button0-rel 0)
  )

(defmacro mouse-hold ()
  `(-> *mouse* button0-abs 0)
  )

(defmacro mouse-pressed? (&rest buttons)
  `(logtest? (mouse-pressed) (mouse-buttons ,@buttons))
  )

(defmacro mouse-hold? (&rest buttons)
  `(logtest? (mouse-hold) (mouse-buttons ,@buttons))
  )

(defmacro mouse-clear! (&rest buttons)
  `(begin
      (logclear! (mouse-pressed) (mouse-buttons ,@buttons))
      (logclear! (mouse-hold) (mouse-buttons ,@buttons))
      )
  )


(defmacro check-cheat-code (cheat-var pad-idx buttons &rest body)
  "execute body when a cheat code made up of sequential inputs has been inputted"

  `(when (nonzero? (cpad-pressed ,pad-idx)) ;; only check when some button has been pressed
    (case ,cheat-var
      ,@(apply-i
          (lambda (x i)
            `((,i)
              (if (cpad-pressed? ,pad-idx ,x)
                ,(if (< i (- (length buttons) 1))
                    `(1+! ,cheat-var)

                    `(begin ,@body (set! ,cheat-var 0))
                    )

                (set! ,cheat-var 0)
                )
              )
            )
        buttons)
      )
    )
  )

(defmacro cheats-sound-play (cheat?)
  "play the appropriate sound for inputting a cheat code"

  `(if ,cheat?
      (sound-play-by-spec (static-sound-spec "menu-pick" :fo-curve 1) (new-sound-id) (the-as vector #t))
      (sound-play-by-spec (static-sound-spec "menu-back" :fo-curve 1) (new-sound-id) (the-as vector #t))
      )
  )

