Programmer 7500/MAX_PROGRAMMERS.iso/INFO/PASCAL/CONSOLE.ZIP/CONSOLE.SRC

Text File | 1989-10-19 | 7.3 KB | 209 lines

(*  VERSION 0011 *)



MODULE cons;


(*******************************************************************)
(*           (C) Copyright 1982 by Patrick Wallace                 *)
(* Use of this program module for commercial purposes without the  *)
(* author's prior written consent is expressly forbidden.          *)
(*     Date last update : 1/21/83                                  *)
(*         [to add ^E,^X,^J,^K,^Q,and ESC to stop characters]      *)
(*******************************************************************)

EXTERNAL FUNCTION @BDOS(func : INTEGER; parm : WORD) : INTEGER;


PROCEDURE console(VAR entrych:CHAR; VAR entry:STRING; VAR position:INTEGER;
                  charcount, len : INTEGER);

CONST
   contrs = $13;       contrd = $04;          contra = $01;
   backspc = $08;       forspc = $06;           contrf = $06;
   contrg = $07;        tab = $09;              del = $7F;
   fwd = $0C;           nsert = $16;

TYPE
  letter = SET OF CHAR;         way = (fwr, bak);


VAR
dummy : INTEGER;                     ch : BYTE;
ltrs : letter;                     stop : SET OF BYTE;



       PROCEDURE getch(VAR CH : BYTE);

       BEGIN
         REPEAT
           ch := @BDOS(6, WRD($FF)) & $7F;  {direct console input}
         UNTIL ORD(ch) <> 0;            {until character is typed}
       END;


       PROCEDURE emit(ch : BYTE);

       BEGIN
         WRITE(CHR(ch))
       END;


       PROCEDURE go(VAR position : INTEGER;
                      dir : way;
                      num : INTEGER);

       VAR
               loop : INTEGER;         ch : BYTE;      offset : INTEGER;

       BEGIN
               IF dir = fwr THEN
                   BEGIN
                     offset := 1;
                     ch := forspc
                   END
               ELSE
                   BEGIN
                     offset := - 1;
                     ch := backspc
                   END;

               FOR loop := 1 TO num DO
                       BEGIN
                             WRITE(CHR(ch));
                             position := position + offset
                       END
       END; {go}


BEGIN {console}

  IF charcount > len THEN charcount := len;   {charcount = length(entry) }

  IF position > charcount + 1 THEN
     BEGIN
       FOR dummy := position DOWNTO charcount + 2 DO
          WRITE(CHR(backspc));  {make screen agree with us}

       position := charcount + 1;
     END;

  ltrs := [' ' .. 'z'];
  stop := [5,10,11,13,17,24,27]; {^E,^J,^K,<CR>,^Q,^X,ESC}
  getch(ch);     {ignore entrych and get our own}

  WHILE NOT (ch IN stop) DO
    BEGIN
      IF ch IN ltrs THEN
           IF position <= len THEN
             BEGIN
               entry[position] := ch;

               IF position = charcount +1 THEN {we're at string's growing end}
                   charcount := charcount + 1;

               position := position + 1;
               emit(ch);
             END
           ELSE
             emit(contrg) {beep}
      ELSE
         BEGIN
           CASE ch OF

              backspc, contrs: IF position >1 THEN {there's room to backspc}
                                  go(position, bak, 1);

              fwd, contrd    : IF position <= charcount THEN {there's room}
                                  go(position, fwr, 1);

              contra         :  BEGIN
                                  IF position > 1 THEN
                                        go(position, bak, 1);

                                  WHILE (position > 1)  AND
                                   ((entry[position] = ' ') OR
                                   (entry[position -1] <> ' ')) DO
                                        go(position, bak, 1)
                                END;

              contrf         :  BEGIN
                                  IF position <= charcount THEN
                                        go(position, fwr, 1);

                                  WHILE (position < charcount)  AND
                                     ((entry[position] = ' ') OR
                                        (entry[position-1] <> ' ')) DO
                                            go(position, fwr, 1);
                                END;

              del, contrg    :  BEGIN
                                  IF (ch = del) AND (position > 1) THEN
                                      go(position, bak, 1);

                                  IF (position <= charcount) AND
                                      (charcount > 0) THEN
                                   BEGIN
                                     entry[0] := CHR(charcount);{to del-copy}
                                     DELETE(entry, position, 1);

                                     IF position < charcount THEN
                                        BEGIN
                                          WRITE(COPY(entry, position,
                                           LENGTH(entry) - position + 1),' ',
                                           CHR(backspc));
                                          go(dummy, bak, LENGTH(entry) -
                                                position +1)
                                        END
                                     ELSE
                                           WRITE(' ', CHR(backspc));
                                     charcount := charcount -1
                                    END; {if}
                                END;

              tab             :  BEGIN
                                   IF position + 5 <= charcount THEN
                                       go(position, fwr, 5)
                                   ELSE
                                      emit(contrg); {beep!}
                                 END;

              nsert          :  BEGIN
                                 IF (charcount < len) AND
                                    (charcount > position) THEN
                                  BEGIN
                                    MOVERIGHT(entry[position],
                                     entry[position+1],charcount-position+1);
                                    entry[position] := ' ';
                                    charcount := SUCC(charcount);
                                    entry[0] := CHR(charcount);
                                    WRITE(COPY(entry, position,
                                           LENGTH(entry) - position + 1));
                                    go(dummy, bak, LENGTH(entry) -
                                           position + 1)
                                   END
                                  ELSE emit(contrg); {beep}
                                 END;


           END  {CASE}

        END; {ELSE}

      getch(ch);
   END; {while}

   IF ORD(ch)=24 THEN
      ch := 10             {convert ^X to return as ^J}
   ELSE IF ORD(ch)=5 THEN
      ch := 11;            {convert ^E to return as ^K}

   entry[0] := CHR(charcount); {set length of string}
   entrych := CHR(ch); {report out last character}
END; {console}

MODEND.

 ee‰eERSIONe
n Nà3 ■;
º