fix some things that broke in the windows UI/game-input backends
parent
175529c938
commit
9bd7471696
|
@ -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 )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue