home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 13 / CDA13.ISO / cdactual / demobin / share / program / Pascal / 10TLST.ZIP / PHONE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-17  |  8.7 KB  |  333 lines
  1. Program Phone;
  2. {$F+}
  3. Uses CRT,TenTools;
  4.  
  5. Type
  6.   S80 = String[80];
  7.  
  8. Var
  9.   RemoteID : S12;
  10.   Caller : S12;
  11.   NodeID   : S12;
  12.   SendCount,I,TransType,Msgs : INteger;
  13.   TransID : Real;
  14.   SendString : S80;
  15.   RcvString : S80;
  16.   RcvLength : Integer;
  17.   TenError : Word;
  18.   Connect,Hangup,BeingCalled,Calling,CBMess : Boolean;
  19.   X,Y,Gar : Integer;
  20.   SendKey,SpecChar,Inchar : Char;
  21.  
  22. Procedure Ring;
  23. Begin
  24.    ClrScr;
  25.    GotoXY(1,1);Write('With which node do you wish to converse: ');
  26.    Readln(RemoteID);
  27.    While Length(RemoteID)<12 do RemoteID:=RemoteID+' ';
  28.    For I:=1 to 12 do RemoteID[I]:=Upcase(RemoteID[I]);
  29.    ClrScr;
  30.    SendString:='You are being "PHONE"ed...';
  31.    TenError:=Chat(RemoteID,SendString);
  32.    If TenError<>0
  33.    then
  34.     begin
  35.        Writeln('Error Chatting...',TenError);
  36.        Halt;
  37.     end;
  38.    SendCount:=0;
  39.    TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,17,0);
  40.    SendString:='';
  41.    Window(1,1,80,25);
  42.    GotoXY(1,25);
  43.    TextColor(White);
  44.    Write(
  45. 'Ringing ',RemoteID,'  (A)bort ');
  46.    ClrEol;
  47.    Caller:=RemoteID;
  48.    Calling:=True;
  49. End;
  50.  
  51. Procedure Ignore;
  52. Begin
  53.    SendString:='Cannot Talk Now...Sorry';
  54.    TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,18,0);
  55.    SendString:='';
  56.    Caller:='';
  57.    BeingCalled:=False;
  58.    Hangup:=True;
  59. End;
  60.  
  61. Procedure Answer;
  62. Begin
  63.    RemoteID:=Caller;
  64.    SendCount:=0;
  65.    SendString:='Responding...';
  66.    TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,17,0);
  67.    SendString:='';
  68.    If TenError<>0
  69.    then
  70.     begin
  71.        Writeln('Error Sending String to ',Caller);
  72.        Halt;
  73.     end;
  74. End;
  75.  
  76. Procedure ClearBuffers;
  77. Begin
  78.    Repeat
  79.       TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
  80.    Until Msgs=0;
  81. End;
  82.  
  83.  
  84. Procedure Communicate;
  85. Begin
  86.    X:=1;
  87.    Y:=11;
  88.    TextColor(White);
  89.    Window(1,1,80,25);
  90.    GotoXY(1,25);
  91.    Write(
  92. '                          Press [F1] to end Conversation');
  93.    GotoXY(1,12);
  94.    Write(
  95. '──────────────────────────────────     ',Caller,' ────────────────────────');
  96.    Window(1,1,80,24);
  97.    Repeat
  98.       RcvLength:=0;
  99.       TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
  100. {      If Msgs>0 then Delay(20); }
  101.       If ((TenError=0) and (Msgs>0))
  102.       then while ((TenError=0) and (Msgs>0)) do
  103.        begin
  104.           TextColor(Red);
  105.           Sound(1000);
  106.           Delay(40);
  107.           NoSound;
  108.           GotoXY(1,WhereY);
  109.           IF ((RemoteID=Caller)and(TransType=20))
  110.           then
  111.            begin
  112.               Window(1,13,80,24);
  113.               GotoXY(1,11);
  114.               Writeln('');
  115.               Writeln(RcvString);
  116.            end;
  117.           If ((RemoteID=Caller)and(TransType=19))
  118.           then
  119.            begin
  120.               Window(1,13,80,24);
  121.               GotoXY(1,11);
  122.               Writeln('');
  123.               Writeln(' ',RemoteID,' hung up!');
  124.               Write(' Press any key to Continue...');
  125.               InChar:=ReadKey;
  126.               Hangup:=True;
  127.               Calling:=False;
  128.               Connect:=False;
  129.               BeingCalled:=False;
  130.               Caller:='';
  131.               Msgs:=0;
  132.            end;
  133.           RcvString:='';
  134.           If not Hangup then
  135.           TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
  136.           If Msgs>0 then Delay(20);
  137.           If TenError<>0 then Writeln('10Net Error: ',TenError);
  138.        end;
  139.       If (Keypressed and not Hangup)
  140.       then
  141.        begin
  142.           SendKey:=ReadKey;
  143.           If SendKey=#0
  144.           then
  145.            begin
  146.               SpecCHar:=ReadKey;
  147.               If SpecCHar=#59
  148.               then
  149.                begin
  150.                   Window(1,1,80,25);
  151.                   GotoXY(1,25);
  152.                   ClrEOL;
  153.                   TextColor(White);
  154.                   Write(
  155. '                   (E)nd Communication  (C)ontinue Communication');
  156.                   Repeat
  157.                      Inchar:=Upcase(Readkey);
  158.                   Until (Inchar in ['E','C']);
  159.                   If Inchar='E'
  160.                   then
  161.                    begin
  162.                       Hangup:=True;
  163.                       Connect:=False;
  164.                       Caller:='';
  165.                       GotoXY(1,25);
  166.                       ClrEol;
  167.                       Write(
  168. '                    Ending Communication...please wait...');
  169.                       SendString:='CLICK';
  170.                       TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,19,0);
  171.                       SendString:='';
  172.                       Window(1,1,80,25);
  173.                       ClrScr;
  174.                       Calling:=False;
  175.                       BeingCalled:=False;
  176.                    end;
  177.                   GotoXY(1,25);
  178.                   ClrEol;
  179.                   GotoXY(1,25);
  180.                   If not Hangup then
  181.                   Write(
  182.                '                          Press [F1] to end Conversation');
  183.                   Window(1,1,80,24);
  184.                end
  185.               else Write(#7);
  186.            end
  187.           else if Sendkey=#13
  188.           then
  189.            begin
  190.               Window(1,1,80,11);
  191.               GotoXY(X,Y);
  192.               Writeln('');
  193.               X:=WhereX;
  194.               Y:=WhereY;
  195.               Inc(SendCount);
  196.               TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,20,0);
  197.               SendString:='';
  198.            end
  199.           else
  200.            begin
  201.               TextColor(Cyan);
  202.               Window(1,1,80,11);
  203.               GotoXY(X,Y);
  204.               SendString:=SendString+SendKey;
  205.               Write(SendKey);
  206.               X:=WhereX;
  207.               Y:=WhereY;
  208.            end;
  209.        end;
  210.    Until Hangup;
  211.    TextColor(White);
  212. End;
  213.  
  214.  
  215. Procedure ScreenCalls;
  216. Begin
  217.    Repeat
  218.       TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
  219.       If Msgs>0 then Delay(20);
  220.       If Msgs>0
  221.       then
  222.        begin
  223.           If Calling
  224.           then
  225.            begin
  226.               If (RemoteID=Caller)
  227.               then
  228.                begin
  229.                   If TransType=17 then Connect:=True;
  230.                   If TransType=18
  231.                   then
  232.                    begin
  233.                       GotoXY(1,25);
  234.                       ClrEol;
  235.                       Write(
  236. '              Call Refused...');
  237.                       Sound(1000);
  238.                       Delay(1000);
  239.                       NoSound;
  240.                       Hangup:=True;
  241.                       Calling:=False;
  242.                    end;
  243.                end;
  244.            end
  245.           else
  246.            begin
  247.               If ((TransType=17) and (Caller=''))
  248.               then Caller:=RemoteID;
  249.            end;
  250.        end;
  251.    Until (Msgs=0)
  252. End;
  253.  
  254. Procedure ClearCalls;
  255. Begin
  256.    Window(1,1,80,25);
  257.    ClrScr;
  258.    GotoXY(1,25);
  259.    Write('(R)ing someone  (Q)uit');
  260.    Hangup:=False;
  261. End;
  262.  
  263.  
  264. Begin  { Main }
  265.   TenError:=TenConfig(80,80,20);
  266.   If TenError<>0
  267.   then
  268.    Begin
  269.       Writeln('Error Configuring TenTools...',TenError);
  270.       Halt;
  271.    end;
  272.   Connect:=False;
  273.   BeingCalled:=False;
  274.   Calling:=False;
  275.   Hangup:=False;
  276.   TextBackground(Black);
  277.   TextColor(Cyan);
  278.   Window(1,1,80,25);
  279.   ClrScr;
  280. {Main Menu}
  281.   ClearBuffers;
  282.   Repeat
  283.      ClearCalls;
  284.       Repeat
  285.          ScreenCalls;
  286.          If Connect
  287.          then Communicate
  288.          else if Keypressed
  289.          then
  290.           begin
  291.              Inchar:=Upcase(Readkey);
  292.              If not (Inchar in ['A','I','R','Q']) then Write(#7);
  293.              If ((Inchar='A') and BeingCalled)
  294.               then
  295.                begin
  296.                   Answer;
  297.                   Communicate;
  298.                end
  299.              else if ((Inchar='A')and Calling)
  300.              then
  301.               begin
  302.                  Calling:=False;
  303.                  Hangup:=True;
  304.                  Caller:='';
  305.               end
  306.              else if Inchar='I'
  307.              then Ignore
  308.              else if Inchar='R'
  309.              then
  310.               begin
  311.                  If Calling then Ignore;
  312.                  Ring;
  313.               end
  314.              else
  315.               begin
  316.                  Hangup:=True;
  317.                  Sound(2000);
  318.                  Delay(10);
  319.                  NOsound;
  320.               end;
  321.           end
  322.          else if ((Caller<>'')and not (Calling or BeingCalled))
  323.          then
  324.           begin
  325.              BeingCalled:=True;
  326.              GotoXY(1,25);
  327.              Write('(R)ing someone (A)nswer  (I)gnore  (Q)uit');
  328.           end;
  329.       Until Hangup;
  330.   Until Inchar in ['Q','q'];
  331.   ClearBuffers;
  332. End.  { Program TenTAlk}
  333.