make directinput constants image-load-resistant

extra/windows/dinput/constants/constants.factor

@@ -7,6 +7,16 @@ IN: windows.dinput.constants
 ! Some global variables aren't provided by the DirectInput DLL (they're in the
 ! dinput8.lib import library), so we lovingly hand-craft equivalent values here
 
+SYMBOLS:
+    GUID_XAxis GUID_YAxis GUID_ZAxis
+    GUID_RxAxis GUID_RyAxis GUID_RzAxis
+    GUID_Slider GUID_Button GUID_Key GUID_POV GUID_Unknown
+    GUID_SysMouse GUID_SysKeyboard GUID_Joystick GUID_SysMouseEm
+    GUID_SysMouseEm2 GUID_SysKeyboardEm GUID_SysKeyboardEm2
+    c_dfDIKeyboard c_dfDIMouse2 c_dfDIJoystick2 ;
+
+<PRIVATE
+
 : (field-spec-of) ( field struct -- field-spec )
     c-type fields>> [ name>> = ] with find nip ;
 : (offsetof) ( field struct -- offset )
@@ -63,18 +73,12 @@ MACRO: (flags) ( array -- )
     [ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
     "DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
 
-SYMBOLS:
-    GUID_XAxis GUID_YAxis GUID_ZAxis
-    GUID_RxAxis GUID_RyAxis GUID_RzAxis
-    GUID_Slider GUID_Button GUID_Key GUID_POV GUID_Unknown
-    GUID_SysMouse GUID_SysKeyboard GUID_Joystick GUID_SysMouseEm
-    GUID_SysMouseEm2 GUID_SysKeyboardEm GUID_SysKeyboardEm2 ;
-
 : (malloc-guid-symbol) ( symbol guid -- )
     global swap '[ [
         , [ byte-length malloc ] [ over byte-array>memory ] bi
     ] unless* ] change-at ;
 
+: define-guid-constants ( -- )
     {
         { GUID_XAxis          GUID: {A36D02E0-C9F3-11CF-BFC7-444553540000} }
         { GUID_YAxis          GUID: {A36D02E1-C9F3-11CF-BFC7-444553540000} }
@@ -94,10 +98,9 @@ SYMBOLS:
         { GUID_SysMouseEm2    GUID: {6F1D2B81-D5A0-11CF-BFC7-444553540000} }
         { GUID_SysKeyboardEm  GUID: {6F1D2B82-D5A0-11CF-BFC7-444553540000} }
         { GUID_SysKeyboardEm2 GUID: {6F1D2B83-D5A0-11CF-BFC7-444553540000} }
-} [ first2 (malloc-guid-symbol) ] each
+    } [ first2 (malloc-guid-symbol) ] each ;
-
-SYMBOLS: c_dfDIKeyboard c_dfDIMouse2 c_dfDIJoystick2 ;
 
+: define-joystick-format-constant ( -- )
     c_dfDIJoystick2 global [ [
         DIDF_ABSAXIS
         "DIJOYSTATE2" heap-size
@@ -267,8 +270,9 @@ c_dfDIJoystick2 global [ [
             { GUID_Slider "rglFSlider"   0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
             { GUID_Slider "rglFSlider"   1 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
         } <DIDATAFORMAT>
-] unless* ] change-at
+    ] unless* ] change-at ;
 
+: define-mouse-format-constant ( -- )
     c_dfDIMouse2 global [ [
         DIDF_RELAXIS
         "DIMOUSESTATE2" heap-size
@@ -285,8 +289,9 @@ c_dfDIMouse2 global [ [
             { GUID_Button "rgbButtons" 6 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
             { GUID_Button "rgbButtons" 7 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
         } <DIDATAFORMAT>
-] unless* ] change-at
+    ] unless* ] change-at ;
 
+: define-keyboard-format-constant ( -- )
     c_dfDIKeyboard global [ [
         DIDF_RELAXIS
         256
@@ -548,7 +553,19 @@ c_dfDIKeyboard global [ [
             { GUID_Key f 254 { DIDFT_OPTIONAL DIDFT_BUTTON [ 254 DIDFT_MAKEINSTANCE ] } 0 }
             { GUID_Key f 255 { DIDFT_OPTIONAL DIDFT_BUTTON [ 255 DIDFT_MAKEINSTANCE ] } 0 }
         } <DIDATAFORMAT>
-] unless* ] change-at
+    ] unless* ] change-at ;
+
+: define-format-constants ( -- )
+    define-joystick-format-constant
+    define-mouse-format-constant
+    define-keyboard-format-constant ;
+
+: define-constants
+    define-guid-constants
+    define-format-constants ;
+
+[ define-constants ] "windows.dinput.constants" add-init-hook
+define-constants
 
 : free-dinput-constants ( -- )
     {
@@ -560,4 +577,7 @@ c_dfDIKeyboard global [ [
     } [ global [ [ free ] when* f ] change-at ] each
     {
         c_dfDIKeyboard c_dfDIMouse2 c_dfDIJoystick2
-    } [
+    } [ global [ [ DIDATAFORMAT-rgodf free ] when* f ] change-at ] each ;
+
+PRIVATE>
+

extra/windows/dinput/dinput.factor

@@ -9,20 +9,33 @@ IN: windows.dinput
 
 LIBRARY: dinput
 
-! callback signature: BOOL DIEnumDevicesCallbackW(LPCDIDEVICEINSTANCEW lpddi, LPVOID pvRef);
 TYPEDEF: void* LPDIENUMDEVICESCALLBACKW
-! Callback signature: BOOL DIEnumDevicesBySemanticsCallbackW(LPCDIDEVICEINSTANCEW lpddi, IDirectInputDevice8W* lpdid, DWORD dwFlags, DWORD dwRemaining, LPVOID pvRef);
+: LPDIENUMDEVICESCALLBACKW ( quot -- alien )
+    [ "BOOL" { "LPCDIDEVICEINSTANCEW" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
 TYPEDEF: void* LPDIENUMDEVICESBYSEMANTICSCBW
-! Callback signature: BOOL DIConfigureDevicesCallback(IUnknown* lpDDSTarget, LPVOID pvRef);
+: LPDIENUMDEVICESBYSEMANTICSCBW ( quot -- alien )
+    [ "BOOL" { "LPCDIDEVICEINSTANCEW" "IDirectInputDevice8W*" "DWORD" "DWORD" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
 TYPEDEF: void* LPDICONFIGUREDEVICESCALLBACK
-! Callback signature: BOOL DIEnumEffectsCallbackW(LPCDIEFFECTINFOW pdei, LPVOID pvRef);
+: LPDICONFIGUREDEVICESCALLBACK ( quot -- alien )
+    [ "BOOL" { "IUnknown*" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
 TYPEDEF: void* LPDIENUMEFFECTSCALLBACKW
-! Callback signature: BOOL DIEnumCreatedEffectObjectsCallback(LPDIRECTINPUTEFFECT peff, LPVOID pvRef);
+: LPDIENUMEFFECTSCALLBACKW ( quot -- alien )
+    [ "BOOL" { "LPCDIEFFECTINFOW" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
 TYPEDEF: void* LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
-! Callback signature: BOOL DIEnumEffectsInFileCallback(LPCDIFILEEFFECT lpDiFileEf, LPVOID pvRef);
+: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
+    [ "BOOL" { "LPDIRECTINPUTEFFECT" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
 TYPEDEF: void* LPDIENUMEFFECTSINFILECALLBACK
+    [ "BOOL" { "LPCDIFILEEFFECT" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
 ! Callback signaature: BOOL DIEnumDeviceObjectsCallback(LPCDIDEVICEOBJECTINSTANCE lpddoi, LPVOID pvRef);
 TYPEDEF: void* LPDIENUMDEVICEOBJECTSCALLBACKW
+    [ "BOOL" { "LPCDIDEVICEOBJECTINSTANCE" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
 
 TYPEDEF: DWORD D3DCOLOR