Topspeed_JPI/TS-V3/SRC/TERM.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  TERM.MOD - COMMS Toolkit terminal emulation                             *
    5  *                                                                          *
    6  *  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
    7  *  All Rights Reserved                                                     *
    8  *                                                                          *
    9  *--------------------------------------------------------------------------*)
   10  
   11  IMPLEMENTATION MODULE Term;
   12    IMPORT SYSTEM,Lib,IO,Str,Window,Keyboard;
   13  
   14    TYPE
   15      CharSets            = (UK,US,SpecialChar);
   16      Attributes          = (Blue,Green,Red,Bold,BlueBack,GreenBack,RedBack,Blink);
   17      AttrSet             = SET OF Attributes;
*****                                   ^ not supported yet
   18      AttributeMap        = ARRAY[0..23],[0..79] OF AttrSet;
*****                                     ^ not supported yet
   19      CharMap             = ARRAY[0..23],[0..79] OF CHAR;
   20  
   21    CONST
   22      NormalAttr          = AttrSet{Blue,Green,Red}; (* Lightgray on Black *)
   23  
   24    VAR
   25      G0,G1,CurrCharSet   : CharSets;
   26      (* for handling protected field attributes *)
   27      CurrAttr,ProtAttr   : AttrSet;
   28      Map                 : AttributeMap;
   29      ScrMap              : CharMap;
   30      cx,cy,p1,p2,
   31      ScreenTop,
   32      ScreenBottom        : CARDINAL;
   33      DECPrivate,
   34      OriginMode,AutoWrap,
   35      NewLineMode,KbdLocked,
   36      LocalEcho,ANSIKeys,
   37      NumKeyPad,Protected,
   38      EditMode,DeferredEdit,
   39      DeferredTransmit,
   40      TransmitOK,
   41      WantsFullPage,
   42      Initialised         : BOOLEAN;
   43      TransmitMode        : (Line,PartialPage,FullPage);
   44      VTMode              : Emulations;
   45      RxState             : (Normal,GotESC,GotBrack,GotLParen,GotRParen,GotHash,ReadingP1,ReadingP2,VT52Line,VT52Col,ANSICmd);
   46      TabStop             : ARRAY[0..79] OF BOOLEAN;
   47      CSave               : RECORD
   48                              cx,cy      : CARDINAL;
   49                              Top,Bottom : CARDINAL;
   50                              OrgMode    : BOOLEAN;
   51                            END;
   52      Kbd                 : RECORD
   53                              rptr,wptr  : CARDINAL;
   54                              Buff       : ARRAY[0..255] OF CHAR;
   55                            END;
   56  
   57  (*.............................................*)
   58  
   59    PROCEDURE SetColor(NewAttr:AttrSet);
   60      BEGIN
   61        Window.TextColor(VAL(Window.Color,SHORTCARD(NewAttr) MOD 16));
   62        Window.TextBackground(VAL(Window.Color,SHORTCARD(NewAttr) DIV 16));
   63      END SetColor;
   64  
   65  (*.............................................*)
   66  
   67    PROCEDURE ResetTerm;
   68      VAR
   69        i                 : CARDINAL;
   70      BEGIN
   71        VTMode            := EmVT100;
   72        RxState           := Normal;
   73        G0                := US;
   74        G1                := SpecialChar;
   75        CurrCharSet       := G0;
   76        ScreenTop         := 0;
   77        ScreenBottom      := 23;
   78        OriginMode        := FALSE;
   79        AutoWrap          := TRUE;
   80        NewLineMode       := FALSE;
   81        KbdLocked         := FALSE;
   82        LocalEcho         := FALSE;
   83        ANSIKeys          := TRUE;
   84        NumKeyPad         := TRUE;
   85        Protected         := FALSE;
   86        EditMode          := FALSE;
   87        DeferredEdit      := FALSE;
   88        DeferredTransmit  := FALSE;
   89        TransmitMode      := Line;
   90        WantsFullPage     := FALSE;
   91        CurrAttr          := NormalAttr;
   92        ProtAttr          := CurrAttr;
   93        SetColor(CurrAttr);
   94        Lib.Fill(ADR(Map),SIZE(Map),NormalAttr);
   95        Lib.Fill(ADR(ScrMap),SIZE(ScrMap),' ');
   96        cx                := 0;
   97        cy                := 0;
   98        WITH CSave DO
   99          cx              := 0;
  100          cy              := 0;
  101          Top             := 0;
  102          Bottom          := 23;
  103          OrgMode         := FALSE;
  104        END;
  105        FOR i:=0 TO 79 DO
  106          TabStop[i]      := (i MOD 8)=0;
  107        END;
  108        WITH Kbd DO
  109          rptr            := 0;
  110          wptr            := 0;
  111        END;
  112      END ResetTerm;
  113  
  114  (*.............................................*)
  115  
  116    PROCEDURE StuffKbdBuffer(s:ARRAY OF CHAR; Lnth:CARDINAL);
  117      VAR
  118        i                 : CARDINAL;
  119      BEGIN
  120        i:=0;
  121        WHILE i<Lnth DO
  122          WITH Kbd DO
  123            Buff[wptr]:=s[i];
  124            wptr := (wptr+1) MOD 100H;
  125          END;
  126          INC(i);
  127        END;
  128      END StuffKbdBuffer;
  129  
  130  (*.............................................*)
  131  
  132    PROCEDURE GotoXY(x,y:CARDINAL);
  133      BEGIN
  134        IF y>23 THEN
  135          y:=23;
  136        END;
  137        IF x>79 THEN
  138          x:=79;
  139        END;
  140        Window.GotoXY(x+1,y+1);
  141        cx:=x;
  142        cy:=y;
  143      END GotoXY;
  144  
  145  (*.............................................*)
  146  
  147    PROCEDURE SelectEmulation(Which:Emulations);
  148      BEGIN
  149        ResetTerm;
  150        Window.Clear;
  151        GotoXY(0,0);
  152        VTMode := Which;
  153      END SelectEmulation;
  154  
  155  (*.............................................*)
  156  
  157    PROCEDURE Scroll(lines:INTEGER);
  158      VAR
  159        i                 : CARDINAL;
  160        x,y               : CARDINAL;
  161        l                 : ARRAY[0..Window.ScreenWidth-1] OF WORD;
  162      BEGIN
  163        (* Do physical scroll *)
  164        x := Window.WhereX();
  165        y := Window.WhereY();
  166        IF lines = 0 THEN
  167          FOR i := ScreenTop+1 TO ScreenBottom+1 DO
  168            Window.GotoXY(1,i);
  169            Window.ClrEol;
  170          END;
  171        ELSE
  172          REPEAT
  173            IF lines < 0 THEN
  174              FOR i := ScreenBottom TO ScreenTop+1 BY -1 DO
  175                Window.RdBufferLn(Window.Used(),1,i,SYSTEM.ADR(l),80);
  176                Window.WrBufferLn(Window.Used(),1,i+1,SYSTEM.ADR(l),80);
  177              END;
  178              Window.GotoXY(1,ScreenTop+1);
  179              Window.ClrEol;
  180              INC(lines);
  181            ELSE
  182              FOR i := ScreenTop+2 TO ScreenBottom+1 DO
  183                Window.RdBufferLn(Window.Used(),1,i,SYSTEM.ADR(l),80);
  184                Window.WrBufferLn(Window.Used(),1,i-1,SYSTEM.ADR(l),80);
  185              END;
  186              Window.GotoXY(1,ScreenBottom+1);
  187              Window.ClrEol;
  188              DEC(lines);
  189            END;
  190          UNTIL ABS(lines) = 0;
  191        END;
  192        Window.GotoXY(x,y);
  193        (* Now scroll attribute map *)
  194        IF lines<>0 THEN
  195          IF lines>0 THEN (* Scroll up *)
  196            i:=ScreenTop;
  197            REPEAT
  198              Map[i] := Map[i+1];
  199              ScrMap[i] := ScrMap[i+1];
  200              INC(i);
  201            UNTIL i=ScreenBottom;
  202          ELSE (* Scroll down *)
  203            i:=ScreenBottom;
  204            REPEAT
  205              Map[i] := Map[i-1];
  206              ScrMap[i] := ScrMap[i-1];
  207              DEC(i);
  208            UNTIL i=ScreenTop;
  209          END;
  210          Lib.Fill(ADR(Map[i]),80,NormalAttr);
  211          Lib.Fill(ADR(ScrMap[i]),80,' ');
  212        END;
  213      END Scroll;
  214  
  215  (*.......................................*)
  216  
  217    PROCEDURE Translate(c:CHAR):CHAR;
  218      CONST
  219        FormChars         = ' ±????øñ??Ù¿ÚÀÅÄÄÄÄÄôÁ³óòãØœ=';
  220      BEGIN
  221        IF CurrCharSet<>US THEN
  222          IF CurrCharSet=SpecialChar THEN
  223            IF (c>=CHR(95)) AND (c<=CHR(126)) THEN
  224               c := FormChars[ORD(c)-95];
  225            END;
  226          ELSIF c='#' THEN (* Must be UK char set *)
  227            c := 'œ';
  228          END;
  229        END;
  230        RETURN c;
  231      END Translate;
  232  
  233  (*.............................................*)
  234  
  235    PROCEDURE FindUnprotected():BOOLEAN;
  236      BEGIN
  237        IF Map[cy,cx]-ProtAttr<>AttrSet{} THEN RETURN(TRUE) END;
  238        LOOP
  239          IF Map[cy,cx]-ProtAttr=AttrSet{} THEN
  240            (* on a protected char position - skip! *)
  241            IF cx=79 THEN
  242              IF cy<ScreenBottom THEN
  243                INC(cy); cx:=0
  244              ELSE
  245                RETURN FALSE
  246              END
  247            ELSE
  248              INC(cx);
  249            END;
  250          ELSE
  251            GotoXY(cx,cy);
  252            RETURN TRUE
  253          END;
  254        END;
  255      END FindUnprotected;
  256  
  257  (*.............................................*)
  258  
  259    PROCEDURE Output(c:CHAR);
  260      BEGIN
  261        IF (c<' ') OR (c=CHR(127)) THEN
  262          CASE ORD(c) OF
  263            7             : IO.WrChar(c);                                   |
  264            8             : IF cx>0 THEN
  265                              GotoXY(cx-1,cy);
  266                            END;                                            |
  267            9             : IF cx<79 THEN
  268                              REPEAT
  269                                INC(cx);
  270                              UNTIL (cx=79) OR (TabStop[cx]);
  271                              GotoXY(cx,cy);
  272                            END;                                            |
  273            10..12        : IF NewLineMode THEN
  274                              cx:=0;
  275                            END;
  276                            IF cy=ScreenBottom THEN
  277                              Scroll(1);
  278                            ELSE
  279                              INC(cy);
  280                            END;
  281                            GotoXY(cx,cy);                                  |
  282            13            : GotoXY(0,cy);                                   |
  283            14            : CurrCharSet := G1;                              |
  284            15            : CurrCharSet := G0;                              |
  285          END
  286        ELSE
  287          IF (NOT Protected) OR FindUnprotected() THEN
  288            Map[cy,cx] := CurrAttr;
  289            ScrMap[cy,cx] := c;
  290            IO.WrChar(Translate(c));
  291            IF (cx=79) AND (AutoWrap) THEN
  292              Output(CHR(10)); GotoXY(0,cy);
  293            ELSIF cx<79 THEN
  294              INC(cx);
  295            END;
  296          END;
  297        END;
  298      END Output;
  299  
  300  (*.............................................*)
  301  
  302    PROCEDURE DECModeChange(c:CHAR);
  303      VAR
  304        Lnth              : CARDINAL;
  305        Seq               : ARRAY[0..9] OF CHAR;
  306      BEGIN
  307        CASE p1 OF
  308          0               : (*Error -ignore*)                               |
  309          1               : (*Cursor Key*)
  310                            IF NOT NumKeyPad THEN
  311                              ANSIKeys := c='l';
  312                            END;                                            |
  313          2               : IF c='l' THEN
  314                              SelectEmulation(EmVT52);
  315                            END;                                            |
  316          3               : (*Select 80/132 Columns - not supported*)       |
  317          4               : (*Select smooth/jump scrolling - not supported*)|
  318          5               : (*Normal or Reverse Screen - not implemented*)  |
  319          6               : (*origin*)
  320                            OriginMode := c='h';                            |
  321          7               : (*Auto-wrap*)
  322                            AutoWrap := c='h';                              |
  323          8               : (*Kbd Auto-repeat on/off - not supported*)      |
  324          10              : (*Editing*)
  325                            EditMode := c='h';                              |
  326          11              : (*Line Transmit*)
  327                            IF c='h' THEN
  328                              TransmitMode := Line
  329                            ELSIF WantsFullPage THEN
  330                              TransmitMode := FullPage
  331                            ELSE
  332                              TransmitMode := PartialPage
  333                            END;                                            |
  334          13              : (*Space compression / Field delimiter*)         |
  335          14              : (*Transmit execution*)
  336                            DeferredTransmit := (c='l');                    |
  337          15              : (* Printer status request *)
  338                            IF c='n' THEN
  339                              Seq:=' [?13n';
  340                              Seq[0]:=CHR(27);
  341                              StuffKbdBuffer(Seq,6);
  342                            END;                                            |
  343          16              : (*Edit key execution*)
  344                            DeferredEdit := c='l';                          |
  345          18              : (*Printer form feed*)                           |
  346          19              : (*Printer extent*)                              |
  347        END;
  348      END DECModeChange;
  349  
  350  (*.............................................*)
  351  
  352    PROCEDURE EraseField(x,y,w:CARDINAL);
  353      VAR
  354        i,oldx,oldy       : CARDINAL;
  355      BEGIN
  356        (* This routine is only called if protected fields are in effect *)
  357        oldx:=cx;
  358        oldy:=cy;
  359        i:=0;
  360        GotoXY(x,y);
  361        WHILE i<w DO
  362          IF Map[y,x+i]-ProtAttr<>AttrSet{} THEN
  363            Map[y,x+i] := CurrAttr;
  364            ScrMap[y,x+i] := ' ';
  365            IO.WrChar(' ');
  366          ELSE
  367            GotoXY(x+i+1,cy);
  368          END;
  369          INC(i);
  370        END;
  371        GotoXY(oldx,oldy);
  372      END EraseField;
  373  
  374  (*.............................................*)
  375  
  376    PROCEDURE EraseLineToCursor;
  377      BEGIN
  378        IF Protected THEN
  379          EraseField(0,cy,cx+1);
  380        ELSE
  381          Lib.Fill(ADR(Map[cy]),cx+1,NormalAttr);
  382          Lib.Fill(ADR(ScrMap[cy]),cx+1,' ');
  383          Window.DirectWrite(0,cy,ADR(ScrMap[cy]),cx);
  384        END;
  385      END EraseLineToCursor;
  386  
  387  (*.............................................*)
  388  
  389    PROCEDURE EraseCursorToEol;
  390      BEGIN
  391        IF Protected THEN
  392          EraseField(cx,cy,cx+1);
  393        ELSE
  394          Window.ClrEol;
  395        END;
  396      END EraseCursorToEol;
  397  
  398  (*.............................................*)
  399  
  400    PROCEDURE EraseScreenToCursor;
  401      VAR
  402        i,x,y             : CARDINAL;
  403      BEGIN
  404        i:=0;
  405        x:=cx;
  406        y:=cy;
  407        WHILE i<y DO
  408          GotoXY(0,i);
  409          EraseCursorToEol;
  410          INC(i);
  411        END;
  412        GotoXY(x,y);
  413        EraseLineToCursor;
  414      END EraseScreenToCursor;
  415  
  416  (*.............................................*)
  417  
  418    PROCEDURE ClrEos;
  419      VAR
  420        i,x,y             : CARDINAL;
  421      BEGIN
  422        i:=0;
  423        x:=cx;
  424        y:=cy;
  425        EraseCursorToEol;
  426        i:=y+1;
  427        WHILE i<=23 DO
  428          GotoXY(0,i);
  429          EraseCursorToEol;
  430          INC(i);
  431        END;
  432        GotoXY(x,y);
  433      END ClrEos;
  434  
  435  (*.............................................*)
  436  
  437    PROCEDURE FieldWidth():CARDINAL;
  438      VAR
  439        i,Max             : CARDINAL;
  440      BEGIN
  441        IF Protected THEN
  442          i:=cx;
  443          IF Map[cy,i]=ProtAttr THEN
  444            RETURN(0);
  445          END;
  446          WHILE (i<80) AND (Map[cy,i]<>ProtAttr) DO
  447            INC(i);
  448          END;
  449          Max := i-1;
  450        ELSE
  451          Max := 79;
  452        END;
  453        RETURN Max;
  454      END FieldWidth;
  455  
  456  (*.............................................*)
  457  
  458    PROCEDURE DelChar;
  459      VAR
  460        i,Max             : CARDINAL;
  461        a                 : AttrSet;
  462      BEGIN
  463        Max := FieldWidth();
  464        IF Max=0 THEN
  465          RETURN;
  466        END;
  467        i:=cx;
  468        a:=Map[cy,i];
  469        SetColor(a);
  470        WHILE i<Max DO
  471          Map[cy,i] := Map[cy,i+1];
  472          ScrMap[cy,i] := ScrMap[cy,i+1];
  473          IF Map[cy,i]<>a THEN
  474            a:=Map[cy,i]; SetColor(a);
  475          END;
  476          IO.WrChar(ScrMap[cy,i]);
  477          INC(i);
  478        END;
  479        IF Map[cy,i]<>a THEN
  480          a:=Map[cy,i];
  481          SetColor(a);
  482        END;
  483        ScrMap[cy,i]:=' ';
  484        IO.WrChar(' ');
  485        GotoXY(cx,cy);
  486      END DelChar;
  487  
  488  (*.............................................*)
  489  
  490    PROCEDURE GetCursorPosition(VAR s:ARRAY OF CHAR; VAR Lnth:CARDINAL);
  491      VAR
  492        TempStr           : ARRAY[0..9] OF CHAR;
  493        Ok                : BOOLEAN;
  494      BEGIN
  495        Str.CardToStr(LONGCARD(cy+1),TempStr,10,Ok);
  496        Str.CardToStr(LONGCARD(cx+1),s,10,Ok);
  497        Lnth := Str.Length(TempStr)+Str.Length(s)+4;
  498        Str.Concat(TempStr,' [',TempStr);
  499        Str.Concat(s,';',s);
  500        Str.Concat(s,TempStr,s);
  501        Str.Concat(s,s,'R');
  502        s[0]:=CHR(27);
  503      END GetCursorPosition;
  504  
  505  (*.............................................*)
  506  
  507    PROCEDURE Transmit;
  508        (* not implemented *)
  509      END Transmit;
  510  
  511  (*.............................................*)
  512  
  513    PROCEDURE CursorMovement ( dir : CHAR ; dist : CARDINAL );
  514      BEGIN
  515        IF dist=0 THEN
  516          dist:=1;
  517        END ;
  518        CASE dir OF
  519          'A'             : IF dist>cy THEN
  520                              cy:=0;
  521                            ELSE
  522                              DEC(cy,dist);
  523                            END;                                            |
  524          'B'             : INC(cy,dist);
  525                            IF cy>ScreenBottom THEN
  526                              cy := ScreenBottom;
  527                            END;                                            |
  528          'C'             : INC(cx,dist);
  529                            IF cy>79 THEN
  530                              cy := 79;
  531                            END;                                            |
  532          'D'             : IF dist>cx THEN
  533                              cx:=0;
  534                            ELSE
  535                              DEC(cx,dist);
  536                            END;                                            |
  537        END;
  538        GotoXY(cx,cy);
  539      END CursorMovement ;
  540  
  541  (*.............................................*)
  542  
  543  
  544    PROCEDURE EraseCommand ( type : CHAR ; function : CARDINAL );
  545      VAR
  546        x,y               : CARDINAL;
  547      BEGIN
  548        CASE type OF
  549          'J'             : CASE function OF
  550                              0          : ClrEos;                     |
  551                              1          : EraseScreenToCursor;        |
  552                              2          : x:=cx;
  553                                           y:=cy;
  554                                           GotoXY(0,0);
  555                                           ClrEos;
  556                                           GotoXY(x,y);                |
  557                            END;                                            |
  558          'K'             : CASE function OF
  559                              0          : EraseCursorToEol;           |
  560                              1          : EraseLineToCursor;          |
  561                              2          : x:=cx;
  562                                           GotoXY(0,cy);
  563                                           EraseCursorToEol;
  564                                           GotoXY(x,cy);               |
  565                            END;                                            |
  566        END ;
  567      END EraseCommand ;
  568  
  569  (*.............................................*)
  570  
  571    PROCEDURE CheckCode(c:CHAR);
  572      VAR
  573        x,y               : CARDINAL;
  574        Seq               : ARRAY[0..9] OF CHAR;
  575      BEGIN
  576        IF DECPrivate THEN
  577          DECModeChange(c)
  578        ELSE
  579          CASE c OF
  580            'A'..'D'      : CursorMovement(c,p1);                           |
  581            'c'           : (* Device attributes request *)
  582                            Seq:=' [?7c';
  583                            Seq[0]:=CHR(27);
  584                            StuffKbdBuffer(Seq,5);                          |
  585            'g'           : IF p1=0 THEN
  586                              TabStop[cx]:=FALSE;
  587                            ELSIF p1=3 THEN
  588                              FOR x:=0 TO 79 DO
  589                                TabStop[x]:=FALSE;
  590                              END;
  591                            END;                                            |
  592            'H','f'       : IF p1=0 THEN
  593                              p1:=1;
  594                            END;
  595                            IF p2=0 THEN
  596                              p2:=1;
  597                            END;
  598                            GotoXY(p2-1,p1-1);                              |
  599            'h','l'       : CASE p1 OF
  600                              2          : KbdLocked := (c='h');                 |
  601                              6          : Protected := (c='l');                 |
  602                              12         : LocalEcho := (c='l');                 |
  603                              16         : WantsFullPage := (c='h');             |
  604                              20         : NewLineMode := (c='h');               |
  605                            END;                                            |
  606            'J','K'       : EraseCommand(c,p1);                             |
  607            'L'           : IF (cy>=ScreenTop) AND (cy<=ScreenBottom) THEN
  608                              y:=ScreenTop;
  609                              ScreenTop:=cy;
  610                              WHILE p1>0 DO
  611                                Scroll(-1);
  612                                DEC(p1);
  613                              END;
  614                              ScreenTop:=y;
  615                            END;                                            |
  616            'M'           : IF (cy>=ScreenTop) AND (cy<=ScreenBottom) THEN
  617                              y:=ScreenTop;
  618                              ScreenTop:=cy;
  619                              WHILE p1>0 DO
  620                                Scroll(1);
  621                                DEC(p1);
  622                              END;
  623                              ScreenTop:=y;
  624                            END;                                            |
  625            'm'           : (* Select graphic rendition *)
  626                            CASE p1 OF
  627                              0          : CurrAttr := NormalAttr ;              |
  628                              1          : INCL(CurrAttr,Bold);                  |
  629                              4          : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue};|
  630                              5          : INCL(CurrAttr,Blink);                 |
  631                              7          : CurrAttr := AttrSet(
  632                                           (SHORTCARD(CurrAttr*AttrSet{Red,Green,Blue})<<4)+
  633                                           (SHORTCARD(CurrAttr*AttrSet{RedBack,GreenBack,BlueBack})>>4)+
  634                                           (SHORTCARD(CurrAttr*AttrSet{Bold,Blink})));|
  635                              8          : CurrAttr := AttrSet{};                |
  636                            END;
  637                            SetColor(CurrAttr);                             |
  638            'n'           : (* Device status reports *)
  639                            Seq[0]:=CHR(27);
  640                            Seq[1]:='[';
  641                            Seq[3]:='n';
  642                            x:=4;
  643                            CASE p1 OF
  644                              5          : Seq[2]:='0';(* VDU status request *)  |
  645                              6          : GetCursorPosition(Seq,x);             |
  646                            ELSE
  647                              x := 0;
  648                            END;
  649                            IF x>0 THEN
  650                              StuffKbdBuffer(Seq,x);
  651                            END;                                            |
  652            'P'           : WHILE p1>0 DO
  653                              DelChar;
  654                              DEC(p1);
  655                            END;                                            |
  656            'r'           : IF (p1>=1) AND (p2>0) AND (p2<=24) AND (p1<p2) THEN
  657                              ScreenTop := p1-1;
  658                              ScreenBottom := p2-1;
  659                            ELSE
  660                              ScreenTop:=0;
  661                              ScreenBottom:=23;
  662                            END;
  663                            GotoXY(0,ScreenTop);                            |
  664            '}'           : (* Set protection attributes *)
  665                            CASE p1 OF
  666                              0          : ProtAttr := NormalAttr;               |
  667                              1          : INCL(ProtAttr,Bold);                  |
  668                              4          : ProtAttr := ProtAttr-AttrSet{Red,Green}+AttrSet{Blue};|
  669                              5          : INCL(ProtAttr,Blink);                 |
  670                              7          : ProtAttr := AttrSet(
  671                                           (SHORTCARD(ProtAttr*AttrSet{Red,Green,Blue})<<4)+
  672                                           (SHORTCARD(ProtAttr*AttrSet{RedBack,GreenBack,BlueBack})>>4)+
  673                                           (SHORTCARD(ProtAttr*AttrSet{Bold,Blink})));|
  674                              8          : ProtAttr := AttrSet{};                |
  675                            ELSE
  676                              IF p1=254 THEN
  677                                ProtAttr:=NormalAttr;
  678                              END;
  679                            END;
  680  
  681          END;
  682        END;
  683      END CheckCode;
  684  
  685  (*.............................................*)
  686  
  687    PROCEDURE ShortCode(c:CHAR);
  688      VAR
  689        x,y               : CARDINAL;
  690        Seq               : ARRAY[0..9] OF CHAR;
  691      BEGIN
  692        CASE c OF
  693          'c'             : (* Reset *)
  694                            SelectEmulation(EmVT100);                       |
  695          'D'             : IF cy<23 THEN
  696                              GotoXY(cx,cy+1);
  697                            ELSE
  698                              Scroll(1);
  699                            END;                                            |
  700          'E'             : Output(CHR(10));
  701                            GotoXY(0,cy);                                   |
  702          'H'             : TabStop[cx]:=TRUE;                              |
  703          'M'             : IF cy>0 THEN
  704                              GotoXY(cx,cy-1);
  705                            ELSE
  706                              Scroll(-1);
  707                            END;                                            |
  708          'N'             : (* G2 char set - not supported *)               |
  709          'Z'             : (* Identity Request *)
  710                            Seq:=' [?7c';
  711                            Seq[0]:=CHR(27);
  712                            StuffKbdBuffer(Seq,5);                          |
  713          'O'             : (* G3 char set - not supported *)               |
  714          '7'             : CSave.cx:=cx;
  715                            CSave.cy:=cy;
  716                            WITH CSave DO
  717                              Top:=ScreenTop;
  718                              Bottom:=ScreenBottom;
  719                              OrgMode:=OriginMode;
  720                            END;                                            |
  721          '8'             : WITH CSave DO
  722                              ScreenTop:=Top;
  723                              ScreenBottom:=Bottom;
  724                              OriginMode:=OrgMode;
  725                              GotoXY(cx,cy);
  726                            END;                                            |
  727           '='            : NumKeyPad := FALSE;(* application keypad mode *)|
  728           '>'            : NumKeyPad := TRUE;
  729                            ANSIKeys := TRUE;                               |
  730        END;
  731      END ShortCode;
  732  
  733  (*.............................................*)
  734  
  735    PROCEDURE NewCharSet(c:CHAR; VAR Gx:CharSets);
  736      BEGIN
  737        CASE c OF
  738          'A'             : Gx:=UK;                |
  739          'B'             : Gx:=US;                |
  740          '0'             : Gx:=SpecialChar;       |
  741          '1'             : (* not supported *)    |
  742          '2'             : (* not supported *)    |
  743        END;
  744      END NewCharSet;
  745  
  746  (*.............................................*)
  747  
  748    PROCEDURE VT100RxSM(c:CHAR);
  749      BEGIN
  750        CASE RxState OF
  751          Normal          : IF c=CHR(27) THEN
  752                              DECPrivate := FALSE;
  753                              p1:=0;
  754                              p2:=0;
  755                              RxState := GotESC
  756                            ELSE
  757                              Output(c)
  758                            END;                                            |
  759          GotESC          : IF c='[' THEN
  760                              RxState := GotBrack
  761                            ELSIF c='(' THEN
  762                              RxState := GotLParen
  763                            ELSIF c=')' THEN
  764                              RxState := GotRParen
  765                            ELSIF c='#' THEN
  766                              RxState := GotHash
  767                            ELSE
  768                              ShortCode(c);
  769                              RxState := Normal;
  770                            END;                                            |
  771          GotBrack        : IF c='?' THEN
  772                              DECPrivate := TRUE;
  773                              RxState := ReadingP1;
  774                            ELSIF (c>='0') AND (c<='9') THEN
  775                              p1 := ORD(c)-48;
  776                              RxState := ReadingP1;
  777                            ELSIF (c=';') THEN
  778                              RxState := ReadingP2;
  779                            ELSE
  780                              CheckCode(c);
  781                              RxState := Normal;
  782                            END;                                            |
  783          GotLParen       : NewCharSet(c,G0);
  784                            RxState := Normal;                              |
  785          GotRParen       : NewCharSet(c,G1);
  786                            RxState := Normal;                              |
  787          GotHash         : RxState := Normal; (* ignore line attributes *) |
  788          ReadingP1       : IF (c>='0') AND (c<='9') THEN
  789                              p1 := p1*10 + ORD(c)-48;
  790                            ELSIF c=';' THEN
  791                              RxState := ReadingP2
  792                            ELSE
  793                              CheckCode(c);
  794                              RxState := Normal;
  795                            END;                                            |
  796          ReadingP2       : IF (c>='0') AND (c<='9') THEN
  797                              p2 := p2*10 + ORD(c)-48;
  798                            ELSE
  799                              CheckCode(c);
  800                              RxState := Normal;
  801                            END;                                            |
  802        END;
  803      END VT100RxSM;
  804  
  805  (*.............................................*)
  806  
  807    VAR
  808      CursorY             : CARDINAL;
  809  
  810    PROCEDURE VT52RxSM(c:CHAR);
  811      VAR
  812        Seq               : ARRAY[0..3] OF CHAR;
  813      BEGIN
  814        CASE RxState OF
  815          Normal          : IF c=CHR(27) THEN
  816                              RxState:=GotESC
  817                            ELSE
  818                              Output(c)
  819                            END;                                            |
  820          GotESC          : CASE c OF
  821                              '<'        : SelectEmulation(EmVT100);             |
  822                              '='        : NumKeyPad:=FALSE;                     |
  823                              '>'        : NumKeyPad:=TRUE;                      |
  824                              'F'        : CurrCharSet:=SpecialChar;             |
  825                              'G'        : CurrCharSet:=US;                      |
  826                              'A'..'D'   : CursorMovement(c,1);                  |
  827                              'H'        : GotoXY(0,0);                          |
  828                              'Y'        : RxState := VT52Line;                  |
  829                              'I'        : IF cy>ScreenTop THEN
  830                                             DEC(cy);
  831                                           ELSE
  832                                             Scroll(-1);
  833                                           END;
  834                                           GotoXY(cx,cy);                        |
  835                              'K'        : EraseCursorToEol;                     |
  836                              'J'        : ClrEos;                               |
  837                              'Z'        : Seq:=' /Z';
  838                                           Seq[0]:=CHR(27);
  839                                           StuffKbdBuffer(Seq,3);                |
  840                            END;
  841                            IF RxState<>VT52Line THEN
  842                              RxState:=Normal;
  843                            END;                                            |
  844          VT52Line        : IF c>=' ' THEN
  845                              CursorY := ORD(c)-32;
  846                              RxState := VT52Col;
  847                            ELSE
  848                              RxState := Normal;
  849                            END;                                            |
  850          VT52Col         : IF c>=' ' THEN
  851                              GotoXY(ORD(c)-32,CursorY);
  852                            END;
  853                            RxState := Normal;                              |
  854        END;
  855      END VT52RxSM;
  856  
  857  (*.............................................*)
  858    VAR
  859      ANSIp               : ARRAY[1..9] OF CARDINAL ;
  860      ANSIn               : [0..9];
  861    PROCEDURE ANSIRxSM(c:CHAR);
  862      (* Reduced PC compatible ANSI driver *)
  863      VAR
  864        i                 : CARDINAL;
  865        W                 : Window.WinType;
  866        wc                : Window.Color;
  867        Seq               : ARRAY[0..9] OF CHAR;
  868      BEGIN
  869        CASE RxState OF
  870          Normal          : IF c=CHR(27) THEN
  871                              RxState:=GotESC;
  872                            ELSE
  873                              Output(c);
  874                            END;                                            |
  875          GotESC          : IF c='[' THEN
  876                              RxState:=ANSICmd;
  877                              FOR i := 1 TO 9 DO
  878                                ANSIp[i] := 0;
  879                              END ;
  880                              ANSIn := 1;
  881                            ELSE
  882                              Output(c);
  883                              RxState:=Normal;
  884                            END;                                            |
  885          ANSICmd         : RxState:=Normal;
  886                            CASE c OF
  887                              '0'..'9'   : ANSIp[ANSIn] := ANSIp[ANSIn]*10+ORD(c)-ORD('0');
  888                                           RxState:=ANSICmd;                     |
  889                              ';'        : IF ANSIn<9 THEN
  890                                             INC(ANSIn);
  891                                           END;
  892                                           RxState:=ANSICmd;                     |
  893                              'f','H'    : IF ANSIp[1] > 0 THEN
  894                                             DEC(ANSIp[1]);
  895                                           END;
  896                                           IF ANSIp[2] > 0 THEN
  897                                             DEC(ANSIp[2]);
  898                                           END;
  899                                           GotoXY(ANSIp[2],ANSIp[1]);            |
  900                              'A'..'D'   : CursorMovement(c,ANSIp[1]);           |
  901                              'J','K'    : EraseCommand(c,ANSIp[1]);             |
  902                              's'        : CSave.cx:=cx;
  903                                           CSave.cy:=cy;                         |
  904                              'u'        : GotoXY(CSave.cx,CSave.cy);            |
  905                              'n'        : IF ANSIp[1]=6 THEN
  906                                             GetCursorPosition(Seq,i);
  907                                             IF i>0 THEN
  908                                               StuffKbdBuffer(Seq,i);
  909                                             END;
  910                                           END;                                  |
  911                              'm'        : FOR i := 1 TO ANSIn DO
  912                                             CASE ANSIp[i] OF
  913                                               0             : CurrAttr := NormalAttr;                                             |
  914                                               1             : INCL(CurrAttr,Bold);                                                |
  915                                               4             : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue};              |
  916                                               5             : INCL(CurrAttr,Blink);                                               |
  917                                               7             : CurrAttr := AttrSet((SHORTCARD(CurrAttr*AttrSet{Red,Green,Blue})<<4)+(SHORTCARD(CurrAttr*AttrSet{RedBack,GreenBack,BlueBack})>>4)+(SHORTCARD(CurrAttr*AttrSet{Bold,Blink})));|
  918                                               8             : CurrAttr := AttrSet{};                                              |
  919                                               30            : CurrAttr := CurrAttr-AttrSet{Red,Green,Blue};                       |
  920                                               31            : CurrAttr := CurrAttr-AttrSet{Green,Blue}+AttrSet{Red};              |
  921                                               32            : CurrAttr := CurrAttr-AttrSet{Red,Blue}+AttrSet{Green};              |
  922                                               33            : CurrAttr := CurrAttr-AttrSet{Blue}+AttrSet{Red,Green};              |
  923                                               34            : CurrAttr := CurrAttr-AttrSet{Red,Green}+AttrSet{Blue};              |
  924                                               35            : CurrAttr := CurrAttr-AttrSet{Green}+AttrSet{Red,Blue};              |
  925                                               36            : CurrAttr := CurrAttr-AttrSet{Red}+AttrSet{Blue,Green};              |
  926                                               37            : CurrAttr := CurrAttr+AttrSet{Red,Blue,Green};                       |
  927                                               40            : CurrAttr := CurrAttr-AttrSet{RedBack,GreenBack,BlueBack};           |
  928                                               41            : CurrAttr := CurrAttr-AttrSet{GreenBack,BlueBack}+AttrSet{RedBack};  |
  929                                               42            : CurrAttr := CurrAttr-AttrSet{RedBack,BlueBack}+AttrSet{GreenBack};  |
  930                                               43            : CurrAttr := CurrAttr-AttrSet{BlueBack}+AttrSet{RedBack,GreenBack};  |
  931                                               44            : CurrAttr := CurrAttr-AttrSet{RedBack,GreenBack}+AttrSet{BlueBack};  |
  932                                               45            : CurrAttr := CurrAttr-AttrSet{GreenBack}+AttrSet{RedBack,BlueBack};  |
  933                                               46            : CurrAttr := CurrAttr-AttrSet{RedBack}+AttrSet{BlueBack,GreenBack};  |
  934                                               47            : CurrAttr := CurrAttr+AttrSet{RedBack,BlueBack,GreenBack};           |
  935                                             END;
  936                                             SetColor(CurrAttr);
  937                                           END;
  938                            ELSE
  939                              Output(c);
  940                            END;
  941        END;
  942      END ANSIRxSM;
  943  
  944  (*.............................................*)
  945  
  946    PROCEDURE WrChar(c:CHAR);
  947      BEGIN
  948        IF ORD(c)>127 THEN
  949          c:=CHR(ORD(c)-128);
  950        END;
  951        CASE VTMode OF
  952          EmVT100: VT100RxSM(c); (* call VT100 receive state machine *)     |
  953          EmVT52:  VT52RxSM(c);  (* call VT52 receive state machine *)      |
  954          EmANSI:  ANSIRxSM(c);  (* call ANSI receive state machine *)      |
  955        END;
  956      END WrChar;
  957  
  958  (*.............................................*)
  959  
  960    PROCEDURE KeyTranslate;
  961      (* Emulate sequences produced by VT100 or VT52 keyboard. There is a  *)
  962      (* dearth of keypad keys on the IBM for this, so instead, to use     *)
  963      (* cursor keys you use the unshifted keys. To access the numeric     *)
  964      (* keypad (or the application keys in alterate mode) you hold down   *)
  965      (* shift while pressing the appropriate keys. This still leaves us   *)
  966      (* five keys short for the keypad "enter" and PF1..PF4. The "Enter"  *)
  967      (* key is produced by F6 on the PC, and PF1..PF4 correspond to F7..F8*)
  968      (* on the PC.                                                        *)
  969      VAR
  970        c                 : CHAR;
  971        Lnth              : CARDINAL;
  972        Seq               : ARRAY[0..2] OF CHAR;
  973      BEGIN
  974        c := Keyboard.RdKey();
  975        IF c=0C THEN
  976          (* NOTE: Alt-Key combinations are reserved for use by the comms *)
  977          (* package, so if this turns out to be one we need to insert the*)
  978          (* preceding NUL into the kbd.buff also, otherwise the equivalent*)
  979          (* VT100 sequence gets stuffed into the keyboard buffer.        *)
  980          c := Keyboard.RdKey();
  981          Seq[0]:=CHR(27);
  982          Lnth:=3;
  983          IF c=CHR(64) THEN
  984            IF NumKeyPad THEN
  985              Seq[0]:=CHR(13);
  986              Lnth:=1;
  987              IF NewLineMode THEN
  988                Seq[1]:=CHR(10);
  989                Lnth:=2;
  990              END;
  991            ELSE
  992              Seq[1]:='O';
  993              Seq[2]:='M';
  994            END;
  995          ELSIF (c>=CHR(65)) AND (c<=CHR(68)) THEN
  996            IF VTMode=EmVT100 THEN
  997              Seq[1]:='O';
  998            ELSE
  999              Seq[1]:='?';
 1000            END;
 1001            CASE ORD(c) OF
 1002              65         : Seq[2]:='P';      |
 1003              66         : Seq[2]:='Q';      |
 1004              67         : Seq[2]:='R';      |
 1005              68         : Seq[2]:='S';      |
 1006            END;
 1007            IF (VTMode=EmVT52) AND (NumKeyPad) THEN
 1008              Seq[1]:=Seq[2];
 1009              Lnth:=2;
 1010            END;
 1011          ELSE
 1012            IF ANSIKeys THEN
 1013              Seq[1]:='[';
 1014            ELSE
 1015              Seq[1]:='O';
 1016            END;
 1017            CASE ORD(c) OF
 1018              72         : Seq[2]:='A'; (* cursor up *)     |
 1019              75         : Seq[2]:='D'; (* cursor left *)   |
 1020              77         : Seq[2]:='C'; (* cursor right *)  |
 1021              80         : Seq[2]:='B'; (* cursor down *)   |
 1022            ELSE
 1023              Seq[0]:=0C; Seq[1]:=c; StuffKbdBuffer(Seq,2);
 1024              RETURN
 1025            END;
 1026            IF VTMode=EmVT52 THEN
 1027              Seq[1]:=Seq[2];
 1028              Lnth:=2;
 1029            END;
 1030          END;
 1031          StuffKbdBuffer(Seq,Lnth);
 1032        ELSIF (Keyboard.ScanCode>=CHR(71)) AND (Keyboard.ScanCode<=CHR(83)) THEN
 1033          IF NumKeyPad THEN
 1034            IF c='+' THEN
 1035              c:=',';
 1036            END;
 1037            StuffKbdBuffer(c,1);
 1038          ELSE
 1039            Seq[0]:=CHR(27);
 1040            IF VTMode=EmVT100 THEN
 1041              Seq[1]:='O';
 1042            ELSE
 1043              Seq[1]:='?';
 1044            END;
 1045            CASE c OF
 1046              '0'        : Seq[2]:='p'; |
 1047              '1'        : Seq[2]:='q'; |
 1048              '2'        : Seq[2]:='r'; |
 1049              '3'        : Seq[2]:='s'; |
 1050              '4'        : Seq[2]:='t'; |
 1051              '5'        : Seq[2]:='u'; |
 1052              '6'        : Seq[2]:='v'; |
 1053              '7'        : Seq[2]:='w'; |
 1054              '8'        : Seq[2]:='x'; |
 1055              '9'        : Seq[2]:='y'; |
 1056              '-'        : Seq[2]:='m'; |
 1057              '+'        : Seq[2]:='l'; |
 1058              '.'        : Seq[2]:='n'; |
 1059            END;
 1060            StuffKbdBuffer(Seq,3);
 1061          END;
 1062        ELSE
 1063          Seq[0]:=c;
 1064          Lnth:=1;
 1065          IF (c=CHR(13)) AND (NewLineMode) THEN
 1066            Seq[1]:=CHR(10); Lnth:=2;
 1067          END;
 1068          StuffKbdBuffer(Seq,Lnth);
 1069        END;
 1070      END KeyTranslate;
 1071  
 1072  (*.............................................*)
 1073  
 1074    PROCEDURE RdKey():CHAR;
 1075      VAR
 1076        c                 : CHAR;
 1077      BEGIN
 1078        LOOP
 1079          WITH Kbd DO
 1080            IF rptr<>wptr THEN
 1081              c:=Buff[rptr];
 1082              rptr:=(rptr+1) MOD 100H;
 1083              EXIT
 1084            ELSE
 1085              KeyTranslate();
 1086            END;
 1087          END;
 1088        END;
 1089        RETURN c;
 1090      END RdKey;
 1091  
 1092  (*.............................................*)
 1093  
 1094    PROCEDURE KeyPressed():BOOLEAN;
 1095      BEGIN
 1096        IF Kbd.rptr<>Kbd.wptr THEN
 1097          RETURN TRUE
 1098        ELSIF Keyboard.KeyPressed() THEN
 1099          KeyTranslate();
 1100          RETURN KeyPressed();
 1101        ELSE
 1102          RETURN FALSE
 1103        END;
 1104      END KeyPressed;
 1105  
 1106  (*.............................................*)
 1107  
 1108    PROCEDURE ClearScreen;
 1109      BEGIN
 1110        GotoXY(0,0);
 1111        ClrEos;
 1112      END ClearScreen;
 1113  
 1114  (*.............................................*)
 1115  
 1116    PROCEDURE EmulateVT100;
 1117      BEGIN
 1118        SelectEmulation(EmVT100);
 1119      END EmulateVT100;
 1120  
 1121  (*.............................................*)
 1122  
 1123    PROCEDURE EmulateVT52;
 1124      BEGIN
 1125        SelectEmulation(EmVT52);
 1126      END EmulateVT52;
 1127  
 1128  (*.............................................*)
 1129  
 1130    PROCEDURE EmulateANSI;
 1131      BEGIN
 1132        SelectEmulation(EmANSI);
 1133      END EmulateANSI;
 1134  
 1135  (*.............................................*)
 1136  
 1137    PROCEDURE Emulation():Emulations;
 1138      BEGIN
 1139        RETURN VTMode;
 1140      END Emulation;
 1141  
 1142  (*.............................................*)
 1143  
 1144    BEGIN
 1145      ResetTerm;
 1146    END Term.

    2 errors