Merge branch 'master' of git://factorcode.org/git/factor

core/binary-search/binary-search-docs.factor

@@ -0,0 +1,43 @@
+IN: binary-search
+USING: help.markup help.syntax sequences kernel math.order ;
+
+ARTICLE: "binary-search" "Binary search"
+"The " { $emphasis "binary search" } " algorithm allows elements to be located in sorted sequence in " { $snippet "O(log n)" } " time."
+{ $subsection search }
+"Variants of sequence words optimized for sorted sequences:"
+{ $subsection sorted-index }
+{ $subsection sorted-member? }
+{ $subsection sorted-memq? }
+{ $see-also "order-specifiers" "sequences-sorting" } ;
+
+ABOUT: "binary-search"
+
+HELP: search
+{ $values { "seq" "a sorted sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- <=> )" } } { "i" "an index, or " { $link f } } { "elt" "an element, or " { $link f } } }
+{ $description "Performs a binary search on a sequence, calling the quotation to decide whether to end the search (" { $link +eq+ } "), search lower (" { $link +lt+ } ") or search higher (" { $link +gt+ } ")."
+$nl
+"If the sequence is non-empty, outputs the index and value of the closest match, which is either an element for which the quotation output " { $link +eq+ } ", or failing that, least element for which the quotation output " { $link +lt+ } "."
+$nl
+"If the sequence is empty, outputs " { $link f } " " { $link f } "." }
+{ $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link find } "." } ;
+
+{ find find-from find-last find-last find-last-from search } related-words
+
+HELP: sorted-index
+{ $values { "elt" object } { "seq" "a sorted sequence" } { "i" "an index, or " { $link f } } { "elt" "an element, or " { $link f } } }
+{ $description "Outputs the index and value of the element closest to " { $snippet "elt" } " in the sequence. See " { $link search } " for details." }
+{ $notes "If the sequence has at least one element, this word always outputs a valid index, because it finds the closest match, not necessarily an exact one. In this respect its behavior differs from " { $link index } "." } ;
+
+{ index index-from last-index last-index-from sorted-index } related-words
+
+HELP: sorted-member?
+{ $values { "elt" object } { "seq" "a sorted sequence" } { "?" "a boolean" } }
+{ $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link = } "." } ;
+
+{ member? sorted-member? } related-words
+
+HELP: sorted-memq?
+{ $values { "elt" object } { "seq" "a sorted sequence" } { "?" "a boolean" } }
+{ $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link eq? } "." } ;
+
+{ memq? sorted-memq? } related-words

core/binary-search/binary-search-tests.factor

@@ -0,0 +1,17 @@
+IN: binary-search.tests
+USING: binary-search math.order vectors kernel tools.test ;
+
+\ sorted-member? must-infer
+
+[ f ] [ 3 { } [ <=> ] with search drop ] unit-test
+[ 0 ] [ 3 { 3 } [ <=> ] with search drop ] unit-test
+[ 1 ] [ 2 { 1 2 3 } [ <=> ] with search drop ] unit-test
+[ 3 ] [ 4 { 1 2 3 4 5 6 } [ <=> ] with search drop ] unit-test
+[ 2 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
+[ 4 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
+[ 10 ] [ 10 20 >vector [ <=> ] with search drop ] unit-test
+
+[ t ] [ "hello" { "alligrator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test
+[ 3 ] [ "hey" { "alligrator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
+[ f ] [ "hello" { "alligrator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
+[ f ] [ "zebra" { "alligrator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test

core/binary-search/binary-search.factor

@@ -0,0 +1,46 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences sequences.private accessors math
+math.order combinators ;
+IN: binary-search
+
+<PRIVATE
+
+: midpoint ( seq -- elt )
+    [ midpoint@ ] keep nth-unsafe ; inline
+
+: decide ( quot seq -- quot seq <=> )
+    [ midpoint swap call ] 2keep rot ; inline
+
+: finish ( quot slice -- i elt )
+    [ [ from>> ] [ midpoint@ ] bi + ] [ seq>> ] bi
+    [ drop ] [ dup ] [ ] tri* nth ; inline
+
+: (search) ( quot seq -- i elt )
+    dup length 1 <= [
+        finish
+    ] [
+        decide {
+            { +eq+ [ finish ] }
+            { +lt+ [ dup midpoint@ head-slice (search) ] }
+            { +gt+ [ dup midpoint@ tail-slice (search) ] }
+        } case
+    ] if ; inline
+
+PRIVATE>
+
+: search ( seq quot -- i elt )
+    over empty? [ 2drop f f ] [ swap <flat-slice> (search) ] if ;
+    inline
+
+: natural-search ( obj seq -- i elt )
+    [ <=> ] with search ;
+
+: sorted-index ( obj seq -- i )
+    natural-search drop ;
+
+: sorted-member? ( obj seq -- ? )
+    dupd natural-search nip = ;
+
+: sorted-memq? ( obj seq -- ? )
+    dupd natural-search nip eq? ;

core/optimizer/known-words/known-words.factor

@@ -143,6 +143,14 @@ IN: optimizer.known-words
     { [ dup optimize-instance? ] [ optimize-instance ] }
 } define-optimizers
 
+! This is a special-case hack
+: redundant-array-capacity-check? ( #call -- ? )
+    dup in-d>> first node-literal [ 0 = ] [ fixnum? ] bi and ;
+
+\ array-capacity? {
+    { [ dup redundant-array-capacity-check? ] [ [ drop t ] f splice-quot ] }
+} define-optimizers
+
 ! eq? on the same object is always t
 { eq? = } {
     { { @ @ } [ 2drop t ] }

core/sequences/sequences-docs.factor

@@ -243,6 +243,7 @@ $nl
 { $subsection "sequences-destructive" }
 { $subsection "sequences-stacks" }
 { $subsection "sequences-sorting" }
+{ $subsection "binary-search" }
 { $subsection "sets" }
 "For inner loops:"
 { $subsection "sequences-unsafe" } ;
@@ -585,8 +586,6 @@ HELP: index
 { $values { "obj" object } { "seq" sequence } { "n" "an index" } }
 { $description "Outputs the index of the first element in the sequence equal to " { $snippet "obj" } ". If no element is found, outputs " { $link f } "." } ;
 
-{ index index-from last-index last-index-from member? memq? } related-words
-
 HELP: index-from
 { $values { "obj" object } { "i" "a start index" } { "seq" sequence } { "n" "an index" } }
 { $description "Outputs the index of the first element in the sequence equal to " { $snippet "obj" } ", starting the search from the " { $snippet "i" } "th element. If no element is found, outputs " { $link f } "." } ;

core/sorting/sorting-docs.factor

@@ -2,18 +2,15 @@ USING: help.markup help.syntax kernel words math
 sequences math.order ;
 IN: sorting
 
-ARTICLE: "sequences-sorting" "Sorting and binary search"
+ARTICLE: "sequences-sorting" "Sorting sequences"
-"Sorting and binary search combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- <=> )" } ", where the output value is one of the three " { $link "order-specifiers" } "."
+"Sorting combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- <=> )" } ", where the output value is one of the three " { $link "order-specifiers" } "."
 $nl
 "Sorting a sequence with a custom comparator:"
 { $subsection sort }
 "Sorting a sequence with common comparators:"
 { $subsection natural-sort }
 { $subsection sort-keys }
-{ $subsection sort-values }
+{ $subsection sort-values } ;
-"Binary search:"
-{ $subsection binsearch }
-{ $subsection binsearch* } ;
 
 ABOUT: "sequences-sorting"
 
@@ -41,24 +38,4 @@ HELP: midpoint@
 { $values { "seq" "a sequence" } { "n" integer } }
 { $description "Outputs the index of the midpoint of " { $snippet "seq" } "." } ;
 
-HELP: midpoint
-{ $values { "seq" "a sequence" } { "elt" object } }
-{ $description "Outputs the element at the midpoint of a sequence." } ;
-
-HELP: partition
-{ $values { "seq" "a sequence" } { "n" integer } { "slice" slice } }
-{ $description "Outputs a slice of the first or second half of the sequence, respectively, depending on the integer's sign." } ;
-
-HELP: binsearch
-{ $values { "elt" object } { "seq" "a sorted sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj1 obj2 -- <=> )" } } { "i" "the index of the search result" } }
-{ $description "Given a sequence that is sorted with respect to the " { $snippet "quot" } " comparator, searches for an element equal to " { $snippet "elt" } ", or failing that, the greatest element smaller than " { $snippet "elt" } ". Comparison is performed with " { $snippet "quot" } "."
-$nl
-"Outputs f if the sequence is empty. If the sequence has at least one element, this word always outputs a valid index." } ;
-
-HELP: binsearch*
-{ $values { "elt" object } { "seq" "a sorted sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj1 obj2 -- <=> )" } } { "result" "the search result" } }
-{ $description "Variant of " { $link binsearch } " which outputs the found element rather than its index in the sequence."
-$nl
-"Outputs " { $link f } " if the sequence is empty. If the sequence has at least one element, this word always outputs a sequence element." } ;
-
 { <=> compare natural-sort sort-keys sort-values } related-words

core/sorting/sorting-tests.factor

@@ -1,8 +1,8 @@
 USING: sorting sequences kernel math math.order random
-tools.test vectors ;
+tools.test vectors sets ;
 IN: sorting.tests
 
-[ [ ] ] [ [ ] natural-sort ] unit-test
+[ { } ] [ { } natural-sort ] unit-test
 
 [ { 270000000 270000001 } ]
 [ T{ slice f 270000000 270000002 270000002 } natural-sort ]
@@ -11,18 +11,10 @@ unit-test
 [ t ] [
     100 [
         drop
-        100 [ 20 random [ 1000 random ] replicate ] replicate natural-sort [ before=? ] monotonic?
+        100 [ 20 random [ 1000 random ] replicate ] replicate
+        dup natural-sort
+        [ set= ] [ nip [ before=? ] monotonic? ] 2bi and
     ] all?
 ] unit-test
 
 [ ] [ { 1 2 } [ 2drop 1 ] sort drop ] unit-test
-
-[ 3 ] [ { 1 2 3 4 } midpoint ] unit-test
-
-[ f ] [ 3 { } [ <=> ] binsearch ] unit-test
-[ 0 ] [ 3 { 3 } [ <=> ] binsearch ] unit-test
-[ 1 ] [ 2 { 1 2 3 } [ <=> ] binsearch ] unit-test
-[ 3 ] [ 4 { 1 2 3 4 5 6 } [ <=> ] binsearch ] unit-test
-[ 2 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ <=> ] binsearch ] unit-test
-[ 4 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] binsearch ] unit-test
-[ 10 ] [ 10 20 >vector [ <=> ] binsearch ] unit-test

core/sorting/sorting.factor

@@ -1,49 +1,142 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math sequences vectors math.order
 sequences sequences.private math.order ;
 IN: sorting
 
-DEFER: sort
+! Optimized merge-sort:
+!
+! 1) only allocates 2 temporary arrays
+
+! 2) first phase (interchanging pairs x[i], x[i+1] where
+! x[i] > x[i+1]) is handled specially
 
 <PRIVATE
 
-: <iterator> 0 tail-slice ; inline
+TUPLE: merge
+{ seq    array }
+{ accum  vector }
+{ accum1 vector }
+{ accum2 vector }
+{ from1  array-capacity }
+{ to1    array-capacity }
+{ from2  array-capacity }
+{ to2    array-capacity } ;
 
-: this ( slice -- obj )
+: dump ( from to seq accum -- )
-    dup slice-from swap slice-seq nth-unsafe ; inline
+    #! Optimize common case where to - from = 1, 2, or 3.
-
+    >r >r 2dup swap - dup 1 =
-: next ( iterator -- )
+    [ 2drop r> nth-unsafe r> push ] [
-    dup slice-from 1+ swap set-slice-from ; inline
+        dup 2 = [
-
+            2drop dup 1+
-: smallest ( iter1 iter2 quot -- elt )
+            r> [ nth-unsafe ] curry bi@
-    >r over this over this r> call +lt+ eq?
+            r> [ push ] curry bi@
-    -rot ? [ this ] keep next ; inline
-
-: (merge) ( iter1 iter2 quot accum -- )
-    >r pick empty? [
-        drop nip r> push-all
-    ] [
-        over empty? [
-            2drop r> push-all
         ] [
-            3dup smallest r> [ push ] keep (merge)
+            dup 3 = [
+                2drop dup 1+ dup 1+
+                r> [ nth-unsafe ] curry tri@
+                r> [ push ] curry tri@
+            ] [
+                drop r> subseq r> push-all
+            ] if
         ] if
     ] if ; inline
 
-: merge ( sorted1 sorted2 quot -- result )
+: l-elt   [ from1>> ] [ seq>> ] bi nth-unsafe ; inline
-    >r [ [ <iterator> ] bi@ ] 2keep r>
+: r-elt   [ from2>> ] [ seq>> ] bi nth-unsafe ; inline
-    rot length rot length + <vector>
+: l-done? [ from1>> ] [ to1>> ] bi number= ; inline
-    [ (merge) ] [ underlying>> ] bi ; inline
+: r-done? [ from2>> ] [ to2>> ] bi number= ; inline
+: dump-l  [ [ from1>> ] [ to1>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
+: dump-r  [ [ from2>> ] [ to2>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
+: l-next  [ [ l-elt ] [ [ 1+ ] change-from1 drop ] bi ] [ accum>> ] bi push ; inline
+: r-next  [ [ r-elt ] [ [ 1+ ] change-from2 drop ] bi ] [ accum>> ] bi push ; inline
+: decide  [ [ l-elt ] [ r-elt ] bi ] dip call +lt+ eq? ; inline
 
-: conquer ( first second quot -- result )
+: (merge) ( merge quot -- )
-    [ tuck >r >r sort r> r> sort ] keep merge ; inline
+    over l-done? [ drop dump-r ] [
+        over r-done? [ drop dump-l ] [
+            2dup decide
+            [ over l-next ] [ over r-next ] if
+            (merge)
+        ] if
+    ] if ; inline
+
+: flip-accum ( merge -- )
+    dup [ accum>> ] [ accum1>> ] bi eq? [
+        dup accum1>> underlying>> >>seq
+        dup accum2>> >>accum
+    ] [
+        dup accum1>> >>accum
+        dup accum2>> underlying>> >>seq
+    ] if
+    dup accum>> 0 >>length 2drop ; inline
+
+: <merge> ( seq -- merge )
+    \ merge new
+        over >vector >>accum1
+        swap length <vector> >>accum2
+        dup accum1>> underlying>> >>seq
+        dup accum2>> >>accum
+        dup accum>> 0 >>length drop ; inline
+
+: compute-midpoint ( merge -- merge )
+    dup [ from1>> ] [ to2>> ] bi + 2/ >>to1 ; inline
+
+: merging ( from to merge -- )
+    swap >>to2
+    swap >>from1
+    compute-midpoint
+    dup [ to1>> ] [ seq>> length ] bi min >>to1
+    dup [ to2>> ] [ seq>> length ] bi min >>to2
+    dup to1>> >>from2
+    drop ; inline
+
+: nth-chunk ( n size -- from to ) [ * dup ] keep + ; inline
+
+: chunks ( length size -- n ) [ align ] keep /i ; inline
+
+: each-chunk ( length size quot -- )
+    [ [ chunks ] keep ] dip
+    [ nth-chunk ] prepose curry
+    each-integer ; inline
+
+: merge ( from to merge quot -- )
+    [ [ merging ] keep ] dip (merge) ; inline
+
+: sort-pass ( merge size quot -- )
+    [
+        over flip-accum
+        over [ seq>> length ] 2dip
+    ] dip
+    [ merge ] 2curry each-chunk ; inline
+
+: sort-loop ( merge quot -- )
+    2 swap
+    [ pick seq>> length pick > ]
+    [ [ dup ] [ 1 shift ] [ ] tri* [ sort-pass ] 2keep ]
+    [ ] while 3drop ; inline
+
+: each-pair ( seq quot -- )
+    [ [ length 1+ 2/ ] keep ] dip
+    [ [ 1 shift dup 1+ ] dip ] prepose curry each-integer ; inline
+
+: (sort-pairs) ( i1 i2 seq quot accum -- )
+    >r >r 2dup length = [
+        nip nth r> drop r> push
+    ] [
+        tuck [ nth-unsafe ] 2bi@ 2dup r> call +gt+ eq?
+        [ swap ] when r> tuck [ push ] 2bi@
+    ] if ; inline
+
+: sort-pairs ( merge quot -- )
+    [ [ seq>> ] [ accum>> ] bi ] dip swap
+    [ (sort-pairs) ] 2curry each-pair ; inline
 
 PRIVATE>
 
-: sort ( seq quot -- sortedseq )
+: sort ( seq quot -- seq' )
-    over length 1 <=
+    [ <merge> ] dip
-    [ drop ] [ over >r >r halves r> conquer r> like ] if ;
+    [ sort-pairs ] [ sort-loop ] [ drop accum>> underlying>> ] 2tri ;
     inline
 
 : natural-sort ( seq -- sortedseq ) [ <=> ] sort ;
@@ -53,25 +146,3 @@ PRIVATE>
 : sort-values ( seq -- sortedseq ) [ [ second ] compare ] sort ;
 
 : sort-pair ( a b -- c d ) 2dup after? [ swap ] when ;
-
-: midpoint ( seq -- elt )
-    [ midpoint@ ] keep nth-unsafe ; inline
-
-: partition ( seq n -- slice )
-    +gt+ eq? not swap halves ? ; inline
-
-: (binsearch) ( elt quot seq -- i )
-    dup length 1 <= [
-        slice-from 2nip
-    ] [
-        [ midpoint swap call ] 3keep roll dup +eq+ eq?
-        [ drop dup slice-from swap midpoint@ + 2nip ]
-        [ partition (binsearch) ] if
-    ] if ; inline
-
-: binsearch ( elt seq quot -- i )
-    swap dup empty?
-    [ 3drop f ] [ <flat-slice> (binsearch) ] if ; inline
-
-: binsearch* ( elt seq quot -- result )
-    over >r binsearch [ r> ?nth ] [ r> drop f ] if* ; inline

extra/cocoa/application/application.factor

@@ -3,12 +3,20 @@
 USING: alien alien.syntax io kernel namespaces core-foundation
 core-foundation.run-loop cocoa.messages cocoa cocoa.classes
 cocoa.runtime sequences threads debugger init summary
-kernel.private ;
+kernel.private assocs ;
 IN: cocoa.application
 
 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
-
 : <NSArray> ( seq -- alien ) <CFArray> -> autorelease ;
+: <NSNumber> ( number -- alien ) <CFNumber> -> autorelease ;
+: <NSData> ( byte-array -- alien ) <CFData> -> autorelease ;
+: <NSDictionary> ( assoc -- alien )
+    NSMutableDictionary over assoc-size -> dictionaryWithCapacity:
+    [
+        [
+            spin -> setObject:forKey:
+        ] curry assoc-each
+    ] keep ;
 
 : NSApplicationDelegateReplySuccess 0 ;
 : NSApplicationDelegateReplyCancel  1 ;

extra/cocoa/cocoa.factor

@@ -43,6 +43,7 @@ SYMBOL: super-sent-messages
         "NSArray"
         "NSAutoreleasePool"
         "NSBundle"
+        "NSData"
         "NSDictionary"
         "NSError"
         "NSEvent"
@@ -53,6 +54,7 @@ SYMBOL: super-sent-messages
         "NSNib"
         "NSNotification"
         "NSNotificationCenter"
+        "NSNumber"
         "NSObject"
         "NSOpenGLContext"
         "NSOpenGLPixelFormat"
@@ -62,6 +64,7 @@ SYMBOL: super-sent-messages
         "NSResponder"
         "NSSavePanel"
         "NSScreen"
+        "NSString"
         "NSView"
         "NSWindow"
         "NSWorkspace"

extra/cocoa/enumeration/enumeration.factor

@@ -0,0 +1,30 @@
+USING: kernel cocoa cocoa.types alien.c-types locals math sequences
+vectors fry libc ;
+IN: cocoa.enumeration
+
+: NS-EACH-BUFFER-SIZE 16 ; inline
+
+: (with-enumeration-buffers) ( quot -- )
+    "NSFastEnumerationState" heap-size swap '[
+        NS-EACH-BUFFER-SIZE "id" heap-size * [
+            NS-EACH-BUFFER-SIZE @
+        ] with-malloc
+    ] with-malloc ; inline
+
+:: (NSFastEnumeration-each) ( object quot state stackbuf count -- )
+    object state stackbuf count -> countByEnumeratingWithState:objects:count:
+    dup zero? [ drop ] [
+        state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
+        '[ , void*-nth quot call ] each
+        object quot state stackbuf count (NSFastEnumeration-each)
+    ] if ; inline
+
+: NSFastEnumeration-each ( object quot -- )
+    [ (NSFastEnumeration-each) ] (with-enumeration-buffers) ; inline
+
+: NSFastEnumeration-map ( object quot -- vector )
+    NS-EACH-BUFFER-SIZE <vector>
+    [ '[ @ , push ] NSFastEnumeration-each ] keep ; inline
+
+: NSFastEnumeration>vector ( object -- vector )
+    [ ] NSFastEnumeration-map ;

extra/cocoa/plists/plists.factor

@@ -2,18 +2,58 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: strings arrays hashtables assocs sequences
 cocoa.messages cocoa.classes cocoa.application cocoa kernel
-namespaces io.backend ;
+namespaces io.backend math cocoa.enumeration byte-arrays
+combinators alien.c-types ;
 IN: cocoa.plists
 
-: assoc>NSDictionary ( assoc -- alien )
+GENERIC: >plist ( value -- plist )
-    NSMutableDictionary over assoc-size -> dictionaryWithCapacity:
+
-    [
+M: number >plist
-        [
+    <NSNumber> ;
-            spin [ <NSString> ] bi@ -> setObject:forKey:
+M: t >plist
-        ] curry assoc-each
+    <NSNumber> ;
-    ] keep ;
+M: f >plist
+    <NSNumber> ;
+M: string >plist
+    <NSString> ;
+M: byte-array >plist
+    <NSData> ;
+M: hashtable >plist
+    [ [ >plist ] bi@ ] assoc-map <NSDictionary> ;
+M: sequence >plist
+    [ >plist ] map <NSArray> ;
 
 : write-plist ( assoc path -- )
-    >r assoc>NSDictionary
+    >r >plist
     r> normalize-path <NSString> 0 -> writeToFile:atomically:
     [ "write-plist failed" throw ] unless ;
+
+DEFER: plist>
+
+: (plist-NSString>) ( NSString -- string )
+    -> UTF8String ;
+
+: (plist-NSNumber>) ( NSNumber -- number )
+    dup -> doubleValue dup >integer =
+    [ -> longLongValue ]
+    [ -> doubleValue ] if ;
+
+: (plist-NSData>) ( NSData -- byte-array )
+    dup -> length <byte-array> [ -> getBytes: ] keep ;
+
+: (plist-NSArray>) ( NSArray -- vector )
+    [ plist> ] NSFastEnumeration-map ;    
+
+: (plist-NSDictionary>) ( NSDictionary -- hashtable )
+    dup [ [ -> valueForKey: ] keep swap [ plist> ] bi@ 2array ] with
+    NSFastEnumeration-map >hashtable ;
+
+: plist> ( plist -- value )
+    {
+        { [ dup NSString     -> isKindOfClass: c-bool> ] [ (plist-NSString>)      ] }
+        { [ dup NSNumber     -> isKindOfClass: c-bool> ] [ (plist-NSNumber>)      ] }
+        { [ dup NSData       -> isKindOfClass: c-bool> ] [ (plist-NSData>)        ] }
+        { [ dup NSArray      -> isKindOfClass: c-bool> ] [ (plist-NSArray>)       ] }
+        { [ dup NSDictionary -> isKindOfClass: c-bool> ] [ (plist-NSDictionary>)  ] }
+        [ ]
+    } cond ;

extra/cocoa/types/types.factor

@@ -64,3 +64,9 @@ C-STRUCT: CGAffineTransform
     { "float" "d" }
     { "float" "tx" }
     { "float" "ty" } ;
+
+C-STRUCT: NSFastEnumerationState
+    { "ulong" "state" }
+    { "id*" "itemsPtr" }
+    { "ulong*" "mutationsPtr" }
+    { "ulong[5]" "extra" } ;

extra/color-picker/color-picker.factor

@@ -3,7 +3,8 @@
 USING: kernel math math.functions math.parser models
        models.filter models.range models.compose sequences ui
        ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
-       ui.gadgets.sliders ui.render math.geometry.rect accessors ;
+       ui.gadgets.sliders ui.render math.geometry.rect accessors
+       ui.gadgets.grids ;
 IN: color-picker
 
 ! Simple example demonstrating the use of models.
@@ -33,12 +34,16 @@ M: color-preview model-changed
       [ <color-slider> add-gadget ] each ;
 
 : <color-picker> ( -- gadget )
-    [
+  <frame>
-        <color-sliders> @top frame,
+    <color-sliders>
-        dup <color-model> <color-preview> @center frame,
+      swap dup
-        [ [ truncate number>string ] map " " join ] <filter>
+      [                               @top    grid-add* ]
-        <label-control> @bottom frame,
+      [ <color-model> <color-preview> @center grid-add* ]
-    ] make-frame ;
+      [
+        [ [ truncate number>string ] map " " join ] <filter> <label-control>
+        @bottom grid-add*
+      ]
+      tri* ;
 
 : color-picker-window ( -- )
     [ <color-picker> "Color Picker" open-window ] with-ui ;

extra/cords/cords.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs sequences sorting math math.order
+USING: accessors assocs sequences sorting binary-search math
-arrays combinators kernel ;
+math.order arrays combinators kernel ;
 IN: cords
 
 <PRIVATE
@@ -23,7 +23,7 @@ M: multi-cord length count>> ;
 
 M: multi-cord virtual@
     dupd
-    seqs>> [ first <=> ] binsearch*
+    seqs>> [ first <=> ] with search nip
     [ first - ] [ second ] bi ;
 
 M: multi-cord virtual-seq

extra/core-foundation/core-foundation.factor

@@ -6,16 +6,43 @@ IN: core-foundation
 
 TYPEDEF: void* CFAllocatorRef
 TYPEDEF: void* CFArrayRef
+TYPEDEF: void* CFDataRef
+TYPEDEF: void* CFDictionaryRef
+TYPEDEF: void* CFMutableDictionaryRef
+TYPEDEF: void* CFNumberRef
 TYPEDEF: void* CFBundleRef
+TYPEDEF: void* CFSetRef
 TYPEDEF: void* CFStringRef
 TYPEDEF: void* CFURLRef
 TYPEDEF: void* CFUUIDRef
+TYPEDEF: void* CFTypeRef
 TYPEDEF: bool Boolean
 TYPEDEF: int CFIndex
 TYPEDEF: int SInt32
+TYPEDEF: uint UInt32
+TYPEDEF: uint CFTypeID
 TYPEDEF: double CFTimeInterval
 TYPEDEF: double CFAbsoluteTime
 
+TYPEDEF: int CFNumberType
+: kCFNumberSInt8Type 1 ; inline
+: kCFNumberSInt16Type 2 ; inline
+: kCFNumberSInt32Type 3 ; inline
+: kCFNumberSInt64Type 4 ; inline
+: kCFNumberFloat32Type 5 ; inline
+: kCFNumberFloat64Type 6 ; inline
+: kCFNumberCharType 7 ; inline
+: kCFNumberShortType 8 ; inline
+: kCFNumberIntType 9 ; inline
+: kCFNumberLongType 10 ; inline
+: kCFNumberLongLongType 11 ; inline
+: kCFNumberFloatType 12 ; inline
+: kCFNumberDoubleType 13 ; inline
+: kCFNumberCFIndexType 14 ; inline
+: kCFNumberNSIntegerType 15 ; inline
+: kCFNumberCGFloatType 16 ; inline
+: kCFNumberMaxType 16 ; inline
+
 FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ;
 
 FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ;
@@ -24,7 +51,8 @@ FUNCTION: void CFArraySetValueAtIndex ( CFArrayRef array, CFIndex index, void* v
 
 FUNCTION: CFIndex CFArrayGetCount ( CFArrayRef array ) ;
 
-: kCFURLPOSIXPathStyle 0 ;
+: kCFURLPOSIXPathStyle 0 ; inline
+: kCFAllocatorDefault f ; inline
 
 FUNCTION: CFURLRef CFURLCreateWithFileSystemPath ( CFAllocatorRef allocator, CFStringRef filePath, int pathStyle, Boolean isDirectory ) ;
 
@@ -38,11 +66,18 @@ FUNCTION: CFIndex CFStringGetLength ( CFStringRef theString ) ;
 
 FUNCTION: void CFStringGetCharacters ( void* theString, CFIndex start, CFIndex length, void* buffer ) ;
 
+FUNCTION: CFNumberRef CFNumberCreate ( CFAllocatorRef allocator, CFNumberType theType, void* valuePtr ) ;
+
+FUNCTION: CFDataRef CFDataCreate ( CFAllocatorRef allocator, uchar* bytes, CFIndex length ) ;
+
 FUNCTION: CFBundleRef CFBundleCreate ( CFAllocatorRef allocator, CFURLRef bundleURL ) ;
 
 FUNCTION: Boolean CFBundleLoadExecutable ( CFBundleRef bundle ) ;
 
-FUNCTION: void CFRelease ( void* cf ) ;
+FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
+FUNCTION: void CFRelease ( CFTypeRef cf ) ;
+
+FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
 
 : CF>array ( alien -- array )
     dup CFArrayGetCount [ CFArrayGetValueAtIndex ] with map ;
@@ -80,9 +115,23 @@ FUNCTION: void CFRelease ( void* cf ) ;
         f swap CFBundleCreate
     ] keep CFRelease ;
 
+GENERIC: <CFNumber> ( number -- alien )
+M: integer <CFNumber>
+    [ f kCFNumberLongLongType ] dip <longlong> CFNumberCreate ;
+M: float <CFNumber>
+    [ f kCFNumberDoubleType ] dip <double> CFNumberCreate ;
+M: t <CFNumber>
+    drop f kCFNumberIntType 1 <int> CFNumberCreate ;
+M: f <CFNumber>
+    drop f kCFNumberIntType 0 <int> CFNumberCreate ;
+
+: <CFData> ( byte-array -- alien )
+    [ f ] dip dup length CFDataCreate ;
+
 : load-framework ( name -- )
     dup <CFBundle> [
         CFBundleLoadExecutable drop
     ] [
         "Cannot load bundled named " prepend throw
     ] ?if ;
+

extra/core-foundation/run-loop/run-loop.factor

@@ -12,6 +12,7 @@ IN: core-foundation.run-loop
 TYPEDEF: void* CFRunLoopRef
 
 FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;
+FUNCTION: CFRunLoopRef CFRunLoopGetCurrent ( ) ;
 
 FUNCTION: SInt32 CFRunLoopRunInMode (
    CFStringRef mode,

extra/help/markup/markup.factor

@@ -188,6 +188,9 @@ M: f print-element drop ;
 : $links ( topics -- )
     [ [ ($link) ] textual-list ] ($span) ;
 
+: $vocab-links ( vocabs -- )
+    [ vocab ] map $links ;
+
 : $see-also ( topics -- )
     "See also" $heading $links ;
 

extra/interval-maps/interval-maps.factor

@@ -1,5 +1,7 @@
-USING: kernel sequences arrays accessors grouping
+! Copyright (C) 2008 Daniel Ehrenberg.
-math.order sorting math assocs locals namespaces ;
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences arrays accessors grouping math.order
+sorting binary-search math assocs locals namespaces ;
 IN: interval-maps
 
 TUPLE: interval-map array ;
@@ -7,7 +9,7 @@ TUPLE: interval-map array ;
 <PRIVATE
 
 : find-interval ( key interval-map -- interval-node )
-    [ first <=> ] binsearch* ;
+    [ first <=> ] with search nip ;
 
 : interval-contains? ( key interval-node -- ? )
     first2 between? ;

extra/iokit/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/iokit/hid/hid.factor

@@ -0,0 +1,271 @@
+USING: iokit alien alien.syntax alien.c-types kernel
+system core-foundation ;
+IN: iokit.hid
+
+: kIOHIDDeviceKey "IOHIDDevice" ; inline
+
+: kIOHIDTransportKey                  "Transport" ; inline
+: kIOHIDVendorIDKey                   "VendorID" ; inline
+: kIOHIDVendorIDSourceKey             "VendorIDSource" ; inline
+: kIOHIDProductIDKey                  "ProductID" ; inline
+: kIOHIDVersionNumberKey              "VersionNumber" ; inline
+: kIOHIDManufacturerKey               "Manufacturer" ; inline
+: kIOHIDProductKey                    "Product" ; inline
+: kIOHIDSerialNumberKey               "SerialNumber" ; inline
+: kIOHIDCountryCodeKey                "CountryCode" ; inline
+: kIOHIDLocationIDKey                 "LocationID" ; inline
+: kIOHIDDeviceUsageKey                "DeviceUsage" ; inline
+: kIOHIDDeviceUsagePageKey            "DeviceUsagePage" ; inline
+: kIOHIDDeviceUsagePairsKey           "DeviceUsagePairs" ; inline
+: kIOHIDPrimaryUsageKey               "PrimaryUsage" ; inline
+: kIOHIDPrimaryUsagePageKey           "PrimaryUsagePage" ; inline
+: kIOHIDMaxInputReportSizeKey         "MaxInputReportSize" ; inline
+: kIOHIDMaxOutputReportSizeKey	      "MaxOutputReportSize" ; inline
+: kIOHIDMaxFeatureReportSizeKey	      "MaxFeatureReportSize" ; inline
+: kIOHIDReportIntervalKey             "ReportInterval" ; inline
+
+: kIOHIDElementKey                    "Elements" ; inline
+
+: kIOHIDElementCookieKey                      "ElementCookie" ; inline
+: kIOHIDElementTypeKey                        "Type" ; inline
+: kIOHIDElementCollectionTypeKey              "CollectionType" ; inline
+: kIOHIDElementUsageKey                       "Usage" ; inline
+: kIOHIDElementUsagePageKey                   "UsagePage" ; inline
+: kIOHIDElementMinKey                         "Min" ; inline
+: kIOHIDElementMaxKey                         "Max" ; inline
+: kIOHIDElementScaledMinKey                   "ScaledMin" ; inline
+: kIOHIDElementScaledMaxKey                   "ScaledMax" ; inline
+: kIOHIDElementSizeKey                        "Size" ; inline
+: kIOHIDElementReportSizeKey                  "ReportSize" ; inline
+: kIOHIDElementReportCountKey                 "ReportCount" ; inline
+: kIOHIDElementReportIDKey                    "ReportID" ; inline
+: kIOHIDElementIsArrayKey                     "IsArray" ; inline
+: kIOHIDElementIsRelativeKey                  "IsRelative" ; inline
+: kIOHIDElementIsWrappingKey                  "IsWrapping" ; inline
+: kIOHIDElementIsNonLinearKey                 "IsNonLinear" ; inline
+: kIOHIDElementHasPreferredStateKey           "HasPreferredState" ; inline
+: kIOHIDElementHasNullStateKey                "HasNullState" ; inline
+: kIOHIDElementFlagsKey                       "Flags" ; inline
+: kIOHIDElementUnitKey                        "Unit" ; inline
+: kIOHIDElementUnitExponentKey                "UnitExponent" ; inline
+: kIOHIDElementNameKey                        "Name" ; inline
+: kIOHIDElementValueLocationKey               "ValueLocation" ; inline
+: kIOHIDElementDuplicateIndexKey              "DuplicateIndex" ; inline
+: kIOHIDElementParentCollectionKey            "ParentCollection" ; inline
+
+: kIOHIDElementVendorSpecificKey
+    cpu ppc? "VendorSpecifc" "VendorSpecific" ? ; inline
+
+: kIOHIDElementCookieMinKey           "ElementCookieMin" ; inline
+: kIOHIDElementCookieMaxKey           "ElementCookieMax" ; inline
+: kIOHIDElementUsageMinKey            "UsageMin" ; inline
+: kIOHIDElementUsageMaxKey            "UsageMax" ; inline
+
+: kIOHIDElementCalibrationMinKey              "CalibrationMin" ; inline
+: kIOHIDElementCalibrationMaxKey              "CalibrationMax" ; inline
+: kIOHIDElementCalibrationSaturationMinKey    "CalibrationSaturationMin" ; inline
+: kIOHIDElementCalibrationSaturationMaxKey    "CalibrationSaturationMax" ; inline
+: kIOHIDElementCalibrationDeadZoneMinKey      "CalibrationDeadZoneMin" ; inline
+: kIOHIDElementCalibrationDeadZoneMaxKey      "CalibrationDeadZoneMax" ; inline
+: kIOHIDElementCalibrationGranularityKey      "CalibrationGranularity" ; inline
+
+: kIOHIDElementTypeInput_Misc        1 ; inline
+: kIOHIDElementTypeInput_Button      2 ; inline
+: kIOHIDElementTypeInput_Axis        3 ; inline
+: kIOHIDElementTypeInput_ScanCodes   4 ; inline
+: kIOHIDElementTypeOutput            129 ; inline
+: kIOHIDElementTypeFeature           257 ; inline
+: kIOHIDElementTypeCollection        513 ; inline
+
+: kIOHIDElementCollectionTypePhysical	    HEX: 00 ; inline
+: kIOHIDElementCollectionTypeApplication    HEX: 01 ; inline
+: kIOHIDElementCollectionTypeLogical        HEX: 02 ; inline
+: kIOHIDElementCollectionTypeReport         HEX: 03 ; inline
+: kIOHIDElementCollectionTypeNamedArray     HEX: 04 ; inline
+: kIOHIDElementCollectionTypeUsageSwitch    HEX: 05 ; inline
+: kIOHIDElementCollectionTypeUsageModifier  HEX: 06 ; inline
+
+: kIOHIDReportTypeInput    0 ; inline
+: kIOHIDReportTypeOutput   1 ; inline
+: kIOHIDReportTypeFeature  2 ; inline
+: kIOHIDReportTypeCount    3 ; inline
+
+: kIOHIDOptionsTypeNone	       HEX: 00 ; inline
+: kIOHIDOptionsTypeSeizeDevice HEX: 01 ; inline
+
+: kIOHIDQueueOptionsTypeNone	   HEX: 00 ; inline
+: kIOHIDQueueOptionsTypeEnqueueAll HEX: 01 ; inline
+
+: kIOHIDElementFlagsConstantMask        HEX: 0001 ; inline
+: kIOHIDElementFlagsVariableMask        HEX: 0002 ; inline
+: kIOHIDElementFlagsRelativeMask        HEX: 0004 ; inline
+: kIOHIDElementFlagsWrapMask            HEX: 0008 ; inline
+: kIOHIDElementFlagsNonLinearMask       HEX: 0010 ; inline
+: kIOHIDElementFlagsNoPreferredMask     HEX: 0020 ; inline
+: kIOHIDElementFlagsNullStateMask       HEX: 0040 ; inline
+: kIOHIDElementFlagsVolativeMask        HEX: 0080 ; inline
+: kIOHIDElementFlagsBufferedByteMask    HEX: 0100 ; inline
+
+: kIOHIDValueScaleTypeCalibrated 0 ; inline
+: kIOHIDValueScaleTypePhysical   1 ; inline
+
+: kIOHIDTransactionDirectionTypeInput  0 ; inline
+: kIOHIDTransactionDirectionTypeOutput 1 ; inline
+
+: kIOHIDTransactionOptionDefaultOutputValue 1 ; inline
+
+TYPEDEF: ptrdiff_t IOHIDElementCookie
+TYPEDEF: int IOHIDElementType
+TYPEDEF: int IOHIDElementCollectionType
+TYPEDEF: int IOHIDReportType
+TYPEDEF: uint IOHIDOptionsType
+TYPEDEF: uint IOHIDQueueOptionsType
+TYPEDEF: uint IOHIDElementFlags
+TYPEDEF: void* IOHIDDeviceRef
+TYPEDEF: void* IOHIDElementRef
+TYPEDEF: void* IOHIDValueRef
+TYPEDEF: void* IOHIDManagerRef
+TYPEDEF: void* IOHIDTransactionRef
+TYPEDEF: UInt32 IOHIDValueScaleType
+TYPEDEF: UInt32 IOHIDTransactionDirectionType
+
+TYPEDEF: void* IOHIDCallback
+: IOHIDCallback ( quot -- alien )
+    [ "void" { "void*" "IOReturn" "void*" } "cdecl" ]
+    dip alien-callback ; inline
+
+TYPEDEF: void* IOHIDReportCallback
+: IOHIDReportCallback ( quot -- alien )
+    [ "void" { "void*" "IOReturn" "void*" "IOHIDReportType" "UInt32" "uchar*" "CFIndex" } "cdecl" ]
+    dip alien-callback ; inline
+
+TYPEDEF: void* IOHIDValueCallback
+: IOHIDValueCallback ( quot -- alien )
+    [ "void" { "void*" "IOReturn" "void*" "IOHIDValueRef" } "cdecl" ]
+    dip alien-callback ; inline
+
+TYPEDEF: void* IOHIDValueMultipleCallback
+: IOHIDValueMultipleCallback ( quot -- alien )
+    [ "void" { "void*" "IOReturn" "void*" "CFDictionaryRef" } "cdecl" ]
+    dip alien-callback ; inline
+
+TYPEDEF: void* IOHIDDeviceCallback
+: IOHIDDeviceCallback ( quot -- alien )
+    [ "void" { "void*" "IOReturn" "void*" "IOHIDDeviceRef" } "cdecl" ]
+    dip alien-callback ; inline
+
+! IOHIDDevice
+
+FUNCTION: CFTypeID IOHIDDeviceGetTypeID ( ) ;
+FUNCTION: IOHIDDeviceRef IOHIDDeviceCreate ( CFAllocatorRef allocator, io_service_t service ) ;
+FUNCTION: IOReturn IOHIDDeviceOpen ( IOHIDDeviceRef device, IOOptionBits options ) ;
+FUNCTION: IOReturn IOHIDDeviceClose ( IOHIDDeviceRef device, IOOptionBits options ) ;
+FUNCTION: Boolean IOHIDDeviceConformsTo ( IOHIDDeviceRef device, UInt32 usagePage, UInt32 usage ) ;
+FUNCTION: CFTypeRef IOHIDDeviceGetProperty ( IOHIDDeviceRef device, CFStringRef key ) ;
+FUNCTION: Boolean IOHIDDeviceSetProperty ( IOHIDDeviceRef device, CFStringRef key, CFTypeRef property ) ;
+FUNCTION: CFArrayRef IOHIDDeviceCopyMatchingElements ( IOHIDDeviceRef device, CFDictionaryRef matching, IOOptionBits options ) ;
+FUNCTION: void IOHIDDeviceScheduleWithRunLoop ( IOHIDDeviceRef device, CFRunLoopRef runLoop, CFStringRef runLoopMode ) ;
+FUNCTION: void IOHIDDeviceUnscheduleFromRunLoop ( IOHIDDeviceRef device, CFRunLoopRef runLoop, CFStringRef runLoopMode ) ;
+FUNCTION: void IOHIDDeviceRegisterRemovalCallback ( IOHIDDeviceRef device, IOHIDCallback callback, void* context ) ;
+FUNCTION: void IOHIDDeviceRegisterInputValueCallback ( IOHIDDeviceRef device, IOHIDValueCallback callback, void* context ) ;
+FUNCTION: void IOHIDDeviceRegisterInputReportCallback ( IOHIDDeviceRef device, uchar* report, CFIndex reportLength, IOHIDReportCallback callback, void* context ) ;
+FUNCTION: void IOHIDDeviceSetInputValueMatching ( IOHIDDeviceRef device, CFDictionaryRef matching ) ;
+FUNCTION: void IOHIDDeviceSetInputValueMatchingMultiple ( IOHIDDeviceRef device, CFArrayRef multiple ) ;
+FUNCTION: IOReturn IOHIDDeviceSetValue ( IOHIDDeviceRef device, IOHIDElementRef element, IOHIDValueRef value ) ;
+FUNCTION: IOReturn IOHIDDeviceSetValueMultiple ( IOHIDDeviceRef device, CFDictionaryRef multiple ) ;
+FUNCTION: IOReturn IOHIDDeviceSetValueWithCallback ( IOHIDDeviceRef device, IOHIDElementRef element, IOHIDValueRef value, CFTimeInterval timeout, IOHIDValueCallback callback, void* context ) ;
+FUNCTION: IOReturn IOHIDDeviceSetValueMultipleWithCallback ( IOHIDDeviceRef device, CFDictionaryRef multiple, CFTimeInterval timeout, IOHIDValueMultipleCallback callback, void* context ) ;
+FUNCTION: IOReturn IOHIDDeviceGetValue ( IOHIDDeviceRef device, IOHIDElementRef element, IOHIDValueRef* pValue ) ;
+FUNCTION: IOReturn IOHIDDeviceCopyValueMultiple ( IOHIDDeviceRef device, CFArrayRef elements, CFDictionaryRef* pMultiple ) ;
+FUNCTION: IOReturn IOHIDDeviceGetValueWithCallback ( IOHIDDeviceRef device, IOHIDElementRef element, IOHIDValueRef* pValue, CFTimeInterval timeout, IOHIDValueCallback callback, void* context ) ;
+FUNCTION: IOReturn IOHIDDeviceCopyValueMultipleWithCallback ( IOHIDDeviceRef device, CFArrayRef elements, CFDictionaryRef* pMultiple, CFTimeInterval timeout, IOHIDValueMultipleCallback callback, void* context ) ;
+FUNCTION: IOReturn IOHIDDeviceSetReport ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex reportLength ) ;
+FUNCTION: IOReturn IOHIDDeviceSetReportWithCallback ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex reportLength, CFTimeInterval timeout, IOHIDReportCallback callback, void* context ) ;
+FUNCTION: IOReturn IOHIDDeviceGetReport ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex* pReportLength ) ;
+FUNCTION: IOReturn IOHIDDeviceGetReportWithCallback ( IOHIDDeviceRef device, IOHIDReportType reportType, CFIndex reportID, uchar* report, CFIndex* pReportLength, CFTimeInterval timeout, IOHIDReportCallback callback, void* context ) ;
+
+! IOHIDManager
+
+FUNCTION: CFTypeID IOHIDManagerGetTypeID ( ) ;
+FUNCTION: IOHIDManagerRef IOHIDManagerCreate ( CFAllocatorRef allocator, IOOptionBits options ) ;
+FUNCTION: IOReturn IOHIDManagerOpen ( IOHIDManagerRef manager, IOOptionBits options ) ;
+FUNCTION: IOReturn IOHIDManagerClose ( IOHIDManagerRef manager, IOOptionBits options ) ;
+FUNCTION: CFTypeRef IOHIDManagerGetProperty ( IOHIDManagerRef manager, CFStringRef key ) ;
+FUNCTION: Boolean IOHIDManagerSetProperty ( IOHIDManagerRef manager, CFStringRef key, CFTypeRef value ) ;
+FUNCTION: void IOHIDManagerScheduleWithRunLoop ( IOHIDManagerRef manager, CFRunLoopRef runLoop, CFStringRef runLoopMode ) ;
+FUNCTION: void IOHIDManagerUnscheduleFromRunLoop ( IOHIDManagerRef manager, CFRunLoopRef runLoop, CFStringRef runLoopMode ) ;
+FUNCTION: void IOHIDManagerSetDeviceMatching ( IOHIDManagerRef manager, CFDictionaryRef matching ) ;
+FUNCTION: void IOHIDManagerSetDeviceMatchingMultiple ( IOHIDManagerRef manager, CFArrayRef multiple ) ;
+FUNCTION: CFSetRef IOHIDManagerCopyDevices ( IOHIDManagerRef manager ) ;
+FUNCTION: void IOHIDManagerRegisterDeviceMatchingCallback ( IOHIDManagerRef manager, IOHIDDeviceCallback callback, void* context ) ;
+FUNCTION: void IOHIDManagerRegisterDeviceRemovalCallback ( IOHIDManagerRef manager, IOHIDDeviceCallback callback, void* context ) ;
+FUNCTION: void IOHIDManagerRegisterInputReportCallback ( IOHIDManagerRef manager, IOHIDReportCallback callback, void* context ) ;
+FUNCTION: void IOHIDManagerRegisterInputValueCallback ( IOHIDManagerRef manager, IOHIDValueCallback callback, void* context ) ;
+FUNCTION: void IOHIDManagerSetInputValueMatching ( IOHIDManagerRef manager, CFDictionaryRef matching ) ;
+FUNCTION: void IOHIDManagerSetInputValueMatchingMultiple ( IOHIDManagerRef manager, CFArrayRef multiple ) ;
+
+! IOHIDElement
+
+FUNCTION: CFTypeID IOHIDElementGetTypeID ( ) ;
+FUNCTION: IOHIDElementRef IOHIDElementCreateWithDictionary ( CFAllocatorRef allocator, CFDictionaryRef dictionary ) ;
+FUNCTION: IOHIDDeviceRef IOHIDElementGetDevice ( IOHIDElementRef element ) ;
+FUNCTION: IOHIDElementRef IOHIDElementGetParent ( IOHIDElementRef element ) ;
+FUNCTION: CFArrayRef IOHIDElementGetChildren ( IOHIDElementRef element ) ;
+FUNCTION: void IOHIDElementAttach ( IOHIDElementRef element, IOHIDElementRef toAttach ) ;
+FUNCTION: void IOHIDElementDetach ( IOHIDElementRef element, IOHIDElementRef toDetach ) ;
+FUNCTION: CFArrayRef IOHIDElementCopyAttached ( IOHIDElementRef element ) ;
+FUNCTION: IOHIDElementCookie IOHIDElementGetCookie ( IOHIDElementRef element ) ;
+FUNCTION: IOHIDElementType IOHIDElementGetType ( IOHIDElementRef element ) ;
+FUNCTION: IOHIDElementCollectionType IOHIDElementGetCollectionType ( IOHIDElementRef element ) ;
+FUNCTION: UInt32 IOHIDElementGetUsagePage ( IOHIDElementRef element ) ;
+FUNCTION: UInt32 IOHIDElementGetUsage ( IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDElementIsVirtual ( IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDElementIsRelative ( IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDElementIsWrapping ( IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDElementIsArray ( IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDElementIsNonLinear ( IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDElementHasPreferredState ( IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDElementHasNullState ( IOHIDElementRef element ) ;
+FUNCTION: CFStringRef IOHIDElementGetName ( IOHIDElementRef element ) ;
+FUNCTION: UInt32 IOHIDElementGetReportID ( IOHIDElementRef element ) ;
+FUNCTION: UInt32 IOHIDElementGetReportSize ( IOHIDElementRef element ) ;
+FUNCTION: UInt32 IOHIDElementGetReportCount ( IOHIDElementRef element ) ;
+FUNCTION: UInt32 IOHIDElementGetUnit ( IOHIDElementRef element ) ;
+FUNCTION: UInt32 IOHIDElementGetUnitExponent ( IOHIDElementRef element ) ;
+FUNCTION: CFIndex IOHIDElementGetLogicalMin ( IOHIDElementRef element ) ;
+FUNCTION: CFIndex IOHIDElementGetLogicalMax ( IOHIDElementRef element ) ;
+FUNCTION: CFIndex IOHIDElementGetPhysicalMin ( IOHIDElementRef element ) ;
+FUNCTION: CFIndex IOHIDElementGetPhysicalMax ( IOHIDElementRef element ) ;
+FUNCTION: CFTypeRef IOHIDElementGetProperty ( IOHIDElementRef element, CFStringRef key ) ;
+FUNCTION: Boolean IOHIDElementSetProperty ( IOHIDElementRef element, CFStringRef key, CFTypeRef property ) ;
+
+! IOHIDValue
+
+FUNCTION: CFTypeID IOHIDValueGetTypeID ( ) ;
+FUNCTION: IOHIDValueRef IOHIDValueCreateWithIntegerValue ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, CFIndex value ) ;
+FUNCTION: IOHIDValueRef IOHIDValueCreateWithBytes ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, uchar* bytes, CFIndex length ) ;
+FUNCTION: IOHIDValueRef IOHIDValueCreateWithBytesNoCopy ( CFAllocatorRef allocator, IOHIDElementRef element, ulonglong timeStamp, uchar* bytes, CFIndex length ) ;
+FUNCTION: IOHIDElementRef IOHIDValueGetElement ( IOHIDValueRef value ) ;
+FUNCTION: ulonglong IOHIDValueGetTimeStamp ( IOHIDValueRef value ) ;
+FUNCTION: CFIndex IOHIDValueGetLength ( IOHIDValueRef value ) ;
+FUNCTION: uchar* IOHIDValueGetBytePtr ( IOHIDValueRef value ) ;
+FUNCTION: CFIndex IOHIDValueGetIntegerValue ( IOHIDValueRef value ) ;
+FUNCTION: double IOHIDValueGetScaledValue ( IOHIDValueRef value, IOHIDValueScaleType type ) ;
+
+! IOHIDTransaction
+
+FUNCTION: CFTypeID IOHIDTransactionGetTypeID ( ) ;
+FUNCTION: IOHIDTransactionRef IOHIDTransactionCreate ( CFAllocatorRef allocator, IOHIDDeviceRef device, IOHIDTransactionDirectionType direction, IOOptionBits options ) ;
+FUNCTION: IOHIDDeviceRef IOHIDTransactionGetDevice ( IOHIDTransactionRef transaction ) ;
+FUNCTION: IOHIDTransactionDirectionType IOHIDTransactionGetDirection ( IOHIDTransactionRef transaction ) ;
+FUNCTION: void IOHIDTransactionSetDirection ( IOHIDTransactionRef transaction, IOHIDTransactionDirectionType direction ) ;
+FUNCTION: void IOHIDTransactionAddElement ( IOHIDTransactionRef transaction, IOHIDElementRef element ) ;
+FUNCTION: void IOHIDTransactionRemoveElement ( IOHIDTransactionRef transaction, IOHIDElementRef element ) ;
+FUNCTION: Boolean IOHIDTransactionContainsElement ( IOHIDTransactionRef transaction, IOHIDElementRef element ) ;
+FUNCTION: void IOHIDTransactionScheduleWithRunLoop ( IOHIDTransactionRef transaction, CFRunLoopRef runLoop, CFStringRef runLoopMode ) ;
+FUNCTION: void IOHIDTransactionUnscheduleFromRunLoop ( IOHIDTransactionRef transaction, CFRunLoopRef runLoop, CFStringRef runLoopMode ) ;
+FUNCTION: void IOHIDTransactionSetValue ( IOHIDTransactionRef transaction, IOHIDElementRef element, IOHIDValueRef value, IOOptionBits options ) ;
+FUNCTION: IOHIDValueRef IOHIDTransactionGetValue ( IOHIDTransactionRef transaction, IOHIDElementRef element, IOOptionBits options ) ;
+FUNCTION: IOReturn IOHIDTransactionCommit ( IOHIDTransactionRef transaction ) ;
+FUNCTION: IOReturn IOHIDTransactionCommitWithCallback ( IOHIDTransactionRef transaction, CFTimeInterval timeout, IOHIDCallback callback, void* context ) ;
+FUNCTION: void IOHIDTransactionClear ( IOHIDTransactionRef transaction ) ;

extra/iokit/iokit.factor

@@ -0,0 +1,180 @@
+USING: alien.syntax alien.c-types core-foundation system
+combinators kernel sequences debugger io accessors ;
+IN: iokit
+
+<< {
+    { [ os macosx? ] [ "/System/Library/Frameworks/IOKit.framework" load-framework ] }
+    [ "IOKit only supported on Mac OS X" ]
+} cond >>
+
+: kIOKitBuildVersionKey   "IOKitBuildVersion" ; inline
+: kIOKitDiagnosticsKey   "IOKitDiagnostics" ; inline
+ 
+: kIORegistryPlanesKey   "IORegistryPlanes" ; inline
+: kIOCatalogueKey    "IOCatalogue" ; inline
+
+: kIOServicePlane    "IOService" ; inline
+: kIOPowerPlane    "IOPower" ; inline
+: kIODeviceTreePlane   "IODeviceTree" ; inline
+: kIOAudioPlane    "IOAudio" ; inline
+: kIOFireWirePlane   "IOFireWire" ; inline
+: kIOUSBPlane    "IOUSB" ; inline
+
+: kIOServiceClass    "IOService" ; inline
+
+: kIOResourcesClass   "IOResources" ; inline
+
+: kIOClassKey    "IOClass" ; inline
+: kIOProbeScoreKey   "IOProbeScore" ; inline
+: kIOKitDebugKey    "IOKitDebug" ; inline
+
+: kIOProviderClassKey   "IOProviderClass" ; inline
+: kIONameMatchKey    "IONameMatch" ; inline
+: kIOPropertyMatchKey   "IOPropertyMatch" ; inline
+: kIOPathMatchKey    "IOPathMatch" ; inline
+: kIOLocationMatchKey   "IOLocationMatch" ; inline
+: kIOParentMatchKey   "IOParentMatch" ; inline
+: kIOResourceMatchKey   "IOResourceMatch" ; inline
+: kIOMatchedServiceCountKey  "IOMatchedServiceCountMatch" ; inline
+
+: kIONameMatchedKey   "IONameMatched" ; inline
+
+: kIOMatchCategoryKey   "IOMatchCategory" ; inline
+: kIODefaultMatchCategoryKey  "IODefaultMatchCategory" ; inline
+
+: kIOUserClientClassKey   "IOUserClientClass" ; inline
+
+: kIOUserClientCrossEndianKey   "IOUserClientCrossEndian" ; inline
+: kIOUserClientCrossEndianCompatibleKey  "IOUserClientCrossEndianCompatible" ; inline
+: kIOUserClientSharedInstanceKey   "IOUserClientSharedInstance" ; inline
+
+: kIOPublishNotification   "IOServicePublish" ; inline
+: kIOFirstPublishNotification  "IOServiceFirstPublish" ; inline
+: kIOMatchedNotification   "IOServiceMatched" ; inline
+: kIOFirstMatchNotification  "IOServiceFirstMatch" ; inline
+: kIOTerminatedNotification  "IOServiceTerminate" ; inline
+
+: kIOGeneralInterest   "IOGeneralInterest" ; inline
+: kIOBusyInterest    "IOBusyInterest" ; inline
+: kIOAppPowerStateInterest  "IOAppPowerStateInterest" ; inline
+: kIOPriorityPowerStateInterest  "IOPriorityPowerStateInterest" ; inline
+
+: kIOPlatformDeviceMessageKey "IOPlatformDeviceMessage" ; inline
+
+: kIOCFPlugInTypesKey   "IOCFPlugInTypes" ; inline
+
+: kIOCommandPoolSizeKey         "IOCommandPoolSize" ; inline
+
+: kIOMaximumBlockCountReadKey "IOMaximumBlockCountRead" ; inline
+: kIOMaximumBlockCountWriteKey "IOMaximumBlockCountWrite" ; inline
+: kIOMaximumByteCountReadKey "IOMaximumByteCountRead" ; inline
+: kIOMaximumByteCountWriteKey "IOMaximumByteCountWrite" ; inline
+: kIOMaximumSegmentCountReadKey "IOMaximumSegmentCountRead" ; inline
+: kIOMaximumSegmentCountWriteKey "IOMaximumSegmentCountWrite" ; inline
+: kIOMaximumSegmentByteCountReadKey "IOMaximumSegmentByteCountRead" ; inline
+: kIOMaximumSegmentByteCountWriteKey "IOMaximumSegmentByteCountWrite" ; inline
+: kIOMinimumSegmentAlignmentByteCountKey "IOMinimumSegmentAlignmentByteCount" ; inline
+: kIOMaximumSegmentAddressableBitCountKey "IOMaximumSegmentAddressableBitCount" ; inline
+
+: kIOIconKey "IOIcon" ; inline
+: kIOBundleResourceFileKey "IOBundleResourceFile" ; inline
+
+: kIOBusBadgeKey "IOBusBadge" ; inline
+: kIODeviceIconKey "IODeviceIcon" ; inline
+
+: kIOPlatformSerialNumberKey  "IOPlatformSerialNumber"  ; inline
+
+: kIOPlatformUUIDKey  "IOPlatformUUID"  ; inline
+
+: kIONVRAMDeletePropertyKey  "IONVRAM-DELETE-PROPERTY" ; inline
+: kIODTNVRAMPanicInfoKey   "aapl,panic-info" ; inline
+
+: kIOBootDeviceKey "IOBootDevice"   ; inline
+: kIOBootDevicePathKey "IOBootDevicePath"  ; inline
+: kIOBootDeviceSizeKey "IOBootDeviceSize"  ; inline
+
+: kOSBuildVersionKey   "OS Build Version" ; inline
+
+: kNilOptions 0 ; inline
+
+TYPEDEF: uint mach_port_t
+TYPEDEF: int kern_return_t
+TYPEDEF: int boolean_t
+TYPEDEF: mach_port_t io_object_t
+TYPEDEF: io_object_t io_iterator_t
+TYPEDEF: io_object_t io_registry_entry_t
+TYPEDEF: io_object_t io_service_t
+TYPEDEF: char[128] io_name_t
+TYPEDEF: char[512] io_string_t
+TYPEDEF: kern_return_t IOReturn
+
+TYPEDEF: uint IOOptionBits
+
+: MACH_PORT_NULL 0 ; inline
+: KERN_SUCCESS 0 ; inline
+
+FUNCTION: IOReturn IOMasterPort ( mach_port_t bootstrap, mach_port_t* master ) ;
+
+FUNCTION: CFDictionaryRef IOServiceMatching ( char* name ) ;
+FUNCTION: CFDictionaryRef IOServiceNameMatching ( char* name ) ;
+FUNCTION: CFDictionaryRef IOBSDNameMatching ( char* name ) ;
+
+FUNCTION: IOReturn IOObjectRetain ( io_object_t o ) ;
+FUNCTION: IOReturn IOObjectRelease ( io_object_t o ) ;
+
+FUNCTION: IOReturn IOServiceGetMatchingServices ( mach_port_t master, CFDictionaryRef matchingDict, io_iterator_t* iterator ) ;
+
+FUNCTION: io_object_t IOIteratorNext ( io_iterator_t i ) ;
+FUNCTION: void IOIteratorReset ( io_iterator_t i ) ;
+FUNCTION: boolean_t IOIteratorIsValid ( io_iterator_t i ) ;
+
+FUNCTION: IOReturn IORegistryEntryGetPath ( io_registry_entry_t entry, io_name_t plane, io_string_t path ) ;
+
+FUNCTION: IOReturn IORegistryEntryCreateCFProperties ( io_registry_entry_t entry, CFMutableDictionaryRef properties, CFAllocatorRef allocator, IOOptionBits options ) ;
+
+FUNCTION: char* mach_error_string ( IOReturn error ) ;
+
+TUPLE: mach-error error-code ;
+C: <mach-error> mach-error
+
+M: mach-error error.
+    "IOKit call failed: " print error-code>> mach_error_string print ;
+
+: mach-error ( return -- )
+    dup KERN_SUCCESS = [ drop ] [ <mach-error> throw ] if ;
+
+: master-port ( -- port )
+    MACH_PORT_NULL 0 <uint> [ IOMasterPort mach-error ] keep *uint ;
+
+: io-services-matching-dictionary ( nsdictionary -- iterator )
+    master-port swap 0 <uint>
+    [ IOServiceGetMatchingServices mach-error ] keep
+    *uint ;
+
+: io-services-matching-service ( service -- iterator )
+    IOServiceMatching io-services-matching-dictionary ;
+: io-services-matching-service-name ( service-name -- iterator )
+    IOServiceNameMatching io-services-matching-dictionary ;
+: io-services-matching-bsd-name ( bsd-name -- iterator )
+    IOBSDNameMatching io-services-matching-dictionary ;
+
+: retain-io-object ( o -- o )
+    [ IOObjectRetain mach-error ] keep ;
+: release-io-object ( o -- )
+    IOObjectRelease mach-error ;
+
+: io-objects-from-iterator* ( i -- i array )
+    [ dup IOIteratorNext dup MACH_PORT_NULL = not ]
+    [ ]
+    [ drop ] produce ;
+
+: io-objects-from-iterator ( i -- array )
+    io-objects-from-iterator* [ release-io-object ] dip ;
+    
+: properties-from-io-object ( o -- o nsdictionary )
+    dup f <void*> [
+        kCFAllocatorDefault kNilOptions
+        IORegistryEntryCreateCFProperties mach-error
+    ]
+    keep *void* ;
+

extra/iokit/summary.txt

@@ -0,0 +1 @@
+Bindings to Apple IOKit device interface

extra/iokit/tags.txt

@@ -0,0 +1,3 @@
+mac
+bindings
+system

extra/math/blas/syntax/syntax.factor

@@ -1,4 +1,5 @@
-USING: kernel math.blas.matrices math.blas.vectors parser ;
+USING: kernel math.blas.matrices math.blas.vectors parser
+arrays prettyprint.backend sequences ;
 IN: math.blas.syntax
 
 : svector{ ( accum -- accum )
@@ -18,3 +19,16 @@ IN: math.blas.syntax
     \ } [ >float-complex-blas-matrix ] parse-literal ; parsing
 : zmatrix{ ( accum -- accum )
     \ } [ >double-complex-blas-matrix ] parse-literal ; parsing
+
+M: float-blas-vector pprint-delims drop \ svector{ \ } ;
+M: double-blas-vector pprint-delims drop \ dvector{ \ } ;
+M: float-complex-blas-vector pprint-delims drop \ cvector{ \ } ;
+M: double-complex-blas-vector pprint-delims drop \ zvector{ \ } ;
+
+M: float-blas-matrix pprint-delims drop \ smatrix{ \ } ;
+M: double-blas-matrix pprint-delims drop \ dmatrix{ \ } ;
+M: float-complex-blas-matrix pprint-delims drop \ cmatrix{ \ } ;
+M: double-complex-blas-matrix pprint-delims drop \ zmatrix{ \ } ;
+
+M: blas-vector-base >pprint-sequence ;
+M: blas-matrix-base >pprint-sequence Mrows ;

extra/math/blas/vectors/vectors-tests.factor

@@ -104,12 +104,12 @@ unit-test
 [ svector{ 1.0 2.0 } ] [ svector{ 4.0 8.0 } 4.0 V/n ] unit-test
 [ dvector{ 1.0 2.0 } ] [ dvector{ 4.0 8.0 } 4.0 V/n ] unit-test
 
-[ cvector{ 2.0 1.0 } ]
+[ cvector{ C{ 0.0 -4.0 } 1.0 } ]
-[ cvector{ C{ 16.0 4.0 } C{ 8.0 2.0 } } C{ 8.0 2.0 } V/n ]
+[ cvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ]
 unit-test
 
-[ cvector{ 2.0 1.0 } ]
+[ zvector{ C{ 0.0 -4.0 } 1.0 } ]
-[ cvector{ C{ 16.0 4.0 } C{ 8.0 2.0 } } C{ 8.0 2.0 } V/n ]
+[ zvector{ C{ 4.0 -4.0 } C{ 1.0 1.0 } } C{ 1.0 1.0 } V/n ]
 unit-test
 
 ! V.

extra/math/primes/primes.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2007 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators kernel lists.lazy math math.functions math.miller-rabin
-       math.order math.primes.list math.ranges sequences sorting ;
+       math.order math.primes.list math.ranges sequences sorting
+       binary-search ;
 IN: math.primes
 
 <PRIVATE
@@ -13,14 +14,14 @@ PRIVATE>
 
 : next-prime ( n -- p )
   dup 999983 < [
-    primes-under-million [ [ <=> ] binsearch 1+ ] keep nth
+    primes-under-million [ natural-search drop 1+ ] keep nth
   ] [
     next-odd find-prime-miller-rabin
   ] if ; foldable
 
 : prime? ( n -- ? )
   dup 1000000 < [
-    dup primes-under-million [ <=> ] binsearch* =
+    dup primes-under-million natural-search nip =
   ] [
     miller-rabin
   ] if ; foldable
@@ -37,7 +38,7 @@ PRIVATE>
   {
     { [ dup 2 < ] [ drop { } ] }
     { [ dup 1000003 < ]
-      [ primes-under-million [ [ <=> ] binsearch 1+ 0 swap ] keep <slice> ] }
+      [ primes-under-million [ natural-search drop 1+ 0 swap ] keep <slice> ] }
     [ primes-under-million 1000003 lprimes-from
         rot [ <= ] curry lwhile list>array append ]
   } cond ; foldable
@@ -45,6 +46,6 @@ PRIVATE>
 : primes-between ( low high -- seq )
   primes-upto
   [ 1- next-prime ] dip
-  [ [ <=> ] binsearch ] keep [ length ] keep <slice> ; foldable
+  [ natural-search drop ] keep [ length ] keep <slice> ; foldable
 
 : coprime? ( a b -- ? ) gcd nip 1 = ; foldable

extra/soundex/soundex-tests.factor

@@ -2,3 +2,4 @@ IN: soundex.tests
 USING: soundex tools.test ;
 
 [ "S162" ] [ "supercalifrag" soundex ] unit-test
+[ "M000" ] [ "M" soundex ] unit-test

extra/soundex/soundex.factor

@@ -25,8 +25,8 @@ TR: soundex-tr
         [ first>upper ]
         [
             soundex-tr
-            trim-first
+            [ "" ] [ trim-first ] if-empty
-            remove-duplicates
+            [ "" ] [ remove-duplicates ] if-empty
             remove-zeroes
         ] bi
         pad-4

extra/tools/vocabs/browser/browser.factor

@@ -3,7 +3,7 @@
 USING: accessors kernel combinators vocabs vocabs.loader
 tools.vocabs io io.files io.styles help.markup help.stylesheet
 sequences assocs help.topics namespaces prettyprint words
-sorting definitions arrays summary sets ;
+sorting definitions arrays summary sets generic ;
 IN: tools.vocabs.browser
 
 : vocab-status-string ( vocab -- string )
@@ -104,9 +104,9 @@ C: <vocab-author> vocab-author
     ] unless drop ;
 
 : vocab-xref ( vocab quot -- vocabs )
-    >r dup vocab-name swap words r> map
+    >r dup vocab-name swap words [ generic? not ] filter r> map
     [ [ word? ] filter [ vocabulary>> ] map ] gather natural-sort
-    remove sift [ vocab ] map ; inline
+    remove sift ; inline
 
 : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
 
@@ -115,13 +115,13 @@ C: <vocab-author> vocab-author
 : describe-uses ( vocab -- )
     vocab-uses dup empty? [
         "Uses" $heading
-        dup $links
+        dup $vocab-links
     ] unless drop ;
 
 : describe-usage ( vocab -- )
     vocab-usage dup empty? [
         "Used by" $heading
-        dup $links
+        dup $vocab-links
     ] unless drop ;
 
 : $describe-vocab ( element -- )

extra/ui/gadgets/books/books.factor

@@ -7,27 +7,24 @@ TUPLE: book < gadget ;
 
 : hide-all ( book -- ) gadget-children [ hide-gadget ] each ;
 
-: current-page ( book -- gadget )
+: current-page ( book -- gadget ) [ control-value ] keep nth-gadget ;
-    [ control-value ] keep nth-gadget ;
 
-M: book model-changed
+M: book model-changed ( model book -- )
     nip
     dup hide-all
     dup current-page show-gadget
     relayout ;
 
 : new-book ( pages model class -- book )
-    new-gadget
+  new-gadget
-        swap >>model
+    swap >>model
-        [ swap add-gadgets drop ] keep ; inline
+    swap add-gadgets ; inline
 
-: <book> ( pages model -- book )
+: <book> ( pages model -- book ) book new-book ;
-    book new-book ;
 
-M: book pref-dim* gadget-children pref-dims max-dim ;
+M: book pref-dim* ( book -- dim ) children>> pref-dims max-dim ;
 
-M: book layout*
+M: book layout* ( book -- )
-    dup rect-dim swap gadget-children
+   [ dim>> ] [ children>> ] bi [ set-layout-dim ] with each ;
-    [ set-layout-dim ] with each ;
 
-M: book focusable-child* current-page ;
+M: book focusable-child* ( book -- child/t ) current-page ;

extra/ui/gadgets/gadgets.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays hashtables kernel models math namespaces
-       sequences quotations math.vectors combinators sorting vectors
+       sequences quotations math.vectors combinators sorting
-       dlists dequeues models threads concurrency.flags
+       binary-search vectors dlists dequeues models threads
-       math.order math.geometry.rect ;
+       concurrency.flags math.order math.geometry.rect ;
 
 IN: ui.gadgets
 
@@ -70,12 +70,15 @@ GENERIC: children-on ( rect/point gadget -- seq )
 
 M: gadget children-on nip children>> ;
 
-: (fast-children-on) ( dim axis gadgets -- i )
+: ((fast-children-on)) ( gadget dim axis -- <=> )
-    swapd [ rect-loc v- over v. 0 <=> ] binsearch nip ;
+    [ swap loc>> v- ] dip v. 0 <=> ;
+
+: (fast-children-on) ( dim axis children -- i )
+    -rot [ ((fast-children-on)) ] 2curry search drop ;
 
 : fast-children-on ( rect axis children -- from to )
-    [ >r >r rect-loc r> r> (fast-children-on) 0 or ]
+    [ [ rect-loc ] 2dip (fast-children-on) 0 or ]
-    [ >r >r dup rect-loc swap rect-dim v+ r> r> (fast-children-on) ?1+ ]
+    [ [ rect-bounds v+ ] 2dip (fast-children-on) ?1+ ]
     3bi ;
 
 : inside? ( bounds gadget -- ? )

extra/ui/gadgets/sliders/sliders.factor

@@ -9,27 +9,21 @@ IN: ui.gadgets.sliders
 
 TUPLE: elevator < gadget direction ;
 
-: find-elevator ( gadget -- elevator/f )
+: find-elevator ( gadget -- elevator/f ) [ elevator? ] find-parent ;
-    [ elevator? ] find-parent ;
 
 TUPLE: slider < frame elevator thumb saved line ;
 
-: find-slider ( gadget -- slider/f )
+: find-slider ( gadget -- slider/f ) [ slider? ] find-parent ;
-    [ slider? ] find-parent ;
 
 : elevator-length ( slider -- n )
-    dup slider-elevator rect-dim
+  [ elevator>> dim>> ] [ orientation>> ] bi v. ;
-    swap gadget-orientation v. ;
 
 : min-thumb-dim 15 ;
 
 : slider-value ( gadget -- n ) gadget-model range-value >fixnum ;
-
+: slider-page  ( gadget -- n ) gadget-model range-page-value    ;
-: slider-page ( gadget -- n ) gadget-model range-page-value ;
+: slider-max   ( gadget -- n ) gadget-model range-max-value     ;
-
+: slider-max*  ( gadget -- n ) gadget-model range-max-value*    ;
-: slider-max ( gadget -- n ) gadget-model range-max-value ;
-
-: slider-max* ( gadget -- n ) gadget-model range-max-value* ;
 
 : thumb-dim ( slider -- h )
     dup slider-page over slider-max 1 max / 1 min
@@ -45,7 +39,6 @@ TUPLE: slider < frame elevator thumb saved line ;
     swap slider-max* 1 max / ;
 
 : slider>screen ( m scale -- n ) slider-scale * ;
-
 : screen>slider ( m scale -- n ) slider-scale / ;
 
 M: slider model-changed nip slider-elevator relayout-1 ;
@@ -76,11 +69,9 @@ thumb H{
         t >>root?
     thumb-theme ;
 
-: slide-by ( amount slider -- )
+: slide-by ( amount slider -- ) gadget-model move-by ;
-    gadget-model move-by ;
 
-: slide-by-page ( amount slider -- )
+: slide-by-page ( amount slider -- ) gadget-model move-by-page ;
-    gadget-model move-by-page ;
 
 : compute-direction ( elevator -- -1/1 )
     dup find-slider swap hand-click-rel
@@ -100,13 +91,10 @@ elevator H{
     { T{ button-down } [ elevator-click ] }
 } set-gestures
 
-: elevator-theme ( elevator -- )
-    lowered-gradient swap set-gadget-interior ;
-
 : <elevator> ( vector -- elevator )
-    elevator new-gadget
+  elevator new-gadget
-    [ set-gadget-orientation ] keep
+    swap             >>orientation
-    dup elevator-theme ;
+    lowered-gradient >>interior ;
 
 : (layout-thumb) ( slider n -- n thumb )
     over gadget-orientation n*v swap slider-thumb ;
@@ -144,17 +132,10 @@ M: elevator layout*
   dup elevator>> over thumb>> add-gadget
   @center grid-add* ;
 
-: <left-button> ( -- button )
+: <left-button>  ( -- button ) { 0 1 } arrow-left -1 <slide-button> ;
-    { 0 1 } arrow-left -1 <slide-button> ;
+: <right-button> ( -- button ) { 0 1 } arrow-right 1 <slide-button> ;
-
+: <up-button>    ( -- button ) { 1 0 } arrow-up   -1 <slide-button> ;
-: <right-button> ( -- button )
+: <down-button>  ( -- button ) { 1 0 } arrow-down  1 <slide-button> ;
-    { 0 1 } arrow-right 1 <slide-button> ;
-
-: <up-button> ( -- button )
-    { 1 0 } arrow-up -1 <slide-button> ;
-
-: <down-button> ( -- button )
-    { 1 0 } arrow-down 1 <slide-button> ;
 
 : <slider> ( range orientation -- slider )
     slider new-frame

extra/ui/gadgets/tracks/tracks.factor

@@ -1,65 +1,65 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io kernel math namespaces
-sequences words math.vectors ui.gadgets ui.gadgets.packs math.geometry.rect ;
+       sequences words math.vectors ui.gadgets ui.gadgets.packs
+       math.geometry.rect fry ;
+
 IN: ui.gadgets.tracks
 
 TUPLE: track < pack sizes ;
 
 : normalized-sizes ( track -- seq )
-    track-sizes
+  sizes>> dup sift sum '[ dup [ , / ] when ] map ;
-    [ sift sum ] keep [ dup [ over / ] when ] map nip ;
 
 : new-track ( orientation class -- track )
-    new-gadget
+  new-gadget
-        swap >>orientation
+    swap       >>orientation
-        V{ } clone >>sizes
+    V{ } clone >>sizes
-        1 >>fill ; inline
+    1          >>fill ; inline
 
-: <track> ( orientation -- track )
+: <track> ( orientation -- track ) track new-track ;
-    track new-track ;
 
 : alloted-dim ( track -- dim )
-    dup gadget-children swap track-sizes { 0 0 }
+  [ children>> ] [ sizes>> ] bi { 0 0 }
-    [ [ drop { 0 0 } ] [ pref-dim ] if v+ ] 2reduce ;
+  [ [ drop { 0 0 } ] [ pref-dim ] if v+ ] 2reduce ;
 
-: available-dim ( track -- dim )
+: available-dim ( track -- dim ) [ dim>> ] [ alloted-dim ] bi v- ;
-    dup rect-dim swap alloted-dim v- ;
 
 : track-layout ( track -- sizes )
-    dup available-dim over gadget-children rot normalized-sizes
+    [ available-dim ] [ children>> ] [ normalized-sizes ] tri
     [ [ over n*v ] [ pref-dim ] ?if ] 2map nip ;
 
-M: track layout*
+M: track layout* ( track -- ) dup track-layout pack-layout ;
-    dup track-layout pack-layout ;
 
-: track-pref-dims-1 ( track -- dim )
+: track-pref-dims-1 ( track -- dim ) children>> pref-dims max-dim ;
-    gadget-children pref-dims max-dim ;
 
 : track-pref-dims-2 ( track -- dim )
-    dup gadget-children pref-dims swap normalized-sizes
+  [ children>> pref-dims ] [ normalized-sizes ] bi
-    [ [ v/n ] when* ] 2map max-dim [ >fixnum ] map ;
+  [ [ v/n ] when* ] 2map
+  max-dim
+  [ >fixnum ] map ;
 
-M: track pref-dim*
+M: track pref-dim* ( gadget -- dim )
-    dup track-pref-dims-1
+   [ track-pref-dims-1                           ]
-    over alloted-dim
+   [ [ alloted-dim ] [ track-pref-dims-1 ] bi v+ ]
-    pick track-pref-dims-2 v+
+   [ orientation>>                               ]
-    rot gadget-orientation set-axis ;
+   tri
+   set-axis ;
 
 : track-add ( gadget track constraint -- )
     over track-sizes push swap add-gadget drop ;
 
 : track-add* ( track gadget constraint -- track )
-    pick sizes>> push
+  pick sizes>> push add-gadget ;
-    add-gadget ;
 
-: track-remove ( gadget track -- )
+: track-remove ( track gadget -- track )
-    over [
+  dupd dup
-        [ gadget-children index ] 2keep
+    [
-        swap unparent track-sizes delete-nth
+      [ swap children>> index ]
-    ] [
+      [ unparent sizes>>      ] 2bi
-        2drop
+      delete-nth 
-    ] if ;
+    ]
+    [ 2drop ]
+  if ;
 
-: clear-track ( track -- )
+: clear-track ( track -- ) V{ } clone >>sizes clear-gadget ;
-    V{ } clone over set-track-sizes clear-gadget ;

extra/ui/tools/search/search-tests.factor

@@ -10,7 +10,7 @@ IN: ui.tools.search.tests
     T{ key-down f { C+ } "x" } swap search-gesture
 ] unit-test
 
-: assert-non-empty empty? f assert= ;
+: assert-non-empty ( obj -- ) empty? f assert= ;
 
 : update-live-search ( search -- seq )
     dup [

extra/ui/tools/tools-tests.factor

@@ -2,7 +2,7 @@ USING: ui.tools ui.tools.interactor ui.tools.listener
 ui.tools.search ui.tools.workspace kernel models namespaces
 sequences tools.test ui.gadgets ui.gadgets.buttons
 ui.gadgets.labelled ui.gadgets.presentations
-ui.gadgets.scrollers vocabs tools.test.ui ui ;
+ui.gadgets.scrollers vocabs tools.test.ui ui accessors ;
 IN: ui.tools.tests
 
 [ f ]

extra/ui/tools/workspace/workspace.factor

@@ -1,25 +1,23 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
-sequences ui ui.backend ui.tools.debugger ui.gadgets
+       sequences ui ui.backend ui.tools.debugger ui.gadgets
-ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
+       ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
-ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
+       ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
-ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
+       ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
-ui.commands ui.gestures assocs arrays namespaces accessors ;
+       ui.commands ui.gestures assocs arrays namespaces accessors ;
+
 IN: ui.tools.workspace
 
 TUPLE: workspace < track book listener popup ;
 
-: find-workspace ( gadget -- workspace )
+: find-workspace ( gadget -- workspace ) [ workspace? ] find-parent ;
-    [ workspace? ] find-parent ;
 
 SYMBOL: workspace-window-hook
 
-: workspace-window* ( -- workspace )
+: workspace-window* ( -- workspace ) workspace-window-hook get call ;
-    workspace-window-hook get call ;
 
-: workspace-window ( -- )
+: workspace-window ( -- ) workspace-window* drop ;
-    workspace-window* drop ;
 
 GENERIC: call-tool* ( arg tool -- )
 
@@ -28,7 +26,7 @@ GENERIC: tool-scroller ( tool -- scroller )
 M: gadget tool-scroller drop f ;
 
 : find-tool ( class workspace -- index tool )
-    workspace-book gadget-children [ class eq? ] with find ;
+  book>> children>> [ class eq? ] with find ;
 
 : show-tool ( class workspace -- tool )
     [ find-tool swap ] keep workspace-book gadget-model
@@ -57,15 +55,15 @@ M: gadget tool-scroller drop f ;
     article-title open-window ;
 
 : hide-popup ( workspace -- )
-    dup workspace-popup over track-remove
+  dup popup>> track-remove
-    f over set-workspace-popup
+  f >>popup
-    request-focus ;
+  request-focus ;
 
 : show-popup ( gadget workspace -- )
-    dup hide-popup
+  dup hide-popup
-    2dup set-workspace-popup
+  over >>popup
-    dupd f track-add
+  over f track-add* drop
-    request-focus ;
+  request-focus ;
 
 : show-titled-popup ( workspace gadget title -- )
     [ find-workspace hide-popup ] <closable-gadget>

extra/usa-cities/usa-cities.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files io.encodings.ascii sequences generalizations
 math.parser combinators kernel memoize csv symbols summary
-words accessors math.order sorting ;
+words accessors math.order binary-search ;
 IN: usa-cities
 
 SINGLETONS: AK AL AR AS AZ CA CO CT DC DE FL GA HI IA ID IL IN
@@ -50,4 +50,4 @@ MEMO: cities-named-in ( name state -- cities )
     ] with with filter ;
 
 : find-zip-code ( code -- city )
-    cities [ first-zip>> <=> ] binsearch* ;
+    cities [ first-zip>> <=> ] with search nip ;

extra/windows/com/com-tests.factor

@@ -16,10 +16,10 @@ COM-INTERFACE: IUnrelated IUnknown {b06ac3f4-30e4-406b-a7cd-c29cead4552c}
     int xPlus ( int y )
     int xMulAdd ( int mul, int add ) ;
 
-"{216fb341-0eb2-44b1-8edb-60b76e353abc}" string>guid 1array [ ISimple-iid ] unit-test
+{ GUID: {216fb341-0eb2-44b1-8edb-60b76e353abc} } [ ISimple-iid ] unit-test
-"{9620ecec-8438-423b-bb14-86f835aa40dd}" string>guid 1array [ IInherited-iid ] unit-test
+{ GUID: {9620ecec-8438-423b-bb14-86f835aa40dd} } [ IInherited-iid ] unit-test
-"{00000000-0000-0000-C000-000000000046}" string>guid 1array [ IUnknown-iid ] unit-test
+{ GUID: {00000000-0000-0000-C000-000000000046} } [ IUnknown-iid ] unit-test
-"{b06ac3f4-30e4-406b-a7cd-c29cead4552c}" string>guid 1array [ IUnrelated-iid ] unit-test
+{ GUID: {b06ac3f4-30e4-406b-a7cd-c29cead4552c} } [ IUnrelated-iid ] unit-test
 
 { (( -- iid )) } [ \ ISimple-iid stack-effect ] unit-test
 { (( this -- HRESULT )) } [ \ ISimple::returnOK stack-effect ] unit-test

extra/windows/com/syntax/syntax-docs.factor

@@ -1,26 +1,30 @@
-USING: help.markup help.syntax io kernel math quotations
+USING: help.markup help.syntax io kernel math quotations
-multiline ;
+multiline ;
-IN: windows.com.syntax
+IN: windows.com.syntax
-
+
-HELP: COM-INTERFACE:
+HELP: GUID:
-{ $syntax <"
+{ $syntax "GUID: {01234567-89ab-cdef-0123-456789abcdef}" }
-COM-INTERFACE: <interface> <parent> <iid>
+{ $description "\nCreate a COM globally-unique identifier (GUID) literal at parse time, and push it onto the data stack." } ;
-    <function-1> ( <params1> )
+
-    <function-2> ( <params2> )
+HELP: COM-INTERFACE:
-    ... ;
+{ $syntax <"
-"> }
+COM-INTERFACE: <interface> <parent> <iid>
-{ $description "\nFor the interface " { $snippet "<interface>" } ", a word " { $snippet "<interface>-iid ( -- iid )" } " is defined to push the interface GUID (IID) onto the stack. Words of the form " { $snippet "<interface>::<function>" } " are also defined to invoke each method, as well as the methods inherited from " { $snippet "<parent>" } ". A " { $snippet "<parent>" } " of " { $snippet "f" } " indicates that the interface is a root interface. (Note that COM conventions demand that all interfaces at least inherit from " { $snippet "IUnknown" } ".)\n\nExample:" }
+    <function-1> ( <params1> )
-{ $code <"
+    <function-2> ( <params2> )
-COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}
+    ... ;
-    HRESULT QueryInterface ( REFGUID iid, void** ppvObject )
+"> }
-    ULONG AddRef ( )
+{ $description "\nFor the interface " { $snippet "<interface>" } ", a word " { $snippet "<interface>-iid ( -- iid )" } " is defined to push the interface GUID (IID) onto the stack. Words of the form " { $snippet "<interface>::<function>" } " are also defined to invoke each method, as well as the methods inherited from " { $snippet "<parent>" } ". A " { $snippet "<parent>" } " of " { $snippet "f" } " indicates that the interface is a root interface. (Note that COM conventions demand that all interfaces at least inherit from " { $snippet "IUnknown" } ".)\n\nExample:" }
-    ULONG Release ( ) ;
+{ $code <"
-
+COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}
-COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
+    HRESULT QueryInterface ( REFGUID iid, void** ppvObject )
-    HRESULT returnOK ( )
+    ULONG AddRef ( )
-    HRESULT returnError ( ) ;
+    ULONG Release ( ) ;
-
+
-COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd}
+COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}
-    int getX ( )
+    HRESULT returnOK ( )
-    void setX ( int newX ) ;
+    HRESULT returnError ( ) ;
-"> } ;
+
+COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd}
+    int getX ( )
+    void setX ( int newX ) ;
+"> } ;

extra/windows/com/syntax/syntax.factor

@@ -100,3 +100,4 @@ PRIVATE>
     define-words-for-com-interface
     ; parsing
 
+: GUID: scan string>guid parsed ; parsing

extra/windows/dinput/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/windows/dinput/constants/constants.factor

@@ -0,0 +1,583 @@
+USING: windows.dinput windows.kernel32 windows.ole32 windows.com
+windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
+combinators sequences symbols fry math accessors macros words quotations
+libc continuations generalizations splitting locals assocs ;
+IN: windows.dinput.constants
+
+! Some global variables aren't provided by the DirectInput DLL (they're in the
+! dinput8.lib import library), so we lovingly hand-craft equivalent values here
+
+SYMBOLS:
+    GUID_XAxis GUID_YAxis GUID_ZAxis
+    GUID_RxAxis GUID_RyAxis GUID_RzAxis
+    GUID_Slider GUID_Button GUID_Key GUID_POV GUID_Unknown
+    GUID_SysMouse GUID_SysKeyboard GUID_Joystick GUID_SysMouseEm
+    GUID_SysMouseEm2 GUID_SysKeyboardEm GUID_SysKeyboardEm2
+    c_dfDIKeyboard c_dfDIMouse2 c_dfDIJoystick2 ;
+
+<PRIVATE
+
+: (field-spec-of) ( field struct -- field-spec )
+    c-type fields>> [ name>> = ] with find nip ;
+: (offsetof) ( field struct -- offset )
+    [ (field-spec-of) offset>> ] [ drop 0 ] if* ;
+: (sizeof) ( field struct -- size )
+    [ (field-spec-of) class>> "[" split1 drop heap-size ] [ drop 1 ] if* ;
+
+MACRO: (flags) ( array -- )
+    0 [ {
+        { [ dup word? ] [ execute ] }
+        { [ dup callable? ] [ call ] }
+        [ ]
+    } cond bitor ] reduce 1quotation ;
+
+: (DIOBJECTDATAFORMAT) ( pguid dwOfs dwType dwFlags alien -- alien )
+    [ {
+        [ set-DIOBJECTDATAFORMAT-dwFlags ]
+        [ set-DIOBJECTDATAFORMAT-dwType ]
+        [ set-DIOBJECTDATAFORMAT-dwOfs ]
+        [ set-DIOBJECTDATAFORMAT-pguid ]
+    } cleave ] keep ;
+
+: <DIOBJECTDATAFORMAT> ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- alien )
+    {
+        [ first dup word? [ get ] when ]
+        [ second rot [ (offsetof) ] [ (sizeof) ] 2bi ]
+        [ third * + ]
+        [ fourth (flags) ]
+        [ 4 swap nth ]
+    } cleave
+    "DIOBJECTDATAFORMAT" <c-object> (DIOBJECTDATAFORMAT) ;
+
+: malloc-DIOBJECTDATAFORMAT-array ( struct array -- alien )
+    [ nip length "DIOBJECTDATAFORMAT" malloc-array dup ]
+    [
+        -rot [| args i alien struct |
+            struct args <DIOBJECTDATAFORMAT>
+            i alien set-DIOBJECTDATAFORMAT-nth
+        ] 2curry each-index
+    ] 2bi ;
+
+: (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )
+    [ {
+        [ set-DIDATAFORMAT-rgodf ]
+        [ set-DIDATAFORMAT-dwNumObjs ]
+        [ set-DIDATAFORMAT-dwDataSize ]
+        [ set-DIDATAFORMAT-dwFlags ]
+        [ set-DIDATAFORMAT-dwObjSize ]
+        [ set-DIDATAFORMAT-dwSize ]
+    } cleave ] keep ;
+
+: <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
+    [ "DIDATAFORMAT" heap-size "DIOBJECTDATAFORMAT" heap-size ] 4 ndip
+    [ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
+    "DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
+
+: (malloc-guid-symbol) ( symbol guid -- )
+    global swap '[ [
+        , [ byte-length malloc ] [ over byte-array>memory ] bi
+    ] unless* ] change-at ;
+
+: define-guid-constants ( -- )
+    {
+        { GUID_XAxis          GUID: {A36D02E0-C9F3-11CF-BFC7-444553540000} }
+        { GUID_YAxis          GUID: {A36D02E1-C9F3-11CF-BFC7-444553540000} }
+        { GUID_ZAxis          GUID: {A36D02E2-C9F3-11CF-BFC7-444553540000} }
+        { GUID_RxAxis         GUID: {A36D02F4-C9F3-11CF-BFC7-444553540000} }
+        { GUID_RyAxis         GUID: {A36D02F5-C9F3-11CF-BFC7-444553540000} }
+        { GUID_RzAxis         GUID: {A36D02E3-C9F3-11CF-BFC7-444553540000} }
+        { GUID_Slider         GUID: {A36D02E4-C9F3-11CF-BFC7-444553540000} }
+        { GUID_Button         GUID: {A36D02F0-C9F3-11CF-BFC7-444553540000} }
+        { GUID_Key            GUID: {55728220-D33C-11CF-BFC7-444553540000} }
+        { GUID_POV            GUID: {A36D02F2-C9F3-11CF-BFC7-444553540000} }
+        { GUID_Unknown        GUID: {A36D02F3-C9F3-11CF-BFC7-444553540000} }
+        { GUID_SysMouse       GUID: {6F1D2B60-D5A0-11CF-BFC7-444553540000} }
+        { GUID_SysKeyboard    GUID: {6F1D2B61-D5A0-11CF-BFC7-444553540000} }
+        { GUID_Joystick       GUID: {6F1D2B70-D5A0-11CF-BFC7-444553540000} }
+        { GUID_SysMouseEm     GUID: {6F1D2B80-D5A0-11CF-BFC7-444553540000} }
+        { GUID_SysMouseEm2    GUID: {6F1D2B81-D5A0-11CF-BFC7-444553540000} }
+        { GUID_SysKeyboardEm  GUID: {6F1D2B82-D5A0-11CF-BFC7-444553540000} }
+        { GUID_SysKeyboardEm2 GUID: {6F1D2B83-D5A0-11CF-BFC7-444553540000} }
+    } [ first2 (malloc-guid-symbol) ] each ;
+
+: define-joystick-format-constant ( -- )
+    c_dfDIJoystick2 global [ [
+        DIDF_ABSAXIS
+        "DIJOYSTATE2" heap-size
+        "DIJOYSTATE2" {
+            { GUID_XAxis  "lX"           0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_YAxis  "lY"           0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_ZAxis  "lZ"           0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RxAxis "lRx"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RyAxis "lRy"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RzAxis "lRz"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglSlider"    0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglSlider"    1 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_POV    "rgdwPOV"      0 { DIDFT_OPTIONAL DIDFT_POV    DIDFT_ANYINSTANCE } 0 }
+            { GUID_POV    "rgdwPOV"      1 { DIDFT_OPTIONAL DIDFT_POV    DIDFT_ANYINSTANCE } 0 }
+            { GUID_POV    "rgdwPOV"      2 { DIDFT_OPTIONAL DIDFT_POV    DIDFT_ANYINSTANCE } 0 }
+            { GUID_POV    "rgdwPOV"      3 { DIDFT_OPTIONAL DIDFT_POV    DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   0 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   1 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   2 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   3 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   4 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   5 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   6 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   7 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   8 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"   9 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  10 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  11 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  12 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  13 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  14 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  15 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  16 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  17 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  18 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  19 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  20 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  21 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  22 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  23 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  24 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  25 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  26 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  27 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  28 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  29 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  30 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  31 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  32 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  33 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  34 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  35 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  36 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  37 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  38 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  39 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  40 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  41 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  42 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  43 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  44 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  45 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  46 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  47 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  48 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  49 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  50 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  51 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  52 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  53 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  54 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  55 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  56 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  57 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  58 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  59 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  60 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  61 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  62 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  63 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  64 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  65 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  66 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  67 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  68 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  69 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  70 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  71 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  72 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  73 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  74 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  75 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  76 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  77 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  78 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  79 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  80 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  81 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  82 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  83 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  84 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  85 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  86 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  87 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  88 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  89 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  90 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  91 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  92 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  93 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  94 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  95 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  96 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  97 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  98 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons"  99 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 100 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 101 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 102 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 103 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 104 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 105 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 106 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 107 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 108 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 109 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 110 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 111 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 112 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 113 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 114 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 115 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 116 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 117 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 118 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 119 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 120 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 121 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 122 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 123 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 124 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 125 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 126 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { f           "rgbButtons" 127 { DIDFT_OPTIONAL DIDFT_BUTTON DIDFT_ANYINSTANCE } 0 }
+            { GUID_XAxis  "lVX"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_YAxis  "lVY"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_ZAxis  "lVZ"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RxAxis "lVRx"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RyAxis "lVRy"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RzAxis "lVRz"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglVSlider"   0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglVSlider"   1 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_XAxis  "lAX"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_YAxis  "lAY"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_ZAxis  "lAZ"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RxAxis "lARx"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RyAxis "lARy"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RzAxis "lARz"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglASlider"   0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglASlider"   1 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_XAxis  "lFX"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_YAxis  "lFY"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_ZAxis  "lFZ"          0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RxAxis "lFRx"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RyAxis "lFRy"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_RzAxis "lFRz"         0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglFSlider"   0 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+            { GUID_Slider "rglFSlider"   1 { DIDFT_OPTIONAL DIDFT_AXIS   DIDFT_ANYINSTANCE } 0 }
+        } <DIDATAFORMAT>
+    ] unless* ] change-at ;
+
+: define-mouse-format-constant ( -- )
+    c_dfDIMouse2 global [ [
+        DIDF_RELAXIS
+        "DIMOUSESTATE2" heap-size
+        "DIMOUSESTATE2" {
+            { GUID_XAxis  "lX"         0 {                DIDFT_ANYINSTANCE DIDFT_AXIS   } 0 }
+            { GUID_YAxis  "lY"         0 {                DIDFT_ANYINSTANCE DIDFT_AXIS   } 0 }
+            { GUID_ZAxis  "lZ"         0 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_AXIS   } 0 }
+            { GUID_Button "rgbButtons" 0 {                DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+            { GUID_Button "rgbButtons" 1 {                DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+            { GUID_Button "rgbButtons" 2 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+            { GUID_Button "rgbButtons" 3 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+            { GUID_Button "rgbButtons" 4 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+            { GUID_Button "rgbButtons" 5 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+            { GUID_Button "rgbButtons" 6 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+            { GUID_Button "rgbButtons" 7 { DIDFT_OPTIONAL DIDFT_ANYINSTANCE DIDFT_BUTTON } 0 }
+        } <DIDATAFORMAT>
+    ] unless* ] change-at ;
+
+: define-keyboard-format-constant ( -- )
+    c_dfDIKeyboard global [ [
+        DIDF_RELAXIS
+        256
+        f {
+            { GUID_Key f   0 { DIDFT_OPTIONAL DIDFT_BUTTON [   0 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   1 { DIDFT_OPTIONAL DIDFT_BUTTON [   1 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   2 { DIDFT_OPTIONAL DIDFT_BUTTON [   2 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   3 { DIDFT_OPTIONAL DIDFT_BUTTON [   3 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   4 { DIDFT_OPTIONAL DIDFT_BUTTON [   4 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   5 { DIDFT_OPTIONAL DIDFT_BUTTON [   5 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   6 { DIDFT_OPTIONAL DIDFT_BUTTON [   6 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   7 { DIDFT_OPTIONAL DIDFT_BUTTON [   7 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   8 { DIDFT_OPTIONAL DIDFT_BUTTON [   8 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f   9 { DIDFT_OPTIONAL DIDFT_BUTTON [   9 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  10 { DIDFT_OPTIONAL DIDFT_BUTTON [  10 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  11 { DIDFT_OPTIONAL DIDFT_BUTTON [  11 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  12 { DIDFT_OPTIONAL DIDFT_BUTTON [  12 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  13 { DIDFT_OPTIONAL DIDFT_BUTTON [  13 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  14 { DIDFT_OPTIONAL DIDFT_BUTTON [  14 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  15 { DIDFT_OPTIONAL DIDFT_BUTTON [  15 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  16 { DIDFT_OPTIONAL DIDFT_BUTTON [  16 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  17 { DIDFT_OPTIONAL DIDFT_BUTTON [  17 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  18 { DIDFT_OPTIONAL DIDFT_BUTTON [  18 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  19 { DIDFT_OPTIONAL DIDFT_BUTTON [  19 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  20 { DIDFT_OPTIONAL DIDFT_BUTTON [  20 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  21 { DIDFT_OPTIONAL DIDFT_BUTTON [  21 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  22 { DIDFT_OPTIONAL DIDFT_BUTTON [  22 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  23 { DIDFT_OPTIONAL DIDFT_BUTTON [  23 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  24 { DIDFT_OPTIONAL DIDFT_BUTTON [  24 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  25 { DIDFT_OPTIONAL DIDFT_BUTTON [  25 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  26 { DIDFT_OPTIONAL DIDFT_BUTTON [  26 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  27 { DIDFT_OPTIONAL DIDFT_BUTTON [  27 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  28 { DIDFT_OPTIONAL DIDFT_BUTTON [  28 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  29 { DIDFT_OPTIONAL DIDFT_BUTTON [  29 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  30 { DIDFT_OPTIONAL DIDFT_BUTTON [  30 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  31 { DIDFT_OPTIONAL DIDFT_BUTTON [  31 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  32 { DIDFT_OPTIONAL DIDFT_BUTTON [  32 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  33 { DIDFT_OPTIONAL DIDFT_BUTTON [  33 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  34 { DIDFT_OPTIONAL DIDFT_BUTTON [  34 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  35 { DIDFT_OPTIONAL DIDFT_BUTTON [  35 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  36 { DIDFT_OPTIONAL DIDFT_BUTTON [  36 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  37 { DIDFT_OPTIONAL DIDFT_BUTTON [  37 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  38 { DIDFT_OPTIONAL DIDFT_BUTTON [  38 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  39 { DIDFT_OPTIONAL DIDFT_BUTTON [  39 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  40 { DIDFT_OPTIONAL DIDFT_BUTTON [  40 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  41 { DIDFT_OPTIONAL DIDFT_BUTTON [  41 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  42 { DIDFT_OPTIONAL DIDFT_BUTTON [  42 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  43 { DIDFT_OPTIONAL DIDFT_BUTTON [  43 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  44 { DIDFT_OPTIONAL DIDFT_BUTTON [  44 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  45 { DIDFT_OPTIONAL DIDFT_BUTTON [  45 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  46 { DIDFT_OPTIONAL DIDFT_BUTTON [  46 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  47 { DIDFT_OPTIONAL DIDFT_BUTTON [  47 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  48 { DIDFT_OPTIONAL DIDFT_BUTTON [  48 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  49 { DIDFT_OPTIONAL DIDFT_BUTTON [  49 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  50 { DIDFT_OPTIONAL DIDFT_BUTTON [  50 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  51 { DIDFT_OPTIONAL DIDFT_BUTTON [  51 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  52 { DIDFT_OPTIONAL DIDFT_BUTTON [  52 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  53 { DIDFT_OPTIONAL DIDFT_BUTTON [  53 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  54 { DIDFT_OPTIONAL DIDFT_BUTTON [  54 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  55 { DIDFT_OPTIONAL DIDFT_BUTTON [  55 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  56 { DIDFT_OPTIONAL DIDFT_BUTTON [  56 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  57 { DIDFT_OPTIONAL DIDFT_BUTTON [  57 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  58 { DIDFT_OPTIONAL DIDFT_BUTTON [  58 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  59 { DIDFT_OPTIONAL DIDFT_BUTTON [  59 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  60 { DIDFT_OPTIONAL DIDFT_BUTTON [  60 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  61 { DIDFT_OPTIONAL DIDFT_BUTTON [  61 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  62 { DIDFT_OPTIONAL DIDFT_BUTTON [  62 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  63 { DIDFT_OPTIONAL DIDFT_BUTTON [  63 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  64 { DIDFT_OPTIONAL DIDFT_BUTTON [  64 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  65 { DIDFT_OPTIONAL DIDFT_BUTTON [  65 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  66 { DIDFT_OPTIONAL DIDFT_BUTTON [  66 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  67 { DIDFT_OPTIONAL DIDFT_BUTTON [  67 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  68 { DIDFT_OPTIONAL DIDFT_BUTTON [  68 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  69 { DIDFT_OPTIONAL DIDFT_BUTTON [  69 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  70 { DIDFT_OPTIONAL DIDFT_BUTTON [  70 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  71 { DIDFT_OPTIONAL DIDFT_BUTTON [  71 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  72 { DIDFT_OPTIONAL DIDFT_BUTTON [  72 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  73 { DIDFT_OPTIONAL DIDFT_BUTTON [  73 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  74 { DIDFT_OPTIONAL DIDFT_BUTTON [  74 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  75 { DIDFT_OPTIONAL DIDFT_BUTTON [  75 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  76 { DIDFT_OPTIONAL DIDFT_BUTTON [  76 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  77 { DIDFT_OPTIONAL DIDFT_BUTTON [  77 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  78 { DIDFT_OPTIONAL DIDFT_BUTTON [  78 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  79 { DIDFT_OPTIONAL DIDFT_BUTTON [  79 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  80 { DIDFT_OPTIONAL DIDFT_BUTTON [  80 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  81 { DIDFT_OPTIONAL DIDFT_BUTTON [  81 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  82 { DIDFT_OPTIONAL DIDFT_BUTTON [  82 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  83 { DIDFT_OPTIONAL DIDFT_BUTTON [  83 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  84 { DIDFT_OPTIONAL DIDFT_BUTTON [  84 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  85 { DIDFT_OPTIONAL DIDFT_BUTTON [  85 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  86 { DIDFT_OPTIONAL DIDFT_BUTTON [  86 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  87 { DIDFT_OPTIONAL DIDFT_BUTTON [  87 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  88 { DIDFT_OPTIONAL DIDFT_BUTTON [  88 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  89 { DIDFT_OPTIONAL DIDFT_BUTTON [  89 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  90 { DIDFT_OPTIONAL DIDFT_BUTTON [  90 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  91 { DIDFT_OPTIONAL DIDFT_BUTTON [  91 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  92 { DIDFT_OPTIONAL DIDFT_BUTTON [  92 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  93 { DIDFT_OPTIONAL DIDFT_BUTTON [  93 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  94 { DIDFT_OPTIONAL DIDFT_BUTTON [  94 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  95 { DIDFT_OPTIONAL DIDFT_BUTTON [  95 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  96 { DIDFT_OPTIONAL DIDFT_BUTTON [  96 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  97 { DIDFT_OPTIONAL DIDFT_BUTTON [  97 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  98 { DIDFT_OPTIONAL DIDFT_BUTTON [  98 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f  99 { DIDFT_OPTIONAL DIDFT_BUTTON [  99 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 100 { DIDFT_OPTIONAL DIDFT_BUTTON [ 100 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 101 { DIDFT_OPTIONAL DIDFT_BUTTON [ 101 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 102 { DIDFT_OPTIONAL DIDFT_BUTTON [ 102 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 103 { DIDFT_OPTIONAL DIDFT_BUTTON [ 103 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 104 { DIDFT_OPTIONAL DIDFT_BUTTON [ 104 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 105 { DIDFT_OPTIONAL DIDFT_BUTTON [ 105 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 106 { DIDFT_OPTIONAL DIDFT_BUTTON [ 106 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 107 { DIDFT_OPTIONAL DIDFT_BUTTON [ 107 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 108 { DIDFT_OPTIONAL DIDFT_BUTTON [ 108 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 109 { DIDFT_OPTIONAL DIDFT_BUTTON [ 109 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 110 { DIDFT_OPTIONAL DIDFT_BUTTON [ 110 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 111 { DIDFT_OPTIONAL DIDFT_BUTTON [ 111 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 112 { DIDFT_OPTIONAL DIDFT_BUTTON [ 112 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 113 { DIDFT_OPTIONAL DIDFT_BUTTON [ 113 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 114 { DIDFT_OPTIONAL DIDFT_BUTTON [ 114 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 115 { DIDFT_OPTIONAL DIDFT_BUTTON [ 115 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 116 { DIDFT_OPTIONAL DIDFT_BUTTON [ 116 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 117 { DIDFT_OPTIONAL DIDFT_BUTTON [ 117 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 118 { DIDFT_OPTIONAL DIDFT_BUTTON [ 118 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 119 { DIDFT_OPTIONAL DIDFT_BUTTON [ 119 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 120 { DIDFT_OPTIONAL DIDFT_BUTTON [ 120 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 121 { DIDFT_OPTIONAL DIDFT_BUTTON [ 121 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 122 { DIDFT_OPTIONAL DIDFT_BUTTON [ 122 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 123 { DIDFT_OPTIONAL DIDFT_BUTTON [ 123 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 124 { DIDFT_OPTIONAL DIDFT_BUTTON [ 124 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 125 { DIDFT_OPTIONAL DIDFT_BUTTON [ 125 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 126 { DIDFT_OPTIONAL DIDFT_BUTTON [ 126 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 127 { DIDFT_OPTIONAL DIDFT_BUTTON [ 127 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 128 { DIDFT_OPTIONAL DIDFT_BUTTON [ 128 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 129 { DIDFT_OPTIONAL DIDFT_BUTTON [ 129 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 130 { DIDFT_OPTIONAL DIDFT_BUTTON [ 130 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 131 { DIDFT_OPTIONAL DIDFT_BUTTON [ 131 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 132 { DIDFT_OPTIONAL DIDFT_BUTTON [ 132 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 133 { DIDFT_OPTIONAL DIDFT_BUTTON [ 133 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 134 { DIDFT_OPTIONAL DIDFT_BUTTON [ 134 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 135 { DIDFT_OPTIONAL DIDFT_BUTTON [ 135 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 136 { DIDFT_OPTIONAL DIDFT_BUTTON [ 136 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 137 { DIDFT_OPTIONAL DIDFT_BUTTON [ 137 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 138 { DIDFT_OPTIONAL DIDFT_BUTTON [ 138 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 139 { DIDFT_OPTIONAL DIDFT_BUTTON [ 139 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 140 { DIDFT_OPTIONAL DIDFT_BUTTON [ 140 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 141 { DIDFT_OPTIONAL DIDFT_BUTTON [ 141 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 142 { DIDFT_OPTIONAL DIDFT_BUTTON [ 142 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 143 { DIDFT_OPTIONAL DIDFT_BUTTON [ 143 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 144 { DIDFT_OPTIONAL DIDFT_BUTTON [ 144 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 145 { DIDFT_OPTIONAL DIDFT_BUTTON [ 145 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 146 { DIDFT_OPTIONAL DIDFT_BUTTON [ 146 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 147 { DIDFT_OPTIONAL DIDFT_BUTTON [ 147 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 148 { DIDFT_OPTIONAL DIDFT_BUTTON [ 148 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 149 { DIDFT_OPTIONAL DIDFT_BUTTON [ 149 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 150 { DIDFT_OPTIONAL DIDFT_BUTTON [ 150 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 151 { DIDFT_OPTIONAL DIDFT_BUTTON [ 151 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 152 { DIDFT_OPTIONAL DIDFT_BUTTON [ 152 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 153 { DIDFT_OPTIONAL DIDFT_BUTTON [ 153 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 154 { DIDFT_OPTIONAL DIDFT_BUTTON [ 154 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 155 { DIDFT_OPTIONAL DIDFT_BUTTON [ 155 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 156 { DIDFT_OPTIONAL DIDFT_BUTTON [ 156 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 157 { DIDFT_OPTIONAL DIDFT_BUTTON [ 157 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 158 { DIDFT_OPTIONAL DIDFT_BUTTON [ 158 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 159 { DIDFT_OPTIONAL DIDFT_BUTTON [ 159 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 160 { DIDFT_OPTIONAL DIDFT_BUTTON [ 160 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 161 { DIDFT_OPTIONAL DIDFT_BUTTON [ 161 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 162 { DIDFT_OPTIONAL DIDFT_BUTTON [ 162 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 163 { DIDFT_OPTIONAL DIDFT_BUTTON [ 163 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 164 { DIDFT_OPTIONAL DIDFT_BUTTON [ 164 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 165 { DIDFT_OPTIONAL DIDFT_BUTTON [ 165 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 166 { DIDFT_OPTIONAL DIDFT_BUTTON [ 166 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 167 { DIDFT_OPTIONAL DIDFT_BUTTON [ 167 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 168 { DIDFT_OPTIONAL DIDFT_BUTTON [ 168 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 169 { DIDFT_OPTIONAL DIDFT_BUTTON [ 169 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 170 { DIDFT_OPTIONAL DIDFT_BUTTON [ 170 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 171 { DIDFT_OPTIONAL DIDFT_BUTTON [ 171 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 172 { DIDFT_OPTIONAL DIDFT_BUTTON [ 172 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 173 { DIDFT_OPTIONAL DIDFT_BUTTON [ 173 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 174 { DIDFT_OPTIONAL DIDFT_BUTTON [ 174 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 175 { DIDFT_OPTIONAL DIDFT_BUTTON [ 175 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 176 { DIDFT_OPTIONAL DIDFT_BUTTON [ 176 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 177 { DIDFT_OPTIONAL DIDFT_BUTTON [ 177 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 178 { DIDFT_OPTIONAL DIDFT_BUTTON [ 178 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 179 { DIDFT_OPTIONAL DIDFT_BUTTON [ 179 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 180 { DIDFT_OPTIONAL DIDFT_BUTTON [ 180 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 181 { DIDFT_OPTIONAL DIDFT_BUTTON [ 181 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 182 { DIDFT_OPTIONAL DIDFT_BUTTON [ 182 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 183 { DIDFT_OPTIONAL DIDFT_BUTTON [ 183 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 184 { DIDFT_OPTIONAL DIDFT_BUTTON [ 184 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 185 { DIDFT_OPTIONAL DIDFT_BUTTON [ 185 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 186 { DIDFT_OPTIONAL DIDFT_BUTTON [ 186 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 187 { DIDFT_OPTIONAL DIDFT_BUTTON [ 187 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 188 { DIDFT_OPTIONAL DIDFT_BUTTON [ 188 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 189 { DIDFT_OPTIONAL DIDFT_BUTTON [ 189 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 190 { DIDFT_OPTIONAL DIDFT_BUTTON [ 190 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 191 { DIDFT_OPTIONAL DIDFT_BUTTON [ 191 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 192 { DIDFT_OPTIONAL DIDFT_BUTTON [ 192 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 193 { DIDFT_OPTIONAL DIDFT_BUTTON [ 193 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 194 { DIDFT_OPTIONAL DIDFT_BUTTON [ 194 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 195 { DIDFT_OPTIONAL DIDFT_BUTTON [ 195 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 196 { DIDFT_OPTIONAL DIDFT_BUTTON [ 196 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 197 { DIDFT_OPTIONAL DIDFT_BUTTON [ 197 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 198 { DIDFT_OPTIONAL DIDFT_BUTTON [ 198 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 199 { DIDFT_OPTIONAL DIDFT_BUTTON [ 199 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 200 { DIDFT_OPTIONAL DIDFT_BUTTON [ 200 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 201 { DIDFT_OPTIONAL DIDFT_BUTTON [ 201 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 202 { DIDFT_OPTIONAL DIDFT_BUTTON [ 202 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 203 { DIDFT_OPTIONAL DIDFT_BUTTON [ 203 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 204 { DIDFT_OPTIONAL DIDFT_BUTTON [ 204 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 205 { DIDFT_OPTIONAL DIDFT_BUTTON [ 205 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 206 { DIDFT_OPTIONAL DIDFT_BUTTON [ 206 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 207 { DIDFT_OPTIONAL DIDFT_BUTTON [ 207 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 208 { DIDFT_OPTIONAL DIDFT_BUTTON [ 208 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 209 { DIDFT_OPTIONAL DIDFT_BUTTON [ 209 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 210 { DIDFT_OPTIONAL DIDFT_BUTTON [ 210 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 211 { DIDFT_OPTIONAL DIDFT_BUTTON [ 211 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 212 { DIDFT_OPTIONAL DIDFT_BUTTON [ 212 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 213 { DIDFT_OPTIONAL DIDFT_BUTTON [ 213 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 214 { DIDFT_OPTIONAL DIDFT_BUTTON [ 214 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 215 { DIDFT_OPTIONAL DIDFT_BUTTON [ 215 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 216 { DIDFT_OPTIONAL DIDFT_BUTTON [ 216 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 217 { DIDFT_OPTIONAL DIDFT_BUTTON [ 217 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 218 { DIDFT_OPTIONAL DIDFT_BUTTON [ 218 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 219 { DIDFT_OPTIONAL DIDFT_BUTTON [ 219 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 220 { DIDFT_OPTIONAL DIDFT_BUTTON [ 220 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 221 { DIDFT_OPTIONAL DIDFT_BUTTON [ 221 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 222 { DIDFT_OPTIONAL DIDFT_BUTTON [ 222 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 223 { DIDFT_OPTIONAL DIDFT_BUTTON [ 223 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 224 { DIDFT_OPTIONAL DIDFT_BUTTON [ 224 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 225 { DIDFT_OPTIONAL DIDFT_BUTTON [ 225 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 226 { DIDFT_OPTIONAL DIDFT_BUTTON [ 226 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 227 { DIDFT_OPTIONAL DIDFT_BUTTON [ 227 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 228 { DIDFT_OPTIONAL DIDFT_BUTTON [ 228 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 229 { DIDFT_OPTIONAL DIDFT_BUTTON [ 229 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 230 { DIDFT_OPTIONAL DIDFT_BUTTON [ 230 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 231 { DIDFT_OPTIONAL DIDFT_BUTTON [ 231 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 232 { DIDFT_OPTIONAL DIDFT_BUTTON [ 232 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 233 { DIDFT_OPTIONAL DIDFT_BUTTON [ 233 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 234 { DIDFT_OPTIONAL DIDFT_BUTTON [ 234 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 235 { DIDFT_OPTIONAL DIDFT_BUTTON [ 235 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 236 { DIDFT_OPTIONAL DIDFT_BUTTON [ 236 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 237 { DIDFT_OPTIONAL DIDFT_BUTTON [ 237 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 238 { DIDFT_OPTIONAL DIDFT_BUTTON [ 238 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 239 { DIDFT_OPTIONAL DIDFT_BUTTON [ 239 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 240 { DIDFT_OPTIONAL DIDFT_BUTTON [ 240 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 241 { DIDFT_OPTIONAL DIDFT_BUTTON [ 241 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 242 { DIDFT_OPTIONAL DIDFT_BUTTON [ 242 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 243 { DIDFT_OPTIONAL DIDFT_BUTTON [ 243 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 244 { DIDFT_OPTIONAL DIDFT_BUTTON [ 244 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 245 { DIDFT_OPTIONAL DIDFT_BUTTON [ 245 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 246 { DIDFT_OPTIONAL DIDFT_BUTTON [ 246 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 247 { DIDFT_OPTIONAL DIDFT_BUTTON [ 247 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 248 { DIDFT_OPTIONAL DIDFT_BUTTON [ 248 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 249 { DIDFT_OPTIONAL DIDFT_BUTTON [ 249 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 250 { DIDFT_OPTIONAL DIDFT_BUTTON [ 250 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 251 { DIDFT_OPTIONAL DIDFT_BUTTON [ 251 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 252 { DIDFT_OPTIONAL DIDFT_BUTTON [ 252 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 253 { DIDFT_OPTIONAL DIDFT_BUTTON [ 253 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 254 { DIDFT_OPTIONAL DIDFT_BUTTON [ 254 DIDFT_MAKEINSTANCE ] } 0 }
+            { GUID_Key f 255 { DIDFT_OPTIONAL DIDFT_BUTTON [ 255 DIDFT_MAKEINSTANCE ] } 0 }
+        } <DIDATAFORMAT>
+    ] unless* ] change-at ;
+
+: define-format-constants ( -- )
+    define-joystick-format-constant
+    define-mouse-format-constant
+    define-keyboard-format-constant ;
+
+: define-constants
+    define-guid-constants
+    define-format-constants ;
+
+[ define-constants ] "windows.dinput.constants" add-init-hook
+define-constants
+
+: free-dinput-constants ( -- )
+    {
+        GUID_XAxis GUID_YAxis GUID_ZAxis
+        GUID_RxAxis GUID_RyAxis GUID_RzAxis
+        GUID_Slider GUID_Button GUID_Key GUID_POV GUID_Unknown
+        GUID_SysMouse GUID_SysKeyboard GUID_Joystick GUID_SysMouseEm
+        GUID_SysMouseEm2 GUID_SysKeyboardEm GUID_SysKeyboardEm2
+    } [ global [ [ free ] when* f ] change-at ] each
+    {
+        c_dfDIKeyboard c_dfDIMouse2 c_dfDIJoystick2
+    } [ global [ [ DIDATAFORMAT-rgodf free ] when* f ] change-at ] each ;
+
+PRIVATE>
+

extra/windows/dinput/dinput.factor

@@ -0,0 +1,400 @@
+USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax
+alien alien.c-types alien.syntax kernel system namespaces math ;
+IN: windows.dinput
+
+<< os windows?
+    [ "dinput" "dinput8.dll" "stdcall" add-library ]
+    [ "DirectInput only supported on Windows" throw ] if
+>>
+
+LIBRARY: dinput
+
+TYPEDEF: void* LPDIENUMDEVICESCALLBACKW
+: LPDIENUMDEVICESCALLBACKW ( quot -- alien )
+    [ "BOOL" { "LPCDIDEVICEINSTANCEW" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
+TYPEDEF: void* LPDIENUMDEVICESBYSEMANTICSCBW
+: LPDIENUMDEVICESBYSEMANTICSCBW ( quot -- alien )
+    [ "BOOL" { "LPCDIDEVICEINSTANCEW" "IDirectInputDevice8W*" "DWORD" "DWORD" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
+TYPEDEF: void* LPDICONFIGUREDEVICESCALLBACK
+: LPDICONFIGUREDEVICESCALLBACK ( quot -- alien )
+    [ "BOOL" { "IUnknown*" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
+TYPEDEF: void* LPDIENUMEFFECTSCALLBACKW
+: LPDIENUMEFFECTSCALLBACKW ( quot -- alien )
+    [ "BOOL" { "LPCDIEFFECTINFOW" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
+TYPEDEF: void* LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
+: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
+    [ "BOOL" { "LPDIRECTINPUTEFFECT" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
+TYPEDEF: void* LPDIENUMEFFECTSINFILECALLBACK
+    [ "BOOL" { "LPCDIFILEEFFECT" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
+TYPEDEF: void* LPDIENUMDEVICEOBJECTSCALLBACKW
+    [ "BOOL" { "LPCDIDEVICEOBJECTINSTANCE" "LPVOID" } "stdcall" ]
+    dip alien-callback ; inline
+
+TYPEDEF: DWORD D3DCOLOR
+
+C-STRUCT: DIDEVICEINSTANCEW
+    { "DWORD"      "dwSize" }
+    { "GUID"       "guidInstance" }
+    { "GUID"       "guidProduct" }
+    { "DWORD"      "dwDevType" }
+    { "WCHAR[260]" "tszInstanceName" }
+    { "WCHAR[260]" "tszProductName" }
+    { "GUID"       "guidFFDriver" }
+    { "WORD"       "wUsagePage" }
+    { "WORD"       "wUsage" } ;
+TYPEDEF: DIDEVICEINSTANCEW* LPDIDEVICEINSTANCEW
+TYPEDEF: DIDEVICEINSTANCEW* LPCDIDEVICEINSTANCEW
+C-UNION: DIACTION-union "LPCWSTR" "UINT" ;
+C-STRUCT: DIACTIONW
+    { "UINT_PTR"       "uAppData" }
+    { "DWORD"          "dwSemantic" }
+    { "DWORD"          "dwFlags" }
+    { "DIACTION-union" "lptszActionName-or-uResIdString" }
+    { "GUID"           "guidInstance" }
+    { "DWORD"          "dwObjID" }
+    { "DWORD"          "dwHow" } ;
+TYPEDEF: DIACTIONW* LPDIACTIONW
+TYPEDEF: DIACTIONW* LPCDIACTIONW
+C-STRUCT: DIACTIONFORMATW
+    { "DWORD"       "dwSize" }
+    { "DWORD"       "dwActionSize" }
+    { "DWORD"       "dwDataSize" }
+    { "DWORD"       "dwNumActions" }
+    { "LPDIACTIONW" "rgoAction" }
+    { "GUID"        "guidActionMap" }
+    { "DWORD"       "dwGenre" }
+    { "DWORD"       "dwBufferSize" }
+    { "LONG"        "lAxisMin" }
+    { "LONG"        "lAxisMax" }
+    { "HINSTANCE"   "hInstString" }
+    { "FILETIME"    "ftTimeStamp" }
+    { "DWORD"       "dwCRC" }
+    { "WCHAR[260]"  "tszActionMap" } ;
+TYPEDEF: DIACTIONFORMATW* LPDIACTIONFORMATW
+TYPEDEF: DIACTIONFORMATW* LPCDIACTIONFORMATW
+C-STRUCT: DICOLORSET
+    { "DWORD"    "dwSize" }
+    { "D3DCOLOR" "cTextFore" }
+    { "D3DCOLOR" "cTextHighlight" }
+    { "D3DCOLOR" "cCalloutLine" }
+    { "D3DCOLOR" "cCalloutHighlight" }
+    { "D3DCOLOR" "cBorder" }
+    { "D3DCOLOR" "cControlFill" }
+    { "D3DCOLOR" "cHighlightFill" }
+    { "D3DCOLOR" "cAreaFill" } ;
+TYPEDEF: DICOLORSET* LPDICOLORSET
+TYPEDEF: DICOLORSET* LPCDICOLORSET
+
+C-STRUCT: DICONFIGUREDEVICESPARAMSW
+    { "DWORD"             "dwSize" }
+    { "DWORD"             "dwcUsers" }
+    { "LPWSTR"            "lptszUserNames" }
+    { "DWORD"             "dwcFormats" }
+    { "LPDIACTIONFORMATW" "lprgFormats" }
+    { "HWND"              "hwnd" }
+    { "DICOLORSET"        "dics" }
+    { "IUnknown*"         "lpUnkDDSTarget" } ;
+TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
+TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
+
+C-STRUCT: DIDEVCAPS
+    { "DWORD" "wSize" }
+    { "DWORD" "wFlags" }
+    { "DWORD" "wDevType" }
+    { "DWORD" "wAxes" }
+    { "DWORD" "wButtons" }
+    { "DWORD" "wPOVs" }
+    { "DWORD" "wFFSamplePeriod" }
+    { "DWORD" "wFFMinTimeResolution" }
+    { "DWORD" "wFirmwareRevision" }
+    { "DWORD" "wHardwareRevision" }
+    { "DWORD" "wFFDriverVersion" } ;
+TYPEDEF: DIDEVCAPS* LPDIDEVCAPS
+TYPEDEF: DIDEVCAPS* LPCDIDEVCAPS
+C-STRUCT: DIDEVICEOBJECTINSTANCEW
+    { "DWORD"      "dwSize" }
+    { "GUID"       "guidInstance" }
+    { "GUID"       "guidProduct" }
+    { "DWORD"      "dwDevType" }
+    { "WCHAR[260]" "tszInstanceName" }
+    { "WCHAR[260]" "tszProductName" }
+    { "GUID"       "guidFFDriver" }
+    { "WORD"       "wUsagePage" }
+    { "WORD"       "wUsage" } ;
+TYPEDEF: DIDEVICEOBJECTINSTANCEW* LPDIDEVICEOBJECTINSTANCEW
+TYPEDEF: DIDEVICEOBJECTINSTANCEW* LPCDIDEVICEOBJECTINSTANCEW
+C-STRUCT: DIDEVICEOBJECTDATA
+    { "DWORD"    "dwOfs" }
+    { "DWORD"    "dwData" }
+    { "DWORD"    "dwTimeStamp" }
+    { "DWORD"    "dwSequence" }
+    { "UINT_PTR" "uAppData" } ;
+TYPEDEF: DIDEVICEOBJECTDATA* LPDIDEVICEOBJECTDATA
+TYPEDEF: DIDEVICEOBJECTDATA* LPCDIDEVICEOBJECTDATA
+C-STRUCT: DIOBJECTDATAFORMAT
+    { "GUID*" "pguid" }
+    { "DWORD" "dwOfs" }
+    { "DWORD" "dwType" }
+    { "DWORD" "dwFlags" } ;
+TYPEDEF: DIOBJECTDATAFORMAT* LPDIOBJECTDATAFORMAT
+TYPEDEF: DIOBJECTDATAFORMAT* LPCDIOBJECTDATAFORMAT
+C-STRUCT: DIDATAFORMAT
+    { "DWORD" "dwSize" }
+    { "DWORD" "dwObjSize" }
+    { "DWORD" "dwFlags" }
+    { "DWORD" "dwDataSize" }
+    { "DWORD" "dwNumObjs" }
+    { "LPDIOBJECTDATAFORMAT" "rgodf" } ;
+TYPEDEF: DIDATAFORMAT* LPDIDATAFORMAT
+TYPEDEF: DIDATAFORMAT* LPCDIDATAFORMAT
+C-STRUCT: DIPROPHEADER
+    { "DWORD" "dwSize" }
+    { "DWORD" "dwHeaderSize" }
+    { "DWORD" "dwObj" }
+    { "DWORD" "dwHow" } ;
+TYPEDEF: DIPROPHEADER* LPDIPROPHEADER
+TYPEDEF: DIPROPHEADER* LPCDIPROPHEADER
+C-STRUCT: DIENVELOPE
+    { "DWORD" "dwSize" }
+    { "DWORD" "dwAttackLevel" }
+    { "DWORD" "dwAttackTime" }
+    { "DWORD" "dwFadeLevel" }
+    { "DWORD" "dwFadeTime" } ;
+TYPEDEF: DIENVELOPE* LPDIENVELOPE
+TYPEDEF: DIENVELOPE* LPCDIENVELOPE
+C-STRUCT: DIEFFECT
+    { "DWORD" "dwSize" }
+    { "DWORD" "dwFlags" }
+    { "DWORD" "dwDuration" }
+    { "DWORD" "dwSamplePeriod" }
+    { "DWORD" "dwGain" }
+    { "DWORD" "dwTriggerButton" }
+    { "DWORD" "dwTriggerRepeatInterval" }
+    { "DWORD" "cAxes" }
+    { "LPDWORD" "rgdwAxes" }
+    { "LPLONG" "rglDirection" }
+    { "LPDIENVELOPE" "lpEnvelope" }
+    { "DWORD" "cbTypeSpecificParams" }
+    { "LPVOID" "lpvTypeSpecificParams" }
+    { "DWORD" "dwStartDelay" } ;
+TYPEDEF: DIEFFECT* LPDIEFFECT
+TYPEDEF: DIEFFECT* LPCDIEFFECT
+C-STRUCT: DIEFFECTINFOW
+    { "DWORD"      "dwSize" }
+    { "GUID"       "guid" }
+    { "DWORD"      "dwEffType" }
+    { "DWORD"      "dwStaticParams" }
+    { "DWORD"      "dwDynamicParams" }
+    { "WCHAR[260]" "tszName" } ;
+TYPEDEF: DIEFFECTINFOW* LPDIEFFECTINFOW
+TYPEDEF: DIEFFECTINFOW* LPCDIEFFECTINFOW
+C-STRUCT: DIEFFESCAPE
+    { "DWORD"  "dwSize" }
+    { "DWORD"  "dwCommand" }
+    { "LPVOID" "lpvInBuffer" }
+    { "DWORD"  "cbInBuffer" }
+    { "LPVOID" "lpvOutBuffer" }
+    { "DWORD"  "cbOutBuffer" } ;
+TYPEDEF: DIEFFESCAPE* LPDIEFFESCAPE
+TYPEDEF: DIEFFESCAPE* LPCDIEFFESCAPE
+C-STRUCT: DIFILEEFFECT
+    { "DWORD"       "dwSize" }
+    { "GUID"        "GuidEffect" }
+    { "LPCDIEFFECT" "lpDiEffect" }
+    { "CHAR[260]"   "szFriendlyName" } ;
+TYPEDEF: DIFILEEFFECT* LPDIFILEEFFECT
+TYPEDEF: DIFILEEFFECT* LPCDIFILEEFFECT
+C-STRUCT: DIDEVICEIMAGEINFOW
+    { "WCHAR[260]" "tszImagePath" }
+    { "DWORD"      "dwFlags" }
+    { "DWORD"      "dwViewID" }
+    { "RECT"       "rcOverlay" }
+    { "DWORD"      "dwObjID" }
+    { "DWORD"      "dwcValidPts" }
+    { "POINT[5]"   "rgptCalloutLine" }
+    { "RECT"       "rcCalloutRect" }
+    { "DWORD"      "dwTextAlign" } ;
+TYPEDEF: DIDEVICEIMAGEINFOW* LPDIDEVICEIMAGEINFOW
+TYPEDEF: DIDEVICEIMAGEINFOW* LPCDIDEVICEIMAGEINFOW
+C-STRUCT: DIDEVICEIMAGEINFOHEADERW
+    { "DWORD" "dwSize" }
+    { "DWORD" "dwSizeImageInfo" }
+    { "DWORD" "dwcViews" }
+    { "DWORD" "dwcButtons" }
+    { "DWORD" "dwcAxes" }
+    { "DWORD" "dwcPOVs" }
+    { "DWORD" "dwBufferSize" }
+    { "DWORD" "dwBufferUsed" }
+    { "DIDEVICEIMAGEINFOW*" "lprgImageInfoArray" } ;
+TYPEDEF: DIDEVICEIMAGEINFOHEADERW* LPDIDEVICEIMAGEINFOHEADERW
+TYPEDEF: DIDEVICEIMAGEINFOHEADERW* LPCDIDEVICEIMAGEINFOHEADERW
+
+C-STRUCT: DIMOUSESTATE2
+    { "LONG"    "lX" }
+    { "LONG"    "lY" }
+    { "LONG"    "lZ" }
+    { "BYTE[8]" "rgbButtons" } ;
+TYPEDEF: DIMOUSESTATE2* LPDIMOUSESTATE2
+TYPEDEF: DIMOUSESTATE2* LPCDIMOUSESTATE2
+
+C-STRUCT: DIJOYSTATE2
+    { "LONG"      "lX" }
+    { "LONG"      "lY" }
+    { "LONG"      "lZ" }
+    { "LONG"      "lRx" }
+    { "LONG"      "lRy" }
+    { "LONG"      "lRz" }
+    { "LONG[2]"   "rglSlider" }
+    { "DWORD[4]"  "rgdwPOV" }
+    { "BYTE[128]" "rgbButtons" }
+    { "LONG"      "lVX" }
+    { "LONG"      "lVY" }
+    { "LONG"      "lVZ" }
+    { "LONG"      "lVRx" }
+    { "LONG"      "lVRy" }
+    { "LONG"      "lVRz" }
+    { "LONG[2]"   "rglVSlider" }
+    { "LONG"      "lAX" }
+    { "LONG"      "lAY" }
+    { "LONG"      "lAZ" }
+    { "LONG"      "lARx" }
+    { "LONG"      "lARy" }
+    { "LONG"      "lARz" }
+    { "LONG[2]"   "rglASlider" }
+    { "LONG"      "lFX" }
+    { "LONG"      "lFY" }
+    { "LONG"      "lFZ" }
+    { "LONG"      "lFRx" }
+    { "LONG"      "lFRy" }
+    { "LONG"      "lFRz" }
+    { "LONG[2]"   "rglFSlider" } ;
+TYPEDEF: DIJOYSTATE2* LPDIJOYSTATE2
+TYPEDEF: DIJOYSTATE2* LPCDIJOYSTATE2
+
+COM-INTERFACE: IDirectInputEffect IUnknown {E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35}
+    HRESULT Initialize ( HINSTANCE hinst, DWORD dwVersion, REFGUID rguid )
+    HRESULT GetEffectGuid ( LPGUID pguid )
+    HRESULT GetParameters ( LPDIEFFECT peff, DWORD dwFlags )
+    HRESULT SetParameters ( LPCDIEFFECT peff, DWORD dwFlags )
+    HRESULT Start ( DWORD dwIterations, DWORD dwFlags )
+    HRESULT Stop ( )
+    HRESULT GetEffectStatus ( LPDWORD pdwFlags )
+    HRESULT Download ( )
+    HRESULT Unload ( )
+    HRESULT Escape ( LPDIEFFESCAPE pesc ) ;
+
+COM-INTERFACE: IDirectInputDevice8W IUnknown {54D41081-DC15-4833-A41B-748F73A38179}
+    HRESULT GetCapabilities ( LPDIDEVCAPS lpDIDeviceCaps )
+    HRESULT EnumObjects ( LPDIENUMDEVICEOBJECTSCALLBACKW lpCallback, LPVOID pvRef, DWORD dwFlags )
+    HRESULT GetProperty ( REFGUID rguidProp, LPDIPROPHEADER pdiph )
+    HRESULT SetProperty ( REFGUID rguidProp, LPCDIPROPHEADER pdiph )
+    HRESULT Acquire ( )
+    HRESULT Unacquire ( )
+    HRESULT GetDeviceState ( DWORD cbData, LPVOID lpvData )
+    HRESULT GetDeviceData ( DWORD cbObjectData, LPDIDEVICEOBJECTDATA rgdod, LPDWORD pdwInOut, DWORD dwFlags )
+    HRESULT SetDataFormat ( LPCDIDATAFORMAT lpdf )
+    HRESULT SetEventNotification ( HANDLE hEvent )
+    HRESULT SetCooperativeLevel ( HWND hwnd, DWORD dwFlags )
+    HRESULT GetObjectInfo ( LPDIDEVICEOBJECTINSTANCEW rdidoi, DWORD dwObj, DWORD dwHow )
+    HRESULT GetDeviceInfo ( LPDIDEVICEINSTANCEW pdidi )
+    HRESULT RunControlPanel ( HWND hwndOwner, DWORD dwFlags )
+    HRESULT Initialize ( HINSTANCE hinst, DWORD dwVersion, REFGUID rguid )
+    HRESULT CreateEffect ( REFGUID rguid, LPCDIEFFECT lpeff, IDirectInputEffect** ppdeff, LPUNKNOWN punkOuter )
+    HRESULT EnumEffects ( LPDIENUMEFFECTSCALLBACKW lpCallback, LPVOID pvRef, DWORD dwEffType )
+    HRESULT GetEffectInfo ( LPDIEFFECTINFOW pdei, REFGUID rguid )
+    HRESULT GetForceFeedbackState ( LPDWORD pdwOut )
+    HRESULT SendForceFeedbackCommand ( DWORD dwFlags )
+    HRESULT EnumCreatedEffectObjects ( LPDIENUMCREATEDEFFECTOBJECTSCALLBACK lpCallback, LPVOID pvRef, DWORD fl )
+    HRESULT Escape ( LPDIEFFESCAPE pesc )
+    HRESULT Poll ( )
+    HRESULT SendDeviceData ( DWORD cbObjectData, LPCDIDEVICEOBJECTDATA rgdod, LPDWORD pdwInOut, DWORD fl )
+    HRESULT EnumEffectsInFile ( LPCWSTR lpszFileName, LPDIENUMEFFECTSINFILECALLBACK lpCallback, LPVOID pvRef, DWORD dwFlags )
+    HRESULT WriteEffectToFile ( LPCWSTR lpszFileName, DWORD dwEntries, LPDIFILEEFFECT rgDiFileEffect, DWORD dwFlags )
+    HRESULT BuildActionMap ( LPDIACTIONFORMATW lpdiaf, LPCWSTR lpszUserName, DWORD dwFlags )
+    HRESULT SetActionMap ( LPDIACTIONFORMATW lpdiActionFormat, LPCWSTR lpwszUserName, DWORD dwFlags )
+    HRESULT GetImageInfo ( LPDIDEVICEIMAGEINFOHEADERW lpdiDeviceImageInfoHeader ) ;
+
+COM-INTERFACE: IDirectInput8W IUnknown {BF798031-483A-4DA2-AA99-5D64ED369700}
+    HRESULT CreateDevice ( REFGUID rguid, IDirectInputDevice8W** lplpDevice, LPUNKNOWN pUnkOuter )
+    HRESULT EnumDevices ( DWORD dwDevType, LPDIENUMDEVICESCALLBACKW lpCallback, LPVOID pvRef, DWORD dwFlags )
+    HRESULT GetDeviceStatus ( REFGUID rguidInstance )
+    HRESULT RunControlPanel ( HWND hwndOwner, DWORD dwFlags )
+    HRESULT Initialize ( HINSTANCE hinst, DWORD dwVersion )
+    HRESULT FindDevice ( REFGUID rguidClass, LPCWSTR pwszName, LPGUID pguidInstance )
+    HRESULT EnumDevicesBySemantics ( LPCWSTR pwszUserName, LPDIACTIONFORMATW lpdiActionFormat, LPDIENUMDEVICESBYSEMANTICSCBW lpCallback, LPVOID pvRef, DWORD dwFlags )
+    HRESULT ConfigureDevices ( LPDICONFIGUREDEVICESCALLBACK lpdiCallback, LPDICONFIGUREDEVICESPARAMSW lpdiCDParams, DWORD dwFlags, LPVOID pvRefData ) ;
+
+FUNCTION: HRESULT DirectInput8Create ( HINSTANCE hinst, DWORD dwVersion, REFIID riidtlf, LPVOID* ppvOut, LPUNKNOWN punkOuter ) ;
+
+: DIRECTINPUT_VERSION HEX: 0800 ; inline
+
+: DI8DEVCLASS_ALL             0 ; inline
+: DI8DEVCLASS_DEVICE          1 ; inline
+: DI8DEVCLASS_POINTER         2 ; inline
+: DI8DEVCLASS_KEYBOARD        3 ; inline
+: DI8DEVCLASS_GAMECTRL        4 ; inline
+
+: DIEDFL_ALLDEVICES       HEX: 00000000 ; inline
+: DIEDFL_ATTACHEDONLY     HEX: 00000001 ; inline
+: DIEDFL_FORCEFEEDBACK    HEX: 00000100 ; inline
+: DIEDFL_INCLUDEALIASES   HEX: 00010000 ; inline
+: DIEDFL_INCLUDEPHANTOMS  HEX: 00020000 ; inline
+: DIEDFL_INCLUDEHIDDEN    HEX: 00040000 ; inline
+
+: DIENUM_STOP             0 ; inline
+: DIENUM_CONTINUE         1 ; inline
+
+: DIDF_ABSAXIS            1 ;
+: DIDF_RELAXIS            2 ;
+
+: DIDFT_ALL           HEX: 00000000 ; inline
+
+: DIDFT_RELAXIS       HEX: 00000001 ; inline
+: DIDFT_ABSAXIS       HEX: 00000002 ; inline
+: DIDFT_AXIS          HEX: 00000003 ; inline
+
+: DIDFT_PSHBUTTON     HEX: 00000004 ; inline
+: DIDFT_TGLBUTTON     HEX: 00000008 ; inline
+: DIDFT_BUTTON        HEX: 0000000C ; inline
+
+: DIDFT_POV           HEX: 00000010 ; inline
+: DIDFT_COLLECTION    HEX: 00000040 ; inline
+: DIDFT_NODATA        HEX: 00000080 ; inline
+
+: DIDFT_ANYINSTANCE   HEX: 00FFFF00 ; inline
+: DIDFT_INSTANCEMASK  DIDFT_ANYINSTANCE ; inline
+: DIDFT_MAKEINSTANCE ( n -- instance ) 8 shift                   ; inline
+: DIDFT_GETTYPE      ( n -- type     ) HEX: FF bitand            ; inline
+: DIDFT_GETINSTANCE  ( n -- instance ) -8 shift HEX: FFFF bitand ; inline
+: DIDFT_FFACTUATOR        HEX: 01000000 ; inline
+: DIDFT_FFEFFECTTRIGGER   HEX: 02000000 ; inline
+: DIDFT_OUTPUT            HEX: 10000000 ; inline
+: DIDFT_VENDORDEFINED     HEX: 04000000 ; inline
+: DIDFT_ALIAS             HEX: 08000000 ; inline
+: DIDFT_OPTIONAL          HEX: 80000000 ; inline
+
+: DIDFT_ENUMCOLLECTION ( n -- instance ) 8 shift HEX: FFFF bitand ; inline
+: DIDFT_NOCOLLECTION      HEX: 00FFFF00 ; inline
+
+: DISCL_EXCLUSIVE     HEX: 00000001 ; inline
+: DISCL_NONEXCLUSIVE  HEX: 00000002 ; inline
+: DISCL_FOREGROUND    HEX: 00000004 ; inline
+: DISCL_BACKGROUND    HEX: 00000008 ; inline
+: DISCL_NOWINKEY      HEX: 00000010 ; inline
+
+SYMBOL: +dinput+
+
+: create-dinput ( -- )
+    f GetModuleHandle DIRECTINPUT_VERSION IDirectInput8W-iid
+    f <void*> [ f DirectInput8Create ole32-error ] keep *void*
+    +dinput+ set ;
+
+: delete-dinput ( -- )
+    +dinput+ [ com-release f ] change ;
+

extra/windows/dinput/summary.txt

@@ -0,0 +1 @@
+DirectInput bindings

extra/windows/dinput/tags.txt

@@ -0,0 +1,2 @@
+windows
+bindings