Turbo Toolbox/Turbo_Toolbox.iso/1988/10_11/coninput.pas

Pascal/Delphi Source File | 1988-06-24 | 17KB | 506 lines

(* ------------------------------------------------------ *)
(*                     CONINPUT.PAS                       *)
(*   Komfortable Eingabe für alle Turbo-Pascal-Basistypen *)
(*                   über die Konsole                     *)
(*       (c) 1988 by Karsten Gieselmann  &  TOOLBOX       *)
(*                                                        *)
(* Die UNIT implementiert einen  vollständigen Satz von   *)
(* Routinen zur Eingabe von Variablen des Typs BYTE,      *)
(* SHORTINT, CHAR, INTEGER, WORD, LONGINT, REAL und       *)
(* STRING über die Konsole.  Zum Einlesen der Zeichen-    *)
(* ketten dient ein komfortabler Zeileneditor, der bei    *)
(* frei wählbarer Breite des Eingabefensters auch hori-   *)
(* zontales Scrolling erlaubt;  Fenstertechnik            *)
(* (Window-Befehl aus CRT) wird unterstützt. Leereingaben *)
(* und Abbruch einer Eingabe mittels <Esc> lassen den     *)
(* Inhalt einer einzulesenden Variablen (außer bei        *)
(* STRINGs) unverändert. Editierbefehle:                  *)
(*                                                        *)
(*  <Pfeil links> . Cursor ein Zeichen nach links         *)
(*  <Pfeil rechts>  Cursor ein Zeichen nach rechts        *)
(*  <Ctrl><links> . Cursor ein Wort nach links            *)
(*  <Ctrl><rechts>  Cursor ein Wort nach rechts           *)
(*  <Home> ........ Cursor an den Anfang der Eingabezeile *)
(*  <End> ......... Cursor an das Ende der Eingabezeile   *)
(*  <Del> ......... Zeichen unter Cursor löschen          *)
(*  <Backspace> ... Zeichen links vom Cursor löschen      *)
(*  <Ctrl><Home> .. löschen von Zeilenanfang bis Cursor   *)
(*  <Ctrl><End> ... löschen vom Cursor bis Zeilenende     *)
(*  <PgDn> ........ letzte Eingabe wiederholen            *)
(*  <Ins> ......... Einfügemodus an/aus                   *)
(*  <Esc> ......... Eingabe abbrechen (nicht übernehmen)  *)
(*  <Ctrl><Break> . laufendes Programm abbrechen          *)
(*  <Return> ...... Eingabe beenden (übernehmen)          *)
(*                                                        *)
(* ------------------------------------------------------ *)

UNIT ConInput;

INTERFACE USES Crt, Dos;

(* ----------------  Kontrollvariablen  ----------------- *)

VAR EditOld : BOOLEAN; (* bestimmt, ob der alte           *)
                       (* Variablenwert bei der Eingabe   *)
                       (* vorgegeben wird                 *)
VAR InsMode : BOOLEAN; (* bestimmt, ob bei Eingabebeginn  *)
                       (* Insert- oder Overwrite-Modus    *)
                       (* aktiv ist                       *)
VAR BufLen  : BYTE;    (* bestimmt die Maximallänge       *)
                       (* einer Eingabe                   *)
VAR EditSize: BYTE;    (* bestimmt die Breite des         *)
                       (* Editierfeldes                   *)
VAR Aborted : BOOLEAN; (* gibt an, ob die letzte Eingabe  *)
                       (* mit <Esc> oder <Break>          *)
                       (* abgebrochen wurde               *)
VAR Width   : BYTE;    (* bestimmt die Breite, mit der    *)
                       (* eine  REAL-Variable im  Gleit-  *)
                       (* kommaformat vorgegeben wird;    *)
                       (* beim Festkommadarstellung hat   *)
                       (* diese Größe keinen Einfluß auf  *)
                       (* das Anzeigeformat eines         *)
                       (* REAL-Wertes!                    *)

VAR Decimals: SHORTINT;
                       (* legt die Anzahl der Nachkomma-  *)
                       (* stellen bei der Eingabevorgabe  *)
                       (* für REAL-Variablen fest; Angabe *)
                       (* eines Wertes < 0 bewirkt        *)
                       (* Gleitkommadarstellung!          *)


(* ---------  Eingaberoutinen für die Basistypen  ------- *)

PROCEDURE ReadByte (VAR B : BYTE);
                         (* Einlesen einer BYTE-Variablen *)

PROCEDURE ReadShortInt (VAR S : SHORTINT);
                 (* Einlesen einer ShortInteger-Variablen *)

PROCEDURE ReadChar (VAR C :CHAR);
                    (* Einlesen einer Character-Variablen *)

PROCEDURE ReadInt (VAR I :INTEGER);
                      (* Einlesen einer INTEGER-Variablen *)

PROCEDURE ReadLongInt (VAR L :LONGINT);
                  (* Einlesen einer LongInteger-Variablen *)

PROCEDURE ReadWord (VAR W :WORD);
                         (* Einlesen einer WORD-Variablen *)

PROCEDURE ReadReal (VAR R :REAL);
                   (* Einlesen einer Gleitkomma-Variablen *)

PROCEDURE ReadString (VAR S : STRING);
                       (* Einlesen einer STRING-Variablen *)



IMPLEMENTATION


(* ------- Akustische Fehlermeldung durch Piepton ------- *)

PROCEDURE Beep (Frequency, Hold : WORD);
BEGIN
  Sound (Frequency); Delay (Hold); NoSound
END;

(* ---------------  der Zeileneditor -------------------- *)

PROCEDURE EditString (VAR EditStr : STRING; MaxLen : BYTE);

TYPE
  ShapeType = ARRAY [FALSE..TRUE] OF WORD;

CONST
  Monochrome = 7;
  MonoShape  : ShapeType = ($0C0D, $060D);
  ColorShape : ShapeType = ($0607, $0407);
  Letters    : SET OF CHAR = ['A'..'Z','a'..'z','0'..'9',
                              'ß','Ä','Ö','Ü','ä','ö','ü'];

VAR
  xpos,ypos,Deleted         : INTEGER;
  p,f,w,SaveShape,Command   : WORD;
  c                         : CHAR absolute Command;
  CursorShape               : WORD absolute $0040:$0060;
  VideoMode                 : BYTE absolute $0040:$0049;
  First,Quit,Display,Insert : BOOLEAN;
  s                         : STRING;
  Len                       : BYTE absolute s;
  Shape                     : ShapeType;

PROCEDURE SetCursorShape (Shape :WORD);
                                     (* Setzt Cursorgröße *)
  INLINE ($59/$B4/$01/$CD/$10);

FUNCTION GetKey :WORD;
                   (* wartet auf Taste und holt Scan-Code *)
  INLINE ($31/$C0/$CD/$16);

FUNCTION MinI (a,b :INTEGER) :INTEGER;
                           (* liefert Minimum von a und b *)
  INLINE ($58/$5B/$39/$D8/$7E/$02/$89/$D8);

PROCEDURE Cursor (Switch : BOOLEAN);
                                (* schaltet Cursor an/aus *)
BEGIN
  CASE Switch OF
    TRUE:  SetCursorShape (CursorShape AND $EFFF);
    FALSE: SetCursorShape (CursorShape  OR $1000);
  END;
END;

FUNCTION StringOf (Ch : CHAR; Num : INTEGER) : STRING;
                                       (* String aus "Ch" *)
VAR s : STRING;
BEGIN
  IF Num < 0 THEN Num:=0;
  s[0] := Chr (Num);
  FillChar (s[1], Num, Ch);
  StringOf := s;
END;

PROCEDURE PosCursor (p : WORD);
                   (* setzt Cursor auf Stringposition "p" *)
BEGIN
  GotoXY(Succ(Pred(xpos+p-f) MOD w), ypos
                                  + (Pred(xpos+p-f) DIV w));
END;

PROCEDURE Advance (StepForward : BOOLEAN);
                     (* bewegt den Cursor im STRING um    *)
                     (* eine Position nach links / rechts *)
                     (* und berechnet gegebenfalls die    *)
                     (* neue Lage des Strings im          *)
                     (* Editierfenster                    *)
BEGIN
  IF StepForward THEN BEGIN
    IF (p > f+EditSize-2) THEN Inc(f) ELSE Display:=FALSE;
    Inc(p);
  END ELSE BEGIN
    IF p = f THEN Dec(f) ELSE Display:=FALSE;
    Dec (p);
  END;
END;

BEGIN                                       (* EditString *)
  xpos       := WhereX;           (* Home-Position merken *)
  ypos       := WhereY;
  w          := Lo(WindMax) - Lo(WindMin) + 1;
                                 (* nutzbare Schirmbreite *)
  s          := EditStr;
  p          := 1;           (* Cursor-Position im STRING *)
  f          := 1;           (* STRING-Index des ersten   *)
                             (* angezeigten Zeichens      *)
  Deleted    := 0;
  First      := TRUE;
  Quit       := FALSE;       (* Flagbyte für Eingabe      *)
                             (* abgeschlossen             *)
  Aborted    := FALSE;
  Insert     := InsMode;     (* Flagbyte für Einfügemodus *)
                             (* an/aus                    *)
  Display    := TRUE;
  SaveShape  := CursorShape;
  If VideoMode = Monochrome THEN
    Shape := MonoShape
  ELSE
    Shape := ColorShape;
  SetCursorShape (Shape[Insert]);
  REPEAT
    IF p > Len THEN IF Deleted=0 THEN Deleted:=1;
    IF Display THEN BEGIN
      Cursor (FALSE);
      GotoXY (xpos,ypos);
      Write (Copy(s,f,EditSize) + StringOf(' ',Deleted));
      Cursor (TRUE);
    END;
    Display := TRUE;
    Deleted := 0;
    PosCursor (p);
    Command := GetKey;
    CASE Command OF

      $4B00:                                   (* <Left>  *)
        IF p>1 THEN Advance (FALSE);

      $4D00:                                   (* <Right> *)
        IF p<=Len THEN Advance (TRUE);

      $7300:                              (* <Ctrl><Left> *)
        BEGIN
          WHILE (p>1) AND NOT (s[p-1] IN Letters) DO
            Advance (FALSE);
          WHILE (p>1) AND     (s[p-1] IN Letters) DO
            Advance (FALSE);
          Display := TRUE;
        END;

      $7400:                             (* <Ctrl><Right> *)
        BEGIN
          WHILE (p <= Len) AND     (s[p] IN Letters) DO
            Advance (TRUE);
          WHILE (p <= Len) AND NOT (s[p] IN Letters) DO
            Advance (TRUE);
          Display := TRUE;
        END;

      $4700:                                    (* <Home> *)
        BEGIN
          p:=1; f:=1;
        END;

      $4F00:                                     (* <End> *)
        BEGIN
          p := Len+1;
          IF p > EditSize THEN
             f := Succ (p-EditSize)
          ELSE
             f := 1;
        END;

      $5300:                                     (* <Del> *)
        IF p <= Len THEN BEGIN
          IF Len > EditSize THEN
            IF (f <> 1) AND (p-f <> EditSize) THEN
              Dec (f)
            ELSE
          ELSE
            Deleted := 1;
          Delete (s, p, 1);
        END;

      $0E08:                                   (* <BkSpc> *)
        IF p > 1 THEN BEGIN
          IF Len >= EditSize THEN
            IF f <> 1 THEN
              Dec (f)
            ELSE IF Len = EditSize THEN
              Deleted := 1
            ELSE
          ELSE
            Deleted := 1;
          Dec (p);
          Delete (s, p, 1);
        END;

      $7700:                              (* <Ctrl><Home> *)
        BEGIN
          Deleted := Pred(MinI(EditSize,Len))
                     - INTEGER(Len-p);
          IF p = Len+1 THEN
            s := ''
          ELSE
            s := Copy (s, p, Len-p+1);
          p:=1; f:=1;
        END;

      $7500:                               (* <Ctrl><End> *)
        BEGIN
          IF p > EditSize THEN
            f := Succ (p-EditSize)
          ELSE
            BEGIN
              Deleted := MinI(EditSize,Len) - Pred(p);
              f := 1;
            END;
          Len := p-1;
        END;

      $5200:                                     (* <Ins> *)
        BEGIN
          Display := FALSE;
          Insert := NOT Insert;
          SetCursorShape (Shape[Insert]);
        END;

      $5100, $011B, $0000:
                          (* <PgDn>, <Esc>, <Ctrl><Break> *)
        BEGIN
          Deleted := Len;
          s := EditStr;
          Deleted := MinI (EditSize-Len, Deleted-Len);
          p:=1; f:=1;
          First := TRUE;
          Aborted := (Command=$0000) OR (Command=$011B);
        END;

      $1C0D:                 (* <Return>, Eingabe beenden *)
        Quit := TRUE;

      ELSE
        IF Ord(c) >= 32 THEN    (* Eingabe eines Zeichens *)
          IF First THEN BEGIN
            Deleted := Pred (MinI (EditSize,Len));
            s := c;
            p := 2
          END ELSE BEGIN
            IF p = Len+1 THEN          (* hinten anfügen? *)
              IF Len < MaxLen THEN BEGIN
                s := s + c;
                Advance (TRUE);
              END ELSE           (* Maximallänge erreicht *)
                Beep (3200,50)
              ELSE
                IF NOT Insert THEN BEGIN
                  s[p] := c;
                          (* Cursor-Zeichen überschreiben *)
                  Advance (TRUE);
                END ELSE
                  IF Len < MaxLen THEN BEGIN
                                              (* einfügen *)
                    s := Copy (s,1,p-1) + c
                         + Copy (s,p,Len);
                    Advance (TRUE);
                  END ELSE       (* Maximallänge erreicht *)
                    Beep (3200,50);
                  Display := TRUE;
                  END
          END;
    IF Command <> $5100 THEN First:=FALSE
  UNTIL Quit OR Aborted;
  EditStr := s;
  f := 1;
  GotoXY (xpos,ypos);
  Write (Copy(s,f,EditSize) + StringOf(' ',Deleted));
  PosCursor (MinI (EditSize,Len+1));
  SetCursorShape (SaveShape);
END;


(* --------  Eingaberoutinen für die Basistypen  -------- *)

TYPE
  Type_ = (BYTE_, SHORTINT_, INTEGER_, WORD_,
           LONGINT_, REAL_);

PROCEDURE Read (p :POINTER; t :Type_);
                          (* liest die bei "p^" stehenden *)
                          (* Variablen vom Typ "t" ein    *)
VAR
  St,Old   : STRING;
  ErrorPos : INTEGER;
  x,y      : BYTE;
  New      : RECORD CASE Type_ OF
               0: (B : BYTE);
               1: (S : SHORTINT);
               2: (I : INTEGER);
               3: (W : WORD);
               4: (L : LONGINT);
               5: (R : REAL);
             END;

BEGIN
  x := WhereX;
  y := WhereY;
  WITH New DO BEGIN
    CASE t OF
      BYTE_     : BEGIN  B := BYTE(p^);      Str(B,Old) END;
      SHORTINT_ : BEGIN  S := SHORTINT(p^);  Str(S,Old) END;
      INTEGER_  : BEGIN  I := INTEGER(p^);   Str(I,Old) END;
      WORD_     : BEGIN  W := WORD(p^);      Str(W,Old) END;
      LONGINT_  : BEGIN  L := LONGINT(p^);   Str(L,Old) END;
      ELSE BEGIN
        R := REAL (p^);
        IF Decimals > 0 THEN          (* Fixkomma-Format? *)
          Str (R:0:Decimals, Old)
        ELSE BEGIN                   (* Gleitkomma-Format *)
          Str (R,Old);
          IF Length(Old) < Width THEN
            Width := Length (Old);
          Str (R:Width+1, Old);
        END;
        WHILE Old[1]=' ' DO Delete (Old,1,1);
                                (* Leerzeichen abstreifen *)
      END
    END;
    IF EditOld THEN St:=Old ELSE St:='';
    REPEAT
      GotoXY (x,y);
      EditString (St, BufLen);
      IF St='' THEN St:=Old;
      IF t = REAL_ THEN
        Val (St, R, ErrorPos)
      ELSE BEGIN
        Val (St, L, ErrorPos);
        IF ErrorPos = 0 THEN
          CASE t OF
            BYTE_    : IF (L <     0) OR (L >   255) THEN
                         ErrorPos:=1;
            SHORTINT_: IF (L <  -128) OR (L >   127) THEN
                         ErrorPos:=1;
            INTEGER_ : IF (L <-32768) OR (L > 32767) THEN
                         ErrorPos:=1;
            WORD_    : IF (L <     0) OR (L > 65535) THEN
                         ErrorPos:=1;
          END;
      END;
      IF ErrorPos > 0 THEN Beep(500,100);
    UNTIL ErrorPos = 0;
    CASE t OF
      BYTE_    : BYTE(p^)     := B;
      SHORTINT_: SHORTINT(p^) := S;
      INTEGER_ : INTEGER(p^)  := I;
      WORD_    : WORD(p^)     := W;
      LONGINT_ : LONGINT(p^)  := L;
      REAL_    : REAL(p^)     := R
      END
    END;
END;

PROCEDURE ReadByte (VAR B : BYTE);
BEGIN
  Read (@B, BYTE_)
END;

PROCEDURE ReadShortInt (VAR S : SHORTINT);
BEGIN
  Read (@S, SHORTINT_)
END;

PROCEDURE ReadChar (VAR C : CHAR);
VAR
  S : STRING;
BEGIN
  EditString (S, 1);
  C := S[1];
END;

PROCEDURE ReadInt (VAR I : INTEGER);
BEGIN
  Read (@I, INTEGER_)
END;

PROCEDURE ReadLongInt (VAR L :LONGINT);
BEGIN
  Read (@L, LONGINT_)
END;

PROCEDURE ReadWord (VAR W : WORD);
BEGIN
  Read (@W, WORD_)
END;

PROCEDURE ReadReal (VAR R : REAL);
BEGIN
  Read (@R, REAL_)
END;

PROCEDURE ReadString (VAR S : STRING);
BEGIN
  EditString (S, BufLen);
END;

BEGIN
  EditOld  := TRUE;          (* Vorgaben standardmäßig an *)
  InsMode  := TRUE;      (* Einfügemodus standardmäßig an *)
  Width    := 255;
  Decimals :=  20;  (* Fließkomma-Format bei REAL-Eingabe *)
  BufLen   := 255;  (* Voreinstellung: maximale Länge     *)
  EditSize := 255;
  Aborted  := FALSE;
END.
(* ------------------------------------------------------ *)
(*                 Ende von CONINPUT.PAS                  *)