$SYSPROG ON$ 
$heap_dispose off$ 
$iocheck off$ 
$range off$ 
$ovflcheck off$ 
$debug off$
$STACKCHECK OFF$ 

PROGRAM installcrt;

MODULE crt; 

IMPORT sysdevs,sysglobals,asm,misc,iodeclarations,general_0 ; 

EXPORT 
    
  PROCEDURE crtinit; 

IMPLEMENT
 
 
CONST dc1           = 17 ;
      default_isc   = 9;
      
      term_environ=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: 0,
                                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]];

  
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;
      screenwidth       : shortint;
      screenheight      : shortint;
      maxx,maxy         : shortint;
       
{ 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;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async 
    THEN iocontrol(myisc,28,0);               { no EOL characters }
  iocontrol(myisc,12,1);                      { connect the card  }
  
  newdrivers := isc_table[myisc].io_drv_ptr^; { copy card dvrs    }
  newdrivers.iod_init := new_reset;           { put in new reset  }
  isc_table[myisc].io_drv_ptr := ADDR(newdrivers); { install drvs }
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 dummyupdatecursor; 
BEGIN 
END; 

PROCEDURE dummydbcrt(op : dbcrtops; VAR dbcrt : dbcinfo);
BEGIN 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 abse   }
  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; 

PROCEDURE setxy(x, y: shortint); 
VAR s : string[9];
    p : INTEGER;
BEGIN 
  IF x>=screenwidth  THEN xpos:=maxx 
                     ELSE IF x<0 THEN xpos:=0
                                 ELSE xpos := x; 
  IF y>=screenheight THEN ypos:=maxy 
                     ELSE IF y<0 THEN ypos:=0 
                                 ELSE ypos := y; 
  
  { 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; 

PROCEDURE gotoxy(x,y: INTEGER); 
BEGIN
  setxy(x,y); 
  call(updatecursorhook); 
END; 

PROCEDURE remote_crtio (     fp              : fibp; 
                      request         : amrequesttype; 
                      ANYVAR buffer   : window; 
                      length          : INTEGER;
                      position        : INTEGER); 
VAR c   : CHAR; 
    s   : STRING[1];
    buf : charptr; 
    d,e : INTEGER;
BEGIN 
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := default_isc;
 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:     BEGIN 
                  IF ypos=maxy 
                    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:BEGIN
                                  getxy(d,e);
                                  IF (xpos = maxx) and (ypos<maxy) 
                                    THEN setxy(0, ypos+1) 
                                    ELSE setxy(xpos+1, ypos); 
                                END;
                                
                      upchar:   BEGIN 
                                  IF (ypos<=1) 
                                    THEN BEGIN
                                      output(CHR(esc) + 'L' + chr(esc) +
                                            '&a0y0C' + chr(esc) + 'K' );
                                      setxy(xpos, ypos);
                                    END;
                                  IF (ypos>0)  
                                    THEN BEGIN
                                      { out(CHR(esc));
                                      out('A'); }
                                      setxy(xpos,ypos-1); 
                                    END;
                                END;
          
                      downchar: BEGIN
                                  IF (ypos=maxy) 
                                    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 BEGIN
                                  out(c);  
                                  IF xpos = maxx
                                    THEN BEGIN
                                      IF ypos = maxy 
                                        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 }
                    call(updatecursorhook); 
                  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;  { of PROCEDURE crtio }

PROCEDURE dummyproc;
BEGIN
  { nothing }
END;

PROCEDURE crtinit; 
 BEGIN 
   syscom^ := term_environ;
   WITH syscom^.crtinfo DO BEGIN 
     screenwidth:=width;
     screenheight:=height;
     maxx       :=width-1;
     maxy       :=height-1;
     xpos       := 0;
     ypos       := 0;
     crtiohook        := remote_crtio;
     dumpalphahook    := dummyproc;
     dumpgraphicshook := dummyproc;
     togglealphahook  := dummyproc;
     togglegraphicshook := dummyproc;
     updatecursorhook := dummyupdatecursor;
     crtinithook      := crtinit;
     crtllhook        := dummycrtll;
     dbcrthook        := dummydbcrt;
     currentcrt       := specialcrt1;
     bitmapaddr       := 0;
     frameaddr        := 0;
     keybuffer^.echo  := FALSE;
     alphastate       := TRUE;
     graphicstate     := FALSE;
   END; { of WITH DO BEGIN }
 END;   { of PROCEDURE crtinit } 
 
END;   { of MODULE crt }

IMPORT crt,loader;

BEGIN
  crtinit;
  markuser;
END.


