$R-,S-,D+,T+,F-,V+,B-

Unit FeltEdit;

Interface

Uses Crt;

CONST
  ToUpper  = 1;
  ToLower  = 2;
  NoInput  = 4;

TYPE
  CharSet = SET OF CHAR;
  CharSetPtr = ^CharSet;
  JustType = (LeftJ,CenterJ,RightJ);
  FeltStr = STRING[12];
  PromptStr = STRING[30];
  FeltStrArray = ARRAY [0..255] OF FeltStr;
  FeltType = (CharT, StrT, EnumT, BoolT, ByteT, IntT, WordT, LongT);
  EditPtr = ^EditRecord;
  EditRecord = RECORD
                 x, y, len, xpos : BYTE;
                 just : JustType;
                 prompt : PromptStr;
                 CASE ftype : FeltType OF
                   CharT : (CharP : ^CHAR;
                            oksetC : CharSetPtr;
                            modeC : BYTE);
                   StrT  : (StrP : ^STRING;
                            oksetS : CharSetPtr;
                            modeS : BYTE);
                   EnumT,
                   BoolT : (EnumP : ^BYTE;
                            EnumAntall : BYTE;
                            EnumStr : ^FeltStrArray);
                   ByteT : (ByteP : ^BYTE;
                            ByteMin, ByteMax : LongInt);
                   IntT  : (IntP  : ^INTEGER;
                            IntMin, IntMax   : LongInt);
                   WordT : (WordP : ^WORD;
                            WordMin, WordMax : LongInt);
                   LongT : (LongP : ^LongInt;
                            LongMin, LongMax : LongInt);
               END;

CONST
  Eantall : WORD = 0;
  BoolStr : ARRAY [0..1] OF FeltStr = ('FALSE','TRUE');
  NumericSet : CharSet = ['0'..'9','.','+','-'];
  InsertMode : BOOLEAN = FALSE;
  LastRecord : WORD = 0;
  FeltAttr : BYTE =  14;
  EditAttr : BYTE = 112;

CONST
  EditChar : CHAR = #255;

FUNCTION EditStr(VAR str: String; VAR xpos: BYTE;
                 len, mode : BYTE; ok : CharSetPtr;just : JustType): BOOLEAN;

FUNCTION Pad(st:String;len : INTEGER): String;

FUNCTION Tstr(l : LongInt; len : INTEGER): String;

PROCEDURE ShowOne(VAR e : EditRecord);

PROCEDURE ShowAll;

PROCEDURE EditOne(VAR e : EditRecord);

PROCEDURE EditARecord(n : WORD);

FUNCTION UpCase(ch : CHAR): CHAR;

FUNCTION LoCase(ch : CHAR): CHAR;

PROCEDURE MakeStr(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : String; okp : Pointer; mode : BYTE);

PROCEDURE MakeChar(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : CHAR; okp : Pointer; mode : BYTE);

PROCEDURE MakeEnum(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v ; antall : BYTE; VAR enum_ar);

PROCEDURE MakeBool(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : BOOLEAN);

PROCEDURE MakeByte(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : BYTE; min, max : BYTE);

PROCEDURE MakeInt(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : INTEGER; min, max : INTEGER);

PROCEDURE MakeWord(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : WORD; min, max : WORD);

PROCEDURE MakeLong(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : LongInt; min, max : LongInt);

PROCEDURE EditAllRecords;

PROCEDURE EditVar(VAR v);

(**************************************************************************)

Implementation

VAR
  ERec : ARRAY [0..255] OF EditPtr;

CONST No_Upper : String[3] = '';
      No_Lower : String[3] = '';

FUNCTION UpCase(ch : CHAR): CHAR;
VAR p : INTEGER;
BEGIN
  IF (ch >= 'a') AND (ch <= 'z') THEN ch := CHAR(BYTE(ch)-32)
  ELSE BEGIN
    p := Pos(ch,No_Lower);
    IF p > 0 THEN ch := No_Upper[p];
  END;
  UpCase := ch;
END;

FUNCTION LoCase(ch : CHAR): CHAR;
VAR p : INTEGER;
BEGIN
  IF (ch >= 'A') AND (ch <= 'Z') THEN ch := CHAR(BYTE(ch)+32)
  ELSE BEGIN
    p := Pos(ch,No_Upper);
    IF p > 0 THEN ch := No_Lower[p];
  END;
  LoCase := ch;
END;

PROCEDURE MakeStr(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : String; okp : Pointer; mode : BYTE);
BEGIN
  New(ERec[EAntall]);

  WITH ERec[Eantall]^ DO BEGIN
    x := px; y := py; len := plen; prompt := prstr;
    ftype := StrT; xpos := 1; just := pjust;
    StrP := Addr(v);
    oksetS := okp;
    modeS := mode;
  END;
  Inc(EAntall);
END;

PROCEDURE MakeChar(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : CHAR; okp : Pointer; mode : BYTE);
BEGIN
  New(ERec[EAntall]);

  WITH ERec[Eantall]^ DO BEGIN
    x := px; y := py; len := plen; prompt := prstr;
    ftype := CharT; xpos := 1; just := pjust;
    CharP := Addr(v);
    oksetC := okp;
    modeC := mode;
  END;
  Inc(EAntall);
END;

PROCEDURE MakeEnum(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v ; antall : BYTE; VAR enum_ar);
BEGIN
  New(ERec[EAntall]);

  WITH ERec[Eantall]^ DO BEGIN
    x := px; y := py; len := plen; prompt := prstr;
    ftype := EnumT; xpos := 1; just := pjust;
    EnumP := Addr(v);
    EnumAntall := antall;
    EnumStr := Addr(enum_ar);
  END;
  Inc(EAntall);
END;

PROCEDURE MakeBool(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : BOOLEAN);
BEGIN
  MakeEnum(px,py,plen,pjust,prstr,v,2,BoolStr);
END;

PROCEDURE MakeByte(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : BYTE; min, max : BYTE);
BEGIN
  New(ERec[EAntall]);

  WITH ERec[Eantall]^ DO BEGIN
    x := px; y := py; len := plen; prompt := prstr;
    ftype := ByteT; xpos := 1; just := pjust;
    ByteP := Addr(v);
    ByteMin := min;
    ByteMax := max;
  END;
  Inc(EAntall);
END;

PROCEDURE MakeInt(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : INTEGER; min, max : INTEGER);
BEGIN
  New(ERec[EAntall]);

  WITH ERec[Eantall]^ DO BEGIN
    x := px; y := py; len := plen; prompt := prstr;
    ftype := IntT; xpos := 1; just := pjust;
    IntP := Addr(v);
    IntMin := min;
    IntMax := max;
  END;
  Inc(EAntall);
END;

PROCEDURE MakeWord(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : WORD; min, max : WORD);
BEGIN
  New(ERec[EAntall]);

  WITH ERec[Eantall]^ DO BEGIN
    x := px; y := py; len := plen; prompt := prstr;
    ftype := WordT; xpos := 1; just := pjust;
    WordP := Addr(v);
    WordMin := min;
    WordMax := max;
  END;
  Inc(EAntall);
END;

PROCEDURE MakeLong(px, py, plen : BYTE; pjust : JustType;
                  prstr : PromptStr; VAR v : LongInt; min, max : LongInt);
BEGIN
  New(ERec[EAntall]);

  WITH ERec[Eantall]^ DO BEGIN
    x := px; y := py; len := plen; prompt := prstr;
    ftype := LongT; xpos := 1; just := pjust;
    LongP := Addr(v);
    LongMin := min;
    LongMax := max;
  END;
  Inc(EAntall);
END;

FUNCTION Pad(st:String;len : INTEGER): String;
BEGIN
  IF len < 0 THEN BEGIN
    len := Lo(-len);
    WHILE len > Length(st) DO st := ' ' + st;
  END
  ELSE IF len > 0 THEN BEGIN
    len := Lo(len);
    WHILE len > Length(st) DO st := st + ' ';
  END;
  Pad := st;
END;

(*
FUNCTION Justify(st : String; len : BYTE; just : JustType): String;
VAR front : BOOLEAN;
BEGIN
  CASE just OF
    LeftJ   : Justify := Pad(st,len);
    CenterJ : BEGIN
                front := FALSE;
                WHILE Length(st) < len DO BEGIN
                  IF front THEN st := ' ' + st
                  ELSE st := st + ' ';
                  front := NOT front;
                END;
                Justify := st;
              END;
    RightJ  : Justify := Pad(st,-len);
  END;
END;
*)

FUNCTION Tstr(l : LongInt; len : INTEGER): String;
VAR st : String;
BEGIN
  Str(l:len,st);
  Tstr := st;
END;

FUNCTION Refresh(len: BYTE; just : JustType; st : String): INTEGER;
VAR front, back, offs : INTEGER;
BEGIN
  front := len - Length(st); IF front < 0 THEN front := 0;
  CASE just OF
    LeftJ   : BEGIN back := front; front := 0; END;
    RightJ  : back := 0;
    CenterJ : BEGIN back := (front+1) DIV 2; Dec(front,back); END;
  END;
  IF front > 0 THEN Write('':front);
  Write(st);
  IF back > 0 THEN Write('':back);
  Refresh := front;
END;

PROCEDURE ShowOne(VAR e : EditRecord);
VAR i : WORD;
    l : LongInt;
    attr : BYTE;
BEGIN
  attr := TextAttr;
  GotoXY(e.x,e.y);
  Write(e.prompt);
  TextAttr := FeltAttr;
  CASE e.ftype OF
    CharT : IF Refresh(e.len,e.just,e.CharP^) = 0 THEN ;
    StrT  : IF Refresh(e.len,e.just,e.StrP^) = 0 THEN ;
    BoolT,
    EnumT : IF Refresh(e.len,e.just,e.EnumStr^[e.EnumP^]) = 0 THEN ;
    ByteT : IF Refresh(e.len,e.just,Tstr(e.ByteP^,1)) = 0 THEN ;
    IntT  : IF Refresh(e.len,e.just,Tstr(e.IntP^,1)) = 0 THEN ;
    WordT : IF Refresh(e.len,e.just,Tstr(e.WordP^,1)) = 0 THEN ;
    LongT : IF Refresh(e.len,e.just,Tstr(e.LongP^,1)) = 0 THEN ;
  END;
  TextAttr := attr;
END;

PROCEDURE ShowAll;
VAR i : WORD;
BEGIN
  FOR i := 0 TO Eantall-1 DO
    ShowOne(ERec[i]^);
END;

FUNCTION EditStr(VAR str: String; VAR xpos: BYTE;
                 len, mode : BYTE; ok : CharSetPtr;just : JustType): BOOLEAN;
VAR sx, sy : BYTE;
    st : String;
    cok, ferdig, change, dirty : BOOLEAN;

PROCEDURE Del1; BEGIN Delete(st,xpos,1); Dirty := TRUE; END;

PROCEDURE RefreshStr;
BEGIN
  GotoXY(sx,sy);
  GotoXY(sx+xpos+Refresh(len,just,st)-1,sy);
  Dirty := FALSE;
END;

BEGIN
  EditStr := FALSE;
  sx := WhereX; sy := WhereY;
  st := str;
  dirty := TRUE;
  ferdig := FALSE;
  IF xpos > Length(str)+1 THEN xpos := 1;
  REPEAT
    IF len <= 1 THEN xpos := 1;
    {IF Dirty THEN }RefreshStr;

    EditChar := ReadKey;
    CASE EditChar OF
        #0 : BEGIN
               EditChar := ReadKey;
               CASE Ord(EditChar) OF
                 68 : BEGIN
                        st := str; RefreshStr; Exit;
                      END;
                 71 : BEGIN xpos := 1; END;
                 72,
                 80 : ferdig := TRUE;
                 75 : IF xpos > 1 THEN Dec(xpos);
                 77 : IF xpos <= Length(st) THEN Inc(xpos);
                 79 : BEGIN xpos := Length(st)+1; END;
                 82 : InsertMode := NOT InsertMode;
                 83 : Del1;
                $75 : st[0] := Chr(xpos-1);    {Ctrl-End}
                 ELSE
                   Exit;
               END;
             END;
        ^H : IF xpos > 1 THEN BEGIN
               Dec(xpos);
               Del1;
             END;
        ^M : ferdig := TRUE;
        ^[ : BEGIN
               change := st <> str;
               IF change THEN BEGIN st := str; xpos := 1; END;
               RefreshStr;
               IF NOT change THEN Exit;
             END;
        #0..#255 :
         BEGIN
           IF mode AND ToUpper <> 0 THEN EditChar := UpCase(EditChar)
           ELSE IF mode AND ToLower <> 0 THEN EditChar := LoCase(EditChar);

           cok := mode AND NoInput = 0;
           IF (ok <> NIL) AND cok THEN cok := EditChar IN ok^;

           IF cok THEN BEGIN
             IF InsertMode THEN BEGIN
               IF Length(st) < len THEN BEGIN
                 Insert(EditChar,st,xpos);
                 Inc(xpos);
               END;
             END
             ELSE BEGIN
               IF xpos <= len THEN BEGIN
                 IF xpos > Length(st) THEN
                   st := st + EditChar
                 ELSE
                   st[xpos] := EditChar;
                 Inc(xpos);
               END;
             END;
             Dirty := TRUE;
           END;
         END;
    END;
  UNTIL ferdig;
  str := st;
  EditStr := TRUE;
END;

FUNCTION EditNum(VAR e : EditRecord): BOOLEAN;
VAR feil, sx, sy : WORD;
    st : String;
    num : LongInt;
BEGIN
  EditNum:= FALSE;
  sx := WhereX; sy := WhereY;
  CASE e.ftype OF
    ByteT : num := e.ByteP^;
    IntT  : num := e.IntP^;
    WordT : num := e.WordP^;
    LongT : num := e.LongP^;
  END;

  REPEAT
    GotoXY(sx,sy);
    Str(num:1,st);
    e.xpos := 1;
    IF NOT EditStr(st,e.xpos,e.len,0,Addr(NumericSet),e.just) THEN Exit;
    Val(st,num,feil);
    IF feil = 0 THEN BEGIN
      feil := 1;
      IF num < e.LongMin THEN
        num := e.LongMin
      ELSE IF num > e.LongMax THEN
        num := e.LongMax
      ELSE
        feil := 0;
    END;
  UNTIL feil = 0;
  EditNum := TRUE;
  CASE e.ftype OF
    ByteT : e.ByteP^ := num;
    IntT  : e.IntP^  := num;
    WordT : e.WordP^ := num;
    LongT : e.LongP^ := num;
  END;
END;

FUNCTION EditEnum(VAR en; max : WORD; len : BYTE; just : JustType;
         VAR enstr : FeltStrArray): BOOLEAN;
VAR e : BYTE ABSOLUTE en;
    b : BYTE;
    sx, sy : WORD;
BEGIN
  b := e;
  sx := WhereX; sy := WhereY;
  EditEnum := TRUE;

  REPEAT
    GotoXY(sx,sy);
    IF Refresh(len,just,enstr[b]) = 0 THEN ;
    GotoXY(sx,sy);
    EditChar := ReadKey;
    CASE EditChar OF
      #0 :
        BEGIN
          EditChar := ReadKey;
          CASE Ord(EditChar) OF
            68 : BEGIN EditEnum := FALSE; Exit; END;
            71 : b := 0;
            72,
            80 : BEGIN e := b; Exit; END;
            75 : b := Succ(b) MOD max;
            77 : b := Pred(b+max) MOD max;
            79 : b := max-1;
            ELSE BEGIN
              e := b;
              Exit;
            END;
          END;
        END;
      ^M : BEGIN e := b; Exit; END;
      ^[ : IF e <> b THEN b := e
           ELSE BEGIN EditEnum := FALSE; Exit; END;
      ' ': b := Succ(b) MOD max;
    END;
  UNTIL FALSE;
END;

PROCEDURE EditOne(VAR e : EditRecord);
VAR res : BOOLEAN;
    attr : BYTE;
    st : String;
BEGIN
  attr := TextAttr;
  WITH e DO BEGIN
    GotoXY(x,y); Write(prompt);
    TextAttr := EditAttr;
    CASE ftype OF
      CharT : BEGIN
                st := CharP^;
                res := EditStr(st,xpos,len,modeC,oksetC,just);
                IF res AND (Length(st) = 1) THEN CharP^ := st[1];
              END;
      StrT  : res := EditStr(StrP^,xpos,len,modeS,oksetS,just);
      BoolT,
      EnumT : res := EditEnum(EnumP^,EnumAntall,len,just,EnumStr^);
      ByteT,
      IntT,
      WordT,
      LongT : res := EditNum(e);
    END;
  END;
  TextAttr := attr;
  ShowOne(e);
END;

PROCEDURE EditVar(VAR v);
VAR i : INTEGER;
BEGIN
  FOR i := 0 TO EAntall-1 DO BEGIN
    IF Addr(v) = Erec[i]^.StrP THEN EditOne(Erec[i]^);
    Inc(i);
  END;
END;

PROCEDURE EditARecord(n : WORD);
BEGIN
  IF n < Eantall THEN EditOne(Erec[n]^);
END;

PROCEDURE EditAllRecords;
BEGIN
  REPEAT
    EditARecord(LastRecord);
    Case EditChar OF
      #80 : LastRecord := Succ(LastRecord) MOD Eantall;
      #72 : LastRecord := Pred(LastRecord + Eantall) MOD Eantall;
    ELSE
      Exit;
    END;
  UNTIL EditChar = #27;
END;

END.