head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.40.22;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.15.18;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.10.00.12;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.35.03;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.35.37;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.34.50;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.20.56;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.19.30;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.33.22;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.17.05;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.23.37;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.09.49;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.56.48;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.04.57;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.22.51;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.14.49;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.58.51;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.40.40;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.12.01.50;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.46.44;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.39.13;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.52.44;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.30.08;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.47.40;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.21.51;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.52.21;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.12.02.43;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.23.29;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.14.00.13;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.44.46;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.10.23;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.54.16;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.14.18.12;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.50.41;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.25.36;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.11.16.07;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.52.10;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.37.00;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.48.17;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.09.04.55;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.16.07.11;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.11.09.54;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.19.36;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.10.02.43;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.16.14.55;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.19.02.07;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.56.56;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.23.06;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.39.11;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.25.00;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.32.00;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.49.26;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.38.44;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.28.00;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.20.21.38;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.50.04;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.21.00;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.17.27.42;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@					       (*

 (c) Copyright Hewlett-Packard Company, 1984.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

(* REMOTE CONSOLE MODIFICATION - 26/JAN/84 *)

$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'FINDC','BLIBS:IO.'$

program rcinitcrt;

module rccrt;
import sysglobals, asm, misc, sysdevs, iodeclarations, general_0, FINDC;
export
  procedure rccrtinit;

implement

CONST dc1           = 17 ;                   {control-S}
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;

{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset( mytemp : ANYPTR );
BEGIN
  { do nothing so that the configuration stays the same }
END;


PROCEDURE myinit;

{This procedure was modified by Anny Randel to do DC1/DC3 handshaking. 9-21-83}

VAR status_reg:                  {variant record to change upper two bits only}
	record case integer of
	  0:      (whole:
		     packed record
			     byte: 0..255;             {gets inital status}
			    end);
	  1:      (part:
		     packed record
			     upper_two_bits: 0..3;       {gets new bits}
			    end);
	end;

BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
	iocontrol(myisc,28,0);                         { no EOL characters }
	iocontrol(myisc,22,3);                         { use DC1/DC3 hndshk }
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
	status_reg.whole.byte := iostatus(myisc,4); {read status reg 4}
	status_reg.part.upper_two_bits := 1;        {change upper two bits}
	iocontrol(myisc,4,status_reg.whole.byte);   {use DC1/DC3 hndshk}
     END;
  iocontrol(myisc,12,1);                               { connect the card }
  newdrivers := isc_table[myisc].io_drv_ptr^;          { copy 628 card dvrs }
  newdrivers.iod_init := new_reset;                    { put in new reset   }
  isc_table[myisc].io_drv_ptr := ADDR( newdrivers );   { install drivers    }
END;


FUNCTION inchar : CHAR;
VAR  x          : CHAR;
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_rdb ,
	 io_tmp_ptr ,
	 x );
  inchar:=x;
END;

PROCEDURE out(x:CHAR);
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_wtb ,
	 io_tmp_ptr ,
	 x );
END;


PROCEDURE output(s    :io_STRING);
VAR i:INTEGER;
BEGIN
  FOR i:=1 to STRLEN(s) DO out(s[i]);
END;


PROCEDURE localbeep;
BEGIN
   out(CHR(7));        { send beep to card }
END;


procedure getxy(var x,y: integer);
VAR dummy : CHAR;
begin
  x:=0;  y:=0;
  { go thru sequence to get actual position }
  out(CHR(esc));        out('`');       { send cursor sense absolute }
  out(CHR(dc1));                        { tell terminal I am ready }
  dummy := inchar;                      { get esc }
  dummy := inchar;                      { get &   }
  dummy := inchar;                      { get '   }
  x     := ORD(inchar)-48;              { get column digit 1 }
  x     := ORD(inchar)-48+x*10;         { get column digit 2 }
  x     := ORD(inchar)-48+x*10;         { get column digit 3 }
  dummy := inchar;                      { get c   }
  y     := ORD(inchar)-48;              { get row    digit 1 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 2 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 3 }
  dummy := inchar;                      { get Y   }
  dummy := inchar;                      { get cr  }

  xpos := x;      ypos := y;
end;    { getxy }

procedure setxy(x, y: shortint);
VAR s : string[9];
    p : INTEGER;
begin
  with syscom^.crtinfo do
  begin
    IF x>=width THEN xpos:=width-1
		ELSE IF x<0 THEN xpos:=0
			    ELSE xpos := x;
    IF y>=height THEN ypos:=height-1
		 ELSE IF y<0 THEN ypos:=0
			     ELSE ypos := y;
  end;
  { send xpos/ypos via escape esc & a xx y yy C }
  SETSTRLEN(s,9);
  STRWRITE (s,1,p,CHR(esc),'&a',ypos:2,'y',xpos:2,'C');
  output   (s);
end;    { setxy }

procedure gotoxy(x,y: integer);
begin
  setxy(x,y);
end;

procedure rccrtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);

var c: char;
    s: string[1];
    buf: charptr;
    d,e : INTEGER;
begin
  myisc := unitable^[fp^.funit].sc;
  IF (myisc>=0) AND (myisc<=7)
  THEN BEGIN
    { 0 is default and 1..7 are not allowed }
    myisc := console_isc;
  END
  ELSE
  BEGIN
    { -isc and isc>7 allows a CTABLE entry
       to override all of this garbage }
    IF myisc < 0  THEN myisc := -myisc;
    IF myisc > 31 THEN myisc := myisc MOD 32;
  END;
  ioresult := ORD(inoerror);
  buf := addr(buffer);
  CASE request OF

    setcursor:    BEGIN
		    gotoxy(fp^.fxpos, fp^.fypos);
		  END;

    getcursor:    BEGIN
		    getxy (fp^.fxpos, fp^.fypos);
		  END;

    flush:        BEGIN
		    myinit;
		  END;

    unitstatus:   BEGIN
		     kbdio(fp, unitstatus,buffer,length,position);
		  END;

    clearunit:    BEGIN
		    myinit;
		  END;

    readtoeol:    BEGIN
		    buf := addr(buf^, 1);
		    buffer[0] := CHR(0);
		    WHILE length>0 DO BEGIN
		      kbdio(fp, readtoeol,  s, 1, 0);
		      IF  STRLEN(s)=0
			THEN BEGIN
			  length := 0
			END
			ELSE BEGIN
			  length := length - 1;
			  crtio(fp, writebytes, s[1], 1, 0);
			  buf := addr(buf^, 1);
			  buffer[0] := CHR(ORD(buffer[0])+1);
			END; { of IF }
		    END;     { of WHILE DO BEGIN }
		  END;       { of BEGIN }

    startread,
    readbytes:    BEGIN
		    while length>0 DO
		      BEGIN
		      kbdio(fp, readbytes,  buf^, 1, 0);
		      IF buf^ = CHR(etx) THEN length := 0
					 ELSE length := length - 1;
		      IF buf^ = eol THEN crtio(fp, writeeol,   buf^, 1, 0)
				    ELSE crtio(fp, writebytes, buf^, 1, 0);
		      buf := addr(buf^, 1);
		      END;
		    IF request = startread THEN call(fp^.feot, fp);
		    END;

    writeeol:     with syscom^.crtinfo do
		  BEGIN
		    IF ypos=height-1 THEN BEGIN out(CHR(esc));
					  out('S');   { scroll up 1 line }
				     END;
		    gotoxy(0, ypos+1);
		  END;

    startwrite,
    writebytes:   BEGIN
		    WHILE length>0 DO BEGIN
		      c:=buf^; buf:=addr(buf^,1); length:=length-1;
		      CASE c OF

			homechar: BEGIN
				    setxy(0,0);
				  END;

			leftchar: BEGIN
				    out(CHR(bs));
				  END;

			rightchar: with syscom^.crtinfo do
				  BEGIN
				    getxy(d,e);
				    IF (xpos = width-1) THEN
				    BEGIN
				     XPOS:=0; YPOS:=YPOS+1;
				     if ypos>=height then
				     begin
					out(CHR(esc));
					out('S');      { scroll up 1 line }
				     end;
				    END
				    ELSE XPOS:=XPOS+1;
				    setxy(xpos, ypos);
				  END;

			upchar:   BEGIN
				    IF (ypos<=1)
				      THEN BEGIN
					out(CHR(esc));
					out('L');      { insert line }
				      END;
				    IF (ypos>0)
				      THEN BEGIN
					{ out(CHR(esc));
					out('A'); }
					setxy(xpos,ypos-1);
				      END;
				  END;

			downchar: with syscom^.crtinfo do
				 BEGIN
				    IF (ypos=height-1)
				      THEN BEGIN
					out(CHR(esc));
					out('S');      { scroll up 1 line }
				      END
				      ELSE BEGIN
					{ out(CHR(esc));
					out('B'); }
					setxy(xpos,ypos+1);
				      END;
				  END;

			bellchar: BEGIN
				    localbeep;
				  END;

			cteos:   BEGIN
				   out(CHR(esc));
				   out('J');
				 END;

			cteol:   BEGIN
				   out(CHR(esc));
				   out('K');
				 END;

			clearscr:BEGIN
				   setxy(0,0);
				   out(CHR(esc));
				   out('J');
				 END;

			eol:      BEGIN
				    out(CHR(cr));
				    out(CHR(lf));
				  END;

			CHR(etx): BEGIN
				    length:=0;
				  END;

			OTHERWISE with syscom^.crtinfo do
				  BEGIN
				    out(c);
				    IF xpos = width-1
				      THEN BEGIN
					IF ypos = height-1
					  THEN BEGIN
					    out(CHR(esc));
					    out('S');   { scroll up 1 line }
					  END;
					setxy(0,ypos+1);
				      END
				      ELSE BEGIN
					{ setxy(xpos+1,ypos); }
					xpos := xpos + 1;
				      END; { of IF }
				  END;

		      END; { of CASE c OF }
		    END; { of WHILE DO BEGIN }
		    IF request = startwrite THEN call(fp^.feot, fp);
		  END; { of startwrite, writebytes case }

    OTHERWISE     BEGIN
		    ioresult := ORD(ibadrequest);
		  END;

  END; { of CASE request OF }
end;

procedure rccrtinit;
const
  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:false,  {?}
				    hasclock:true,
				    canupscroll:true,
				    candownscroll:true],
		   crttype:0,
		   crtctrl:crtcrec[
				    rlf:chr(31),
				    ndfs:chr(28),
				    eraseeol:chr(9),
				    eraseeos:chr(11),
				    home:chr(1),
				    escape:chr(0),
				    backspace:chr(8),
				    fillcount:10,
				    clearscreen:chr(0),
				    clearline:chr(0),
				    prefixed:b9[9 of false]],
		   crtinfo:crtirec[
				    width :80,height:24,
				    crtmemaddr:0,
				    crtcontroladdr:0,
				    keybufferaddr:0,
				    progstateinfoaddr: 0,
				    keybuffersize: 72,
				    crtcon: crtconsttype [0,0,0,0,0,0,
							  0,0,0,0,0,0],
				    right{FS}:chr(28),
				    left{BS}:chr(8),
				    down{LF}:chr(10),    up{US}:chr(31),
				    badch{?}:chr(63),
				    chardel{BS}:chr(8),stop{DC3} :chr(19),
				    break{DLE}:chr(16),
				    flush{ACK}:chr(6),  eof{ETX}:chr(3),
				    altmode{ESC}:chr(27),
				    linedel{DEL}:chr(127),
				    backspace{BS}:chr(8),
				    etx:chr(3),prefix:chr(0),
				    prefixed:b14[14 of false],
				    cursormask : 0,     spare : 0]];
	{ end of environc }
begin   { rccrtinit }
  syscom^:=environc;
  keybuffer^.maxsize:=syscom^.crtinfo.keybuffersize;
  currentcrt := specialcrt1;
  crtiohook  := rccrtio;
  xpos       := 0;
  ypos       := 0;
  ALPHASTATE := TRUE;
  GRAPHICSTATE := FALSE;
end;    { rccrtinit }
END;

{  install the remote console crt }
import rccrt, loader, findc;
begin
  if internal_console then
  begin
    rccrtinit;
    markuser;
  end;
end.


@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 439
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 439
					       (*

 (c) Copyright Hewlett-Packard Company, 1984.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)

(* REMOTE CONSOLE MODIFICATION - 26/JAN/84 *)

$modcal$
$heap_dispose off$
$iocheck off$
$range off$ $ovflcheck off$
$debug off$
$stackcheck off$
$search  'FINDC','BLIBS:IO.'$

program rcinitcrt;

module rccrt;
import sysglobals, asm, misc, sysdevs, iodeclarations, general_0, FINDC;
export
  procedure rccrtinit;

implement

CONST dc1           = 17 ;                   {control-S}
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;

{ note that you should not use the 'console'
  select code for anything else }


PROCEDURE new_reset( mytemp : ANYPTR );
BEGIN
  { do nothing so that the configuration stays the same }
END;


PROCEDURE myinit;

{This procedure was modified by Anny Randel to do DC1/DC3 handshaking. 9-21-83}

VAR status_reg:                  {variant record to change upper two bits only}
	record case integer of
	  0:      (whole:
		     packed record
			     byte: 0..255;             {gets inital status}
			    end);
	  1:      (part:
		     packed record
			     upper_two_bits: 0..3;       {gets new bits}
			    end);
	end;

BEGIN
  IF isc_table[myisc].card_id = hp98628_async
    THEN BEGIN
	iocontrol(myisc,28,0);                         { no EOL characters }
	iocontrol(myisc,22,3);                         { use DC1/DC3 hndshk }
    END;
  IF isc_table[myisc].card_id = hp98626
    THEN BEGIN
	status_reg.whole.byte := iostatus(myisc,4); {read status reg 4}
	status_reg.part.upper_two_bits := 1;        {change upper two bits}
	iocontrol(myisc,4,status_reg.whole.byte);   {use DC1/DC3 hndshk}
     END;
  iocontrol(myisc,12,1);                               { connect the card }
  newdrivers := isc_table[myisc].io_drv_ptr^;          { copy 628 card dvrs }
  newdrivers.iod_init := new_reset;                    { put in new reset   }
  isc_table[myisc].io_drv_ptr := ADDR( newdrivers );   { install drivers    }
END;


FUNCTION inchar : CHAR;
VAR  x          : CHAR;
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_rdb ,
	 io_tmp_ptr ,
	 x );
  inchar:=x;
END;

PROCEDURE out(x:CHAR);
BEGIN
  WITH isc_table[myisc] DO
  CALL ( io_drv_ptr^.iod_wtb ,
	 io_tmp_ptr ,
	 x );
END;


PROCEDURE output(s    :io_STRING);
VAR i:INTEGER;
BEGIN
  FOR i:=1 to STRLEN(s) DO out(s[i]);
END;


PROCEDURE localbeep;
BEGIN
   out(CHR(7));        { send beep to card }
END;


procedure getxy(var x,y: integer);
VAR dummy : CHAR;
begin
  x:=0;  y:=0;
  { go thru sequence to get actual position }
  out(CHR(esc));        out('`');       { send cursor sense absolute }
  out(CHR(dc1));                        { tell terminal I am ready }
  dummy := inchar;                      { get esc }
  dummy := inchar;                      { get &   }
  dummy := inchar;                      { get '   }
  x     := ORD(inchar)-48;              { get column digit 1 }
  x     := ORD(inchar)-48+x*10;         { get column digit 2 }
  x     := ORD(inchar)-48+x*10;         { get column digit 3 }
  dummy := inchar;                      { get c   }
  y     := ORD(inchar)-48;              { get row    digit 1 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 2 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 3 }
  dummy := inchar;                      { get Y   }
  dummy := inchar;                      { get cr  }

  xpos := x;      ypos := y;
end;    { getxy }

procedure setxy(x, y: shortint);
VAR s : string[9];
    p : INTEGER;
begin
  with syscom^.crtinfo do
  begin
    IF x>=width THEN xpos:=width-1
		ELSE IF x<0 THEN xpos:=0
			    ELSE xpos := x;
    IF y>=height THEN ypos:=height-1
		 ELSE IF y<0 THEN ypos:=0
			     ELSE ypos := y;
  end;
  { send xpos/ypos via escape esc & a xx y yy C }
  SETSTRLEN(s,9);
  STRWRITE (s,1,p,CHR(esc),'&a',ypos:2,'y',xpos:2,'C');
  output   (s);
end;    { setxy }

procedure gotoxy(x,y: integer);
begin
  setxy(x,y);
end;

procedure rccrtio(fp: fibp; request: amrequesttype; anyvar buffer: window;
						   length, position: integer);

var c: char;
    s: string[1];
    buf: charptr;
    d,e : INTEGER;
begin
  myisc := unitable^[fp^.funit].sc;
  IF (myisc>=0) AND (myisc<=7)
  THEN BEGIN
    { 0 is default and 1..7 are not allowed }
    myisc := console_isc;
  END
  ELSE
  BEGIN
    { -isc and isc>7 allows a CTABLE entry
       to override all of this garbage }
    IF myisc < 0  THEN myisc := -myisc;
    IF myisc > 31 THEN myisc := myisc MOD 32;
  END;
  ioresult := ORD(inoerror);
  buf := addr(buffer);
  CASE request OF

    setcursor:    BEGIN
		    gotoxy(fp^.fxpos, fp^.fypos);
		  END;

    getcursor:    BEGIN
		    getxy (fp^.fxpos, fp^.fypos);
		  END;

    flush:        BEGIN
		    myinit;
		  END;

    unitstatus:   BEGIN
		     kbdio(fp, unitstatus,buffer,length,position);
		  END;

    clearunit:    BEGIN
		    myinit;
		  END;

    readtoeol:    BEGIN
		    buf := addr(buf^, 1);
		    buffer[0] := CHR(0);
		    WHILE length>0 DO BEGIN
		      kbdio(fp, readtoeol,  s, 1, 0);
		      IF  STRLEN(s)=0
			THEN BEGIN
			  length := 0
			END
			ELSE BEGIN
			  length := length - 1;
			  crtio(fp, writebytes, s[1], 1, 0);
			  buf := addr(buf^, 1);
			  buffer[0] := CHR(ORD(buffer[0])+1);
			END; { of IF }
		    END;     { of WHILE DO BEGIN }
		  END;       { of BEGIN }

    startread,
    readbytes:    BEGIN
		    while length>0 DO
		      BEGIN
		      kbdio(fp, readbytes,  buf^, 1, 0);
		      IF buf^ = CHR(etx) THEN length := 0
					 ELSE length := length - 1;
		      IF buf^ = eol THEN crtio(fp, writeeol,   buf^, 1, 0)
				    ELSE crtio(fp, writebytes, buf^, 1, 0);
		      buf := addr(buf^, 1);
		      END;
		    IF request = startread THEN call(fp^.feot, fp);
		    END;

    writeeol:     with syscom^.crtinfo do
		  BEGIN
		    IF ypos=height-1 THEN BEGIN out(CHR(esc));
					  out('S');   { scroll up 1 line }
				     END;
		    gotoxy(0, ypos+1);
		  END;

    startwrite,
    writebytes:   BEGIN
		    WHILE length>0 DO BEGIN
		      c:=buf^; buf:=addr(buf^,1); length:=length-1;
		      CASE c OF

			homechar: BEGIN
				    setxy(0,0);
				  END;

			leftchar: BEGIN
				    out(CHR(bs));
				  END;

			rightchar: with syscom^.crtinfo do
				  BEGIN
				    getxy(d,e);
				    IF (xpos = width-1) THEN
				    BEGIN
				     XPOS:=0; YPOS:=YPOS+1;
				     if ypos>=height then
				     begin
					out(CHR(esc));
					out('S');      { scroll up 1 line }
				     end;
				    END
				    ELSE XPOS:=XPOS+1;
				    setxy(xpos, ypos);
				  END;

			upchar:   BEGIN
				    IF (ypos<=1)
				      THEN BEGIN
					out(CHR(esc));
					out('L');      { insert line }
				      END;
				    IF (ypos>0)
				      THEN BEGIN
					{ out(CHR(esc));
					out('A'); }
					setxy(xpos,ypos-1);
				      END;
				  END;

			downchar: with syscom^.crtinfo do
				 BEGIN
				    IF (ypos=height-1)
				      THEN BEGIN
					out(CHR(esc));
					out('S');      { scroll up 1 line }
				      END
				      ELSE BEGIN
					{ out(CHR(esc));
					out('B'); }
					setxy(xpos,ypos+1);
				      END;
				  END;

			bellchar: BEGIN
				    localbeep;
				  END;

			cteos:   BEGIN
				   out(CHR(esc));
				   out('J');
				 END;

			cteol:   BEGIN
				   out(CHR(esc));
				   out('K');
				 END;

			clearscr:BEGIN
				   setxy(0,0);
				   out(CHR(esc));
				   out('J');
				 END;

			eol:      BEGIN
				    out(CHR(cr));
				    out(CHR(lf));
				  END;

			CHR(etx): BEGIN
				    length:=0;
				  END;

			OTHERWISE with syscom^.crtinfo do
				  BEGIN
				    out(c);
				    IF xpos = width-1
				      THEN BEGIN
					IF ypos = height-1
					  THEN BEGIN
					    out(CHR(esc));
					    out('S');   { scroll up 1 line }
					  END;
					setxy(0,ypos+1);
				      END
				      ELSE BEGIN
					{ setxy(xpos+1,ypos); }
					xpos := xpos + 1;
				      END; { of IF }
				  END;

		      END; { of CASE c OF }
		    END; { of WHILE DO BEGIN }
		    IF request = startwrite THEN call(fp^.feot, fp);
		  END; { of startwrite, writebytes case }

    OTHERWISE     BEGIN
		    ioresult := ORD(ibadrequest);
		  END;

  END; { of CASE request OF }
end;

procedure rccrtinit;
const
  environc=environ[miscinfo:crtfrec[
				    nobreak:false,
				    stupid :false,
				    slowterm:false,
				    hasxycrt:true,
				    haslccrt:false,  {?}
				    hasclock:true,
				    canupscroll:true,
				    candownscroll:true],
		   crttype:0,
		   crtctrl:crtcrec[
				    rlf:chr(31),
				    ndfs:chr(28),
				    eraseeol:chr(9),
				    eraseeos:chr(11),
				    home:chr(1),
				    escape:chr(0),
				    backspace:chr(8),
				    fillcount:10,
				    clearscreen:chr(0),
				    clearline:chr(0),
				    prefixed:b9[9 of false]],
		   crtinfo:crtirec[
				    width :80,height:24,
				    crtmemaddr:0,
				    crtcontroladdr:0,
				    keybufferaddr:0,
				    progstateinfoaddr: 0,
				    keybuffersize: 72,
				    crtcon: crtconsttype [0,0,0,0,0,0,
							  0,0,0,0,0,0],
				    right{FS}:chr(28),
				    left{BS}:chr(8),
				    down{LF}:chr(10),    up{US}:chr(31),
				    badch{?}:chr(63),
				    chardel{BS}:chr(8),stop{DC3} :chr(19),
				    break{DLE}:chr(16),
				    flush{ACK}:chr(6),  eof{ETX}:chr(3),
				    altmode{ESC}:chr(27),
				    linedel{DEL}:chr(127),
				    backspace{BS}:chr(8),
				    etx:chr(3),prefix:chr(0),
				    prefixed:b14[14 of false],
				    cursormask : 0,     spare : 0]];
	{ end of environc }
begin   { rccrtinit }
  syscom^:=environc;
  keybuffer^.maxsize:=syscom^.crtinfo.keybuffersize;
  currentcrt := specialcrt1;
  crtiohook  := rccrtio;
  xpos       := 0;
  ypos       := 0;
  ALPHASTATE := TRUE;
  GRAPHICSTATE := FALSE;
end;    { rccrtinit }
END;

{  install the remote console crt }
import rccrt, loader, findc;
begin
  if internal_console then
  begin
    rccrtinit;
    markuser;
  end;
end.


@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Auto bump revision for PAWS 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
