fix some things that broke in the windows UI/game-input backends

db4
Joe Groff 2009-08-31 12:45:39 -05:00
parent 175529c938
commit 9bd7471696
4 changed files with 15 additions and 36 deletions

View File

@ -95,6 +95,7 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
: find-device-axes-callback ( -- alien ) : find-device-axes-callback ( -- alien )
[ ! ( lpddoi pvRef -- BOOL ) [ ! ( lpddoi pvRef -- BOOL )
[ DIDEVICEOBJECTINSTANCEW memory>struct ] dip
+controller-devices+ get at +controller-devices+ get at
swap guidType>> { swap guidType>> {
{ [ dup GUID_XAxis = ] [ drop 0.0 >>x ] } { [ dup GUID_XAxis = ] [ drop 0.0 >>x ] }
@ -142,7 +143,7 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
: find-controller-callback ( -- alien ) : find-controller-callback ( -- alien )
[ ! ( lpddi pvRef -- BOOL ) [ ! ( lpddi pvRef -- BOOL )
drop guidInstance>> add-controller drop DIDEVICEINSTANCEW memory>struct guidInstance>> add-controller
DIENUM_CONTINUE DIENUM_CONTINUE
] LPDIENUMDEVICESCALLBACKW ; inline ] LPDIENUMDEVICESCALLBACKW ; inline
@ -255,7 +256,7 @@ M: dinput-game-input-backend product-string
utf16n alien>string ; utf16n alien>string ;
M: dinput-game-input-backend product-id M: dinput-game-input-backend product-id
handle>> device-info guidProduct>> <guid> ; handle>> device-info guidProduct>> ;
M: dinput-game-input-backend instance-id M: dinput-game-input-backend instance-id
handle>> device-guid ; handle>> device-guid ;
@ -311,9 +312,9 @@ CONSTANT: pov-values
: fill-mouse-state ( buffer count -- state ) : fill-mouse-state ( buffer count -- state )
[ +mouse-state+ get ] 2dip swap [ nth (fill-mouse-state) ] curry each ; [ +mouse-state+ get ] 2dip swap [ nth (fill-mouse-state) ] curry each ;
: get-device-state ( device byte-array -- ) : get-device-state ( device DIJOYSTATE2 -- )
[ dup IDirectInputDevice8W::Poll ole32-error ] dip [ dup IDirectInputDevice8W::Poll ole32-error ] dip
[ length ] keep [ byte-length ] keep
IDirectInputDevice8W::GetDeviceState ole32-error ; IDirectInputDevice8W::GetDeviceState ole32-error ;
: (read-controller) ( handle template -- state ) : (read-controller) ( handle template -- state )

View File

@ -614,8 +614,8 @@ M: windows-ui-backend do-events
: default-position-RECT ( RECT -- RECT' ) : default-position-RECT ( RECT -- RECT' )
dup get-RECT-width/height dup get-RECT-width/height
[ CW_USEDEFAULT + >>bottom ] dip [ CW_USEDEFAULT + >>right ] dip
CW_USEDEFAULT + >>right CW_USEDEFAULT + >>bottom
CW_USEDEFAULT >>left CW_USEDEFAULT >>left
CW_USEDEFAULT >>top ; CW_USEDEFAULT >>top ;
@ -758,7 +758,7 @@ M: windows-ui-backend beep ( -- )
: client-area>RECT ( hwnd -- RECT ) : client-area>RECT ( hwnd -- RECT )
RECT <struct> RECT <struct>
[ GetClientRect win32-error=0/f ] [ GetClientRect win32-error=0/f ]
[ "POINT" byte-array>struct-array [ ClientToScreen drop ] with each ] [ >c-ptr "POINT" byte-array>struct-array [ ClientToScreen drop ] with each ]
[ nip ] 2tri ; [ nip ] 2tri ;
: hwnd>RECT ( hwnd -- RECT ) : hwnd>RECT ( hwnd -- RECT )

View File

@ -2,7 +2,7 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com
windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
combinators sequences fry math accessors macros words quotations combinators sequences fry math accessors macros words quotations
libc continuations generalizations splitting locals assocs init libc continuations generalizations splitting locals assocs init
struct-arrays memoize ; struct-arrays memoize classes.struct ;
IN: windows.dinput.constants IN: windows.dinput.constants
! Some global variables aren't provided by the DirectInput DLL (they're in the ! Some global variables aren't provided by the DirectInput DLL (they're in the
@ -38,14 +38,6 @@ MEMO: heap-size* ( c-type -- n ) heap-size ;
: (flags) ( array -- n ) : (flags) ( array -- n )
0 [ (flag) bitor ] reduce ; 0 [ (flag) bitor ] reduce ;
: (DIOBJECTDATAFORMAT) ( pguid dwOfs dwType dwFlags alien -- alien )
[ {
[ set-DIOBJECTDATAFORMAT-dwFlags ]
[ set-DIOBJECTDATAFORMAT-dwType ]
[ set-DIOBJECTDATAFORMAT-dwOfs ]
[ set-DIOBJECTDATAFORMAT-pguid ]
} cleave ] keep ;
: <DIOBJECTDATAFORMAT> ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- alien ) : <DIOBJECTDATAFORMAT> ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- alien )
{ {
[ first dup word? [ get ] when ] [ first dup word? [ get ] when ]
@ -54,10 +46,10 @@ MEMO: heap-size* ( c-type -- n ) heap-size ;
[ fourth (flags) ] [ fourth (flags) ]
[ 4 swap nth (flag) ] [ 4 swap nth (flag) ]
} cleave } cleave
"DIOBJECTDATAFORMAT" <c-object> (DIOBJECTDATAFORMAT) ; DIOBJECTDATAFORMAT <struct-boa> ;
:: malloc-DIOBJECTDATAFORMAT-array ( struct array -- alien ) :: malloc-DIOBJECTDATAFORMAT-array ( struct array -- alien )
[let | alien [ array length "DIOBJECTDATAFORMAT" malloc-struct-array ] | [let | alien [ array length DIOBJECTDATAFORMAT malloc-struct-array ] |
array [| args i | array [| args i |
struct args <DIOBJECTDATAFORMAT> struct args <DIOBJECTDATAFORMAT>
i alien set-nth i alien set-nth
@ -65,22 +57,10 @@ MEMO: heap-size* ( c-type -- n ) heap-size ;
alien alien
] ; ] ;
: (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )
[
{
[ set-DIDATAFORMAT-rgodf ]
[ set-DIDATAFORMAT-dwNumObjs ]
[ set-DIDATAFORMAT-dwDataSize ]
[ set-DIDATAFORMAT-dwFlags ]
[ set-DIDATAFORMAT-dwObjSize ]
[ set-DIDATAFORMAT-dwSize ]
} cleave
] keep ;
: <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien ) : <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
[ "DIDATAFORMAT" heap-size "DIOBJECTDATAFORMAT" heap-size ] 4 ndip [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip
[ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi [ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
"DIDATAFORMAT" <c-object> (DIDATAFORMAT) ; DIDATAFORMAT <struct-boa> ;
: initialize ( symbol quot -- ) : initialize ( symbol quot -- )
call swap set-global ; inline call swap set-global ; inline
@ -861,7 +841,7 @@ MEMO: heap-size* ( c-type -- n ) heap-size ;
{ {
c_dfDIKeyboard c_dfDIKeyboard_HID c_dfDIMouse2 c_dfDIJoystick2 c_dfDIKeyboard c_dfDIKeyboard_HID c_dfDIMouse2 c_dfDIJoystick2
} [ [ DIDATAFORMAT-rgodf free ] uninitialize ] each ; } [ [ rgodf>> free ] uninitialize ] each ;
PRIVATE> PRIVATE>

View File

@ -330,9 +330,7 @@ STRUCT: PIXELFORMATDESCRIPTOR
{ dwDamageMask DWORD } ; { dwDamageMask DWORD } ;
: <RECT> ( loc dim -- RECT ) : <RECT> ( loc dim -- RECT )
[ RECT <struct> ] 2dip dupd v+ [ first2 ] bi@ RECT <struct-boa> ;
[ drop [ first >>left ] [ second >>top ] bi ]
[ v+ [ first >>right ] [ second >>bottom ] bi ] 2bi ;
TYPEDEF: RECT* PRECT TYPEDEF: RECT* PRECT
TYPEDEF: RECT* LPRECT TYPEDEF: RECT* LPRECT