Joysticks on Windows

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 objvg) /* The arguments */
 {
    JOYINFO ji;
    MMRESULT ok;
    UINT id;
    Tcl_Obj *data[4];

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

    if (Tcl_GetIntFromObj(interp, objv[1], (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;
    }

    data[0] = Tcl_NewLongObj(ji.wXpos);
    data[1] = Tcl_NewLongObj(ji.wYpos);
    data2 = Tcl_NewLongObj(ji.wZpos);
    data[3] = Tcl_NewLongObj(ji.wButtons);
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, data));
    return TCL_OK;
 }

Category Windows