mirror of
https://github.com/open-goal/jak-project
synced 2026-06-08 12:27:57 -04:00
660 lines
26 KiB
Common Lisp
Vendored
Generated
660 lines
26 KiB
Common Lisp
Vendored
Generated
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; definition of type scf-time
|
|
(deftype scf-time (structure)
|
|
((stat uint8 :offset-assert 0)
|
|
(second uint8 :offset-assert 1)
|
|
(minute uint8 :offset-assert 2)
|
|
(hour uint8 :offset-assert 3)
|
|
(week uint8 :offset-assert 4)
|
|
(day uint8 :offset-assert 5)
|
|
(month uint8 :offset-assert 6)
|
|
(year uint8 :offset-assert 7)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x8
|
|
:flag-assert #x900000008
|
|
)
|
|
|
|
;; definition for method 3 of type scf-time
|
|
(defmethod inspect scf-time ((obj scf-time))
|
|
(when (not obj)
|
|
(set! obj obj)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" obj 'scf-time)
|
|
(format #t "~1Tstat: ~D~%" (-> obj stat))
|
|
(format #t "~1Tsecond: #x~X~%" (-> obj second))
|
|
(format #t "~1Tminute: #x~X~%" (-> obj minute))
|
|
(format #t "~1Thour: #x~X~%" (-> obj hour))
|
|
(format #t "~1Tweek: #x~X~%" (-> obj week))
|
|
(format #t "~1Tday: #x~X~%" (-> obj day))
|
|
(format #t "~1Tmonth: #x~X~%" (-> obj month))
|
|
(format #t "~1Tyear: #x~X~%" (-> obj year))
|
|
(label cfg-4)
|
|
obj
|
|
)
|
|
|
|
;; definition for symbol *cheat-mode*, type symbol
|
|
(define *cheat-mode* #t)
|
|
|
|
;; definition of type hw-cpad
|
|
(deftype hw-cpad (basic)
|
|
((valid uint8 :offset-assert 4)
|
|
(status uint8 :offset-assert 5)
|
|
(button0 uint16 :offset-assert 6)
|
|
(rightx uint8 :offset-assert 8)
|
|
(righty uint8 :offset-assert 9)
|
|
(leftx uint8 :offset-assert 10)
|
|
(lefty uint8 :offset-assert 11)
|
|
(abutton uint8 12 :offset-assert 12)
|
|
(dummy uint8 12 :offset-assert 24)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x24
|
|
:flag-assert #x900000024
|
|
)
|
|
|
|
;; definition for method 3 of type hw-cpad
|
|
(defmethod inspect hw-cpad ((obj hw-cpad))
|
|
(when (not obj)
|
|
(set! obj obj)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~1Tvalid: #x~X~%" (-> obj valid))
|
|
(format #t "~1Tstatus: #x~X~%" (-> obj status))
|
|
(format #t "~1Tbutton0: #x~X~%" (-> obj button0))
|
|
(format #t "~1Trightx: ~D~%" (-> obj rightx))
|
|
(format #t "~1Trighty: ~D~%" (-> obj righty))
|
|
(format #t "~1Tleftx: ~D~%" (-> obj leftx))
|
|
(format #t "~1Tlefty: ~D~%" (-> obj lefty))
|
|
(format #t "~1Tabutton[12] @ #x~X~%" (-> obj abutton))
|
|
(format #t "~1Tdummy[12] @ #x~X~%" (-> obj dummy))
|
|
(label cfg-4)
|
|
obj
|
|
)
|
|
|
|
;; definition of type cpad-info
|
|
(deftype cpad-info (hw-cpad)
|
|
((number int32 :offset-assert 36)
|
|
(cpad-file int32 :offset-assert 40)
|
|
(button0-abs pad-buttons 3 :offset-assert 44)
|
|
(button0-shadow-abs pad-buttons 1 :offset-assert 56)
|
|
(button0-rel pad-buttons 3 :offset-assert 60)
|
|
(stick0-dir float :offset-assert 72)
|
|
(stick0-speed float :offset-assert 76)
|
|
(new-pad int32 :offset-assert 80)
|
|
(state int32 :offset-assert 84)
|
|
(align uint8 6 :offset-assert 88)
|
|
(direct uint8 6 :offset-assert 94)
|
|
(buzz-val uint8 2 :offset-assert 100)
|
|
(buzz-pause-val uint8 1 :offset-assert 102)
|
|
(buzz-pause-time uint8 :offset-assert 103)
|
|
(buzz-time time-frame 2 :offset-assert 104)
|
|
(buzz basic :offset-assert 120)
|
|
(buzz-act int32 :offset-assert 124)
|
|
(change-time time-frame :offset-assert 128)
|
|
(old-rightx uint8 2 :offset-assert 136)
|
|
(old-righty uint8 2 :offset-assert 138)
|
|
(old-leftx uint8 2 :offset-assert 140)
|
|
(old-lefty uint8 2 :offset-assert 142)
|
|
)
|
|
:method-count-assert 10
|
|
:size-assert #x90
|
|
:flag-assert #xa00000090
|
|
(:methods
|
|
(new (symbol type int) _type_ 0)
|
|
(adjust-to-screen-flip (_type_) int 9)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type cpad-info
|
|
(defmethod inspect cpad-info ((obj cpad-info))
|
|
(when (not obj)
|
|
(set! obj obj)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~1Tvalid: #x~X~%" (-> obj valid))
|
|
(format #t "~1Tstatus: #x~X~%" (-> obj status))
|
|
(format #t "~1Tbutton0: #x~X~%" (-> obj button0))
|
|
(format #t "~1Trightx: ~D~%" (-> obj rightx))
|
|
(format #t "~1Trighty: ~D~%" (-> obj righty))
|
|
(format #t "~1Tleftx: ~D~%" (-> obj leftx))
|
|
(format #t "~1Tlefty: ~D~%" (-> obj lefty))
|
|
(format #t "~1Tabutton[12] @ #x~X~%" (-> obj abutton))
|
|
(format #t "~1Tdummy[12] @ #x~X~%" (-> obj dummy))
|
|
(format #t "~1Tnumber: ~D~%" (-> obj number))
|
|
(format #t "~1Tcpad-file: ~D~%" (-> obj cpad-file))
|
|
(format #t "~1Tbutton0-abs[3] @ #x~X~%" (-> obj button0-abs))
|
|
(format #t "~1Tbutton0-shadow-abs[1] @ #x~X~%" (-> obj button0-shadow-abs))
|
|
(format #t "~1Tbutton0-rel[3] @ #x~X~%" (-> obj button0-rel))
|
|
(format #t "~1Tstick0-dir: ~f~%" (-> obj stick0-dir))
|
|
(format #t "~1Tstick0-speed: ~f~%" (-> obj stick0-speed))
|
|
(format #t "~1Tnew-pad: ~D~%" (-> obj new-pad))
|
|
(format #t "~1Tstate: ~D~%" (-> obj state))
|
|
(format #t "~1Talign[6] @ #x~X~%" (-> obj align))
|
|
(format #t "~1Tdirect[6] @ #x~X~%" (-> obj direct))
|
|
(format #t "~1Tbuzz-val[2] @ #x~X~%" (-> obj buzz-val))
|
|
(format #t "~1Tbuzz-pause-val[1] @ #x~X~%" (-> obj buzz-pause-val))
|
|
(format #t "~1Tbuzz-pause-time: ~D~%" (-> obj buzz-pause-time))
|
|
(format #t "~1Tbuzz-time[2] @ #x~X~%" (-> obj buzz-time))
|
|
(format #t "~1Tbuzz: ~A~%" (-> obj buzz))
|
|
(format #t "~1Tbuzz-act: ~D~%" (-> obj buzz-act))
|
|
(format #t "~1Tchange-time: ~D~%" (-> obj change-time))
|
|
(format #t "~1Told-rightx[2] @ #x~X~%" (-> obj old-rightx))
|
|
(format #t "~1Told-righty[2] @ #x~X~%" (-> obj old-righty))
|
|
(format #t "~1Told-leftx[2] @ #x~X~%" (-> obj old-leftx))
|
|
(format #t "~1Told-lefty[2] @ #x~X~%" (-> obj old-lefty))
|
|
(label cfg-4)
|
|
obj
|
|
)
|
|
|
|
;; definition for function cpad-invalid!
|
|
(defun cpad-invalid! ((arg0 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))
|
|
)
|
|
(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
|
|
)
|
|
|
|
;; definition for method 0 of type cpad-info
|
|
(defmethod new cpad-info ((allocation symbol) (type-to-make type) (arg0 int))
|
|
(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)
|
|
)
|
|
)
|
|
|
|
;; definition of type cpad-list
|
|
(deftype cpad-list (basic)
|
|
((num-cpads int32 :offset-assert 4)
|
|
(cpads cpad-info 2 :offset-assert 8)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x10
|
|
:flag-assert #x900000010
|
|
(:methods
|
|
(new (symbol type) _type_ 0)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type cpad-list
|
|
(defmethod inspect cpad-list ((obj cpad-list))
|
|
(when (not obj)
|
|
(set! obj obj)
|
|
(goto cfg-4)
|
|
)
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~1Tnum-cpads: ~D~%" (-> obj num-cpads))
|
|
(format #t "~1Tcpads[2] @ #x~X~%" (-> obj cpads))
|
|
(label cfg-4)
|
|
obj
|
|
)
|
|
|
|
;; definition for method 0 of type cpad-list
|
|
(defmethod new cpad-list ((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 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
|
|
)
|
|
)
|
|
|
|
;; definition for function analog-input
|
|
(defun analog-input ((arg0 int) (arg1 float) (arg2 float) (arg3 float) (arg4 float))
|
|
(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)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for function cpad-set-buzz!
|
|
;; WARN: Return type mismatch int vs none.
|
|
(defun cpad-set-buzz! ((arg0 cpad-info) (arg1 int) (arg2 int) (arg3 time-frame))
|
|
(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)
|
|
)
|
|
|
|
;; definition for symbol *cpad-list*, type cpad-list
|
|
(define *cpad-list* (new 'global 'cpad-list))
|
|
|
|
;; definition for symbol *cpad-debug*, type symbol
|
|
(define *cpad-debug* #f)
|
|
|
|
;; definition for function service-cpads
|
|
(defun service-cpads ()
|
|
(let ((pads *cpad-list*))
|
|
(dotimes (i (-> pads num-cpads))
|
|
(let ((pad (-> *cpad-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))
|
|
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))
|
|
(when (= (-> pad status) 115)
|
|
(set! (-> pad abutton 0) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons right))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 1) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons left))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 2) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons up))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 3) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons down))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 6) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons x))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 5) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons circle))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 4) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons triangle))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 7) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons square))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 8) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons l1))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 10) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons l2))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 9) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons r1))
|
|
255
|
|
0
|
|
)
|
|
)
|
|
)
|
|
(set! (-> pad abutton 11) (the-as uint (if (logtest? (-> pad button0-abs 0) (pad-buttons r2))
|
|
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-down) buttons-pushed))
|
|
)
|
|
((< (the-as uint 225) (-> pad lefty))
|
|
(set! buttons-pushed (logior (pad-buttons l-analog-up) 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-down) buttons-pushed))
|
|
)
|
|
((< (the-as uint 225) (-> pad righty))
|
|
(set! buttons-pushed (logior (pad-buttons r-analog-up) 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)
|
|
((2 3)
|
|
(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 2) (= v1-135 3))
|
|
)
|
|
(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! (-> pad button0-rel 0) (logclear (-> pad button0-abs 0) (-> pad button0-abs 1)))
|
|
(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) 0.3)
|
|
(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 (< 0.3 (-> pad stick0-speed)) (zero? (-> pad change-time)))
|
|
)
|
|
(set! (-> pad change-time) (get-current-time))
|
|
)
|
|
)
|
|
(else
|
|
(cpad-invalid! pad)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
*cpad-list*
|
|
)
|
|
|
|
;; definition for function buzz-stop!
|
|
;; WARN: Return type mismatch int vs none.
|
|
(defun buzz-stop! ((arg0 int))
|
|
(cpad-set-buzz! (-> *cpad-list* cpads arg0) 0 0 0)
|
|
(cpad-set-buzz! (-> *cpad-list* cpads arg0) 1 0 0)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
;; definition of type mouse-info
|
|
(deftype mouse-info (basic)
|
|
((active symbol :offset-assert 4)
|
|
(cursor basic :offset-assert 8)
|
|
(valid symbol :offset-assert 12)
|
|
(id uint8 :offset-assert 16)
|
|
(status uint16 :offset-assert 18)
|
|
(button0 uint16 :offset-assert 20)
|
|
(deltax int8 :offset-assert 22)
|
|
(deltay int8 :offset-assert 23)
|
|
(wheel uint8 :offset-assert 24)
|
|
(change-time time-frame :offset-assert 32)
|
|
(button0-abs uint32 3 :offset-assert 40)
|
|
(button0-shadow-abs uint32 1 :offset-assert 52)
|
|
(button0-rel uint32 3 :offset-assert 56)
|
|
(pos vector 2 :inline :offset-assert 80)
|
|
(posx float :offset 80)
|
|
(posy float :offset 84)
|
|
(oldposx float :offset 96)
|
|
(oldposy float :offset 100)
|
|
(speedx float :offset 92)
|
|
(speedy float :offset 108)
|
|
)
|
|
:method-count-assert 9
|
|
:size-assert #x70
|
|
:flag-assert #x900000070
|
|
(:methods
|
|
(new (symbol type) _type_ 0)
|
|
)
|
|
)
|
|
|
|
;; definition for method 3 of type mouse-info
|
|
(defmethod inspect mouse-info ((obj mouse-info))
|
|
(when (not obj)
|
|
(set! obj obj)
|
|
(goto cfg-7)
|
|
)
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~1Tactive: ~A~%" (-> obj active))
|
|
(format #t "~1Tcursor: ~A~%" (-> obj cursor))
|
|
(format #t "~1Tvalid: ~A~%" (-> obj valid))
|
|
(format #t "~1Tid: ~D~%" (-> obj id))
|
|
(format #t "~1Tstatus: #x~X~%" (-> obj status))
|
|
(format #t "~1Tbutton0: #x~X~%" (-> obj button0))
|
|
(format #t "~1Tdeltax: ~D~%" (-> obj deltax))
|
|
(format #t "~1Tdeltay: ~D~%" (-> obj deltay))
|
|
(format #t "~1Twheel: ~D~%" (-> obj wheel))
|
|
(format #t "~1Tchange-time: ~D~%" (-> obj change-time))
|
|
(format #t "~1Tbutton0-abs[3] @ #x~X~%" (-> obj button0-abs))
|
|
(format #t "~1Tbutton0-shadow-abs[1] @ #x~X~%" (-> obj button0-shadow-abs))
|
|
(format #t "~1Tbutton0-rel[3] @ #x~X~%" (-> obj button0-rel))
|
|
(format #t "~1Tpos[2] @ #x~X~%" (-> obj pos))
|
|
(dotimes (s5-0 2)
|
|
(format #t "~T [~D]~1Tpos: ~`vector`P~%" s5-0 (-> obj pos s5-0))
|
|
)
|
|
(format #t "~1Tposx: ~f~%" (-> obj posx))
|
|
(format #t "~1Tposy: ~f~%" (-> obj posy))
|
|
(format #t "~1Toldposx: ~f~%" (-> obj pos 1 x))
|
|
(format #t "~1Toldposy: ~f~%" (-> obj oldposy))
|
|
(format #t "~1Tspeedx: ~f~%" (-> obj speedx))
|
|
(format #t "~1Tspeedy: ~f~%" (-> obj speedy))
|
|
(label cfg-7)
|
|
obj
|
|
)
|
|
|
|
;; definition for method 0 of type mouse-info
|
|
(defmethod new mouse-info ((allocation symbol) (type-to-make type))
|
|
(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
|
|
)
|
|
)
|
|
|
|
;; definition for symbol *mouse*, type mouse-info
|
|
(define *mouse* (new 'global 'mouse-info))
|
|
|
|
;; definition for function service-mouse
|
|
;; INFO: Used lq/sq
|
|
;; WARN: Return type mismatch mouse-info vs none.
|
|
(defun service-mouse ()
|
|
(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) (the-as uint 0))
|
|
(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) v1-22)
|
|
(set! (-> gp-0 button0-abs 0) 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))
|
|
(add-debug-cursor
|
|
#t
|
|
(bucket-id debug-no-zbuf2)
|
|
(+ (the int (-> gp-0 posx)) 256)
|
|
(+ (the int (-> gp-0 posy)) 208)
|
|
(the-as int (-> gp-0 button0-abs 0))
|
|
)
|
|
)
|
|
)
|
|
(none)
|
|
)
|