XBMC USB Controller solderpad
xbmc-usb-controller / Controller / dmMain.~pas
//******************************************************************************
// XBMC USB Controller for Windows.
// Copyright � 2011 Dilshan R Jayakody.
//
// This program is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later 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 General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with this program. If not, see <http://www.gnu.org/licenses/>.
//******************************************************************************
unit dmMain;
interface
uses
SysUtils, Classes, ExtCtrls, JvComponentBase, JvHidControllerClass, superobject,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, uSystem,
Windows, Messages, Forms, inifiles, JclStrings, AppEvnts, JvTrayIcon,
Menus, shellapi;
type
TdMain = class(TDataModule)
http_client: TIdHTTP;
hid_controller: TJvHidDeviceController;
event_capture: TTimer;
XBMCU_update: TTimer;
app_event: TApplicationEvents;
tray_icon: TJvTrayIcon;
try_menu: TPopupMenu;
mnuLog: TMenuItem;
mnuClose: TMenuItem;
N1: TMenuItem;
mnuAbout: TMenuItem;
procedure hid_controllerDeviceChange(Sender: TObject);
procedure hid_controllerRemoval(HidDev: TJvHidDevice);
procedure hid_controllerArrival(HidDev: TJvHidDevice);
procedure event_captureTimer(Sender: TObject);
function PostDataToXBMC(indata : string) : string;
procedure XBMCU_updateTimer(Sender: TObject);
procedure http_clientConnected(Sender: TObject);
procedure hid_controllerDeviceData(HidDev: TJvHidDevice;
ReportID: Byte; const Data: Pointer; Size: Word);
procedure ResetPlayerState();
function ConnectXBMC() : Boolean;
procedure RenderInfoToLCD();
procedure ResetLCD();
function WriteUSB : Boolean;
procedure ResetUSBDataBuffer();
procedure SetupSystemConfig();
procedure MapKeyTable();
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
procedure GetKeyMapData(instr : string; var mode_ : integer; var data_ : integer);
procedure app_eventException(Sender: TObject; E: Exception);
procedure SetXBMCVolumeLevel(isUp : Boolean; step_ : integer = 1);
procedure SetXBMCGoToHome();
procedure SetXBMCAudioMute();
procedure mnuCloseClick(Sender: TObject);
procedure mnuLogClick(Sender: TObject);
procedure try_menuPopup(Sender: TObject);
procedure mnuAboutClick(Sender: TObject);
private
xbmc_ : TXBMCInfo;
device_ : TUSBDeviceInfo;
player_data_buffer, player_ : TPlayerData;
device_online : Boolean;
usb_write_buf: array [0..64] of Byte;
controller_ : TJvHidDevice;
keymap : TList;
rotate_state : string;
public
procedure InitSystem();
end;
var
dMain: TdMain;
implementation
uses fmAbout;
{$R *.dfm}
procedure TdMain.GetKeyMapData(instr : string; var mode_ : integer; var data_ : integer);
var pos : integer;
begin
for pos := 0 to keymap.Count - 1 do begin
if(instr = PKeyInfo(keymap.Items[pos])^.ID) then begin
mode_ := PKeyInfo(keymap.Items[pos])^.Mode;
data_ := PKeyInfo(keymap.Items[pos])^.Data;
break;
end;
end;
end;
procedure TdMain.MapKeyTable();
var config_ini : TIniFile; val_list: TStringList; pos : integer; key_ptr : PKeyInfo;
val_ : string;
begin
config_ini := TIniFile.Create(Root+'\mcci.ini');
val_list := TStringList.Create;
config_ini.ReadSection('keymap',val_list);
keymap.Clear;
for pos := 0 to val_list.Count - 1 do begin
new(key_ptr);
key_ptr^.ID := val_list.Strings[pos];
val_ := config_ini.ReadString('keymap',val_list.Strings[pos],'0,0');
key_ptr^.Mode := StrToIntDef(val_[1],0);
key_ptr^.Data := StrToIntDef(trim(StrRight(val_,Length(val_)-2)),0);
keymap.Add(key_ptr);
end;
freeandnil(val_list);
end;
function TdMain.PostDataToXBMC(indata : string) : string;
var indata_container : TStringList;
begin
result := '';
indata_container := TStringList.Create;
indata_container.Add(indata);
try
result := http_client.Post('http://'+xbmc_.address+'/jsonrpc', indata_container)
except
event_capture.Enabled := false;
XBMCU_update.Enabled := true;
end;
freeandnil(indata_container);
end;
procedure TdMain.hid_controllerDeviceChange(Sender: TObject);
begin
if(not Assigned(controller_)) then begin
while(hid_controller.CheckOut(controller_))do begin
if((controller_.Attributes.VendorID = device_.VID) and (controller_.Attributes.ProductID = device_.PID))then begin
controller_.NumInputBuffers := 128;
controller_.NumOverlappedBuffers := 128;
LogMsg('USB Controller Interface is checkout');
break;
end;
end;
end;
end;
procedure TdMain.hid_controllerRemoval(HidDev: TJvHidDevice);
begin
if(device_online) then begin
if(((HidDev.Attributes.VendorID = device_.VID) and (HidDev.Attributes.ProductID = device_.PID)) and device_online) then begin
if(Assigned(controller_)) then
hid_controller.CheckIn(controller_);
device_online := false;
LogMsg('USB Controller Interface is removed');
end;
end;
end;
procedure TdMain.hid_controllerArrival(HidDev: TJvHidDevice);
begin
if((HidDev.Attributes.VendorID = device_.VID) and (HidDev.Attributes.ProductID = device_.PID)) then begin
device_online := true;
LogMsg('USB Controller Interface is detected');
end;
end;
procedure TdMain.event_captureTimer(Sender: TObject);
var rx_data : string; json_data : ISuperObject; playlist_item : int64;
player_str : string;
begin
try
if(device_online and ConnectXBMC) then begin
rx_data := PostDataToXBMC('{"jsonrpc": "2.0", "method": "Player.GetActivePlayers", "id": 1}');
if(rx_data <> '') then begin
json_data := SO(rx_data);
if((json_data.O['result'].O['audio'] <> nil)and(json_data.O['result'].O['video'] <> nil)and(json_data.O['result'].O['picture'] <> nil)) then begin
if(json_data.O['result'].B['audio']) then
player_.ActivePlayer := psAudio
else if(json_data.O['result'].B['video']) then
player_.ActivePlayer := psVideo
else if(json_data.O['result'].B['picture']) then
player_.ActivePlayer := psPicture
else
ResetPlayerState;
if(player_.ActivePlayer = psPicture) then begin
player_.Attrib1 := '';
player_.Title := '';
end else if((player_.ActivePlayer = psAudio) or (player_.ActivePlayer = psVideo)) then begin
if(player_.ActivePlayer = psAudio) then
player_str := '{"jsonrpc": "2.0", "method": "AudioPlaylist.GetItems", "params": { "fields": ["title", "artist"] }, "id": 1}'
else
player_str := '{"jsonrpc": "2.0", "method": "VideoPlaylist.GetItems", "params": { "fields": ["title"] }, "id": 1}';
rx_data := PostDataToXBMC(player_str);
if(rx_data <> '') then begin
json_data := SO(rx_data);
if(json_data.O['result'].O['state'] <> nil) then begin
player_.PlayMode := plPlay;
if(json_data.O['result'].O['state'].B['paused']) then
player_.PlayMode := plPause;
playlist_item := StrToIntDef(json_data.O['result'].O['state'].S['current'],-1);
player_.Attrib1 := '';
player_.Title := '';
if((playlist_item>-1) and (json_data.O['result'].O['items']<>nil)) then begin
if(player_.ActivePlayer = psAudio) then begin
player_.Title := trim(json_data.O['result'].A['items'].O[playlist_item].S['title']);
player_.Attrib1 := trim(json_data.O['result'].A['items'].O[playlist_item].S['artist']);
end else begin
player_.Title := trim(json_data.O['result'].A['items'].O[playlist_item].S['label']);
player_.Attrib1 := '';
end;
end;
end else begin
player_.PlayMode := plStop;
player_.Attrib1 := '';
player_.Title := '';
end;
end else
raise Exception.Create('Invalid return from Playlist.GetItems');
end;
end else
raise Exception.Create('Invalid JSON Player.GetActivePlayers result data');
end else
raise Exception.Create('Invalid return from Player.GetActivePlayers');
end;
except on ex_ : Exception do begin
ResetPlayerState;
LogMsg(ex_.Message, lgError);
end;
end;
if(device_online) then begin
if((player_data_buffer.ActivePlayer <> player_.ActivePlayer)or((player_data_buffer.PlayMode <> player_.PlayMode))or((player_data_buffer.Attrib1 <> player_.Attrib1))or((player_data_buffer.Title <> player_.Title))) then begin
if(player_.ActivePlayer = psNone) then
ResetLCD
else
RenderInfoToLCD;
end;
end;
player_data_buffer := player_;
end;
procedure TdMain.XBMCU_updateTimer(Sender: TObject);
begin
XBMCU_update.Enabled := not ConnectXBMC;
end;
procedure TdMain.http_clientConnected(Sender: TObject);
begin
if(not event_capture.Enabled) then begin
event_capture.Enabled := true;
XBMCU_update.Enabled := false;
end;
end;
procedure TdMain.hid_controllerDeviceData(HidDev: TJvHidDevice;
ReportID: Byte; const Data: Pointer; Size: Word);
var mode_, data_ : integer; xbmc_wnd: HWND; str_ : string; rotery_mode : byte;
begin
if((device_online and ConnectXBMC) and ((HidDev.Attributes.VendorID = device_.VID) and (HidDev.Attributes.ProductID = device_.PID))) then begin
if ((Cardinal(PChar(Data)[0]) = 184) and (Cardinal(PChar(Data)[1]) = 1)) then begin
str_ := inttostr(Cardinal(PChar(Data)[2]))+inttostr(Cardinal(PChar(Data)[3]))+inttostr(Cardinal(PChar(Data)[4]));
xbmc_wnd := FindWindow('xbmc', nil);
if((str_='110') or (str_='120') or (str_='200') or (str_='210') or (str_='220')) then begin
rotery_mode := 0;
if(rotate_state='110')and(str_='120')then begin
rotery_mode := 1;
rotate_state := '';
end else if(rotate_state='120')and(str_='110')then begin
rotery_mode := 2;
rotate_state := '';
end else
rotate_state := str_;
if(xbmc_wnd <> 0) then begin
if(((player_.ActivePlayer = psAudio) or (player_.ActivePlayer = psVideo))) and (((player_.PlayMode = plPlay) or (player_.PlayMode = plPause))) then begin
if(str_ = '200') then
PostMessage(xbmc_wnd, WM_KEYDOWN, VK_SPACE, 0);
if(rotery_mode>0) then
SetXBMCVolumeLevel(rotery_mode=1);
end else begin
if(str_ = '200') then
PostMessage(xbmc_wnd, WM_KEYDOWN, VK_RETURN, 0);
if(rotery_mode=1) then
PostMessage(xbmc_wnd, WM_KEYDOWN, VK_UP, 0);
if(rotery_mode=2) then
PostMessage(xbmc_wnd, WM_KEYDOWN, VK_DOWN, 0);
end;
if(str_ = '210') then
SetXBMCGoToHome
else if(str_ = '220') then
PostMessage(xbmc_wnd, WM_KEYDOWN, VK_ESCAPE, 0);
end;
end else begin
rotate_state := '';
GetKeyMapData(str_,mode_, data_);
if(mode_ > 0) and (xbmc_wnd <> 0) then begin
if(mode_ = 1) then
PostMessage(xbmc_wnd, WM_KEYDOWN, data_, 0)
else if(mode_ = 2) then
PostMessage(xbmc_wnd, WM_CHAR, data_, 0)
else if(mode_ = 3) then begin
case(data_) of
1 : SetXBMCVolumeLevel(true);
2 : SetXBMCVolumeLevel(false);
3 : SetXBMCGoToHome;
4 : SetXBMCAudioMute;
end;
end;
end;
end;
end;
end;
end;
procedure TdMain.ResetPlayerState();
begin
player_.Title := '';
player_.Attrib1 := '';
player_.playmode := plIdle;
player_.ActivePlayer := psNone;
end;
procedure TdMain.SetupSystemConfig();
begin
xbmc_ := GetXBMCConfigInfo;
device_ := GetUSBDeviceInfo;
end;
procedure TdMain.ResetUSBDataBuffer();
var pos : integer;
begin
for pos := 1 to 63 do begin
usb_write_buf[pos] := 0;
end;
usb_write_buf[0] := 0;
usb_write_buf[1] := 1;
end;
function TdMain.WriteUSB : Boolean;
var written_: cardinal;
begin
if(Assigned(controller_)) then begin
result := controller_.WriteFile(usb_write_buf, 65, written_);
if(not result) then
LogMsg('USB write operation failed',lgError);
end else begin
LogMsg('Call to unassigned USB device',lgError);
result := false;
end;
end;
procedure TdMain.ResetLCD();
begin
ResetUSBDataBuffer;
usb_write_buf[2] := 60;
usb_write_buf[3] := 60;
WriteUSB;
end;
procedure TdMain.RenderInfoToLCD();
var out_str : string; pos : shortint;
begin
ResetUSBDataBuffer;
case player_.ActivePlayer of
psAudio : usb_write_buf[2] := 65;
psVideo : usb_write_buf[2] := 66;
psPicture : usb_write_buf[2] := 67;
psNone : usb_write_buf[2] := 60;
end;
case player_.PlayMode of
plStop : usb_write_buf[3] := 65;
plPlay : usb_write_buf[3] := 66;
plPause : usb_write_buf[3] := 67;
end;
out_str := player_.Title;
if(Length(out_str + ' - '+ player_.Attrib1) <= 60) then
out_str := out_str + ' - '+ player_.Attrib1;
if(Length(out_str)>=60) then
out_str := StrLeft(out_str,56) + '...';
if(trim(out_str) <> '-') then begin
for pos := 0 to Length(out_str) do
usb_write_buf[5+pos] := ord(out_str[pos+1]);
end;
WriteUSB;
end;
function TdMain.ConnectXBMC() : Boolean;
begin
try
result := http_client.Connected;
if(result = false) then begin
http_client.Connect();
result := http_client.Connected;
end;
except
result := false;
end;
end;
procedure TdMain.InitSystem();
begin
ClearLog;
controller_ := nil;
SetupSystemConfig;
ResetPlayerState;
MapKeyTable;
device_online := false;
http_client.Host := xbmc_.address;
http_client.Port := StrToIntDef(xbmc_.port, 80);
player_data_buffer := player_;
XBMCU_update.Enabled := true;
LogMsg('Application initiated successfully');
if(StartXBMC) then begin
while(not Application.Terminated) do begin
Sleep(1);
Application.ProcessMessages;
end;
end else
LogMsg('Unable to launch or find XBMC executable file');
XBMCU_update.Enabled := false;
event_capture.Enabled := false;
LogMsg('Application terminated');
end;
procedure TdMain.DataModuleCreate(Sender: TObject);
begin
keymap := TList.Create;
end;
procedure TdMain.DataModuleDestroy(Sender: TObject);
begin
freeandnil(keymap);
end;
procedure TdMain.app_eventException(Sender: TObject; E: Exception);
begin
LogMsg('Fatal Error: '+E.Message, lgError);
end;
procedure TdMain.SetXBMCGoToHome();
begin
PostDataToXBMC('{"jsonrpc": "2.0", "method": "Input.Home", "id": 1}')
end;
procedure TdMain.SetXBMCAudioMute();
begin
PostDataToXBMC('{"jsonrpc": "2.0", "method": "XBMC.ToggleMute", "id": 1}')
end;
procedure TdMain.SetXBMCVolumeLevel(isUp : Boolean; step_ : integer = 1);
var json_rpc : ISuperObject; xbmc_watch_state : Boolean; rx_ : string;
vol_level : integer;
begin
xbmc_watch_state := event_capture.Enabled;
event_capture.Enabled := false;
try
rx_ := trim(PostDataToXBMC('{"jsonrpc": "2.0", "method": "XBMC.GetVolume", "id": 1}'));
if(rx_ <> '') then begin
json_rpc := SO(rx_);
vol_level := json_rpc.I['result'];
if(isUp) then begin
vol_level := vol_level + step_;
if(vol_level > 100) then
vol_level := 100;
end else begin
vol_level := vol_level - step_;
if(vol_level < 0) then
vol_level := 0;
end;
PostDataToXBMC('{"jsonrpc": "2.0", "method": "XBMC.SetVolume", "params": {"value" : '+inttostr(vol_level)+'}, "id": 1}');
end else
raise Exception.Create('Invalid return from XBMC.GetVolume');
finally
event_capture.Enabled := xbmc_watch_state;
end;
end;
procedure TdMain.mnuCloseClick(Sender: TObject);
begin
event_capture.Enabled := false;
XBMCU_update.Enabled := false;
Application.Terminate;
end;
procedure TdMain.mnuLogClick(Sender: TObject);
begin
if FileExists(Root + '\mcci.log') then
ShellExecute(0,'open',pchar(Root + '\mcci.log'),'','',1)
end;
procedure TdMain.try_menuPopup(Sender: TObject);
begin
mnuLog.Enabled := FileExists(Root + '\mcci.log');
end;
procedure TdMain.mnuAboutClick(Sender: TObject);
var fmAboutWin : TFrmAbout;
begin
fmAboutWin := TFrmAbout.Create(nil);
fmAboutWin.ShowModal;
freeandnil(fmAboutWin);
end;
end.