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

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

db4
Slava Pestov 2009-05-08 22:10:42 -05:00
parent 1d747ea911 77c8f38372
commit f40d5b0c03
2 changed files with 72 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
basis/cocoa/plists/plists.factor
View File

@ -4,7 +4,7 @@
USING: strings arrays hashtables assocs sequences fry macros USING: strings arrays hashtables assocs sequences fry macros
cocoa.messages cocoa.classes cocoa.application cocoa kernel cocoa.messages cocoa.classes cocoa.application cocoa kernel
namespaces io.backend math cocoa.enumeration byte-arrays namespaces io.backend math cocoa.enumeration byte-arrays
combinators alien.c-types words core-foundation combinators alien.c-types words core-foundation quotations
core-foundation.data core-foundation.utilities ; core-foundation.data core-foundation.utilities ;
IN: cocoa.plists IN: cocoa.plists
@ -41,10 +41,16 @@ DEFER: plist>
*void* [ -> release "read-plist failed" throw ] when* ; *void* [ -> release "read-plist failed" throw ] when* ;
MACRO: objc-class-case ( alist -- quot ) MACRO: objc-class-case ( alist -- quot )
[ [ '[ dup _ execute -> isKindOfClass: c-bool> ] ] dip ] assoc-map '[ _ cond ] ; [
dup callable?
[ first2 [ '[ dup _ execute -> isKindOfClass: c-bool> ] ] dip 2array ]
unless
] map '[ _ cond ] ;
PRIVATE> PRIVATE>
ERROR: invalid-plist-object object ;
: plist> ( plist -- value ) : plist> ( plist -- value )
{ {
{ NSString [ (plist-NSString>) ] } { NSString [ (plist-NSString>) ] }
@ -53,6 +59,7 @@ PRIVATE>
{ NSArray [ (plist-NSArray>) ] } { NSArray [ (plist-NSArray>) ] }
{ NSDictionary [ (plist-NSDictionary>) ] } { NSDictionary [ (plist-NSDictionary>) ] }
{ NSObject [ ] } { NSObject [ ] }
[ invalid-plist-object ]
} objc-class-case ; } objc-class-case ;
: read-plist ( path -- assoc ) : read-plist ( path -- assoc )

114
extra/game-input/iokit/iokit.factor
View File

@ -1,13 +1,15 @@
USING: cocoa cocoa.plists core-foundation iokit iokit.hid USING: cocoa cocoa.plists core-foundation iokit iokit.hid
kernel cocoa.enumeration destructors math.parser cocoa.application kernel cocoa.enumeration destructors math.parser cocoa.application
sequences locals combinators.short-circuit threads sequences locals combinators.short-circuit threads
namespaces assocs vectors arrays combinators namespaces assocs vectors arrays combinators hints alien
core-foundation.run-loop accessors sequences.private core-foundation.run-loop accessors sequences.private
alien.c-types math parser game-input vectors ; alien.c-types math parser game-input vectors ;
IN: game-input.iokit IN: game-input.iokit
SINGLETON: iokit-game-input-backend SINGLETON: iokit-game-input-backend
SYMBOLS: +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ ;
iokit-game-input-backend game-input-backend set-global iokit-game-input-backend game-input-backend set-global
: hid-manager-matching ( matching-seq -- alien ) : hid-manager-matching ( matching-seq -- alien )
@ -23,7 +25,6 @@ iokit-game-input-backend game-input-backend set-global
CONSTANT: game-devices-matching-seq CONSTANT: game-devices-matching-seq
{ {
H{ { "DeviceUsage" 1 } { "DeviceUsagePage" 1 } } ! pointers
H{ { "DeviceUsage" 2 } { "DeviceUsagePage" 1 } } ! mouses H{ { "DeviceUsage" 2 } { "DeviceUsagePage" 1 } } ! mouses
H{ { "DeviceUsage" 4 } { "DeviceUsagePage" 1 } } ! joysticks H{ { "DeviceUsage" 4 } { "DeviceUsagePage" 1 } } ! joysticks
H{ { "DeviceUsage" 5 } { "DeviceUsagePage" 1 } } ! gamepads H{ { "DeviceUsage" 5 } { "DeviceUsagePage" 1 } } ! gamepads
@ -88,19 +89,17 @@ CONSTANT: hat-switch-matching-hash
game-devices-matching-seq hid-manager-matching ; game-devices-matching-seq hid-manager-matching ;
: device-property ( device key -- value ) : device-property ( device key -- value )
<NSString> IOHIDDeviceGetProperty plist> ; <NSString> IOHIDDeviceGetProperty [ plist> ] [ f ] if* ;
: element-property ( element key -- value ) : element-property ( element key -- value )
<NSString> IOHIDElementGetProperty plist> ; <NSString> IOHIDElementGetProperty [ plist> ] [ f ] if* ;
: set-element-property ( element key value -- ) : set-element-property ( element key value -- )
[ <NSString> ] [ >plist ] bi* IOHIDElementSetProperty drop ; [ <NSString> ] [ >plist ] bi* IOHIDElementSetProperty drop ;
: transfer-element-property ( element from-key to-key -- ) : transfer-element-property ( element from-key to-key -- )
[ dupd element-property ] dip swap set-element-property ; [ dupd element-property ] dip swap
[ set-element-property ] [ 2drop ] if* ;
: mouse-device? ( device -- ? ) : mouse-device? ( device -- ? )
{ 1 2 IOHIDDeviceConformsTo ;
[ 1 1 IOHIDDeviceConformsTo ]
[ 1 2 IOHIDDeviceConformsTo ]
} 1|| ;
: controller-device? ( device -- ? ) : controller-device? ( device -- ? )
{ {
@ -113,28 +112,31 @@ CONSTANT: hat-switch-matching-hash
[ IOHIDElementGetUsagePage ] [ IOHIDElementGetUsage ] bi [ IOHIDElementGetUsagePage ] [ IOHIDElementGetUsage ] bi
2array ; 2array ;
: button? ( {usage-page,usage} -- ? ) : button? ( element -- ? )
first 9 = ; inline IOHIDElementGetUsagePage 9 = ; inline
: keyboard-key? ( {usage-page,usage} -- ? ) : keyboard-key? ( element -- ? )
first 7 = ; inline IOHIDElementGetUsagePage 7 = ; inline
: axis? ( element -- ? )
IOHIDElementGetUsagePage 1 = ; inline
: x-axis? ( {usage-page,usage} -- ? ) : x-axis? ( {usage-page,usage} -- ? )
{ 1 HEX: 30 } = ; inline IOHIDElementGetUsage HEX: 30 = ; inline
: y-axis? ( {usage-page,usage} -- ? ) : y-axis? ( {usage-page,usage} -- ? )
{ 1 HEX: 31 } = ; inline IOHIDElementGetUsage HEX: 31 = ; inline
: z-axis? ( {usage-page,usage} -- ? ) : z-axis? ( {usage-page,usage} -- ? )
{ 1 HEX: 32 } = ; inline IOHIDElementGetUsage HEX: 32 = ; inline
: rx-axis? ( {usage-page,usage} -- ? ) : rx-axis? ( {usage-page,usage} -- ? )
{ 1 HEX: 33 } = ; inline IOHIDElementGetUsage HEX: 33 = ; inline
: ry-axis? ( {usage-page,usage} -- ? ) : ry-axis? ( {usage-page,usage} -- ? )
{ 1 HEX: 34 } = ; inline IOHIDElementGetUsage HEX: 34 = ; inline
: rz-axis? ( {usage-page,usage} -- ? ) : rz-axis? ( {usage-page,usage} -- ? )
{ 1 HEX: 35 } = ; inline IOHIDElementGetUsage HEX: 35 = ; inline
: slider? ( {usage-page,usage} -- ? ) : slider? ( {usage-page,usage} -- ? )
{ 1 HEX: 36 } = ; inline IOHIDElementGetUsage HEX: 36 = ; inline
: wheel? ( {usage-page,usage} -- ? ) : wheel? ( {usage-page,usage} -- ? )
{ 1 HEX: 38 } = ; inline IOHIDElementGetUsage HEX: 38 = ; inline
: hat-switch? ( {usage-page,usage} -- ? ) : hat-switch? ( {usage-page,usage} -- ? )
{ 1 HEX: 39 } = ; inline IOHIDElementGetUsage HEX: 39 = ; inline
CONSTANT: pov-values CONSTANT: pov-values
{ {
@ -152,45 +154,55 @@ CONSTANT: pov-values
: pov-value ( value -- pov-direction ) : pov-value ( value -- pov-direction )
IOHIDValueGetIntegerValue pov-values ?nth [ pov-neutral ] unless* ; IOHIDValueGetIntegerValue pov-values ?nth [ pov-neutral ] unless* ;
: record-button ( hid-value usage state -- ) : record-button ( state hid-value element -- )
[ button-value ] [ second 1- ] [ buttons>> ] tri* set-nth ; [ buttons>> ] [ button-value ] [ IOHIDElementGetUsage 1- ] tri* rot set-nth ;
: record-controller ( controller-state value -- ) : record-controller ( controller-state value -- )
dup IOHIDValueGetElement element-usage { dup IOHIDValueGetElement {
{ [ dup button? ] [ rot record-button ] } { [ dup button? ] [ record-button ] }
{ [ dup x-axis? ] [ drop axis-value >>x drop ] } { [ dup axis? ] [ {
{ [ dup y-axis? ] [ drop axis-value >>y drop ] } { [ dup x-axis? ] [ drop axis-value >>x drop ] }
{ [ dup z-axis? ] [ drop axis-value >>z drop ] } { [ dup y-axis? ] [ drop axis-value >>y drop ] }
{ [ dup rx-axis? ] [ drop axis-value >>rx drop ] } { [ dup z-axis? ] [ drop axis-value >>z drop ] }
{ [ dup ry-axis? ] [ drop axis-value >>ry drop ] } { [ dup rx-axis? ] [ drop axis-value >>rx drop ] }
{ [ dup rz-axis? ] [ drop axis-value >>rz drop ] } { [ dup ry-axis? ] [ drop axis-value >>ry drop ] }
{ [ dup slider? ] [ drop axis-value >>slider drop ] } { [ dup rz-axis? ] [ drop axis-value >>rz drop ] }
{ [ dup hat-switch? ] [ drop pov-value >>pov drop ] } { [ dup slider? ] [ drop axis-value >>slider drop ] }
{ [ dup hat-switch? ] [ drop pov-value >>pov drop ] }
[ 3drop ]
} cond ] }
[ 3drop ] [ 3drop ]
} cond ; } cond ;
SYMBOLS: +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ ; HINTS: record-controller { controller-state alien } ;
: ?set-nth ( value nth seq -- ) : ?set-nth ( value nth seq -- )
2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ; 2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ;
: record-keyboard ( value -- ) : record-keyboard ( keyboard-state value -- )
dup IOHIDValueGetElement element-usage keyboard-key? [ dup IOHIDValueGetElement dup keyboard-key? [
[ IOHIDValueGetIntegerValue c-bool> ] [ IOHIDValueGetIntegerValue c-bool> ]
[ IOHIDValueGetElement IOHIDElementGetUsage ] bi [ IOHIDElementGetUsage ] bi*
+keyboard-state+ get ?set-nth rot ?set-nth
] [ drop ] if ; ] [ 3drop ] if ;
: record-mouse ( value -- ) HINTS: record-keyboard { array alien } ;
dup IOHIDValueGetElement element-usage {
{ [ dup button? ] [ +mouse-state+ get record-button ] } : record-mouse ( mouse-state value -- )
{ [ dup x-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-dx drop ] } dup IOHIDValueGetElement {
{ [ dup y-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-dy drop ] } { [ dup button? ] [ record-button ] }
{ [ dup wheel? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-scroll-dx drop ] } { [ dup axis? ] [ {
{ [ dup z-axis? ] [ drop mouse-axis-value +mouse-state+ get [ + ] change-scroll-dy drop ] } { [ dup x-axis? ] [ drop mouse-axis-value [ + ] curry change-dx drop ] }
[ 2drop ] { [ dup y-axis? ] [ drop mouse-axis-value [ + ] curry change-dy drop ] }
{ [ dup wheel? ] [ drop mouse-axis-value [ + ] curry change-scroll-dx drop ] }
{ [ dup z-axis? ] [ drop mouse-axis-value [ + ] curry change-scroll-dy drop ] }
[ 3drop ]
} cond ] }
[ 3drop ]
} cond ; } cond ;
HINTS: record-mouse { mouse-state alien } ;
M: iokit-game-input-backend read-mouse M: iokit-game-input-backend read-mouse
+mouse-state+ get ; +mouse-state+ get ;
@ -263,8 +275,8 @@ M: iokit-game-input-backend reset-mouse
{ [ sender controller-device? ] [ { [ sender controller-device? ] [
sender +controller-states+ get at value record-controller sender +controller-states+ get at value record-controller
] } ] }
{ [ sender mouse-device? ] [ value record-mouse ] } { [ sender mouse-device? ] [ +mouse-state+ get value record-mouse ] }
[ value record-keyboard ] [ +keyboard-state+ get value record-keyboard ]
} cond } cond
] IOHIDValueCallback ; ] IOHIDValueCallback ;
@ -289,7 +301,7 @@ M: iokit-game-input-backend (open-game-input)
} cleave ; } cleave ;
M: iokit-game-input-backend (reset-game-input) M: iokit-game-input-backend (reset-game-input)
{ +hid-manager+ +keyboard-state+ +controller-states+ } { +hid-manager+ +keyboard-state+ +mouse-state+ +controller-states+ }
[ f swap set-global ] each ; [ f swap set-global ] each ;
M: iokit-game-input-backend (close-game-input) M: iokit-game-input-backend (close-game-input)