Shareware Grab Bag/Shareware Grab Bag.iso/007/simcode.arc/MAINSIM.PAS

Pascal/Delphi Source File | 1985-02-14 | 17.5 KB | 637 lines

{$symtab-,$pagesize:86,$linesize:96,$debug-,
$title:'MAINSIM.PAS -- Main Routine for Terminal Simulator'}
{    COPYRIGHT @ 1982
    Jim Holtman and Eric Holtman
    35 Dogwood Trail
    Randolph, NJ 07869
    [phone]
}
{$include:'arglist.inc'}
{$list-}
{$include:'filkqq.inc'}
{$list+, FILKQQ.INC included}

 program simterm(output,input);

     uses
     arglist,filkqq;       {$include:'simterm.inc'}

     const
     Alt_C = 46;           {Alternate C - log file switch}
     Alt_D = 32;           {Alternate D - Dump the file to Comm line}
     Alt_F = 33;           {Alternate F - turn on line edit mode}
      Alt_E = 18;           {toggle the vi_cursor mode}
     Alt_H = 35;           { Help screen }
     Alt_K = 37;           { Alternate login functions }
     Alt_L = 38;           { Executing login scripts }
     Alt_R = 19;           {XModem Receive}
     Alt_T = 20;           {XModem Transmit}
     Alt_P = 25;            {Toggle Prime editting mode}
     Alt_V = 47;           {Ventel functions entry point }
     F1 = 59;           {function key 1}
     F2 = 60;           {function key 2}
     F3 = 61;           {function key 3}
     F5 = 63;           {function key 5, send an "l" (for reading notes) }
     F6 = 64;           {function key 6, send a "j" (for reading notes) }
     F8 = 66;           {function key 8}
     Alt_F1 = 104;           {Alternate F1}
     Alt_F2 = 105;           {Alternate F2}
     Alt_F3 = 106;           {Alternate F3}
     Alt_F4 = 107;           {Alternate F4 -- toggle the masking bit}
     Alt_F5 = 108;           {Alternate F5 -- clear 25th line}
     Alt_F6 = 109;           {Alternate F6 -- display modes on 25th line}
     Alt_F10 = 113;    {Exit, but clear screen first}
     HOME = 71;           {HOME key}
     PrtSc = 114;           {CNTL-PrtSc}
     CNTL_Pg_Dn = 118;       {Download -- UNIX -> IBM}
     CNTL_Pg_Up = 132;       {Upload -- IBM -> UNIX}
     Alt_1 = 120;
     Alt_0 = 129;
     Alt_MINUS = 130;
     Alt_EQUAL = 131;

     type
     screen_buffer = array [1..4000] of byte;

     var
     adm_sim_flag [public] : boolean;
     answer : lstring(10);
     bbs_filename [external] : lstring(64);
     bbs_numbers [public] : boolean ;
     prime_mode [public] : boolean;
     bios_data_ptr : ads of array[0..99] of byte;
     ca : integer;
     cesxqq [external] : word; {load address for SIMTERM}
     ch : integer;
     char_graphics [public] : boolean;
     cold_start : boolean;
     direct_connect : boolean;
     display_buffer_addr [public] : word;
     display_columns [public] : boolean;
     display_control [public] : boolean;
     emacs_flag [public] : boolean;
     first_script [public] : lstring(20);
     fts_sense : boolean;
     function_keys [public] : array[1..10] of lstring(30);
     graftrax [public] : boolean;
     half_duplex : boolean;
     hayes_modem [public] : boolean;
     hp_sim_flag [public] : boolean;
     i,x,y : integer;
     ignore_char : integer;
     ignore_dels [public] : boolean;
     ignore_rubout [public] : boolean;
     inch : char;
     insert_mode [external] : boolean;
     interrupt_set : boolean;
     irq_num : integer;
     keych : char;
     keycnt : integer;
     key_file : text;
     last_bbs [public] : integer ;
     line_buf : lstring(81);   {line buffer for ENTER}
     line_edit [public] : boolean;
     log_file [public] : file of char;
     log_flag [public] : boolean;
     lpt_only_flag [public] : boolean;
     max_bbs [public] : integer ;
     menufil : lstring(30);
     num_chars : integer;
     outfile : lstring(100);
     param : lstring(40);
     parity : word;
     parity_mask [external] : integer;
     port_num : integer;
     recv_reset [external] : boolean;
     retrace_flag [public] : boolean;
     rogue_mode [public] : boolean;
                   {true if we're playing rogue}
     s2 : string(2);
     script_file [public] : lstring(20);
     script_verbose [public] : boolean;
     scroll_top [public]: integer;
                   { where the 'top' is for scroll lock }
     silent_mode [public] : boolean;
                   {status message switch}
     snapptr : integer;
     snapscreen : array[1..20] of ^screen_buffer;
     snapx, snapy : array[1..20] of integer;
     speed : real;           {baud rate}
     stop_bits : word;       { 1 or 2 }
     telfile [public] : text;
     telno : lstring(40);
     vi_cursor [external] : boolean;
     word_length : word;
     xoff_sent [public]: boolean;
     xxdate [external] : string(6);
     x_control : boolean;
     x_last,y_last : integer;
value
     adm_sim_flag := false;
     bbs_numbers := false;
     bios_data_ptr.r := 0;
     bios_data_ptr.s := #40;
     char_graphics := false;
     cold_start := false;
     direct_connect := false;
     display_buffer_addr := 0;
     display_columns := false;
     display_control := false;
     emacs_flag := false;
     first_script.len := 0;
     fts_sense := true;
     function_keys[1] := 'who'*chr(13);
     function_keys[2] := 'ls'*chr(13);
     graftrax := true;       {assume an EPSON w/ GRAFTRAX option}
     half_duplex := false;
     hayes_modem := false;
     hp_sim_flag := false;
     ignore_char := -1;
     ignore_dels := false;
     ignore_rubout := false;
     interrupt_set := true;
     irq_num := 4;           {assume IRQ4}
     last_bbs := -1;
     line_edit := false;
     log_flag := false;
     lpt_only_flag := false;
     parity := 0;           {no checking}
     port_num := 0;    {assume COM1 }
     prime_mode := false;
     rogue_mode := false;
     script_file := 'scripts';
     script_verbose := false;
     scroll_top := 0;
     silent_mode := false;
     snapptr := 1;
     speed := 1200.0;       {default speed}
     stop_bits := 1;
     telno := 'none';
     word_length := 8;
     xoff_sent := false;
     x_control := true;
     x_last := -1;
     y_last := -1;           {$include:'graph.inc'}
                   {$include:'comm.inc'}

     function menutree(const s: string) : integer; external;

     procedure login; external;

     procedure keyp(i : char);external;

     procedure alogin; external;

     procedure chattr(newattr : byte;
       y, sx, ex : integer); external;

     procedure ck(a : integer;
       const b : string); external;

     procedure save_line(line : CRT_SIZE;
       inc : INC_LIMIT); external;

     procedure display_line(line : CRT_SIZE;
       inc : INC_LIMIT); external;

     procedure putchar(inchar : char); external;

     function getc(exit_flag : LOOP_FLAG) : integer; external;

     procedure parse(var c : integer); external;

     procedure endxqq; external;

     procedure parse_file(var filename : lstring); external;

     procedure down_load; external;

     procedure up_load; external;

     procedure xmodem_down; external;

     procedure xmodem_up; external;

     procedure dump_file; external;

     procedure adm_sim(ch : integer); external;

     procedure do_help(i : integer); external;

     procedure do_ventels; external;

     procedure write_file; external;

     procedure com_begin(port_num : integer;
       speed : integer;
       lcr : word;
       xon : boolean); external;

     function modem_status : byte; external;

     procedure com_end; external;

     procedure set_interrupt_high(number : integer); external;

     procedure delete_char [public];

     var
         i,x,y,ca : integer;

     begin               {delete char}
         xrcurp(x,y);
         for i := x to (RIGHT_MAR-1) do begin
         xxmove(i+1,y);
         ca:=xrca;
         xxmove(i,y);
         xwca(ca,1)   end;
         xxmove(RIGHT_MAR,y);
         xwca(NULLB,1);
         xxmove(x,y);
         end;
{ Two routine that can take a snapshot of screen w/cursor and
  then later restore the snapshot }

     procedure savescreen [public];

     var
         x : ads of char;

     begin
         x.s := display_buffer_addr;
         x.r := 0;
         new(snapscreen[snapptr]);
         if retrace_flag then moves_wait(x,ads snapscreen[snapptr]^,4000)
         else movesl(x, ads snapscreen[snapptr]^, 4000);
         xrcurp(snapx[snapptr], snapy[snapptr]);
         snapptr := snapptr + 1;
         end;

     procedure restorescreen [public];

     var
         x : ads of char;

     begin
         x.s := display_buffer_addr;
         x.r := 0;
         if (snapptr = 1) then return;
         snapptr := snapptr - 1;
         if retrace_flag then moves_wait(ads snapscreen[snapptr]^, x, 4000)
         else movesl(ads snapscreen[snapptr]^, x, 4000);
         xxmove(snapx[snapptr], snapy[snapptr]);
         dispose(snapscreen[snapptr]);
         end;


{Binary to ASCII conversion for diplaying coordinates
 on the CRT}

     procedure btoa(i:integer;
       var s : string);

     begin
         s[1] := chr(i div 10 + ord('0'));
         if s[1] = '0' then s[1] := ' ';
         s[2] := chr(i mod 10 + ord('0'));
         end;

     procedure dial(var number : lstring);

     external;           {dial number on a ventel autodialer}

     function is_answered : boolean;

     external;

     procedure display_keys [public];
                   {display the function key values}

     var
         i,j : integer;
         x,y : integer;
         tchar : char;
         slen : integer;

     begin
         xrcurp(x,y);
         xxmove(0,24);
         for i := 1 to 10 do   {replace CR with ESC for displaying string}
         if (function_keys[i,ord(function_keys[i,0])] = chr(13)) then function_keys[i,ord(function_keys[i,0])]
               := chr(174)   ;
         for i := 1 to 10 do begin
         tchar := chr((i mod 10)+ord('0'));
         xttywrt(tchar,#70);
         if i <> 10 then slen := 7
         else slen := 6;
         write(function_keys[i]:slen);
         end;
         for i := 1 to 10 do   {UNDO the above substitution}
         if (function_keys[i,ord(function_keys[i,0])] = chr(174)) then function_keys[i,ord(function_keys[i,0])]
               := chr(13)   ;
         xxmove(x,y);
         end;

     begin
     xxcls;
     xxmove(0,0);
     xttywrt('COPYRIGHT @ 1982 -- Jim & Eric Holtman'*chr(10)*chr(13),240);
     xttywrt('----------- S I M T E R M ------------'*chr(10)*chr(13),240);
     writeln(output,'Terminal Simulator Ready.       Version: ',xxdate, '            Load Address: ',cesxqq:4:16,
           'H');
     save_line(0,0);       {force a save to setup buffer pointers}
     bios_data_ptr^[#17] := 0; {clear keyboard flag to ensure no SHIFTs are LOCKed}

     for i := 1 to argc do begin
         argv(i,param);
         if (param.len < 2) or (param[1] <> '-') then cycle;
         case param[2] of

         'a':              {simulate an ADM3A}
               adm_sim_flag := true;

         'b':              {force the monochrome display buffer}
               display_buffer_addr := #B000;

         'B':              {reset the receiver buffer on a BREAK}
               recv_reset := true;

         'c':              {set the comm port -  1..4}
               begin
             delete(param,1,2);
             eval(decode(param,port_num));
             if port_num = 2 then irq_num := 3; {standard default}
             if (port_num < 1) or (port_num > 4) then begin
             writeln(output,'illegal COMM#. COM1 assumed.');
             port_num := 1;
             end;
             port_num := port_num-1;
                   {adjust for indexing}
             end;

         'd':              {direct connect -- don't wait for carrier detect}
               direct_connect := true;

         'D':              {ignore the DELs -- noise on the line}
                   {I have lots of noise on my line and it appears as a DEL followed by 'junk'. This
                      flag filters out the offending characters}
               ignore_dels := true;

         'e':              {EPSON w/o GRAFTRAX option - must simulate underlines, etc}
               graftrax := false;

         'E':           {set EMACS cursors keys for `curses'}
               emacs_flag := true;

         'g':              {set to graphics display buffer}
               display_buffer_addr := #B800;

         'h':              {set for half-duplex mode; echo input}
               half_duplex := true;

         'H': hp_sim_flag := true;

         'i':              {setup user specified IRQ for Async controller}
               begin
             delete(param,1,2);
             eval(decode(param,irq_num));
             if (irq_num < 2) or (irq_num > 5) then begin
             writeln(output,'Illegal IRQ. IRQ4 assumed.');
             irq_num := 4;
             end;
             end;

         'I':         {set comm line as highest interrupt}
            if param.len = 3 then interrupt_set := false
             else interrupt_set := true;

         'k':              {read in user KEY file}
               begin
             delete(param,1,2);
             assign(key_file,param);
             key_file.trap := true;
             reset(key_file);
             if key_file.errs = 0 then begin
             while not eof(key_file) do begin
                 readln(key_file,param);
                 x := ord(param[1]) - ord('0');
                 if x = 0 then x := 10;
                 delete(param,1,2);
                 if param[ord(param[0])] = chr(174) then param[ord( param[0] )] := chr(13);
                 function_keys[x] := param;
                 end;
             close(key_file);
             display_keys;
             end
             else writeln(output,'Key file not found - ',param);
             end;

         'M': prime_mode := true;

         'm': hayes_modem := true;

         'n':              {dial the sequnece that follow the 'n' on a VenTel }
               begin
             delete(param,1,2);
             telno := param;
             end;

         'P':              {options to parse the scriptfile}
             case param[3] of
             'F': begin
                 delete(param,1,3);
                 script_file := param;
                 end;
             'D': begin
                 delete(param,1,3);
                 first_script := param;
                 end;
             'S': script_verbose := true;
             end   ;


         'p':              {parity}
             case param[3] of

             'e':      {EVEN}
                   parity := #18;

             'm':      {MARK}
                   parity := #28;

             'n':      {no checking}
                   parity := 0;

             'o':      {ODD}
                   parity := #8;

             's':      {SPACE}
                   parity := #38;

             otherwise
                 writeln('illegal parity setting ',param);

             end   ;

         'o':              {turn off the status messages on errors}
               silent_mode := true;

         'r':              {set to wait for retrace on color graphics}
               retrace_flag := true;

         's':              {set the speed}
               begin
             delete(param,1,2);
             eval(decode(param,speed));
             end;

         'S':              {set the number of stop bits}
               begin
             delete(param,1,2);
             eval(decode(param,stop_bits));
             end;

         'v':              {setup the BBS dialing file}
               begin
             delete(param,1,2);
             bbs_filename := param;
             end;

         'w':              {set word length}
               begin
             delete(param,1,2);
             eval(decode(param,word_length));
             end;

         'x':              {XON/XOFF control}
             if param[3] = 'n' then x_control := false   ;

         otherwise
             writeln('illegal parameter :',param);

         end;
         end;
     if display_buffer_addr = 0 then
         if (bios_data_ptr^[#10] and #30) = #30 then display_buffer_addr := #B000
                   {B/W monitor}
         else display_buffer_addr := #B800;
                   {Color/graphics board}
                   {Now setup the LCR}
     if parity <> 0 then word_length := word_length-1;
                   {account for parity bit}
     word_length := ((word_length-5) and 3) or parity;
     if stop_bits = 2 then word_length := word_length or 4;
                   {2 stop bits}
     if interrupt_set then set_interrupt_high(irq_num);
     com_begin(irq_num*256+port_num,trunc(1843200.0/(speed*16.0)), word_length,x_control);
     if not direct_connect then
         repeat
         if ((modem_status and #80) = 0) and (fts_sense) then begin
             fts_sense := false;
             writeln(chr(7)*'Establish communications link'*chr(7))   end;
                   {Check if user wants to terminate the program}
         case xxinkey(inch) of
                   {read data from keyboard}
             0: ;       {no data, try again}

             1,2:
             case ord(inch) of
                   {normal ASCII data}
                 255,Alt_F1,Alt_F2: begin
                   {Terminate}
                 writeln(chr(7)*'Terminating the Simulator');
                 write_file;
                   {update bbs file}
                 com_end;
                 endxqq   end;

                 otherwise ;
                   {ignore}
                 end   ;

             end;

         until (modem_status and #80) = #80   ;
     writeln('Communications established');
     if (telno <> 'none') then begin
         dial(telno);
         end;
     if (first_script.len > 0) then begin
         login;
         first_script.len := 0;
         end;
     while TRUE do begin
         ch := getc(EXIT);       {get data from comm line}
         if (ch > -1) then begin
         if log_flag then begin
             log_file^ := chr(ch);
             put(log_file);
             end;
         if display_control then putchar(chr(ord(ch)))
         else if adm_sim_flag then adm_sim(ch)
         else parse(ch);
         end
         else if display_columns then begin
         xrcurp(x,y);
         if (x <> x_last) or (y <> y_last) then begin
             x_last := x;
             y_last := y;
             btoa(x,s2);
             xxmove(41,24);
             xttywrt(s2,7);
             btoa(y,s2);
             xxmove(38,24);
             xttywrt(s2,7);
             xxmove(x,y);
             end;
         end;

         keycnt := xxinkey(inch);
         if ((keycnt = 2) and (ord(inch) = 35)) then begin
         menufil := '\simterm\menus';
         parse_file(menufil);
         x := menutree(menufil);
         if (x > 1000) then begin
             do_help(x);
             x := 0;
             keycnt := 0;
             end
         else begin
             inch := chr(x);
             if (inch <> chr(0)) then keycnt := 2
             else keycnt := 0;
             end;
         end
         else if ((keycnt=1) and (line_edit) and (inch = chr(13))) then begin
         line_edit := false;
         insert_mode := false;
         vi_cursor := false;
         inch := chr(INSERT_KEY);
         keycnt := 2;
         end;
         case keycnt of       {read data from keyboard}
         0: ;           {no data, try again}

         1:
             case ord(inch) of
                   {normal ASCII data}
             255: begin{Terminate}
                 writeln(chr(7)*'Terminating the Simulator');
                 write_file;
                   {update bbs file}
                 com_end;
                 endxqq   end;

             otherwise
                 if (half_duplex or line_edit) then putchar(chr( inch));
                 if not line_edit then send(inch);
                   {output character}
             end ;

         2: keyp(inch);
         end;
         end;
     end.