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

windows.directx.dinput: redo constant generation yet again to get compile time under control

db4
Joe Groff 2010-05-05 23:26:54 -07:00
parent ec6c2ccc3e
commit 98db8b5e78
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,7 @@ windows.com windows.com.syntax alien alien.c-types alien.data
alien.syntax kernel system namespaces combinators sequences fry alien.syntax kernel system namespaces combinators sequences fry
math accessors macros words quotations libc continuations math accessors macros words quotations libc continuations
generalizations splitting locals assocs init specialized-arrays generalizations splitting locals assocs init specialized-arrays
classes.struct strings arrays literals ; classes.struct strings arrays literals sequences.generalizations ;
SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
IN: windows.directx.dinput.constants IN: windows.directx.dinput.constants
@ -46,27 +46,27 @@ M: array array-base-type first ;
: (flags) ( array -- n ) : (flags) ( array -- n )
0 [ (flag) bitor ] reduce ; 0 [ (flag) bitor ] reduce ;
: <DIOBJECTDATAFORMAT>-quot ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- quot ) : <DIOBJECTDATAFORMAT> ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- object )
{ {
[ drop f ] [ drop f ]
[ second rot [ (offsetof) ] [ (sizeof) ] 2bi ] [ second rot [ (offsetof) ] [ (sizeof) ] 2bi ]
[ third * + ] [ third * + ]
[ fourth (flags) ] [ fourth (flags) ]
[ 4 swap nth (flag) ] [ 4 swap nth (flag) ]
[ first dup word? [ '[ _ get ] ] [ drop [ f ] ] if ]
} cleave } cleave
[ DIOBJECTDATAFORMAT <struct-boa> ] dip DIOBJECTDATAFORMAT <struct-boa> ;
curry ;
: set-DIOBJECTDATAFORMAT ( array struct pguid n -- array ) : make-DIOBJECTDATAFORMAT-arrays ( struct array -- values vars )
[ [ clone ] dip >>pguid ] dip pick set-nth ; [ [ <DIOBJECTDATAFORMAT> ] [ first ] bi ] with
DIOBJECTDATAFORMAT-array{ } { } 1 2 mnmap-as ;
:: make-DIOBJECTDATAFORMAT-array-quot ( struct array -- quot ) : make-DIOBJECTDATAFORMAT-array-quot ( struct arr -- quot )
array length '[ _ malloc-DIOBJECTDATAFORMAT-array ] [ nip length ] [ make-DIOBJECTDATAFORMAT-arrays ] 2bi '[
array [| args i | _ malloc-DIOBJECTDATAFORMAT-array
struct args <DIOBJECTDATAFORMAT>-quot [ _ dup byte-length memcpy ]
i '[ @ _ set-DIOBJECTDATAFORMAT ] [ _ [ get >>pguid drop ] 2each ]
] map-index [ ] join compose ; [ ] tri
] ;
>> >>