[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]

     {
     Program Name : Phone.Pas
     Written By   : Anonymous
     E-Mail       : nothing
     Web Page     : nothing
     Program
     Compilation  : Turbo Pascal 5.0 or later

     Program Description :

     Usefulness for BBS'S and general communications.
     For a detailed description of this code source, please,
     read the file TENTOOLS.DOC. Thank you
     }

    Program Phone;
    {$F+}
    Uses CRT,TenTools;

    Type
      S80 = String[80];

    Var
      RemoteID : S12;
      Caller : S12;
      NodeID   : S12;
      SendCount,I,TransType,Msgs : INteger;
      TransID : Real;
      SendString : S80;
      RcvString : S80;
      RcvLength : Integer;
      TenError : Word;
      Connect,Hangup,BeingCalled,Calling,CBMess : Boolean;
      X,Y,Gar : Integer;
      SendKey,SpecChar,Inchar : Char;

    Procedure Ring;
    Begin
       ClrScr;
       GotoXY(1,1);Write('With which node do you wish to converse: ');
       Readln(RemoteID);
       While Length(RemoteID)<12 do RemoteID:=RemoteID+' ';
       For I:=1 to 12 do RemoteID[I]:=Upcase(RemoteID[I]);
       ClrScr;
       SendString:='You are being "PHONE"ed...';
       TenError:=Chat(RemoteID,SendString);
       If TenError<>0
       then
        begin
           Writeln('Error Chatting...',TenError);
           Halt;
        end;
       SendCount:=0;
       TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,17,0);
       SendString:='';
       Window(1,1,80,25);
       GotoXY(1,25);
       TextColor(White);
       Write(
    'Ringing ',RemoteID,'  (A)bort ');
       ClrEol;
       Caller:=RemoteID;
       Calling:=True;
    End;

    Procedure Ignore;
    Begin
       SendString:='Cannot Talk Now...Sorry';
       TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,18,0);
       SendString:='';
       Caller:='';
       BeingCalled:=False;
       Hangup:=True;
    End;

    Procedure Answer;
    Begin
       RemoteID:=Caller;
       SendCount:=0;
       SendString:='Responding...';
       TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,17,0);
       SendString:='';
       If TenError<>0
       then
        begin
           Writeln('Error Sending String to ',Caller);
           Halt;
        end;
    End;

    Procedure ClearBuffers;
    Begin
       Repeat
          TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
       Until Msgs=0;
    End;

    Procedure Communicate;
    Begin
       X:=1;
       Y:=11;
       TextColor(White);
       Window(1,1,80,25);
       GotoXY(1,25);
       Write(
    '                          Press [F1] to end Conversation');
       GotoXY(1,12);
       Write(
    'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ     ',Caller,' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
       Window(1,1,80,24);
       Repeat
          RcvLength:=0;
          TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
    {      If Msgs>0 then Delay(20); }
          If ((TenError=0) and (Msgs>0))
          then while ((TenError=0) and (Msgs>0)) do
           begin
              TextColor(Red);
              Sound(1000);
              Delay(40);
              NoSound;
              GotoXY(1,WhereY);
              IF ((RemoteID=Caller)and(TransType=20))
              then
               begin
                  Window(1,13,80,24);
                  GotoXY(1,11);
                  Writeln('');
                  Writeln(RcvString);
               end;
              If ((RemoteID=Caller)and(TransType=19))
              then
               begin
                  Window(1,13,80,24);
                  GotoXY(1,11);
                  Writeln('');
                  Writeln(' ',RemoteID,' hung up!');
                  Write(' Press any key to Continue...');
                  InChar:=ReadKey;
                  Hangup:=True;
                  Calling:=False;
                  Connect:=False;
                  BeingCalled:=False;
                  Caller:='';
                  Msgs:=0;
               end;
              RcvString:='';
              If not Hangup then
              TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
              If Msgs>0 then Delay(20);
              If TenError<>0 then Writeln('10Net Error: ',TenError);
           end;
          If (Keypressed and not Hangup)
          then
           begin
              SendKey:=ReadKey;
              If SendKey=#0
              then
               begin
                  SpecCHar:=ReadKey;
                  If SpecCHar=#59
                  then
                   begin
                      Window(1,1,80,25);
                      GotoXY(1,25);
                      ClrEOL;
                      TextColor(White);
                      Write(
    '                   (E)nd Communication  (C)ontinue Communication');
                      Repeat
                         Inchar:=Upcase(Readkey);
                      Until (Inchar in ['E','C']);
                      If Inchar='E'
                      then
                       begin
                          Hangup:=True;
                          Connect:=False;
                          Caller:='';
                          GotoXY(1,25);
                          ClrEol;
                          Write(
    '                    Ending Communication...please wait...');
                          SendString:='CLICK';
                          TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,19,0);
                          SendString:='';
                          Window(1,1,80,25);
                          ClrScr;
                          Calling:=False;
                          BeingCalled:=False;
                       end;
                      GotoXY(1,25);
                      ClrEol;
                      GotoXY(1,25);
                      If not Hangup then
                      Write(
                   '                          Press [F1] to end Conversation');
                      Window(1,1,80,24);
                   end
                  else Write(#7);
               end
              else if Sendkey=#13
              then
               begin
                  Window(1,1,80,11);
                  GotoXY(X,Y);
                  Writeln('');
                  X:=WhereX;
                  Y:=WhereY;
                  Inc(SendCount);
                  TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,20,0);
                  SendString:='';
               end
              else
               begin
                  TextColor(Cyan);
                  Window(1,1,80,11);
                  GotoXY(X,Y);
                  SendString:=SendString+SendKey;
                  Write(SendKey);
                  X:=WhereX;
                  Y:=WhereY;
               end;
           end;
       Until Hangup;
       TextColor(White);
    End;

    Procedure ScreenCalls;
    Begin
       Repeat
          TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
          If Msgs>0 then Delay(20);
          If Msgs>0
          then
           begin
              If Calling
              then
               begin
                  If (RemoteID=Caller)
                  then
                   begin
                      If TransType=17 then Connect:=True;
                      If TransType=18
                      then
                       begin
                          GotoXY(1,25);
                          ClrEol;
                          Write(
    '              Call Refused...');
                          Sound(1000);
                          Delay(1000);
                          NoSound;
                          Hangup:=True;
                          Calling:=False;
                       end;
                   end;
               end
              else
               begin
                  If ((TransType=17) and (Caller=''))
                  then Caller:=RemoteID;
               end;
           end;
       Until (Msgs=0)
    End;

    Procedure ClearCalls;
    Begin
       Window(1,1,80,25);
       ClrScr;
       GotoXY(1,25);
       Write('(R)ing someone  (Q)uit');
       Hangup:=False;
    End;

    Begin  { Main }
      TenError:=TenConfig(80,80,20);
      If TenError<>0
      then
       Begin
          Writeln('Error Configuring TenTools...',TenError);
          Halt;
       end;
      Connect:=False;
      BeingCalled:=False;
      Calling:=False;
      Hangup:=False;
      TextBackground(Black);
      TextColor(Cyan);
      Window(1,1,80,25);
      ClrScr;
    {Main Menu}
      ClearBuffers;
      Repeat
         ClearCalls;
          Repeat
             ScreenCalls;
             If Connect
             then Communicate
             else if Keypressed
             then
              begin
                 Inchar:=Upcase(Readkey);
                 If not (Inchar in ['A','I','R','Q']) then Write(#7);
                 If ((Inchar='A') and BeingCalled)
                  then
                   begin
                      Answer;
                      Communicate;
                   end
                 else if ((Inchar='A')and Calling)
                 then
                  begin
                     Calling:=False;
                     Hangup:=True;
                     Caller:='';
                  end
                 else if Inchar='I'
                 then Ignore
                 else if Inchar='R'
                 then
                  begin
                     If Calling then Ignore;
                     Ring;
                  end
                 else
                  begin
                     Hangup:=True;
                     Sound(2000);
                     Delay(10);
                     NOsound;
                  end;
              end
             else if ((Caller<>'')and not (Calling or BeingCalled))
             then
              begin
                 BeingCalled:=True;
                 GotoXY(1,25);
                 Write('(R)ing someone (A)nswer  (I)gnore  (Q)uit');
              end;
          Until Hangup;
      Until Inchar in ['Q','q'];
      ClearBuffers;
    End.  { Program TenTAlk}

[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]