Version 5 of Joysticks on Windows

Updated 2013-10-16 06:46:24 by pooryorick

David Gravereaux donated this code, which adds joystick capability to Tcl on Windows, on comp.lang.tcl, and RS thought it belongs here too, for future reference, and also as a little example of a Tcl extension in C.


 #include <windows.h>
 #pragma comment (lib, "winmm.lib")
 #define USE_TCL_STUBS
 #include <tcl.h>

 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLEXPORT

 Tcl_ObjCmdProc GetJoyPosCmd;

 EXTERN int
 Joytcl_Init(
    Tcl_Interp *interp)
 {
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
 return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "joy::getpos", GetJoyPosCmd, NULL, NULL);
    return Tcl_PkgProvide(interp, "Joy", "1.0");
 }

 int
 GetJoyPosCmd(
    ClientData clientData, /* Not used */
    Tcl_Interp *interp,  /* The interp we are in */
    int objc,   /* Number of arguments */
    Tcl_Obj *CONST objv) /* The arguments */
 {
    JOYINFO ji;
    MMRESULT ok;
    UINT id;
    Tcl_Obj *data4;

    if (objc != 2) {
 Tcl_WrongNumArgs(interp, 1, objv, "id");
 return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv1, (int *)&id) == TCL_ERROR) {
 return TCL_ERROR;
    }

    ok = joyGetPos(id, &ji);

    if (ok != JOYERR_NOERROR) {
 switch (ok) {
     case MMSYSERR_NODRIVER:
  Tcl_SetObjResult(interp, Tcl_NewStringObj("The joystick driver is not present", -1));
  break;
     case MMSYSERR_INVALPARAM:
  Tcl_SetObjResult(interp, Tcl_NewStringObj("An invalid parameter was passed.", -1));
  break;
     case JOYERR_UNPLUGGED:
  Tcl_SetObjResult(interp, Tcl_NewStringObj("The specified joystick is not connected to the system.", -1));
  break;
     case JOYERR_PARMS:
  Tcl_SetObjResult(interp, Tcl_NewStringObj("The specified joystick device identifier is invalid", -1));
  break;
     default:
  Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown error.", -1));
 } return TCL_ERROR;
    }

    data0 = Tcl_NewLongObj(ji.wXpos);
    data1 = Tcl_NewLongObj(ji.wYpos);
    data2 = Tcl_NewLongObj(ji.wZpos);
    data3 = Tcl_NewLongObj(ji.wButtons);
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, data));
    return TCL_OK;
 }