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


PROGRAM installkeys;

MODULE keys; 

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

 PROCEDURE initkeys;
 
IMPLEMENT

 CONST
  default_isc = 9;
  
  VAR  eol_lying_around : PACKED ARRAY[type_isc] OF BOOLEAN;
       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;
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
  IF eol_lying_around[myisc] 
    THEN BEGIN 
      inchar := eol;
      eol_lying_around[myisc] := FALSE;
    END
    ELSE BEGIN
      WITH isc_table[myisc] DO 
      CALL (io_drv_ptr^.iod_rdb ,
             io_tmp_ptr ,
             x);
      inchar:=x;
    END;
END;

FUNCTION kbdbusy : BOOLEAN;
VAR     x       : INTEGER;
BEGIN
 WITH isc_table[myisc] DO
  BEGIN
   IF card_id = hp98628_async THEN
    BEGIN
     { check inbound queue for data }
     x:=iostatus(myisc,5);
     IF (x=1) OR (x=3) OR eol_lying_around[myisc] THEN
      kbdbusy:=FALSE
     ELSE
      kbdbusy:=TRUE;
    END;
   IF (card_id = hp98626) or (card_id = hp98644) THEN
    BEGIN
     x:=iostatus(myisc,10); { check character buffer for data } 
     IF bit_set(x,0) OR eol_lying_around[myisc] THEN
      kbdbusy:=FALSE 
     ELSE
      kbdbusy:=TRUE;
    END; 
  END; { WITH isc_table[myisc] DO }
END;


PROCEDURE remote_kbdio (       fp              : fibp; 
                        request         : amrequesttype; 
                        ANYVAR buffer   : window; 
                        length          : INTEGER ;
                        position        : INTEGER); 

VAR   buf               : charptr; 
BEGIN 
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := default_isc;
 ioresult := ORD(inoerror); 
 buf := ADDR(buffer); 
 CASE request OF 
  
   flush:       BEGIN
                  myinit;
                END;
   
   unitstatus:  BEGIN
                  fp^.fbusy := kbdbusy  ;
                END;
  
   clearunit:   BEGIN 
                  myinit;
                END; 
  
   readtoeol, 
   readbytes,
   startread:   BEGIN 
                  IF request = readtoeol 
                    THEN BEGIN 
                      { the buffer is a string, so set it to empty }
                      buf := ADDR(buf^, 1); 
                      buffer[0] := chr(0); 
                    END; 
                  WHILE length>0 DO BEGIN 
                    buf^ := inchar;
                    IF buf^ = chr(etx)
                      THEN length := 0 
                      ELSE length := length-1; 
                    IF (buf^=eol) and (request=readtoeol) 
                      THEN BEGIN
                        eol_lying_around[myisc] := TRUE;
                        length := 0
                      END
                      ELSE BEGIN 
                        fp^.feoln := FALSE; 
                        buf := ADDR(buf^, 1); 
                        IF request = readtoeol 
                          THEN buffer[0] := CHR(ORD(buffer[0])+1);
                      END;
                  END; { of WHILE DO } 
                  IF request = startread THEN CALL(fp^.feot, fp); 
                END; 
  
   OTHERWISE    BEGIN
                  ioresult := ORD(ibadrequest); 
                END;
 
 END; { of CASE }
END; { of PROCEDURE }

PROCEDURE dummyreq(cmd : byte; VAR value : byte);
BEGIN END;

PROCEDURE dummykbd(VAR statbyte, databyte : byte;
                   VAR doit : BOOLEAN);
BEGIN END;
                   
PROCEDURE dummyproc;
BEGIN END;

PROCEDURE dummyboolproc(b : BOOLEAN);
BEGIN END;

PROCEDURE initkeys; 
VAR localisc  : shortint;
BEGIN 
  kbdiohook       := remote_kbdio;
  kbdreqhook      := dummyreq;
  kbdisrhook      := dummykbd;
  kbdpollhook     := dummyboolproc;
  kbdwaithook     := dummyproc;
  kbdreleasehook  := dummyproc;
  kbdtype         := specialkbd1;
  kbdlang         := ns1_kbd;
  sysmenu         := NIL;
  sysmenushift    := NIL;
  menustate       := m_none;
  FOR localisc := 0 TO 31 DO
   eol_lying_around[localisc] := FALSE;
END;

END;    { of module keys }


IMPORT keys,loader;

BEGIN
  initkeys;
  markuser;
END.


