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 )
|
: 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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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>
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue