NPIdea
24-02-2012, 13:35:37
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)
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.
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)
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.