kernel system namespaces combinators sequences fry math accessors
macros words quotations libc continuations generalizations
splitting locals assocs init specialized-arrays memoize
-classes.struct strings arrays ;
+classes.struct strings arrays literals ;
SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
IN: windows.directx.dinput.constants
<PRIVATE
+<<
+
MEMO: c-type* ( name -- c-type ) c-type ;
MEMO: heap-size* ( c-type -- n ) heap-size ;
GENERIC: array-base-type ( c-type -- c-type' )
M: object array-base-type ;
-M: string array-base-type "[" split1 drop ;
M: array array-base-type first ;
: (field-spec-of) ( field struct -- field-spec )
: (flags) ( array -- n )
0 [ (flag) bitor ] reduce ;
-: <DIOBJECTDATAFORMAT> ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- alien )
+: <DIOBJECTDATAFORMAT>-quot ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- quot )
{
- [ first dup word? [ get ] when ]
+ [ first dup word? [ '[ _ get ] ] [ drop [ f ] ] if ]
[ second rot [ (offsetof) ] [ (sizeof) ] 2bi ]
[ third * + ]
[ fourth (flags) ]
[ 4 swap nth (flag) ]
} cleave
- DIOBJECTDATAFORMAT <struct-boa> ;
+ '[ @ _ _ _ DIOBJECTDATAFORMAT <struct-boa> ] ;
-:: make-DIOBJECTDATAFORMAT-array ( struct array -- alien )
- array length malloc-DIOBJECTDATAFORMAT-array :> alien
+:: make-DIOBJECTDATAFORMAT-array-quot ( struct array -- quot )
+ array length '[ _ malloc-DIOBJECTDATAFORMAT-array ]
array [| args i |
- struct args <DIOBJECTDATAFORMAT>
- i alien set-nth
- ] each-index
- alien ;
+ struct args <DIOBJECTDATAFORMAT>-quot
+ i '[ _ pick set-nth ] compose compose
+ ] each-index ;
-: <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
- [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip
- [ nip length ] [ make-DIOBJECTDATAFORMAT-array ] 2bi
- DIDATAFORMAT <struct-boa> ;
+>>
-: initialize ( symbol quot -- )
- call swap set-global ; inline
+MACRO: <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
+ [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip
+ [ nip length ] [ make-DIOBJECTDATAFORMAT-array-quot ] 2bi
+ '[ _ _ _ _ _ @ DIDATAFORMAT <struct-boa> ] ;
: (malloc-guid-symbol) ( symbol guid -- )
- '[ _ execute( -- value ) malloc-byte-array ] initialize ;
+ '[ _ malloc-byte-array ] initialize ;
: define-guid-constants ( -- )
{
- { GUID_XAxis_malloced GUID_XAxis }
- { GUID_YAxis_malloced GUID_YAxis }
- { GUID_ZAxis_malloced GUID_ZAxis }
- { GUID_RxAxis_malloced GUID_RxAxis }
- { GUID_RyAxis_malloced GUID_RyAxis }
- { GUID_RzAxis_malloced GUID_RzAxis }
- { GUID_Slider_malloced GUID_Slider }
- { GUID_Button_malloced GUID_Button }
- { GUID_Key_malloced GUID_Key }
- { GUID_POV_malloced GUID_POV }
- { GUID_Unknown_malloced GUID_Unknown }
- { GUID_SysMouse_malloced GUID_SysMouse }
- { GUID_SysKeyboard_malloced GUID_SysKeyboard }
- { GUID_Joystick_malloced GUID_Joystick }
- { GUID_SysMouseEm_malloced GUID_SysMouseEm }
- { GUID_SysMouseEm2_malloced GUID_SysMouseEm2 }
- { GUID_SysKeyboardEm_malloced GUID_SysKeyboardEm }
- { GUID_SysKeyboardEm2_malloced GUID_SysKeyboardEm2 }
+ { GUID_XAxis_malloced $ GUID_XAxis }
+ { GUID_YAxis_malloced $ GUID_YAxis }
+ { GUID_ZAxis_malloced $ GUID_ZAxis }
+ { GUID_RxAxis_malloced $ GUID_RxAxis }
+ { GUID_RyAxis_malloced $ GUID_RyAxis }
+ { GUID_RzAxis_malloced $ GUID_RzAxis }
+ { GUID_Slider_malloced $ GUID_Slider }
+ { GUID_Button_malloced $ GUID_Button }
+ { GUID_Key_malloced $ GUID_Key }
+ { GUID_POV_malloced $ GUID_POV }
+ { GUID_Unknown_malloced $ GUID_Unknown }
+ { GUID_SysMouse_malloced $ GUID_SysMouse }
+ { GUID_SysKeyboard_malloced $ GUID_SysKeyboard }
+ { GUID_Joystick_malloced $ GUID_Joystick }
+ { GUID_SysMouseEm_malloced $ GUID_SysMouseEm }
+ { GUID_SysMouseEm2_malloced $ GUID_SysMouseEm2 }
+ { GUID_SysKeyboardEm_malloced $ GUID_SysKeyboardEm }
+ { GUID_SysKeyboardEm2_malloced $ GUID_SysKeyboardEm2 }
} [ first2 (malloc-guid-symbol) ] each ;
: define-joystick-format-constant ( -- )
c_dfDIJoystick2 [
DIDF_ABSAXIS
- DIJOYSTATE2 heap-size
+ $[ DIJOYSTATE2 heap-size ]
DIJOYSTATE2 {
{ GUID_XAxis_malloced "lX" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 }
{ GUID_YAxis_malloced "lY" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 }
: define-mouse-format-constant ( -- )
c_dfDIMouse2 [
DIDF_RELAXIS
- DIMOUSESTATE2 heap-size
+ $[ DIMOUSESTATE2 heap-size ]
DIMOUSESTATE2 {
{ GUID_XAxis_malloced "lX" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 }
{ GUID_YAxis_malloced "lY" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 }
define-guid-constants
define-format-constants ;
-[ define-constants ] "windows.directx.dinput.constants" add-startup-hook
+! [ define-constants ] "windows.directx.dinput.constants" add-startup-hook
: uninitialize ( variable quot -- )
- '[ _ when* f ] change-global ; inline
+ [ '[ _ when* f ] change-global ]
+ [ drop global delete-at ] 2bi ; inline
: free-dinput-constants ( -- )
{