ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/LTCOMM50.ZIP/LCDEMO.PAS

Pascal/Delphi Source File | 1989-05-14 | 27.4 KB | 1,039 lines

{$A-,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
PROGRAM LCDEMO;
(*
** LCDEMO is Copyright (c) 1989, Information Technology Ltd.
**           -- All Rights Reserved --
**
** Note: To recompile this program, you must have Technojock's Turbo Toolkit
**       by TechnoJock Software, Inc; PO Box 820927, Houston, TX 77282
**
*)

USES Crt, Dos, Printer, FastTTT5, IOTTT5, KeyTTT5, MiscTTT5, NestTTT5, ReadTTT5,
     StrnTTT5, WinTTT5, LctKrnl, LctSupp, LctYMBat, LTXmKrnl, LTXmodem;

TYPE
  BytePtr = ^BYTE;

  PtrRec = RECORD
    Ofs, Seg : WORD;
  END;

  ConfigRec = RECORD
    ComPort  : INTEGER;
    BaudRate : WORD;
    Parity   : CHAR;
    DataBits : INTEGER;
    StopBits : INTEGER;
    Changed  : BOOLEAN;
  END;

VAR
  Main_Menu : Nest_Menu;
  Desk_Menu : Nest_Menu;
  Dnl_Menu  : Nest_Menu;
  Upl_Menu  : Nest_Menu;
  Opt_Menu  : Nest_Menu;
  Port_Menu : Nest_Menu;
  Set_Menu  : Nest_Menu;
  Quit_Menu : Nest_Menu;

  HostMode  : BOOLEAN;
  LocalEcho : BOOLEAN;
  ExitActive : BOOLEAN;
  GotEsc     : BOOLEAN;

  CurrConfig : ConfigRec;
  CfgFile    : FILE OF ConfigRec;

  XMBlksize  : INTEGER;

PROCEDURE ShowPortStatus;
VAR
  X, Y, Top, Bottom : BYTE;
  DispStr : STRING;
  WkStr : STRING[18];

BEGIN
  WITH CurrConfig DO
  BEGIN
    FindCursor(X, Y, Top, Bottom);
    OffCursor;
    CASE ComPort OF
      1 : DispStr := 'COM1,';
      2 : DispStr := 'COM2,';
      3 : DispStr := 'COM3,';
      4 : DispStr := 'COM4,';
    END;
    WkStr := Int_to_Str(BaudRate);
    DispStr := DispStr + WkStr + ',' + Parity + ',';
    WkStr := Int_to_Str(DataBits);
    DispStr := DispStr + WkStr + ',';
    WkStr := Int_to_Str(StopBits);
    DispStr := DispStr + WkStr;
    PlainWrite(40, 25, DispStr);
    PosCursor(X, Y);
    OnCursor;
  END (* with *);
END (* ShowPortStatus *);

PROCEDURE ChangePort(NewPort : INTEGER);
VAR
  dbool : BOOLEAN;

BEGIN
  WITH CurrConfig DO
  BEGIN
    CommClose(ComPort, FALSE);
    ComPort := NewPort;
    dbool := CommOpen(ComPort, BaudRate, Parity, DataBits, StopBits, 2048, 2048, TRUE);
    Changed := TRUE;
  END (* with *);
  ShowPortStatus;
END (* ChangePort *);

PROCEDURE SetPort(Choice : INTEGER);
VAR
  dbool : BOOLEAN;
  Ch    : CHAR;

BEGIN
  WITH CurrConfig DO
  BEGIN
    CASE Choice OF
      50..51 : BaudRate := 1200;
      52..53 : BaudRate := 2400;
      54..55 : BaudRate := 9600;
      56..57 : BaudRate := 19200;
    END (* case *);
    IF Choice <= 57 THEN                    (* using menu pre-sets ? *)
    BEGIN
      Changed := TRUE;
      IF (Choice MOD 2) = 0 THEN
      BEGIN
        Parity := 'N';
        DataBits := 8;
      END
      ELSE
      BEGIN
        Parity := 'E';
        DataBits := 7;
      END;
      StopBits := 1;
    END
    ELSE
      TempMessageBoxCh(20, 12, WHITE, RED, 2, 'Sorry...That function isn''t available', Ch);

    dbool := CommSetup(ComPort, BaudRate, Parity, DataBits, StopBits);
  END (* with *);
  ShowPortStatus;
END (* SetPort *);

PROCEDURE ShowInfoBox;
BEGIN
  GrowMkWin(21, 8, 55, 15, Black, Green, 1);    (* open up the window *)
  PlainWrite(26, 9, 'FileName:');
  PlainWrite(28, 11, 'Blocks:');
  PlainWrite(28, 12, 'Errors:');
  PlainWrite(22, 13, 'Total Errors:');
END (* ShowInfoBox *);

{$F+}
PROCEDURE ShowFile(CPort: INTEGER; Name:STRING);
BEGIN
  PlainWrite(36, 9, '            ');
  PlainWrite(36, 9, Name);
END (* ShowFile *);

PROCEDURE ShowXferData(CPort:INTEGER; Rec, Errors, TotErrors:WORD);
VAR
  WString : STRING;

BEGIN
  WString := Int_to_Str(Rec+1);
  PlainWrite(36, 11, WString);
  WString := Int_to_Str(Errors);
  PlainWrite(36, 12, WString);
  WString := Int_to_Str(TotErrors);
  PlainWrite(36, 13, WString);
END (* ShowXferData *);

FUNCTION ChkKbd : BOOLEAN;
VAR
  Ch : CHAR;

BEGIN
  ChkKbd := FALSE;
  IF KeyPressed THEN
  BEGIN
    Ch := ReadKey;
    IF Ch = #$00 THEN
      Ch := ReadKey;
  END;
  IF Ch = #$1B THEN
    ChkKbd := TRUE;
END (* ChkKbd *);

PROCEDURE Test_Esc(VAR Ch:CHAR; VAR ID:BYTE; VAR REFRESH:BYTE);
BEGIN
  GotEsc := FALSE;
  REFRESH := Refresh_None;
  IF Ch = Esc THEN
  BEGIN
    GotEsc := TRUE;
    REFRESH := End_Input;
  END;
END (* Test_Esc *);

PROCEDURE Leave_Tab1(VAR ID:BYTE; VAR R:BYTE);
BEGIN
  IF ID = 7 THEN
    R := End_Input;
END (* Leave_Tab1 *);

PROCEDURE Leave_Tab2(VAR ID:BYTE; VAR R:BYTE);
BEGIN
  R := End_Input;
END (* Leave_Tab1 *);

PROCEDURE Leave_Tab5(VAR ID:BYTE; VAR R:BYTE);
BEGIN
  IF ID = 3 THEN
    R := End_Input;
END (* Leave_Tab1 *);

{$F-}

PROCEDURE LcInfo;
BEGIN
  CreateScreen(2,25);                       (* start a virtual screen *)
  Activate_Virtual_Screen(2);
  FBox(1, 1, 80, 25, BLACK, CYAN, 4);
  WriteCenter(2, BLACK, GREEN, 'INTRODUCING LITECOMM');
  WriteAT(6, 4, BLACK, CYAN,
    'LiteComm (Tm) and LiteComm-TP are sophisticated toolboxes of proven');
  WriteAT(6, 5, BLACK, CYAN,
    'routines for C and PASCAL programmers. By using LiteComm, you can');
  WriteAT(6, 6, BLACK, CYAN,
    'quickly and easily add communications capabilities to your application');
  WriteAT(6, 7, BLACK, CYAN,
    'without worrying about the details.');
  WriteAT(6, 9, BLACK, CYAN,
    'LiteComm is a shareware product. If you find the package useful, you');
  WriteAT(6, 10, BLACK, CYAN,
    'must register it. Full registration information is contained in the');
  WriteAT(6, 11, BLACK, CYAN,
    'documentation, or you may complete the online registration form.');
  WriteCenter(13, BLACK, GREEN,
    'LiteComm and LiteComm-TP are Copyright (c) 1987,88,89');
  WriteCenter(14, BLACK, GREEN,
    'Information Technology, Ltd.; all rights reserved');
  WriteAT(35, 16, BLACK, CYAN, '┌─────┐');
  WriteAT(31, 17, BLACK, CYAN, '┌───┴─┐   │            (Tm)');
  WriteAT(29, 18, BLACK, CYAN, '──┤     │o  ├────────────────');
  WriteAT(31, 19, BLACK, CYAN, '│ ┌───┴┴┐ │ Association of');
  WriteAT(31, 20, BLACK, CYAN, '│ │     ├─┘ Shareware');
  WriteAT(31, 21, BLACK, CYAN, '└─┤  o  │   Professionals');
  WriteAT(29, 22, BLACK, CYAN, '────╡  │  ├──────────────────');
  WriteAT(33, 23, BLACK, CYAN, '└──┴──┘   MEMBER');
  Activate_Visible_Screen;
  SaveScreen(1);
  SlideRestoreScreen(2, Left);
  REPEAT
    ;
  UNTIL ChkKbd;
  SlideRestoreScreen(1, Up);
END (* LcInfo *);

PROCEDURE LcReg;
VAR
  Name,
  Company,
  Address : STRING[35];
  City,
  Country : STRING[20];
  State   : STRING[2];
  PostCode,
  DayPhone : STRING[15];
  ByCheck,
  ByVISA,
  ByMC    : STRING[1];
  CCNumber: STRING[16];
  ExpDate : DATES;

BEGIN
(*
** init the world
*)
  Name := '';
  Company := '';
  Address := '';
  City := '';
  Country := '';
  State := '';
  PostCode := '';
  ByCheck := '';
  ByVISA := '';
  ByMC := '';
  DayPhone := '';
  CCNumber := '';
  ExpDate := 0;

  MkWin(1, 1, 80, 25, BLACK, CYAN, 2);      (* double line box window *)
  WriteCenter(3, BLACK, GREEN, 'LITECOMM (Tm) REGISTRATION');
  WriteAT(11, 5, BLACK, CYAN,
    'Complete the following information. I will print a completed');
  WriteAT(11, 6, BLACK, CYAN,
    'registration form for you to mail. (ESC to abort)');
  WriteAT(11, 8, BLACK, CYAN, 'NAME');
  WriteAT(57, 8, BLACK, GREEN, '(from credit card)');
  WriteAT(11, 10, BLACK, CYAN, 'COMPANY');
  WriteAT(11, 12, BLACK, CYAN, 'ADDRESS');
  WriteAT(11, 14, BLACK, CYAN, 'CITY');
  WriteAT(41, 14, BLACK, CYAN, 'STATE');
  WriteAT(11, 16, BLACK, CYAN, 'COUNTRY');
  WriteAT(41, 16, BLACK, CYAN, 'POSTAL CODE');
  WriteAT(11, 18, BLACK, CYAN, 'Method of Payment ($50 Fee)');
  WriteAT(13, 20, BLACK, CYAN, '[ ] Check Enclosed');
  WriteAT(13, 22, BLACK, CYAN, '[ ] VISA  [ ] MasterCard  NO:');
  WriteAT(64, 22, BLACK, CYAN, 'EXPIRES');
  WriteAT(13, 23, BLACK, CYAN, 'Daytime Telephone');

  Create_Tables(5);

  Activate_Table(1);                        (* table 1 is basic info *)
  Allow_Esc(TRUE);
  Create_Fields(7);
  Add_Field(1, 1, 2, 1, 2, 20, 8);          (* Name *)
  Add_Field(2, 1, 3, 2, 3, 20, 10);         (* Company *)
  Add_Field(3, 2, 4, 3, 4, 20, 12);         (* Address *)
  Add_Field(4, 3, 5, 4, 5, 20, 14);         (* City *)
  Add_Field(5, 4, 6, 5, 6, 47, 14);         (* State *)
  Add_Field(6, 5, 7, 6, 7, 20, 16);         (* Country *)
  Add_field(7, 6, 7, 7, 7, 53, 16);         (* postal code *)
  String_Field(1, Name, '***********************************');
  String_Field(2, Company, '***********************************');
  String_Field(3, Address, '***********************************');
  String_Field(4, City, '********************');
  String_Field(5, State, '!!');
  String_Field(6, Country, '********************');
  String_Field(7, PostCode, '***************');

  Activate_Table(2);
  Allow_Esc(TRUE);
  Create_Fields(1);
  Add_Field(1, 1, 1, 1, 1, 14, 20);         (* pay by check *)
  String_Field(1, ByCheck, '!');
  Field_Rules(1, JumpIfFull, [' ', 'X', 'x'], [No_Char]);
  Add_Message(1, 1, 25, 'X to Select, SPACE to Skip');

  Activate_Table(3);
  Allow_Esc(TRUE);
  Create_Fields(1);
  Add_Field(1, 1, 1, 1, 1, 14, 22);         (* pay by visa *)
  String_Field(1, ByVISA, '!');
  Field_Rules(1, JumpIfFull, [' ', 'X', 'x'], [No_Char]);
  Add_Message(1, 1, 25, 'X to Select, SPACE to Skip');

  Activate_Table(4);
  Allow_Esc(TRUE);
  Create_Fields(1);
  Add_Field(1, 1, 1, 1, 1, 24, 22);        (* pay by M/C *)
  String_Field(1, ByMC, '!');
  Field_Rules(1, JumpIfFull, [' ', 'X', 'x'], [No_Char]);
  Add_Message(1, 1, 25, 'X to Select, SPACE to Skip');

  Activate_Table(5);
  Allow_Esc(TRUE);
  Create_Fields(3);
  Add_Field(1, 1, 2, 1, 2, 43, 22);
  Add_Field(2, 1, 3, 2, 3, 72, 22);
  Add_Field(3, 2, 3, 3, 3, 31, 23);
  String_Field(1, CCNumber, '####-####-####-####');
  Date_Field(2, ExpDate, MMYY, '##/##', 0, 0);
  String_Field(3, DayPhone, '***************');
  Field_Rules(1, JumpIfFull, [No_Char], [No_Char]);
  Field_Rules(2, JumpIfFull, [No_Char], [No_Char]);
  Field_Rules(3, JumpIfFull, [No_Char], [No_Char]);
  Add_Message(3, 1, 25, 'Daytime Telephone Number');

(*  Basic Data *)
  Activate_Table(1);
  Assign_CharHook(Test_Esc);
  Assign_LeaveFieldHook(Leave_Tab1);
  Process_Input(1);
  IF GotEsc THEN
  BEGIN
    Dispose_Fields;
    Dispose_Tables;
    RmWin;
    EXIT;
  END;

  REPEAT
    ByCheck := '';
    ByVISA := '';
    ByMC := '';

  (*  By Check *)
    Activate_Table(2);
    Assign_CharHook(Test_Esc);
    Assign_LeaveFieldHook(Leave_Tab2);
    String_Field(1, ByCheck, '!');          (* force default reset *)
    Process_Input(1);

  (* By VISA *)
    IF (ByCheck <> 'X') AND
       (NOT GotEsc) THEN
    BEGIN
      Activate_Table(3);
      Assign_CharHook(Test_Esc);
      Assign_LeaveFieldHook(Leave_Tab2);
      String_Field(1, ByVISA, '!');
      Process_Input(1);
    END;

  (* By MC *)
    IF (ByCheck <> 'X') AND
       (ByVISA <> 'X') AND
       (NOT GotEsc ) THEN
    BEGIN
      Activate_Table(4);
      Assign_CharHook(Test_Esc);
      Assign_LeaveFieldHook(Leave_Tab2);
      String_Field(1, ByMC, '!');
      Process_Input(1);
    END;
  UNTIL (ByCheck = 'X') OR
        (ByVISA = 'X') OR
        (ByMC = 'X') OR
        (GotEsc);
  IF GotEsc THEN
  BEGIN
    Dispose_Fields;
    Dispose_Tables;
    RmWin;
    EXIT;
  END;


(* Credit Card Info *)
  IF (BYCheck <> 'X') AND
     (NOT GotEsc) THEN
  BEGIN
    Activate_Table(5);
    Assign_CharHook(Test_Esc);
    Assign_LeaveFieldHook(Leave_Tab5);
    Process_Input(1);
    IF GotEsc THEN
    BEGIN
      Dispose_Fields;
      Dispose_Tables;
      RmWin;
      EXIT;
    END;
  END;

(*
** Print the actual form
*)
  Writeln(Lst, '          LiteComm - TP REGISTRATION');
  Writeln(Lst);
  Writeln(Lst);
  Writeln(Lst);
  Writeln(Lst, 'Please register my copy of the LiteComm-TP ToolBox.');
  Writeln(Lst, 'I Agree to be bound by the terms and conditions of the');
  Writeln(Lst, 'license agreement as stated in the LiteComm-TP documentation');
  Writeln(Lst);
  Writeln(Lst);
  Writeln(Lst,'  Name:    ', Name);
  Writeln(Lst,'  Company: ', Company);
  Writeln(Lst,'  Address: ', Address);
  Writeln(Lst,'  City:    ', City, '  State: ', State);
  IF Length(Country) > 0 THEN
    Write(Lst,'  Country: ', Country, ' ');
  Writeln(Lst, 'Postal Code: ', PostCode);
  Writeln(Lst);
  Writeln(Lst, 'Payment by:');
  IF ByCheck = 'X' THEN
    Writeln(Lst, '   Check Enclosed')
  ELSE
    IF ByVISA = 'X' THEN
      Writeln(Lst, '   VISA No: ', CCNumber, ' Expires',
        Julian_to_Date(ExpDate, MMYY))
    ELSE
      Writeln(Lst, '   MasterCard No: ', CCNumber, ' Expires',
        Julian_to_Date(ExpDate, MMYY));
  IF ByCheck <> 'X' THEN
  BEGIN
    Writeln(Lst, '   Daytime Phone Number: ', DayPhone);
    Writeln(Lst);
    Writeln(Lst);
    Writeln(Lst, 'Signature(required)..............................................');
  END;
  Writeln(Lst);
  Writeln(Lst,'Send to: Information Technology, Ltd');
  Writeln(Lst,'         PO Box 554');
  Writeln(Lst,'         Coventry, RI 02816');
  Write(Lst, #$0C);                         (* FORM-FEED *)

  Dispose_Fields;
  Dispose_Tables;
  RmWin;
END (* LcReg *);

PROCEDURE Downl_XM;
VAR
  dbool : BOOLEAN;
  X, Y, Top, Bottom : BYTE;
  Path  : PathStr;

  BSize    : WORD;
  RBSize   : INTEGER;
  HandShake : BYTE;
  BPtr     : BytePtr;
  CRPtr    : BytePtr;
  Result   : XMResult;
  BytesRem : WORD;                          (* number of untrans. bytes *)
  XMFile : FILE;

BEGIN
  Path := '';
  SaveScreen(1);
  Read_String(3, 12, 70, '_File Name to Get, Esc to EXIT', 1, Path);
  RestoreScreen(1);
  IF R_Char = Esc THEN
    EXIT;

  FindCursor(X, Y, Top, Bottom);
  OffCursor;
  ShowInfoBox;
(*
** Install Hooks For the display Routines
*)

  dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);

  BSize := 8192;                            (* want to use 8K buffer *)
  BPtr  := NIL;
  WHILE (BPtr = NIL) AND                    (* allocate buffer for proc *)
        (BSize > 0) DO
    IF MaxAvail >= BSize THEN               (* enough contig space *)
      GetMem(BPtr, BSize)                   (* yes, grab it *)
    ELSE
      DEC(BSize, 1024);                     (* no, try 1K less *)

(*
** Here is where everything begins...All XModem related code is
** self-contained here
*)

  Assign(XMFile, Path);
  ShowFnProc[CurrConfig.ComPort](CurrConfig.ComPort, Path);
{$I-}
  Rewrite(XMFile, 1);
{$I+}
  IF IOResult <> 0 THEN
    FlagAbort(CurrConfig.ComPort);

  Result := Success;
  BytesRem := 0;
  CRPtr := BPtr;

  HandShake := CRCREQ;                    (* receive in CRC mode *)
  XMReset(CurrConfig.ComPort);
  BatchMode(CurrConfig.ComPort, FALSE);

  WHILE Result = Success DO
  BEGIN
    Result := LxmRrec(CurrConfig.ComPort, CRPtr^, RBSize, RTOUT, HandShake);
    IF Result = Success THEN
    BEGIN
      INC(BytesRem, RBSize);
      INC(PtrRec(CRPtr).Ofs, RBSize);
      IF BytesRem >= BSize THEN           (* filled the IO Buffer *)
      BEGIN
{$I-}
        BlockWrite(XMFile, BPtr^, BSize);
{$I+}
        IF IOResult <> 0 THEN
          FlagAbort(CurrConfig.ComPort);
        CRPtr := BPtr;                     (* set current record ptr *)
        BytesRem := 0;
      END;
    END;
    IF Result = DupBlk THEN
      Result := Success;
  END (* while *);
  IF (BytesRem > 0) AND                   (* anything left unwritten *)
     (Result = EndFile) THEN              (* Is it End of File ? *)
    BlockWrite(XMFile, BPtr^, BytesRem);   (* yes, flush the buffer *)

  Close(XMFile);
  BatchMode(CurrConfig.ComPort, FALSE);
  Dispose(BPtr);
  XMReset(CurrConfig.ComPort);

  IF Result <> EndFile THEN               (* if we didn't end OK *)
    Erase(XMFile);

  RmWin;
  OnCursor;
  PosCursor(X, Y);
END (* Downl_XM *);

PROCEDURE Send_XM;
VAR
  Path     : PathStr;
  X, Y, Top, Bottom : BYTE;
  BSize    : WORD;
  BPtr     : BytePtr;
  CRPtr    : BytePtr;
  Result   : XMResult;
  BytesRead,                                (* number of bytes read *)
  BytesRem : WORD;                          (* number of untrans. bytes *)
  XMFile   : FILE;

BEGIN
  Path := '';
  SaveScreen(1);
  Read_String(3, 12, 70, '_File Spec to Send, Esc to EXIT', 1, Path);
  RestoreScreen(1);
  IF R_Char = Esc THEN
    EXIT;

  FindCursor(X, Y, Top, Bottom);
  OffCursor;
  ShowInfoBox;

  BSize := 8192;                            (* want to use 8K buffer *)
  BPtr  := NIL;
  WHILE (BPtr = NIL) AND                    (* allocate buffer for proc *)
        (BSize > 0) DO
    IF MaxAvail >= BSize THEN               (* enough contig space *)
      GetMem(BPtr, BSize)                   (* yes, grab it *)
    ELSE
      DEC(BSize, 1024);                     (* no, try 1K less *)

  Assign(XMFile, Path);
  ShowFnProc[CurrConfig.ComPort](CurrConfig.ComPort, Path);
{$I-}
  Reset(XMFile, 1);
{$I+}
  FillChar(BPtr^, XMBlksize, $00);              (* prefill buffer w/ nulls *)

  Result := Success;
  BytesRead := 1;

  WHILE (BytesRead > 0) AND
        (Result = Success) DO
  BEGIN
    FillChar(BPtr^, BSize, $00);
{$I-}
    BlockRead(XMFile, BPtr^, BSize, BytesRead);
{$I+}
    CRPtr := BPtr;                        (* set current record ptr *)
    BytesRem := BytesRead;

    WHILE (BytesRem > 0) AND
          (Result = Success) DO
    BEGIN
      Result := LxmTrec(CurrConfig.ComPort, CRPtr^);    (* do actual transmission *)
      IF BytesRem > XMBlksize THEN
        DEC(BytesRem, XMBlksize)
      ELSE
        BytesRem := 0;
      INC(PtrRec(CRPtr).Ofs, XMBlksize);
    END;

    IF BytesRead < BSize THEN
      BytesRead := 0;
  END; (* OUTER WHILE *)

  IF Result = Success THEN
    Result := LxmTeot(CurrConfig.ComPort);       (* send end of file *)
  Close(XMFile);
  Dispose(BPtr);                        (* release buffer *)

  RmWin;
  OnCursor;
  PosCursor(X, Y);
END;


PROCEDURE Downl_YM;
VAR
  dbool : BOOLEAN;
  X, Y, Top, Bottom : BYTE;

BEGIN
  FindCursor(X, Y, Top, Bottom);
  OffCursor;
  ShowInfoBox;
(*
** Install Hooks For the display Routines
*)

  dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  dbool := LctYMRecv(CurrConfig.ComPort);

  RmWin;
  OnCursor;
  PosCursor(X, Y);
END (* Downl_YM *);

PROCEDURE Upl_YM;
VAR
  dbool : BOOLEAN;
  X, Y, Top, Bottom : BYTE;
  Path  : PathStr;

BEGIN
  Path := '';
  SaveScreen(1);
  Read_String(3, 12, 70, '_File Spec to Send, Esc to EXIT', 1, Path);
  RestoreScreen(1);
  IF R_Char = Esc THEN
    EXIT;

  FindCursor(X, Y, Top, Bottom);
  OffCursor;
  ShowInfoBox;
(*
** Install Hooks For the display Routines, Abort handler
*)

  dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  dbool := LctYMSend(CurrConfig.ComPort, Path);

  RmWin;
  OnCursor;
  PosCursor(X, Y);
END (* Upl_YM *);

PROCEDURE Upl_XM;
VAR
  dbool : BOOLEAN;

BEGIN
  dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  UseYModem(CurrConfig.ComPort, FALSE);
  XMBlkSize := 128;
  Send_XM;
END (* Upl_XM *);

PROCEDURE Upl_XMB;
VAR
  dbool : BOOLEAN;

BEGIN
  dbool := SetFnHook(CurrConfig.ComPort, ShowFile);
  dbool := SetUserHook(CurrConfig.ComPort, ShowXferData);
  dbool := SetAbortHook(CurrConfig.ComPort, ChkKbd);
  UseYModem(CurrConfig.ComPort, TRUE);
  XMBlkSize := 1024;
  Send_XM;
END (* Upl_XM *);

PROCEDURE SaveConfig;
BEGIN
  Assign(CfgFile, 'LCDEMO.CFG');
{$I-}
  Rewrite(CfgFile);                         (* (re)create the file *)
{$I+}
  IF IOResult <> 0 THEN                     (* was the file found ? *)
    EXIT;
  CurrConfig.Changed := FALSE;
  Write(CfgFile, CurrConfig);               (* write the config file *)
  Close(CfgFile);
END (* SaveConfig *);

PROCEDURE LoadConfig;
BEGIN
  Assign(CfgFile, 'LCDEMO.CFG');
{$I-}
  Reset(CfgFile);                           (* attempt to open *)
{$I+}
  IF IOResult = 0 THEN                      (* was the file found ? *)
  BEGIN
    Read(CfgFile, CurrConfig);              (* load the last config *)
    Close(CfgFile);
    EXIT;
  END;
  CurrConfig.Changed := FALSE;
  SaveConfig;                               (* force file create *)
END (* LoadConfig *);

{$F+}
PROCEDURE Task_Caller(VAR TopicCode:INTEGER; VAR RetCode:BYTE);
VAR
  XYZ : INTEGER;

BEGIN
  CASE TopicCode OF
     1 : BEGIN
           LcInfo;
           RetCode := ClearAll;
         END;
     2 : BEGIN
           LcReg;
           RetCode := ClearAll;
         END;
    10 : BEGIN
           Downl_XM;
           RetCode := ClearAll;
         END;
    12 : BEGIN
           Downl_XM;
           RetCode := ClearAll;
         END;
    13 : BEGIN
           Downl_YM;
           RetCode := ClearAll;
         END;
    20 : BEGIN
           Upl_XM;
           RetCode := ClearAll;
         END;
    22 : BEGIN
           Upl_XMB;
           RetCode := ClearAll;
         END;
    23 : BEGIN
           Upl_YM;
           RetCode := ClearAll;
         END;
    32 : BEGIN
           IF HostMode THEN
             Modify_Topic_Name(Opt_Menu, 3, 'Host Mode - OFF')
           ELSE
             Modify_Topic_Name(Opt_Menu, 3, 'Host Mode - ON');
           HostMode := NOT HostMode;
           RetCode := RefreshTopic;
         END;
    33 : BEGIN
           IF LocalEcho THEN
             Modify_Topic_Name(Opt_Menu,4,'Local Echo - OFF')
           ELSE
             Modify_Topic_Name(Opt_Menu,4,'Local Echo - ON');
           LocalEcho := NOT LocalEcho;
           RetCode := RefreshTopic;
         END;
    35 : BEGIN
           SaveConfig;
           RetCode := ClearCurrent;
         END;
 40..43 : BEGIN
           ChangePort((TopicCode-40)+1);
           RetCode := ClearCurrent;
         END;
 50..58 : BEGIN
           SetPort(TopicCode);
           RetCode := ClearCurrent;
         END;
   999 : BEGIN
           RetCode := ClearAll;
           ExitActive := TRUE;
         END;
  ELSE
    RetCode := ClearCurrent;                (* terminate the menus *)
  END;
END;
{$F-}

PROCEDURE InitMenus;
BEGIN
  Initialize_Menu(Main_Menu, 'LCDemo', 0, 0);
  Initialize_Menu(Desk_Menu, 'Information', 0, 0);
  Initialize_Menu(Dnl_Menu, 'File Download', 0, 0);
  Initialize_Menu(Upl_Menu, 'File Upload', 0, 0);
  Initialize_Menu(Opt_Menu, 'User Options', 0, 0);
  Initialize_Menu(Port_Menu, 'Active Port', 0, 0);
  Initialize_Menu(Set_Menu, 'Port Settings', 0, 0);
  Initialize_Menu(Quit_Menu, 'Quit', 0, 0);

(*
** Build Main Menu Topics
*)
  Add_Topic(Main_Menu, 'Information  Alt-I', TRUE, AltI, 0, @Desk_Menu);
  Add_Topic(Main_Menu, 'Download     Alt-D', TRUE, AltD, 0, @Dnl_Menu);
  Add_Topic(Main_Menu, 'Upload       Alt-U', TRUE, AltU, 0, @Upl_Menu);
  Add_Topic(Main_Menu, 'Options      Alt-O', TRUE, AltO, 0, @Opt_Menu);
  Add_Topic(Main_Menu, 'Quit         Alt-Q', TRUE, AltQ, 0, @Quit_Menu);

(*
** Build Information Menu Topics
*)
  Add_Topic(Desk_Menu, 'About LiteComm', TRUE, #0, 1, NIL);
  Add_Topic(Desk_Menu, 'Registration', TRUE, #0, 2, NIL);

(*
** Build File Download Menu
*)
  Add_Topic(Dnl_Menu, 'Xmodem', TRUE, #0, 10, NIL);
  Add_Topic(Dnl_Menu, 'Xmodem-1K', TRUE, #0, 12, NIL);
  Add_Topic(Dnl_Menu, 'Ymodem', TRUE, #0, 13, NIL);

(*
** Build File Upload Menu
*)
  Add_Topic(Upl_Menu, 'Xmodem', TRUE, #0, 20, NIL);
  Add_Topic(Upl_Menu, 'Xmodem-1K', TRUE, #0, 22, NIL);
  Add_Topic(Upl_Menu, 'Ymodem', TRUE, #0, 23, NIL);

(*
** Build User Options Menu
*)
  Add_Topic(Opt_Menu, 'Active Port', TRUE, #0, 0, @Port_Menu);
  Add_Topic(Opt_Menu, 'Port Settings', TRUE, #0, 0, @Set_Menu);
  Add_Topic(Opt_Menu, 'Host Mode - OFF', TRUE, #0, 32, NIL);
  Add_Topic(Opt_Menu, 'Local Echo - OFF', TRUE, #0, 33, NIL);
  Add_Topic(Opt_Menu, 'Restore', TRUE, #0, 34, NIL);
  Add_Topic(Opt_Menu, 'Save', TRUE, #0, 35, NIL);

(*
** Build Port Menu
*)
  Add_Topic(Port_Menu, 'COM1', TRUE, #0, 40, NIL);
  Add_Topic(Port_Menu, 'COM2', TRUE, #0, 41, NIL);
  Add_Topic(Port_Menu, 'COM3', TRUE, #0, 42, NIL);
  Add_Topic(Port_Menu, 'COM4', TRUE, #0, 43, NIL);

(*
** Build Settings Menu
*)
  Add_Topic(Set_Menu, '1200,N,8,1', TRUE, #0, 50, NIL);
  Add_Topic(Set_Menu, '1200,E,8,1', TRUE, #0, 51, NIL);
  Add_Topic(Set_Menu, '2400,N,8,1', TRUE, #0, 52, NIL);
  Add_Topic(Set_Menu, '2400,E,8,1', TRUE, #0, 53, NIL);
  Add_Topic(Set_Menu, '9600,N,8,1', TRUE, #0, 54, NIL);
  Add_Topic(Set_Menu, '9600,E,8,1', TRUE, #0, 55, NIL);
  Add_Topic(Set_Menu, '19200,N,8,1', TRUE, #0, 56, NIL);
  Add_Topic(Set_Menu, '19200,E,8,1', TRUE, #0, 57, NIL);

(*
** Build Quit Menu
*)
  Add_Topic(Quit_Menu, 'No', TRUE, #0, 998, NIL);
  Add_Topic(Quit_Menu, 'Yes', TRUE, #0, 999, NIL);
  Assign_Despatcher(Task_Caller);

END (* InitMenus *);

PROCEDURE InitSetup;
VAR
  dbool : BOOLEAN;

BEGIN
  Window(1, 1, 80, 24);
  ClearText(1, 1, 80, 25, WHITE, BLACK);    (* erase screen before starting *)
  ClearLine(25, LightBlue, LightGray);
  PlainWrite(65, 25, 'F10 FOR MENU');
  HostMode := FALSE;
  LocalEcho := FALSE;
  ExitActive := FALSE;

  WITH CurrConfig DO
  BEGIN
    ComPort := 2;
    BaudRate := 2400;
    Parity := 'N';
    DataBits := 8;
    StopBits := 1;
    dbool := CommOpen(ComPort, BaudRate, Parity, DataBits, StopBits, 2048, 2048, TRUE)
  END (* with *);
  LoadConfig;                               (* load existing config *)
END;

PROCEDURE ShowConnectStatus;
VAR
  X, Y, Top, Bottom : BYTE;
  MStatus : BYTE;

BEGIN
  WITH CurrConfig DO
  BEGIN
    MStatus := ModemStatus(ComPort);
    IF (MStatus AND (DeltaRI OR DeltaDCD OR DeltaCTS OR DeltaDSR)) = $00 THEN
      EXIT;
    FindCursor(X, Y, Top, Bottom);
    OffCursor;
    IF (MStatus AND DCD) <> $00 THEN
      PlainWrite(2, 25, 'DCD')
    ELSE
      PlainWrite(2, 25, '   ');
    IF (MStatus AND CTS) <> $00 THEN
      PlainWrite(6, 25, 'CTS')
    ELSE
      PlainWrite(6, 25, '   ');
    IF (MStatus AND DSR) <> $00 THEN
      PlainWrite(10, 25, 'DSR')
    ELSE
      PlainWrite(10, 25, '   ');
    IF (MStatus AND RI) <> $00 THEN
      PlainWrite(14, 25, 'RI ')
    ELSE
      PlainWrite(14, 25, '   ');
    PosCursor(X, Y);
    OnCursor;
  END (* with *);
END (* ShowConnectStatus *);

PROCEDURE TermDisplay(Ch : Char);
BEGIN
  Write(Ch);
END (* TermDisplay *);

PROCEDURE Terminal;
VAR
  Ch    : CHAR;
  dbool : BOOLEAN;

BEGIN
  GotoXY(1, 1);
  WHILE NOT ExitActive DO
  BEGIN
    IF KeyPressed THEN
    BEGIN
      Ch := GetKey;
      CASE Ch OF
        F10  : Show_Nest(Main_Menu);
        AltI : Show_Nest(Desk_Menu);
        AltD : Show_Nest(Dnl_Menu);
        AltU : Show_Nest(Upl_Menu);
        AltO : Show_Nest(Opt_Menu);
        AltQ : Show_Nest(Quit_Menu);
      ELSE
        dbool := LctPut(CurrConfig.ComPort, BYTE(Ch));
        IF LocalEcho THEN
          TermDisplay(Ch);
      END (* case *);
    END (* if *);
    IF LctGet(CurrConfig.ComPort, BYTE(Ch)) THEN
    BEGIN
      TermDisplay(Ch);
      IF HostMode THEN
        dbool := LctPut(CurrConfig.ComPort, BYTE(Ch));
    END;
    ShowConnectStatus;
  END (* while *);
END (* Terminal *);

BEGIN
  InitMenus;
  InitSetup;
  ShowPortStatus;
  Terminal;

  ClearText(1, 1, 80, 25, LightGray, Black);
END.