added bluetooth

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2729 8e941d3f-bd1b-0410-a28a-d453659cc2b4

examples/bluetooth/README.txt

@@ -0,0 +1,15 @@
+The is the source directory of the bluetoothlaz package.
+The package and examples are licensed under the modified LGPL. See the headers
+of the the files.
+
+At the moment it only supports linux.
+
+Prerequisites:
+
+For linux you need the BlueZ devel package.
+Under ubuntu/debian it is called: libbluetooth-dev
+For example:
+  sudo apt-get install libbluetooth-dev
+
+There is an example showing the access of a wii-remote.
+

examples/bluetooth/bluetoothlaz.lpk

@@ -0,0 +1,46 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="3">
+    <Name Value="bluetoothlaz"/>
+    <CompilerOptions>
+      <Version Value="5"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <CodeGeneration>
+        <Generate Value="Faster"/>
+      </CodeGeneration>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Files Count="3">
+      <Item1>
+        <Filename Value="bluetooth.pas"/>
+        <UnitName Value="Bluetooth"/>
+      </Item1>
+      <Item2>
+        <Filename Value="wiimotetools.pas"/>
+        <UnitName Value="WiiMoteTools"/>
+      </Item2>
+      <Item3>
+        <Filename Value="README.txt"/>
+        <Type Value="Binary"/>
+      </Item3>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item1>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

examples/bluetooth/bluetoothlaz.pas

@@ -0,0 +1,20 @@
+{ This file was automatically created by Lazarus. Do not edit!
+This source is only used to compile and install the package.
+ }
+
+unit bluetoothlaz; 
+
+interface
+
+uses
+  Bluetooth, WiiMoteTools, LazarusPackageIntf; 
+
+implementation
+
+procedure Register; 
+begin
+end; 
+
+initialization
+  RegisterPackage('bluetoothlaz', @Register); 
+end.

examples/bluetooth/create_zip.sh

@@ -0,0 +1,27 @@
+#!/usr/bin/env bash
+
+set -e
+
+TmpDir=/tmp/bluetoothlaz
+rm -rf $TmpDir
+mkdir -p $TmpDir
+
+rsync -av --exclude=".svn" ../bluetooth $TmpDir/
+
+for Ext in ppu o a compiled exe rst zip tgz bak lps;do
+  find $TmpDir -name "*.$Ext" -exec rm {} \;
+done
+find $TmpDir -name "*~" -exec rm {} \;
+# remove all programs without extension
+find . -type f -perm -100 -iregex '.*\/[a-z]+$' -exec rm {} \;
+
+TargetFile=$(pwd)/bluetoothlaz.zip
+rm -f $TargetFile
+cd $TmpDir
+zip -r $TargetFile bluetooth
+cd -
+
+echo "Created: $TargetFile"
+
+# end.
+

examples/bluetooth/examples/headtracking/mainunit.lfm

@@ -0,0 +1,12 @@
+object Form1: TForm1
+  Left = 304
+  Height = 666
+  Top = 232
+  Width = 946
+  HorzScrollBar.Page = 945
+  VertScrollBar.Page = 665
+  Caption = 'VR Headtracking Demo mit der Wii Remote'
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '0.9.25'
+end

examples/bluetooth/examples/headtracking/mainunit.lrs

@@ -0,0 +1,8 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'0'#1#6'Height'#3#154#2#3'Top'#3#232#0#5'W'
+  +'idth'#3#178#3#18'HorzScrollBar.Page'#3#177#3#18'VertScrollBar.Page'#3#153#2
+  +#7'Caption'#6'''VR Headtracking Demo mit der Wii Remote'#8'OnCreate'#7#10'Fo'
+  +'rmCreate'#9'OnDestroy'#7#11'FormDestroy'#10'LCLVersion'#6#6'0.9.25'#0#0
+]);

examples/bluetooth/examples/headtracking/mainunit.pas

@@ -0,0 +1,456 @@
+{ Demonstrating VR Headtracking with a wii-remote.
+
+  Copyright (C) 2008 Mattias Gaertner mattias@freepascal.org
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit MainUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Math, LResources, LCLProc, Forms, Controls, Graphics,
+  Dialogs, ExtCtrls, FPimage, IntfGraphics, StdCtrls, LCLType,
+  WiiMoteTools,
+  OpenGLContext, Vectors, Asmoday, AsmTypes, AsmShaders;
+
+type
+
+  { THeadtrackingCamera }
+
+  THeadtrackingCamera = class(TRotationCamera)
+  public
+    procedure RotateAboutView(Angle: single);
+    procedure SetRoll(Angle: single);
+  end;
+
+  THeadTrackingDot = record
+    X, Y: integer;
+    Size: integer;// negative or 0 means not visible
+  end;
+  
+  THeadTrackingDots = array[1..4] of THeadTrackingDot;
+  
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    OpenGLControl1: TOpenGLControl;
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure OnIdle(Sender: TObject; var Done: Boolean);
+    procedure OpenGLControl1KeyDown(Sender: TObject; var Key: Word;
+      Shift: TShiftState);
+    procedure OpenGLControl1Paint(Sender: TObject);
+    procedure OpenGLControl1Resize(Sender: TObject);
+  private
+    fInitialized: Boolean;
+    procedure ConnectWiiMotes;
+    procedure DisconnectWiiMotes;
+    procedure UpdateHeadtracking;
+    procedure UpdateSceneHeadTracking;// set camera
+    procedure Init;
+  public
+    EnableRotation: boolean;
+  
+    WiiMotes: TWiimotes;
+    Dots: array[1..5] of THeadTrackingDots;
+
+    Camera: THeadtrackingCamera;
+    CameraAngleRot: single;
+    CameraAngleX: single;
+    CameraAngleY: single;
+    Scene: TScene;
+
+    // Die letzten Kameraeinstellungen ueber denen gemittelt wird:
+    OldAngleX: array[0..4] of single;
+    OldAngleY: array[0..4] of single;
+    OldCamDist: array[0..4] of single;
+  end;
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  OpenGLControl1:=TOpenGLControl.Create(Self);
+  with OpenGLControl1 do begin
+    Name:='OpenGLControl1';
+    Align:=alClient;
+    Parent:=Self;
+    OnPaint:=@OpenGLControl1Paint;
+    OnResize:=@OpenGLControl1Resize;
+    OnKeyDown:=@OpenGLControl1KeyDown;
+  end;
+
+  ConnectWiiMotes;
+  Application.AddOnIdleHandler(@OnIdle);
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  DisconnectWiiMotes;
+end;
+
+procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean);
+var
+  i: Integer;
+begin
+  if WiiMotes<>nil then begin
+    for i:=1 to 100 do begin
+      if not WiiMotes.HandleEvents then break;
+      UpdateHeadtracking;
+    end;
+    Done:=false;
+  end;
+end;
+
+procedure TForm1.OpenGLControl1KeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  case Key of
+  VK_ESCAPE: Close;
+  VK_R:
+    begin
+      EnableRotation:=not EnableRotation;
+      OpenGLControl1.Invalidate;
+    end;
+  end;
+end;
+
+procedure TForm1.OpenGLControl1Paint(Sender: TObject);
+begin
+  // Initialize the Scene if not already done
+  if not fInitialized then Init;
+  // update head tracking position
+  UpdateSceneHeadTracking;
+  // Render the scene
+  Scene.RenderScene;
+end;
+
+procedure TForm1.OpenGLControl1Resize(Sender: TObject);
+begin
+  // on a resize we want to update our viewport and redraw it
+  if fInitialized then begin
+    Scene.UpdateViewport;
+    OpenGLControl1.Invalidate;
+  end;
+end;
+
+procedure TForm1.ConnectWiiMotes;
+var
+  connected: LongInt;
+  i: Integer;
+begin
+  Wiimotes:=TWiimotes.Create;
+  try
+    Wiimotes.FindWiiMotes(5);
+    connected := WiiMotes.Connect;
+    if connected>0 then
+      writeln('Connected to ',connected,' of ',WiiMotes.Count,' wiimotes.')
+    else
+      raise Exception.Create('Failed to connect to any wiimote.');
+
+    // Now set the LEDs for a second so it's easy
+    // to tell which wiimotes are connected
+    for i:=0 to 3 do begin
+      if i<Wiimotes.Count then
+        case i of
+        0: Wiimotes[i].SetLEDs(WIIMOTE_LED_1);
+        1: Wiimotes[i].SetLEDs(WIIMOTE_LED_2);
+        2: Wiimotes[i].SetLEDs(WIIMOTE_LED_3);
+        3: Wiimotes[i].SetLEDs(WIIMOTE_LED_4);
+        end;
+    end;
+    Wiimotes[0].ReportIR:=true;
+    Wiimotes[0].ReportMotion:=true;
+    Wiimotes[0].RealizeReportType;
+    // already done in handshake, not needed here: WiiMotes[0].RealizeIR;
+  except
+    on E: Exception do begin
+      DebugLn(['TForm1.ConnectWiiMotes ERROR: ',E.Message]);
+      MessageDlg('Connection failed: '+E.Message,mtError,[mbCancel],0);
+    end;
+  end;
+end;
+
+procedure TForm1.DisconnectWiiMotes;
+begin
+  WiiMotes.Disconnect;
+  FreeAndNil(WiiMotes);
+end;
+
+procedure TForm1.UpdateHeadtracking;
+var
+  WiiMote: TWiiMote;
+  NewDots: array[1..4] of THeadTrackingDot;
+  i: Integer;
+  DotsChanged: Boolean;
+begin
+  NewDots[1].x:=0;
+  FillByte(NewDots[1],SizeOf(THeadTrackingDot)*4,0);
+  if (WiiMotes<>nil) and (WiiMotes.Count>0) and (WiiMotes[0].Connected) then
+  begin
+    WiiMote:=WiiMotes[0];
+    for i:=1 to 4 do begin
+      NewDots[i].x:=WiiMote.Dots[i-1].x;
+      NewDots[i].y:=WiiMote.Dots[i-1].y;
+      NewDots[i].Size:=WiiMote.Dots[i-1].Size;
+      if not WiiMote.Dots[i-1].Visible then
+        NewDots[i].Size:=0;
+    end;
+  end;
+  // check for changes
+  DotsChanged:=false;
+  for i:=1 to 4 do begin
+    if (Dots[5][i].X<>NewDots[i].X)
+    or (Dots[5][i].Y<>NewDots[i].Y)
+    or (Dots[5][i].Size<>NewDots[i].Size)
+    then
+      DotsChanged:=true;
+    Dots[5][i]:=NewDots[i];
+  end;
+  //DebugLn(['TForm1.UpdateHeadtracking ']);
+  if DotsChanged then
+    OpenGLControl1.Invalidate;
+end;
+
+procedure TForm1.UpdateSceneHeadTracking;
+var
+  Distance: single;
+  CamDist: single;
+  dx: Integer;
+  dy: Integer;
+  Angle: single;
+  CenterX: Integer;
+  CenterY: Integer;
+  AngleX: single;
+  AngleY: single;
+  SmoothDots: THeadTrackingDots;
+  TimeID: Integer;
+  DotID: Integer;
+  i: Integer;
+  NewAngleX: single;
+  NewAngleY: single;
+  NewCamDist: single;
+begin
+  SmoothDots:=Dots[5];
+  if (SmoothDots[1].Size>0) and (SmoothDots[2].Size>0) then begin
+    // last point valid
+
+    // compute average of last 5 states
+    for DotID:=1 to 4 do begin
+      for TimeID:=1 to 4 do begin
+        inc(SmoothDots[DotID].X,Dots[TimeID][DotID].X);
+        inc(SmoothDots[DotID].Y,Dots[TimeID][DotID].Y);
+      end;
+      SmoothDots[DotID].X:=SmoothDots[DotID].X div 5;
+      SmoothDots[DotID].Y:=SmoothDots[DotID].Y div 5;
+    end;
+  
+    // use the two best dots
+    // x: 0-1023
+    // y: 0-768
+    
+    dx:=SmoothDots[2].x-SmoothDots[1].x;
+    dy:=SmoothDots[2].y-SmoothDots[1].y;
+
+    // Distance: 170-800 map to 4-0.1
+    Distance:=Max(1,Sqrt(Sqr(dx)+Sqr(dy)));
+    CamDist:=Power(500/Distance,1.5);
+
+    // Position
+    // WiiMote has 45degree field of view. Map it to 90degree so the user can see more.
+    CenterX:=(SmoothDots[1].x+SmoothDots[2].x) div 2;
+    CenterY:=(SmoothDots[1].y+SmoothDots[2].y) div 2;
+    CenterX:=CenterX-(1024 div 2);
+    CenterY:=CenterY-(768 div 2);
+    AngleX:=CenterX*90/1024;
+    AngleY:=CenterY*90/768;
+
+    // Angle
+    if dx=0 then
+      Angle:=90
+    else
+      Angle:=-radtodeg(arctan(dy/dx));
+
+    //DebugLn(['TForm1.UpdateSceneHeadTracking AngleX=',AngleX,' AngleY=',AngleY,' AngleRot=',Angle,' CamDist=',CamDist,' dx=',dx,' dy=',dy,' Size1=',SmoothDots[1].Size,' Size2=',SmoothDots[2].Size]);
+    
+    NewAngleX:=0;
+    NewAngleY:=0;
+    NewCamDist:=0;
+    
+    for i := 0 to 4 do begin
+      NewAngleX:=NewAngleX+OldAngleX[i];
+      NewAngleY:=NewAngleY+OldAngleY[i];
+      NewCamDist:=NewCamDist+OldCamDist[i];
+    end;
+    
+    NewAngleX:=NewAngleX/5;
+    NewAngleY:=NewAngleY/5;
+    NewCamDist:=NewCamDist/5;
+    
+    // NewAngel = SmoothedValues
+    // Angle = original Values
+    Camera.Alpha:=NewAngleX;
+    Camera.Beta:=90-NewAngleY;
+    Camera.Radius:=NewCamDist;
+    if EnableRotation then
+      Camera.SetRoll(Angle)
+    else
+      Camera.SetRoll(0);
+
+    for i := 1 to 4 do begin
+      OldAngleX[i-1]:=OldAngleX[i];
+      OldAngleY[i-1]:=OldAngleY[i];
+      OldCamDist[i-1]:=OldCamDist[i];
+    end;
+    
+    OldAngleX[4]:=AngleX;
+    OldAngleY[4]:=AngleY;
+    OldCamDist[4]:=CamDist;
+    // move old values down
+    for i:=1 to 4 do
+      Dots[i]:=Dots[i+1];
+
+  end else begin
+    // not enough data
+  end;
+end;
+
+procedure TForm1.Init;
+var
+  CubeMesh: TMesh;
+  i: Integer;
+  k: Integer;
+  Model: TAsmObject;
+  Light: TDirectionalLight;
+begin
+  // Create and intialize the scene
+  Scene := TScene.Create(OpenGLControl1);
+  Scene.Init;
+  writeln('GL Version: ', Scene.Version);
+  writeln('Max Indicies: ', Scene.MaxIndex);
+  writeln('Max Verticies: ', Scene.MaxVertex);
+
+  // Set up our camera at (0, 0, 3), let it look at the origin as there our
+  // cube will be placed. The field of view is 45 degree and the near and far plane
+  // are at 1 unit in front of our camera and 100 units respectively (this means
+  // only objects between 1 and 100 units in front of our camera are visible)
+  Camera := THeadtrackingCamera.Create(3, 0,  0, 0, 0, 45, 0.1, 100);
+  //Camera := T6DOFCamera.Create(0,0,3,45,0.1,100);
+  Scene.ActiveCamera := Camera;
+  
+  Scene.SetSkybox('neg_z.bmp','pos_z.bmp','neg_x.bmp','pos_x.bmp','pos_y.bmp','neg_y.bmp');
+
+  // load obj
+  // We need a mesh that holds the geometry information
+  CubeMesh := TMesh.Create;
+  // Let Asmoday create a unitcube for us
+  CubeMesh.LoadMeshFromObjFile('bunny.obj');
+
+  // Now lets set up our object
+  for i:=1 to 3 do begin
+    for k:=1 to 3 do begin
+      Model := TAsmObject.Create;
+      // Tell it where to find the geometry
+      Model.Mesh := CubeMesh;
+      // Color it gray
+      Model.SetColor(150, 150, 150, 255);
+      // Every object needs a shader, so that Asmoday knows how to render it
+      // Our models should be rendered with lighting
+      Model.Shader := ShaderLighting;
+      // Make it visible
+      Model.Visible := true;
+
+      Model.SetScale(5,5,5);
+      Model.RotateAboutLocalX(90);
+      Model.SetPosition(i-2,0,k-2);
+      // Add the object to the scene
+      Scene.Objectlist.Add(Model);
+    end;
+  end;
+
+  // Now we need a light
+  Light := TDirectionalLight.Create;
+  // Directional lights don't really have a position, they just emit parallel
+  // light rays. SetPosition is used to set the direction of this rays. The
+  // direction is the vector from the position to the origin.
+  Light.SetPosition(-0.5, 5, 1);
+  // Enable the light
+  Light.Enabled := true;
+  // set ambient
+  Light.SetAmbientColor(55,55,55,255);
+  // And add it to the scene
+  Scene.Lightlist.Add(Light);
+
+  Finitialized := true;
+end;
+
+{ THeadtrackingCamera }
+
+procedure THeadtrackingCamera.RotateAboutView(Angle: single);
+var
+  View: TVector3;
+  Right: TVector3;
+begin
+  UpdatePosition;
+  View:=fCoV-fPosition;
+  Normalize(View);
+  Right:=Normalized(CrossProduct(View,Up));
+  Rotate(Right,View,Angle);
+  Normalize(Right);
+  // create orthogonal Up
+  fUp:=CrossProduct(Right,View);
+  Normalize(fUp);
+end;
+
+procedure THeadtrackingCamera.SetRoll(Angle: single);
+var
+  View: TVector3;
+  Right: TVector3;
+begin
+  UpdatePosition;
+  View:=fCoV-fPosition;
+  Normalize(View);
+  Right:=Normalized(CrossProduct(View,UnitVectorY));
+  Rotate(Right,View,Angle);
+  Normalize(Right);
+  // create orthogonal Up
+  fUp:=CrossProduct(Right,View);
+  Normalize(fUp);
+end;
+
+initialization
+  {$I mainunit.lrs}
+
+end.
+

examples/bluetooth/examples/headtracking/wiimoteasmodaytest1.lpi

@@ -0,0 +1,73 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <SessionStorage Value="InIDEConfig"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="wiimoteasmodaytest1"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="asmodaypkg"/>
+        <DefaultFilename Value="../../../asmoday/asmodaypkg.lpk"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="bluetoothlaz"/>
+        <MinVersion Valid="True"/>
+        <DefaultFilename Value="../../bluetoothlaz.lpk"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="wiimoteasmodaytest1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="WiimoteAsmodayTest1"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="mainunit.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="mainunit.lrs"/>
+        <UnitName Value="MainUnit"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

examples/bluetooth/examples/headtracking/wiimoteasmodaytest1.lpr

@@ -0,0 +1,18 @@
+program WiimoteAsmodayTest1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { you can add units after this }, MainUnit, bluetoothlaz;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

examples/bluetooth/examples/infrared/mainunit.lfm

@@ -0,0 +1,29 @@
+object Form1: TForm1
+  Left = 304
+  Height = 363
+  Top = 232
+  Width = 401
+  HorzScrollBar.Page = 400
+  VertScrollBar.Page = 362
+  Caption = 'Wii Remote IR dots'
+  ClientHeight = 363
+  ClientWidth = 401
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '0.9.25'
+  object GroupBox1: TGroupBox
+    Height = 363
+    Width = 401
+    Align = alClient
+    Caption = 'Dots'
+    ClientHeight = 344
+    ClientWidth = 397
+    TabOrder = 0
+    object WorldPaintBox: TPaintBox
+      Height = 344
+      Width = 397
+      Align = alClient
+      OnPaint = WorldPaintBoxPaint
+    end
+  end
+end

examples/bluetooth/examples/infrared/mainunit.lrs

@@ -0,0 +1,13 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'0'#1#6'Height'#3'k'#1#3'Top'#3#232#0#5'Wi'
+  +'dth'#3#145#1#18'HorzScrollBar.Page'#3#144#1#18'VertScrollBar.Page'#3'j'#1#7
+  +'Caption'#6#18'Wii Remote IR dots'#12'ClientHeight'#3'k'#1#11'ClientWidth'#3
+  +#145#1#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#10'LCLVer'
+  +'sion'#6#6'0.9.25'#0#9'TGroupBox'#9'GroupBox1'#6'Height'#3'k'#1#5'Width'#3
+  +#145#1#5'Align'#7#8'alClient'#7'Caption'#6#4'Dots'#12'ClientHeight'#3'X'#1#11
+  +'ClientWidth'#3#141#1#8'TabOrder'#2#0#0#9'TPaintBox'#13'WorldPaintBox'#6'Hei'
+  +'ght'#3'X'#1#5'Width'#3#141#1#5'Align'#7#8'alClient'#7'OnPaint'#7#18'WorldPa'
+  +'intBoxPaint'#0#0#0#0
+]);

examples/bluetooth/examples/infrared/mainunit.pas

@@ -0,0 +1,205 @@
+{ Demonstrating reading the infrared sensors of a wii-remote.
+
+  Copyright (C) 2008 Mattias Gaertner mattias@freepascal.org
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+unit MainUnit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, LCLProc, Forms, Controls, Graphics, Dialogs,
+  ExtCtrls, FPimage, IntfGraphics, WiiMoteTools, StdCtrls;
+
+type
+  THeadTrackingDot = record
+    X, Y: integer;
+    Size: integer;// negative or 0 means not visible
+  end;
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    GroupBox1: TGroupBox;
+    WorldPaintBox: TPaintBox;
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure OnIdle(Sender: TObject; var Done: Boolean);
+    procedure WorldPaintBoxPaint(Sender: TObject);
+  private
+    procedure ConnectWiiMotes;
+    procedure DisconnectWiiMotes;
+    procedure UpdateHeadtracking;
+  public
+    WiiMotes: TWiiMotes;
+    Dots: array[1..4] of THeadTrackingDot;
+  end;
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  ConnectWiiMotes;
+  Application.AddOnIdleHandler(@OnIdle);
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  DisconnectWiiMotes;
+end;
+
+procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean);
+var
+  i: Integer;
+begin
+  if WiiMotes<>nil then begin
+    for i:=1 to 100 do begin
+      if not WiiMotes.HandleEvents then break;
+      UpdateHeadtracking;
+    end;
+    Done:=false;
+  end;
+end;
+
+procedure TForm1.WorldPaintBoxPaint(Sender: TObject);
+var
+  i: Integer;
+  Size: Integer;
+  X: Integer;
+  Y: Integer;
+begin
+  //DebugLn(['TForm1.WorldPaintBoxPaint ']);
+  if WiiMotes=nil then begin
+    WorldPaintBox.Canvas.TextOut(10,200,'not connected');
+  end else begin
+    for i:=1 to 4 do begin
+      if Dots[i].Size>0 then begin
+        case i of
+        1: Canvas.Brush.Color:=clYellow;
+        2: Canvas.Brush.Color:=clRed;
+        3: Canvas.Brush.Color:=clGreen;
+        4: Canvas.Brush.Color:=clBlue;
+        end;
+        X:=(WorldPaintBox.Width*Dots[i].X) div 1024;
+        Y:=(WorldPaintBox.Height*Dots[i].Y) div 768;
+        Size:=Dots[i].Size;
+        Canvas.Ellipse(X-Size,Y-Size,X+Size,Y+Size);
+      end;
+    end;
+  end;
+end;
+
+procedure TForm1.ConnectWiiMotes;
+var
+  connected: LongInt;
+  i: Integer;
+begin
+  WiiMotes:=TWiiMotes.Create;
+  try
+    WiiMotes.FindWiiMotes(5);
+    connected := WiiMotes.Connect;
+    if connected>0 then
+      writeln('Connected to ',connected,' of ',WiiMotes.Count,' wiimotes.')
+    else
+      raise Exception.Create('Failed to connect to any wiimote.');
+
+    // Now set the LEDs for a second so it's easy
+    // to tell which wiimotes are connected
+    for i:=0 to 3 do begin
+      if i<WiiMotes.Count then
+        case i of
+        0: WiiMotes[i].SetLEDs(WIIMOTE_LED_1);
+        1: WiiMotes[i].SetLEDs(WIIMOTE_LED_2);
+        2: WiiMotes[i].SetLEDs(WIIMOTE_LED_3);
+        3: WiiMotes[i].SetLEDs(WIIMOTE_LED_4);
+        end;
+    end;
+    WiiMotes[0].ReportIR:=true;
+    WiiMotes[0].ReportMotion:=true;
+    WiiMotes[0].RealizeReportType;
+    // already done in handshake, not needed here: WiiMotes[0].RealizeIR;
+  except
+    on E: Exception do begin
+      DebugLn(['TForm1.ConnectWiiMotes ERROR: ',E.Message]);
+      MessageDlg('Connection failed: '+E.Message,mtError,[mbCancel],0);
+    end;
+  end;
+end;
+
+procedure TForm1.DisconnectWiiMotes;
+begin
+  WiiMotes.Disconnect;
+  FreeAndNil(WiiMotes);
+end;
+
+procedure TForm1.UpdateHeadtracking;
+var
+  WiiMote: TWiiMote;
+  NewDots: array[1..4] of THeadTrackingDot;
+  i: Integer;
+  DotsChanged: Boolean;
+begin
+  NewDots[1].x:=0;
+  FillByte(NewDots[1],SizeOf(THeadTrackingDot)*4,0);
+  if (WiiMotes<>nil) and (WiiMotes.Count>0) and (WiiMotes[0].Connected) then
+  begin
+    WiiMote:=WiiMotes[0];
+    for i:=1 to 4 do begin
+      NewDots[i].x:=WiiMote.Dots[i-1].x;
+      NewDots[i].y:=WiiMote.Dots[i-1].y;
+      NewDots[i].Size:=WiiMote.Dots[i-1].Size;
+      if not WiiMote.Dots[i-1].Visible then
+        NewDots[i].Size:=0;
+    end;
+  end;
+  // check for changes
+  DotsChanged:=false;
+  for i:=1 to 4 do begin
+    if (Dots[i].X<>NewDots[i].X)
+    or (Dots[i].Y<>NewDots[i].Y)
+    or (Dots[i].Size<>NewDots[i].Size)
+    then
+      DotsChanged:=true;
+    Dots[i]:=NewDots[i];
+  end;
+  //DebugLn(['TForm1.UpdateHeadtracking X=',Dots[1].X,' Y=',Dots[1].Y,' Size=',Dots[1].Size]);
+  if DotsChanged then
+    WorldPaintBox.Invalidate;
+end;
+
+initialization
+  {$I mainunit.lrs}
+
+end.
+

examples/bluetooth/examples/infrared/wiimotetestproject.lpi

@@ -0,0 +1,68 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <SessionStorage Value="InIDEConfig"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="bluetoothlaz"/>
+        <MinVersion Valid="True"/>
+        <DefaultFilename Value="../../bluetoothlaz.lpk"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="wiimotetestproject.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="WiimoteTestProject"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="mainunit.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="mainunit.lrs"/>
+        <UnitName Value="MainUnit"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

examples/bluetooth/examples/infrared/wiimotetestproject.lpr

@@ -0,0 +1,18 @@
+program WiimoteTestProject;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { you can add units after this }, MainUnit, bluetoothlaz;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+