home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / turbopas / ltc55.zip / LCDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-05-14  |  28KB  |  1,039 lines
  1. {$A-,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3. PROGRAM LCDEMO;
  4. (*
  5. ** LCDEMO is Copyright (c) 1989, Information Technology Ltd.
  6. **           -- All Rights Reserved --
  7. **
  8. ** Note: To recompile this program, you must have Technojock's Turbo Toolkit
  9. **       by TechnoJock Software, Inc; PO Box 820927, Houston, TX 77282
  10. **
  11. *)
  12.  
  13. USES Crt, Dos, Printer, FastTTT5, IOTTT5, KeyTTT5, MiscTTT5, NestTTT5, ReadTTT5,
  14.      StrnTTT5, WinTTT5, LctKrnl, LctSupp, LctYMBat, LTXmKrnl, LTXmodem;
  15.  
  16. TYPE
  17.   BytePtr = ^BYTE;
  18.  
  19.   PtrRec = RECORD
  20.     Ofs, Seg : WORD;
  21.   END;
  22.  
  23.   ConfigRec = RECORD
  24.     ComPort  : INTEGER;
  25.     BaudRate : WORD;
  26.     Parity   : CHAR;
  27.     DataBits : INTEGER;
  28.     StopBits : INTEGER;
  29.     Changed  : BOOLEAN;
  30.   END;
  31.  
  32. VAR
  33.   Main_Menu : Nest_Menu;
  34.   Desk_Menu : Nest_Menu;
  35.   Dnl_Menu  : Nest_Menu;
  36.   Upl_Menu  : Nest_Menu;
  37.   Opt_Menu  : Nest_Menu;
  38.   Port_Menu : Nest_Menu;
  39.   Set_Menu  : Nest_Menu;
  40.   Quit_Menu : Nest_Menu;
  41.  
  42.   HostMode  : BOOLEAN;
  43.   LocalEcho : BOOLEAN;
  44.   ExitActive : BOOLEAN;
  45.   GotEsc     : BOOLEAN;
  46.  
  47.   CurrConfig : ConfigRec;
  48.   CfgFile    : FILE OF ConfigRec;
  49.  
  50.   XMBlksize  : INTEGER;
  51.  
  52. PROCEDURE ShowPortStatus;
  53. VAR
  54.   X, Y, Top, Bottom : BYTE;
  55.   DispStr : STRING;
  56.   WkStr : STRING[18];
  57.  
  58. BEGIN
  59.   WITH CurrConfig DO
  60.   BEGIN
  61.     FindCursor(X, Y, Top, Bottom);
  62.     OffCursor;
  63.     CASE ComPort OF
  64.       1 : DispStr := 'COM1,';
  65.       2 : DispStr := 'COM2,';
  66.       3 : DispStr := 'COM3,';
  67.       4 : DispStr := 'COM4,';
  68.     END;
  69.     WkStr := Int_to_Str(BaudRate);
  70.     DispStr := DispStr + WkStr + ',' + Parity + ',';
  71.     WkStr := Int_to_Str(DataBits);
  72.     DispStr := DispStr + WkStr + ',';
  73.     WkStr := Int_to_Str(StopBits);
  74.     DispStr := DispStr + WkStr;
  75.     PlainWrite(40, 25, DispStr);
  76.     PosCursor(X, Y);
  77.     OnCursor;
  78.   END (* with *);
  79. END (* ShowPortStatus *);
  80.  
  81. PROCEDURE ChangePort(NewPort : INTEGER);
  82. VAR
  83.   dbool : BOOLEAN;
  84.  
  85. BEGIN
  86.   WITH CurrConfig DO
  87.   BEGIN
  88.     CommClose(ComPort, FALSE);
  89.     ComPort := NewPort;
  90.     dbool := CommOpen(ComPort, BaudRate, Parity, DataBits, StopBits, 2048, 2048, TRUE);
  91.     Changed := TRUE;
  92.   END (* with *);
  93.   ShowPortStatus;
  94. END (* ChangePort *);
  95.  
  96. PROCEDURE SetPort(Choice : INTEGER);
  97. VAR
  98.   dbool : BOOLEAN;
  99.   Ch    : CHAR;
  100.  
  101. BEGIN
  102.   WITH CurrConfig DO
  103.   BEGIN
  104.     CASE Choice OF
  105.       50..51 : BaudRate := 1200;
  106.       52..53 : BaudRate := 2400;
  107.       54..55 : BaudRate := 9600;
  108.       56..57 : BaudRate := 19200;
  109.     END (* case *);
  110.     IF Choice <= 57 THEN                    (* using menu pre-sets ? *)
  111.     BEGIN
  112.       Changed := TRUE;
  113.       IF (Choice MOD 2) = 0 THEN
  114.       BEGIN
  115.         Parity := 'N';
  116.         DataBits := 8;
  117.       END
  118.       ELSE
  119.       BEGIN
  120.         Parity := 'E';
  121.         DataBits := 7;
  122.       END;
  123.       StopBits := 1;
  124.     END
  125.     ELSE
  126.       TempMessageBoxCh(20, 12, WHITE, RED, 2, 'Sorry...That function isn''t available', Ch);
  127.  
  128.     dbool := CommSetup(ComPort, BaudRate, Parity, DataBits, StopBits);
  129.   END (* with *);
  130.   ShowPortStatus;
  131. END (* SetPort *);
  132.  
  133. PROCEDURE ShowInfoBox;
  134. BEGIN
  135.   GrowMkWin(21, 8, 55, 15, Black, Green, 1);    (* open up the window *)
  136.   PlainWrite(26, 9, 'FileName:');
  137.   PlainWrite(28, 11, 'Blocks:');
  138.   PlainWrite(28, 12, 'Errors:');
  139.   PlainWrite(22, 13, 'Total Errors:');
  140. END (* ShowInfoBox *);
  141.  
  142. {$F+}
  143. PROCEDURE ShowFile(CPort: INTEGER; Name:STRING);
  144. BEGIN
  145.   PlainWrite(36, 9, '            ');
  146.   PlainWrite(36, 9, Name);
  147. END (* ShowFile *);
  148.  
  149. PROCEDURE ShowXferData(CPort:INTEGER; Rec, Errors, TotErrors:WORD);
  150. VAR
  151.   WString : STRING;
  152.  
  153. BEGIN
  154.   WString := Int_to_Str(Rec+1);
  155.   PlainWrite(36, 11, WString);
  156.   WString := Int_to_Str(Errors);
  157.   PlainWrite(36, 12, WString);
  158.   WString := Int_to_Str(TotErrors);
  159.   PlainWrite(36, 13, WString);
  160. END (* ShowXferData *);
  161.  
  162. FUNCTION ChkKbd : BOOLEAN;
  163. VAR
  164.   Ch : CHAR;
  165.  
  166. BEGIN
  167.   ChkKbd := FALSE;
  168.   IF KeyPressed THEN
  169.   BEGIN
  170.     Ch := ReadKey;
  171.     IF Ch = #$00 THEN
  172.       Ch := ReadKey;
  173.   END;
  174.   IF Ch = #$1B THEN
  175.     ChkKbd := TRUE;
  176. END (* ChkKbd *);
  177.  
  178. PROCEDURE Test_Esc(VAR Ch:CHAR; VAR ID:BYTE; VAR REFRESH:BYTE);
  179. BEGIN
  180.   GotEsc := FALSE;
  181.   REFRESH := Refresh_None;
  182.   IF Ch = Esc THEN
  183.   BEGIN
  184.     GotEsc := TRUE;
  185.     REFRESH := End_Input;
  186.   END;
  187. END (* Test_Esc *);
  188.  
  189. PROCEDURE Leave_Tab1(VAR ID:BYTE; VAR R:BYTE);
  190. BEGIN
  191.   IF ID = 7 THEN
  192.     R := End_Input;
  193. END (* Leave_Tab1 *);
  194.  
  195. PROCEDURE Leave_Tab2(VAR ID:BYTE; VAR R:BYTE);
  196. BEGIN
  197.   R := End_Input;
  198. END (* Leave_Tab1 *);
  199.  
  200. PROCEDURE Leave_Tab5(VAR ID:BYTE; VAR R:BYTE);
  201. BEGIN
  202.   IF ID = 3 THEN
  203.     R := End_Input;
  204. END (* Leave_Tab1 *);
  205.  
  206. {$F-}
  207.  
  208. PROCEDURE LcInfo;
  209. BEGIN
  210.   CreateScreen(2,25);                       (* start a virtual screen *)
  211.   Activate_Virtual_Screen(2);
  212.   FBox(1, 1, 80, 25, BLACK, CYAN, 4);
  213.   WriteCenter(2, BLACK, GREEN, 'INTRODUCING LITECOMM');
  214.   WriteAT(6, 4, BLACK, CYAN,
  215.     'LiteComm (Tm) and LiteComm-TP are sophisticated toolboxes of proven');
  216.   WriteAT(6, 5, BLACK, CYAN,
  217.     'routines for C and PASCAL programmers. By using LiteComm, you can');
  218.   WriteAT(6, 6, BLACK, CYAN,
  219.     'quickly and easily add communications capabilities to your application');
  220.   WriteAT(6, 7, BLACK, CYAN,
  221.     'without worrying about the details.');
  222.   WriteAT(6, 9, BLACK, CYAN,
  223.     'LiteComm is a shareware product. If you find the package useful, you');
  224.   WriteAT(6, 10, BLACK, CYAN,
  225.     'must register it. Full registration information is contained in the');
  226.   WriteAT(6, 11, BLACK, CYAN,
  227.     'documentation, or you may complete the online registration form.');
  228.   WriteCenter(13, BLACK, GREEN,
  229.     'LiteComm and LiteComm-TP are Copyright (c) 1987,88,89');
  230.   WriteCenter(14, BLACK, GREEN,
  231.     'Information Technology, Ltd.; all rights reserved');
  232.   WriteAT(35, 16, BLACK, CYAN, '┌─────┐');
  233.   WriteAT(31, 17, BLACK, CYAN, '┌───┴─┐   │            (Tm)');
  234.   WriteAT(29, 18, BLACK, CYAN, '──┤     │o  ├────────────────');
  235.   WriteAT(31, 19, BLACK, CYAN, '│ ┌───┴┴┐ │ Association of');
  236.   WriteAT(31, 20, BLACK, CYAN, '│ │     ├─┘ Shareware');
  237.   WriteAT(31, 21, BLACK, CYAN, '└─┤  o  │   Professionals');
  238.   WriteAT(29, 22, BLACK, CYAN, '────╡  │  ├──────────────────');
  239.   WriteAT(33, 23, BLACK, CYAN, '└──┴──┘   MEMBER');
  240.   Activate_Visible_Screen;
  241.   SaveScreen(1);
  242.   SlideRestoreScreen(2, Left);
  243.   REPEAT
  244.     ;
  245.   UNTIL ChkKbd;
  246.   SlideRestoreScreen(1, Up);
  247. END (* LcInfo *);
  248.  
  249. PROCEDURE LcReg;
  250. VAR
  251.   Name,
  252.   Company,
  253.   Address : STRING[35];
  254.   City,
  255.   Country : STRING[20];
  256.   State   : STRING[2];
  257.   PostCode,
  258.   DayPhone : STRING[15];
  259.   ByCheck,
  260.   ByVISA,
  261.   ByMC    : STRING[1];
  262.   CCNumber: STRING[16];
  263.   ExpDate : DATES;
  264.  
  265. BEGIN
  266. (*
  267. ** init the world
  268. *)
  269.   Name := '';
  270.   Company := '';
  271.   Address := '';
  272.   City := '';
  273.   Country := '';
  274.   State := '';
  275.   PostCode := '';
  276.   ByCheck := '';
  277.   ByVISA := '';
  278.   ByMC := '';
  279.   DayPhone := '';
  280.   CCNumber := '';
  281.   ExpDate := 0;
  282.  
  283.   MkWin(1, 1, 80, 25, BLACK, CYAN, 2);      (* double line box window *)
  284.   WriteCenter(3, BLACK, GREEN, 'LITECOMM (Tm) REGISTRATION');
  285.   WriteAT(11, 5, BLACK, CYAN,
  286.     'Complete the following information. I will print a completed');
  287.   WriteAT(11, 6, BLACK, CYAN,
  288.     'registration form for you to mail. (ESC to abort)');
  289.   WriteAT(11, 8, BLACK, CYAN, 'NAME');
  290.   WriteAT(57, 8, BLACK, GREEN, '(from credit card)');
  291.   WriteAT(11, 10, BLACK, CYAN, 'COMPANY');
  292.   WriteAT(11, 12, BLACK, CYAN, 'ADDRESS');
  293.   WriteAT(11, 14, BLACK, CYAN, 'CITY');
  294.   WriteAT(41, 14, BLACK, CYAN, 'STATE');
  295.   WriteAT(11, 16, BLACK, CYAN, 'COUNTRY');
  296.   WriteAT(41, 16, BLACK, CYAN, 'POSTAL CODE');
  297.   WriteAT(11, 18, BLACK, CYAN, 'Method of Payment ($50 Fee)');
  298.   WriteAT(13, 20, BLACK, CYAN, '[ ] Check Enclosed');
  299.   WriteAT(13, 22, BLACK, CYAN, '[ ] VISA  [ ] MasterCard  NO:');
  300.   WriteAT(64, 22, BLACK, CYAN, 'EXPIRES');
  301.   WriteAT(13, 23, BLACK, CYAN, 'Daytime Telephone');
  302.  
  303.   Create_Tables(5);
  304.  
  305.   Activate_Table(1);                        (* table 1 is basic info *)
  306.   Allow_Esc(TRUE);
  307.   Create_Fields(7);
  308.   Add_Field(1, 1, 2, 1, 2, 20, 8);          (* Name *)
  309.   Add_Field(2, 1, 3, 2, 3, 20, 10);         (* Company *)
  310.   Add_Field(3, 2, 4, 3, 4, 20, 12);         (* Address *)
  311.   Add_Field(4, 3, 5, 4, 5, 20, 14);         (* City *)
  312.   Add_Field(5, 4, 6, 5, 6, 47, 14);         (* State *)
  313.   Add_Field(6, 5, 7, 6, 7, 20, 16);         (* Country *)
  314.   Add_field(7, 6, 7, 7, 7, 53, 16);         (* postal code *)
  315.   String_Field(1, Name, '***********************************');
  316.   String_Field(2, Company, '***********************************');
  317.   String_Field(3, Address, '***********************************');
  318.   String_Field(4, City, '********************');
  319.   String_Field(5, State, '!!');
  320.   String_Field(6, Country, '********************');
  321.   String_Field(7, PostCode, '***************');
  322.  
  323.   Activate_Table(2);
  324.   Allow_Esc(TRUE);
  325.   Create_Fields(1);
  326.   Add_Field(1, 1, 1, 1, 1, 14, 20);         (* pay by check *)
  327.   String_Field(1, ByCheck, '!');
  328.   Field_Rules(1, JumpIfFull, [' ', 'X', 'x'], [No_Char]);
  329.   Add_Message(1, 1, 25, 'X to Select, SPACE to Skip');
  330.  
  331.   Activate_Table(3);
  332.   Allow_Esc(TRUE);
  333.   Create_Fields(1);
  334.   Add_Field(1, 1, 1, 1, 1, 14, 22);         (* pay by visa *)
  335.   String_Field(1, ByVISA, '!');
  336.   Field_Rules(1, JumpIfFull, [' ', 'X', 'x'], [No_Char]);
  337.   Add_Message(1, 1, 25, 'X to Select, SPACE to Skip');
  338.  
  339.   Activate_Table(4);
  340.   Allow_Esc(TRUE);
  341.   Create_Fields(1);
  342.   Add_Field(1, 1, 1, 1, 1, 24, 22);        (* pay by M/C *)
  343.   String_Field(1, ByMC, '!');
  344.   Field_Rules(1, JumpIfFull, [' ', 'X', 'x'], [No_Char]);
  345.   Add_Message(1, 1, 25, 'X to Select, SPACE to Skip');
  346.  
  347.   Activate_Table(5);
  348.   Allow_Esc(TRUE);
  349.   Create_Fields(3);
  350.   Add_Field(1, 1, 2, 1, 2, 43, 22);
  351.   Add_Field(2, 1, 3, 2, 3, 72, 22);
  352.   Add_Field(3, 2, 3, 3, 3, 31, 23);
  353.   String_Field(1, CCNumber, '####-####-####-####');
  354.   Date_Field(2, ExpDate, MMYY, '##/##', 0, 0);
  355.   String_Field(3, DayPhone, '***************');
  356.   Field_Rules(1, JumpIfFull, [No_Char], [No_Char]);
  357.   Field_Rules(2, JumpIfFull, [No_Char], [No_Char]);
  358.   Field_Rules(3, JumpIfFull, [No_Char], [No_Char]);
  359.   Add_Message(3, 1, 25, 'Daytime Telephone Number');
  360.  
  361. (*  Basic Data *)
  362.   Activate_Table(1);
  363.   Assign_CharHook(Test_Esc);
  364.   Assign_LeaveFieldHook(Leave_Tab1);
  365.   Process_Input(1);
  366.   IF GotEsc THEN
  367.   BEGIN
  368.     Dispose_Fields;
  369.     Dispose_Tables;
  370.     RmWin;
  371.     EXIT;
  372.   END;
  373.  
  374.   REPEAT
  375.     ByCheck := '';
  376.     ByVISA := '';
  377.     ByMC := '';
  378.  
  379.   (*  By Check *)
  380.     Activate_Table(2);
  381.     Assign_CharHook(Test_Esc);
  382.     Assign_LeaveFieldHook(Leave_Tab2);
  383.     String_Field(1, ByCheck, '!');          (* force default reset *)
  384.     Process_Input(1);
  385.  
  386.   (* By VISA *)
  387.     IF (ByCheck <> 'X') AND
  388.        (NOT GotEsc) THEN
  389.     BEGIN
  390.       Activate_Table(3);
  391.       Assign_CharHook(Test_Esc);
  392.       Assign_LeaveFieldHook(Leave_Tab2);
  393.       String_Field(1, ByVISA, '!');
  394.       Process_Input(1);
  395.     END;
  396.  
  397.   (* By MC *)
  398.     IF (ByCheck <> 'X') AND
  399.        (ByVISA <> 'X') AND
  400.        (NOT GotEsc ) THEN
  401.     BEGIN
  402.       Activate_Table(4);
  403.       Assign_CharHook(Test_Esc);
  404.       Assign_LeaveFieldHook(Leave_Tab2);
  405.       String_Field(1, ByMC, '!');
  406.       Process_Input(1);
  407.     END;
  408.   UNTIL (ByCheck = 'X') OR
  409.         (ByVISA = 'X') OR
  410.         (ByMC = 'X') OR
  411.         (GotEsc);
  412.   IF GotEsc THEN
  413.   BEGIN
  414.     Dispose_Fields;
  415.     Dispose_Tables;
  416.     RmWin;
  417.     EXIT;
  418.   END;
  419.  
  420.  
  421. (* Credit Card Info *)
  422.   IF (BYCheck <> 'X') AND
  423.      (NOT GotEsc) THEN
  424.   BEGIN
  425.     Activate_Table(5);
  426.     Assign_CharHook(Test_Esc);
  427.     Assign_LeaveFieldHook(Leave_Tab5);
  428.     Process_Input(1);
  429.     IF GotEsc THEN
  430.     BEGIN
  431.       Dispose_Fields;
  432.       Dispose_Tables;
  433.       RmWin;
  434.       EXIT;
  435.     END;
  436.   END;
  437.  
  438. (*
  439. ** Print the actual form
  440. *)
  441.   Writeln(Lst, '          LiteComm - TP REGISTRATION');
  442.   Writeln(Lst);
  443.   Writeln(Lst);
  444.   Writeln(Lst);
  445.   Writeln(Lst, 'Please register my copy of the LiteComm-TP ToolBox.');
  446.   Writeln(Lst, 'I Agree to be bound by the terms and conditions of the');
  447.   Writeln(Lst, 'license agreement as stated in the LiteComm-TP documentation');
  448.   Writeln(Lst);
  449.   Writeln(Lst);
  450.   Writeln(Lst,'  Name:    ', Name);
  451.   Writeln(Lst,'  Company: ', Company);
  452.   Writeln(Lst,'  Address: ', Address);
  453.   Writeln(Lst,'  City:    ', City, '  State: ', State);
  454.   IF Length(Country) > 0 THEN
  455.     Write(Lst,'  Country: ', Country, ' ');
  456.   Writeln(Lst, 'Postal Code: ', PostCode);
  457.   Writeln(Lst);
  458.   Writeln(Lst, 'Payment by:');
  459.   IF ByCheck = 'X' THEN
  460.     Writeln(Lst, '   Check Enclosed')
  461.   ELSE
  462.     IF ByVISA = 'X' THEN
  463.       Writeln(Lst, '   VISA No: ', CCNumber, ' Expires',
  464.         Julian_to_Date(ExpDate, MMYY))
  465.     ELSE
  466.       Writeln(Lst, '   MasterCard No: ', CCNumber, ' Expires',
  467.         Julian_to_Date(ExpDate, MMYY));
  468.   IF ByCheck <> 'X' THEN
  469.   BEGIN
  470.     Writeln(Lst, '   Daytime Phone Number: ', DayPhone);
  471.     Writeln(Lst);
  472.     Writeln(Lst);
  473.     Writeln(Lst, 'Signature(required)..............................................');
  474.   END;
  475.   Writeln(Lst);
  476.   Writeln(Lst,'Send to: Information Technology, Ltd');
  477.   Writeln(Lst,'         PO Box 554');
  478.   Writeln(Lst,'         Coventry, RI 02816');
  479.   Write(Lst, #$0C);                         (* FORM-FEED *)
  480.  
  481.   Dispose_Fields;
  482.   Dispose_Tables;
  483.   RmWin;
  484. END (* LcReg *);
  485.  
  486. PROCEDURE Downl_XM;
  487. VAR
  488.   dbool : BOOLEAN;
  489.   X, Y, Top, Bottom : BYTE;
  490.   Path  : PathStr;
  491.  
  492.   BSize    : WORD;
  493.   RBSize   : INTEGER;
  494.   HandShake : BYTE;
  495.   BPtr     : BytePtr;
  496.   CRPtr    : BytePtr;
  497.   Result   : XMResult;
  498.   BytesRem : WORD;                          (* number of untrans. bytes *)
  499.   XMFile : FILE;
  500.  
  501. BEGIN
  502.   Path := '';
  503.   SaveScreen(1);
  504.   Read_String(3, 12, 70, '_File Name to Get, Esc to EXIT', 1, Path);
  505.   RestoreScreen(1);
  506.   IF R_Char = Esc THEN
  507.     EXIT;
  508.  
  509.   FindCursor(X, Y, Top, Bottom);
  510.   OffCursor;
  511.   ShowInfoBox;
  512. (*
  513. ** Install Hooks For the display Routines
  514. *)
  515.  
  516.   dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  517.   dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  518.   dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  519.  
  520.   BSize := 8192;                            (* want to use 8K buffer *)
  521.   BPtr  := NIL;
  522.   WHILE (BPtr = NIL) AND                    (* allocate buffer for proc *)
  523.         (BSize > 0) DO
  524.     IF MaxAvail >= BSize THEN               (* enough contig space *)
  525.       GetMem(BPtr, BSize)                   (* yes, grab it *)
  526.     ELSE
  527.       DEC(BSize, 1024);                     (* no, try 1K less *)
  528.  
  529. (*
  530. ** Here is where everything begins...All XModem related code is
  531. ** self-contained here
  532. *)
  533.  
  534.   Assign(XMFile, Path);
  535.   ShowFnProc[CurrConfig.ComPort](CurrConfig.ComPort, Path);
  536. {$I-}
  537.   Rewrite(XMFile, 1);
  538. {$I+}
  539.   IF IOResult <> 0 THEN
  540.     FlagAbort(CurrConfig.ComPort);
  541.  
  542.   Result := Success;
  543.   BytesRem := 0;
  544.   CRPtr := BPtr;
  545.  
  546.   HandShake := CRCREQ;                    (* receive in CRC mode *)
  547.   XMReset(CurrConfig.ComPort);
  548.   BatchMode(CurrConfig.ComPort, FALSE);
  549.  
  550.   WHILE Result = Success DO
  551.   BEGIN
  552.     Result := LxmRrec(CurrConfig.ComPort, CRPtr^, RBSize, RTOUT, HandShake);
  553.     IF Result = Success THEN
  554.     BEGIN
  555.       INC(BytesRem, RBSize);
  556.       INC(PtrRec(CRPtr).Ofs, RBSize);
  557.       IF BytesRem >= BSize THEN           (* filled the IO Buffer *)
  558.       BEGIN
  559. {$I-}
  560.         BlockWrite(XMFile, BPtr^, BSize);
  561. {$I+}
  562.         IF IOResult <> 0 THEN
  563.           FlagAbort(CurrConfig.ComPort);
  564.         CRPtr := BPtr;                     (* set current record ptr *)
  565.         BytesRem := 0;
  566.       END;
  567.     END;
  568.     IF Result = DupBlk THEN
  569.       Result := Success;
  570.   END (* while *);
  571.   IF (BytesRem > 0) AND                   (* anything left unwritten *)
  572.      (Result = EndFile) THEN              (* Is it End of File ? *)
  573.     BlockWrite(XMFile, BPtr^, BytesRem);   (* yes, flush the buffer *)
  574.  
  575.   Close(XMFile);
  576.   BatchMode(CurrConfig.ComPort, FALSE);
  577.   Dispose(BPtr);
  578.   XMReset(CurrConfig.ComPort);
  579.  
  580.   IF Result <> EndFile THEN               (* if we didn't end OK *)
  581.     Erase(XMFile);
  582.  
  583.   RmWin;
  584.   OnCursor;
  585.   PosCursor(X, Y);
  586. END (* Downl_XM *);
  587.  
  588. PROCEDURE Send_XM;
  589. VAR
  590.   Path     : PathStr;
  591.   X, Y, Top, Bottom : BYTE;
  592.   BSize    : WORD;
  593.   BPtr     : BytePtr;
  594.   CRPtr    : BytePtr;
  595.   Result   : XMResult;
  596.   BytesRead,                                (* number of bytes read *)
  597.   BytesRem : WORD;                          (* number of untrans. bytes *)
  598.   XMFile   : FILE;
  599.  
  600. BEGIN
  601.   Path := '';
  602.   SaveScreen(1);
  603.   Read_String(3, 12, 70, '_File Spec to Send, Esc to EXIT', 1, Path);
  604.   RestoreScreen(1);
  605.   IF R_Char = Esc THEN
  606.     EXIT;
  607.  
  608.   FindCursor(X, Y, Top, Bottom);
  609.   OffCursor;
  610.   ShowInfoBox;
  611.  
  612.   BSize := 8192;                            (* want to use 8K buffer *)
  613.   BPtr  := NIL;
  614.   WHILE (BPtr = NIL) AND                    (* allocate buffer for proc *)
  615.         (BSize > 0) DO
  616.     IF MaxAvail >= BSize THEN               (* enough contig space *)
  617.       GetMem(BPtr, BSize)                   (* yes, grab it *)
  618.     ELSE
  619.       DEC(BSize, 1024);                     (* no, try 1K less *)
  620.  
  621.   Assign(XMFile, Path);
  622.   ShowFnProc[CurrConfig.ComPort](CurrConfig.ComPort, Path);
  623. {$I-}
  624.   Reset(XMFile, 1);
  625. {$I+}
  626.   FillChar(BPtr^, XMBlksize, $00);              (* prefill buffer w/ nulls *)
  627.  
  628.   Result := Success;
  629.   BytesRead := 1;
  630.  
  631.   WHILE (BytesRead > 0) AND
  632.         (Result = Success) DO
  633.   BEGIN
  634.     FillChar(BPtr^, BSize, $00);
  635. {$I-}
  636.     BlockRead(XMFile, BPtr^, BSize, BytesRead);
  637. {$I+}
  638.     CRPtr := BPtr;                        (* set current record ptr *)
  639.     BytesRem := BytesRead;
  640.  
  641.     WHILE (BytesRem > 0) AND
  642.           (Result = Success) DO
  643.     BEGIN
  644.       Result := LxmTrec(CurrConfig.ComPort, CRPtr^);    (* do actual transmission *)
  645.       IF BytesRem > XMBlksize THEN
  646.         DEC(BytesRem, XMBlksize)
  647.       ELSE
  648.         BytesRem := 0;
  649.       INC(PtrRec(CRPtr).Ofs, XMBlksize);
  650.     END;
  651.  
  652.     IF BytesRead < BSize THEN
  653.       BytesRead := 0;
  654.   END; (* OUTER WHILE *)
  655.  
  656.   IF Result = Success THEN
  657.     Result := LxmTeot(CurrConfig.ComPort);       (* send end of file *)
  658.   Close(XMFile);
  659.   Dispose(BPtr);                        (* release buffer *)
  660.  
  661.   RmWin;
  662.   OnCursor;
  663.   PosCursor(X, Y);
  664. END;
  665.  
  666.  
  667. PROCEDURE Downl_YM;
  668. VAR
  669.   dbool : BOOLEAN;
  670.   X, Y, Top, Bottom : BYTE;
  671.  
  672. BEGIN
  673.   FindCursor(X, Y, Top, Bottom);
  674.   OffCursor;
  675.   ShowInfoBox;
  676. (*
  677. ** Install Hooks For the display Routines
  678. *)
  679.  
  680.   dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  681.   dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  682.   dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  683.   dbool := LctYMRecv(CurrConfig.ComPort);
  684.  
  685.   RmWin;
  686.   OnCursor;
  687.   PosCursor(X, Y);
  688. END (* Downl_YM *);
  689.  
  690. PROCEDURE Upl_YM;
  691. VAR
  692.   dbool : BOOLEAN;
  693.   X, Y, Top, Bottom : BYTE;
  694.   Path  : PathStr;
  695.  
  696. BEGIN
  697.   Path := '';
  698.   SaveScreen(1);
  699.   Read_String(3, 12, 70, '_File Spec to Send, Esc to EXIT', 1, Path);
  700.   RestoreScreen(1);
  701.   IF R_Char = Esc THEN
  702.     EXIT;
  703.  
  704.   FindCursor(X, Y, Top, Bottom);
  705.   OffCursor;
  706.   ShowInfoBox;
  707. (*
  708. ** Install Hooks For the display Routines, Abort handler
  709. *)
  710.  
  711.   dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  712.   dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  713.   dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  714.   dbool := LctYMSend(CurrConfig.ComPort, Path);
  715.  
  716.   RmWin;
  717.   OnCursor;
  718.   PosCursor(X, Y);
  719. END (* Upl_YM *);
  720.  
  721. PROCEDURE Upl_XM;
  722. VAR
  723.   dbool : BOOLEAN;
  724.  
  725. BEGIN
  726.   dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  727.   dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  728.   dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  729.   UseYModem(CurrConfig.ComPort, FALSE);
  730.   XMBlkSize := 128;
  731.   Send_XM;
  732. END (* Upl_XM *);
  733.  
  734. PROCEDURE Upl_XMB;
  735. VAR
  736.   dbool : BOOLEAN;
  737.  
  738. BEGIN
  739.   dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  740.   dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  741.   dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  742.   UseYModem(CurrConfig.ComPort, TRUE);
  743.   XMBlkSize := 1024;
  744.   Send_XM;
  745. END (* Upl_XM *);
  746.  
  747. PROCEDURE SaveConfig;
  748. BEGIN
  749.   Assign(CfgFile, 'LCDEMO.CFG');
  750. {$I-}
  751.   Rewrite(CfgFile);                         (* (re)create the file *)
  752. {$I+}
  753.   IF IOResult <> 0 THEN                     (* was the file found ? *)
  754.     EXIT;
  755.   CurrConfig.Changed := FALSE;
  756.   Write(CfgFile, CurrConfig);               (* write the config file *)
  757.   Close(CfgFile);
  758. END (* SaveConfig *);
  759.  
  760. PROCEDURE LoadConfig;
  761. BEGIN
  762.   Assign(CfgFile, 'LCDEMO.CFG');
  763. {$I-}
  764.   Reset(CfgFile);                           (* attempt to open *)
  765. {$I+}
  766.   IF IOResult = 0 THEN                      (* was the file found ? *)
  767.   BEGIN
  768.     Read(CfgFile, CurrConfig);              (* load the last config *)
  769.     Close(CfgFile);
  770.     EXIT;
  771.   END;
  772.   CurrConfig.Changed := FALSE;
  773.   SaveConfig;                               (* force file create *)
  774. END (* LoadConfig *);
  775.  
  776. {$F+}
  777. PROCEDURE Task_Caller(VAR TopicCode:INTEGER; VAR RetCode:BYTE);
  778. VAR
  779.   XYZ : INTEGER;
  780.  
  781. BEGIN
  782.   CASE TopicCode OF
  783.      1 : BEGIN
  784.            LcInfo;
  785.            RetCode := ClearAll;
  786.          END;
  787.      2 : BEGIN
  788.            LcReg;
  789.            RetCode := ClearAll;
  790.          END;
  791.     10 : BEGIN
  792.            Downl_XM;
  793.            RetCode := ClearAll;
  794.          END;
  795.     12 : BEGIN
  796.            Downl_XM;
  797.            RetCode := ClearAll;
  798.          END;
  799.     13 : BEGIN
  800.            Downl_YM;
  801.            RetCode := ClearAll;
  802.          END;
  803.     20 : BEGIN
  804.            Upl_XM;
  805.            RetCode := ClearAll;
  806.          END;
  807.     22 : BEGIN
  808.            Upl_XMB;
  809.            RetCode := ClearAll;
  810.          END;
  811.     23 : BEGIN
  812.            Upl_YM;
  813.            RetCode := ClearAll;
  814.          END;
  815.     32 : BEGIN
  816.            IF HostMode THEN
  817.              Modify_Topic_Name(Opt_Menu, 3, 'Host Mode - OFF')
  818.            ELSE
  819.              Modify_Topic_Name(Opt_Menu, 3, 'Host Mode - ON');
  820.            HostMode := NOT HostMode;
  821.            RetCode := RefreshTopic;
  822.          END;
  823.     33 : BEGIN
  824.            IF LocalEcho THEN
  825.              Modify_Topic_Name(Opt_Menu,4,'Local Echo - OFF')
  826.            ELSE
  827.              Modify_Topic_Name(Opt_Menu,4,'Local Echo - ON');
  828.            LocalEcho := NOT LocalEcho;
  829.            RetCode := RefreshTopic;
  830.          END;
  831.     35 : BEGIN
  832.            SaveConfig;
  833.            RetCode := ClearCurrent;
  834.          END;
  835.  40..43 : BEGIN
  836.            ChangePort((TopicCode-40)+1);
  837.            RetCode := ClearCurrent;
  838.          END;
  839.  50..58 : BEGIN
  840.            SetPort(TopicCode);
  841.            RetCode := ClearCurrent;
  842.          END;
  843.    999 : BEGIN
  844.            RetCode := ClearAll;
  845.            ExitActive := TRUE;
  846.          END;
  847.   ELSE
  848.     RetCode := ClearCurrent;                (* terminate the menus *)
  849.   END;
  850. END;
  851. {$F-}
  852.  
  853. PROCEDURE InitMenus;
  854. BEGIN
  855.   Initialize_Menu(Main_Menu, 'LCDemo', 0, 0);
  856.   Initialize_Menu(Desk_Menu, 'Information', 0, 0);
  857.   Initialize_Menu(Dnl_Menu, 'File Download', 0, 0);
  858.   Initialize_Menu(Upl_Menu, 'File Upload', 0, 0);
  859.   Initialize_Menu(Opt_Menu, 'User Options', 0, 0);
  860.   Initialize_Menu(Port_Menu, 'Active Port', 0, 0);
  861.   Initialize_Menu(Set_Menu, 'Port Settings', 0, 0);
  862.   Initialize_Menu(Quit_Menu, 'Quit', 0, 0);
  863.  
  864. (*
  865. ** Build Main Menu Topics
  866. *)
  867.   Add_Topic(Main_Menu, 'Information  Alt-I', TRUE, AltI, 0, @Desk_Menu);
  868.   Add_Topic(Main_Menu, 'Download     Alt-D', TRUE, AltD, 0, @Dnl_Menu);
  869.   Add_Topic(Main_Menu, 'Upload       Alt-U', TRUE, AltU, 0, @Upl_Menu);
  870.   Add_Topic(Main_Menu, 'Options      Alt-O', TRUE, AltO, 0, @Opt_Menu);
  871.   Add_Topic(Main_Menu, 'Quit         Alt-Q', TRUE, AltQ, 0, @Quit_Menu);
  872.  
  873. (*
  874. ** Build Information Menu Topics
  875. *)
  876.   Add_Topic(Desk_Menu, 'About LiteComm', TRUE, #0, 1, NIL);
  877.   Add_Topic(Desk_Menu, 'Registration', TRUE, #0, 2, NIL);
  878.  
  879. (*
  880. ** Build File Download Menu
  881. *)
  882.   Add_Topic(Dnl_Menu, 'Xmodem', TRUE, #0, 10, NIL);
  883.   Add_Topic(Dnl_Menu, 'Xmodem-1K', TRUE, #0, 12, NIL);
  884.   Add_Topic(Dnl_Menu, 'Ymodem', TRUE, #0, 13, NIL);
  885.  
  886. (*
  887. ** Build File Upload Menu
  888. *)
  889.   Add_Topic(Upl_Menu, 'Xmodem', TRUE, #0, 20, NIL);
  890.   Add_Topic(Upl_Menu, 'Xmodem-1K', TRUE, #0, 22, NIL);
  891.   Add_Topic(Upl_Menu, 'Ymodem', TRUE, #0, 23, NIL);
  892.  
  893. (*
  894. ** Build User Options Menu
  895. *)
  896.   Add_Topic(Opt_Menu, 'Active Port', TRUE, #0, 0, @Port_Menu);
  897.   Add_Topic(Opt_Menu, 'Port Settings', TRUE, #0, 0, @Set_Menu);
  898.   Add_Topic(Opt_Menu, 'Host Mode - OFF', TRUE, #0, 32, NIL);
  899.   Add_Topic(Opt_Menu, 'Local Echo - OFF', TRUE, #0, 33, NIL);
  900.   Add_Topic(Opt_Menu, 'Restore', TRUE, #0, 34, NIL);
  901.   Add_Topic(Opt_Menu, 'Save', TRUE, #0, 35, NIL);
  902.  
  903. (*
  904. ** Build Port Menu
  905. *)
  906.   Add_Topic(Port_Menu, 'COM1', TRUE, #0, 40, NIL);
  907.   Add_Topic(Port_Menu, 'COM2', TRUE, #0, 41, NIL);
  908.   Add_Topic(Port_Menu, 'COM3', TRUE, #0, 42, NIL);
  909.   Add_Topic(Port_Menu, 'COM4', TRUE, #0, 43, NIL);
  910.  
  911. (*
  912. ** Build Settings Menu
  913. *)
  914.   Add_Topic(Set_Menu, '1200,N,8,1', TRUE, #0, 50, NIL);
  915.   Add_Topic(Set_Menu, '1200,E,8,1', TRUE, #0, 51, NIL);
  916.   Add_Topic(Set_Menu, '2400,N,8,1', TRUE, #0, 52, NIL);
  917.   Add_Topic(Set_Menu, '2400,E,8,1', TRUE, #0, 53, NIL);
  918.   Add_Topic(Set_Menu, '9600,N,8,1', TRUE, #0, 54, NIL);
  919.   Add_Topic(Set_Menu, '9600,E,8,1', TRUE, #0, 55, NIL);
  920.   Add_Topic(Set_Menu, '19200,N,8,1', TRUE, #0, 56, NIL);
  921.   Add_Topic(Set_Menu, '19200,E,8,1', TRUE, #0, 57, NIL);
  922.  
  923. (*
  924. ** Build Quit Menu
  925. *)
  926.   Add_Topic(Quit_Menu, 'No', TRUE, #0, 998, NIL);
  927.   Add_Topic(Quit_Menu, 'Yes', TRUE, #0, 999, NIL);
  928.   Assign_Despatcher(Task_Caller);
  929.  
  930. END (* InitMenus *);
  931.  
  932. PROCEDURE InitSetup;
  933. VAR
  934.   dbool : BOOLEAN;
  935.  
  936. BEGIN
  937.   Window(1, 1, 80, 24);
  938.   ClearText(1, 1, 80, 25, WHITE, BLACK);    (* erase screen before starting *)
  939.   ClearLine(25, LightBlue, LightGray);
  940.   PlainWrite(65, 25, 'F10 FOR MENU');
  941.   HostMode := FALSE;
  942.   LocalEcho := FALSE;
  943.   ExitActive := FALSE;
  944.  
  945.   WITH CurrConfig DO
  946.   BEGIN
  947.     ComPort := 2;
  948.     BaudRate := 2400;
  949.     Parity := 'N';
  950.     DataBits := 8;
  951.     StopBits := 1;
  952.     dbool := CommOpen(ComPort, BaudRate, Parity, DataBits, StopBits, 2048, 2048, TRUE)
  953.   END (* with *);
  954.   LoadConfig;                               (* load existing config *)
  955. END;
  956.  
  957. PROCEDURE ShowConnectStatus;
  958. VAR
  959.   X, Y, Top, Bottom : BYTE;
  960.   MStatus : BYTE;
  961.  
  962. BEGIN
  963.   WITH CurrConfig DO
  964.   BEGIN
  965.     MStatus := ModemStatus(ComPort);
  966.     IF (MStatus AND (DeltaRI OR DeltaDCD OR DeltaCTS OR DeltaDSR)) = $00 THEN
  967.       EXIT;
  968.     FindCursor(X, Y, Top, Bottom);
  969.     OffCursor;
  970.     IF (MStatus AND DCD) <> $00 THEN
  971.       PlainWrite(2, 25, 'DCD')
  972.     ELSE
  973.       PlainWrite(2, 25, '   ');
  974.     IF (MStatus AND CTS) <> $00 THEN
  975.       PlainWrite(6, 25, 'CTS')
  976.     ELSE
  977.       PlainWrite(6, 25, '   ');
  978.     IF (MStatus AND DSR) <> $00 THEN
  979.       PlainWrite(10, 25, 'DSR')
  980.     ELSE
  981.       PlainWrite(10, 25, '   ');
  982.     IF (MStatus AND RI) <> $00 THEN
  983.       PlainWrite(14, 25, 'RI ')
  984.     ELSE
  985.       PlainWrite(14, 25, '   ');
  986.     PosCursor(X, Y);
  987.     OnCursor;
  988.   END (* with *);
  989. END (* ShowConnectStatus *);
  990.  
  991. PROCEDURE TermDisplay(Ch : Char);
  992. BEGIN
  993.   Write(Ch);
  994. END (* TermDisplay *);
  995.  
  996. PROCEDURE Terminal;
  997. VAR
  998.   Ch    : CHAR;
  999.   dbool : BOOLEAN;
  1000.  
  1001. BEGIN
  1002.   GotoXY(1, 1);
  1003.   WHILE NOT ExitActive DO
  1004.   BEGIN
  1005.     IF KeyPressed THEN
  1006.     BEGIN
  1007.       Ch := GetKey;
  1008.       CASE Ch OF
  1009.         F10  : Show_Nest(Main_Menu);
  1010.         AltI : Show_Nest(Desk_Menu);
  1011.         AltD : Show_Nest(Dnl_Menu);
  1012.         AltU : Show_Nest(Upl_Menu);
  1013.         AltO : Show_Nest(Opt_Menu);
  1014.         AltQ : Show_Nest(Quit_Menu);
  1015.       ELSE
  1016.         dbool := LctPut(CurrConfig.ComPort, BYTE(Ch));
  1017.         IF LocalEcho THEN
  1018.           TermDisplay(Ch);
  1019.       END (* case *);
  1020.     END (* if *);
  1021.     IF LctGet(CurrConfig.ComPort, BYTE(Ch)) THEN
  1022.     BEGIN
  1023.       TermDisplay(Ch);
  1024.       IF HostMode THEN
  1025.         dbool := LctPut(CurrConfig.ComPort, BYTE(Ch));
  1026.     END;
  1027.     ShowConnectStatus;
  1028.   END (* while *);
  1029. END (* Terminal *);
  1030.  
  1031. BEGIN
  1032.   InitMenus;
  1033.   InitSetup;
  1034.   ShowPortStatus;
  1035.   Terminal;
  1036.  
  1037.   ClearText(1, 1, 80, 25, LightGray, Black);
  1038. END.
  1039.