home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / simcode.arc / GETPUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-12-23  |  5.5 KB  |  180 lines
  1. {$symtab-,$pagesize:84,$linesize:131,$debug-,
  2. $title:'GETPUT.PAS -- Get from Comm Line and Put to CRT'}
  3. {    COPYRIGHT @ 1982
  4.     Jim Holtman and Eric Holtman
  5.     35 Dogwood Trail
  6.     Randolph, NJ 07869
  7.     (201) 361-3395
  8. }
  9.  
  10.  module get_put;
  11. {$include:'simterm.inc'}
  12.  
  13.     var
  14.        [ external] insert_mode,prt_flag,lpt_only_flag : boolean;
  15.        direct_printer_flag : boolean;
  16.        display_mode : PRT_ATTR;
  17.        display_buffer_addr : word;
  18.        graftrax : boolean;
  19.        scroll_top : integer;
  20.        char_graphics : boolean;    {true if I want to print chars >128}
  21.        retrace_flag : boolean;
  22.        silent_mode [external] : boolean;
  23.  
  24.     procedure ck(a : integer;
  25.      const b :string);
  26.  
  27.        external;
  28.  
  29.     procedure save_line(line : CRT_SIZE;
  30.      inc : INC_LIMIT);
  31.  
  32.        external;
  33.  
  34.     procedure scan_line(const line : screen_buf);
  35.  
  36.        external;
  37.  
  38.     function com_get(var inch : char) : boolean;
  39.  
  40.        external;           {$include:'graph.inc'}
  41.                    {$include:'comm.inc'}
  42.  
  43.     procedure putchar(inchar : char);
  44.  
  45.        const
  46.       NORMAL = 7;
  47.       UNDERLINE = 1;
  48.       INTENSE = #0a;
  49.       INTENSEUN = #09;
  50.       REVERSE = #70;       {reverse video}
  51.       TAB = chr(9);        {expand TABS}
  52.       BACKSP = chr(8);       {back space}
  53.  
  54.        var
  55.       x,y,ynow,xpos : integer;
  56.       attr_byte,ca : integer;
  57.       save_buf : screen_buf;   {parameter for SCAN_LINE}
  58.       startb , endb : ads of char;
  59.       display_control [external] : boolean;
  60.  
  61.        begin
  62.       if direct_printer_flag then begin
  63.          xlpt1(inchar);
  64.          return   end;
  65.       xrcurp(x,y);
  66.       if (y >= BOTTOM) and ((inchar = NL) or (x = RIGHT_MAR)) then begin
  67.          xscrlup(1,scroll_top,BOTTOM);
  68.          xxmove(x,BOTTOM-1);
  69.          y := BOTTOM-1   end;
  70.       if inchar = TAB then begin
  71.          repeat
  72.         putchar(chr(xrca and #ff));
  73.                    {output the same character so }
  74.                    {TAB is non-distructive}
  75.         x := x+1
  76.         until (x mod 8) = 0;
  77.                    {go to 8th position}
  78.          return   end;
  79.       if insert_mode then begin
  80.          startb.s := display_buffer_addr;
  81.          endb.s := display_buffer_addr;
  82.          startb.r := wrd((y*(RIGHT_MAR+1) + x)*2);
  83.          endb.r := startb.r+2;
  84.          if retrace_flag then 
  85.         movesr_wait(startb,endb,wrd((RIGHT_MAR-x)*2))
  86.          else movesr(startb,endb,wrd((RIGHT_MAR-x)*2));
  87.          end;
  88.       case display_mode of
  89.          PRT_NORMAL: attr_byte := NORMAL;
  90.          PRT_UNDERLINE: attr_byte := UNDERLINE;
  91.          PRT_SUPER: attr_byte := INTENSE;
  92.          PRT_SUB: attr_byte := INTENSEUN;
  93.          PRT_BOLD: attr_byte := REVERSE;
  94.          otherwise ;
  95.          end;
  96.       if (display_control = true) then begin
  97.                    {special code for displaying control
  98.                       characters}
  99.          if inchar < chr(#20) then begin
  100.                    {this is a control character}
  101.         attr_byte := REVERSE;
  102.         inchar := chr(ord(inchar) + #40)   end     end;
  103.                    {if BACK-SPACE and LEFT MARGIN, then backup a
  104.                       line to handle}
  105.                    {wrap around on a line correctly}
  106.       if (x=LEFT_MAR) and (inchar=BACKSP) then BEGIN
  107.          if y>TOP then xxmove(RIGHT_MAR,y-1)
  108.          else   END
  109.       else xttywrt(inchar,attr_byte);
  110.       if lpt_only_flag or (graftrax and prt_flag) then xlpt1(inchar);
  111.       xrcurp(x,ynow);       {cursor after read}
  112.       if ynow>y then begin       {cursor moved down a line, so save it and }
  113.                    {SCAN it for output to printer}
  114.          save_line(y,1);
  115.          if prt_flag and (not graftrax) then begin
  116.         startb.s := display_buffer_addr;
  117.         startb.r := wrd(2*y*80);
  118.                    {find line in display area}
  119.         if retrace_flag then moves_wait(startb,ads save_buf,160)
  120.                    {setup for call}
  121.         else movesl(startb,ads save_buf,160);
  122.                    {setup for call}
  123.         scan_line(save_buf)   end   end;
  124.       end;
  125.  
  126.     function getc(flag : LOOP_FLAG) : integer;
  127.  
  128.        const
  129.       BREAK_OUT = #E;       {Left Shift, Ctrl, and Alt are depressed}
  130.  
  131.        var
  132.       inch : char;
  133.       parity_mask [public] : integer;
  134.       ignore_dels [external] : boolean;
  135.       bios_data_ptr [static] : adsmem;
  136.       err_flag [external] : byte;
  137.       lsr_value [external] : byte;
  138.       msr_value [external] : byte;
  139.  
  140.       value parity_mask := #7F;
  141.       bios_data_ptr.s := #40;  {address data area for DOS}
  142.       bios_data_ptr.r := 0;
  143.  
  144.        begin
  145.       while (com_get(inch)) do begin
  146.          if flag = EXIT then begin
  147.         getc := -1;
  148.         return;
  149.         end;
  150.          if (bios_data_ptr^[#17] and BREAK_OUT) = BREAK_OUT then begin
  151.         getc := 0;       {return NULL on a forced break out}
  152.         return;
  153.         end;
  154.          end;
  155.       getc := ord(inch) and parity_mask;
  156.                    {If we are stripping DELs, then also drop the
  157.                       next character}
  158.       if ignore_dels then BEGIN
  159.          while result(getc) = #7F do begin
  160.         eval(getc(HANG));
  161.         getc := getc(flag);
  162.         err_flag := 0;       {ignore this error}
  163.         end   END;
  164.       if not silent_mode and (err_flag<> 0) then begin
  165.          if (err_flag and 2#100)<>0 then xttywrt('Recv Buf Ovrflw',240);
  166.          if (err_flag and 2#1000)<>0 then
  167.           xttywrt('Stray THRE interrupt!',240);
  168.          if (err_flag and 2#10000)<>0 then
  169.           xttywrt('Char not XMITTED',240);
  170.          if ((err_flag and 2#10)<> 0) and ((msr_value and 2#10)<>0) then
  171.           xttywrt('DSR Changed',240);
  172.          if (err_flag and 1)<>0 then begin
  173.         if (lsr_value and 2#10)<>0 then xttywrt('Data Overrun',240);
  174.         if (lsr_value and 2#100)<>0 then xttywrt('Parity Error',240);
  175.         if (lsr_value and 2#1000)<>0 then xttywrt('Framing Error',240);
  176.         end;
  177.          err_flag := 0;
  178.          end;
  179.       end;     end.
  180.