Tech Arsenal 2/Tech Arsenal 2 (Arsenal Computer).iso/pascal/action.pas

Pascal/Delphi Source File | 1994-06-09 | 9.4 KB | 336 lines

{$I WCDEFINE.INC}
unit Action;

interface

uses
  Dos,  TpDos,  TpCrt,  TpString,  TpDate,  Filer,  ApTimer,  Desq,
  WcScreen,  WcEdit,  ChatType,  NameFunc,  Func,  Flags,  WcGlobal,
  WcType;


type
  ActionWordType = (awNone, awDefault, awChannel);


  function ReadKeywords(const Filename : String) : Boolean;
  function ReadChannelKeywords(const Filename : String) : Boolean;
  function GetActionWord(const Filename : String; Position : LongInt; var ActionRec : TActionRecord) : Boolean;
  function FindKeyword(const Keyword : String; var Position : LongInt) : ActionWordType;
  function ActionString(const InStr,
                              ToUser, FromUser : String;
                              ToSex, FromSex : TSex;
                              Response : ResponseType) : String;
  procedure DisplayActionArrays;

{************************************************************************}

implementation

{************************************************************************}
  Function GetLangVersion(const findme : String) : String;
  Begin
     If (LangInfo.Language = '') then
       GetLangVersion := MwConfig.LanguagePath+FindMe
     Else
       If ExistFile(MwConfig.LanguagePath+LangInfo.Language+'\'+FindMe) then
         GetLangVersion := MwConfig.LanguagePath+LangInfo.Language+'\'+FindMe
       Else
         If ExistFile(MwConfig.LanguagePath+FindMe) then
           GetLangVersion := MwConfig.LanguagePath+FindMe
         Else
           GetLangVersion := '';
  End;


{************************************************************************}

  function ReadChannelKeywords(const Filename : String) : Boolean;

  begin
    if FileName <> '' then
      begin
        ChannelCnt := 0;
        FillChar(ChannelKeys, SizeOf(ChannelKeys), 0);
        ReadChannelKeywords := ReadKeywords(Filename);
      end
    else
      begin
        ChannelCnt := 0;
        ReadChannelKeywords := True;
      end;
  end;

{************************************************************************}

  function ReadKeywords(const Filename : String) : Boolean;
  var
    Status   : Boolean;
    Finished : Boolean;
    fp       : File;
    ActionRec: TActionRecord;
    p        : LongInt;
    Cnt      : Word;
    Path     : PathStr;
  begin
    Status := False;
    if Filename <> '' then
      begin
        Path := GetLangVersion(ForceExtension(Filename, 'ACT'));
        if ExistFile(Path) then
          begin
            ClearIoError;
            Assign(fp, Path);
            FileMode := $42;
            Reset(fp, 1);
            if NOT IsError then
              begin
                Finished := False;
                Cnt := 1;

                while (NOT Finished) AND (NOT Eof(fp)) AND (Cnt <= 200) do
                  begin
                    p := FilePos(fp);
                    BlockRead(fp, ActionRec, SizeOf(TActionRecord));
                    if NOT IsError then
                      begin
                        ChannelKeys[Cnt].Keyword := ActionRec.Keyword;
                        ChannelKeys[Cnt].Position:= Cnt;
                        Inc(Cnt);
                      end
                    else
                      Finished := True;
                  end;

                Status := True;
                ActionWords := True;
                ChannelCnt := Cnt;
                Close(fp);
              end;
          end
        else
          Status := True;
      end
    else
      Status := True;

    ReadKeywords := Status;
  end;

{************************************************************************}

  function GetActionWord(const Filename : String; Position : LongInt; var ActionRec : TActionRecord) : Boolean;
  var
    fp      : File;
    Status  : Boolean;
    OffSet  : LongInt;
    Path    : PathStr;

  begin
    Status := False;

    if ActionWords then
      begin
        Path := GetLangVersion(ForceExtension(Filename, 'ACT'));
        If Path <> '' then
           Begin
              Assign(fp, Path);
              FileMode := $42;
              Reset(fp, 1);
              if NOT IsError then
                begin
                  OffSet := (Position - LongInt(1)) * LongInt(SizeOf(TActionRecord));
                  Seek(fp, OffSet);
                  BlockRead(fp, ActionRec, SizeOf(TActionRecord));
                  if NOT IsError then
                    Status := True;
                  Close(fp);
                end;
           End;
      end
    else
      Status := True;

    GetActionWord := Status;
  end;

{************************************************************************}

  function FindKeyword(const Keyword : String; var Position : LongInt) : ActionWordType;
  var
    Status  : ActionWordType;
    Mid     : Integer;
    Upper   : Integer;
    Lower   : Integer;

  begin
    Status  := awNone;

    if ActionWords then
      begin
        Position := 0;

        if ChannelCnt > 0 then
          begin
            Upper := ChannelCnt;
            Lower := 1;

            while (Upper >= Lower) AND (Position = 0) do
              begin
                Mid := (Lower + Upper) div 2;
                case CompString(Keyword, ChannelKeys[Mid].Keyword) of
                    Equal  : Position := ChannelKeys[Mid].Position;
                    Less   : Upper := Mid - 1;
                    Greater: Lower := Mid + 1;
                  end;
              end;

            if Position <> 0 then
              Status := awChannel;
          end;
      end;

    FindKeyword := Status;
  end;

{************************************************************************}

  function ActionString(const InStr,
                              ToUser, FromUser : String;
                              ToSex, FromSex : TSex;
                              Response : ResponseType) : String;
  var
    p     : Byte;
    OutStr: String;
  const
    AtTo         = '@TO@';
    AtFrom       = '@FROM@';
    AtToHeShe    = '@THE/SHE@';
    AtFromHeShe  = '@FHE/SHE@';
    AtToHisHer   = '@THIS/HER@';
    AtFromHisHer = '@FHIS/HER@';
    AtToHimHer   = '@THIM/HER@';
    AtFromHimHer = '@FHIM/HER@';
  begin
    OutStr := InStr;
    While Pos(AtTO, OutStr) > 0 do
      begin
        p := Pos(AtTO, OutStr);
        Delete(OutStr, p, 4);
        case Response of
          awNormal: Insert(ToUser, OutStr, p);
          awAll   : Insert('everybody', OutStr, p);
          awYou   : Insert('you', OutStr, p);
        end;
      end;

    While Pos(AtFROM, OutStr) > 0 do
      begin
        p := Pos(AtFROM, OutStr);
        Delete(OutStr, p, 6);
        Insert(FromUser, OutStr, p);
      end;

    While Pos(AtToHeShe, OutStr) > 0 do
      begin
        p := Pos(AtToHeShe, OutStr);
        Delete(OutStr, p, 9);
        Case ToSex of
          sMale     : Insert('he', OutStr, p);
          sFemale   : Insert('she', OutStr, p);
          else        Insert('they', OutStr, p);
        end;
      end;

    While Pos(AtFromHeShe, OutStr) > 0 do
      begin
        p := Pos(AtFromHeShe, OutStr);
        Delete(OutStr, p, 9);
        Case FromSex of
          sMale     : Insert('he', OutStr, p);
          sFemale   : Insert('she', OutStr, p);
          else        Insert('they', OutStr, p);
        end;
      end;

    While Pos(AtToHisHer, OutStr) > 0 do
      begin
        p := Pos(AtToHisHer, OutStr);
        Delete(OutStr, p, 10);
        Case ToSex of
          sMale     : Insert('his', OutStr, p);
          sFemale   : Insert('her', OutStr, p);
          else        Insert('their', OutStr, p);
        end;
      end;

    While Pos(AtFromHisHer, OutStr) > 0 do
      begin
        p := Pos(AtFromHisHer, OutStr);
        Delete(OutStr, p, 10);
        Case FromSex of
          sMale     : Insert('his', OutStr, p);
          sFemale   : Insert('her', OutStr, p);
          else        Insert('their', OutStr, p);
        end;
      end;

    While Pos(AtToHimHer, OutStr) > 0 do
      begin
        p := Pos(AtToHimHer, OutStr);
        Delete(OutStr, p, 10);
        Case ToSex of
          sMale     : Insert('him', OutStr, p);
          sFemale   : Insert('her', OutStr, p);
          else        Insert('them', OutStr, p);
        end;
      end;

    While Pos(AtFromHimHer, OutStr) > 0 do
      begin
        p := Pos(AtFromHimHer, OutStr);
        Delete(OutStr, p, 10);
        Case FromSex of
          sMale     : Insert('him', OutStr, p);
          sFemale   : Insert('her', OutStr, p);
          else        Insert('them', OutStr, p);
        end;
      end;

    ActionString := OutStr;
  end;

{************************************************************************}

  procedure DisplayActionArrays;
  var
    Str   : String;
    Cnt   : Word;
    ColCnt: Byte;
  begin
    if ChannelCnt > 0 then
      begin
        Str := '';
        ColCnt := 1;
        Cnt := 1;
        while Cnt <= ChannelCnt do
          begin
            Str := Str + Pad(Trim(ChannelKeys[Cnt].Keyword), 12);
            Inc(Cnt);
            Inc(ColCnt);
            if ColCnt > 6 then
              begin
                Writeln(Str);
                Str := '';
                ColCnt := 1;
              end;
          end;
        if Str <> '' then
          Writeln(Str);
      end;
  end;

{************************************************************************}

end.