uelements.pas

用AIML语言开发的一款中文自动聊天软件

unit UElements;
{所有在模板中支持的元素对象}

interface
implementation
uses
  UElementFActory,UPatternMatcher,UVariables,UAIMLLoader,UTemplateProcessor,
  LibXMLParser,SysUtils,classes,UUtils;

type
  TBotElement=class(TTEmplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TxStarElement=class(TTEmplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;
type
  TGetElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;
type
  TSetElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TDefaultElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TLearnElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;
type
  TSrElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TThinkElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSraiElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TRandomElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TBrElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TConditionElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    function blockCondition(variable,value:string;Match:TMatch;Parser:TXMLParser):string;
    function blockSwitch(variable:string;Match:TMatch;Parser:TXMLParser):string;
    //function blockMulti(Match:TMatch;Parser:TXMLParser):string;

    procedure register;override;
  end;
type
  TCaseElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TThatElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TVersionElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TidElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSizeElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TDateElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TGossipElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TInputElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSubstElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TJScriptElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TSystemElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;

type
  TforgetElement=class(TTemplateElement)
    function Process(Match:TMatch;Parser:TXMLParser):string;override;
    procedure register;override;
  end;


  function TSetElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      name:string;
    begin
      name:=parser.CurAttr.Value('name');
      result:=ProcessContents(Match,Parser);
      result:=TrimWS(ConvertWs(result,true));
      Memory.setVar(name,result);
    end;
  procedure TSetElement.register;
    begin
      ElementFactory.register('set',self);
    end;

  function TBotElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=Memory.getProp(parser.CurAttr.Value('name'));
    end;
  procedure TBotElement.register;
    begin
      ElementFactory.register('bot',Self);
    end;
  function TGetElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:=Memory.getVar(parser.CurAttr.Value('name'));
      if (Parser.CurPartType=ptEmptyTag) or
         (Parser.CurPartType=ptEndTag) then exit;
      if result<>'' then
        repeat until
          (not parser.Scan)or
          ((parser.CurPartType=ptEndTag)and
           (parser.CurName='get'))
      else
        result:=ProcessContents(Match,Parser);
    end;
  procedure TGetElement.register;
    begin
      ElementFactory.register('get',Self);
    end;

  function TxStarElement.Process(Match:TMatch;Parser:TXMLParser):string;
    //统配符(star)元素-处理
    var
      context:integer;
      index:string;
    begin
      if parser.CurPartType<>ptEndTag then begin
        if parser.CurName='star' then context:=0;
        if parser.CurName='thatstar' then context:=1;
        if parser.CurName='topicstar' then context:=2;
        index:=Parser.CurAttr.Value('index');
        if index='' then index:='1';  //默认为第一个
        result:=Match.get(context,strtoint(index)); //获得匹配的 star 值
        result:=TrimWS(result);
      end else
        result:='';
    end;
  procedure TxStarElement.register;
    //统配符(star)元素-注册
    begin
      ElementFactory.register('star',self);
      ElementFactory.register('thatstar',self);
      ElementFactory.register('topicstar',self);
    end;

  function TDefaultElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      SetLength(result,Parser.CurFinal-Parser.CurStart+1);
      result:=StrLCopy(PCHar(result),Parser.CurStart,Parser.CurFinal-Parser.CurStart+1);
    end;
  procedure TDefaultElement.register;
    begin
      ElementFactory.registerdefault(Self);
    end;

  function TLearnElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      result:='';
      if parser.CurPartType=ptEmptyTag then exit;
      result:=ProcessContents(Match,Parser);
      if not assigned(AIMLLoader) then AIMLLoader:=TAIMLLoader.Create;
      AIMLLoader.load(result);
    end;
  procedure TLearnElement.register;
    begin
      ElementFactory.register('learn',Self);
    end;

  function TSrElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      temp:TMatch;
    begin
      temp:=PatternMatcher.Matchinput(Match.get(0,1));
      result:=TemplateProcessor.Process(temp);
      temp.free;
      if parser.curPartType=ptStartTag then
      while (parser.scan) and (parser.curparttype<>ptEndTag) and (parser.curName<>'sr') do;
    end;
  procedure TSrElement.register;
    begin
      ElementFactory.register('sr',Self);
    end;

  function TThinkElement.Process(Match:TMatch;Parser:TXMLParser):string;
    begin
      ProcessContents(Match,Parser);
      result:='';
    end;
  procedure TThinkElement.register;
    begin
      ElementFactory.register('think',Self);
    end;
  function TSraiElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      temp:TMatch;
    begin
      result:=ProcessContents(Match,Parser);
      if result='' then begin
        temp:=PatternMatcher.Matchinput(Match.get(0,1));
        result:=TemplateProcessor.Process(temp);
        temp.free;
      end else begin
        temp:=PatternMatcher.Matchinput(result);
        result:=TemplateProcessor.Process(temp);
        temp.free;
      end;
    end;
  procedure TSraiElement.register;
    begin
      ElementFactory.register('srai',Self);
    end;

  function TRandomElement.Process(Match:TMatch;Parser:TXMLParser):string;
    var
      Options:Tlist;
      //Start:PChar;
      continue:PChar;
      //i:integer;
    begin
      Options:=Tlist.Create;
      result:='';
      While parser.Scan do begin
        case parser.CurPartType of
          ptStartTag:if (parser.CurName='li') then begin
                         Options.Add(Parser.CurFinal);
                         SkipElement(Parser);
                     end;
          ptEndTag:if (parser.CurName='random') then break;
        end;
      end;