unit datalist;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils,
  base,textfile,arrays;

type
  TDataList=Class(TStringList)
    function InputData(ch:TTextDevice;        const kindlist:ansistring;
                        option:IOoptions;      const prompt:AnsiString;
                        timelimit:double;      elapsed: PDouble;
                        insideofWhen:boolean;  RecordSetter:tpRecordSetter;
                        LineNumb:integer                             ):integer;
                 // 結果は例外番号
     function ReadData(ch:TTextDevice;        const kindlist:ansistring;
                        option:IOoptions;      const prompt:AnsiString;
                        timelimit:double;      elapsed: PDouble;
                        insideofWhen:boolean;  RecordSetter:tpRecordSetter;
                        LineNumb:integer                             ):integer;
                 // 結果は例外番号
     function LineInput(ch:TTextDevice;        const kindlist:ansistring;
                        option:IOoptions;      const prompt:AnsiString;
                        timelimit:double;      elapsed: PDouble;
                        insideofWhen:boolean;  RecordSetter:tpRecordSetter;
                        LineNumb:integer                             ):integer;
                 // 結果は例外番号
     function CharacterInput(ch:TTextDevice;        const kindlist:ansistring;
                        option:IOoptions;      const prompt:AnsiString;
                        timelimit:double;      elapsed: PDouble;
                        insideofWhen:boolean;  RecordSetter:tpRecordSetter;
                        LineNumb:integer                             ):integer;
                 // 結果は例外番号
     function InputVarilen(ch:TTextDevice;        const kindlist:ansistring;
                        option:IOoptions;      const prompt:AnsiString;
                        timelimit:double;      elapsed: PDouble;
                        insideofWhen:boolean;  RecordSetter:tpRecordSetter;
                        LineNumb:integer                             ):integer;
                 // 結果は例外番号
     procedure AssignData(a:Array of Const);
     procedure AssignVarilen(a:TArray1);
     constructor create;
     destructor destroy;override;
     public
        SvExtype:integer;
  end;

type
  TAllChannelList=class(TThreadList)
     public
       procedure FreeAll;
  end;
var
  AllChannelList:TAllChannelList;


implementation
uses base2;

var INPUTCriticalSection: TRTLCriticalSection;

function TDataList.InputData( ch:TTextDevice;       const kindlist:ansistring;
                              option:IOoptions;     const prompt:AnsiString;
                              timelimit:double;     elapsed: PDouble;
                              insideofWhen:boolean; RecordSetter:tpRecordSetter;
                              LineNumb:integer                        ):integer;
var
  StartTime:Double;
begin
    if TimeLimit<0 then
                    setexception(8402);
    starttime:=now;
    if ch=nil then setexception(7004);

    ch.CheckForInput(option);
    if ch=console then EnterCriticalSection(INPUTCriticalSection);
    try
    ch.initInput(LineNumb,prompt,now+timelimit/86400. );
    ch.Setpointer(RecordSetter,insideofWhen);
    result:=ch.DataFoundForRead;
    if result=0 then
       result:=ch.InputData(self,kindlist,option);
    finally
       if ch=console then LeaveCriticalSection(INPUTCriticalSection);
    end;
    if (elapsed <> nil) and (result<>8401) then
                    elapsed^:=(now-starttime)*86400. ;

end;

function TDataList.readData(  ch:TTextDevice;       const kindlist:ansistring;
                              option:IOoptions;     const prompt:AnsiString;
                              timelimit:double;     elapsed: PDouble;
                              insideofWhen:boolean; RecordSetter:tpRecordSetter;
                              LineNumb:integer                        ):integer;
var
  StartTime:Double;
begin
    if TimeLimit<0 then
                    setexception(8402);
    starttime:=now;

    if ch=nil then setexception(7004);
    ch.CheckForInput(option);
    //ch.initInput(LineNumb,prompt,now+timelimit/86400. );
    ch.Setpointer(RecordSetter,insideofWhen);
    result:=ch.DataFoundForRead;
    if result=0 then
       result:=ch.ReadData(self,kindlist,option);

    if (elapsed <> nil) and (result<>8401) then
                    elapsed^:=(now-starttime)*86400. ;

end;

function TDataList.LineInput( ch:TTextDevice;       const kindlist:ansistring;
                              option:IOoptions;     const prompt:AnsiString;
                              timelimit:double;     elapsed: PDouble;
                              insideofWhen:boolean; RecordSetter:tpRecordSetter;
                              LineNumb:integer                        ):integer;
var
  StartTime:Double;
begin
    if TimeLimit<0 then
                    setexception(8402);
    starttime:=now;

    if ch=nil then setexception(7004);
    ch.CheckForInput(option);
    if ch=console then EnterCriticalSection(INPUTCriticalSection);
    try
    ch.initInput(LineNumb,prompt,now+timelimit/86400. );
    ch.Setpointer(RecordSetter,insideofWhen);
    result:=ch.DataFoundForRead;
    if result=0 then
       result:=ch.LineInput(self,length(kindlist),option);
    finally
       if ch=console then LeaveCriticalSection(INPUTCriticalSection);
    end;
    if (elapsed <> nil) and (result<>8401) then
                    elapsed^:=(now-starttime)*86400. ;

end;

function TDataList.CharacterInput( ch:TTextDevice;       const kindlist:ansistring;
                              option:IOoptions;     const prompt:AnsiString;
                              timelimit:double;     elapsed: PDouble;
                              insideofWhen:boolean; RecordSetter:tpRecordSetter;
                              LineNumb:integer                        ):integer;
var
  StartTime:Double;
  s:string;
begin
    if TimeLimit<0 then
                    setexception(8402);
    starttime:=now;

    if ch=nil then setexception(7004);
    ch.CheckForInput(option);
    if ch=console then EnterCriticalSection(INPUTCriticalSection);
    try
    ch.initInput(LineNumb,prompt,now+timelimit/86400. );
    ch.Setpointer(RecordSetter,insideofWhen);
    result:=ch.DataFoundForRead;
    if result=0 then
       begin
         ch.CharacterInput(s,option);
         self.add(s);
         if (ioNoWait in option) and (s='') then
            begin
              SvExtype:=0;  // exception発生を抑止
              //result:=false;
            end;
       end;
    finally
       if ch=console then LeaveCriticalSection(INPUTCriticalSection);
    end;
    if (elapsed <> nil) and (result<>8401) then
                    elapsed^:=(now-starttime)*86400. ;
end;

function TDataList.InputVarilen( ch:TTextDevice;       const kindlist:ansistring;
                              option:IOoptions;     const prompt:AnsiString;
                              timelimit:double;     elapsed: PDouble;
                              insideofWhen:boolean; RecordSetter:tpRecordSetter;
                              LineNumb:integer                        ):integer;
var
  StartTime:Double;
  count:integer;
begin
    if TimeLimit<0 then
                    setexception(8402);
    starttime:=now;

    if ch=nil then setexception(7004);
    ch.CheckForInput(option);
    if ch=console then EnterCriticalSection(INPUTCriticalSection);
    try
    ch.initInput(LineNumb,prompt,now+timelimit/86400. );
    ch.Setpointer(RecordSetter,insideofWhen);
    result:=ch.DataFoundForRead;
    if result=0 then
       ch.InputVarilen(self,kindlist,option,count);
    finally
       if ch=console then LeaveCriticalSection(INPUTCriticalSection);
    end;
    if (elapsed <> nil) and (result<>8401) then
                    elapsed^:=(now-starttime)*86400. ;
end;


procedure TDataList.AssignData(a:Array of Const); //aはTArrayの配列
var
   p:integer;
   i:integer;
begin
   p:=0;
   for i:=0 to HIGH(a) do
     with a[i] do
        case VType of
        vtObject:(VObject as TArray).read(self,p);
    end;
end;

procedure TDataList.AssignVarilen(a:TArray1);
begin
  a.AssignVarilen(self)
end;


procedure TAllChannelList.FreeAll;
var
    i:integer;
begin
    with LockList do
     begin
       for i:=count-1 downto 0 do
       (TDataList(items[i]).free);
     end;
    unlocklist;
end;

constructor TDataList.create;
begin
  inherited create;
  AllChannelList.add(self)
end;

destructor TDataList.destroy;
begin
  AllChannelList.remove(self);
  inherited destroy;
end;

initialization
InitCriticalSection(INPUTCriticalSection);
AllChannelList:=TAllChannelList.create;
finalization
DoneCriticalSection(INPUTCriticalSection);
AllChannelList.free;
end.

