home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OOBPLS10.ZIP / TERMBP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-06  |  20.3 KB  |  711 lines
  1. {$A+,F+,R-,S-,V-}
  2. {$M 8192,0,$A0000}
  3.  
  4. {***********************************************}
  5. {*              TERMBP.PAS  1.02               *}
  6. {*   Copyright (c) TurboPower Software 1991    *}
  7. {*            All Rights Reserved              *}
  8. {***********************************************}
  9.  
  10. program TermBP;
  11.   {Example prog for BPlus protocols, including online GIF display}
  12.  
  13. {$I APDEFINE.INC}
  14.  
  15. {$IFNDEF UseOPro}
  16.   !!! The included defines are not compatible with this program !!!
  17. {$ENDIF}
  18.  
  19. {$IFNDEF UseOOP}
  20.   !!! The included defines are not compatible with this program !!!
  21. {$ENDIF}
  22.  
  23.   {The following two defines must match the state of the same defines in}
  24.   {OOBPLUS.PAS and GIFVIDEO.PAS}
  25.  
  26. {$DEFINE SupportGIF}
  27. {$DEFINE UseSVGA}
  28.  
  29. uses
  30.   DOS,
  31.   OpRoot,
  32.   OpDos,
  33.   OpCrt,
  34.   OpString,
  35.   OpKey,
  36.   ApMisc,
  37.   ApPort,
  38.   ApUart,
  39.   ApTimer,
  40.   ApAnsi,
  41.   OOCom,
  42.   OOAbsPcl,
  43.   OOBPlus,
  44.   GIFVideo,
  45.   OLGIF;
  46.  
  47. type
  48.   BufPtr = ^BufferArray;
  49.   BufferArray = array[0..MaxInt] of Char;
  50.  
  51. const
  52.   WAttr : Byte = $1B;          {Window attribute}
  53.   FAttr : Byte = $1E;          {Frame attribute}
  54.   DAttr : Byte = $1F;          {Data attribute}
  55.   StatusDelay = 2000;          {Delay 2 seconds for status messages}
  56.  
  57. var
  58.   UP : UartPortPtr;    {our port ptr}
  59.   BP : BPProtoFTP;     {B+ proto object}
  60.  
  61.   W : Word;
  62.   C : Char absolute W;
  63.   GotIt,
  64.   Finished : Boolean;
  65.   S : String;
  66.   BytesRead : Word;
  67.   B : array[1..1000] of Char;
  68.   OTMode : Byte;
  69.  
  70.   procedure Abort(Msg : String; Code : Integer);
  71.     {-Close port and halt}
  72.   begin
  73.     WriteLn(Msg, Code);
  74.     Halt(1);
  75.   end;
  76.  
  77.   procedure RingBell;
  78.     {-make a noise}
  79.   begin
  80.     Sound(440);
  81.     Delay(100);
  82.     NoSound;
  83.   end;
  84.  
  85. {--------------------------------------------------------------------------}
  86.  
  87.   function Long2StrBlank(L : LongInt) : string;
  88.     {-Convert a long/word/integer/byte/shortint to a string}
  89.   begin
  90.     if L <= 0 then
  91.       Long2StrBlank := ''
  92.     else
  93.       Long2StrBlank := Long2Str(L);
  94.   end;
  95.  
  96.   function BuildWindow(XLow, YLow, XHigh, YHigh : Byte; Header : String) : Pointer;
  97.     {-Saves the underlying screen, frames and clears a window}
  98.   type
  99.     FrameCharType = (ULeft, LLeft, URight, LRight, Horiz, Vert);
  100.     FrameArray = array[FrameCharType] of Char;
  101.   const
  102.     FrameChars : FrameArray = '╒╘╕╛═│';
  103.   var
  104.     CoversP : BufPtr;
  105.     WordsPerRow : Word;
  106.     BufBytes : Word;
  107.     SrcPos : Word;
  108.     DestPos : Word;
  109.     Row : Word;
  110.     HeaderLen : Byte absolute Header;
  111.     Width, HeaderPos : Byte;
  112.     Span : string[132];
  113.     SpanLen : Byte absolute Span;
  114.  
  115.   begin
  116.     BuildWindow := nil;
  117.  
  118.     {Compute number of words to move per row}
  119.     WordsPerRow := Succ(XHigh-XLow);
  120.  
  121.     {Compute bytes needed for screen buffer}
  122.     BufBytes := (WordsPerRow*Succ(YHigh-YLow)) shl 1;
  123.  
  124.     {Make sure enough memory is available}
  125.     if not GetMemCheck(CoversP, BufBytes) then
  126.       Exit;
  127.  
  128.     {Save current contents to the screen buffer}
  129.     DestPos := 0;
  130.     SrcPos := (Pred(YLow)*ScreenWidth+Pred(XLow)) shl 1;
  131.     for Row := YLow to YHigh do begin
  132.       MoveScreen(Mem[VideoSegment:SrcPos], CoversP^[DestPos], WordsPerRow);
  133.       Inc(SrcPos, ScreenWidth shl 1);
  134.       Inc(DestPos, WordsPerRow shl 1);
  135.     end;
  136.  
  137.     {Calculate width of window and position of header}
  138.     SpanLen := Succ(XHigh - XLow);
  139.     Width := SpanLen-2;
  140.  
  141.     {construct the upper border and draw it}
  142.     FillChar(Span[2], Width, FrameChars[Horiz]);
  143.     Span[1] := FrameChars[ULeft];
  144.     Span[SpanLen] := FrameChars[URight];
  145.     FastWrite(Span, YLow, XLow, FAttr);
  146.  
  147.     {Draw the vertical bars}
  148.     for Row := Succ(YLow) to Pred(YHigh) do begin
  149.       FastWrite(FrameChars[Vert], Row, XLow, FAttr);
  150.       FastWrite(FrameChars[Vert], Row, XHigh, FAttr);
  151.     end;
  152.  
  153.     {Draw the bottom border}
  154.     Span[1] := FrameChars[LLeft];
  155.     Span[SpanLen] := FrameChars[LRight];
  156.     FastWrite(Span, YHigh, XLow, FAttr);
  157.  
  158.     {Draw the header}
  159.     if HeaderLen > 0 then begin
  160.       if HeaderLen > Width then
  161.         HeaderLen := Width;
  162.       HeaderPos := (SpanLen-HeaderLen) shr 1;
  163.       FastWrite(Header, YLow, XLow + HeaderPos, FAttr);
  164.     end;
  165.  
  166.     {Fill in the window}
  167.     for Row := Ylow+1 to YHigh-1 do
  168.       FastWrite(CharStr(' ', Pred(XHigh-XLow)), Row, XLow+1, FAttr);
  169.  
  170.     BuildWindow := CoversP;
  171.   end;
  172.  
  173.   procedure RemoveWindow(P : Pointer; XLow, YLow, XHigh, YHigh : Byte);
  174.     {-Restore screen contents and deallocate buffer space if requested}
  175.   var
  176.     CoversP : BufPtr absolute P;
  177.     WordsPerRow : Word;
  178.     SrcPos : Word;
  179.     DestPos : Word;
  180.     Row : Word;
  181.   begin
  182.     {Compute number of words to move per row}
  183.     WordsPerRow := Succ(XHigh-XLow);
  184.  
  185.     {Restore current contents to the screen buffer}
  186.     DestPos := 0;
  187.     SrcPos := (Pred(YLow)*ScreenWidth+Pred(XLow)) shl 1;
  188.     for Row := YLow to YHigh do begin
  189.       MoveScreen(CoversP^[DestPos], Mem[VideoSegment:SrcPos], WordsPerRow);
  190.       Inc(SrcPos, ScreenWidth shl 1);
  191.       Inc(DestPos, WordsPerRow shl 1);
  192.     end;
  193.  
  194.     {Deallocate buffer space}
  195.     FreeMem(CoversP, (WordsPerRow*Succ(YHigh-YLow)) shl 1);
  196.   end;
  197.  
  198.   function ReadStrWin(Pr : String; var S : String) : Boolean;
  199.     {-prompt for a string in a window}
  200.   var
  201.     P : Pointer;
  202.     OX,OL : Word;
  203.     OA,B : Byte;
  204.   begin
  205.     ReadStrWin := False;
  206.     OA := TextAttr;
  207.     GetCursorState(OX,OL);
  208.     S := '';
  209.     P := BuildWindow(1,10,ScreenWidth,12,'');
  210.     if P = NIL then exit;
  211.  
  212.     FastWrite(Pr,11,3,WAttr);
  213.     GoToXYAbs(Length(Pr)+4,11);
  214.     TextAttr := DAttr;
  215.     S := '';
  216.     ReadLn(S);
  217.  
  218.     TextAttr := OA;
  219.     RestoreCursorState(OX,OL);
  220.     RemoveWindow(P,1,10,ScreenWidth,12);
  221.     ReadStrWin := (S <> '');
  222.   end;
  223.  
  224.   function FormatMinSec(TotalSecs : LongInt) : String;
  225.     {-Format TotalSecs as minutes:seconds}
  226.   var
  227.     Min, Sec : LongInt;
  228.     S : String;
  229.   begin
  230.     Min := TotalSecs div 60;
  231.     Sec := TotalSecs mod 60;
  232.     Str(Sec:2, S);
  233.     if S[1] = ' ' then
  234.       S[1] := '0';
  235.     FormatMinSec := Pad(Long2Str(Min) + ':' + S,8);
  236.   end;
  237.  
  238.   function FormatMinTenths(TotalSecs : LongInt) : String;
  239.     {-Format TotalSecs as minutes.tenths}
  240.   var
  241.     Min : Real;
  242.     S : String;
  243.   begin
  244.     Min := TotalSecs / 60;
  245.     Str(Min:6:1, S);
  246.     FormatMinTenths := Pad(S,8);
  247.   end;
  248.  
  249.   procedure UpdateProgressBar(Row, Col, Len : Byte; Percent : Real);
  250.     {-Fills in a progress bar with Percent complete}
  251.   const
  252.     CompleteChar = '▓';
  253.   var
  254.     CharPercent : Real;
  255.     CharCount : Byte;
  256.     BarStr : String;
  257.   begin
  258.     if Len = 0 then exit;
  259.     {Calculate "percent value" of each character space}
  260.     CharPercent := 100.0 / Len;
  261.  
  262.     {Calculate how many chars we need to approach (but not exceed) Percent}
  263.     CharCount := Trunc((Percent * 100) / CharPercent);
  264.  
  265.     {Make sure we don't go past Len}
  266.     if CharCount > Len then
  267.       CharCount := Len;
  268.  
  269.     {Write out the complete bar}
  270.     FillChar(BarStr[1], CharCount, CompleteChar);
  271.     BarStr[0] := Char(CharCount);
  272.     if CharCount <> 0 then
  273.       FastWrite(BarStr, Row, Col, DAttr);
  274.   end;
  275.  
  276.   procedure UpdateStatusMsg(Row, Col, Len : Byte);
  277.     {-Translate the current AsyncStatus into a status message}
  278.   const
  279.     LastStatus : Word = 65535;
  280.     MaxMsgLen = 40;
  281.   var
  282.     Msg : String;
  283.   begin
  284.     if AsyncStatus <> LastStatus then begin
  285.       FillChar(Msg[1], MaxMsgLen, ' ');
  286.       Msg[0] := Char(MaxMsgLen);
  287.       FastWrite(Msg, Row, Col, DAttr);
  288.       Msg := bpStatusStr(AsyncStatus);
  289.       FastWrite(Msg, Row, Col, DAttr);
  290.       if AsyncStatus <> 0 then Delay(2000);
  291.     end;
  292.   end;
  293.  
  294.  
  295. {$F+}
  296.   function WindowResume(BP : BPProtocolPtr) : ResumeResultType;
  297.   var
  298.     Res : ResumeResultType;
  299.     C : Char;
  300.     E : EventTimer;
  301.   begin
  302.     FastWrite(Pad('File Exists. (R)esume, (O)verwrite, re(N)ame, (A)bort?',57),18,12,DAttr);
  303.     RingBell;
  304.     NewTimerSecs(E,10);
  305.     repeat
  306.       while NOT KeyPressed do
  307.         if TimerExpired(E) then begin     {send WACK to host}
  308.           BP^.APort^.PutString(cDLE+';');
  309.           NewTimerSecs(E,10);
  310.         end;
  311.       C := Upcase(ReadKey);
  312.     until (C in ['A','N','O','R']);
  313.     FastWrite(Pad(' ',57),18,12,DAttr);
  314.     case C of
  315.       'A': WindowResume := xfrAbort;
  316.       'N': WindowResume := xfrRename;
  317.       'O': WindowResume := xfrOverwrite;
  318.       'R': WindowResume := xfrResume;
  319.     end;
  320.   end;
  321.  
  322.   procedure WindowStatus(AP : AbstractProtocolPtr;
  323.                          Starting, Ending : Boolean);
  324.     {-Default show status procedure}
  325.  
  326.   (*
  327.         ┌───────────────────── Protocol Upload ────────────────────┐
  328.   1     │ Protocol:       xxxxxxxxxx     Bytes sent:       xxxxxxx │
  329.   2     │ File name:      xxxxxxxxxx     Bytes recd:       xxxxxxx │
  330.   3     │ File size:      xxxxxx         Packets sent:     xxxxxxx │
  331.   4     │ Block check:    xxx            Packets recd:     xxxxxxx │
  332.   5     │ Block size:     xxxxx          Data bytes:       xxxxxxx │
  333.   6     │ Blocks to go:   xxxxx          Remaining:        xxxxxxx │
  334.   7     │                                                          │
  335.   8     │ Est. time:      xx.x           Total errors:     xxxxxxx │
  336.   9     │ Elapsed time:                  Throughput:       xxxxxxx │
  337.   10    │ Remaining time: xx.x           Efficiency:       xxxxxxx │
  338.   11    │                                                          │
  339.   12    │ Progress:       ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ │
  340.   13    │ Last Message:   Ok                                       │
  341.   14    │                                                          │
  342.         └──────────────────────────────────────────────────────────┘
  343.   *)
  344.  
  345.   const
  346.     XLow = 10;
  347.     YLow = 4;
  348.     XHigh = 69;
  349.     YHigh = 19;
  350.     P : Pointer = nil;
  351.     NewProgBar = '░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░';
  352.   var
  353.     Blocks : Integer;
  354.     Efficiency, MaxCPS, ActualCPS, R : Real;
  355.     CurBlockSize : Word;
  356.     CurElapsedTics : LongInt;
  357.     CurElapsedSecs : LongInt;
  358.     CurBlock : Word;
  359.     S : String;
  360.     I : Word;
  361.     B : Boolean;
  362.   begin
  363.     if Starting then with BPProtoFTPPtr(AP)^ do begin
  364.       {Build and frame the window}
  365.       P := BuildWindow(XLow, YLow, XHigh, YHigh,' BPlus Protocol ');
  366.       if P = nil then
  367.         Abort('Insufficient memory ', 1);
  368.  
  369.       {Write out the fixed text strings}
  370.       FastWrite('Protocol:', YLow+1, XLow+2, WAttr);
  371.       FastWrite('Check type:', YLow+2, XLow+2, WAttr);
  372.       FastWrite('File name:', YLow+3, XLow+2, WAttr);
  373.       FastWrite('File size:', YLow+4, XLow+2, WAttr);
  374.       FastWrite('Block size:', YLow+5, XLow+2, WAttr);
  375.       FastWrite('Blocks to go:', YLow+6, XLow+2, WAttr);
  376.  
  377.       FastWrite('Est. time:', YLow+8, XLow+2, WAttr);
  378.       FastWrite('Elapsed time:', YLow+9, XLow+2, WAttr);
  379.       FastWrite('Remaining time:', YLow+10, XLow+2, WAttr);
  380.  
  381.       FastWrite('Bytes sent:', YLow+1, XLow+33, WAttr);
  382.       FastWrite('Bytes recd:', YLow+2, XLow+33, WAttr);
  383.       FastWrite('Packets sent:', YLow+3, XLow+33, WAttr);
  384.       FastWrite('Packets recd:', YLow+4, XLow+33, WAttr);
  385.       FastWrite('Data bytes:', YLow+5, XLow+33, WAttr);
  386.       FastWrite('Remaining:', YLow+6, XLow+33, WAttr);
  387.  
  388.       FastWrite('Total errors:', YLow+8, XLow+33, WAttr);
  389.       FastWrite('Throughput:', YLow+9, XLow+33, WAttr);
  390.       FastWrite('Efficiency:', YLow+10, XLow+33, WAttr);
  391.  
  392.       FastWrite('Progress:', YLow+12, XLow+2, WAttr);
  393.       FastWrite('Status:', YLow+13, XLow+2, WAttr);
  394.       FastWrite(NewProgBar, YLow+12, XLow+18, DAttr);
  395.     end;
  396.  
  397.     {Update the data areas}
  398.     with BPProtoFTPPtr(AP)^ do begin
  399.       {Store common status info in local variables}
  400.       CurBlockSize := OurParams.BlkSize * 128;
  401.       BlockLen := CurBlockSize;
  402.       CurElapsedTics := ElapsedTime(Timer);
  403.       CurElapsedSecs := Tics2Secs(CurElapsedTics);
  404.  
  405.       {Protocol and file name}
  406.       FastWrite(ProtocolTypeString[ProtType], YLow+1, XLow+18, DAttr);
  407.       case GetCheckType of
  408.         bcChecksum1 : S := bcsChecksum1;
  409.         else S := bcsCrc16;
  410.       end;
  411.       FastWrite(S, YLow+2, XLow+18, DAttr);
  412.       FastWrite(Pad(StUpcase(GetFileName), 12), YLow+3, XLow+18, DAttr);
  413.  
  414.       {File size, packet size, check type and packets remaining}
  415.       FastWrite(LeftPad(Long2StrBlank(SrcFileLen),8), YLow+4, XLow+18, DAttr);
  416.       FastWrite(LeftPad(Long2Str(CurBlockSize),8), YLow+5, XLow+18, DAttr);
  417.       Blocks := Trunc((BytesRemaining+Pred(CurBlockSize)) div CurBlockSize);
  418.       FastWrite(LeftPad(Long2StrBlank(Blocks),8), YLow+6, XLow+18, DAttr);
  419.  
  420.       {Estimated time, elapsed time and time remaining}
  421.       if SrcFileLen > 0 then
  422.         FastWrite(Pad(FormatMinSec(EstimateTransferSecs(SrcFileLen)),8),
  423.                   YLow+8, XLow+18, DAttr);
  424.       FastWrite(Pad(FormatMinSec(CurElapsedSecs),8), YLow+9, XLow+18, DAttr);
  425.       if BytesRemaining > 0 then
  426.         FastWrite(Pad(FormatMinSec(EstimateTransferSecs(BytesRemaining)),8),
  427.                   YLow+10, XLow+18, DAttr);
  428.  
  429.       {Raw bytes sent and recd}
  430.       FastWrite(LeftPad(Long2StrBlank(S_Raw),8), YLow+1, XLow+50, DAttr);
  431.       FastWrite(LeftPad(Long2StrBlank(R_Raw),8), YLow+2, XLow+50, DAttr);
  432.  
  433.       {Blocks sent and recd}
  434.       FastWrite(LeftPad(Long2StrBlank(S_Packets),8), YLow+3, XLow+50, DAttr);
  435.       FastWrite(LeftPad(Long2StrBlank(R_Packets),8), YLow+4, XLow+50, DAttr);
  436.  
  437.       {Data counts}
  438.       FastWrite(LeftPad(Long2StrBlank(BytesTransferred),8), YLow+5, XLow+50, DAttr);
  439.       FastWrite(LeftPad(Long2StrBlank(BytesRemaining),8), YLow+6, XLow+50, DAttr);
  440.  
  441.       {Errors}
  442.       FastWrite(LeftPad(Long2Str(GetTotalErrors),8), YLow+8, XLow+50, DAttr);
  443.  
  444.       {Display an empty progress bar on startup}
  445.       if BytesTransferred = 0 then
  446.         FastWrite(NewProgBar, YLow+12, XLow+18, DAttr);
  447.  
  448.       {Update the progress bar (if the file size is known}
  449.       if SrcFileLen > 0 then
  450.         R := BytesRemaining / SrcFileLen
  451.       else
  452.         R := 1.0;
  453.       UpdateProgressBar(YLow+12, XLow+18, Length(NewProgBar), 1.0 - R);
  454.  
  455.       {Update status message}
  456.       UpdateStatusMsg(YLow+13, XLow+18, 35);
  457.  
  458.       {Calculate and display throughput}
  459.       if CurElapsedSecs > 0 then
  460.         ActualCPS := BytesTransferred / CurElapsedSecs
  461.       else
  462.         ActualCPS := 0.0;
  463.       FastWrite(LeftPad(Long2Str(Trunc(ActualCPS))+' CPS',8),
  464.                 YLow+9, XLow+50, DAttr);
  465.  
  466.         {Calculate and display efficiency}
  467.       MaxCPS := APort^.PR^.CurBaud div 10;
  468.       if MaxCPS > 0 then
  469.         Efficiency := (ActualCPS / MaxCPS) * 100.0
  470.       else
  471.         Efficiency := 0.0;
  472.       FastWrite(Real2Str(Efficiency, 7, 0)+'%', YLow+10, XLow+50, DAttr);
  473.     end;
  474.  
  475.     {Remove the window on the last status call}
  476.     if Ending then
  477.       RemoveWindow(P, XLow, YLow, XHigh, YHigh);
  478.   end;
  479.  
  480. {--------------------------------------------------------------------------}
  481.  
  482. {$IFDEF SupportGIF}
  483.  
  484.   procedure ShowGIF;
  485.     {-save screen, display GIF online}
  486.   const
  487.     TmpName = '$$TEMP$$.GIF';
  488.     TmpBSize = 8192;
  489.   var
  490.     SP : Pointer;
  491.     X,L : Word;
  492.     B : Boolean;
  493.     S : String;
  494.  
  495.     function SaveTempGIF(NewFN : PathStr) : Boolean;
  496.       {-save temp GIF capture file to new name by fastest means}
  497.     var P : Pointer;
  498.         C : Char;
  499.         W : Word;
  500.         T : PathStr;
  501.         F : File;
  502.     begin
  503.       SaveTempGIF := False;
  504.         {see if new name is on same drive as current}
  505.       C := DefaultDrive;
  506.       T := FExpand(NewFN);
  507.       if (C = T[1]) and (NOT(ExistFile(T))) then begin
  508.           {if so, just rename file and we're done}
  509.         Assign(F,TmpName);
  510.         Rename(F,T);
  511.         SaveTempGIF := (IOResult = 0);
  512.       end
  513.       else begin
  514.           {slow way}
  515.         if NOT GetMemCheck(P,TmpBSize) then exit;
  516.         W := CopyFile(TmpName,T,P,TmpBSize);
  517.         SaveTempGIF := (W = 0);
  518.         FreeMemCheck(P,TmpBSize);
  519.       end;
  520.     end;
  521.  
  522.     procedure KillTemp;
  523.       {-erase the temp file}
  524.     var F : File;
  525.     begin
  526.       Assign(F,TmpName);
  527.       Erase(F);
  528.       if IOResult = 0 then ;
  529.     end;
  530.  
  531.   begin
  532.       {save the screen for later}
  533.     if SaveWindow(1,1,ScreenWidth,ScreenHeight,True,SP) then begin
  534.       GetCursorState(X,L);
  535.  
  536.         {display the thing}
  537.       B := DisplayGIFOnline(UP, True);
  538.  
  539.         {restore the screen}
  540.       RestoreWindow(1,1,ScreenWidth,ScreenHeight,True,SP);
  541.       RestoreCursorState(X,L);
  542.  
  543.         {if the view/capture was OK, get a name and save the perm file}
  544.       if B then
  545.         if (ReadStrWin('GIF Name (<CR>=no save) ',S)) and (S <> '') then begin
  546.           S := StUpcase(S);
  547.           S := DefaultExtension(S,'GIF');
  548.           if SaveTempGIF(S) then
  549.             KillTemp
  550.           else
  551.             RingBell;
  552.         end;
  553.       UP^.PutChar(^M);  {host always waits for a CR after a GIF view}
  554.     end;
  555.   end;
  556.  
  557. {$ENDIF}
  558.  
  559.   procedure ProcessANSI(S : String);
  560.     {-handle our special ANSI/VT52 sequences}
  561.   var
  562.     C : Char;
  563.   begin
  564.     C := S[Length(S)];
  565.     case C of
  566. {$IFDEF SupportGIF}
  567.       'g':
  568.         if S[3] = '>' then              {GIF command: "[>dg" where d=0,1 or 2}
  569.           case S[4] of
  570.             '0': UP^.PutString(GIFReply + ^M);         {send GIF support info}
  571.             '1': ShowGIF;                               {GIF comming, show it}
  572.             '2': WriteStringAnsi(S); {"2" is to print the GIF, we don't do it}
  573.             else WriteStringAnsi(S);                                {I dunno!}
  574.           end;
  575. {$ENDIF}
  576.       'I':
  577.         if S[2] = 'I' then
  578.           BP.bpHandleESCI  {send host our Capabilities Response string}
  579.         else
  580.           WriteStringAnsi(S);
  581.  
  582.       else
  583.         WriteStringAnsi(S);
  584.     end;
  585.   end;
  586.  
  587.  
  588.   procedure Map(var C : Char);
  589.     {-mask recd char to 7 bits}
  590.   begin
  591.     C := Char(Byte(C) and $7F);
  592.   end;
  593.  
  594.   procedure HandleReceive;
  595.     {-process possible received character}
  596.   type
  597.     RcvStates = (rsNormal, rsEscSeen);
  598.   const
  599.     RecvState : RcvStates = rsNormal;
  600.     CapStr : String[40] = '';
  601.   var
  602.     C : Char;
  603.   begin
  604.     if UP^.CharReady then begin
  605.       UP^.GetChar(C);
  606.       Map(C);
  607.  
  608.       case RecvState of
  609.         rsEscSeen:
  610.           begin
  611.             CapStr := CapStr + C;
  612.             if C in ['A'..'Z','a'..'z'] then begin
  613.               ProcessAnsi(CapStr);
  614.               RecvState := rsNormal;
  615.             end;
  616.           end;
  617.  
  618.         rsNormal:
  619.           case C of
  620.             #5 :  {<ENQ>, reply}
  621.               BP.bpHandleENQ;
  622.             #8 :  {<BS>, make distructive}
  623.               Write(#8#32#8);
  624.             #12:  {<FF>, clear the screen}
  625.               ClrScr;
  626.             #16:  {<DLE>, start B+ session}
  627.               if BP.bpDLESeen then ;
  628.             #27:  {<ESC>, start of a term command}
  629.               begin
  630.                 CapStr := '' + #27;
  631.                 RecvState := rsEscSeen;
  632.               end;
  633.             else
  634.               Write(C);
  635.           end;
  636.       end;
  637.     end;
  638.   end;
  639.  
  640.   function HandleKey : Boolean;
  641.     {-process pressed keys}
  642.   var W : Word;
  643.       C : Char absolute W;
  644.   begin
  645.     HandleKey := False;
  646.     if NOT KeyPressed then exit;
  647.     W := ReadKeyWord;
  648.     case W of
  649.       AltX:
  650.         HandleKey := True;
  651.       else if C <> #0 then
  652.         UP^.PutChar(C);
  653.     end;
  654.   end;
  655.  
  656.  
  657.  
  658. begin
  659.   ClrScr;
  660.  
  661. {$IFDEF UseSVGA}
  662.  
  663.   if CurrentDisplay = VGA then begin
  664.       {we have a VGA, see if it's a supported SVGA.  We save & restore text
  665.        mode around this as DetectSVGAType can leave the card somewhat twisted}
  666.     OTMode := CurrentMode;
  667.     DetectSVGAType(True);
  668.     TextMode(OTMode);
  669.     ReinitCrt;
  670.     ClrScr;
  671.     if SVGAType = vtVESA then
  672.       WriteLn('Using detected VESA driver')
  673.     else if SVGAType <> 0 then
  674.       WriteLn('Found ',SVGANames[SVGAType],' chipset-based SVGA');
  675.   end;
  676.  
  677. {$ENDIF}
  678.  
  679.     {Open a port.  B+ protocol should have *minimum* of 2K recv buffer!}
  680.   UP := New(UartPortPtr, InitCustom(Com3, 2400, NoParity, 8, 1,
  681.                                     4096, 4096, DefPortOptions));
  682.   if UP = nil then
  683.     Abort('Failed to open port: ', AsyncStatus);
  684.   WriteLn('Com1 opened at 2400 N81');
  685.  
  686.     {set up our B+ protocol object}
  687.   if NOT BP.Init(UP,xfrRename) then begin
  688.     WriteLn('Failed to init protocol object');
  689.     Dispose(UP,Done);
  690.     Halt;
  691.   end;
  692.   BP.SetShowStatusProc(WindowStatus);
  693.   BP.bpSetResumeProc(WindowResume);
  694.  
  695.   WriteLn('Press <AltX> to quit');
  696.  
  697.     {Simple terminal}
  698.   repeat
  699.     {Process chars to send}
  700.     Finished := HandleKey;
  701.  
  702.     {Process chars received}
  703.     HandleReceive;
  704.  
  705.   until Finished;
  706.  
  707.   BP.Done;
  708.   Dispose(UP, Done);
  709. end.
  710.  
  711.