Avoid cloning in game-input.backend.dinput to improve performance

db4
U-VICTORIA\Administrator 2008-07-26 22:20:17 -07:00
parent 2c76f34ddf
commit 1c7b117581
1 changed files with 15 additions and 17 deletions

View File

@ -4,12 +4,12 @@ arrays vectors windows.kernel32 windows.com windows.dinput
shuffle windows.user32 windows.messages sequences combinators shuffle windows.user32 windows.messages sequences combinators
math.geometry.rect ui.windows accessors math windows alien math.geometry.rect ui.windows accessors math windows alien
alien.strings io.encodings.utf16 continuations byte-arrays alien.strings io.encodings.utf16 continuations byte-arrays
locals ; locals game-input.backend.dinput.keys-array ;
IN: game-input.backend.dinput IN: game-input.backend.dinput
SINGLETON: dinput-game-input-backend SINGLETON: dinput-game-input-backend
SYMBOLS: +dinput+ +keyboard-device+ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
+controller-devices+ +controller-guids+ +controller-devices+ +controller-guids+
+device-change-window+ +device-change-handle+ ; +device-change-window+ +device-change-handle+ ;
@ -40,7 +40,9 @@ SYMBOLS: +dinput+ +keyboard-device+
: find-keyboard ( -- ) : find-keyboard ( -- )
GUID_SysKeyboard device-for-guid GUID_SysKeyboard device-for-guid
[ configure-keyboard ] [ configure-keyboard ]
[ +keyboard-device+ set-global ] bi ; [ +keyboard-device+ set-global ] bi
256 <byte-array> <keys-array> keyboard-state boa
+keyboard-state+ set-global ;
: device-info ( device -- DIDEVICEIMAGEINFOW ) : device-info ( device -- DIDEVICEIMAGEINFOW )
"DIDEVICEINSTANCEW" <c-object> "DIDEVICEINSTANCEW" <c-object>
@ -187,7 +189,8 @@ TUPLE: window-rect < rect window-loc ;
: release-keyboard ( -- ) : release-keyboard ( -- )
+keyboard-device+ global +keyboard-device+ global
[ com-release f ] change-at ; [ com-release f ] change-at
f +keyboard-state+ set-global ;
M: dinput-game-input-backend (open-game-input) M: dinput-game-input-backend (open-game-input)
create-dinput create-dinput
@ -228,9 +231,6 @@ M: dinput-game-input-backend instance-id
pov-down pov-down-left pov-left pov-up-left pov-down pov-down-left pov-left pov-up-left
} ; inline } ; inline
: >keys ( byte-array -- array )
[ HEX: 80 bitand c-bool> ] { } map-as ;
: >axis ( long -- float ) : >axis ( long -- float )
32767 - 32767.0 /f ; 32767 - 32767.0 /f ;
: >slider ( long -- float ) : >slider ( long -- float )
@ -240,7 +240,7 @@ M: dinput-game-input-backend instance-id
[ drop pov-neutral ] [ drop pov-neutral ]
[ 2750 + 4500 /i pov-values nth ] if ; [ 2750 + 4500 /i pov-values nth ] if ;
: >buttons ( alien length -- array ) : >buttons ( alien length -- array )
memory>byte-array >keys ; memory>byte-array <keys-array> ;
: (fill-if) ( controller-state DIJOYSTATE2 ? quot -- ) : (fill-if) ( controller-state DIJOYSTATE2 ? quot -- )
[ drop ] compose [ 2drop ] if ; inline [ drop ] compose [ 2drop ] if ; inline
@ -258,16 +258,13 @@ M: dinput-game-input-backend instance-id
[ DIJOYSTATE2-rgbButtons over buttons>> length >buttons >>buttons ] [ DIJOYSTATE2-rgbButtons over buttons>> length >buttons >>buttons ]
} 2cleave ; } 2cleave ;
: <keyboard-state> ( byte-array -- keyboard-state ) : get-device-state ( device byte-array -- )
>keys keyboard-state boa ;
: get-device-state ( device state-size -- byte-array )
[ dup IDirectInputDevice8W::Poll ole32-error ] dip [ dup IDirectInputDevice8W::Poll ole32-error ] dip
dup <byte-array> [ length ] keep
[ IDirectInputDevice8W::GetDeviceState ole32-error ] keep ; IDirectInputDevice8W::GetDeviceState ole32-error ;
: (read-controller) ( handle template -- state ) : (read-controller) ( handle template -- state )
clone swap [ "DIJOYSTATE2" heap-size get-device-state ] swap [ "DIJOYSTATE2" heap-size <byte-array> [ get-device-state ] keep ]
[ fill-controller-state ] [ drop f ] with-acquisition ; [ fill-controller-state ] [ drop f ] with-acquisition ;
M: dinput-game-input-backend read-controller M: dinput-game-input-backend read-controller
@ -278,7 +275,8 @@ M: dinput-game-input-backend calibrate-controller
handle>> f 0 IDirectInputDevice8W::RunControlPanel ole32-error ; handle>> f 0 IDirectInputDevice8W::RunControlPanel ole32-error ;
M: dinput-game-input-backend read-keyboard M: dinput-game-input-backend read-keyboard
+keyboard-device+ get [ 256 get-device-state ] +keyboard-device+ get
[ <keyboard-state> ] [ f ] with-acquisition ; [ +keyboard-state+ get [ keys>> underlying>> get-device-state ] keep ]
[ ] [ f ] with-acquisition ;
dinput-game-input-backend game-input-backend set-global dinput-game-input-backend game-input-backend set-global