Program Putstr;
{$nomain}

{ 
  Version
  File:[22,310]PUTSTR.PAS
  Author: Jim Bostwick 1-Nov-83

  Last Edit: 23-JUN-1988 22:17:03 

  History: 
	 23-JUN-1988 21:57:34  - JMB PA3UTL upgrade.
         14-Dec-83 PTH -- correct "lin MOD 24"operation for line 24
	 15-Nov-83 JMB -- enable lin=0 --> no cursor positioning

}
{$Nolist}
{[a+,b+,l-,k+,r+] Pasmat }
 %INCLUDE 'PAS$EXT:General.typ';
 %INCLUDE 'PAS$EXT:VT100.TYP';
{$List }

Procedure Putstr(Lin,Col:Integer;
  		Atts:CRT_Attribute_set;
  		Buffer:Packed array [lo..hi:integer] of char
  	);external;

{*USER*
 Pascal-3 procedure to display a string on
a CRT at line Lin, column Col, with display attributes Attributes.
Note that the attribute set has changed from the Pascal-2 version.
If Save_cursor is in Atts, the cursor and CRT context are preserved across
the field write. If not, the context is established by the PUTFLD
parameters, and the cursor remains at the last character written.
The Standard attribute overrides all other character attributes.
Maximum input string length is about 80. bytes. The routine does not
detect overflow, and may fail with excessive string lengths.
Minimum input string length is 0 bytes. If Count=0, no text will be
output, but the cursor position, attributes, and save will be done.
 If lin is negative, the entire screen will be erased prior to writing
the field, which will appear at abs(lin). Column must be 00-132.
lin must be 00-24. (or -24 for auto erase).
 If Col is negative, an erase to end-of-line sequence is generated
at the end of the output, but before any restore sequence. The effect
is to erase the remainder of the line specified by Lin. 	
 NOTE: For the Cursor save/restore function to work, you must not
allow the screen to scroll, and must open ouput with the /ftn 
switch -- rewrite(output,'TI:/ftn');
At this point, the first character of any output string to the terminal
other than through Putstr will be interpreted as carriage control. 
   } 


Procedure Putstr;

Var
  buff: packed array [1..150] of char;
  i:integer; {buffer index}
  j,top:integer; {temp index }
  ereol:boolean;


{-------------- Put Numeric parameter to Buff ------------------------}

Procedure PN(n:integer);	{local}

{ will put out a numeric parameter with exactly the correct number of 
 characters }

Begin
  if n > 9 then PN(n div 10);
  buff[i] := chr(ord('0') + (N MOD 10));
  i := i+1
end;


{------------------- Put Escape sequence to Buff ----------------------}

Procedure ESeq(str:packed array [lo..hi:integer] of char);   { Local }

{ will append <esc> plus 'str' to buff. Only use type '1' strings. }

Var 
  j:integer;

BEGIN
  buff[i] := chr(33B);
  for j := lo to hi do buff[i + j] := str[j];
  i := i + hi + 1
END;


{--------------- Put two character escape seq in Buff ----------------}

Procedure Etwo(c:char);		{local}

BEGIN
  buff[i] := chr(33b);
  buff[i+1] := c;
  i := i+2
END;

{------------------- Append string to Buff ---------------------------}

Procedure APD(str:packed array [lo..hi:integer] of char);	{ local }

Var
    j:integer;

Begin
  for j := lo to hi do buff[i - 1 + j] := str[j];
  i := i + hi
END;

{------------------- Put one char to Buff ----------------------------}

Procedure ApdC(c:Char);		{ local }

Begin
  Buff[i] := c;
  i := i + 1
end;

{-------------------------- Putstr -----------------------------------}

BEGIN
  buff[1] := chr(0);
  i := 2;	{ initialize buff index }
  if save_cursor in Atts then ETwo('7');

  { process pre-erase and cursor position stuff }

  if col < 0 then 
    BEGIN        
    col := -col;
    ereol := true
    END
  else ereol := false;

  if lin <> 0 then  { lin = 0 --> no cursor positioning }
    BEGIN 
    if lin < 0 then 
      BEGIN 
      lin := -lin;
      ESeq('[2J')
      END;
    lin := lin MOD 24;
    if lin=0 then lin:= 24;  {we need to correct for line 24}
    Etwo('['); {start cursor postition sequence }
    PN(lin); { dump line number }
    Apdc(';');
    col := col MOD 132;
    pn(col);
    ApdC('H')
    END;

  { process attributes }
  if Standard in Atts then Eseq('[m')
    else if [bold, underline, blink, reverse] * atts <> [] then
    BEGIN 
    Etwo('[');	{ start of attribute sequence }
    if bold in atts then apd('1;');
    if underline in atts then apd('4;');
    if blink in atts then apd('5;');
    if reverse in atts then apd('7;');
    buff[i-1] := 'm' { overwrite last ';'}
    END;
  
  { process double high/wide stuff }
  if double_upper in atts then ESeq('#3')
    else if double_lower in atts then ESeq('#4');
  if double_wide in atts then ESeq('#6');
    
  { want a bell? }
  if ring_bell in atts then 
  ApdC(chr(7));

  { it is now time to copy the input to output buffer }
  if lo = 0 then top := ord(buffer[0]) else top := hi;
  for j := 1 to top do buff[i - 1 + j] := buffer[j];
  i := i + top;

  { finish up with ereol and/or cursor restore }
  if ereol then ESeq('[K');
  if save_cursor in atts then Etwo('8');
  
  { at long last, write it out }
  i := i-1; { get length }
  writeln(buff:i)
end;