windows.directx.dinput: use macros to define format constants to avoid holding onto a bunch of useless symbols after deployment
parent
338c568478
commit
3e3b85d279
|
@ -3,7 +3,7 @@ windows.com.syntax alien alien.c-types alien.data alien.syntax
|
||||||
kernel system namespaces combinators sequences fry math accessors
|
kernel system namespaces combinators sequences fry math accessors
|
||||||
macros words quotations libc continuations generalizations
|
macros words quotations libc continuations generalizations
|
||||||
splitting locals assocs init specialized-arrays memoize
|
splitting locals assocs init specialized-arrays memoize
|
||||||
classes.struct strings arrays ;
|
classes.struct strings arrays literals ;
|
||||||
SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
|
SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
|
||||||
IN: windows.directx.dinput.constants
|
IN: windows.directx.dinput.constants
|
||||||
|
|
||||||
|
@ -20,12 +20,13 @@ SYMBOLS:
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
<<
|
||||||
|
|
||||||
MEMO: c-type* ( name -- c-type ) c-type ;
|
MEMO: c-type* ( name -- c-type ) c-type ;
|
||||||
MEMO: heap-size* ( c-type -- n ) heap-size ;
|
MEMO: heap-size* ( c-type -- n ) heap-size ;
|
||||||
|
|
||||||
GENERIC: array-base-type ( c-type -- c-type' )
|
GENERIC: array-base-type ( c-type -- c-type' )
|
||||||
M: object array-base-type ;
|
M: object array-base-type ;
|
||||||
M: string array-base-type "[" split1 drop ;
|
|
||||||
M: array array-base-type first ;
|
M: array array-base-type first ;
|
||||||
|
|
||||||
: (field-spec-of) ( field struct -- field-spec )
|
: (field-spec-of) ( field struct -- field-spec )
|
||||||
|
@ -45,61 +46,59 @@ M: array array-base-type first ;
|
||||||
: (flags) ( array -- n )
|
: (flags) ( array -- n )
|
||||||
0 [ (flag) bitor ] reduce ;
|
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 ]
|
[ second rot [ (offsetof) ] [ (sizeof) ] 2bi ]
|
||||||
[ third * + ]
|
[ third * + ]
|
||||||
[ fourth (flags) ]
|
[ fourth (flags) ]
|
||||||
[ 4 swap nth (flag) ]
|
[ 4 swap nth (flag) ]
|
||||||
} cleave
|
} cleave
|
||||||
DIOBJECTDATAFORMAT <struct-boa> ;
|
'[ @ _ _ _ DIOBJECTDATAFORMAT <struct-boa> ] ;
|
||||||
|
|
||||||
:: make-DIOBJECTDATAFORMAT-array ( struct array -- alien )
|
:: make-DIOBJECTDATAFORMAT-array-quot ( struct array -- quot )
|
||||||
array length malloc-DIOBJECTDATAFORMAT-array :> alien
|
array length '[ _ malloc-DIOBJECTDATAFORMAT-array ]
|
||||||
array [| args i |
|
array [| args i |
|
||||||
struct args <DIOBJECTDATAFORMAT>
|
struct args <DIOBJECTDATAFORMAT>-quot
|
||||||
i alien set-nth
|
i '[ _ pick set-nth ] compose compose
|
||||||
] each-index
|
] each-index ;
|
||||||
alien ;
|
|
||||||
|
|
||||||
: <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
|
>>
|
||||||
|
|
||||||
|
MACRO: <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 ] [ make-DIOBJECTDATAFORMAT-array ] 2bi
|
[ nip length ] [ make-DIOBJECTDATAFORMAT-array-quot ] 2bi
|
||||||
DIDATAFORMAT <struct-boa> ;
|
'[ _ _ _ _ _ @ DIDATAFORMAT <struct-boa> ] ;
|
||||||
|
|
||||||
: initialize ( symbol quot -- )
|
|
||||||
call swap set-global ; inline
|
|
||||||
|
|
||||||
: (malloc-guid-symbol) ( symbol guid -- )
|
: (malloc-guid-symbol) ( symbol guid -- )
|
||||||
'[ _ execute( -- value ) malloc-byte-array ] initialize ;
|
'[ _ malloc-byte-array ] initialize ;
|
||||||
|
|
||||||
: define-guid-constants ( -- )
|
: define-guid-constants ( -- )
|
||||||
{
|
{
|
||||||
{ GUID_XAxis_malloced GUID_XAxis }
|
{ GUID_XAxis_malloced $ GUID_XAxis }
|
||||||
{ GUID_YAxis_malloced GUID_YAxis }
|
{ GUID_YAxis_malloced $ GUID_YAxis }
|
||||||
{ GUID_ZAxis_malloced GUID_ZAxis }
|
{ GUID_ZAxis_malloced $ GUID_ZAxis }
|
||||||
{ GUID_RxAxis_malloced GUID_RxAxis }
|
{ GUID_RxAxis_malloced $ GUID_RxAxis }
|
||||||
{ GUID_RyAxis_malloced GUID_RyAxis }
|
{ GUID_RyAxis_malloced $ GUID_RyAxis }
|
||||||
{ GUID_RzAxis_malloced GUID_RzAxis }
|
{ GUID_RzAxis_malloced $ GUID_RzAxis }
|
||||||
{ GUID_Slider_malloced GUID_Slider }
|
{ GUID_Slider_malloced $ GUID_Slider }
|
||||||
{ GUID_Button_malloced GUID_Button }
|
{ GUID_Button_malloced $ GUID_Button }
|
||||||
{ GUID_Key_malloced GUID_Key }
|
{ GUID_Key_malloced $ GUID_Key }
|
||||||
{ GUID_POV_malloced GUID_POV }
|
{ GUID_POV_malloced $ GUID_POV }
|
||||||
{ GUID_Unknown_malloced GUID_Unknown }
|
{ GUID_Unknown_malloced $ GUID_Unknown }
|
||||||
{ GUID_SysMouse_malloced GUID_SysMouse }
|
{ GUID_SysMouse_malloced $ GUID_SysMouse }
|
||||||
{ GUID_SysKeyboard_malloced GUID_SysKeyboard }
|
{ GUID_SysKeyboard_malloced $ GUID_SysKeyboard }
|
||||||
{ GUID_Joystick_malloced GUID_Joystick }
|
{ GUID_Joystick_malloced $ GUID_Joystick }
|
||||||
{ GUID_SysMouseEm_malloced GUID_SysMouseEm }
|
{ GUID_SysMouseEm_malloced $ GUID_SysMouseEm }
|
||||||
{ GUID_SysMouseEm2_malloced GUID_SysMouseEm2 }
|
{ GUID_SysMouseEm2_malloced $ GUID_SysMouseEm2 }
|
||||||
{ GUID_SysKeyboardEm_malloced GUID_SysKeyboardEm }
|
{ GUID_SysKeyboardEm_malloced $ GUID_SysKeyboardEm }
|
||||||
{ GUID_SysKeyboardEm2_malloced GUID_SysKeyboardEm2 }
|
{ GUID_SysKeyboardEm2_malloced $ GUID_SysKeyboardEm2 }
|
||||||
} [ first2 (malloc-guid-symbol) ] each ;
|
} [ first2 (malloc-guid-symbol) ] each ;
|
||||||
|
|
||||||
: define-joystick-format-constant ( -- )
|
: define-joystick-format-constant ( -- )
|
||||||
c_dfDIJoystick2 [
|
c_dfDIJoystick2 [
|
||||||
DIDF_ABSAXIS
|
DIDF_ABSAXIS
|
||||||
DIJOYSTATE2 heap-size
|
$[ DIJOYSTATE2 heap-size ]
|
||||||
DIJOYSTATE2 {
|
DIJOYSTATE2 {
|
||||||
{ GUID_XAxis_malloced "lX" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 }
|
{ GUID_XAxis_malloced "lX" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 }
|
||||||
{ GUID_YAxis_malloced "lY" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 }
|
{ GUID_YAxis_malloced "lY" 0 { DIDFT_OPTIONAL DIDFT_AXIS DIDFT_ANYINSTANCE } 0 }
|
||||||
|
@ -271,7 +270,7 @@ M: array array-base-type first ;
|
||||||
: define-mouse-format-constant ( -- )
|
: define-mouse-format-constant ( -- )
|
||||||
c_dfDIMouse2 [
|
c_dfDIMouse2 [
|
||||||
DIDF_RELAXIS
|
DIDF_RELAXIS
|
||||||
DIMOUSESTATE2 heap-size
|
$[ DIMOUSESTATE2 heap-size ]
|
||||||
DIMOUSESTATE2 {
|
DIMOUSESTATE2 {
|
||||||
{ GUID_XAxis_malloced "lX" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 }
|
{ GUID_XAxis_malloced "lX" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 }
|
||||||
{ GUID_YAxis_malloced "lY" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 }
|
{ GUID_YAxis_malloced "lY" 0 { DIDFT_ANYINSTANCE DIDFT_AXIS } 0 }
|
||||||
|
@ -828,10 +827,11 @@ M: array array-base-type first ;
|
||||||
define-guid-constants
|
define-guid-constants
|
||||||
define-format-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 -- )
|
: uninitialize ( variable quot -- )
|
||||||
'[ _ when* f ] change-global ; inline
|
[ '[ _ when* f ] change-global ]
|
||||||
|
[ drop global delete-at ] 2bi ; inline
|
||||||
|
|
||||||
: free-dinput-constants ( -- )
|
: free-dinput-constants ( -- )
|
||||||
{
|
{
|
||||||
|
|
Loading…
Reference in New Issue