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

View File

@ -614,8 +614,8 @@ M: windows-ui-backend do-events
: default-position-RECT ( RECT -- RECT' )
dup get-RECT-width/height
[ CW_USEDEFAULT + >>bottom ] dip
CW_USEDEFAULT + >>right
[ CW_USEDEFAULT + >>right ] dip
CW_USEDEFAULT + >>bottom
CW_USEDEFAULT >>left
CW_USEDEFAULT >>top ;
@ -758,7 +758,7 @@ M: windows-ui-backend beep ( -- )
: client-area>RECT ( hwnd -- RECT )
RECT <struct>
[ 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 ;
: 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
combinators sequences fry math accessors macros words quotations
libc continuations generalizations splitting locals assocs init
struct-arrays memoize ;
struct-arrays memoize classes.struct ;
IN: windows.dinput.constants
! 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 )
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 )
{
[ first dup word? [ get ] when ]
@ -54,10 +46,10 @@ MEMO: heap-size* ( c-type -- n ) heap-size ;
[ fourth (flags) ]
[ 4 swap nth (flag) ]
} cleave
"DIOBJECTDATAFORMAT" <c-object> (DIOBJECTDATAFORMAT) ;
DIOBJECTDATAFORMAT <struct-boa> ;
:: 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 |
struct args <DIOBJECTDATAFORMAT>
i alien set-nth
@ -65,22 +57,10 @@ MEMO: heap-size* ( c-type -- n ) heap-size ;
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" heap-size "DIOBJECTDATAFORMAT" heap-size ] 4 ndip
[ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip
[ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
"DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
DIDATAFORMAT <struct-boa> ;
: initialize ( symbol quot -- )
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
} [ [ DIDATAFORMAT-rgodf free ] uninitialize ] each ;
} [ [ rgodf>> free ] uninitialize ] each ;
PRIVATE>

View File

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