diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 804895f6c4..4b5dd8542d 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -221,6 +221,7 @@ M: word declarations. POSTPONE: parsing POSTPONE: delimiter POSTPONE: inline + POSTPONE: recursive POSTPONE: foldable POSTPONE: flushable } [ declaration. ] with each ; diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor index 18bc7f14cf..036ff2f759 100644 --- a/core/sorting/sorting-docs.factor +++ b/core/sorting/sorting-docs.factor @@ -20,7 +20,7 @@ ABOUT: "sequences-sorting" HELP: sort { $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj1 obj2 -- <=> )" } } { "sortedseq" "a new sorted sequence" } } -{ $description "Sorts the elements into a new sequence of the same class as " { $snippet "seq" } "." } ; +{ $description "Sorts the elements into a new array." } ; HELP: sort-keys { $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } } diff --git a/extra/cocoa/cocoa.factor b/extra/cocoa/cocoa.factor index 907d75fd84..744d577c0d 100755 --- a/extra/cocoa/cocoa.factor +++ b/extra/cocoa/cocoa.factor @@ -61,6 +61,7 @@ SYMBOL: super-sent-messages "NSOpenGLView" "NSOpenPanel" "NSPasteboard" + "NSPropertyListSerialization" "NSResponder" "NSSavePanel" "NSScreen" diff --git a/extra/cocoa/plists/plists.factor b/extra/cocoa/plists/plists.factor index 139e0840e1..bb73b8fac3 100644 --- a/extra/cocoa/plists/plists.factor +++ b/extra/cocoa/plists/plists.factor @@ -3,7 +3,7 @@ USING: strings arrays hashtables assocs sequences cocoa.messages cocoa.classes cocoa.application cocoa kernel namespaces io.backend math cocoa.enumeration byte-arrays -combinators alien.c-types ; +combinators alien.c-types core-foundation ; IN: cocoa.plists GENERIC: >plist ( value -- plist ) @@ -24,8 +24,8 @@ M: sequence >plist [ >plist ] map ; : write-plist ( assoc path -- ) - >r >plist - r> normalize-path 0 -> writeToFile:atomically: + [ >plist ] [ normalize-path ] bi* 0 + -> writeToFile:atomically: [ "write-plist failed" throw ] unless ; DEFER: plist> @@ -57,3 +57,13 @@ DEFER: plist> { [ dup NSDictionary -> isKindOfClass: c-bool> ] [ (plist-NSDictionary>) ] } [ ] } cond ; + +: (read-plist) ( NSData -- id ) + NSPropertyListSerialization swap kCFPropertyListImmutable f f + [ -> propertyListFromData:mutabilityOption:format:errorDescription: ] keep + *void* [ -> release "read-plist failed" throw ] when* ; + +: read-plist ( path -- assoc ) + normalize-path + NSData swap -> dataWithContentsOfFile: + [ (read-plist) plist> ] [ "read-plist failed" throw ] if* ; diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index d61674280a..838bb08b92 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -2,6 +2,15 @@ USING: combinators.lib kernel math random sequences tools.test continuations arrays vectors ; IN: combinators.lib.tests +[ 6 -1 ] [ 5 0 1 [ + ] [ - ] bi, bi* ] unit-test +[ 6 -1 1 ] [ 5 0 1 1 [ + ] [ - ] [ * ] tri, tri* ] unit-test + +[ 5 4 ] [ 5 0 1 [ + ] [ - ] bi*, bi ] unit-test +[ 5 4 5 ] [ 5 0 1 1 [ + ] [ - ] [ * ] tri*, tri ] unit-test + +[ 5 6 ] [ 5 0 1 [ + ] bi@, bi ] unit-test +[ 5 6 7 ] [ 5 0 1 2 [ + ] tri@, tri ] unit-test + [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test [ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 4af12a9ad6..a7d5e4cf58 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -8,6 +8,25 @@ generalizations macros continuations locals ; IN: combinators.lib +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Currying cleave combinators +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: bi, ( obj quot quot -- quot' quot' ) + [ [ curry ] curry ] bi@ bi ; inline +: tri, ( obj quot quot quot -- quot' quot' quot' ) + [ [ curry ] curry ] tri@ tri ; inline + +: bi*, ( obj obj quot quot -- quot' quot' ) + [ [ curry ] curry ] bi@ bi* ; inline +: tri*, ( obj obj obj quot quot quot -- quot' quot' quot' ) + [ [ curry ] curry ] tri@ tri* ; inline + +: bi@, ( obj obj quot -- quot' quot' ) + [ curry ] curry bi@ ; inline +: tri@, ( obj obj obj quot -- quot' quot' quot' ) + [ curry ] curry tri@ ; inline + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Generalized versions of core combinators ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/core-foundation/core-foundation.factor b/extra/core-foundation/core-foundation.factor index c511a24320..5c3ccf6c80 100644 --- a/extra/core-foundation/core-foundation.factor +++ b/extra/core-foundation/core-foundation.factor @@ -43,6 +43,11 @@ TYPEDEF: int CFNumberType : kCFNumberCGFloatType 16 ; inline : kCFNumberMaxType 16 ; inline +TYPEDEF: int CFPropertyListMutabilityOptions +: kCFPropertyListImmutable 0 ; inline +: kCFPropertyListMutableContainers 1 ; inline +: kCFPropertyListMutableContainersAndLeaves 2 ; inline + FUNCTION: CFArrayRef CFArrayCreateMutable ( CFAllocatorRef allocator, CFIndex capacity, void* callbacks ) ; FUNCTION: void* CFArrayGetValueAtIndex ( CFArrayRef array, CFIndex idx ) ; diff --git a/extra/game-input/authors.txt b/extra/game-input/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/game-input/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/game-input/backend/authors.txt b/extra/game-input/backend/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/game-input/backend/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/game-input/backend/backend.factor b/extra/game-input/backend/backend.factor new file mode 100644 index 0000000000..451bbf1c34 --- /dev/null +++ b/extra/game-input/backend/backend.factor @@ -0,0 +1,8 @@ +USING: kernel system combinators parser ; +IN: game-input.backend + +<< { + { [ os macosx? ] [ "game-input.backend.iokit" use+ ] } + { [ os windows? ] [ "game-input.backend.dinput" use+ ] } + { [ t ] [ ] } +} cond >> diff --git a/extra/game-input/backend/dinput/authors.txt b/extra/game-input/backend/dinput/authors.txt new file mode 100755 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/game-input/backend/dinput/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/game-input/backend/dinput/dinput.factor b/extra/game-input/backend/dinput/dinput.factor new file mode 100755 index 0000000000..69b2d41962 --- /dev/null +++ b/extra/game-input/backend/dinput/dinput.factor @@ -0,0 +1,282 @@ +USING: windows.dinput windows.dinput.constants game-input +symbols alien.c-types windows.ole32 namespaces assocs kernel +arrays vectors windows.kernel32 windows.com windows.dinput +shuffle windows.user32 windows.messages sequences combinators +math.geometry.rect ui.windows accessors math windows alien +alien.strings io.encodings.utf16 continuations byte-arrays +locals game-input.backend.dinput.keys-array ; +IN: game-input.backend.dinput + +SINGLETON: dinput-game-input-backend + +SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+ + +controller-devices+ +controller-guids+ + +device-change-window+ +device-change-handle+ ; + +: create-dinput ( -- ) + f GetModuleHandle DIRECTINPUT_VERSION IDirectInput8W-iid + f [ f DirectInput8Create ole32-error ] keep *void* + +dinput+ set-global ; + +: delete-dinput ( -- ) + +dinput+ global [ com-release f ] change-at ; + +: device-for-guid ( guid -- device ) + +dinput+ get swap f + [ f IDirectInput8W::CreateDevice ole32-error ] keep *void* ; + +: set-coop-level ( device -- ) + +device-change-window+ get DISCL_BACKGROUND DISCL_NONEXCLUSIVE bitor + IDirectInputDevice8W::SetCooperativeLevel ole32-error ; + +: set-data-format ( device format-symbol -- ) + get IDirectInputDevice8W::SetDataFormat ole32-error ; + +: configure-keyboard ( keyboard -- ) + [ c_dfDIKeyboard_HID set-data-format ] [ set-coop-level ] bi ; +: configure-controller ( controller -- ) + [ c_dfDIJoystick2 set-data-format ] [ set-coop-level ] bi ; + +: find-keyboard ( -- ) + GUID_SysKeyboard device-for-guid + [ configure-keyboard ] + [ +keyboard-device+ set-global ] bi + 256 keyboard-state boa + +keyboard-state+ set-global ; + +: device-info ( device -- DIDEVICEIMAGEINFOW ) + "DIDEVICEINSTANCEW" + "DIDEVICEINSTANCEW" heap-size over set-DIDEVICEINSTANCEW-dwSize + [ IDirectInputDevice8W::GetDeviceInfo ole32-error ] keep ; +: device-caps ( device -- DIDEVCAPS ) + "DIDEVCAPS" + "DIDEVCAPS" heap-size over set-DIDEVCAPS-dwSize + [ IDirectInputDevice8W::GetCapabilities ole32-error ] keep ; + +: ( memory -- byte-array ) + "GUID" heap-size memory>byte-array ; + +: device-guid ( device -- guid ) + device-info DIDEVICEINSTANCEW-guidInstance ; + +: device-attached? ( device -- ? ) + +dinput+ get swap device-guid + IDirectInput8W::GetDeviceStatus S_OK = ; + +: find-device-axes-callback ( -- alien ) + [ ! ( lpddoi pvRef -- BOOL ) + +controller-devices+ get at + swap DIDEVICEOBJECTINSTANCEW-guidType { + { [ dup GUID_XAxis = ] [ drop 0.0 >>x ] } + { [ dup GUID_YAxis = ] [ drop 0.0 >>y ] } + { [ dup GUID_ZAxis = ] [ drop 0.0 >>z ] } + { [ dup GUID_RxAxis = ] [ drop 0.0 >>rx ] } + { [ dup GUID_RyAxis = ] [ drop 0.0 >>ry ] } + { [ dup GUID_RzAxis = ] [ drop 0.0 >>rz ] } + { [ dup GUID_Slider = ] [ drop 0.0 >>slider ] } + [ drop ] + } cond drop + DIENUM_CONTINUE + ] LPDIENUMDEVICEOBJECTSCALLBACKW ; + +: find-device-axes ( device controller-state -- controller-state ) + swap [ +controller-devices+ get set-at ] 2keep + find-device-axes-callback over DIDFT_AXIS + IDirectInputDevice8W::EnumObjects ole32-error ; + +: controller-state-template ( device -- controller-state ) + controller-state new + over device-caps + [ DIDEVCAPS-dwButtons f >>buttons ] + [ DIDEVCAPS-dwPOVs zero? f pov-neutral ? >>pov ] bi + find-device-axes ; + +: device-known? ( guid -- ? ) + +controller-guids+ get key? ; inline + +: (add-controller) ( guid -- ) + device-for-guid { + [ configure-controller ] + [ controller-state-template ] + [ dup device-guid +controller-guids+ get set-at ] + [ +controller-devices+ get set-at ] + } cleave ; + +: add-controller ( guid -- ) + dup device-known? [ drop ] [ (add-controller) ] if ; + +: remove-controller ( device -- ) + [ +controller-devices+ get delete-at ] + [ device-guid +controller-guids+ get delete-at ] + [ com-release ] tri ; + +: find-controller-callback ( -- alien ) + [ ! ( lpddi pvRef -- BOOL ) + drop DIDEVICEINSTANCEW-guidInstance add-controller + DIENUM_CONTINUE + ] LPDIENUMDEVICESCALLBACKW ; + +: find-controllers ( -- ) + +dinput+ get DI8DEVCLASS_GAMECTRL find-controller-callback + f DIEDFL_ATTACHEDONLY IDirectInput8W::EnumDevices ole32-error ; + +: set-up-controllers ( -- ) + 4 +controller-devices+ set-global + 4 +controller-guids+ set-global + find-controllers ; + +: find-and-remove-detached-devices ( -- ) + +controller-devices+ get keys + [ device-attached? not ] filter + [ remove-controller ] each ; + +: device-interface? ( dbt-broadcast-hdr -- ? ) + DEV_BROADCAST_HDR-dbch_devicetype DBT_DEVTYP_DEVICEINTERFACE = ; + +: device-arrived ( dbt-broadcast-hdr -- ) + device-interface? [ find-controllers ] when ; + +: device-removed ( dbt-broadcast-hdr -- ) + device-interface? [ find-and-remove-detached-devices ] when ; + +: handle-wm-devicechange ( hWnd uMsg wParam lParam -- ) + [ 2drop ] 2dip swap { + { [ dup DBT_DEVICEARRIVAL = ] [ drop device-arrived ] } + { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop device-removed ] } + [ 2drop ] + } cond ; + +TUPLE: window-rect < rect window-loc ; +: ( -- window-rect ) + window-rect new + { 0 0 } >>window-loc + { 0 0 } >>loc + { 0 0 } >>dim ; + +: (device-notification-filter) ( -- DEV_BROADCAST_DEVICEW ) + "DEV_BROADCAST_DEVICEW" + "DEV_BROADCAST_DEVICEW" heap-size over set-DEV_BROADCAST_DEVICEW-dbcc_size + DBT_DEVTYP_DEVICEINTERFACE over set-DEV_BROADCAST_DEVICEW-dbcc_devicetype ; + +: create-device-change-window ( -- ) + create-window + [ + (device-notification-filter) + DEVICE_NOTIFY_WINDOW_HANDLE DEVICE_NOTIFY_ALL_INTERFACE_CLASSES bitor + RegisterDeviceNotification + +device-change-handle+ set-global + ] + [ +device-change-window+ set-global ] bi ; + +: close-device-change-window ( -- ) + +device-change-handle+ global + [ UnregisterDeviceNotification drop f ] change-at + +device-change-window+ global + [ DestroyWindow win32-error=0/f f ] change-at ; + +: add-wm-devicechange ( -- ) + [ 4dup handle-wm-devicechange DefWindowProc ] + WM_DEVICECHANGE add-wm-handler ; + +: remove-wm-devicechange ( -- ) + WM_DEVICECHANGE wm-handlers get-global delete-at ; + +: release-controllers ( -- ) + +controller-devices+ global [ + [ drop com-release ] assoc-each f + ] change-at + f +controller-guids+ set-global ; + +: release-keyboard ( -- ) + +keyboard-device+ global + [ com-release f ] change-at + f +keyboard-state+ set-global ; + +M: dinput-game-input-backend (open-game-input) + create-dinput + create-device-change-window + find-keyboard + set-up-controllers + add-wm-devicechange ; + +M: dinput-game-input-backend (close-game-input) + remove-wm-devicechange + release-controllers + release-keyboard + close-device-change-window + delete-dinput ; + +M: dinput-game-input-backend get-controllers + +controller-devices+ get + [ drop controller boa ] { } assoc>map ; + +M: dinput-game-input-backend product-string + handle>> device-info DIDEVICEINSTANCEW-tszProductName + utf16n alien>string ; + +M: dinput-game-input-backend product-id + handle>> device-info DIDEVICEINSTANCEW-guidProduct ; +M: dinput-game-input-backend instance-id + handle>> device-guid ; + +:: with-acquisition ( device acquired-quot succeeded-quot failed-quot -- result/f ) + device IDirectInputDevice8W::Acquire succeeded? [ + device acquired-quot call + succeeded-quot call + ] failed-quot if ; inline + +: pov-values + { + pov-up pov-up-right pov-right pov-down-right + pov-down pov-down-left pov-left pov-up-left + } ; inline + +: >axis ( long -- float ) + 32767 - 32767.0 /f ; +: >slider ( long -- float ) + 65535.0 /f ; +: >pov ( long -- symbol ) + dup HEX: FFFF bitand HEX: FFFF = + [ drop pov-neutral ] + [ 2750 + 4500 /i pov-values nth ] if ; +: >buttons ( alien length -- array ) + memory>byte-array ; + +: (fill-if) ( controller-state DIJOYSTATE2 ? quot -- ) + [ drop ] compose [ 2drop ] if ; inline + +: fill-controller-state ( controller-state DIJOYSTATE2 -- controller-state ) + { + [ over x>> [ DIJOYSTATE2-lX >axis >>x ] (fill-if) ] + [ over y>> [ DIJOYSTATE2-lY >axis >>y ] (fill-if) ] + [ over z>> [ DIJOYSTATE2-lZ >axis >>z ] (fill-if) ] + [ over rx>> [ DIJOYSTATE2-lRx >axis >>rx ] (fill-if) ] + [ over ry>> [ DIJOYSTATE2-lRy >axis >>ry ] (fill-if) ] + [ over rz>> [ DIJOYSTATE2-lRz >axis >>rz ] (fill-if) ] + [ over slider>> [ DIJOYSTATE2-rglSlider *long >slider >>slider ] (fill-if) ] + [ over pov>> [ DIJOYSTATE2-rgdwPOV *uint >pov >>pov ] (fill-if) ] + [ DIJOYSTATE2-rgbButtons over buttons>> length >buttons >>buttons ] + } 2cleave ; + +: get-device-state ( device byte-array -- ) + [ dup IDirectInputDevice8W::Poll ole32-error ] dip + [ length ] keep + IDirectInputDevice8W::GetDeviceState ole32-error ; + +: (read-controller) ( handle template -- state ) + swap [ "DIJOYSTATE2" heap-size [ get-device-state ] keep ] + [ fill-controller-state ] [ drop f ] with-acquisition ; + +M: dinput-game-input-backend read-controller + handle>> dup +controller-devices+ get at + [ (read-controller) ] [ drop f ] if* ; + +M: dinput-game-input-backend calibrate-controller + handle>> f 0 IDirectInputDevice8W::RunControlPanel ole32-error ; + +M: dinput-game-input-backend read-keyboard + +keyboard-device+ get + [ +keyboard-state+ get [ keys>> underlying>> get-device-state ] keep ] + [ ] [ f ] with-acquisition ; + +dinput-game-input-backend game-input-backend set-global diff --git a/extra/game-input/backend/dinput/keys-array/keys-array.factor b/extra/game-input/backend/dinput/keys-array/keys-array.factor new file mode 100755 index 0000000000..b2dbe9ad93 --- /dev/null +++ b/extra/game-input/backend/dinput/keys-array/keys-array.factor @@ -0,0 +1,15 @@ +USING: sequences sequences.private math alien.c-types +accessors ; +IN: game-input.backend.dinput.keys-array + +TUPLE: keys-array underlying ; +C: keys-array + +: >key ( byte -- ? ) + HEX: 80 bitand c-bool> ; + +M: keys-array length underlying>> length ; +M: keys-array nth-unsafe underlying>> nth-unsafe >key ; + +INSTANCE: keys-array sequence + diff --git a/extra/game-input/backend/dinput/summary.txt b/extra/game-input/backend/dinput/summary.txt new file mode 100755 index 0000000000..f758a5f83a --- /dev/null +++ b/extra/game-input/backend/dinput/summary.txt @@ -0,0 +1 @@ +DirectInput backend for game-input diff --git a/extra/game-input/backend/dinput/tags.txt b/extra/game-input/backend/dinput/tags.txt new file mode 100755 index 0000000000..70912457cb --- /dev/null +++ b/extra/game-input/backend/dinput/tags.txt @@ -0,0 +1,4 @@ +input +gamepads +joysticks +windows diff --git a/extra/game-input/backend/iokit/authors.txt b/extra/game-input/backend/iokit/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/game-input/backend/iokit/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/game-input/backend/iokit/iokit.factor b/extra/game-input/backend/iokit/iokit.factor new file mode 100755 index 0000000000..1871569227 --- /dev/null +++ b/extra/game-input/backend/iokit/iokit.factor @@ -0,0 +1,275 @@ +USING: cocoa cocoa.plists core-foundation iokit iokit.hid +kernel cocoa.enumeration destructors math.parser cocoa.application +sequences locals combinators.short-circuit game-input threads +symbols namespaces assocs vectors arrays combinators +core-foundation.run-loop accessors sequences.private +alien.c-types math ; +IN: game-input.backend.iokit + +SINGLETON: iokit-game-input-backend + +: hid-manager-matching ( matching-seq -- alien ) + f 0 IOHIDManagerCreate + [ swap >plist IOHIDManagerSetDeviceMatchingMultiple ] + keep ; + +: devices-from-hid-manager ( manager -- vector ) + [ + IOHIDManagerCopyDevices + [ &CFRelease NSFastEnumeration>vector ] [ f ] if* + ] with-destructors ; + +: game-devices-matching-seq + { + H{ { "DeviceUsage" 4 } { "DeviceUsagePage" 1 } } ! joysticks + H{ { "DeviceUsage" 5 } { "DeviceUsagePage" 1 } } ! gamepads + H{ { "DeviceUsage" 6 } { "DeviceUsagePage" 1 } } ! keyboards + } ; inline + +: buttons-matching-hash + H{ { "UsagePage" 9 } { "Type" 2 } } ; inline +: keys-matching-hash + H{ { "UsagePage" 7 } { "Type" 2 } } ; inline +: x-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 30 } { "Type" 1 } } ; inline +: y-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 31 } { "Type" 1 } } ; inline +: z-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 32 } { "Type" 1 } } ; inline +: rx-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 33 } { "Type" 1 } } ; inline +: ry-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 34 } { "Type" 1 } } ; inline +: rz-axis-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 35 } { "Type" 1 } } ; inline +: slider-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 36 } { "Type" 1 } } ; inline +: hat-switch-matching-hash + H{ { "UsagePage" 1 } { "Usage" HEX: 39 } { "Type" 1 } } ; inline + +: device-elements-matching ( device matching-hash -- vector ) + [ + >plist 0 IOHIDDeviceCopyMatchingElements + [ &CFRelease NSFastEnumeration>vector ] [ f ] if* + ] with-destructors ; + +: button-count ( device -- button-count ) + buttons-matching-hash device-elements-matching length ; + +: ?axis ( device hash -- axis/f ) + device-elements-matching dup empty? [ drop f ] [ first ] if ; + +: ?x-axis ( device -- ? ) + x-axis-matching-hash ?axis ; +: ?y-axis ( device -- ? ) + y-axis-matching-hash ?axis ; +: ?z-axis ( device -- ? ) + z-axis-matching-hash ?axis ; +: ?rx-axis ( device -- ? ) + rx-axis-matching-hash ?axis ; +: ?ry-axis ( device -- ? ) + ry-axis-matching-hash ?axis ; +: ?rz-axis ( device -- ? ) + rz-axis-matching-hash ?axis ; +: ?slider ( device -- ? ) + slider-matching-hash ?axis ; +: ?hat-switch ( device -- ? ) + hat-switch-matching-hash ?axis ; + +: hid-manager-matching-game-devices ( -- alien ) + game-devices-matching-seq hid-manager-matching ; + +: device-property ( device key -- value ) + IOHIDDeviceGetProperty plist> ; +: element-property ( element key -- value ) + IOHIDElementGetProperty plist> ; +: set-element-property ( element key value -- ) + [ ] [ >plist ] bi* IOHIDElementSetProperty drop ; +: transfer-element-property ( element from-key to-key -- ) + [ dupd element-property ] dip swap set-element-property ; + +: controller-device? ( device -- ? ) + { + [ 1 4 IOHIDDeviceConformsTo ] + [ 1 5 IOHIDDeviceConformsTo ] + } 1|| ; + +: element-usage ( element -- {usage-page,usage} ) + [ IOHIDElementGetUsagePage ] [ IOHIDElementGetUsage ] bi + 2array ; + +: button? ( {usage-page,usage} -- ? ) + first 9 = ; inline +: keyboard-key? ( {usage-page,usage} -- ? ) + first 7 = ; inline +: x-axis? ( {usage-page,usage} -- ? ) + { 1 HEX: 30 } = ; inline +: y-axis? ( {usage-page,usage} -- ? ) + { 1 HEX: 31 } = ; inline +: z-axis? ( {usage-page,usage} -- ? ) + { 1 HEX: 32 } = ; inline +: rx-axis? ( {usage-page,usage} -- ? ) + { 1 HEX: 33 } = ; inline +: ry-axis? ( {usage-page,usage} -- ? ) + { 1 HEX: 34 } = ; inline +: rz-axis? ( {usage-page,usage} -- ? ) + { 1 HEX: 35 } = ; inline +: slider? ( {usage-page,usage} -- ? ) + { 1 HEX: 36 } = ; inline +: hat-switch? ( {usage-page,usage} -- ? ) + { 1 HEX: 39 } = ; inline + +: pov-values + { + pov-up pov-up-right pov-right pov-down-right + pov-down pov-down-left pov-left pov-up-left + pov-neutral + } ; inline + +: button-value ( value -- f/(0,1] ) + IOHIDValueGetIntegerValue dup zero? [ drop f ] when ; +: axis-value ( value -- [-1,1] ) + kIOHIDValueScaleTypeCalibrated IOHIDValueGetScaledValue ; +: pov-value ( value -- pov-direction ) + IOHIDValueGetIntegerValue pov-values ?nth [ pov-neutral ] unless* ; + +: record-controller ( controller-state value -- ) + dup IOHIDValueGetElement element-usage { + { [ dup button? ] [ [ button-value ] [ second 1- ] bi* rot buttons>> set-nth ] } + { [ dup x-axis? ] [ drop axis-value >>x drop ] } + { [ dup y-axis? ] [ drop axis-value >>y drop ] } + { [ dup z-axis? ] [ drop axis-value >>z drop ] } + { [ dup rx-axis? ] [ drop axis-value >>rx drop ] } + { [ dup ry-axis? ] [ drop axis-value >>ry drop ] } + { [ dup rz-axis? ] [ drop axis-value >>rz drop ] } + { [ dup slider? ] [ drop axis-value >>slider drop ] } + { [ dup hat-switch? ] [ drop pov-value >>pov drop ] } + [ 3drop ] + } cond ; + +SYMBOLS: +hid-manager+ +keyboard-state+ +controller-states+ ; + +: ?set-nth ( value nth seq -- ) + 2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ; + +: record-keyboard ( value -- ) + dup IOHIDValueGetElement element-usage keyboard-key? [ + [ IOHIDValueGetIntegerValue c-bool> ] + [ IOHIDValueGetElement IOHIDElementGetUsage ] bi + +keyboard-state+ get ?set-nth + ] [ drop ] if ; + +: default-calibrate-saturation ( element -- ) + [ kIOHIDElementMinKey kIOHIDElementCalibrationSaturationMinKey transfer-element-property ] + [ kIOHIDElementMaxKey kIOHIDElementCalibrationSaturationMaxKey transfer-element-property ] + bi ; + +: default-calibrate-axis ( element -- ) + [ kIOHIDElementCalibrationMinKey -1.0 set-element-property ] + [ kIOHIDElementCalibrationMaxKey 1.0 set-element-property ] + [ default-calibrate-saturation ] + tri ; + +: default-calibrate-slider ( element -- ) + [ kIOHIDElementCalibrationMinKey 0.0 set-element-property ] + [ kIOHIDElementCalibrationMaxKey 1.0 set-element-property ] + [ default-calibrate-saturation ] + tri ; + +: (default) ( ? quot -- ) + [ f ] if* ; inline + +: ( device -- controller-state ) + { + [ ?x-axis [ default-calibrate-axis 0.0 ] (default) ] + [ ?y-axis [ default-calibrate-axis 0.0 ] (default) ] + [ ?z-axis [ default-calibrate-axis 0.0 ] (default) ] + [ ?rx-axis [ default-calibrate-axis 0.0 ] (default) ] + [ ?ry-axis [ default-calibrate-axis 0.0 ] (default) ] + [ ?rz-axis [ default-calibrate-axis 0.0 ] (default) ] + [ ?slider [ default-calibrate-slider 0.0 ] (default) ] + [ ?hat-switch pov-neutral and ] + [ button-count f ] + } cleave controller-state boa ; + +: device-matched-callback ( -- alien ) + [| context result sender device | + device controller-device? [ + device + device +controller-states+ get set-at + ] when + ] IOHIDDeviceCallback ; + +: device-removed-callback ( -- alien ) + [| context result sender device | + device +controller-states+ get delete-at + ] IOHIDDeviceCallback ; + +: device-input-callback ( -- alien ) + [| context result sender value | + sender controller-device? + [ sender +controller-states+ get at value record-controller ] + [ value record-keyboard ] + if + ] IOHIDValueCallback ; + +: initialize-variables ( manager -- ) + +hid-manager+ set-global + 4 +controller-states+ set-global + 256 f +keyboard-state+ set-global ; + +M: iokit-game-input-backend (open-game-input) + hid-manager-matching-game-devices { + [ initialize-variables ] + [ device-matched-callback f IOHIDManagerRegisterDeviceMatchingCallback ] + [ device-removed-callback f IOHIDManagerRegisterDeviceRemovalCallback ] + [ device-input-callback f IOHIDManagerRegisterInputValueCallback ] + [ 0 IOHIDManagerOpen mach-error ] + [ + CFRunLoopGetMain CFRunLoopDefaultMode + IOHIDManagerScheduleWithRunLoop + ] + } cleave ; + +M: iokit-game-input-backend (close-game-input) + +hid-manager+ get-global [ + +hid-manager+ global [ + [ + CFRunLoopGetMain CFRunLoopDefaultMode + IOHIDManagerUnscheduleFromRunLoop + ] + [ 0 IOHIDManagerClose drop ] + [ CFRelease ] tri + f + ] change-at + f +keyboard-state+ set-global + f +controller-states+ set-global + ] when ; + +M: iokit-game-input-backend get-controllers ( -- sequence ) + +controller-states+ get keys [ controller boa ] map ; + +: ?join ( pre post sep -- string ) + 2over start [ swap 2nip ] [ [ 2array ] dip join ] if ; + +M: iokit-game-input-backend product-string ( controller -- string ) + handle>> + [ kIOHIDManufacturerKey device-property ] + [ kIOHIDProductKey device-property ] bi " " ?join ; +M: iokit-game-input-backend product-id ( controller -- integer ) + handle>> + [ kIOHIDVendorIDKey device-property ] + [ kIOHIDProductIDKey device-property ] bi 2array ; +M: iokit-game-input-backend instance-id ( controller -- integer ) + handle>> kIOHIDLocationIDKey device-property ; + +M: iokit-game-input-backend read-controller ( controller -- controller-state ) + handle>> +controller-states+ get at clone ; + +M: iokit-game-input-backend read-keyboard ( -- keyboard-state ) + +keyboard-state+ get clone keyboard-state boa ; + +M: iokit-game-input-backend calibrate-controller ( controller -- ) + drop ; + +iokit-game-input-backend game-input-backend set-global diff --git a/extra/game-input/backend/iokit/summary.txt b/extra/game-input/backend/iokit/summary.txt new file mode 100644 index 0000000000..8fc5d827d0 --- /dev/null +++ b/extra/game-input/backend/iokit/summary.txt @@ -0,0 +1 @@ +IOKit HID Manager backend for game-input diff --git a/extra/game-input/backend/iokit/tags.txt b/extra/game-input/backend/iokit/tags.txt new file mode 100644 index 0000000000..b3bc4f873b --- /dev/null +++ b/extra/game-input/backend/iokit/tags.txt @@ -0,0 +1,4 @@ +gamepads +joysticks +mac +input diff --git a/extra/game-input/backend/summary.txt b/extra/game-input/backend/summary.txt new file mode 100644 index 0000000000..6a77f8e1e0 --- /dev/null +++ b/extra/game-input/backend/summary.txt @@ -0,0 +1 @@ +Platform-specific backends for game-input diff --git a/extra/game-input/backend/tags.txt b/extra/game-input/backend/tags.txt new file mode 100644 index 0000000000..48ad1f6141 --- /dev/null +++ b/extra/game-input/backend/tags.txt @@ -0,0 +1,3 @@ +gamepads +joysticks +input diff --git a/extra/game-input/game-input-docs.factor b/extra/game-input/game-input-docs.factor new file mode 100755 index 0000000000..5428ca66d0 --- /dev/null +++ b/extra/game-input/game-input-docs.factor @@ -0,0 +1,126 @@ +USING: help.markup help.syntax kernel ui.gestures quotations +sequences strings math ; +IN: game-input + +ARTICLE: "game-input" "Game controller input" +"The " { $vocab-link "game-input" } " vocabulary provides cross-platform access to game controller devices such as joysticks and gamepads. It also provides an interface for polling raw keyboard input." $nl +"The game input interface must be initialized before being used:" +{ $subsection open-game-input } +{ $subsection close-game-input } +{ $subsection with-game-input } +"Once the game input interface is open, connected controller devices can be enumerated:" +{ $subsection get-controllers } +{ $subsection find-controller-products } +{ $subsection find-controller-instance } +"These " { $link controller } " objects can be queried of their identity:" +{ $subsection product-string } +{ $subsection product-id } +{ $subsection instance-id } +"A hook is provided for invoking the system calibration tool:" +{ $subsection calibrate-controller } +"The current state of a controller or the keyboard can be read:" +{ $subsection read-controller } +{ $subsection read-keyboard } +{ $subsection controller-state } +{ $subsection keyboard-state } ; + +HELP: open-game-input +{ $description "Initializes the game input interface. An exception will be thrown if the initialization fails. If the game input interface is already opened, nothing happens." } ; + +HELP: close-game-input +{ $description "Closes the game input interface, releasing any allocated resources. Once this word is called, any remaining " { $link controller } " objects are invalid. If the game input interface is not opened, nothing happens." } ; + +HELP: game-input-opened? +{ $values { "?" "a boolean" } } +{ $description "Returns true if the game input interface is open, false otherwise." } ; + +HELP: with-game-input +{ $values { "quot" quotation } } +{ $description "Initializes the game input interface for the dynamic extent of " { $snippet "quotation" } "." } ; + +{ open-game-input close-game-input with-game-input game-input-opened? } related-words + +HELP: get-controllers +{ $values { "sequence" "A " { $link sequence } " of " { $link controller } "s" } } +{ $description "Returns a " { $link sequence } " of " { $link controller } " objects representing the currently connected game controllers. The order of the controller objects in the sequence is not significant or guaranteed to be stable between calls to " { $snippet "get-controllers" } "." } ; + +HELP: find-controller-products +{ $values { "product-id" "A product ID as returned by " { $link product-id } } { "sequence" "A " { $link sequence } " of " { $link controller } "s" } } +{ $description "Returns a " { $link sequence } " of " { $link controller } " objects representing the currently connected game controllers with the given " { $link product-id } ". The order of the controller objects in the sequence is not significant or guaranteed to be stable between calls to " { $snippet "find-controller-products" } "." } ; + +HELP: find-controller-instance +{ $values { "product-id" "A product ID as returned by " { $link product-id } } { "instance-id" "An instance ID as returned by " { $link instance-id } "." } { "controller/f" "A " { $link controller } " object, or " { $link f } } } +{ $description "Returns the " { $link controller } " instance identified by " { $snippet "product-id" } " and " { $snippet "instance-id" } ". If the identified device is not currently attached, " { $link f } " is returned." } ; + +HELP: controller +{ $class-description "Objects of this class represent game controller devices such as joysticks and gamepads. They should be treated as opaque by client code." } ; + +HELP: product-string +{ $values { "controller" controller } { "string" string } } +{ $description "Returns a human-readable string describing the game controller device represented by " { $snippet "controller" } ". This string is not necessarily unique to the product or instance; to uniquely identify the device, see " { $link product-id } " and " { $link instance-id } "." } ; + +HELP: product-id +{ $values { "controller" controller } { "id" "A unique identifier" } } +{ $description "Returns an identifier uniquely representing the kind of game controller device represented by " { $snippet "controller" } ". This identifier will be the same for devices of the same make and manufacturer. The type of the identifier value is platform-specific, but equivalent " { $snippet "product-id" } "s are guaranteed to be testable with the " { $link = } " word. The identifier can be used to find devices of the same kind with the " { $link find-controller-products } " word." } ; + +HELP: instance-id +{ $values { "controller" controller } { "id" "A unique identifier" } } +{ $description "Returns an identifier uniquely representing the game controller device represented by " { $snippet "controller" } ". This identifier paired with the device's " { $link product-id } " provides a unique identifier for a particular device that persists between reboots (but not necessarily between computers). This unique identifier can be used to find the same device again with the " { $snippet "find-controller-instance" } " word. Depending on the platform, the instance-id may change if the device is plugged into a different port. The type of the identifier value is platform-specific, but equivalent " { $snippet "instance-id" } "s are guaranteed to be testable with the " { $link = } " word." } ; + +{ product-string product-id instance-id find-controller-products find-controller-instance } related-words + +HELP: calibrate-controller +{ $values { "controller" controller } } +{ $description "Invokes the operating system's calibration tool for " { $snippet "controller" } ". If the operating system does not have a calibration tool, this word does nothing." } ; + +HELP: read-controller +{ $values { "controller" controller } { "controller-state" controller-state } } +{ $description "Reads the current state of " { $snippet "controller" } ". See the documentation for the " { $link controller-state } " class for details of the returned value's format. If the device is no longer available, " { $link f } " is returned." } +{ $warning "For efficiency, the implementation may reuse the returned " { $snippet "controller-state" } " object next time " { $snippet "read-controller" } " is called on the same controller. You should " { $link clone } " any values from the returned tuple you need to preserve." } ; + +{ controller-state controller read-controller } related-words + +HELP: read-keyboard +{ $values { "keyboard-state" keyboard-state } } +{ $description "Reads the current raw state of the keyboard. See the documentation for the " { $link keyboard-state } " class for details on the returned value's format." } +{ $warning "For efficiency, the implementation may reuse the returned " { $snippet "keyboard-state" } " object next time " { $snippet "read-keyboard" } " is called. You should " { $link clone } " any values from the returned tuple you need to preserve." +$nl "The keyboard state returned by this word is unprocessed by any keymaps, modifier keys, key repeat settings, or other operating environment postprocessing. Because of this, " { $snippet "read-keyboard" } " should not be used for text entry purposes. The Factor UI's standard gesture mechanism should be used in cases where the logical meaning of keypresses is needed; see " { $link "keyboard-gestures" } "." } ; + +HELP: controller-state +{ $class-description "The " { $link read-controller } " word returns objects of this class. " { $snippet "controller-state" } " objects have the following slots:" +{ $list + { { $snippet "x" } " contains the position of the device's X axis." } + { { $snippet "y" } " contains the position of the device's Y axis." } + { { $snippet "z" } " contains the position of the device's Z axis, if any." } + { { $snippet "rx" } " contains the rotational position of the device's X axis, if available." } + { { $snippet "ry" } " contains the rotational position of the device's Y axis, if available." } + { { $snippet "rz" } " contains the rotational position of the device's Z axis, if available." } + { { $snippet "slider" } " contains the position of the device's throttle slider, if any." } + { { $snippet "pov" } " contains the state of the device's POV hat, if any." } + { { $snippet "buttons" } " contains a sequence of values indicating the state of every button on the device." } +} +"The values are formatted as follows:" +{ $list + { "For the axis slots (" { $snippet "x" } ", " { $snippet "y" } ", " { $snippet "z" } ", " { $snippet "rx" } ", " { $snippet "ry" } ", " { $snippet "rz" } "), a " { $link float } " value between -1.0 and 1.0 is returned." } + { "For the " { $snippet "slider" } " slot, a value between 0.0 and 1.0 is returned." } + { "For the " { $snippet "pov" } " slot, one of the following symbols is returned:" { $list + { { $link pov-neutral } } + { { $link pov-up } } + { { $link pov-up-right } } + { { $link pov-right } } + { { $link pov-down-right } } + { { $link pov-down } } + { { $link pov-down-left } } + { { $link pov-left } } + { { $link pov-up-left } } + } } + { "For each element of the " { $snippet "buttons" } " array, " { $link f } " indicates that the corresponding button is released. If the button is pressed, a value between 0.0 and 1.0 is returned indicating the pressure on the button (or simply 1.0 if the device's buttons are on/off only)." } + { "A value of " { $link f } " in any slot (besides the elements of " { $snippet "buttons" } ") indicates that the corresponding element is not present on the device." } } } ; + +HELP: keyboard-state +{ $class-description "The " { $link read-keyboard } " word returns objects of this class. The " { $snippet "keys" } " slot of a " { $snippet "keyboard-state" } " object contains a " { $link sequence } " of 256 members representing the state of the keys on the keyboard. Each element is a boolean value indicating whether the corresponding key is pressed. The sequence is indexed by scancode as defined under usage page 7 of the USB HID standard. Named scancode constants are provided in the " { $vocab-link "game-input.scancodes" } " vocabulary." } +{ $warning "The scancodes used to index " { $snippet "keyboard-state" } " objects correspond to physical key positions on the keyboard--they are unaffected by keymaps, modifier keys, or other operating environment postprocessing. The face value of the constants in " { $vocab-link "game-input.scancodes" } " do not necessarily correspond to what the user expects the key to type. Because of this, " { $link read-keyboard } " should not be used for text entry purposes. The Factor UI's standard gesture mechanism should be used in cases where the logical meaning of keypresses is needed; see " { $link "keyboard-gestures" } "." } ; + +{ keyboard-state read-keyboard } related-words + +ABOUT: "game-input" diff --git a/extra/game-input/game-input.factor b/extra/game-input/game-input.factor new file mode 100755 index 0000000000..5472eead9c --- /dev/null +++ b/extra/game-input/game-input.factor @@ -0,0 +1,60 @@ +USING: arrays accessors continuations kernel symbols +combinators.lib sequences namespaces ; +IN: game-input + +SYMBOLS: game-input-backend game-input-opened ; + +HOOK: (open-game-input) game-input-backend ( -- ) +HOOK: (close-game-input) game-input-backend ( -- ) + +: game-input-opened? ( -- ? ) + game-input-opened get ; + +: open-game-input ( -- ) + game-input-opened? [ + (open-game-input) + game-input-opened on + ] unless ; +: close-game-input ( -- ) + game-input-opened? [ + (close-game-input) + game-input-opened off + ] when ; + +: with-game-input ( quot -- ) + open-game-input [ close-game-input ] [ ] cleanup ; + +TUPLE: controller handle ; +TUPLE: controller-state x y z rx ry rz slider pov buttons ; + +M: controller-state clone + call-next-method dup buttons>> clone >>buttons ; + +SYMBOLS: + pov-neutral + pov-up pov-up-right pov-right pov-down-right + pov-down pov-down-left pov-left pov-up-left ; + +HOOK: get-controllers game-input-backend ( -- sequence ) + +HOOK: product-string game-input-backend ( controller -- string ) +HOOK: product-id game-input-backend ( controller -- id ) +HOOK: instance-id game-input-backend ( controller -- id ) + +: find-controller-products ( product-id -- sequence ) + get-controllers [ product-id = ] with filter ; +: find-controller-instance ( product-id instance-id -- controller/f ) + get-controllers [ + [ product-id = ] + [ instance-id = ] bi, bi* and + ] 2with find nip ; + +HOOK: read-controller game-input-backend ( controller -- controller-state ) +HOOK: calibrate-controller game-input-backend ( controller -- ) + +TUPLE: keyboard-state keys ; + +M: keyboard-state clone + call-next-method dup keys>> clone >>keys ; + +HOOK: read-keyboard game-input-backend ( -- keyboard-state ) diff --git a/extra/game-input/scancodes/authors.txt b/extra/game-input/scancodes/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/game-input/scancodes/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/game-input/scancodes/scancodes.factor b/extra/game-input/scancodes/scancodes.factor new file mode 100644 index 0000000000..7b0e39ee9b --- /dev/null +++ b/extra/game-input/scancodes/scancodes.factor @@ -0,0 +1,175 @@ +IN: game-input.scancodes + +: key-undefined HEX: 0000 ; inline +: key-error-roll-over HEX: 0001 ; inline +: key-error-post-fail HEX: 0002 ; inline +: key-error-undefined HEX: 0003 ; inline +: key-a HEX: 0004 ; inline +: key-b HEX: 0005 ; inline +: key-c HEX: 0006 ; inline +: key-d HEX: 0007 ; inline +: key-e HEX: 0008 ; inline +: key-f HEX: 0009 ; inline +: key-g HEX: 000a ; inline +: key-h HEX: 000b ; inline +: key-i HEX: 000c ; inline +: key-j HEX: 000d ; inline +: key-k HEX: 000e ; inline +: key-l HEX: 000f ; inline +: key-m HEX: 0010 ; inline +: key-n HEX: 0011 ; inline +: key-o HEX: 0012 ; inline +: key-p HEX: 0013 ; inline +: key-q HEX: 0014 ; inline +: key-r HEX: 0015 ; inline +: key-s HEX: 0016 ; inline +: key-t HEX: 0017 ; inline +: key-u HEX: 0018 ; inline +: key-v HEX: 0019 ; inline +: key-w HEX: 001a ; inline +: key-x HEX: 001b ; inline +: key-y HEX: 001c ; inline +: key-z HEX: 001d ; inline +: key-1 HEX: 001e ; inline +: key-2 HEX: 001f ; inline +: key-3 HEX: 0020 ; inline +: key-4 HEX: 0021 ; inline +: key-5 HEX: 0022 ; inline +: key-6 HEX: 0023 ; inline +: key-7 HEX: 0024 ; inline +: key-8 HEX: 0025 ; inline +: key-9 HEX: 0026 ; inline +: key-0 HEX: 0027 ; inline +: key-return HEX: 0028 ; inline +: key-escape HEX: 0029 ; inline +: key-backspace HEX: 002a ; inline +: key-tab HEX: 002b ; inline +: key-space HEX: 002c ; inline +: key-- HEX: 002d ; inline +: key-= HEX: 002e ; inline +: key-[ HEX: 002f ; inline +: key-] HEX: 0030 ; inline +: key-\ HEX: 0031 ; inline +: key-#-non-us HEX: 0032 ; inline +: key-; HEX: 0033 ; inline +: key-' HEX: 0034 ; inline +: key-` HEX: 0035 ; inline +: key-, HEX: 0036 ; inline +: key-. HEX: 0037 ; inline +: key-/ HEX: 0038 ; inline +: key-caps-lock HEX: 0039 ; inline +: key-f1 HEX: 003a ; inline +: key-f2 HEX: 003b ; inline +: key-f3 HEX: 003c ; inline +: key-f4 HEX: 003d ; inline +: key-f5 HEX: 003e ; inline +: key-f6 HEX: 003f ; inline +: key-f7 HEX: 0040 ; inline +: key-f8 HEX: 0041 ; inline +: key-f9 HEX: 0042 ; inline +: key-f10 HEX: 0043 ; inline +: key-f11 HEX: 0044 ; inline +: key-f12 HEX: 0045 ; inline +: key-print-screen HEX: 0046 ; inline +: key-scroll-lock HEX: 0047 ; inline +: key-pause HEX: 0048 ; inline +: key-insert HEX: 0049 ; inline +: key-home HEX: 004a ; inline +: key-page-up HEX: 004b ; inline +: key-delete HEX: 004c ; inline +: key-end HEX: 004d ; inline +: key-page-down HEX: 004e ; inline +: key-right-arrow HEX: 004f ; inline +: key-left-arrow HEX: 0050 ; inline +: key-down-arrow HEX: 0051 ; inline +: key-up-arrow HEX: 0052 ; inline +: key-keypad-numlock HEX: 0053 ; inline +: key-keypad-/ HEX: 0054 ; inline +: key-keypad-* HEX: 0055 ; inline +: key-keypad-- HEX: 0056 ; inline +: key-keypad-+ HEX: 0057 ; inline +: key-keypad-enter HEX: 0058 ; inline +: key-keypad-1 HEX: 0059 ; inline +: key-keypad-2 HEX: 005a ; inline +: key-keypad-3 HEX: 005b ; inline +: key-keypad-4 HEX: 005c ; inline +: key-keypad-5 HEX: 005d ; inline +: key-keypad-6 HEX: 005e ; inline +: key-keypad-7 HEX: 005f ; inline +: key-keypad-8 HEX: 0060 ; inline +: key-keypad-9 HEX: 0061 ; inline +: key-keypad-0 HEX: 0062 ; inline +: key-keypad-. HEX: 0063 ; inline +: key-\-non-us HEX: 0064 ; inline +: key-application HEX: 0065 ; inline +: key-power HEX: 0066 ; inline +: key-keypad-= HEX: 0067 ; inline +: key-f13 HEX: 0068 ; inline +: key-f14 HEX: 0069 ; inline +: key-f15 HEX: 006a ; inline +: key-f16 HEX: 006b ; inline +: key-f17 HEX: 006c ; inline +: key-f18 HEX: 006d ; inline +: key-f19 HEX: 006e ; inline +: key-f20 HEX: 006f ; inline +: key-f21 HEX: 0070 ; inline +: key-f22 HEX: 0071 ; inline +: key-f23 HEX: 0072 ; inline +: key-f24 HEX: 0073 ; inline +: key-execute HEX: 0074 ; inline +: key-help HEX: 0075 ; inline +: key-menu HEX: 0076 ; inline +: key-select HEX: 0077 ; inline +: key-stop HEX: 0078 ; inline +: key-again HEX: 0079 ; inline +: key-undo HEX: 007a ; inline +: key-cut HEX: 007b ; inline +: key-copy HEX: 007c ; inline +: key-paste HEX: 007d ; inline +: key-find HEX: 007e ; inline +: key-mute HEX: 007f ; inline +: key-volume-up HEX: 0080 ; inline +: key-volume-down HEX: 0081 ; inline +: key-locking-caps-lock HEX: 0082 ; inline +: key-locking-num-lock HEX: 0083 ; inline +: key-locking-scroll-lock HEX: 0084 ; inline +: key-keypad-, HEX: 0085 ; inline +: key-keypad-=-as-400 HEX: 0086 ; inline +: key-international-1 HEX: 0087 ; inline +: key-international-2 HEX: 0088 ; inline +: key-international-3 HEX: 0089 ; inline +: key-international-4 HEX: 008a ; inline +: key-international-5 HEX: 008b ; inline +: key-international-6 HEX: 008c ; inline +: key-international-7 HEX: 008d ; inline +: key-international-8 HEX: 008e ; inline +: key-international-9 HEX: 008f ; inline +: key-lang-1 HEX: 0090 ; inline +: key-lang-2 HEX: 0091 ; inline +: key-lang-3 HEX: 0092 ; inline +: key-lang-4 HEX: 0093 ; inline +: key-lang-5 HEX: 0094 ; inline +: key-lang-6 HEX: 0095 ; inline +: key-lang-7 HEX: 0096 ; inline +: key-lang-8 HEX: 0097 ; inline +: key-lang-9 HEX: 0098 ; inline +: key-alternate-erase HEX: 0099 ; inline +: key-sysreq HEX: 009a ; inline +: key-cancel HEX: 009b ; inline +: key-clear HEX: 009c ; inline +: key-prior HEX: 009d ; inline +: key-enter HEX: 009e ; inline +: key-separator HEX: 009f ; inline +: key-out HEX: 00a0 ; inline +: key-oper HEX: 00a1 ; inline +: key-clear-again HEX: 00a2 ; inline +: key-crsel-props HEX: 00a3 ; inline +: key-exsel HEX: 00a4 ; inline +: key-left-control HEX: 00e0 ; inline +: key-left-shift HEX: 00e1 ; inline +: key-left-alt HEX: 00e2 ; inline +: key-left-gui HEX: 00e3 ; inline +: key-right-control HEX: 00e4 ; inline +: key-right-shift HEX: 00e5 ; inline +: key-right-alt HEX: 00e6 ; inline +: key-right-gui HEX: 00e7 ; inline diff --git a/extra/game-input/scancodes/summary.txt b/extra/game-input/scancodes/summary.txt new file mode 100644 index 0000000000..b1bdefeb71 --- /dev/null +++ b/extra/game-input/scancodes/summary.txt @@ -0,0 +1 @@ +Scan code constants for HID keyboards diff --git a/extra/game-input/scancodes/tags.txt b/extra/game-input/scancodes/tags.txt new file mode 100644 index 0000000000..6f4814c59c --- /dev/null +++ b/extra/game-input/scancodes/tags.txt @@ -0,0 +1,2 @@ +keyboard +input diff --git a/extra/game-input/summary.txt b/extra/game-input/summary.txt new file mode 100644 index 0000000000..ef479fee55 --- /dev/null +++ b/extra/game-input/summary.txt @@ -0,0 +1 @@ +Cross-platform joystick, gamepad, and raw keyboard input diff --git a/extra/game-input/tags.txt b/extra/game-input/tags.txt new file mode 100644 index 0000000000..ae360e1776 --- /dev/null +++ b/extra/game-input/tags.txt @@ -0,0 +1,3 @@ +joysticks +gamepads +input diff --git a/extra/iokit/hid/authors.txt b/extra/iokit/hid/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/iokit/hid/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/iokit/hid/hid.factor b/extra/iokit/hid/hid.factor index 79c3516b4e..11ba5d3687 100644 --- a/extra/iokit/hid/hid.factor +++ b/extra/iokit/hid/hid.factor @@ -20,8 +20,8 @@ IN: iokit.hid : kIOHIDPrimaryUsageKey "PrimaryUsage" ; inline : kIOHIDPrimaryUsagePageKey "PrimaryUsagePage" ; inline : kIOHIDMaxInputReportSizeKey "MaxInputReportSize" ; inline -: kIOHIDMaxOutputReportSizeKey "MaxOutputReportSize" ; inline -: kIOHIDMaxFeatureReportSizeKey "MaxFeatureReportSize" ; inline +: kIOHIDMaxOutputReportSizeKey "MaxOutputReportSize" ; inline +: kIOHIDMaxFeatureReportSizeKey "MaxFeatureReportSize" ; inline : kIOHIDReportIntervalKey "ReportInterval" ; inline : kIOHIDElementKey "Elements" ; inline @@ -77,7 +77,7 @@ IN: iokit.hid : kIOHIDElementTypeFeature 257 ; inline : kIOHIDElementTypeCollection 513 ; inline -: kIOHIDElementCollectionTypePhysical HEX: 00 ; inline +: kIOHIDElementCollectionTypePhysical HEX: 00 ; inline : kIOHIDElementCollectionTypeApplication HEX: 01 ; inline : kIOHIDElementCollectionTypeLogical HEX: 02 ; inline : kIOHIDElementCollectionTypeReport HEX: 03 ; inline @@ -90,10 +90,10 @@ IN: iokit.hid : kIOHIDReportTypeFeature 2 ; inline : kIOHIDReportTypeCount 3 ; inline -: kIOHIDOptionsTypeNone HEX: 00 ; inline +: kIOHIDOptionsTypeNone HEX: 00 ; inline : kIOHIDOptionsTypeSeizeDevice HEX: 01 ; inline -: kIOHIDQueueOptionsTypeNone HEX: 00 ; inline +: kIOHIDQueueOptionsTypeNone HEX: 00 ; inline : kIOHIDQueueOptionsTypeEnqueueAll HEX: 01 ; inline : kIOHIDElementFlagsConstantMask HEX: 0001 ; inline @@ -269,3 +269,4 @@ FUNCTION: IOHIDValueRef IOHIDTransactionGetValue ( IOHIDTransactionRef transacti FUNCTION: IOReturn IOHIDTransactionCommit ( IOHIDTransactionRef transaction ) ; FUNCTION: IOReturn IOHIDTransactionCommitWithCallback ( IOHIDTransactionRef transaction, CFTimeInterval timeout, IOHIDCallback callback, void* context ) ; FUNCTION: void IOHIDTransactionClear ( IOHIDTransactionRef transaction ) ; + diff --git a/extra/iokit/hid/summary.txt b/extra/iokit/hid/summary.txt new file mode 100644 index 0000000000..5b660488a4 --- /dev/null +++ b/extra/iokit/hid/summary.txt @@ -0,0 +1 @@ +HID Manager bindings diff --git a/extra/iokit/hid/tags.txt b/extra/iokit/hid/tags.txt new file mode 100644 index 0000000000..c83070b657 --- /dev/null +++ b/extra/iokit/hid/tags.txt @@ -0,0 +1,3 @@ +mac +bindings +system diff --git a/extra/iokit/iokit.factor b/extra/iokit/iokit.factor old mode 100644 new mode 100755 diff --git a/extra/joystick-demo/authors.txt b/extra/joystick-demo/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/joystick-demo/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/joystick-demo/joystick-demo.factor b/extra/joystick-demo/joystick-demo.factor new file mode 100755 index 0000000000..c39a4b0b1c --- /dev/null +++ b/extra/joystick-demo/joystick-demo.factor @@ -0,0 +1,145 @@ +USING: ui ui.gadgets sequences kernel arrays math colors +ui.render math.vectors accessors fry ui.gadgets.packs game-input +game-input.backend ui.gadgets.labels ui.gadgets.borders alarms +calendar locals combinators.lib strings ui.gadgets.buttons +combinators math.parser assocs threads ; +IN: joystick-demo + +: SIZE { 151 151 } ; +: INDICATOR-SIZE { 4 4 } ; +: FREQUENCY ( -- f ) 30 recip seconds ; + +TUPLE: axis-gadget < gadget indicator z-indicator pov ; + +M: axis-gadget pref-dim* drop SIZE ; + +: (rect-polygon) ( lo hi -- polygon ) + 2dup + [ [ second ] [ first ] bi* swap 2array ] + [ [ first ] [ second ] bi* 2array ] 2bi swapd 4array ; + +: indicator-polygon ( -- polygon ) + { 0 0 } INDICATOR-SIZE (rect-polygon) ; + +: pov-polygons + V{ + { pov-neutral { { 70 75 } { 75 70 } { 80 75 } { 75 80 } } } + { pov-up { { 70 65 } { 75 60 } { 80 65 } } } + { pov-up-right { { 83 60 } { 90 60 } { 90 67 } } } + { pov-right { { 85 70 } { 90 75 } { 85 80 } } } + { pov-down-right { { 90 83 } { 90 90 } { 83 90 } } } + { pov-down { { 70 85 } { 75 90 } { 80 85 } } } + { pov-down-left { { 67 90 } { 60 90 } { 60 83 } } } + { pov-left { { 65 70 } { 60 75 } { 65 80 } } } + { pov-up-left { { 67 60 } { 60 60 } { 60 67 } } } + } ; + +: ( color -- indicator ) + indicator-polygon ; + +: (>loc) ( axisloc -- windowloc ) + 0.5 v*n { 0.5 0.5 } v+ SIZE v* [ >integer ] map + INDICATOR-SIZE 2 v/n v- ; + +: (xy>loc) ( x y -- xyloc ) + 2array (>loc) ; +: (z>loc) ( z -- zloc ) + 0.0 swap 2array (>loc) ; + +: (xyz>loc) ( x y z -- xyloc zloc ) + [ [ 0.0 ] unless* ] tri@ + [ (xy>loc) ] dip (z>loc) ; + +: move-axis ( gadget x y z -- ) + (xyz>loc) rot + [ indicator>> (>>loc) ] + [ z-indicator>> (>>loc) ] bi, bi* ; + +: move-pov ( gadget pov -- ) + swap pov>> [ interior>> -rot = [ gray ] [ white ] if >>color drop ] + with assoc-each ; + +:: add-pov-gadget ( gadget direction polygon -- gadget direction gadget ) + gadget white polygon [ add-gadget ] keep + direction swap ; + +: add-pov-gadgets ( gadget -- gadget ) + pov-polygons [ add-pov-gadget ] assoc-map >>pov ; + +: ( -- gadget ) + axis-gadget new-gadget + add-pov-gadgets + black [ >>z-indicator ] [ add-gadget ] bi + red [ >>indicator ] [ add-gadget ] bi + dup [ 0.0 0.0 0.0 move-axis ] [ f move-pov ] bi ; + +TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ; + +: add-gadget-with-border ( parent child -- parent ) + 2 gray >>boundary add-gadget ; + +: add-controller-label ( gadget controller -- gadget ) + [ >>controller ] [ product-string