{$N+,E+}

Unit DoSubs1;

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

{*  The procedures are in the order that they appear in the main loop.

{*  A procedure will always start with "Do" and end with the name of the

{*    constant that calls it.

{*  These are the procedures that require interactive inputs or are very

{*    slow.

{*  The functions that BBSDosSub calls are in Unit BBSFuncs.

{*

{*  Test by placing BBS.EXE in a clean sub-directory by itself to see if

{*    it generates its needed files and sub-directories.

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

interface

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

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

Procedure DoWaitConnect;

Procedure DoWaitConnect_1;

Procedure DoGetName;

Procedure DoGetName_1;

Procedure DoGetName_2;

Procedure DoGetName_3;

Procedure DoUserInput;

Procedure DoPrompt;

Procedure DoPrompt_1;

Procedure DoLogOff;

Procedure DoLogOff_1;

Procedure DoDisconnect;

Procedure DoDisconnect_1;

Procedure DoDisconnect_2;

Procedure DoBulletins;

Procedure DoBullDel;

Procedure DoBullDel_1;

Procedure DoBullEdit;

Procedure DoBullNext;

Procedure DoBullNext_1;

Procedure DoBullPickedChild;

Procedure DoBullPickedChild_1;

Procedure DoBullPickedParent;

Procedure DoBullPickedParent_1;

Procedure DoBullPickedBull;

Procedure DoBullPickedBull_1;

Procedure DoBullPickedBull_2;

Procedure DoBullPost;

Procedure DoBullPost_1;

Procedure DoBullPrompt;

Procedure DoBullPrompt_1;

Procedure DoBullRead;

Procedure DoBullRead_1;

Procedure DoBullSubKill;

Procedure DoBullSubKill_1;

Procedure DoBullSubCon;

Procedure DoBullSubCon_1;

Procedure DoBullSubCon_2;

Procedure DoBullSubDown;

Procedure DoBullSubDown_1;

Procedure DoBullSubMake;

Procedure DoBullSubMake_1;

Procedure DoBullSubOpen;

Procedure DoBullSubUp;

Procedure DoBullSubUp_1;

Procedure DoCallBack;

Procedure DoCallBack_1;

Procedure DoCallBack_2;

Procedure DoCallBack_3;

Procedure DoCallBack_4;

Procedure DoComment;

Procedure DoComment_1;

Procedure DoEditAppend;

Procedure DoEditAppend_1;

Procedure DoEditDelete;

Procedure DoEditDelete_1;

Procedure DoEditDelete_2;

Procedure DoEditInsert;

Procedure DoEditInsert_1;

Procedure DoEditInsert_2;

Procedure DoEditModify;

Procedure DoEditModify_1;

Procedure DoEditModify_2;

Procedure DoEditPrompt;

Procedure DoEditPrompt_1;

Procedure DoFileShow;

Procedure DoFileShow_1;

Procedure DoHangUp;

Procedure DoHangUp_1;

Procedure DoHangUp_2;

Procedure DoHangUp_3;

Procedure DoMail;

Procedure DoMail_1;

Procedure DoMailSend;

Procedure DoMailSend_1;

Procedure DoMailSend_2;

Procedure DoMailRead;

Procedure DoMakePassword;

Procedure DoMakePassword_1;

Procedure DoMakePassword_2;

Procedure DoModemSetup;

Procedure DoModemSetup_1;



implementation

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

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

uses

  BBSFuncs,

  BBSGlbls,

  Bull,

  Crt,

  Dos,

  Disk,

  Glob,

  IOPorts,

  LCTKrnl,

  Misc,

  Monitor,

  Data,

  Time,

  UpDnLoad,

  UserData;



Procedure DoWaitConnect;

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

begin

  if JulianDateTimeNow > ResetDateTime[Port] then

    begin

      AreaSub(ModemSetUp);

      exit;

    end;

  if Port = 0 then

    begin

      if SessInStr[0] <> '' then

        AreaSub(GetName);

      exit;

    end;

  if pos('CONNECT', UpCaseStr(SessInStr[Port])) <> 0 then

    begin

      DateTimeLogOut[Port] := JulianDateTimeNow + ConnectTime;

      DelayBBS(3, WaitConnect_1);

    end

  else

    if IsCallBack[Port] and

      ( (Pos('BUSY', SessInStr[Port]) <> 0)

        or (Pos('NO DIALTONE', SessInStr[Port]) <> 0) ) then

          AreaSub(CallBack_3);

end;



Procedure DoWaitConnect_1;

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

begin

  if Pos('2400', SessInStr[Port]) <> 0 then

    Baud[Port] := 2400

  else

    if Pos('1200', SessInStr[Port]) <> 0 then

      Baud[Port] := 1200

    else

      if not(IsCallBack[Port]) then

        Baud[Port] := 300;

  DumBool := BaudSwitch(Port, Baud[Port]);

  Monitor.Wr(Port, SessInStr[Port]);

  SessInStr[Port] := '';

  DateTimeLogOut[Port] := JulianDateTimeNow + LogInTime;

  DelayBBS(1, GetName);

end;



Procedure DoUserInput;

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

var

  InChar: char;

  LenStr: byte;

  Letter: byte;

  Part1,

  Part2: string;

begin

  if JulianDateTimeNow > InputDeadLine[Port] then

    begin

      BeepTime[Port] := BeepTime[Port]*0.9;

      InputDeadLine[Port] := JulianDateTimeNow + BeepTime[Port];

      Say(Beep);

      if BeepTime[Port] < 0.001 then

        begin

          InputDeadLine[Port] := Infinity;

          SayL('');

          SayL('Your prompt input time has expired, '+UserName[Port]+'!');

          SayL('Disconnecting... Please call again later.');

          AreaSub(Disconnect);

        end;

    end;

  if length(SessInStr[Port]) = 0 then

    exit;

  Letter := 0;

  repeat

    LenStr := length(SessInStr[Port]);

    inc(Letter);

    InChar := SessInStr[Port, Letter];

    case InChar of

      BackSpace:

        begin

          if LenStr <> 1 then

            begin

              if Echo[Port] then

                Say(BackSpace+' '+BackSpace);

              Part1 := copy(SessInStr[Port], 1, Letter - 2);

              Part2 := copy(SessInStr[Port], Letter + 1, LenStr - Letter);

              SessInStr[Port] := Part1 + Part2;

              Dec(Letter, 3);

            end

          else

            begin

              Say(Beep);

              SessInStr[Port] := '';

            end;

        end;

      Enter:

        begin

          AreaPop;

          if AreaPeek <> Pause_1 then

            SayL('');

        end;

    end; {case}

  until (InChar = Enter) or (Letter = length(SessInStr[Port]));

end;



Procedure DoGetName;

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

var

  alpha: integer;

begin

  for alpha := 1 to 10 do

    SayL('');

  IdentifyBBS;

  VarPushInteger(0);

  FlushSessInput;

  Echo[Port] := true;

  AreaSub(GetName_1);

end;



Procedure DoGetName_1;

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

begin

  if VarPeekInteger = 3 then

    AreaSub(Disconnect)

  else

    Ask('Name:  ', GetName_2, 0);

end;



Procedure DoGetName_2;

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

var

  OK: boolean;

begin

  IsCallBack[Port] := IsCallBack[Port]

    and (UpCaseStr(UserName[Port]) = UpCaseStr(Reply));

  UserName[Port] := Reply;

  UserName[Port] := UpCaseFirstLetters(UserName[Port]);

  OK := ValidName;

  if not(OK) then

    begin

      Say(#7);

      SayL('I do not know anyone named '+UserName[Port]+'.');

      Ask('Are you new to this bulletin board? (y/N):  ', GetName_3, 0);

    end

  else

    AreaSub(PasswordGood);

end;



Procedure DoGetName_3;

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

var

  UserStr: string;

begin

  UserStr := Reply;

  if Upcase(UserStr[1]) = 'Y' then

    AreaSub(Register)

  else

    begin

      VarPushInteger(VarPopInteger + 1);

      SayL('');

      AreaSub(GetName_1);

    end;

end;



Procedure DoPrompt;

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

begin

  if UserMenu[Port] = 'ON' then

    MainMenu;

  SayL('');

  if MailCheck(true) then

    SayL('You have E-MAIL, '+UserName[Port]+'.')

  else

    SublimPick;

  ShowTimeLeft;

  Ask('MAIN COMMAND PROMPT (type H for Help):  ', Prompt_1, 1);

end;



Procedure DoPrompt_1;

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

var

  Command: string;

  Goodbye: boolean;

begin

  AreaSub(Prompt);

  ;

  SayL('');

  Command := Reply;

  if Command = '' then

    begin

      Say(Beep);

      exit;

    end;

  Command[1] := UpCase(Command[1]);

  Case Command[1] of

    'A':

      begin

        SayL('No additional sections available.');

        AreaPush(Pause);

      end;

    'B': AreaPush(Bulletins);

    'C': AreaPush(Comment);

    'D': AreaPush(Statistics);

    'E': AreaPush(Mail);

    'F': AreaPush(XFilePrompt);

    'G': AreaPush(LogOff);

    'H': if UserMenu[Port] <> 'ON' then

           MainMenu;

    'I':

      begin

        SayL('No information available at this time.');

        AreaPush(Pause);

      end;

  else

    begin

      Say(#7);

      SayL('Option "'+Command[1]+'" not available at this time.');

      AreaPush(Pause);

    end;

  end; {case}

end;



Procedure DoLogOff;

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

begin

  SayL('');

  Ask('Are you sure you want to Log Off now? (y/N):  ', LogOff_1, 1);

end;



Procedure DoLogOff_1;

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

var

  InStr: string;

begin

  InStr := Reply;

  if InStr = '' then

    InStr := 'N';

  if upcase(InStr[1]) = 'Y' then

    AreaSub(Disconnect)

  else

    AreaPop;

end;



Procedure DoDisconnect;

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

var

  alpha: integer;

begin

  Echo[Port] := false;

  SessInStr[Port] := '';

  VarTextCloseAll(Port);

  DateTimeLogOut[Port] := Infinity;

  if LoginOK[Port] then

    SayL('Goodbye, '+UserName[Port]+'!');

  SayL('Disconnected.');

  VarPushInteger(0);

  AreaSub(Disconnect_1);

end;



Procedure DoDisconnect_1;

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

var

  alpha: integer;

  ClearAttempts: integer;

begin

  ClearAttempts := VarPopInteger;

  if (ClearAttempts = 256) or OutputClear(Port) then

    begin

      AreaSub(Disconnect_2);

      AreaPush(HangUp);

    end

  else

    VarPushInteger(ClearAttempts + 1);

end;



Procedure DoDisconnect_2;

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

begin

  if LoginOK[Port] then

    UserData.Update;

  InitSessionVariables(Port);

end;



Procedure DoBulletins;

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

begin

  BullAreaID[Port]   := 0;

  BullAreaDir[Port]  := 0;

  BullAreaSubj[Port] := BullTopSubjectStr;

  AreaSub(BullPrompt);

end;



Procedure DoBullDel;

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

begin

  AreaSub(BullDel_1);

  AreaPush(BullPickedBull);

end;



Procedure DoBullDel_1;

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

var

  BullSABFileStr: string;

  DeadBull: integer;

  DeadBullFile: string;

  alpha: integer;

  Author: string;

begin

  DeadBull := VarPopInteger;

  if DeadBull = 0 then

    begin

      AreaPop;

      exit;

    end;

  BullSABFileStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]);

  if not(FileLine('R', BullSABFileStr, DeadBull + 1, DeadBullFile)) then

    begin

      SayL('Bulletin would not open!  Contact BBS Manager.');

      AreaPop;

      exit;

    end;

  DeadBullFile := UsersDir + '\' + DeadBullFile;

  if not(BullHeaderAuthor(DeadBullFile, Author)) then

    begin

      ErrSayL('Error:  ' + DeadBullFile + ' failed to open!');

      AreaPop;

      exit;

    end;

  if UserName[Port] <> Author then

    begin

      SayL('You are not the author of this bulletin.');

      if not(PrivCheck(true, BullKillPriv)) then

        begin

          AreaSub(Pause);

          exit;

        end;

    end;

  if FileLine('D', BullSABFileStr, DeadBull + 1, DumStr) then

    SayL('Bulletin deleted.')

  else

    SayL(#7 + 'Bulletin was NOT deleted.');

  AreaPop;

end;



Procedure DoBullEdit;

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

var

  Author: string;

  BullPicked: integer;

  BullIDStr: string;

begin

  BullPicked := VarPopInteger;

  AreaPop;

  if not(BullFile(BullAreaDir[Port], BullAreaID[Port], BullPicked, BullIDStr))

    then

      exit;

  if not(BullHeaderAuthor(BullIDStr, Author)) then

    begin

      ErrSayL('Error:  ' + BullIDStr + ' failed to open!');

      AreaPop;

      exit;

    end;

  if UserName[Port] <> Author then

    begin

      SayL('You are not the author of this bulletin.');

      if not(PrivCheck(true, BullEditPriv)) then

        begin

          AreaPush(Pause);

          exit;

        end;

    end;

  VarPushStr(BullIDStr);

  AreaPush(EditPrompt);

end;



Procedure DoBullNext;

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

begin

  if not(PrivCheck(true, BullReadPriv)) then

    begin

      AreaPush(Pause);

      exit;

    end;

  if FileCreate(UserDir(UserID[Port]) + '\' + Bull.NextSubjFile) then

    begin

      SayL('Searching '+DropBlanksEnd(BullAreaSubj[Port])+'...');

      AreaSub(BullNext_1);

    end

  else

    AreaPop;

end;



Procedure DoBullNext_1;

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

var

  BullID: integer;

  BullIDStr: string;

  BullReadBool: boolean;

  BullSABFileStr: string;

  BullToRead: W10k;

  Done: boolean;

  GetNextSubjArea: boolean;

  WasRead: boolean;

begin

  BullToRead := 1;

  Done := false;

  repeat

    BullSABFileStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]);

    GetNextSubjArea := false;

    if not(FileExists(BullSABFileStr)) then

      GetNextSubjArea := true;

    if not(GetNextSubjArea) and

      Disk.LineRead(BullSABFile(BullAreaDir[Port], BullAreaID[Port]),

       BullToRead + 1, BullIDStr) then

        begin

          BullID := IntStr(copy(BullIDStr, length(BullIDStr)-7, 4));

          BullIDStr := UsersDir + '\' + BullIDStr;

          WasRead

            := FileDataBool('R', BullReadFile, BullID-1, BullReadBool);

          if not(WasRead) or (WasRead and not(BullReadBool)) then

            begin

              BullReadMark(BullID);

              VarPushStr(BullIDStr);

              VarPushInteger(0); {* # of lines before-hand *}

              VarPushInteger(LinesPerPage[Port]);

              AreaSub(FileShow);

              exit;

            end;

        end

    else

      GetNextSubjArea := true;

    if GetNextSubjArea then

      begin

        if not(Bull.SubjAreaMarkNext) then

          begin

            SayL('All bulletins in subject areas that were not shut have'

              + ' been read.');

            Done := true;

            AreaSub(Pause);

          end

        else

          begin

            BullToRead := 0;

            SayL('Searching '+DropBlanksEnd(BullAreaSubj[Port])+'...');

          end;

      end;

    inc(BullToRead);

  until Done;

end;



Procedure DoBullPickedBull;

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

var

  BullCount,

  StartBull: integer;

begin

  BullCount := BullCountBulls(BullAreaID[Port]);

  if BullCount > 0 then

    begin

      VarPushInteger(BullCount);

      StartBull := BullCount - LinesPerPage[Port] + 2;

      if StartBull < 1 then

        StartBull := 1;

      VarPushInteger(StartBull);

{*      if BullCount > LinesPerPage[Port] then

*}

        Ask('First bulletin to list ['+StrInt(StartBull)+']:  ',

          BullPickedBull_1, 4)

{*      else

        AreaSub(BullPickedBull_1);

*}

    end

  else

    begin

      SayL(Beep+'There are no bulletins at this subject area level.');

      AreaSub(Pause);

      VarPushInteger(0);

    end;

end;



Procedure DoBullPickedBull_1;

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

var

  StartBullStr: string;

  StartBull,

  StopBull: integer;

begin

  StartBull := VarPopInteger;

  StopBull := VarPeekInteger;

  if StopBull > LinesPerPage[Port] then

    begin

      StartBullStr := Reply;

      if StartBullStr <> '' then

        StartBull := IntStr(StartBullStr);

      if StopBull > StartBull + LinesPerPage[Port] - 2 then

        StopBull := StartBull + LinesPerPage[Port] - 2;

    end;

  DumInt := BullListBulls(StartBull, StopBull);

  Ask('Which bulletin? [ENTER to cancel]:  ', BullPickedBull_2, 4);

end;



Procedure DoBullPickedBull_2;

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

var

  Count: integer;

  Picked: integer;

  InStr: string;

begin

  Count := VarPopInteger;

  InStr := Reply;

  if InStr = '' then

    begin

      VarPushInteger(0);

      AreaPop;

      exit;

    end;

  Picked := IntStr(InStr);

  if (Picked <= 0) or (Picked > Count) then

    begin

      AreaSub(BullPickedBull);

      exit;

    end;

  VarPushInteger(Picked);

  AreaPop;

end;



Procedure DoBullPickedChild;

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

var

  Count: integer;

begin

  if not(BullCountChildren(BullAreaID[Port]) > 0) then

    begin

      VarPushInteger(-1);

      AreaPop;

      exit;

    end;

  Count := BullListChildren(BullAreaDir[Port], BullAreaID[Port]);

  VarPushInteger(Count);

  Ask('Which lower subject path? [ENTER to cancel]:  ', BullPickedChild_1,

    0);

end;



Procedure DoBullPickedChild_1;

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

var

  Count: integer;

  Picked: integer;

  InStr: string;

begin

  Count := VarPopInteger;

  InStr := Reply;

  Picked := IntStr(InStr);

  if (Picked <= 0) or (Picked > Count) then

    begin

      VarPushInteger(0);

      AreaPop;

      exit;

    end;

  VarPushInteger(Picked);

  AreaPop;

end;



Procedure DoBullPickedParent;

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

var

  Count: integer;

begin

  if BullCountParents(BullAreaID[Port]) <= 0 then

    begin

      AreaPop;

      exit;

    end;

  Count := BullListParents(BullAreaDir[Port], BullAreaID[Port]);

  VarPushInteger(Count);

  Ask('Go up which subject path? [ENTER to cancel]:  ', BullPickedParent_1,

    0);

end;



Procedure DoBullPickedParent_1;

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

var

  Count: integer;

  Picked: integer;

  InStr: string;

begin

  Count := VarPopInteger;

  InStr := Reply;

  Picked := IntStr(InStr);

  if (Picked < 0) or (Picked > Count) then

    begin

      Say(Beep);

      AreaSub(BullPickedParent);

      exit;

    end;

  if Picked = 0 then

    begin

      AreaPop;

      exit;

    end;

  VarPushInteger(Picked);

  AreaPop;

end;



Procedure DoBullPost;

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

begin

  if not(PrivCheck(true, BullPostPriv)) then

    begin

      AreaPop;

      exit;

    end;

  Ask('Subject:  ', BullPost_1, 0);

end;



Procedure DoBullPost_1;

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

var

  BullHeader,

  BullFileName,

  BullSABFileStr:  string;

  BF: text;

  TopLine: string;

begin

  BullFileName := BullNextBulletin;

  BullSABFileStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]);

  TopLine := Bull.SABFileTopLine;

  if not(FileExists(BullSABFileStr)) then

    if FileCreate(BullSABFileStr) then

      DumBool := FileLine('O', BullSABFileStr, 1, TopLine);

  if not(Disk.LineAppend(BullSABFileStr, BullFileName)) then

    begin

      AreaSub(Pause);

      exit;

    end;

  if FileOpen('W', UsersDir + '\' + BullFileName, BF) = 0 then

    begin

      writeln(BF, 'Subject:  ', Reply);

      writeln(BF, 'Author :  ', UserName[Port]);

      writeln(BF, 'Date   :  ', DateTimeStrNow);

      writeln(BF, 'Expires:  ');

      writeln(BF, MultiChar('-',78));

      Close(BF);

      VarPushStr(UsersDir + '\' + BullFileName);

      AreaSub(EditAppend);

    end

  else

    AreaPop;

end;



Procedure DoBullPrompt;

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

begin

  if UserMenu[Port] = 'ON' then

    BullMenu;

  SayL('');

  SayL('Subject Area: '+BullAreaSubj[Port]);

  SayL(StrInt(BullCountParents(BullAreaID[Port])) +' subject area(s) above, '

    +  StrInt(BullCountChildren(BullAreaID[Port]))+' subject area(s) below, '

    +  StrInt(BullCountBulls(BullAreaID[Port]))   +' bulletin(s).');

  ShowTimeLeft;

  Ask('BULLETIN command prompt (Type H for help):  ', BullPrompt_1, 1);

end;



Procedure DoBullPrompt_1;

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

var

  InStr: string;

  UserOpt,

  UserType: char;

  Count: integer;

  NewSubjectArea: integer;

begin

  AreaSub(BullPrompt);

  InStr := Reply;

  ;

  SayL('');

  if InStr = '' then

    exit;

  UserOpt := upcase(InStr[1]);

  case UserOpt of

    'A': AreaPush(BullSubMake);

    'C': AreaPush(Comment);

    'D': AreaPush(BullSubDown);

    'E':

      begin

        AreaPush(BullEdit);

        AreaPush(BullPickedBull);

      end;

    'G':  AreaPush(Logoff);

    'H':  if UserMenu[Port] <> 'ON' then

                 BullMenu;

    'K': begin

           AreaPush(Pause);

           AreaPush(BullSubCon);

         end;

    'N': AreaPush(BullNext);

    'S': begin

           AreaPush(BullSubOpen);

           AreaPush(BullPickedChild);

         end;

    'P': AreaPush(BullPost);

    'Q': AreaPop;

    'R': AreaPush(BullRead);

    'B': begin

           AreaPush(Pause);

           AreaPush(BullSubKill);

         end;

    'T': begin

           AreaPush(Pause);

           AreaPush(BullDel);

         end;

    'U': AreaPush(BullSubUp);

    else

      begin

        SayL(Beep+'Option "'+UserOpt+'" not available at this time.');

        AreaPush(Pause);

      end;

  end; {case}

end;



Procedure DoBullRead;

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

begin

  if not(PrivCheck(true, BullReadPriv)) then

    begin

      AreaPop;

      exit;

    end;

  AreaSub(BullRead_1);

  AreaPush(BullPickedBull);

end;



Procedure DoBullRead_1;

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

var

  BullPicked: integer;

  BullIDStr: string;

  BullSABFileStr: string;

begin

  AreaPop;

  BullPicked := VarPopInteger;

  ;

  if BullPicked = 0 then

    exit;

  if BullFile(BullAreaDir[Port], BullAreaID[Port], BullPicked, BullIDStr) then

    begin

      BullReadMark(BullID(BullIDStr));

      VarPushStr(BullIDStr);

      VarPushInteger(0); {* # of lines before-hand *}

      VarPushInteger(LinesPerPage[Port]);

      AreaPush(FileShow);

    end;

end;



Procedure DoBullSubCon;

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

begin

  SayL(Beep+'Disabled.');

  AreaPop;

{*  AreaSub(BullSubCon_1);

  VarPushInt(0);

  VarPushInt(0);

*}

end;



Procedure DoBullSubCon_1;

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

begin

{*

  NewSub := VarPopInt;

  OldSub := VarPopInt;

  ;

  if NewSub = 0 then

    begin

      VarPushStr(

      VarPushInt(OldSub);

      AreaSub(BullSubCon_2);

      exit;

    end;

  SayL('Hit ENTER when you have picked the parent subject area...');

  VarPushInt(NewSub);

  AreaPush(BullPickedChildFrom(NewSub));

*}

end;



Procedure DoBullSubCon_2;

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

begin

{*

  ParentStr := VarPopStr;

  ParentNum := VarPopInt;

  BullFileConnect(ParentStr, BullSubAreaStr, ParentNum, BullArea);

  AreaPop;

*}

end;



Procedure DoBullSubDown;

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

begin

  if BullCountChildren(BullAreaID[Port]) = 1 then

    begin

      BullSwitchSubjectArea(1);

      AreaPop;

      exit;

    end;

  AreaSub(BullSubDown_1);

  AreaPush(BullPickedChild);

end;



Procedure DoBullSubDown_1;

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

var

  BSD: Integer;

begin

  AreaPop;

  BSD := VarPopInteger;

  if BSD = -1 then

    begin

      SayL(Beep + 'There are no subject areas below this one.');

      AreaPush(Pause);

    end

  else

    if BSD > 0 then

      BullSwitchSubjectArea(BSD);

end;



Procedure DoBullSubMake;

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

begin

  if not(PrivCheck(true, BullAreaMakePriv)) then

    begin

      AreaPop;

      exit;

    end;

  Ask('New subject area:  ', BullSubMake_1, BSALen);

end;



Procedure DoBullSubMake_1;

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

var

  BullSABFileStr: string;

  NewSubjectArea: W10k;

  Subject: string;

begin

  Subject := Reply;

  NewSubjectArea := BullNextSubjectArea;

  if Subject = '' then

    begin

      AreaPop;

      exit;

    end;

  if not(BullSAConnect(BullSAPFile(UserID[Port], NewSubjectArea),

    BullSACFile(BullAreaDir[Port], BullAreaID[Port]) )) then

      begin

        ErrSayL(#7 + 'ERROR:  Unable to add the subject area!');

        AreaSub(Pause);

        exit;

      end;

  BullSABFileStr := BullSABFile(UserID[Port], NewSubjectArea);

  if FileCreate(BullSABFileStr) then

    DumBool := Disk.LineAppend(BullSABFileStr, StrSized(Subject, BSALen));

  AreaPop;

end;



Procedure DoBullSubKill;

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

begin

  if not(PrivCheck(true, BullAreaKillPriv)) then

    begin

      AreaPop;

      exit;

    end;

  AreaSub(BullSubKill_1);

  AreaPush(BullPickedChild);

end;



Procedure DoBullSubKill_1;

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

begin

  DumBool := FileLine('D', BullSACFile(BullAreaDir[Port],

    BullAreaID[Port]), VarPopInteger + 1, DumStr);

  AreaPop;

end;



Procedure DoBullSubOpen;

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

var

  BullFileStr: string;

  Flipped: integer;

begin

  Flipped := VarPopInteger;

  AreaPop;

  DumBool := Bull.SubjAreaFlip(BullAreaDir[Port], BullAreaID[Port], Flipped);

end;



Procedure DoBullSubUp;

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

begin

  if BullAreaID[Port] = 0 then

    begin

      SayL(#7 + 'You are already at the top level.');

      AreaSub(Pause);

      exit;

    end;

  if BullCountParents(BullAreaID[Port]) = 1 then

    begin

      BullSwitchSubjectArea(-1);

      AreaPop;

      exit;

    end;

  AreaSub(BullSubUp_1);

  AreaPush(BullPickedParent);

end;



Procedure DoBullSubUp_1;

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

begin

  BullSwitchSubjectArea(-VarPopInteger);

  AreaPop;

end;



Procedure DoCallBack;

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

var

  Phone: string;

begin

  if not(UserData.GetPhone(Phone)) then

    begin

      AreaSub(Prompt);

      exit;

    end;

  Phone := StrPhone(Phone);

  Ask('Do you want this Wyrm BBS to call you back right now at '

    +Phone+' (Y/n)?:  ', CallBack_1, 1);

end;



Procedure DoCallBack_1;

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

var

  YesStr: string;

begin

  YesStr := Reply;

  if upcase(YesStr[1]) = 'N' then

    AreaPop

  else

    begin

      SayL('Please give your modem the automatic answer command "ATA".');

      VarPushInteger(0);

      AreaSub(CallBack_2);

    end;

end;



Procedure DoCallBack_2;

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

var

  alpha: integer;

  ClearAttempts: integer;

begin

  ClearAttempts := VarPopInteger;

  if Echo[Port] or (DateTimeLogOut[Port] <> Infinity) then

    begin

      Echo[Port] := false;

      SessInStr[Port] := '';

      DateTimeLogOut[Port] := Infinity;

      SayL('Goodbye, '+UserName[Port]+'!');

      SayL('Disconnected.');

    end;

  if (ClearAttempts = 256) or OutputClear(Port) then

    begin

      AreaSub(CallBack_3);

      AreaPush(HangUp);

    end

  else

    VarPushInteger(ClearAttempts + 1);

end;



Procedure DoCallBack_3;

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

begin

  UserData.Update;

  AreaPop;

  AreaSub(CallBack_4);

  DateTimeLogOut[Port] := JulianDateTimeNow + CallBackTime;

  IsCallBack[Port] := true;

end;



Procedure DoCallBack_4;

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

var

  Phone: string;

begin

  if not(UserData.GetPhone(Phone)) then

    begin

      AreaSub(Disconnect);

      exit;

    end;

  SessInStr[Port] := '';

  Delay(ModemDelay);

  SayL('ATDT'+Phone);

  AreaSub(WaitConnect);

end;



Procedure DoComment;

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

var

  alpha: integer;

  EFile: string;

begin

  SayL('');

  SayL('Paging the System Operator (SYSOP)...');

  for alpha := 1 to 6 do

    Say(#7);

  SayL('Please enter your comment, '+UserName[Port]+'.');

  SayL('The SYSOP will interrupt eventually if available.');

  Ask('Subject [ENTER = cancel]:  ', Comment_1, 0);

end;



Procedure DoComment_1;

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

var

  SubjectStr: string;

  EFile: string;

  EM: text;

begin

  SubjectStr := Reply;

  if SubjectStr = '' then

    begin

      AreaPop;

      exit;

    end;

  EFile := MailNext;

  if DirExists(UserDir(0)) then

    if FileOpen('A', UserDir(0) + '\' + MailBox, EM) = 0 then

      begin

        writeln(EM, UserName[Port]);

        writeln(EM, SubjectStr);

        writeln(EM, EFile);

        close(EM);

      end;

  VarPushStr(EFile);

  AreaSub(EditAppend);

end;



Procedure DoEditAppend;

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

{* pops the file name

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

var

  FileStr: string;

  BlankCount: Integer;

begin

  FileStr := VarPopStr;

  Inc(VarTextTOS[Port]);

  if FileOpen('A', FileStr, VarText[Port, VarTextTOS[Port]]) = 0 then

    begin

      WordWrap[Port] := true;

      SayL('Enter two blank lines to quit and save.');

      SayL(MultiChar('-', LineLen));

      AreaSub(EditAppend_1);

      BlankCount := 0;

      VarPushInteger(BlankCount);

      Ask('', EditAppend_1, 0);

    end

  else

    begin

      ErrSayL('File "'+FileStr+'" would not open for writing!!!');

      AreaPop;

    end;

end;



Procedure DoEditAppend_1;

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

var

  InStr: string;

  BlankCount: Integer;

begin

  BlankCount := VarPopInteger;

  InStr := Reply;

  if InStr = '' then

    Inc(BlankCount);

  if BlankCount = 0 then

    writeln(VarText[Port, VarTextTOS[Port]], InStr);

  if BlankCount = 1 then

    if InStr <> '' then

       begin

         BlankCount := 0;

         writeln(VarText[Port, VarTextTOS[Port]]);

         writeln(VarText[Port, VarTextTOS[Port]], InStr);

       end;

  VarPushInteger(BlankCount);

  if BlankCount = 2 then

    begin

      DumInt := VarPopInteger;

      Close(VarText[Port,VarTextTOS[Port]]);

      Dec(VarTextTOS[Port]);

      WordWrap[Port] := false;

      AreaPop;

    end

  else

    Ask('', EditAppend_1, 0);

end;



Procedure DoEditDelete;

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

begin

  Ask('Please enter the number of the line to delete [ENTER = cancel]:  ',

    EditDelete_1, 0);

end;



Procedure DoEditDelete_1;

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

var

  DeadLine,

  LineStr: string;

begin

  DeadLine := Reply;

  if DeadLine = '' then

    begin

      AreaPop;

      exit;

    end;

  if FileLine('R', VarPeekStr, IntStr(DeadLine), LineStr) then

    begin

      SayL(LineStr);

      VarPushInteger(IntStr(DeadLine));

      Ask('Delete this line (y/N):  ', EditDelete_2, 1);

    end

  else

    begin

      SayL('');

      SayL(Beep+'Error with the line number or file.  Line NOT deleted.');

      AreaSub(Pause);

    end;

end;



Procedure DoEditDelete_2;

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

var

  DeadLine: integer;

  LicenseToKill: string;

begin

  AreaPop;

  LicenseToKill := Reply;

  DeadLine := VarPopInteger;

  if not((upcase(LicenseToKill[1]) = 'Y')

    and FileLine('D', VarPeekStr, DeadLine, DumStr)) then

      begin

        SayL('');

        SayL('Line was NOT deleted.');

        AreaPush(Pause);

      end;

end;



Procedure DoEditInsert;

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

begin

  Ask('Insert a new line before which line? [ENTER = cancel]:  ',

    EditInsert_1, 0);

end;



Procedure DoEditInsert_1;

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

var

  Where: integer;

begin

  Where := IntStr(Reply);

  if Where = 0 then

    begin

      AreaPop;

      exit;

    end;

  VarPushInteger(Where);

  SayL('Please enter the new line.');

  Ask('', EditInsert_2, 0);

end;



Procedure DoEditInsert_2;

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

var

  NewLine: string;

  Where: integer;

begin

  NewLine := Reply;

  Where := VarPopInteger;

  DumBool := FileLine('I', VarPeekStr, Where, NewLine);

  AreaPop;

end;



Procedure DoEditModify;

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

begin

  Ask('Please enter the number of the line to modify [ENTER = cancel]:  ',

    EditModify_1, 0);

end;



Procedure DoEditModify_1;

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

var

  ModLine: integer;

  OldLine: string;

begin

  ModLine := IntStr(Reply);

  if ModLine = 0 then

    begin

      AreaPop;

      exit;

    end;

  if FileLine('R', VarPeekStr, ModLine, OldLine) then

    begin

      VarPushInteger(ModLine);

      SayL(OldLine);

      SayL('Please enter the line again with changes.');

      Ask('', EditModify_2, 0);

    end

  else

    AreaPop;

end;



Procedure DoEditModify_2;

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

var

  ModifiedLine: string;

begin

  ModifiedLine := Reply;

  DumBool := FileLine('O', VarPeekStr, VarPopInteger, ModifiedLine);

  AreaPop;

end;



Procedure DoEditPrompt;

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

begin

  if UserMenu[Port] = 'ON' then

    EditMenu;

  SayL('');

  SayL('Editing file "'+ VarPeekStr + '".');

  ShowTimeLeft;

  Ask('EDITOR command prompt (type H for Help):  ', EditPrompt_1, 1);

end;



Procedure DoEditPrompt_1;

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

var

  InStr: string;

  UserOpt: char;

begin

  AreaSub(EditPrompt);

  InStr := Reply;

  ;

  SayL('');

  if InStr = '' then

    exit;

  UserOpt := upcase(InStr[1]);

  case UserOpt of

    'A':  begin

            VarPushStr(VarPeekStr);

            AreaPush(EditAppend);

          end;

    'C':  AreaPush(Comment);

    'D':  AreaPush(EditDelete);

    'G':  AreaPush(Logoff);

    'H':  if UserMenu[Port] <> 'ON' then

            EditMenu;

    'I':  AreaPush(EditInsert);

    'L':  begin

            VarPushStr(VarPeekStr);

            VarPushInteger(0);

            VarPushInteger(-LinesPerPage[Port]);

            AreaPush(FileShow);

          end;

    'M':  AreaPush(EditModify);

    'Q':  begin

            AreaPop;

            DumStr := VarPopStr;

          end;

    'S':  begin

            VarPushStr(VarPeekStr);

            VarPushInteger(0);

            VarPushInteger(LinesPerPage[Port]);

            AreaPush(FileShow);

          end;

    else

      begin

        SayL(Beep+'Option "'+UserOpt+'" not available at this time.');

        AreaPush(Pause);

      end;

  end; {case}

end;



Procedure DoFileShow;

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

{*  pops an area

{*  pops a string   :  FileStr

{*  pops a Integer  :  LinesPerPage   -- if negative, adds line #'s

{*  pops a Integer  :  Shortened

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

var

  FileStr: string;

  LinesPerPage,

  Shortened: Integer;

  TextNum: integer;

begin

  FileStr := VarPopStr;

  LinesPerPage := VarPopInteger;

  Shortened := VarPopInteger;

  ;

  TextNum := VarPushText;

  if not(FileOpen('R', FileStr, VarText[Port, TextNum]) = 0) then

    begin

      SayL('Sorry, the file you wanted to read would not open.');

      exit;

    end;

  SayL(MultiChar('-', 78));

  VarPushInteger(Shortened + 1);

  VarPushInteger(LinesPerPage);

  AreaSub(FileShow_1);

end;



Procedure DoFileShow_1;

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

var

  LinesPerPage: integer;

  LineCount: integer;

  LineStr: string;

  TextNum: integer;

  WithLineNumbers: boolean;

begin

  LinesPerPage := VarPopInteger;

  WithLineNumbers := LinesPerPage < 0;

  if WithLineNumbers then

    LinesPerPage := (-LinesPerPage) div 2;

  LineCount := VarPopInteger;

  TextNum := VarPeekTextNum;

  if not(EOF(VarText[Port, TextNum])) then

    begin

      readln(VarText[Port, TextNum], LineStr);

      if WithLineNumbers then

        SayL(StrInt(LineCount));

      SayL(LineStr);

      inc(LineCount);

      if (LineCount + 1) mod LinesPerPage = 0 then

        AreaPush(Pause);

      VarPushInteger(LineCount);

      if WithLineNumbers then

        LinesPerPage := (-LinesPerPage)*2;

      VarPushInteger(LinesPerPage);

    end

  else

    begin

      Close(VarText[Port, TextNum]);

      DumInt := VarPopTextNum;

      SayL(MultiChar('-', 78));

      AreaSub(Pause);

    end;

end;



Procedure DoHangUp;

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

begin

  if Port = 0 then

    begin

      AreaPop;

      exit;

    end;

  DelayBBS(2, HangUp_1);

end;



Procedure DoHangUp_1;

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

begin

  Say('+++');

  DelayBBS(2, HangUp_2);

end;



Procedure DoHangUp_2;

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

begin

  Say('ATH0'+Enter);

  DelayBBS(4, HangUp_3);

end;



Procedure DoHangUp_3;

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

begin

  AreaPop;

end;



Procedure DoMail;

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

begin

  if UserMenu[Port] = 'ON' then

    MailMenu;

  SayL('');

  DumBool := MailCheck(false);

  ShowTimeLeft;

  Ask('E-MAIL Command Prompt (H for Help Menu):  ', Mail_1, 0);

end;



Procedure DoMail_1;

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

var

  InStr: string;

  Command: char;

begin

  AreaSub(Mail);

  InStr := Reply;

  ;

  SayL('');

  Command := upcase(InStr[1]);

  case Command of

    'C': AreaPush(Comment);

    'R': AreaPush(MailRead);

    'S': AreaPush(MailSend);

    'G': AreaPush(LogOff);

    'H': if UserMenu[Port] <> 'ON' then

                MailMenu;

    'Q': AreaPop;

    else

      SayL(Beep+'"'+Command+'" not available from this command prompt.');

  end; {case}

end;



Procedure DoMailSend;

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

begin

  Ask('Subject [ENTER = cancel]:  ', MailSend_1, 0);

end;



Procedure DoMailSend_1;

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

var

  SubjectStr: string;

begin

  SubjectStr := Reply;

  if SubjectStr = '' then

    begin

      AreaPop;

      exit;

    end;

  VarPushStr(MailNext);

  VarPushStr(SubjectStr);

  Ask('To [ENTER = no more recipients]:  ', MailSend_2, 0);

end;



Procedure DoMailSend_2;

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

var

  SubjectStr: string;

  InStr: string;

  ToUser: integer;

  ToUserStr: string;

  EM: text;

  EFile: string;

begin

  SubjectStr := VarPopStr;

  EFile := VarPeekStr;

  InStr := Reply;

  ;

  if InStr = '' then

    begin

      AreaSub(EditAppend);

      exit;

    end;

  VarPushStr(SubjectStr);

  ToUser := UserFindID(InStr);

  ToUserStr := StrInt(ToUser);

  if ToUser = -1 then

    SayL(Beep+'I do not kPort "'+InStr+'".')

  else

    if DirExists(UserDir(ToUser)) then

      if FileOpen('A', UserDir(ToUser) + '\' + MailBox, EM) = 0 then

        begin

          writeln(EM, UserName[Port]);

          writeln(EM, SubjectStr);

          writeln(EM, EFile);

          close(EM);

        end;

  Ask('To [ENTER = no more recipients]:  ', MailSend_2, 0);

end;



Procedure DoMailRead;

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

var

  Userbox: string;

  InStr: string;

begin

  if not(MailCheck(false)) then

    begin

      AreaSub(Pause);

      exit;

    end;

  UserBox := UserDir(UserID[Port]) + '\' + MailBox;

  if FileLine('R', UserBox, 1, InStr) then

    begin

      SayL('Letter from '+InStr+'...');

      DumBool := FileLine('D', UserBox, 1, DumStr);

    end;

  if FileLine('R', UserBox, 1, InStr) then

    begin

      SayL('Subject:  '+InStr);

      DumBool := FileLine('D', UserBox, 1, DumStr);

    end;

  if FileLine('R', UserBox, 1, InStr) then

    begin

      DumBool := FileLine('D', UserBox, 1, DumStr);

      VarPushInteger(0);

      VarPushInteger(LinesPerPage[Port]);

      VarPushStr(InStr);

      AreaSub(FileShow);

    end;

end;



Procedure DoMakePassword;

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

begin

  if UserID[Port] = 0 then

    begin

      SayL(Beep+'MANAGER cannot change the MANAGER PASSWORD.');

      AreaPop;

      exit;

    end;

  SayL('');

  Say('Please enter a password of at least '+StrInt(PasswordMinLen));

  SayL(' characters.');

  SayL('The password will not show on the screen.  Please ENTER when done.');

  Echo[Port] := false;

  Ask('Password:', MakePassword_1, 0);

end;



Procedure DoMakePassword_1;

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

begin

  Password1 := Reply;

  if length(password1) < PassWordMinLen then

    begin

      SayL('');

      SayL(Beep+'Your password must be at least '+StrInt(PassWordMinLen)

        + ' characters long please!');

      AreaSub(MakePassword);

    end

  else

    begin

      SayL('Please enter your password again to safeguard against typos.');

      Ask('Password:', MakePassword_2, 0);

    end;

end;



Procedure DoMakePassword_2;

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

begin

  Password2 := Reply;

  if password1 <> password2 then

    begin

      SayL('');

      SayL(Beep+'The second entry was not the same.  Please re-enter the'

        + ' first again.');

      AreaSub(MakePassword);

      exit;

    end;

  Echo[Port] := true;

  if not(FileExists(UserFile(UserID[Port]))) then

    DumBool := FileCreate(UserFile(UserID[Port]));

  if not(FileLine('O', UserFile(UserID[Port]), 1, password1)) then

    SayL(Beep+'Warning:  password was not successfully saved to disk!');

  AreaPop;

end;



Procedure DoModemSetup;

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

begin

  if Port = 0 then

    begin

      AreaSub(WaitConnect);

      exit;

    end;

  VarPushInteger(0);

  AreaSub(ModemSetup_1);

  AreaPush(HangUp);

end;



Procedure DoModemSetup_1;

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

var

  alpha: integer;

  ModCom: Integer;

begin

  ModCom := VarPopInteger;

  if ModCom <> 0 then

    begin

      Monitor.Wr(Port, SessInStr[Port]);

      SessInStr[Port] := '';

    end;

  case ModCom of

    0: begin

         PutStr(Port, 'AT');

    {* just to clear the air *}

       end;

    1:  PutStr(Port, 'AT&F');

    {* initial factory configuration *}

    2:  PutStr(Port, 'ATQ0');

    {* modem returns result codes *}

    3:  PutStr(Port, 'ATV1');

    {* full result codes *}

    4:  PutStr(Port, 'ATE1');

    {* modem echoes commands *}

    5:  PutStr(Port, 'ATF1');

    {* full duplex *}

    6:  PutStr(Port, 'ATX4');

    {* wait for dial tone, connect results, display BUSY *}

    7:  PutStr(Port, 'ATM0');

    {* speaker off - ATM0 *}

    8:  PutStr(Port, 'ATS0=1');

    {* answer on the first ring *}

    9:

      begin

        ResetDateTime[Port] := JulianDateTimeNow + (15*60);

        AreaSub(WaitConnect);

        exit;

      end;

  end; {* case *}

  PutStr(Port, Enter);

  DelayBBS(1.5, ModemSetup_1);

  VarPushInteger(ModCom + 1);

end;



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

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

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

begin

end.