steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

windows.directx.dinput: use macros to define format constants to avoid holding onto a bunch of useless symbols after deployment

db4
Joe Groff 2010-05-02 01:27:07 -07:00
parent 338c568478
commit 3e3b85d279
1 changed files with 40 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
basis/windows/directx/dinput/constants/constants.factor
View File

@ -3,7 +3,7 @@ windows.com.syntax alien alien.c-types alien.data alien.syntax
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
@ -20,12 +20,13 @@ SYMBOLS:
<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 )
@ -45,61 +46,59 @@ M: array array-base-type first ;
: (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 )
>>
MACRO: <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
[ 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 }
@ -271,7 +270,7 @@ M: array array-base-type first ;
: 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 }
@ -828,10 +827,11 @@ M: array array-base-type first ;
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 ( -- )
{