Version 1 of Joysticks on Windows

Updated 2004-01-21 18:25:19

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

Calling example (in Tcl) - however it seems not to match the code:

 set joy [joyOpen $port -command gotJoyEvent]
 proc gotJoyEvent {event data1 data2 data3} {
     switch $event {
       joy1move {
         puts "joy1:: buttons: $data1, xpos: $data2, ypos: $data3"
       }
       joy1zmove {
         puts "joy1:: buttons: $data1, zpos: $data2"
       }
       joy2move {
         puts "joy2:: buttons: $data1, xpos: $data2, ypos: $data3"
       }
       joy2zmove {
         puts "joy2:: buttons: $data1, zpos: $data2"
       }
     }
 }

---

 #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 *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);
    data[2] = Tcl_NewLongObj(ji.wZpos);
    data[3] = Tcl_NewLongObj(ji.wButtons);
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, data));
    return TCL_OK;
 }

---