[NPIdea]

Hola a todos.

He instalado Debian en una maquina virtual con VirtualBox y por supuesto Lazarus. Funciona muy bien, hay que decirlo.

Mi proposito erá encontrar librerias bluetooth para hacer alguna aplicación y encontré BluettothLaz 0.1 en la http://wiki.lazarus.freepascal.org/Bluetooth/es.

He instalado la libreria libbluetooth-dev y luego he ido a instalar el paquete. Me da un error de compilación en una unit llamada wiimotetools.

Como no tengo ninguna esperiencia en realizar componentes os pido a ver si le podeis echar un ojo y decirme la solución: (Quito el chorizo variables, sino el mensaje es muy largo y no me deja publicarlo)

Código Delphi [-]

unit WiiMoteTools;

{$mode objfpc}{$H+}

{$linklib bluetooth}

interface

uses
  Classes, SysUtils, Bluetooth, ctypes, Sockets;

//------------------------------------------------------------------------------
// mini libc
type
   __time_t = longint;
   __suseconds_t = longint;
   Ptimeval = ^timeval;
   timeval = record
        tv_sec : __time_t;
        tv_usec : __suseconds_t;
     end;
   __fd_mask = dWord;

const
  __FD_SETSIZE = 1024;
  __NFDBITS       = 8 * sizeof(__fd_mask);

type
  __fd_set = record
     fds_bits: packed array[0..(__FD_SETSIZE div __NFDBITS)-1] of __fd_mask;
  end;
  TFdSet = __fd_set;
  PFdSet = ^TFdSet;
Type
  Pfd_set = ^_fd_set;
  _fd_set = __fd_set;

const
  FD_SETSIZE = __FD_SETSIZE;

Type
  Pfd_mask = ^fd_mask;
  fd_mask = __fd_mask;

const
  NFDBITS = __NFDBITS;

Function __FDELT(d: longint): Integer;
Function __FDMASK(d: longint): __fd_mask;
procedure FD_ZERO(out fdset: _fd_set);
procedure FD_SET(fd: longint; var fdset: _fd_Set);
type
  TAccelVector = record
    x,y,z: integer;
  end;
  
  TAccelCalibration = record
    cal_zero: TAccelVector;
    cal_g: TAccelVector;
  end;
  
  TWiiMoteReadRequest = class;

  TWiiMoteReadCallback = procedure(Request: TWiiMoteReadRequest) of object;

  { TWiiMoteReadRequest }

  TWiiMoteReadRequest = class
  public
    Callback: TWiiMoteReadCallback;
    Addr: cardinal;
    BufSize: word;
    Buf: PByte;
    Received: word;
    constructor Create(const TheCallback: TWiiMoteReadCallback;
                       TheAddr: cardinal; TheBufSize: word);
    destructor Destroy; override;
  end;

  TWiiMoteDot = record
    X: word;
    Y: word;
    Size: word;
    Visible: boolean;
  end;

  TWiimotes = class;

  { TWiiMote }

  TWiimote = class
  private
    FLEDS: integer;
    FRealizedIR: boolean;
    FReadRequests: TFPList;// list of TWiiMoteReadRequest
    function SendCmd(ReportType: byte; Msg: PByte; Count: integer): PtrInt;
    function SendData(Addr: cuint; Data: Pointer; Count: byte): PtrInt;
    function RequestRead(const Callback: TWiiMoteReadCallback;
                          Addr: cuint; BufSize: cushort): TWiiMoteReadRequest;
    procedure SendNextReadRequest;
    procedure OnHandShake(Request: TWiiMoteReadRequest);
    procedure HandleEvents;
    procedure HandleRead;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetLEDs(const AValue: integer);
    function Connect: boolean;
    procedure Disconnect;
    procedure EnableHandshake;
    function RealizeReportType: boolean;
    procedure RealizeIR;
    
    WiiMotes: TWiiMotes;
    ID: integer;
    Name: string;
    bdaddr: bdaddr_t;
    Found: boolean;
    Connected: boolean;
    OutSocket: cint;
    InSocket: cint;
    Handshaking: boolean;
    HandshakeComplete: boolean;
    Event: TWiimoteEventType;
    EventBuf: array[0..31] of byte;
    
    // properties
    LEDs: integer;
    Rumble: boolean;
    Continuous: boolean;
    ReportMotion: boolean;
    ReportIR: boolean;
    ReportExpansion: boolean;
    Buttons: word; // current button state
    Accel: TAccelVector; // current accelerator state
    AccelCalibration: TAccelCalibration;
    Dots: array[0..3] of TWiiMoteDot;
  end;
  
  { TWiiMotes }

  TWiimotes = class
  private
    FItems: TFPList;
    function GetItems(Index: integer): TWiimote;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(Item: TWiimote): integer;
    function Count: integer;
    property Items[Index: integer]: TWiimote read GetItems; default;
    procedure FindWiiMotes(timeout: integer);
    function Connect: integer;
    procedure Disconnect;
    function HandleEvents: boolean;
  end;


function c_close(fd: cint): cint; external name 'close';


implementation

function __FDELT(d: longint): Integer;
begin
  Result:=d div __NFDBITS;
end;

function __FDMASK(d: longint): __fd_mask;
begin
  Result:=1 shl (d mod __NFDBITS);
end;

procedure FD_ZERO(out fdset: _fd_set);
var
  I: Integer;
begin
  with fdset do
    for I:=Low(fds_bits) to High(fds_bits) do
      fds_bits[i]:=0;
end;

procedure FD_SET(fd: longint; var fdset: _fd_Set);
begin
  fdset.fds_bits[__FDELT(fd)]:=fdset.fds_bits[__FDELT(fd)] or __FDMASK(fd);
end;

procedure FD_CLR(fd: longint; var fdset: _fd_set);
begin
  fdset.fds_bits[__FDELT(fd)]:=fdset.fds_bits[__FDELT(fd)] and (not __FDMASK(fd));
end;

function FD_ISSET(fd: longint; const fdset: _fd_set): Boolean;
begin
  Result:=(fdset.fds_bits[__FDELT(fd)] and __FDMASK(fd))<>0;
end;


procedure TWiimotes.FindWiiMotes(timeout: integer);
var
  device_id, device_sock: cint;
  scan_info: array[0..127] of inquiry_info;
  scan_info_ptr: Pinquiry_info;
  found_devices: cint;
  DevName: PCChar;
  CurWiiMote: TWiimote;
  i: Integer;
begin
  // get the id of the first bluetooth device.
  device_id := hci_get_route(nil);
  if (device_id < 0) then
    raise Exception.Create('FindWiiMotes: hci_get_route');

  // create a socket to the device
  device_sock := hci_open_dev(device_id);
  if (device_sock < 0) then
    raise Exception.Create('hci_open_dev');

  // scan for bluetooth devices for 'timeout' seconds
  scan_info_ptr:=@scan_info[0];
  FillByte(scan_info[0],SizeOf(inquiry_info)*128,0);
  found_devices := hci_inquiry_1(device_id, timeout, 128, nil,
                                 @scan_info_ptr, IREQ_CACHE_FLUSH);
  if (found_devices < 0) then
    raise Exception.Create('hci_inquiry');
  writeln('found_devices=',found_devices);
  
  // display discovered devices
  DevName:=nil;
  GetMem(DevName,20);
  for i:=0 to found_devices-1 do begin
    if ((scan_info[i].dev_class[0] = WM_DEV_CLASS_0) and
        (scan_info[i].dev_class[1] = WM_DEV_CLASS_1) and
        (scan_info[i].dev_class[2] = WM_DEV_CLASS_2)) then
    begin
      CurWiiMote:=TWiimote.Create;
      Add(CurWiiMote);
      // found a device
      ba2str(@scan_info[i].bdaddr, DevName);
      CurWiiMote.Name:=PChar(DevName);
      CurWiiMote.bdaddr:=scan_info[i].bdaddr;
      CurWiiMote.Found:=true;

      writeln(i,' Device=',CurWiiMote.Name);
    end;
  end;
  FreeMem(DevName);

  c_close(device_sock);
end;

function TWiimotes.Connect: integer;
var
  CurWiiMote: TWiimote;
  i: Integer;
begin
  Result:=0;
  for i:=0 to Count-1 do begin
    CurWiiMote:=Items[i];
    if not CurWiiMote.Found then
      // if the device address is not set, skip it
      continue;

    if CurWiiMote.Connect then
      inc(Result);
  end;
end;

procedure TWiimotes.Disconnect;
var
  i: Integer;
begin
  for i:=0 to Count-1 do Items[i].Disconnect;
end;

function TWiimotes.HandleEvents: boolean;
var
  fds: _fd_set;
  highest_fd: integer;
  tv: timeval;
  i: integer;
  r: PtrInt;
begin
  highest_fd:=0;
  Result:=false;

  // block select() for 1/2000th of a second
  tv.tv_sec := 0;
  tv.tv_usec := 500;

  FD_ZERO(fds);

  for i:=0 to Count-1 do begin
    // only poll it if it is connected
    if Items[i].Connected then begin
      FD_SET(Items[i].InSocket, fds);

      // find the highest fd of the connected wiimotes
      if (Items[i].InSocket > highest_fd) then
        highest_fd := Items[i].InSocket;
    end;

    Items[i].Event:= WiiMote_NONE;
  end;

  if (select(highest_fd + 1, @fds, nil, nil, @tv) = -1) then
    raise Exception.Create('Unable to select() the wiimote interrupt socket(s)');

  // check each socket for an event
  for i:=0 to Count-1 do begin
    // if this wiimote is not connected, skip it
    if not Items[i].Connected then
      continue;

    if (FD_ISSET(Items[i].InSocket, fds)) then begin
      // clear out the event buffer
      FillByte(Items[i].EventBuf[0],32,0);

      // read the pending message into the buffer
      r := fprecv(Items[i].InSocket,@Items[i].EventBuf[0], 32,0);
      if (r = -1) then begin
        // error reading data
        writeln('Receiving wiimote data '+IntToStr(Items[i].ID));
        // remote disconnect
        Items[i].Disconnect;
        Result:=true;
        continue;
      end;

      // propagate the event
      if Items[i].EventBuf[1]<>0 then begin
        Items[i].HandleEvents;
        Result:=true;
      end;
    end else begin
      //idle_cycle(wm[i]);
    end;
  end;
end;

{ TWiimotes }

function TWiimotes.GetItems(Index: integer): TWiimote;
begin
  Result:=TWiimote(FItems[Index]);
end;

constructor TWiimotes.Create;
begin
  FItems:=TFPList.Create;
end;

destructor TWiimotes.Destroy;
var
  i: Integer;
begin
  for i:=0 to FItems.Count-1 do TObject(FItems[i]).Free;
  FreeAndNil(FItems);
  inherited Destroy;
end;

function TWiimotes.Add(Item: TWiimote): integer;
begin
  Item.ID:=Count;
  Item.WiiMotes:=Self;
  Result:=FItems.Add(Item);
end;

function TWiimotes.Count: integer;
begin
  Result:=FItems.Count;
end;

{ TWiimote }

procedure TWiimote.SetLEDs(const AValue: integer);
var
  buf: byte;
begin
  // remove the lower 4 bits because they control rumble
  FLEDs:=AValue and $F0;
  // make sure if the rumble is on that we keep it on
  if Rumble then
    FLEDs := FLEDs or 1;

  if Connected then begin
    buf := FLEDs;
    SendCmd(WM_CMD_LED, @buf, 1);
  end;
end;

function TWiimote.Connect: boolean;
var
  Addr: sockaddr_l2;
begin
  Addr.l2_family:=AF_BLUETOOTH;
  Addr.l2_bdaddr:=bdaddr;

  // OUTPUT CHANNEL
  OutSocket:=fpsocket(AF_BLUETOOTH, SOCK_SEQPACKET, BTPROTO_L2CAP);
  if (OutSocket = -1) then
    exit(false);

  {$IFDEF BIG_ENDIAN}
  {$ERROR ToDo BIG_ENDIAN}
  {$ENDIF}
  Addr.l2_psm := WM_OUTPUT_CHANNEL; // htobs

  // connect to wiimote
  if (fpconnect(OutSocket, psockaddr(@addr), SizeOf(addr)) < 0) then
    raise Exception.Create('fpconnect output');

  // INPUT CHANNEL
  InSocket:=fpsocket(AF_BLUETOOTH, SOCK_SEQPACKET, BTPROTO_L2CAP);
  if (InSocket = -1) then begin
    CloseSocket(OutSocket);
    OutSocket := -1;
    exit(false);
  end;

  Addr.l2_psm := WM_INPUT_CHANNEL; // htobs

  // connect to wiimote
  if (fpconnect(InSocket, psockaddr(@addr), SizeOf(addr)) < 0) then
  begin
    CloseSocket(OutSocket);
    OutSocket := -1;
    raise Exception.Create('fpconnect input');
  end;

  writeln('Connected to wiimote ',ID);

  // do the handshake
  Connected:=true;

  EnableHandshake;
  RealizeReportType;

  Result:=true;
end;

procedure TWiimote.Disconnect;
begin
  if not Connected then exit;

  CloseSocket(OutSocket);
  CloseSocket(InSocket);

  OutSocket:=-1;
  InSocket:=-1;

  Connected:=false;
  Handshaking:=false;
  HandshakeComplete:=false;
  FRealizedIR:=false;
end;

procedure TWiimote.EnableHandshake;
begin
  // send request to wiimote for accelerometer calibration

  Handshaking:=true;
  SetLEDs(WIIMOTE_LED_ALL);
  RequestRead(@OnHandShake,WM_MEM_OFFSET_CALIBRATION, 7);

  //WiiMote_read_data(wm, WiiMote_handshake, buf, WM_MEM_OFFSET_CALIBRATION, 7);
  //inc(WiiMote.Handshake_State);

  //WiiMote_set_leds(wm, WIIMOTE_LED_NONE);
end;

function TWiimote.RealizeReportType: boolean;
var
  buf: array[0..1] of byte;
begin
  if not Connected then exit(false);

  if Continuous then
    buf[0] := 4 // set to 0x04 for continuous reporting
  else
    buf[0] :=0;
  buf[1] := 0;

  // if rumble is enabled, make sure we keep it
  if Rumble then
    buf[0] := buf[0] or 1;

  if ReportMotion    then buf[1] := buf[1] or WM_RPT_BTN_ACC;
  if ReportExpansion then buf[1] := buf[1] or WM_RPT_BTN_EXP;
  if ReportIR        then buf[1] := buf[1] or WM_RPT_BTN_IR;
  writeln('TWiiMote.RealizeReportType ',buf[1]);

  if SendCmd(WM_CMD_REPORT_TYPE,@buf[0],2)<=0 then begin
    writeln('TWiiMote.RealizeReportType FAILED');
    exit(false);
  end;

  Result:=true;
end;

procedure TWiimote.RealizeIR;
var
  buf: byte;
begin
  if not HandshakeComplete then begin
    writeln('TWiiMote.EnableIR still handshaking');
    exit;
  end;
  
  if ReportIR=FRealizedIR then exit;

  writeln('TWiiMote.RealizeIR ReportIR=',ReportIR);
  
  // set camera 1 and 2
  if ReportIR then
    buf:=4
  else
    buf:=0;
  SendCmd(WM_CMD_IR,@buf,1);
  SendCmd(WM_CMD_IR_2,@buf,1);

  if ReportIR then begin
    // enable IR, set sensitivity
    buf:=8;
    SendData(WM_REG_IR,@buf,1);

    // wait for the wiimote to catch up
    Sleep(50);

    // write sensitivity blocks
    SendData(WM_REG_IR_BLOCK1, Pointer(WM_IR_BLOCK1_CLIFF), length(WM_IR_BLOCK1_CLIFF));
    SendData(WM_REG_IR_BLOCK2, Pointer(WM_IR_BLOCK2_CLIFF), length(WM_IR_BLOCK2_CLIFF));

    // set the IR mode
    if ReportExpansion then
      buf := WM_IR_TYPE_BASIC
    else
      buf := WM_IR_TYPE_EXTENDED;
    SendData(WM_REG_IR_MODENUM,@buf,1);

    // wait for the wiimote to catch up
    Sleep(50);

    // set the wiimote report type
    RealizeReportType;
    writeln('TWiiMote.RealizeIR IR enabled');
  end;
end;

procedure TWiimote.HandleEvents;
var
  Data: PByte;
  i: Integer;
begin
  // don't know what WiiMote.EventBuf[0] is
  case EventBuf[1] of

  WM_RPT_CTRL_STATUS:
    begin
      writeln('TWiiMote.HandleEvent WM_RPT_CTRL_STATUS');
    end;

  WM_RPT_READ:
    begin
      writeln('TWiiMote.HandleEvent WM_RPT_READ');
      HandleRead;
    end;

  WM_RPT_WRITE:
    begin
      writeln('TWiiMote.HandleEvent WM_RPT_WRITE');
    end;

  WM_RPT_BTN:
    begin
      Buttons:=PWord(@EventBuf[2])^ and WIIMOTE_BUTTON_ALL;
      writeln('TWiiMote.HandleEvent Button ',Buttons);
    end;

  WM_RPT_BTN_ACC or WM_RPT_BTN_IR:
    begin
      Buttons:=PWord(@EventBuf[2])^ and WIIMOTE_BUTTON_ALL;
      Accel.x:=EventBuf[4];
      Accel.y:=EventBuf[5];
      Accel.z:=EventBuf[6];
      // 7,8,9,10
      Data:=PByte(@EventBuf[7]);
      for i := 0 to 3 do begin
        Dots[i].x := 1023 - (data[3*i] or ((data[(3*i)+2] and $30) shl 4));
        Dots[i].y := data[(3*i)+1] or ((data[(3*i)+2] and $C0) shl 2);

        Dots[i].size := data[(3*i)+2] and $0F;

        // if in range set to visible
        Dots[i].visible := (Dots[i].y <> 1023);
        //if dot[i].visible then write(' ',dot[i].rx,' ',dot[i].ry,' ',dot[i].size,' ',dot[i].visible);
      end;
      //for i:=0 to 20 do write(IntToHex(ord(EventBuf[i]),2),' ');
      //writeln(' TWiiMotes.HandleEvent x=',Accel.x,' y=',Accel.y,' z=',Accel.z);
      //Sleep(300);
    end;

  else
    writeln('TWiiMotes.HandleEvent other decimal=',EventBuf[1],' hex=',IntToHex(EventBuf[1],2));
  end;
end;

procedure TWiimote.HandleRead;
var
  Error: byte;
  len: byte;
  offset: word;
  Request: TWiiMoteReadRequest;
begin
  // always assume the packet received is from the most recent request

  Buttons:=PWord(@EventBuf[2])^ and WIIMOTE_BUTTON_ALL;

  // if we don't have a request out then we didn't ask for this packet
  if FReadRequests.Count=0 then begin
    writeln('TWiiMote.HandleRead Received data packet whithout request');
    exit;
  end;

  Error := EventBuf[4] and $0F;
....................... y sigue

En la linea en rojo me da el error de compilación:

/home/heppy/Downloads/bluetooth/wiimotetools.pas(311,5) Error: Fields cannot appear after a method or property definition, start a new visibility section first

Por más que lo miro y lo remiro, no encuentro solución.

Gracias y disculpad por el chorizo código.