segment ISO6429emulator;
 
 const
    maxparm   = 4;
    errorchar = 168;
    maxleadin = 5;
 
    exitcode  = 128;
    upcode    = 129;
    downcode  = 130;
    rightcode = 131;
    leftcode  = 132; 
    
    {$I ISO.CST  }
    {$I SOFT.CST }
    {$I SSMP.CST }
 
 type
    {$I ISO.TYP }
    {$I HARDWARE.TYP }
    {$I SOFT.TYP }
    {$I SSMP.TYP }
 
    ISOtype  = (VBASE, VLEADIN, VCONTROL, VMODE, VEXEC, VSCS);
    partype    = 1..maxparm;
    digit = 0..9;
    leadintype = 1..maxleadin;
 
 var
    junk : boolean;
    ISOstate    : ISOtype;     { used by ISOfsm and ISO6429 } 
    termtype    : ZEUStype;
    leadin      : array [leadintype] of character;
    leadinptr   : leadintype;
    par         : partype;
    parm        : array [partype] of integer;
    hadparm     : boolean;
    n           : integer;
    top, bottom : rowtype;
    mode        : digit;
    escaped     : boolean;
    saverow, 
    savecol     : byte;
    savegr      : highlight; 
 
 
 { EXTERNAL procedure definitions }
 
 {$I DRIVERS.EXT  }
 {$I SOFT2.EXT }
 {$I SSMP.EXT   } 
 
 procedure reset;   {FAWN}
 begin              {FAWN}
 end;               {FAWN}
 
 procedure resetparms;
 var i : partype;
 begin 
    for i := 1 to maxparm do parm[i] := 1;
    par := 1;
    hadparm := false;
    n := 0
 end;
 
 
 procedure default(p1, p2: integer);
 var i : partype;
 begin
    if not hadparm then
    begin
       parm[1] := p1;
       parm[2] := p2
    end 
 end;
 
 
 procedure logparm;
 begin
    if (n > 255) then n := 255;
    parm[par] := n;
    n := 0;
    par := par + 1 
 end;
 
 
 procedure nexttab;
 begin
 end;
 
 
 function max(a, b : integer) : integer;
 begin
    if (a > b) then max := a else max := b
 end;
 
 
 function min(a, b : integer) : integer;
 begin
    if (a > b) then min := b else min := a
 end;
  
 
 procedure answerback;
 begin
 end;
 
 
 procedure selectg(n : integer);
 begin
 end;
 
 
 procedure setmode;
 begin
 end;
 
 
 procedure resetmode;
 begin
 end;
 
 
 procedure TX(c : character);
 begin
    repeat until ZLRDY;
    ZLPUT(c)
 end;
 
 
 procedure TXC(c : character);
 begin
    TX(ESC); TX(LBRACK); TX(c)  
 end; 
 
 
 { ISOfsm -- finite state machine emulation of a ISO6429 Terminal }
 procedure ISOfsm(c : character); 
 var { NB uses global ISOstate }
     junk   : boolean;
     row, oldrow : rowtype;
     col, oldcol : coltype;
 begin
    case ISOstate of
       VBASE : 
       begin
          if (c >= BLANK) and (c < DEL) then ZSPUT(c)   else
          if (c = ESC)    then ISOstate := VLEADIN      else
          if (c = CTRLE)  then answerback               else
          if (c = CTRLG)  then ZSBELL                   else
          if (c = CTRLH) and (ZSCOL > 0)
                          then ZSGOXY(ZSCOL-1,ZSROW)    else
          if (c = CTRLI)  then nexttab                  else
          if (c = CTRLJ) or (c = CTRLK) or (c = CTRLL)  then 
          begin
             if (ZSROW < bottom) then ZSGOXY(ZSCOL,ZSROW+1) else      {2.0D}
             begin                                                    {2.0D}
                ZSWIN(0,maxcol,top,bottom);
                ZSUPSC(1);
                ZSWIN(0,maxcol,0,maxrow)
             end
          end else
          if (c = CTRLM)  then ZSGOXY(0,ZSROW)          else
          if (c = CTRLN)  then selectg(1)               else
          if (c = CTRLO)  then selectg(0)               
          { otherwise character is ignored }
       end;
                      
       VLEADIN : 
       if (c = LBRACK) then ISOstate := VCONTROL             else
       if (c = LPAREN) or (c = RPAREN) then ISOstate := VSCS else   {2.0D} 
       if (c = CTRLK)  then oldterminal(termtype)            else
       begin
          if (c = DIG7) then 
          begin                          { Savecursor     }
             saverow := ZSROW;
             savecol := ZSCOL;
             savegr  := ZSGSET 
          end else
          if (c = DIG8) then 
          begin                          { Restore cursor }
             ZSGOXY(savecol,saverow);
             junk := ZSSETG(savegr) 
          end else 
          if (c = LESS) then { DECINLM }                else
          if (c = EQUALS) then { DECKPAM }              else
          if (c = GREATER) then { reset-numeric mode }  else 
          if (c = CAPD) then
          begin
             if (ZSROW < bottom) then ZSGOXY(ZSCOL,ZSROW+1) else
             begin
                ZSWIN(0,maxcol,top,bottom);
                ZSUPSC(1);
                ZSWIN(0,maxcol,0,maxrow)
             end
          end else
          if (c = CAPE) then
          begin
             if (ZSROW < bottom) then ZSGOXY(0,ZSROW+1) else
             begin
                ZSWIN(0,maxcol,top,bottom);
                ZSUPSC(1);
                ZSWIN(0,maxcol,0,maxrow)
             end
          end else
          if (c = CAPM) then
          begin
             if (ZSROW > top) then ZSGOXY(ZSCOL,ZSROW-1) else
             begin
                ZSWIN(0,maxcol,top,bottom);
                ZSDNSC(1);
                ZSWIN(0,maxcol,0,maxrow)
             end
          end;
 
          { Command processed or not recognised ... return to base mode }
          ISOstate := VBASE     
       end; 
 
       VCONTROL :
       if (c = SEMICOL)  then logparm                   else
       if (c = QUESTION) then ISOstate := VMODE       else
       if (c >= DIG0) and (c <= DIG9) then 
       begin
          hadparm := true;
          n := 10*n + (c - DIG0) 
       end else
       begin
          logparm;
 
          if (c = CAPD) then 
          begin 
             default(1,1); 
             ZSGOXY(max(0,ZSCOL-parm[1]),ZSROW) 
          end else
 
          if (c = CAPB) then 
          begin
             default(1,1);
             ZSGOXY(ZSCOL,min(bottom,ZSROW+parm[1]))   {2.0D}
          end else
 
          if (c = CAPC) then 
          begin
             default(1,1);
             ZSGOXY(min(maxcol,ZSCOL+parm[1]),ZSROW) 
          end else
 
          if (c = CAPH) or (c = LETF) then 
          begin
             default(1,1);
             ZSGOXY(max(0,min(maxcol,parm[2]-1)),
                    max(0,min(maxrow,parm[1]-1))) 
          end else
 
          if (c = CAPA) then 
          begin
             default(1,1);
             ZSGOXY(ZSCOL,max(top,ZSROW-parm[1]))     {2.0D}
          end else
 
          if (c = LETR) then 
          begin
             default(1,24);
             top    := max(0,min(maxrow,parm[1]-1));
             bottom := max(0,min(maxrow,parm[2]-1));
             ZSGOXY(0,0)             { Bug fix 4/12/86 }
          end else
 
          if (c = CAPJ) then
          begin
             default(0,0);
             if (parm[1] = 0) then 
             begin
                oldcol := ZSCOL; oldrow := ZSROW;
                ZSERAL;
                if (ZSROW < maxrow) then
                for row := ZSROW + 1 to maxrow do
                begin
                   ZSGOXY(0,row);                   
                   ZSERAL 
                end;
                ZSGOXY(oldcol,oldrow)
             end else
             if (parm[1] = 1) then 
             begin
                oldcol := ZSCOL; oldrow := ZSROW;
                if (ZSROW > 0) then
                for row := 0 to ZSROW - 1 do
                begin
                   ZSGOXY(0,row);                   
                   ZSERAL 
                end;
                ZSGOXY(0,ZSROW);
                for col := 0 to oldcol do ZSPUT(BLANK);
                ZSGOXY(oldcol,oldrow)
             end else
             if (parm[1] = 2) then ZSCLR
          end else
 
          if (c = CAPK) then
          begin
             default(0,0);
             if (parm[1] = 0) then ZSERAL else
             if (parm[1] = 1) then 
             begin
                oldcol := ZSCOL;
                ZSGOXY(0,ZSROW);
                for col := 0 to oldcol do ZSPUT(BLANK);
                ZSGOXY(oldcol,ZSROW)
             end else
             if (parm[1] = 2) then 
             begin
                oldcol := ZSCOL;
                ZSGOXY(0,ZSROW);
                ZSERAL;
                ZSGOXY(oldcol,ZSROW)
             end
          end else
 
          if (c = LETH) then setmode else  
          if (c = LETL) then resetmode else
 
          if (c = LETM) then 
          begin
             default(0,0);
             junk := ZSSETG(max(DEFAULTREND,min(CROSSEDOUT,parm[1])))
          end else
 
          if (c = ATSIGN) then
          begin
             default(1,1);
             ZSINS(parm[1])
          end else
 
          if (c = CAPL) then
          begin
             default(1,1);
             ZSWIN(0,maxcol,ZSROW,maxrow);
             ZSDNSC(parm[1]);
             ZSWIN(0,maxcol,0,maxrow)
          end else
 
          if (c = CAPM) then
          begin
             default(1,1);
             ZSWIN(0,maxcol,ZSROW,maxrow);
             ZSUPSC(parm[1]);
             ZSWIN(0,maxcol,0,maxrow)
          end else
 
          if (c = CAPP) then
          begin
             default(1,1);
             ZSDEL(parm[1])
          end else
 
          if (c = CAPX) then
          begin
             default(1,1);
             oldcol := ZSCOL;
             for col := 1 to min(parm[1],maxcol-oldcol+1) do ZSPUT(BLANK);
             ZSGOXY(oldcol,ZSROW)
          end;
 
          ISOstate := VBASE; 
          resetparms
       end;
 
       VMODE : 
       if (c >= DIG0) and (c <= DIG9) then 
       begin
          mode := c - DIG0;
          ISOstate := VEXEC 
       end else ISOstate := VBASE;
 
       VEXEC :
       begin
          if (c = LETH) then { execute set-mode } else
          if (c = LETL) then { execute reset-mode }; 
          ISOstate := VBASE
       end;
 
       VSCS : 
          ISOstate := VBASE   {2.0D}
 
    end { case ISOstate }
 end;
 
 
 {#PUBLIC ISO6429 -- ISO6429 standard terminal emulator }
 procedure ISO6429;     { NB uses global termtype and ISOstate }
 var c : character;
     i : leadintype;
     brkpend, esckey  : boolean;
     brktime, timeout : integer; 
 begin
    termtype  := typeISO6429; 
    setresume(false);           { forces a proper level 0 entry to SSMP }
 
    brkpend := false;
    brktime := 0;
    esckey  := false;
    timeout := 2000;    { Select on test }
 
 
    ZSWIN(0,79,0,23);
    ZSGOXY(0,23);
 
    top := 0;          {2.0D}
    bottom := maxrow;  {2.0D}
 
    ISOstate := VBASE;
    resetparms;
    leadinptr := 1;
    leadin[1] := CTRLK;
    leadin[2] := EQUALS;
    leadin[3] := CAPP;
    leadin[4] := DIG0;
    leadin[5] := SEMICOL;
 
    junk := ZKSETK(KENTER,    0); 
    junk := ZKSETK(KCSRUP,    upcode);
    junk := ZKSETK(KCSRDOWN,  downcode);
    junk := ZKSETK(KCSRLEFT,  leftcode);
    junk := ZKSETK(KCSRRIGHT, rightcode); 
    junk := ZKSETK(KNEXTTAB,  CTRLI);
    junk := ZKSETK(KPREVTAB,  CTRLI);
    junk := ZKSETK(KLEFTUPD,  0);
    junk := ZKSETK(KFIRSTNS,  0);
    junk := ZKSETK(KALASTNS,  0);
    junk := ZKSETK(KINSMODE,  0);
    junk := ZKSETK(KERARIGHT, 0);
    junk := ZKSETK(KINSSPAC,  0);
    junk := ZKSETK(KDELCHAR,  0);
    junk := ZKSETK(KERAPREV,  0);
    junk := ZKSETK(KINSLINE,  0);
    junk := ZKSETK(KDELLINE,  0);
    junk := ZKSETK(KAPPLINE,  0);
    junk := ZKSETK(KSPLLINE,  0);
    junk := ZKSETK(KNEXTFLD,  0);
    junk := ZKSETK(KPREVFLD,  0);
    junk := ZKSETK(KHOMEFLD,  0);
    junk := ZKSETK(KNEWLINE,  0);
    junk := ZKSETK(KEXIT,     exitcode);
 
    repeat
       if ZKDATA then
       begin
          ZSFLSH(false,5000);
          c := ZKGET;
 
          if brkpend then
          begin
             if (c = CAPR) or (c = LETR) then reset  else 
             if (c = CAPS) or (c = LETS) then oldterminal(termtype) else
             if (c = CAPB) or (c = LETB) or (c = KBREAK) then ZLBRK else 
                                                             ZSBELL; 
             brkpend := false
          end else
 
          if esckey then
          begin
             if (c = enqmode(KRESTART)) then 
             begin
                termtype := typeSSMP;
                newterminal(termtype);
                setresume(true) 
             end else ZLPUT(c);
             esckey := false
          end else
 
          if (c = exitcode)  then oldterminal(termtype) else 
          if (c = upcode)    then TXC(CAPA) else
          if (c = downcode)  then TXC(CAPB) else
          if (c = rightcode) then TXC(CAPC) else
          if (c = leftcode)  then TXC(CAPD) else    
 
          if (c = KBREAK)    then 
          begin
             brkpend := true;
             brktime := 0 
          end else ZLPUT(c);
 
          esckey := (c = ESC)
       end;
 
       if brkpend then
       begin
          if (brktime < timeout) then brktime := brktime + 1 else
          begin
             ZLBRK;
             brkpend := false
          end 
       end;
 
       if ZLDATA then                            { line to screen   }  
       begin
          ZSFLSH(false,5000);
          c := ZLGET;
          if (c > 127) then c := c - 128;       { mask top bit }
         
          if (c = leadin[leadinptr]) then 
          begin
             if (leadinptr < maxleadin) then leadinptr := leadinptr + 1 else 
             begin
                termtype := typeSSMP;
                newterminal(termtype)
             end
          end else
          begin
             if (leadinptr > 1) { For efficiency } then
             begin
                for i := 1 to leadinptr-1 do ISOfsm(leadin[i]);
                leadinptr := 1
             end;
             ISOfsm(c);
          end
       end; 
 
       ZSFLSH(true,5000);
       ZSUPDT(false)                          { software clock   } 
    until (termtype <> typeISO6429)
 end; 
 
 begin
 end.