Skip to content

Commit

Permalink
Added ability to choose which tuners should be available for use by D…
Browse files Browse the repository at this point in the history 
…VR clients
  • Loading branch information
Craig Moksnes committed Mar 17, 2020
1 parent c348950 commit cd0b0ae
Show file tree
Hide file tree
Showing 6 changed files with 1,628 additions and 347 deletions.
1,617 changes: 1,337 additions & 280 deletions ProxyFormUnit.fmx
View file

Large diffs are not rendered by default.

114 changes: 83 additions & 31 deletions ProxyFormUnit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,10 +30,6 @@ interface
FMX.Layouts,
FMX.ListBox,
FMX.Utils,
FMX.ListView.Types,
FMX.ListView.Appearances,
FMX.ListView.Adapters.Base,
FMX.ListView,
FMX.SpinBox,
FMX.Menus,
FMX.Platform,
Expand Down Expand Up @@ -71,7 +67,6 @@ TMainForm = class(TForm, IServiceConfigEvents)
SaveTimer: TTimer;
Label2: TLabel;
btnRefreshChannels: TButton;
lbStats: TListView;
Label3: TLabel;
eHDHRListenHTTPPort: TEdit;
Label4: TLabel;
Expand All @@ -96,6 +91,7 @@ TMainForm = class(TForm, IServiceConfigEvents)
HelpCallout: TCalloutRectangle;
lblHelp: TLabel;
eCetonTunerAddress: TComboEdit;
lbTuners: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure lbChannelsChangeCheck(Sender: TObject);
Expand All @@ -117,6 +113,7 @@ TMainForm = class(TForm, IServiceConfigEvents)
Shift: TShiftState; X, Y: Single);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; var Handled: Boolean);
procedure lbTunersChangeCheck(Sender: TObject);
private
{ Private declarations }
fConfigManager: IServiceConfigManager;
Expand All @@ -142,7 +139,7 @@ TMainForm = class(TForm, IServiceConfigEvents)
procedure UpdateInterface;
procedure UpdateChannelCount;
procedure FillChannels;
procedure FillTunerStatistics;
procedure FillTuners;

property ConfigManager: IServiceConfigManager read fConfigManager;
property Client: TCetonClient read GetClient;
Expand Down Expand Up @@ -311,7 +308,7 @@ procedure TMainForm.lbChannelsChangeCheck(Sender: TObject);
ConfigManager.UnlockConfig(lConfig);
end;

updateChannelCount;
UpdateChannelCount;

Save([TServiceConfigSection.Channels]);
end;
Expand Down Expand Up @@ -415,7 +412,7 @@ procedure TMainForm.SaveTimerTimer(Sender: TObject);
ConfigManager.Changed(Self, lSections);
end;

FillTunerStatistics;
FillTuners;
end;

procedure TMainForm.FormShow(Sender: TObject);
Expand Down Expand Up @@ -485,41 +482,77 @@ procedure TMainForm.btnRefreshChannelsClick(Sender: TObject);
FillChannels;
end;

procedure TMainForm.FillTunerStatistics;
procedure TMainForm.FillTuners;
var
lStatsArray: TTunerStatsArray;
i, i2: Integer;
lActiveStr: String;
lText: String;
lCount: Integer;
lConfig: TServiceConfig;
lTunerConfigList: TTunerConfigList;
begin
lStatsArray := Client.GetTunerStats;
while lbStats.Items.Count < Length(lStatsArray) do
lbStats.Items.Add;
while lbStats.Items.Count > Length(lStatsArray) do
lbStats.Items.Delete(lbStats.Items.Count-1);
BeginInterfaceUpdate;
try
lStatsArray := Client.GetTunerStats;

for i := 0 to High(lStatsArray) do
begin
if lStatsArray[i].Active then
lActiveStr := 'Active'
else
lActiveStr := 'Not active';
lbTuners.BeginUpdate;
try
while lbTuners.Items.Count < Length(lStatsArray) do
lbTuners.Items.Add('');
while lbTuners.Items.Count > Length(lStatsArray) do
lbTuners.Items.Delete(lbTuners.Items.Count-1);

lText := Format('%d. Channel: %d, %s (%0.2fMbps, Buffer free: %0.0f%%)', [i+1, lStatsArray[i].Channel, lActiveStr, lStatsArray[i].InMeter.GetBytesPerSecond(True)*8/1000000, lStatsArray[i].BufferFree*100]);
lCount := 1;
lTunerConfigList := TTunerConfigList.Create;
try
ConfigManager.LockConfig(lConfig);
try
lTunerConfigList.Assign(lConfig.Ceton.Tuners);
finally
ConfigManager.UnlockConfig(lConfig);
end;

for i2 := 0 to lStatsArray[i].ClientCount-1 do
begin
if lStatsArray[i].Clients[i2].Active then
begin
lText := lText + #13#10 + Format(' To client: %0.2fMbps, Lost packets: %d', [lStatsArray[i].Clients[i2].OutMeter.GetBytesPerSecond(True)*8/1000000, lStatsArray[i].Clients[i2].Lost]);
Inc(lCount);
for i := 0 to High(lStatsArray) do
begin
if lStatsArray[i].Active then
lActiveStr := 'Active'
else
lActiveStr := 'Not active';

lText := Format('%d. Channel: %d, %s (%0.2fMbps, Buffer free: %0.0f%%)', [i+1, lStatsArray[i].Channel, lActiveStr, lStatsArray[i].InMeter.GetBytesPerSecond(True)*8/1000000, lStatsArray[i].BufferFree*100]);
lCount := 1;

for i2 := 0 to lStatsArray[i].ClientCount-1 do
begin
if lStatsArray[i].Clients[i2].Active then
begin
lText := lText + #13#10 + Format(' To client: %0.2fMbps, Lost packets: %d', [lStatsArray[i].Clients[i2].OutMeter.GetBytesPerSecond(True)*8/1000000, lStatsArray[i].Clients[i2].Lost]);
Inc(lCount);
end;
end;

lbTuners.ListItems[i].Text := lText;
lbTuners.ListItems[i].Height := 22*lCount;

if (i < lTunerConfigList.Count) then
lbTuners.ListItems[i].IsChecked := lTunerConfigList[i].Enabled
else
lbTuners.ListItems[i].IsChecked := False;

lbTuners.ListItems[i].StyledSettings := lbTuners.ListItems[i].StyledSettings - [TStyledSetting.FontColor];
if lbTuners.ListItems[i].IsChecked then
lbTuners.ListItems[i].FontColor := TAlphaColorRec.Black
else
lbTuners.ListItems[i].FontColor := TAlphaColorRec.Gray;
end;
finally
lTunerConfigList.Free;
end;
finally
lbTuners.EndUpdate;
end;

lbStats.Items[i].Text := lText;
lbStats.Items[i].Height := 22*lCount;
finally
EndInterfaceUpdate;
end;
end;

Expand Down Expand Up @@ -765,4 +798,23 @@ procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
end;
end;

procedure TMainForm.lbTunersChangeCheck(Sender: TObject);
var
lConfig: TServiceConfig;
begin
if not InterfaceUpdating then
begin
ConfigManager.LockConfig(lConfig);
try
if TListBoxItem(Sender).Index < lConfig.Ceton.Tuners.Count then
lConfig.Ceton.Tuners[TListBoxItem(Sender).Index].Enabled := TListBoxItem(Sender).IsChecked;
finally
ConfigManager.UnlockConfig(lConfig);
end;

// TODO: Use another config section so that servers aren't restarted
Save([TServiceConfigSection.Other]);
end;
end;

end.
4 changes: 2 additions & 2 deletions ProxyServerModuleUnit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -384,7 +384,7 @@ procedure TProxyServerModule.DiscoveryUDPRead(AThread: TIdUDPListenerThread;
begin
if TryGetAddress(ABinding.IP, lAddress) then
begin
lTunerCount := Client.TunerCount;
lTunerCount := Client.EnabledTunerCount;

ConfigManager.LockConfig(lConfig);
try
Expand Down Expand Up @@ -474,7 +474,7 @@ function TProxyServerModule.TryGetAddress(const aRequestLocalIP: String; out aAd

if (lAddresses.IndexOf(ARequestLocalIP) > -1) then
begin
if ProxyServiceModule.Client.TunerCount = 0 then
if ProxyServiceModule.Client.EnabledTunerCount = 0 then
Exit(False);

lModel := ProxyServiceModule.Client.Model;
Expand Down
48 changes: 47 additions & 1 deletion ProxyServiceModuleUnit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -211,6 +211,16 @@ function TServiceConfig.ToJSON: String;
begin
m := TJSONMarshal.Create(TJSONConverter.Create);
try
m.RegisterConverter(TTunerConfigList, 'fList',
function(Data: TObject; Field: String): TListOfObjects
var
i: Integer;
begin
SetLength(Result, TTunerConfigList(Data).Count);
for i := 0 to High(Result) do
Result[i] := TTunerConfigList(Data)[i];
end);

m.RegisterConverter(TChannelMap, 'fList',
function(Data: TObject; Field: String): TListOfObjects
var
Expand Down Expand Up @@ -244,6 +254,21 @@ class function TServiceConfig.FromJSON(const aJSON: String): TServiceConfig;

m := TJSONUnMarshal.Create;
try
lR := TReverterEvent.Create(TTunerConfig, 'list');
lR.ObjectsReverter :=
procedure(Data: TObject; Field: string; Args: TListOfObjects)
var
i: Integer;
begin
TTunerConfigList(Data).Count := Length(Args);
for i := 0 to High(Args) do
begin
TTunerConfigList(Data)[i].Assign(TTunerConfig(Args[i]));
Args[i].Free;
end;
end;
m.RegisterReverter(TTunerConfigList, 'list', lR);

lR := TReverterEvent.Create(TChannelMapItem, 'list');
lR.ObjectsReverter :=
procedure(Data: TObject; Field: string; Args: TListOfObjects)
Expand Down Expand Up @@ -742,6 +767,9 @@ procedure TServiceThread.QueryDiscoveredCetonDevices;
end;

procedure TServiceThread.Execute;
var
lConfig: TServiceConfig;
lCetonConfig: TCetonConfig;
begin
Coinitialize(nil);
try
Expand All @@ -759,7 +787,25 @@ procedure TServiceThread.Execute;
SaveLogs;

try
fServiceModule.Client.CheckTuner;
if fServiceModule.Client.CheckTuner then
begin
// If check tuner did something, it may have changed its config, so update the service module's config
lCetonConfig := TCetonConfig.Create;
try
fServiceModule.Client.GetConfig(lCetonConfig);

fServiceModule.ConfigManager.LockConfig(lConfig);
try
lConfig.Ceton.Assign(lCetonConfig, [TCetonConfigSection.Channels]);
finally
fServiceModule.ConfigManager.UnlockConfig(lConfig);
end;
finally
lCetonConfig.Free;
end;

fServiceModule.ConfigManager.Changed(fServiceModule.Client, [TServiceConfigSection.Other]);
end;
except
on e: Exception do
TLogger.Log(cLogDefault, e.Message);
Expand Down
14 changes: 7 additions & 7 deletions ProxyWebModuleUnit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ TProxyWebModule = class(TWebModule)
function GetAddress(const aRequest: TWebRequest): String;

procedure GetLineup(const aLineup: TLineup);
procedure SendTuneResponse(const aTuner, aChannel: Integer; const aTest: Boolean; const aDurationSec: Integer; const aRemux: Boolean; const Response: TWebResponse);
procedure SendTuneResponse(const aTuner, aChannel: Integer; const aAllowedDisabledTuners: Boolean; const aTest: Boolean; const aDurationSec: Integer; const aRemux: Boolean; const Response: TWebResponse);

function CreateDeviceXML: String;

Expand Down Expand Up @@ -161,7 +161,7 @@ procedure TProxyWebModule.ProxyWebModuleDiscoverActionAction(Sender: TObject;
lResponse := TDiscoverResponse.Create;
try
lAddress := GetAddress(Request);
lTunerCount := Client.TunerCount;
lTunerCount := Client.EnabledTunerCount;

ConfigManager.LockConfig(lConfig);
try
Expand Down Expand Up @@ -212,7 +212,7 @@ procedure TProxyWebModule.ProxyWebModuleLineupJSONActionAction(Sender: TObject;
end;
end;

procedure TProxyWebModule.SendTuneResponse(const aTuner, aChannel: Integer; const aTest: Boolean; const aDurationSec: Integer; const aRemux: Boolean; const Response: TWebResponse);
procedure TProxyWebModule.SendTuneResponse(const aTuner, aChannel: Integer; const aAllowedDisabledTuners: Boolean; const aTest: Boolean; const aDurationSec: Integer; const aRemux: Boolean; const Response: TWebResponse);
var
lStream: TCetonVideoStream;
lStatsWatch, lDurationWatch: TStopWatch;
Expand All @@ -227,7 +227,7 @@ procedure TProxyWebModule.SendTuneResponse(const aTuner, aChannel: Integer; cons
lDurationWatch := TStopWatch.StartNew;

// If Create here
lStream := TCetonVideoStream.Create(Client, aTuner, aChannel, aRemux);
lStream := TCetonVideoStream.Create(Client, aTuner, aChannel, aAllowedDisabledTuners, aRemux);
try
try
TIdHTTPAppChunkedResponse(Response).SendChunkedStream(lStream,
Expand Down Expand Up @@ -286,7 +286,7 @@ procedure TProxyWebModule.ProxyWebModuleAutoActionAction(Sender: TObject;
lChannel := StrToIntDef(lParts[1].Substring(1),0);
if lChannel > 0 then
begin
SendTuneResponse(-1, lChannel, False, 0, True, Response);
SendTuneResponse(-1, lChannel, False, False, 0, True, Response);
end;
end;
finally
Expand Down Expand Up @@ -420,7 +420,7 @@ procedure TProxyWebModule.ProxyWebModuleTunerActionAction(Sender: TObject;
lChannel := StrToIntDef(lParts[1].Substring(1),0);
if (lTuner > -1) and (lChannel > 0) then
begin
SendTuneResponse(lTuner, lChannel, False, 0, True, Response);
SendTuneResponse(lTuner, lChannel, False, False, 0, True, Response);
end;
end;
finally
Expand Down Expand Up @@ -936,7 +936,7 @@ procedure TProxyWebModule.ProxyWebModuleVideoTestActionAction(Sender: TObject;
lDuration := StrToIntDef(Request.QueryFields.Values['duration'], 45);
lRemux := Boolean(StrToIntDef(Request.QueryFields.Values['remux'], 0));

SendTuneResponse(lTunerIndex, lChannel, True, lDuration, lRemux, Response);
SendTuneResponse(lTunerIndex, lChannel, True, True, lDuration, lRemux, Response);
end;
end;
finally
Expand Down
Loading

0 comments on commit cd0b0ae

Please sign in to comment.