mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-09-07 03:30:01 -04:00
Code Issues Packages Projects Releases Wiki Activity

Decompiler fixes + decompiling (#276)

Browse Source 
* decomp pad

* more decompilation

* update

* fix test name
This commit is contained in:
water111
2021-02-22 09:36:30 -05:00
committed by GitHub
parent ac24b2ab15
commit 5ec9a91eb9
48 changed files with 2567 additions and 530 deletions
Download Patch File Download Diff File Expand all files Collapse all files
goal_src/engine/dma/dma-buffer.gc
+1 -1
View File
@@ -59,7 +59,7 @@
(deftype dma-buffer (basic)
((allocated-length int32 :offset-assert 4)
(base pointer :offset-assert 8)
(end uint32 :offset-assert 12)
(end pointer :offset-assert 12)
(data uint64 1 :offset-assert 16) ;; weird, I guess this aligns the data?
(data-buffer uint8 :dynamic :offset 16)
)
goal_src/engine/dma/dma-disasm.gc
+179
View File
@@ -19,3 +19,182 @@
)
(defun disasm-vif-details ((stream symbol) (data (pointer uint8)) (kind int) (count int))
(local-vars
(v1-21 uint)
(v1-26 uint)
(a3-7 int)
(i int)
(s2-1 int)
(s2-2 int)
(s2-3 int)
(s2-4 int)
(s2-5 int)
(s2-6 int)
(data-ptr (pointer uint8))
(s3-1 (pointer uint8))
(s3-2 (pointer uint8))
(s3-3 (pointer uint8))
(s3-4 (pointer uint8))
(s3-5 (pointer uint8))
(s3-6 (pointer uint8))
(count2 int)
)
(set! count2 count)
(cond
((= kind 110)
(set! data-ptr (&-> data 4))
(set! i 0)
(while (< i count2)
(format stream " #x~X: #x~2X #x~2X #x~2X #x~2X~%"
(+ (+ (shl i 2) 4) (the-as int data))
(-> (the-as (pointer uint8) (&+ data-ptr (shl i 2))))
(-> (the-as (pointer uint8) (&+ data-ptr (+ (shl i 2) 1))))
(-> (the-as (pointer uint8) (&+ data-ptr (+ (shl i 2) 2))))
(-> (the-as (pointer uint8) (&+ data-ptr (+ (shl i 2) 3))))
)
(+! i 1)
)
)
((= kind 98)
(set! s3-1 (&-> data 4))
(set! s2-1 0)
(while (< s2-1 count2)
(format stream " #x~X: #x~2x~%" (+ (+ s2-1 4) (the-as int data)) count)
(set! v1-21 (-> (the-as (pointer uint8) (&+ s3-1 (* 3 s2-1)))))
(set! v1-26 (-> (the-as (pointer uint8) (&+ s3-1 (+ (* 3 s2-1) 1)))))
(+! s2-1 1)
)
)
((= kind 108)
(set! s3-2 (&-> data 4))
(set! s2-2 0)
(while (< s2-2 count2)
(format stream " #x~X: #x~8x #x~8x #x~8x #x~8x~%"
(+ (+ (shl s2-2 4) 4) (the-as int data))
(-> (the-as (pointer uint32) (&+ s3-2 (shl (shl s2-2 2) 2))))
(-> (the-as (pointer uint32) (&+ s3-2 (shl (+ (shl s2-2 2) 1) 2))))
(-> (the-as (pointer uint32) (&+ s3-2 (shl (+ (shl s2-2 2) 2) 2))))
(-> (the-as (pointer uint32) (&+ s3-2 (shl (+ (shl s2-2 2) 3) 2))))
)
(+! s2-2 1)
)
)
((= kind 109)
(set! s3-3 (&-> data 4))
(set! s2-3 0)
(while
(< s2-3 count2)
(format stream " #x~X: #x~4x #x~4x #x~4x #x~4x~%"
(+ (+ (shl s2-3 3) 4) (the-as int data))
(-> (the-as (pointer uint16) (&+ s3-3 (shl (shl s2-3 2) 1))))
(-> (the-as (pointer uint16) (&+ s3-3 (shl (+ (shl s2-3 2) 1) 1))))
(-> (the-as (pointer uint16) (&+ s3-3 (shl (+ (shl s2-3 2) 2) 1))))
(-> (the-as (pointer uint16) (&+ s3-3 (shl (+ (shl s2-3 2) 3) 1))))
)
(+! s2-3 1)
)
)
((= kind 104)
(set! s3-4 (&-> data 4))
(set! s2-4 0)
(while
(< s2-4 count2)
(format stream
" #x~X: #x~8x #x~8x #x~8x~%"
(+ (+ (* 12 s2-4) 4) (the-as int data))
(-> (the-as (pointer uint32) (&+ s3-4 (* 12 s2-4))))
(-> (the-as (pointer uint32) (&+ s3-4 (shl (+ (* 3 s2-4) 1) 2))))
(-> (the-as (pointer uint32) (&+ s3-4 (shl (+ (* 3 s2-4) 2) 2))))
)
(+! s2-4 1)
)
)
((= kind 105)
(set! s3-5 (&-> data 4))
(set! s2-5 0)
(while
(< s2-5 count2)
(format stream
" #x~X: #x~4x #x~4x #x~4x~%"
(+ (+ (* 6 s2-5) 4) (the-as int data))
(-> (the-as (pointer uint16) (&+ s3-5 (* 6 s2-5))))
(-> (the-as (pointer uint16) (&+ s3-5 (shl (+ (* 3 s2-5) 1) 1))))
(-> (the-as (pointer uint16) (&+ s3-5 (shl (+ (* 3 s2-5) 2) 1))))
)
(+! s2-5 1)
)
)
((= kind 101)
(set! s3-6 (&-> data 4))
(set! s2-6 0)
(while
(< s2-6 count2)
(format stream " #x~X: #x~4x #x~4x~%"
(+ (+ (shl s2-6 2) 4) (the-as int data))
(-> (the-as (pointer uint16) (&+ s3-6 (* 6 s2-6))))
(-> (the-as (pointer uint16) (&+ s3-6 (shl (+ (* 3 s2-6) 1) 1))))
)
(+! s2-6 1)
)
)
(else
(set! a3-7 kind)
(format stream
" #x~X: Data format #b~b not yet supported, add it for yourself!~%"
(&-> data 4)
a3-7
)
)
)
#f
)
(defun disasm-dma-tag ((arg0 uint) (arg1 symbol))
"Print out a dma-tag"
(local-vars
(v1-1 uint)
(v1-15 int)
)
(format arg1 "(dma-tag ")
;; this is a case used by value, which it doesn't like because the temp v1-1 can't be folded into a single
;; expression. In reality, the game does the following line _after_ the format symbol is loaded,
;; but this makes no difference and OpenGOAL doesn't have case, so we have to make do with this.
(set! v1-1 (shr (shl arg0 33) 61))
(format arg1 "~s"
(cond
((= v1-1 7) "end")
((= v1-1 6) "ret")
((= v1-1 5) "call")
((= v1-1 4) "refs")
((= v1-1 3) "ref")
((= v1-1 2) "next")
((= v1-1 1) "cnt")
((zero? v1-1) "refe")
(else "*unknown*")
)
)
;; only print address if nonzero
(if (> (shr (shl arg0 1) 33) 0)
(format arg1 " :addr #x~8x" (shr (shl arg0 1) 33))
)
;; only print qwc if nonzero
(if (> (shr (shl arg0 48) 48) 0)
(format arg1 " :qwc ~d" (shr (shl arg0 48) 48))
)
;; only print spr if set
(if (> (shr arg0 63) 0)
(format arg1 " :spr ~d" (shr arg0 63)))
;;(.srl v1-15 arg0 31)
(set! v1-15 (logand #xffffffff (shr arg0 31)))
(when (> (the-as uint v1-15) 0)
(format arg1 " :irq ~d" (logand #xffffffff (shr arg0 31)))
)
(if (> (shr (shl arg0 36) 62) 0)
(format arg1 " :pce ~d" (shr (shl arg0 36) 62))
)
(the-as int (format arg1 ")~%"))
)
goal_src/engine/dma/dma-h.gc
+2 -1
View File
@@ -86,7 +86,8 @@
(defconstant VIF0_DMA_BANK (the dma-bank-vif #x10008000))
(defconstant VIF1_DMA_BANK (the dma-bank-vif #x10009000))
;; gif, ipuFrom, ipTop, sif0, sif1, sif2 believed unused.
(defconstant GIF_DMA_BANK (the dma-bank #x1000a000))
;; ipuFrom, ipTop, sif0, sif1, sif2 believed unused.
(defconstant SPR_FROM_BANK (the dma-bank-spr #x1000d000))
(defconstant SPR_TO_BANK (the dma-bank-spr #x1000d400))
goal_src/engine/gfx/hw/display-h.gc
+183
View File
@@ -5,3 +5,186 @@
;; name in dgo: display-h
;; dgos: GAME, ENGINE
(declare-type display basic)
(define-extern set-display (function display int int int int int display))
(deftype display-env (structure)
((pmode uint64 :offset-assert 0)
(smode2 uint64 :offset-assert 8)
(dspfb uint64 :offset-assert 16)
(display uint64 :offset-assert 24)
(bgcolor uint64 :offset-assert 32)
)
:pack-me
:method-count-assert 9
:size-assert #x28
:flag-assert #x900000028
)
(deftype draw-env (structure)
((frame1 uint64 :offset-assert 0)
(frame1addr uint64 :offset-assert 8)
(zbuf1 uint64 :offset-assert 16)
(zbuf1addr uint64 :offset-assert 24)
(xyoffset1 uint64 :offset-assert 32)
(xyoffset1addr uint64 :offset-assert 40)
(scissor1 uint64 :offset-assert 48)
(scissor1addr uint64 :offset-assert 56)
(prmodecont uint64 :offset-assert 64)
(prmodecontaddr uint64 :offset-assert 72)
(colclamp uint64 :offset-assert 80)
(colclampaddr uint64 :offset-assert 88)
(dthe uint64 :offset-assert 96)
(dtheaddr uint64 :offset-assert 104)
(test1 uint64 :offset-assert 112)
(test1addr uint64 :offset-assert 120)
)
:method-count-assert 9
:size-assert #x80
:flag-assert #x900000080
)
(defun put-draw-env ((packet dma-packet))
"Uses the qwc stored in the packet."
;; TODO - good spot to patch for PC, or maybe just exclude.
(dma-send GIF_DMA_BANK (the uint packet) (+ (the uint 1) (-> packet dma qwc)))
)
(deftype display-frame (basic)
((buffer int32 11 :offset-assert 4) ;; no idea
(calc-buf basic :offset 8) ;; todo - maybe DMA buffers?
(vu1-buf basic :offset 8)
(debug-buf basic :offset 36)
(global-buf basic :offset 40)
(bucket-group dma-bucket :offset 44)
(profile-bar basic 2 :offset 48)
(run-time uint64 :offset 56)
)
(:methods
(new (symbol type) _type_ 0)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
(defmethod new display-frame ((allocation symbol) (type-to-make type))
"Allocate a new display-frame"
(local-vars (obj display-frame))
(set! obj (object-new allocation type-to-make (the-as int (-> type-to-make size))))
(set! (-> obj buffer 1) 0)
(set! (-> obj buffer 9) 0)
(set! (-> obj buffer 8) 0)
(when *debug-segment*
(set! (-> obj profile-bar 0) (new 'debug 'profile-bar))
(set! (-> obj profile-bar 1) (new 'debug 'profile-bar))
)
obj
)
(deftype virtual-frame (structure)
((display display-env :offset-assert 0)
(display-last display-env :offset-assert 4)
(gif pointer :offset-assert 8)
(draw draw-env :offset-assert 12)
(frame display-frame :offset-assert 16)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
(deftype display (basic)
((display-env0 display-env :inline :offset-assert 8)
(display-env1 display-env :inline :offset-assert 48)
(display-env2 display-env :inline :offset-assert 88)
(gif-tag0 uint128 :offset-assert 128)
(draw0 draw-env :inline :offset-assert 144)
(gif-tag1 uint128 :offset-assert 272)
(draw1 draw-env :inline :offset-assert 288)
(gif-tag2 uint128 :offset-assert 416)
(draw2 draw-env :inline :offset-assert 432)
(on-screen int32 :offset-assert 560)
(last-screen int32 :offset-assert 564)
(frames virtual-frame 6 :inline :offset-assert 568)
(bg-clear-color uint32 4 :offset-assert 760)
(real-frame-counter uint64 :offset-assert 776)
(base-frame-counter uint64 :offset-assert 784)
(game-frame-counter uint64 :offset-assert 792)
(integral-frame-counter uint64 :offset-assert 800)
(real-integral-frame-counter uint64 :offset-assert 808)
(actual-frame-counter uint64 :offset-assert 816)
(real-actual-frame-counter uint64 :offset-assert 824)
(part-frame-counter uint64 :offset-assert 832)
(old-real-frame-counter uint64 :offset-assert 840)
(old-base-frame-counter uint64 :offset-assert 848)
(old-game-frame-counter uint64 :offset-assert 856)
(old-integral-frame-counter uint64 :offset-assert 864)
(old-real-integral-frame-counter uint64 :offset-assert 872)
(old-actual-frame-counter uint64 :offset-assert 880)
(old-real-actual-frame-counter uint64 :offset-assert 888)
(old-part-frame-counter uint64 :offset-assert 896)
(time-ratio float :offset-assert 904)
(seconds-per-frame float :offset-assert 908)
(frames-per-second float :offset-assert 912)
(time-factor float :offset-assert 916)
(time-adjust-ratio float :offset-assert 920)
)
:method-count-assert 10
:size-assert #x39c
:flag-assert #xa0000039c
(:methods
(new (symbol type int int int int int) _type_ 0)
(dummy-9 () none 9)
)
)
(defmethod new display ((allocation symbol) (type-to-make type) (psm int) (w int) (h int) (ztest int) (zpsm int))
(local-vars (obj display))
(set! obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
(set-display obj psm w h ztest zpsm)
(set! (-> obj frames 0 display) (-> obj display-env0))
(set! (-> obj frames 1 display) (-> obj display-env1))
(set! (-> obj frames 2 display) (-> obj display-env2))
(set! (-> obj frames 3 display) (-> obj display-env0))
(set! (-> obj frames 4 display) (-> obj display-env1))
(set! (-> obj frames 5 display) (-> obj display-env2))
(set! (-> obj frames 0 display-last) (-> obj display-env2))
(set! (-> obj frames 1 display-last) (-> obj display-env0))
(set! (-> obj frames 2 display-last) (-> obj display-env1))
(set! (-> obj frames 3 display-last) (-> obj display-env2))
(set! (-> obj frames 4 display-last) (-> obj display-env0))
(set! (-> obj frames 5 display-last) (-> obj display-env1))
(set! (-> obj frames 0 gif) (&-> obj gif-tag0))
(set! (-> obj frames 1 gif) (&-> obj gif-tag1))
(set! (-> obj frames 2 gif) (&-> obj gif-tag2))
(set! (-> obj frames 3 gif) (&-> obj gif-tag0))
(set! (-> obj frames 4 gif) (&-> obj gif-tag1))
(set! (-> obj frames 5 gif) (&-> obj gif-tag2))
(set! (-> obj frames 0 draw) (-> obj draw0))
(set! (-> obj frames 1 draw) (-> obj draw1))
(set! (-> obj frames 2 draw) (-> obj draw2))
(set! (-> obj frames 3 draw) (-> obj draw0))
(set! (-> obj frames 4 draw) (-> obj draw1))
(set! (-> obj frames 5 draw) (-> obj draw2))
(set! (-> obj frames 0 frame) (new 'global 'display-frame))
(set! (-> obj frames 1 frame) (new 'global 'display-frame))
(set! (-> obj frames 2 frame) (-> obj frames 0 frame))
(set! (-> obj frames 3 frame) (-> obj frames 1 frame))
(set! (-> obj frames 4 frame) (-> obj frames 0 frame))
(set! (-> obj frames 5 frame) (-> obj frames 1 frame))
(default-buffer-init *default-regs-buffer*)
(set! (-> obj bg-clear-color 0) #x80808080)
(set! (-> obj bg-clear-color 1) #x80808080)
(set! (-> obj bg-clear-color 2) #x80808080)
(set! (-> obj bg-clear-color 3) #x80808080)
obj
)
(define *pre-draw-hook* nothing)
(define *post-draw-hook* nothing)
goal_src/engine/gfx/hw/gs.gc
+518
View File
@@ -5,3 +5,521 @@
;; name in dgo: gs
;; dgos: GAME, ENGINE
(deftype gs-pmode (uint64)
()
:flag-assert #x900000008
)
(deftype gs-smode2 (uint64)
()
:flag-assert #x900000008
)
;; 19 = PSMT8
;; 20 = PSMT4
;; 2 = PSMCT24
;; 10 = PSMCT16S
;; 50 = PSMZ16
;; 58 = PSMZ16S
(defconstant TEX_MZ16S 58)
(defconstant TEX_MZ16 50)
(defconstant TEX_MZ24 49)
(defconstant TEX_MZ32 48)
(defconstant TEX_MT4HH 44)
(defconstant TEX_MT4HL 36)
(defconstant TEX_MT8H 27)
(defconstant TEX_MT4 20)
(defconstant TEX_MT8 19)
(defconstant TEX_CT16S 10)
(defconstant TEX_CT16 2)
(defconstant TEX_CT24 1)
(defconstant TEX_CT32 0)
(defun psm-size ((arg0 int))
"Not sure exactly what 'size' means, but this likely takes a texture format as an input."
(cond
((= arg0 TEX_MT8) 64)
((= arg0 TEX_MT4) 32)
(else
(if (or (= arg0 TEX_CT16) (= arg0 TEX_CT16S) (= arg0 TEX_MZ16) (= arg0 TEX_MZ16S))
128
256
)
)
)
)
(defun psm-page-height ((arg0 int))
"texture format -> page height?"
(cond
((= arg0 TEX_MT8) 64)
((= arg0 TEX_MT4) 128)
(else
(if (or (= arg0 TEX_CT16) (= arg0 TEX_CT16S) (= arg0 TEX_MZ16) (= arg0 TEX_MZ16S))
64
32
)
)
)
)
(defun psm->string ((arg0 int))
"Convert texture format to its name"
(local-vars (v1-0 int))
(set! v1-0 arg0)
(cond
((= v1-0 TEX_MZ16S) "mz16s")
((= v1-0 TEX_MZ16) "mz16")
((= v1-0 TEX_MZ24) "mz24")
((= v1-0 TEX_MZ32) "mz32")
((= v1-0 TEX_MT4HH) "mt4hh")
((= v1-0 TEX_MT4HL) "mt4hl")
((= v1-0 TEX_MT8H) "mt8h")
((= v1-0 TEX_MT4) "mt4")
((= v1-0 TEX_MT8) "mt8")
((= v1-0 TEX_CT16S) "ct16s")
((= v1-0 TEX_CT16) "ct16")
((= v1-0 TEX_CT24) "ct24")
((zero? v1-0) "ct32")
(else "*unknown*")
)
)
(deftype gs-display-fb (uint64)
()
:flag-assert #x900000008
)
(deftype gs-display (uint64)
()
:flag-assert #x900000008
)
(deftype gs-bgcolor (uint64)
()
:flag-assert #x900000008
)
(deftype gs-csr (uint64)
()
:flag-assert #x900000008
)
(deftype gs-bank (structure)
((pmode gs-pmode :offset-assert 0)
(smode2 gs-smode2 :offset 32)
(dspfb1 gs-display-fb :offset 112)
(display1 gs-display :offset 128)
(dspfb2 gs-display-fb :offset 144)
(display2 gs-display :offset 160)
(extbuf uint64 :offset 176)
(extdata uint64 :offset 192)
(extwrite uint64 :offset 208)
(bgcolor gs-bgcolor :offset 224)
(csr gs-csr :offset 4096)
(imr uint64 :offset 4112)
(busdir uint64 :offset 4160)
)
:method-count-assert 9
:size-assert #x1048
:flag-assert #x900001048
)
(deftype gs-frame (uint64)
()
:flag-assert #x900000008
)
(deftype gs-zbuf (uint64)
()
:flag-assert #x900000008
)
(deftype gs-xy-offset (uint64)
()
:flag-assert #x900000008
)
(deftype gs-scissor (uint64)
()
:flag-assert #x900000008
)
(deftype gs-prmode-cont (uint64)
()
:flag-assert #x900000008
)
(deftype gs-color-clamp (uint64)
()
:flag-assert #x900000008
)
(deftype gs-dthe (uint64)
()
:flag-assert #x900000008
)
(deftype gs-test (uint64)
()
:flag-assert #x900000008
)
(deftype gs-prim (uint64)
()
:flag-assert #x900000008
)
(deftype gs-rgbaq (uint64)
()
:flag-assert #x900000008
)
(deftype gs-xyz (uint64)
()
:flag-assert #x900000008
)
(deftype gs-uv (uint64)
()
:flag-assert #x900000008
)
(deftype gs-st (uint64)
()
:flag-assert #x900000008
)
(deftype gs-xyzf (uint64)
()
:flag-assert #x900000008
)
(deftype gs-trxpos (uint64)
()
:flag-assert #x900000008
)
(deftype gs-trxreg (uint64)
()
:flag-assert #x900000008
)
(deftype gs-trxdir (uint64)
()
:flag-assert #x900000008
)
(deftype gs-bitbltbuf (uint64)
()
:flag-assert #x900000008
)
(deftype gs-tex0 (uint64)
()
:flag-assert #x900000008
)
(deftype gs-tex1 (uint64)
()
:flag-assert #x900000008
)
(deftype gs-texa (uint64)
()
:flag-assert #x900000008
)
(deftype gs-texclut (uint64)
()
:flag-assert #x900000008
)
(deftype gs-miptbp (uint64)
()
:flag-assert #x900000008
)
(deftype gs-alpha (uint64)
()
:flag-assert #x900000008
)
(defmethod inspect gs-alpha ((obj gs-alpha))
(format #t "[~8x] ~A~%" obj 'gs-alpha)
(format #t "~Ta: ~D~%" (shr (shl (the-as int obj) 62) 62))
(format #t "~Tb: ~D~%" (shr (shl (the-as int obj) 60) 62))
(format #t "~Tc: ~D~%" (shr (shl (the-as int obj) 58) 62))
(format #t "~Td: ~D~%" (shr (shl (the-as int obj) 56) 62))
(format #t "~Tfix: ~D~%" (shr (shl (the-as int obj) 24) 56))
obj
)
(deftype gs-fog (uint64)
()
:flag-assert #x900000008
)
(defmethod inspect gs-fog ((obj gs-fog))
(format #t "[~8x] ~A~%" obj 'gs-fog)
(format #t "~Tf: ~D~%" (shr (the-as int obj) 56))
obj
)
(deftype gs-fogcol (uint64)
()
:flag-assert #x900000008
)
(defmethod inspect gs-fogcol ((obj gs-fogcol))
(format #t "[~8x] ~A~%" obj 'gs-fogcol)
(format #t "~Tr: ~D~%" (shr (shl (the-as int obj) 56) 56))
(format #t "~Tg: ~D~%" (shr (shl (the-as int obj) 48) 56))
(format #t "~Tb: ~D~%" (shr (shl (the-as int obj) 40) 56))
obj
)
(deftype gif-ctrl (uint32)
()
:flag-assert #x900000004
)
(deftype gif-mode (uint32)
()
:flag-assert #x900000004
)
(deftype gif-stat (uint32)
()
:flag-assert #x900000004
)
(deftype gif-cnt (uint32)
()
:flag-assert #x900000004
)
(deftype gif-p3cnt (uint32)
()
:flag-assert #x900000004
)
(deftype gif-p3tag (uint32)
()
:flag-assert #x900000004
)
(deftype gif-bank (structure)
((ctrl gif-ctrl :offset 0)
(mode gif-mode :offset 16)
(stat gif-stat :offset 32)
(tag0 uint32 :offset 64)
(tag1 uint32 :offset 80)
(tag2 uint32 :offset 96)
(tag3 uint32 :offset 112)
(cnt gif-cnt :offset 128)
(p3cnt gif-p3cnt :offset 144)
(p3tag gif-p3tag :offset 160)
)
:method-count-assert 9
:size-assert #xa4
:flag-assert #x9000000a4
)
(deftype gif-tag-prim (uint32)
()
:flag-assert #x900000004
)
(deftype gif-tag-count (uint32)
()
:flag-assert #x900000004
)
(deftype gif-tag64 (uint64)
()
:flag-assert #x900000008
)
(deftype gif-tag (uint128)
()
:flag-assert #x900000010
)
(deftype gs-gif-tag (structure)
((qword uint128 :offset-assert 0) ;; is "qword" and inline? in game
(dword uint64 2 :offset 0)
(word uint32 4 :offset 0)
(tag uint64 :offset 0)
(regs uint64 :offset 8)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; Note - there was an inspect method for the uint128-based gif-tag, but it is being left out.
;; no idea what format this is stored in. Looks like a nasty orange?
(define *fog-color* #xc88029)
;; set up a DMA buffer. This will hold a message to set the GS state to normal.
;; these regs are NOT the ones mapped in the EE memory, but other internal GS registers.
(define *default-regs-buffer* (new 'global 'dma-buffer 1024))
(defun default-buffer-init ((buff dma-buffer))
"Puts some currently unknown gif tags in the buffer."
(local-vars
(tag3 gs-gif-tag)
(tag gs-gif-tag)
(tag2 gs-gif-tag)
(data (pointer uint64))
)
;; reset the buffer base and end.
(set! (-> buff base) (-> buff data))
(set! (-> buff end) (&-> buff data-buffer (-> buff allocated-length)))
;; make a tag (maybe this is actually a dma/vif tag?)
(set! tag (the gs-gif-tag (-> buff base)))
(set! (-> tag dword 0) #x1000000a)
(set! (-> tag word 2) #x13000000)
(set! (-> tag word 3) #x5000000a)
(set! (-> buff base) (&+ (the-as pointer tag) 16))
;; make another tag.
(set! tag2 (the gs-gif-tag (-> buff base)))
;; no idea what this is about, it doesn't matter.
;;(set! a2-3 (l.d L53))
;;(.pcpyld a2-4 r0-0 a2-3)
(set! (-> tag2 dword 0) #x9000000000008001)
(set! (-> tag2 dword 1) #xeeeeeeeeeeeeeeee)
(set! (-> buff base) (&+ (the-as pointer tag2) 16))
;; now some payload.
(set! data (the (pointer uint64) (-> buff base)))
(set! (-> data 0) 68)
(set! (-> data 1) 66)
(set! (-> data 2) #x10001c0)
(set! (-> data 3) 78)
(set! (-> data 4) #x5000e)
(set! (-> data 5) 71)
(set! (-> data 6) 0)
(set! (-> data 7) 73)
(set! (-> data 8) 5)
(set! (-> data 9) 8)
(set! (-> data 10) 96)
(set! (-> data 11) 20)
(set! (-> data 12) (shl 128 32))
(set! (-> data 13) 59)
(set! (-> data 14) 4)
(set! (-> data 15) 28)
(set! (-> data 16) *fog-color*)
(set! (-> data 17) 61)
(set! (-> buff base) (&-> data 18))
;; and a final tag.
(set! tag3 (the gs-gif-tag (-> buff base)))
(set! (-> tag3 dword 0) #x60000000)
(set! (-> tag3 word 2) 0)
(set! (-> tag3 word 3) 0)
(set! (-> buff base) (&+ (the-as pointer tag3) 16))
(none)
)
(default-buffer-init *default-regs-buffer*)
;; This isn't a dynamic type in the type system, but it's used as one.
;; the array at the end is used as a dynamic array.
;; NOTE - this gif-packet stuff seems unused. Instead dma-gif-packet is used.
;; this seems to use 128-bit integer values, but the compiler gets confused sometimes??
;; This stuff could be used like this:
;; - new gif-packet
;; - open-gif-packet
;; - add-reg-gif-packet to add a register
;; - close-gif-packet
;; now you have a reglist gs packet.
(deftype gif-packet (basic)
((reg-count int32 :offset-assert 4)
(gif-tag0 uint128 :offset-assert 16)
(gif-tag gs-gif-tag :inline :offset 16)
(args uint64 1 :offset-assert 32) ;; there's one here already.
)
(:methods
(new (symbol type int) _type_ 0)
)
:method-count-assert 9
:size-assert #x28
:flag-assert #x900000028
)
(defmethod new gif-packet ((allocation symbol) (type-to-make type) (arg0 int))
"Make a new gif packet with enough room for arg0 64-bit args"
(object-new allocation type-to-make
(the-as int (+ (-> type-to-make size) (shl (+ arg0 -1) 3)))
)
)
(defun open-gif-packet ((arg0 gif-packet))
"Initialize a gif packet"
(set! (-> arg0 reg-count) 0)
(set! (-> arg0 gif-tag dword 1) 0)
arg0
)
(defun add-reg-gif-packet ((packet gif-packet) (reg-idx int) (reg-val int))
"Adds a register to reglist packet."
(local-vars (tag gs-gif-tag))
(set! tag (-> packet gif-tag))
;; dword 1 contains the list of registers to set. each is 4-bits.
(set! (-> tag dword 1)
(logior (-> tag dword 1)
(the-as uint (ash reg-idx (shl (-> packet reg-count) 2))) ;; shift to the correct spot
)
)
;; ?? (-> packet args (-> packet reg-count))
;; store the value for the register.
(set! (-> (&-> packet args (-> packet reg-count)) 0) reg-val)
;; increment the reg we're on.
(set! (-> packet reg-count) (+ (-> packet reg-count) 1))
(none)
)
(defun close-gif-packet ((arg0 gif-packet) (arg1 int))
"Sets the lower dword of the giftag for reglist"
(local-vars (v1-2 int) (v1-3 int))
(set! v1-2
(logior (logior #x400000000000001 (the-as uint (shl (-> arg0 reg-count) 60)))
(the-as uint (shr (shl arg1 63) 48))
)
)
;;(.pcpyld v1-3 r0-0 v1-2)?? GOAL compiler is confused.
(set! (-> arg0 gif-tag dword 0) v1-2)
arg0
)
(deftype draw-context (basic)
((orgx int32 :offset-assert 4)
(orgy int32 :offset-assert 8)
(orgz int32 :offset-assert 12)
(width int32 :offset-assert 16)
(height int32 :offset-assert 20)
(color int32 4 :offset-assert 24)
)
(:methods
(new (symbol type int int int int int) _type_ 0)
)
:method-count-assert 9
:size-assert #x28
:flag-assert #x900000028
)
(defmethod new draw-context ((allocation symbol)
(type-to-make type)
(org-x int)
(org-y int)
(width int)
(height int)
(color-0 int)
)
"Allocate and initialize a draw-context"
(local-vars (v0-0 draw-context) (v1-3 int) (a0-2 int))
(set! v0-0
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
(set! v1-3
(the int (* (the float org-y) (-> *video-parms* relative-y-scale)))
)
(set! a0-2
(the int (* (the float height) (-> *video-parms* relative-y-scale)))
)
(set! (-> v0-0 orgx) org-x)
(set! (-> v0-0 orgy) v1-3)
(set! (-> v0-0 orgz) #xffffff)
(set! (-> v0-0 width) width)
(set! (-> v0-0 height) a0-2)
(set! (-> v0-0 color 0) color-0)
v0-0
)
(defun draw-context-set-xy ((arg0 draw-context) (x int) (y int))
"Set the origin of the draw context, scaling by relative-y-scale as needed."
(local-vars (v0-0 int))
(set! v0-0 (the int (* (the float y) (-> *video-parms* relative-y-scale))))
(set! (-> arg0 orgx) x)
(set! (-> arg0 orgy) v0-0)
(none)
)
goal_src/engine/load/file-io.gc
+107 -95
View File
@@ -19,8 +19,8 @@
(file uint32 :offset-assert 16)
)
(:methods
(new ((allocation symbol) (type-to-make type) (name string) (mode basic)) _type_)
)
(new ((allocation symbol) (type-to-make type) (name string) (mode basic)) _type_)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
@@ -28,26 +28,26 @@
(defmethod new file-stream ((allocation symbol) (type-to-make type) (name string) (mode basic))
"Allocate a file-stream and open it."
(let ((stream (object-new allocation type-to-make)))
(file-stream-open stream name mode)
stream
)
)
"Allocate a file-stream and open it."
(let ((stream (object-new allocation type-to-make)))
(file-stream-open stream name mode)
stream
)
)
;; we already have a length method for a file-stream defined in C.
;; just store that in the method table.
(set! (-> file-stream method-table 4) file-stream-length)
(defun file-stream-read-string ((stream file-stream) (str string))
"Fill a string with data from a file stream.
"Fill a string with data from a file stream.
Note: this function does not work."
;; makes the length of the string 0.
(clear str)
;; so this will read nothing.
(file-stream-read stream (-> str data) (length str))
str
)
;; makes the length of the string 0.
(clear str)
;; so this will read nothing.
(file-stream-read stream (-> str data) (length str))
str
)
;; A common file header found in GOAL files.
@@ -66,63 +66,77 @@
)
(defmethod print file-info ((obj file-info))
"Print information about a file"
(format #t "#<~A ~A :version ~D.~D @ #x~X>"
(-> obj type) (-> obj file-name) (-> obj major-version) (-> obj minor-version) obj)
obj
)
"Print information about a file"
(format #t "#<~A ~A :version ~D.~D @ #x~X>"
(-> obj type) (-> obj file-name) (-> obj major-version) (-> obj minor-version) obj)
obj
)
;; allocate a temporary string
(define *file-temp-string* (new 'global 'string 128 (the string #f)))
(defconstant LEVEL_BT_FILE 0) ;; aka bsp-header
(defconstant LEVEL_BT_FILE_VERSION 30)
(defconstant ART_GROUP_FILE 1)
(defconstant ART_GROUP_FILE_VERSION 6)
(defconstant TPAGE_FILE 2)
(defconstant TPAGE_FILE_VERSION 7) ;; also used for dir
(defconstant DIR_TPAGE_FILE 3)
(defconstant LEVEL_VS_FILE 4)
(defconstant LEVEL_VS_FILE_VERSION 30)
(defconstant TX_FILE 5)
(defconstant TX_FILE_VERSION 1)
(defconstant VIS_FILE 6)
(defun make-file-name ((kind int) (name string) (art-group-version int))
"Make a file name. Similar to MakeFileName in C.
"Make a file name. Similar to MakeFileName in C.
Note: file type enum is different between C and GOAL.
File versions should match those in versions.h.
Uses a single *file-temp-string* buffer, shared with make-vfile-name."
(clear *file-temp-string*)
(cond
((= kind 3)
(format *file-temp-string* "texture-page~D/dir-tpages" 7))
((= kind 2)
(format *file-temp-string* "texture-page~D/tpage-~S" 7 name))
((zero? kind)
(format *file-temp-string* "level~D/~S-bt" 30 name))
((= kind 5)
(format *file-temp-string* "res~D/~S-tx" 1 name))
((= kind 4)
(format *file-temp-string* "level~D/~S-vs" 30 name))
((= kind 6)
(format *file-temp-string* "~S.VIS" name))
((= kind 1)
(format *file-temp-string* "art-group~D/~S-ag"
(if (> art-group-version 0) art-group-version 6)
name
)
)
)
*file-temp-string*
)
(clear *file-temp-string*)
(cond
((= kind DIR_TPAGE_FILE)
(format *file-temp-string* "texture-page~D/dir-tpages" TPAGE_FILE_VERSION))
((= kind TPAGE_FILE)
(format *file-temp-string* "texture-page~D/tpage-~S" TPAGE_FILE_VERSION name))
((= kind LEVEL_BT_FILE)
(format *file-temp-string* "level~D/~S-bt" LEVEL_BT_FILE_VERSION name))
((= kind TX_FILE)
(format *file-temp-string* "res~D/~S-tx" TX_FILE_VERSION name))
((= kind LEVEL_VS_FILE)
(format *file-temp-string* "level~D/~S-vs" LEVEL_VS_FILE_VERSION name))
((= kind VIS_FILE)
(format *file-temp-string* "~S.VIS" name))
((= kind ART_GROUP_FILE)
(format *file-temp-string* "art-group~D/~S-ag"
(if (> art-group-version 0) art-group-version ART_GROUP_FILE_VERSION)
name
)
)
)
*file-temp-string*
)
(defun make-vfile-name ((a0-0 int) (a1-0 string))
"Make another type of file name."
(local-vars
(s5-0 int)
(gp-0 string)
)
(set! s5-0 a0-0)
(set! gp-0 a1-0)
(clear *file-temp-string*)
(cond
((zero? s5-0) (format *file-temp-string* "$LEVEL/~S" gp-0))
((= s5-0 1) (format *file-temp-string* "$ART_GROUP/~S" gp-0))
)
*file-temp-string*
)
(local-vars
(s5-0 int)
(gp-0 string)
)
(set! s5-0 a0-0)
(set! gp-0 a1-0)
(clear *file-temp-string*)
(cond
((zero? s5-0) (format *file-temp-string* "$LEVEL/~S" gp-0))
((= s5-0 1) (format *file-temp-string* "$ART_GROUP/~S" gp-0))
)
*file-temp-string*
)
(defun file-info-correct-version? ((info file-info) (kind int) (version int))
"Check if the file info is valid. If you call this with version = 0,
@@ -134,35 +148,35 @@
(expected-version int)
)
;; figure out the expected major version
(set! expected-version
(cond
((zero? version) ;; version not specified.
(set! v1-0 kind)
(cond
((or (zero? (+ v1-0 -2)) (zero? (+ v1-0 -3))) 7) ;; textures.
((zero? v1-0) 30) ;; level
((= v1-0 1) 6) ;; art-group
)
)
(else version) ;; version was specified
)
)
;; figure out the expected kind
(set! expected-kind
(begin
(set! v1-1 kind)
(cond ((= v1-1 2) "texture-page")
((zero? v1-1) "bsp-header")
((= v1-1 1) "art-group"))
)
)
;; check:
(cond
;; first, check the name is right:
;; not clear why we dereference the symbol like this.
;; figure out the expected major version
(set! expected-version
(cond
((zero? version) ;; version not specified.
(set! v1-0 kind)
(cond
((or (= v1-0 TPAGE_FILE) (= v1-0 DIR_TPAGE_FILE)) TPAGE_FILE_VERSION) ;; textures.
((= v1-0 LEVEL_BT_FILE) LEVEL_BT_FILE_VERSION) ;; level
((= v1-0 ART_GROUP_FILE) ART_GROUP_FILE_VERSION) ;; art-group
)
)
(else version) ;; version was specified
)
)
;; figure out the expected kind
(set! expected-kind
(begin
(set! v1-1 kind)
(cond ((= v1-1 TPAGE_FILE) "texture-page")
((= v1-1 LEVEL_BT_FILE) "bsp-header")
((= v1-1 ART_GROUP_FILE) "art-group"))
)
)
;; check:
(cond
;; first, check the name is right:
;; not clear why we dereference the symbol like this.
((not (name= (the-as basic (-> info file-type value)) expected-kind))
(format 0 "ERROR: file ~A is of type ~S but needs to be ~S.~%"
@@ -173,18 +187,16 @@
;; check versions (only major)
((!= expected-version (-> info major-version))
(format
0
"ERROR: file ~A is version ~D.~D, but needs to be ~D.x~%"
(-> info file-name)
(-> info major-version)
(-> info minor-version)
expected-version
)
(format 0 "ERROR: file ~A is version ~D.~D, but needs to be ~D.x~%"
(-> info file-name)
(-> info major-version)
(-> info minor-version)
expected-version
)
'#f
)
;; both tests pass!
(else '#t)
)
)
)
goal_src/engine/load/loader-h.gc
+181
View File
@@ -5,3 +5,184 @@
;; name in dgo: loader-h
;; dgos: GAME, ENGINE
(define-extern art-group type)
;; This type didn't have an inspect method, so these field names are made up.
(deftype load-dir (basic)
((unknown basic)
(string-array (array string))
(data-array (array basic))
)
:flag-assert #xb00000010
(:methods
(new (symbol type int basic) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
)
)
(deftype load-dir-art-group (load-dir)
()
(:methods
(new (symbol type int basic) _type_ 0)
)
:flag-assert #xb00000010
)
(defmethod new load-dir ((allocation symbol) (type-to-make type) (length int) (arg1 basic))
(local-vars (obj load-dir))
(set! obj (object-new allocation type-to-make (the-as int (-> type-to-make size))) )
(set! (-> obj unknown) arg1)
(set! (-> obj string-array)
(the (array string) ((method-of-type array new) allocation array string length))
)
(set! (-> obj string-array length) 0)
(set! (-> obj data-array)
(the (array basic) ((method-of-type array new) allocation array basic length))
)
(set! (-> obj data-array length) 0)
obj
)
(defmethod new load-dir-art-group ((allocation symbol) (type-to-make type) (arg0 int) (arg1 basic))
(local-vars (v0-0 load-dir))
;; call parent constructor...
(set! v0-0 ((method-of-type load-dir new) allocation type-to-make arg0 arg1))
;; change our content type to art-group
(set! (-> v0-0 data-array content-type) art-group)
;; cast us to a load-dir-art-group.
(the-as load-dir-art-group v0-0)
)
(deftype external-art-buffer (basic)
((index int32 :offset-assert 4)
(other external-art-buffer :offset-assert 8)
(status basic :offset-assert 12)
(locked? basic :offset-assert 16)
(frame-lock basic :offset-assert 20)
(heap kheap :inline :offset-assert 32)
(pending-load-file basic :offset-assert 48)
(pending-load-file-part int32 :offset-assert 52)
(pending-load-file-owner uint64 :offset-assert 56)
(pending-load-file-priority float :offset-assert 64)
(load-file basic :offset-assert 68)
(load-file-part int32 :offset-assert 72)
(load-file-owner uint64 :offset-assert 80)
(load-file-priority float :offset-assert 88)
(buf uint32 :offset-assert 92)
(len int32 :offset-assert 96)
(art-group basic :offset-assert 100)
)
:method-count-assert 16
:size-assert #x68
:flag-assert #x1000000068
(:methods
(new (symbol type int) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
)
)
(defmethod new external-art-buffer ((allocation symbol) (type-to-make type) (arg0 int))
(local-vars (v0-0 external-art-buffer))
(set! v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))
(set! (-> v0-0 index) arg0)
(set! (-> v0-0 load-file) #f)
(set! (-> v0-0 load-file-part) -1)
(set! (-> v0-0 load-file-owner) (the uint64 #f))
(set! (-> v0-0 load-file-priority) 100000000.0)
(set! (-> v0-0 pending-load-file) #f)
(set! (-> v0-0 pending-load-file-part) -1)
(set! (-> v0-0 pending-load-file-owner) (the uint64 #f))
(set! (-> v0-0 pending-load-file-priority) 100000000.0)
(set! (-> v0-0 art-group) #f)
(set! (-> v0-0 status) 'initialize)
(set! (-> v0-0 locked?) #f)
(set! (-> v0-0 other) #f)
v0-0
)
(deftype spool-anim (basic)
((name basic :offset 16) ;; why?
(index int32 :offset-assert 20)
(parts int32 :offset-assert 24)
(priority float :offset-assert 28)
(owner uint64 :offset-assert 32)
(command-list basic :offset-assert 40)
)
:pack-me
:method-count-assert 9
:size-assert #x2c
:flag-assert #x90000002c
)
(deftype external-art-control (basic)
((buffer external-art-buffer 2 :offset-assert 4)
(rec spool-anim 3 :inline)
(spool-lock uint64 :offset-assert 160)
(reserve-buffer basic :offset-assert 168)
(reserve-buffer-count int32 :offset-assert 172)
(active-stream basic :offset-assert 176)
(preload-stream spool-anim :inline :offset-assert 184)
(last-preload-stream spool-anim :inline :offset-assert 232)
(end-pad uint32)
)
:method-count-assert 17
:size-assert #x118
:flag-assert #x1100000118
(:methods
(new (symbol type) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
)
)
(defmethod new external-art-control ((allocation symbol) (type-to-make type))
(local-vars (v1-9 int) (s4-0 int) (obj external-art-control))
(set! obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
(set! s4-0 0)
(while (< s4-0 2)
;; construct buffers.
(set! (-> obj buffer s4-0)
((method-of-type external-art-buffer new) allocation external-art-buffer s4-0 )
)
(+! s4-0 1)
)
;; point buffers to each other
(set! (-> obj buffer 0 other) (-> obj buffer 1))
(set! (-> obj buffer 1 other) (-> obj buffer 0))
(set! v1-9 0)
;; setup recs
(while (< v1-9 3)
(set! (-> obj rec v1-9 name) #f)
(set! (-> obj rec v1-9 priority) 100000000.000000)
(set! (-> obj rec v1-9 owner) (the uint64 #f))
(+! v1-9 1)
)
;; setup
(set! (-> obj spool-lock) (the uint64 #f))
(set! (-> obj reserve-buffer) #f)
(set! (-> obj active-stream) #f)
;; setup streams
(set! (-> obj preload-stream name) #f)
(set! (-> obj preload-stream priority) 100000000.000000)
(set! (-> obj preload-stream owner) (the uint64 #f))
(set! (-> obj last-preload-stream name) #f)
(set! (-> obj last-preload-stream priority) 100000000.000000)
(set! (-> obj last-preload-stream owner) (the uint64 #f))
obj
)
goal_src/engine/ps2/pad.gc
+312
View File
@@ -5,3 +5,315 @@
;; name in dgo: pad
;; dgos: GAME, ENGINE
;; these forward declarations should probably go somewhere else...
(define-extern get-current-time (function uint))
(define-extern get-integral-current-time (function uint))
;; this gets set to #f later on.
(define *cheat-mode* #t)
(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
)
(deftype cpad-info (hw-cpad)
((number int32 :offset-assert 36)
(cpad-file int32 :offset-assert 40)
(button0-abs uint32 3 :offset-assert 44) ;; bitmask of buttons, pressed or not, with history
(button0-shadow-abs uint32 1 :offset-assert 56) ;; modify this to change button history in the future.
(button0-rel uint32 3 :offset-assert 60) ;; bitmask of if button going down.
(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) ;; hardware control of buzzing.
(buzz-val uint8 2 :offset-assert 100) ;; intensity for buzzing
(buzz-time uint64 2 :offset-assert 104) ;; when to stop buzzing
(buzz basic :offset-assert 120) ;; is vibration enabled?
(buzz-act int32 :offset-assert 124)
(change-time uint64 :offset-assert 128)
)
(:methods
(new (symbol type int) _type_ 0)
)
:method-count-assert 9
:size-assert #x88
:flag-assert #x900000088
)
(deftype cpad-list (basic)
((num-cpads int32 :offset-assert 4)
(cpads cpad-info 2 :offset-assert 8) ;; guess
)
(:methods
(new (symbol type) _type_ 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(defun cpad-invalid! ((pad cpad-info))
"Make everything in a cpad-info set to default"
(local-vars (v1-2 int) (v1-14 int) (v1-17 int))
(set! (-> pad valid) (logior (-> pad valid) 128))
(set! (-> pad button0) 0)
(set! (-> pad button0-abs 0) 0)
(set! (-> pad button0-shadow-abs 0) 0)
(set! (-> pad button0-rel 0) 0)
(set! v1-2 0)
(while (< v1-2 12)
(nop!)
(set! (-> pad abutton v1-2) 0)
(+! v1-2 1)
)
(set! (-> pad stick0-dir) 0.000000)
(set! (-> pad stick0-speed) 0.000000)
(set! (-> pad rightx) 128)
(set! (-> pad righty) 128)
(set! (-> pad leftx) 128)
(set! (-> pad lefty) 128)
(set! (-> pad align 0) 0)
(set! (-> pad align 1) 1)
(set! (-> pad align 2) 255)
(set! (-> pad align 3) 255)
(set! (-> pad align 4) 255)
(set! (-> pad align 5) 255)
(set! v1-14 0)
(while (< v1-14 6)
(set! (-> pad direct v1-14) 0)
(+! v1-14 1)
)
(set! v1-17 0)
(while (< v1-17 2)
(set! (-> pad buzz-val 0) 0)
(set! (-> pad buzz-time 0) 0)
(+! v1-17 1)
)
pad
)
(defmethod new cpad-info ((alloction symbol) (type-to-make type) (idx int))
"Allocate a cpad. Also opens it using functions from the kernel."
(local-vars (obj cpad-info))
(set! obj (object-new alloction type-to-make (the-as int (-> type-to-make size))))
(set! (-> obj number) idx)
(set! (-> obj buzz) #f)
(cpad-open obj idx)
(cpad-invalid! obj)
)
(defmethod new cpad-list ((allocation symbol) (type-to-make type))
"Allocate a cpad-list and set up two controllers, including openeing them."
(local-vars (gp-0 cpad-list))
(set! 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
)
(defun analog-input ((in int) (offset float) (center-val float) (max-val float) (out-range float))
"Take an integer input and convert it to 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 offset)
The max val is the expected value with the stick all the way pushed
"
(local-vars
(max-magnitude float)
(magnitude float)
(offset-in float)
)
;; do the offset
(set! offset-in (- (the float in) offset))
;; figure out the absolute value of the displacement from 0.
(set! magnitude (- (fabs offset-in) center-val))
;; the maximum allowed magnitude
(set! max-magnitude (- max-val center-val))
;; if we are negative, our output range should be negative.
(when (< offset-in 0.000000)
(set! out-range (- out-range))
)
(cond
((>= 0.000000 magnitude) 0.000000) ;; shouldn't happen
((>= magnitude max-magnitude) out-range) ;; too big
(else (/ (* magnitude out-range) max-magnitude)) ;; scale!
)
)
(defun cpad-set-buzz! ((pad cpad-info) (buzz-idx int) (buzz-amount int) (duration int))
"Turn on vibration motor 'buzz-idx' for duration, at magnitude buzz-amount."
(cond
((zero? buzz-amount)
;; set buzz-amount to 0, immediately kill it.
(set! (-> pad buzz-val buzz-idx) 0)
)
((= buzz-amount (-> pad buzz-val buzz-idx))
;; we are already buzzing at this intensity.
;; buzz for max (old_buzz, new_buzz) duration
(set! (-> pad buzz-time buzz-idx)
(max (the-as int (-> pad buzz-time buzz-idx))
(the-as int (+ (get-current-time) (the-as uint duration)))
)
)
)
((< (-> pad buzz-val buzz-idx) (the-as uint buzz-amount))
;; buzz harder than the older value, overwrite the old buzz.
(set! (-> pad buzz-val buzz-idx) buzz-amount)
(set! (-> pad buzz-time buzz-idx)
(+ (get-current-time) (the-as uint duration))
)
)
)
(none)
)
;; the two controllers
(define *cpad-list* (new 'global 'cpad-list))
;; weird leftover debug thing, enabling overrides the x position of both sticks on both controllers.
(define *cpad-debug* #f)
(defun service-cpads ()
"Call this once a frame to read the pad, handle vibration, and process the left stick"
(local-vars
(v1-10 int)
(current-button0 uint)
(buzz-idx int)
(pad cpad-info)
(pad-idx int)
(pad-list cpad-list)
(lefty-pos float)
(leftx-pos float)
)
;; iterate through cpads.
(set! pad-list *cpad-list*)
(set! pad-idx 0)
(while (< pad-idx (-> pad-list num-cpads))
(set! pad (-> *cpad-list* cpads pad-idx))
;; read data from pad.
(cpad-get-data pad)
(cond
((zero? (logand (-> pad valid) 128))
;; pad is valid! update buzz.
(set! buzz-idx 0)
(while (< buzz-idx 2)
(cond
;; when buzz enbaled, in buzz time, and in game mode:
((and (-> pad buzz)
(< (the-as int (get-current-time))
(the-as int (-> pad buzz-time buzz-idx))
)
(= *master-mode* 'game)
)
;; case statement?
(set! v1-10 buzz-idx)
(cond ((zero? v1-10)
;; buzz 0, I think the small one, doesn't have analog control.
;; I _think_ this is some clever way to pulse it at a duty cycle proportional
;; to the desired intensity.
(set! (-> pad direct buzz-idx)
(logand (ash (-> pad buzz-val buzz-idx)
(- (the-as int (logand (get-integral-current-time) 7)))
)
1
)
)
)
((= v1-10 1)
;; buzz 1, the big motor can be controlled directly by the PS2.
(set! (-> pad direct buzz-idx) (-> pad buzz-val buzz-idx))
)
)
)
(else
;; time to stop buzzing. set buzz-val and the hardware command to 0.
(set! (-> pad buzz-val buzz-idx) 0)
(set! (-> pad direct buzz-idx) 0)
)
)
(+! buzz-idx 1)
)
;; update buttons history
(set! (-> pad button0-abs 2) (-> pad button0-abs 1))
;; update abs history from shadow-abs
(set! (-> pad button0-abs 1) (-> pad button0-shadow-abs 0))
;; update rel history
(set! (-> pad button0-rel 2) (-> pad button0-rel 1))
(set! (-> pad button0-rel 1) (-> pad button0-rel 0))
;; put in new buttons
(set! current-button0 (-> pad button0))
(set! (-> pad button0-shadow-abs 0) current-button0)
(set! (-> pad button0-abs 0) current-button0)
;; buttons going down
(set! (-> pad button0-rel 0)
(logand (-> pad button0-abs 0) (lognot (-> pad button0-abs 1)))
)
;; some weird leftover from debugging.
(when *cpad-debug*
(set! (-> pad leftx) 255)
(set! (-> pad rightx) 255)
)
(set! (-> pad stick0-speed) 1.000)
(cond
((= (shr (-> pad status) 4) 7) ;; status that we have analog?
(set! leftx-pos (* 0.0078125 (the float (+ (-> pad leftx) -128))))
(set! lefty-pos (* 0.0078125 (the float (- 127 (-> pad lefty)))))
;; heading of the stick. note that y -> -x, x -> y, so it's rotated...
(set! (-> pad stick0-dir) (atan (- leftx-pos) lefty-pos))
;; the "speed" is just the magnitude.
(set! (-> pad stick0-speed) (fmin 1.0 (sqrtf (+ (* leftx-pos leftx-pos) (* lefty-pos lefty-pos)))))
;; deadband the speed at 0.3? this seems kinda high.
(when (< (-> pad stick0-speed) 0.3)
(set! (-> pad stick0-speed) 0.0)
)
)
(else
;; invalid analog state, set things to safe defaults.
(set! (-> pad leftx) 128)
(set! (-> pad lefty) 128)
(set! (-> pad rightx) 128)
(set! (-> pad righty) 128)
(set! (-> pad stick0-dir) 0.000000)
(set! (-> pad stick0-speed) 0.0)
)
)
;; did the pad change?
(if (or (!= (-> pad button0-abs 0) (-> pad button0-abs 1)) ;; button pushed
(or (< 0.3 (-> pad stick0-speed)) ;; stick away from origin
(zero? (-> pad change-time)) ;; initially zero
)
)
(set! (-> pad change-time) (get-current-time))
)
)
(else
;; invalid pad
(cpad-invalid! pad)
)
)
(+! pad-idx 1)
)
*cpad-list*
)
(defun buzz-stop! ((idx int))
"Set the buzz to 0 on both vibration motors of the given cpad."
(cpad-set-buzz! (-> *cpad-list* cpads idx) 0 0 0)
(cpad-set-buzz! (-> *cpad-list* cpads idx) 1 0 0)
(none)
)