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 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 ( -- )
{ {