聪明二休-程序结构.txt

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

包括：
  OperatorChat：
  UDebug.pas：Debug窗体，调用UAIMLLoader,UTemplateprocessor, UBotLoader，UPatternMatcher, UVariables
  UPatternMatcher.pas：模式匹配（Graphmaster），调用uUtils
  UAIMLLoader.pas：装载AIML,调用UPatternMatcher,LibXmlParser
  UVariables.pas：变量处理，调用UPatternMatcher
  UTemplateProcessor.pas：模板处理，调用LibXMLParser,UPatternMatcher,classes,UElementFactory
  UElementFactory.pas：元素工厂，调用LibXMLParser,UPatternMatcher,classes
  UElements.pas：元素对象，调用                 UElementFActory,UPatternMatcher,UVariables,UAIMLLoader,UTemplateProcessor,
                 LibXMLParser,SysUtils,classes,UUtils;
  UChat.pas：聊天窗口（用户界面），调用UBotloader,UUtils
  UBotLoader.pas：装载bot,调用LibXMLParser,UAIMLLoader,classes, UPAtternMatcher
  ULogging.pas：日志文件处理，UChat,SysUtils
  UUtils.pas：常用工具
-----------------------------------------------------------------------------------
program OperatorChat;

uses
  Forms,
  UDebug in 'UDebug.pas' {DebugForm},
  UPatternMatcher in 'UPatternMatcher.pas',
  UAIMLLoader in 'UAIMLLoader.pas',
  UVariables in 'UVariables.pas',
  UTemplateProcessor in 'UTemplateProcessor.pas',
  UElementFactory in 'UElementFactory.pas',
  UElements in 'UElements.pas',
  UChat in 'UChat.pas' {Chat},
  UBotLoader in 'UBotLoader.pas',
  ULogging in 'ULogging.pas',
  UUtils in 'UUtils.pas';

{$R *.RES}
begin


  Application.Initialize;

  Log:=TLog.Create;
  PatternMatcher:=TPatternMatcher.Create;
  TemplateProcessor:=TTemplateProcessor.Create;
  Memory:=Tmemory.create;
  AIMLLoader:=TAIMLLoader.create;
  BotLoader:=TBotLoader.Create;
  Preprocessor:=TSimpleSubstituter.create;
  //ElementFactory:=TElementFactory.Create; {auto create when loading units}
  //TBotloaderThread.Create(false);

  Application.Title := 'PASCALice';
  Application.CreateForm(TChat, Chat);
  Application.CreateForm(TDebugForm, DebugForm);
  Application.Run;


  PatternMatcher.Free;
  TemplateProcessor.Free;

  Memory.Free;
  AIMLLoader.Free;
  BotLoader.Free;
  ElementFactory.Free;
  log.Free;
  preprocessor.Free;

end.

-----------------------------------------------------------------------------------------
unit UDebug;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UPatternMatcher, StdCtrls, ComCtrls, UVariables;

type
  TDebugForm = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Label1: TLabel;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    edName: TEdit;
    Label2: TLabel;
    edValue: TEdit;
    Label3: TLabel;
    Button2: TButton;
    Button6: TButton;
    ListBox1: TListBox;
    Button7: TButton;
    Button8: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DebugForm: TDebugForm;

implementation

uses UAIMLLoader,UTemplateprocessor, UBotLoader;



{$R *.DFM}

procedure TDebugForm.FormCreate(Sender: TObject);
begin
  ListBox1.Items:=memory.vars;
end;

procedure TDebugForm.Button2Click(Sender: TObject);
begin
  Memory.setVar(edName.text,edValue.text);
  ListBox1.Items:=Memory.vars;
end;

procedure TDebugForm.Button3Click(Sender: TObject);
var m:THeapStatus;
begin
m:=GetHeapStatus;
Label1.Caption:='Free:'+inttostr(m.TotalFree)+'  patterns:'+InttoStr(PatternMatcher._count);
end;

procedure TDebugForm.Button4Click(Sender: TObject);
var
  M:TMatch;
  i:integer;
begin
Memory.setvar('input',edit1.Text);
M:=PatternMatcher.match;
if m._template='' then
  Memo1.Lines.Add('No match')
else begin
  Memo1.Lines.Add('Pattern:'+M._path);
  for i:=1 to m.count(0) do
    Memo1.Lines.Add('star '+inttostr(i)+ ':'+ M.get(0,i));
  for i:=1 to m.count(1) do
    Memo1.Lines.Add('thatstar '+inttostr(i)+ ':'+ M.get(1,i));
  for i:=1 to m.count(2) do
    Memo1.Lines.Add('topicstar '+inttostr(i)+ ':'+ M.get(2,i));
  Memo1.Lines.Add('------------');
  Memo1.Lines.Add(m._template);
  Memo1.Lines.Add('------------');
  Memo1.Lines.Add(TemplateProcessor.Process(m));
  Memo1.Lines.Add('------------');
end;
m.Free;
end;

procedure TDebugForm.Button5Click(Sender: TObject);
//var
//  loader:TBotLoader;
begin
  TBotloaderThread.Create(false);
end;

procedure TDebugForm.Button7Click(Sender: TObject);
begin
  Memory.setProp(edName.text,edValue.text);
  ListBox1.Items:=Memory.vars;
end;

procedure TDebugForm.Button6Click(Sender: TObject);
begin
  edValue.Text:=Memory.getVar(edName.Text);
end;

procedure TDebugForm.Button8Click(Sender: TObject);
begin
  edValue.Text:=Memory.getProp(edName.Text);
end;

end.

-------------------------------------------------------------------------------
{Here resides the 'Graphmaster' of PASCALice, used to store & match the
 loaded AIML}

unit UPatternMatcher;

interface
uses classes,uUtils;
const
{these constants will be made into a separate class for handling user
 defined contexts}
  CNumContext=3;
  CContext:array[0..CNumContext-1] of string=
    ('<INPUT>','<THAT>','<TOPIC>');
type
{TContexts maintains a list of contexts, their order and variable bindings}
  TContexts=class
  end;
  
{TMatch stores information about a match, such as matched wildcards,
 or the resulting template}
  TMatch=class
    _m:array of array of string; {array for handling user defined context matches}
    _template:string;            {the activated category's template}
    _processed:string;           {the processed template}
    _path:string;                {the path of the activated category}
    _fifo:boolean;               {behaviour of get method}
    constructor create;
    procedure add(context:integer;s:string);  {adds a matched wildcard of a context}
    function get(context:integer;i:integer):string;overload;
    function count(context:integer):integer;   {the number of 'stars' in the context}
    {function get(context:integer):string);overload;}

  end;
  TPatternNode=class
    _pattern:string;           {the word this node represents, can be a wildcard or a context separator}
    _context:integer;          {the id of the context}
    _template:string;          {if this node is a leaf node, contains the template}
    _path:string;              {if leaf node, then it's the path to the category it represents}
    //_file:string;
    _parent:TPatternNode;      {not currently used}
    _childs:array of TStringList; {list of childcontexts, will probably need replacing by custom container}
    _count:array of integer;      {number of childnodes in each context}
    constructor create(pattern:string;parent:TPatternNode);

    //function add(n:TPatternNode):TPatternNode;overload; {not used; adds already created node object}
    //function add(p:String):TPatternNode;overload; {not used; adds node without context id}
    function add(p:String;context:integer):TPatternNode;overload; {creates and adds a node if there isn't one already present}

    {matches the tokens in input from token number depth, if sucessfull returns the matched childnode}
    function match(input:TStringList;depth:integer;var m:TMatch):TPatternNode;
    Procedure delete(context:integer;i:integer); {delete &free child node i}
    Procedure clear;             {free all child nodes recursively}
    function contains(context:integer;p:string):integer; {returns index of child node with the pattern p}
    //function get(i:integer):TpatternNode;overload; {returns child node i}
    //function get(p:string):TpatternNode;overload;  {returns child node with pattern p}

    function get(context:integer; i:integer):TPatternNode;overload;
    function get(context:integer;p:string):TPatternNode;overload;

  end;

  TPatternMatcher=class
    _root:TPatternNode;
    _tokenizer:TStringTokenizer;
    _SentenceTokenizer:TStringTokenizer;
    _count:integer;
    _locked:boolean;
    _matchfault:integer;
    procedure add(path:string;t:string);
    function match:TMatch;overload;
    function match(path:string):TMatch;overload;
    function match(input,that,topic:string):TMatch;overload;
    function matchinput(input:string):TMatch;
    constructor Create;
    destructor destroy;override;
  end;
var
  PatternMatcher:TPatternMatcher;
  Nodecount:integer;
implementation
  uses SysUtils,UVariables;
  var matchfault:integer;
  constructor TMatch.create;
    var
      i:integer;
    begin
      _fifo:=false;
      _template:='';
      Setlength(_m,CNumContext);
      for i:=0 to CNumContext-1 do
        _m[i]:=nil
    end;
  procedure TMatch.Add(context:integer;s:string);
    begin
      setlength(_m[context],Length(_m[context])+1);
      _m[context,length(_m[context])-1]:=s;
    end;
  function TMatch.count(context:integer):integer;
    begin
      if (_m[context]=nil)or (context>=Cnumcontext) then
        result:=0
      else
        result:=length(_m[context]);
    end;
  function TMatch.get(context:integer;i:integer):string;
    begin
      if count(context)<i then begin
        result:='';
        exit;
      end;
      if _fifo then dec(i)
      else i:=count(context)-i;

      result:=_m[context,i];
    end;
  constructor TPatternNode.Create(pattern:string;parent:TPatternNode);
    begin
      _pattern:=pattern;
      _parent:=parent;
      _template:='';
      SetLength(_childs,CNumContext);
      SetLength(_count,CNumContext);
      inc(nodecount);
    end;
  function TPatternNode.Contains(context:integer;p:string):integer;
    begin
      if _childs[context]<>nil then
        result:=_childs[context].IndexOf(p)
      else
        result:=-1;
    end;


  function TPatternNode.get(context:integer;i:integer):TPatternNode;
    begin
      if i>=_Count[context] then result := nil else
        result:=TPatternnode(_childs[context].Objects[i]);
    end;
  function TPatternNode.get(context:integer;p:string):TPatternNode;
    var i:integer;
    begin
      if _count[context]=0 then begin
        result:=nil;
        exit;
      end;
      I:=_childs[context].indexof(p);
      if i>=0 then result:=TPatternNode(_Childs[context].Objects[i])
      else result:=nil;

    end;
(*
  function TPatternNode.Add(n:TPatternNode):TPatternNode;
    var
      i:integer;
    begin
      if _childs=nil then begin
        _childs:=TStringList.Create;
        _childs.sorted:=true;
        _childs.duplicates:=dupIgnore;
      end;
      i:=_childs.indexof(n._pattern);
      if i<0 then begin
        _childs.AddObject(n._pattern,n);
        result:=n;
      end else begin
        result:=TPatternNode(_childs.Objects[i]);
        n.Destroy;
      end;
      _count:=_childs.count;
    end;
*)
(*
  function TPatternNode.Add(p:string):TPatternNode;
    var
      i:integer;
      n:TPatternnode;
    begin
      if _childs=nil then begin
        _childs:=TStringList.Create;
        _childs.sorted:=true;
        _childs.duplicates:=dupIgnore;
      end;

      i:=_childs.indexof(p);
      if i<0 then begin {create new child node}
        n:=TPatternNode.create(p,self);
        _childs.AddObject(p,n);
        result:=n;
      end else begin {this node already exists, just return it}
        result:=TPatternNode(_childs.Objects[i]);
      end;
      _count:=_childs.count;
    end;
*)
  function TPatternNode.Add(p:string;context:integer):TPatternNode;
    var
      i:integer;
      n:TPatternnode;
    begin
      if _childs[context]=nil then begin
        _childs[context]:=TStringList.Create;
        _childs[context].sorted:=true;
        _childs[context].duplicates:=dupIgnore;
      end;

      i:=_childs[context].indexof(p);
      if i<0 then begin {create new child node}
        n:=TPatternNode.create(p,self);
        _childs[context].AddObject(p,n);
        result:=n;
      end else begin {child node already exists}
        result:=TPatternNode(_childs[context].Objects[i]);
      end;
      result._context:=context;
      _count[context]:=_childs[context].count;
    end;
  function TPatternNode.match(input:TStringList;depth:integer;var m:TMatch):TPatternNode;
    var
      n:TPatternNode;
      i:integer;
      wcl:integer; {number of words in the current wildcard, starting from depth}
      wc:string; {matched wildcard}
      newcontext:integer;
    begin
      inc(matchfault);
      result:=nil;
      wcl:=0;
      wc:='';
      {check current context from input (get the variable bound to the context if we've reached the end)}
      newcontext:=_context;
      for i:=_context to CNumContext-1 do
        if ansisametext(input[depth],CContext[i]) then begin
          newcontext:=i;
          break;
        end;
      if _count[newcontext]=0 then begin
        result:=nil;
        exit;
      end;
      n:=get(newcontext,'_');
      {try to match the underscore wildcard}
      if (n<>nil) then begin
        repeat {try to match words with the wildcard}
          if (depth+wcl<input.Count-1) then
            result:=n.Match(input,depth+wcl+1,m) {we haven't reached the end of the input, and there's still childnodes to try}
          else if n._template<>'' then
            result:=n; {we've found a category}
          inc(wcl);
        until (result<> nil) or (depth+wcl>=input.Count); {until we match or we reach end of input}
        if result<> nil then begin {if we matched}
          if m=nil then m.create;  {just in case this is the first match}
          for i:=depth to depth+wcl-1 do
            wc:=wc+input[i]+' '; {construct the individual words into the matched wildcard}