(* ------------------------- FORM2.INC --------------------------------------- *)
(* Version 2.4  31.12.2021                                                     *)
(*                                                                             *)
(* Abhaengigkeiten: INPUT2.INC, BOX.INC                                        *)
(*                                                                             *)
(*  Include-File fuer Formulare auf der JOYCE unter Turbo Pascal.              *)
(*  Es sind enthalten:                                                         *)
(*     SetMessageLine               -> Legt die Position der Infozeile fest    *)
(*     WriteCharPtrString           -> Schreibt einen dynamischen String       *)
(*     FormCancelled                -> Formular ueber Cancel Button beendet?   *)
(*     ProcessForm                  -> Anzeige und Steuerung des Formulars     *)
(*     GetFormElement               -> Formularelement holen                   *)
(*     GetField                     -> Feld holen                              *)
(*     GetButton                    -> Button holen                            *)
(*     IsActivated                  -> Ist der Button aktiviert worden?        *)
(*     AddField                     -> Feld zum Formular hinzufuegen           *)
(*     AddButton                    -> Button zum Formular hinzufuegen         *)
(*     NewAndLinkWithPrevElement    -> Neues Element und mit vorigem verbinden *)
(*     InitForm                     -> Formular initialisieren                 *)
(*     SetFieldText                 -> Text eines Feldes setzen                *)
(* --------------------------------------------------------------------------- *)

(*$V-*)

type
  FormElementType = (FEField, FEButton);
  ButtonType = (Ok, Cancel, Other);
  FormElementPtr = ^FormElement;
  FieldPtr = ^Field;
  ButtonPtr = ^Button;
  FormElement = record
    next: FormElementPtr;
    prev: FormElementPtr;
    case elementType: FormElementType of
      FEField:  (field:  FieldPtr);
      FEButton: (button: ButtonPtr);
  end;
  Field = record
    kind: FieldType;
    fieldLength: Integer;
    caption: CharPtr;
    xCaption, yCaption: Integer;
    xInput, yInput: Integer;
    txt: CharPtr;
    mandatory: Boolean;
  end;
  Button = record
    kind: ButtonType;
    x, y: Integer;
    width: Integer;
    caption: CharPtr;
    activated: Boolean;
  end;
  
var
  form_FirstElement: FormElementPtr;
  form_HeapTop: ^Integer; 
  form_currElement, form_prevElement: FormElementPtr;
  form_messageLine: Byte;


(* User defined procedure in the main application. *)
procedure InitFormElements(formIdx: Byte); forward;


(* Sets the position of the message line (Y coordinate). *)
procedure SetMessageLine(line: Byte);
begin
  form_messageLine := line;
end; (* SetMessageLine *)


(* Writes a dynamically allocated String. *)
procedure WriteCharPtrString(cp: CharPtr);
var len, i: Byte;
begin
  len := ord(cp^);
  for i := 1 to len do begin
    cp := ptr(succ(ord(cp))); (* move pointer to next address *)
    Write(cp^);
  end;
end; (* WriteCharPtrString *)


(* Was form processing finished by a cancel button? *)
function FormCancelled: Boolean;
var currentElement: FormElementPtr;
    but: ButtonPtr;
    found: Boolean;
begin
  currentElement := form_FirstElement;
  found := false;
  
  repeat
    if currentElement^.elementType = FEButton then begin
      but := currentElement^.button;
      with but^ do begin
        if activated and (kind = Cancel) then begin
          found := true;
        end;
      end;
    end;
    if not found then
      currentElement := currentElement^.next;
  until (currentElement = nil) or found;
  
  FormCancelled := found;
end; (* FormCancelled *)


(* Processes the form. *)
procedure ProcessForm;
var i, j: Integer;
    currentElement: FormElementPtr;
    finished: Boolean;
  
  (* Draws a button. *)
  procedure drawButton(x, y, width: Integer; caption: CharPtr);
  var len, i: Byte;
  begin
    DrawBox(x, y, width, 3);
    len := ord(caption^);
    GotoXY(x + (width - len) div 2, y + 1);
    WriteCharPtrString(caption);
  end; (* drawButton *)
  
  
  (* Writes the button's caption centered inside the button frame. *)
  procedure writeButtonCaption(button: ButtonPtr);
  var len, i:  Byte;
  begin
    with button^ do begin
      GotoXY(succ(x), succ(y));
      for i := 2 to width - 1 do Write(' ');
      len := ord(caption^);
      GotoXY(x + (width - len) div 2, y + 1);
      WriteCharPtrString(caption);
    end;
  end;
  

  (* Handles a button. When entered, the button caption gets reversed; when a
     finish key is pressed, the caption is switched to normal again.
     The Return key activates the button, i.e. the activated property is set
     to true.
     Returns the key pressed.
  *)
  function handleButton(button: ButtonPtr): Char;
  var ch: Char;
  begin
    LowVideo; (* inverse video *)
    Write(#27,'f'); (* hide cursor *)
    writeButtonCaption(button);
    repeat
      ch := GetKey;
    until IsFieldInputFinished(ch) or (ch = CH_LEFT) or (ch = CH_RIGHT);
    if ch = CH_RETURN then button^.activated := true;
    NormVideo;
    writeButtonCaption(button);
    Write(#27,'e'); (* show cursor *)

    handleButton := ch;
  end; (* handleButton *)
  
  
  (* Check if all mandatory fields are filled out.
     Returns true if all mandatory fields are filled out, false if at least one
     mandatory field is not filled out.
  *)
  function checkMandatoryFields: Boolean;
  var finished: Boolean;
      result: Boolean;
  begin
    currentElement := form_FirstElement;
    finished := false;
    repeat
      with currentElement^ do begin
        if elementType = FEField then begin
          with field^ do begin
            if mandatory then begin
              if txt^ = #0 then begin
                finished := true;
                GotoXY(1, form_messageLine);
                Write('"');
                WriteCharPtrString(caption);
                Write('" ist ein Pflichtfeld: bitte ausf}llen.');
                GotoXY(xInput, yInput);
              end;
            end;
          end;
        end;
      end;
      if not finished then
        currentElement := currentElement^.next;
    until (currentElement = nil) or finished;
    
    checkMandatoryFields := not finished;
  end; (* checkMandatoryFields *)
  
  
  (* Clears the message line. *)
  procedure clearMessageLine;
  begin
    GotoXY(1, form_MessageLine);
    ClrEol;
  end; (* clearMessageLine *)
  
  
  (* Displays the form. *)
  procedure displayForm;
  begin
    currentElement := form_FirstElement;
    finished := false;
    repeat
      with currentElement^ do begin
        case elementType of
          FEField: with field^ do begin
              GotoXY(xCaption, yCaption);
              if mandatory then Write('*');
              WriteCharPtrString(caption);
              Write(':');
              GotoXY(xInput, yInput);
              WriteCharPtrString(txt);
              for j := ord(txt^) + 1 to fieldLength do Write('_');
            end;
          FEButton: with button^ do begin
              drawButton(x, y, width, caption);
            end;
        end; (* case *)
        if next = nil then finished := true;
        currentElement := next;
      end;
    until finished;
  end; (* displayForm *)

begin
  if form_FirstElement <> nil then begin
    displayForm;
    
    (* Process the form. *)
    currentElement := form_FirstElement;
    finished := false;
    repeat
      with currentElement^ do begin
        case elementType of
          FEField: with field^ do begin
              InputString(txt, fieldLength, xInput, yInput, kind);
            end;
          FEButton: with button^ do begin
              input_lastChar := handleButton(button);
              if input_lastChar = CH_RETURN then finished := true;
            end;
        end; (* case *)
      end;
      clearMessageLine;
      if finished then begin
        if FormCancelled then
          finished := true
        else
          finished := checkMandatoryFields;
      end else begin
        if input_lastChar = CH_UP then begin (* Up *)
          if currentElement <> form_FirstElement then begin
            currentElement := currentElement^.prev;
          end;
        end else begin (* Enter, Tab, or Down *)
          if currentElement^.elementType = FEButton then begin
            case input_lastChar of
              CH_RETURN: currentElement := nil;
              CH_LEFT:   if currentElement^.prev <> nil then
                           currentElement := currentElement^.prev;
              else currentElement := currentElement^.next;
            end; (* case *)
          end else
            currentElement := currentElement^.next;
        end;
      end;
      if currentElement = nil then currentElement := form_FirstElement;
    until finished;
  end;
end; (* ProcessForm *)


(* Gets the nth form element from the element list.
   Returns a pointer to element n if found or nil if not found. *)
function GetFormElement(n: Byte): FormElementPtr;
var currentElement: FormElementPtr;
    count: Byte;
begin
  currentElement := form_FirstElement;
  count := 1;
  
  while (currentElement <> nil) and (n <> count) do begin
    count := succ(count);
    currentElement := currentElement^.next;
  end;
  
  GetFormElement := currentElement;
end; (* GetFormElement *)


(* Gets the nth field from the element list.
   Returns a pointer to the field n if found or nil if not found. *)
function GetField(n: Byte): FieldPtr;
var currentElement: FormElementPtr;
    fieldsFound: Byte;
    found: Boolean;
    result: FieldPtr;
begin
  currentElement := form_FirstElement;
  fieldsFound := 0;
  found := false;
  
  repeat
    if currentElement^.elementType = FEField then begin
      fieldsFound := succ(fieldsFound);
      if fieldsFound = n then begin
        found := true;
      end;
    end;
    if not found then
      currentElement := currentElement^.next;
  until (currentElement = nil) or found;
  
  if currentElement = nil then
    result := nil
  else
    result := currentElement^.field;
  
  GetField := result;
end; (* GetField *)


(* Gets the nth button from the element list.
   Returns a pointer to the button n if found or nil if not found. *)
function GetButton(n: Byte): ButtonPtr;
var currentElement: FormElementPtr;
    buttonsFound: Byte;
    found: Boolean;
    result: ButtonPtr;
begin
  currentElement := form_FirstElement;
  buttonsFound := 0;
  found := false;
  
  repeat
    if currentElement^.elementType = FEButton then begin
      buttonsFound := succ(buttonsFound);
      if buttonsFound = n then begin
        found := true;
      end;
    end;
    if not found then
      currentElement := currentElement^.next;
  until (currentElement = nil) or found;
  
  if currentElement = nil then
    result := nil
  else
    result := currentElement^.button;
  
  GetButton := result;
end; (* GetButton *)


(* Is the button activated? *)
function IsActivated(n: Byte): Boolean;
var button: ButtonPtr;
    result: Boolean;
begin
  button := GetButton(n);
  if button = nil then
    result := false
  else
    result := button^.activated;
  IsActivated := result;
end; (* IsActivated *)


(* Adds a field to the form. *)
procedure AddField(pKind: FieldType;
  pFieldLength: Integer; pCaption: WorkString;
  pXCaption, pYCaption: Integer;
  pXInput, pYInput: Integer;
  pMandatory: Boolean);
begin
  with form_currElement^ do begin
    elementType := FEField;
    prev := form_prevElement;
    next := nil;
    New(field);
    with field^ do begin
      kind := pKind;
      GetMem(txt, pFieldLength + 1);
      txt^ := #0; (* initial length is 0 (empty String) *)
      fieldlength := pFieldLength;
      GetMem(caption, Length(pCaption) + 1);
      StringToCharPtr(pCaption, caption);
      xCaption  := pXCaption;
      yCaption  := pYCaption;
      xInput    := pXInput;
      yInput    := pYInput;
      mandatory := pMandatory;
    end;
  end;
end; (* AddField *)


(* Adds a button to the form. *)
procedure AddButton(pKind: ButtonType; pX, pY, pWidth: Integer; pCaption: WorkString);
begin
  with form_currElement^ do begin
    elementType := FEButton;
    prev := form_prevElement;
    next := nil;
    New(button);
    with button^ do begin
      kind := pKind;
      x := pX;
      y := pY;
      width := pWidth;
      GetMem(caption, Length(pCaption) + 1);
      StringToCharPtr(pCaption, caption);
      activated := false;
    end;
  end;
end; (* AddButton *)


(* Creates a new form element and links it with the previous one. *)
procedure NewAndLinkWithPrevElement;
begin
  form_prevElement := form_currElement;
  New(form_currElement);
  form_prevElement^.next := form_currElement;
end; (* NewAndLinkWithPrevElement *)


(* Initializes the form. Calls InitFormElements, a procedure to be
   implemented in the main application. *)
procedure InitForm(formIdx: Byte);
begin
  New(form_FirstElement);
  form_currElement := form_FirstElement;
  form_prevElement := nil;
  InitFormElements(formIdx);
end; (* InitForm *)


(* Sets the text of field n. *)
procedure SetFieldText(n: Byte; var s: WorkString);
var fld: FieldPtr;
begin
  fld := GetField(n);
  with fld^ do begin
    txt^ := chr(Length(s));
    StringToCharPtr(s, txt);
  end;
end;

(* ------------------ Ende von FORM2.INC ----------------------- *)
