(***************************************************************************

     $RCSfile: StringDialog.mod $
  Description: Defines and implements a simple string dialog.

   Created by: fjc (Frank Copeland)
    $Revision: 1.3 $
      $Author: fjc $
        $Date: 1994/05/12 21:26:09 $

  Copyright © 1994, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

  Log entries are at the end of the file.

***************************************************************************)

MODULE StringDialog;

(* $P- allow non-portable code *)
(* $L+ use absolute long addressing for global variables *)

IMPORT
  T := Types, G := Graphics, I := Intuition, IU := IntuiUtil, Events,
  ISup := IntuiSup, ISE := ISupEvents, U := Util, SYS := SYSTEM;

CONST

  NumGadgets = 3;
  NumTexts   = 1;

TYPE

  StrDlg * = POINTER TO StrDlgRec;
  StrDlgRec = RECORD (ISE.ISupDialogRec)
    g0         : ISup.InputData;
    g1         : ISup.ButtonData;
    g2         : ISup.ButtonData;
    gDataEnd   : LONGINT;
    t0         : ISup.TextData;
    tDataEnd   : INTEGER;
    textBuffer : T.STRPTR;
    result     : BOOLEAN;
  END; (* StrDlgRec *)

  StrDlgPort = POINTER TO StrDlgPortRec;
  StrDlgPortRec = RECORD (ISE.ISupPortRec)
    strDlg : StrDlg;
  END;

CONST

  AcceptText = "_Accept";
  CancelText = "_Cancel";

  StringGadgetID = 0;
  AcceptButtonID = 1;
  CancelButtonID = 2;

(* ----- Support procedures ----- *)


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE CalcTextBox
  ( renderInfo : ISup.RenderInfoPtr;
    text       : ARRAY OF CHAR;
    font       : G.TextAttrPtr;
    VAR width, height : INTEGER );

BEGIN (* CalcTextBox *)
  IF font = NIL THEN font := SYS.ADR(renderInfo.riTextAttr) END;
  IU.CalcTextBox (text, font, width, height);
END CalcTextBox;


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE CalcTextButtonBox
  ( renderInfo    : ISup.RenderInfoPtr;
    text          : ARRAY OF CHAR;
    font          : G.TextAttrPtr;
  VAR width, height : INTEGER );

  CONST
    extraWidth  = 10;
    extraHeight =  6;
  VAR
    tempWidth, tempHeight : INTEGER;

BEGIN (* CalcTextButtonBox *)
  CalcTextBox (renderInfo, text, font, tempWidth, tempHeight);
  INC (tempWidth, extraWidth);
  INC (tempHeight, extraHeight);
  IF tempWidth > width THEN
    width := tempWidth;
  END; (* IF *)
  IF tempHeight > height THEN
    height := tempHeight;
  END; (* IF *)
END CalcTextButtonBox;


(*------------------------------------*)
PROCEDURE CalcInputGadgetBox
  ( renderInfo        : ISup.RenderInfoPtr;
    visibleChars      : INTEGER;
    VAR width, height : INTEGER );

  CONST
    extraWidth  = 12;
    extraHeight = 6;
  VAR
    tempWidth, tempHeight : INTEGER;

BEGIN (* CalcInputGadgetBox *)
  CalcTextBox (renderInfo, "0\0", NIL, tempWidth, tempHeight);
  tempWidth := tempWidth * visibleChars;
  INC (tempWidth, extraWidth);
  INC (tempHeight, extraHeight);
  IF tempWidth > width THEN
    width := tempWidth;
  END; (* IF *)
  IF tempHeight > height THEN
    height := tempHeight;
  END; (* IF *)
END CalcInputGadgetBox;


(*------------------------------------*)
PROCEDURE (sdp : StrDlgPort) HandleISup
  (msg : I.IntuiMessagePtr) : INTEGER;

  VAR result : INTEGER;

BEGIN (* HandleISup *)
  CASE msg.Code OF
    StringGadgetID :
      sdp.strDlg.textBuffer := msg.IAddress;
      result := Events.Continue
    |
    AcceptButtonID :
      sdp.strDlg.result := (sdp.strDlg.textBuffer # NIL);
      result := Events.Stop
    |
    CancelButtonID :
      sdp.strDlg.result := FALSE;
      result := Events.Stop
    |
  END;
  ISup.Base.IReplyMsg (msg);
  RETURN result;
END HandleISup;


(*------------------------------------------------------------------------*)
(* Exported procedures *)

(*------------------------------------*)
PROCEDURE InitStrDlg *
  ( dialog        : StrDlg;
    renderInfo    : ISup.RenderInfoPtr;
    title, prompt : ARRAY OF CHAR;
    visibleChars,
    maxChars      : INTEGER );

  CONST
    HSpace = 8; VSpace = 4;

  VAR
    textWidth, textHeight, stringWidth, stringHeight, buttonWidth,
    buttonHeight, dialogWidth, dialogHeight
      : INTEGER;
    sdp : StrDlgPort;

  (*------------------------------------*)
  PROCEDURE CalcStrDlg ();

  BEGIN (* CalcStrDlg *)
    CalcTextBox (renderInfo, prompt, NIL, textWidth, textHeight);
    stringWidth := 0; stringHeight := 0;
    CalcInputGadgetBox (
      renderInfo, visibleChars, stringWidth, stringHeight);
    buttonWidth := 0; buttonHeight := 0;
    CalcTextButtonBox (
      renderInfo, AcceptText, NIL, buttonWidth, buttonHeight);
    CalcTextButtonBox (
      renderInfo, CancelText, NIL, buttonWidth, buttonHeight);
    dialogWidth :=
      U.MaxInt
        ( U.MaxInt (textWidth, stringWidth), (buttonWidth * 2) + HSpace )
      + (2 * HSpace);
    dialogHeight := textHeight + stringHeight + buttonHeight + (4 * VSpace);
  END CalcStrDlg;

  (*------------------------------------*)
  PROCEDURE InitTexts (dialog : StrDlg);

  BEGIN (* InitTexts *)
    dialog.t0.tdType     := ISup.tdtText;
    dialog.t0.tdFlags    := {ISup.tdfCenter};
    dialog.t0.tdLeftEdge := 0;
    dialog.t0.tdTopEdge  := VSpace;
    dialog.t0.tdText     := SYS.ADR (prompt);
    dialog.t0.tdTextAttr := NIL;
    dialog.tDataEnd      := ISup.DataEnd;
  END InitTexts;

  (*------------------------------------*)
  PROCEDURE InitGadgets (dialog : StrDlg);

    CONST
      StringGadgetFlags = {ISup.gdfMovePointer};
      ButtonFlags = {ISup.gdfHotKey};

    VAR halfWidth : INTEGER;

  BEGIN (* InitGadgets *)
    dialog.g0.gdType := ISup.gdtString;
    dialog.g0.gdFlags := StringGadgetFlags;
    dialog.g0.gdLeftEdge := (dialogWidth - stringWidth) DIV 2;
    dialog.g0.gdTopEdge := textHeight + (2 * VSpace);
    dialog.g0.gdWidth := stringWidth;
    dialog.g0.gdHeight := stringHeight;
    dialog.g0.gdText := NIL;
    dialog.g0.gdTextAttr := NIL;
    dialog.g0.gdInputLen := maxChars;
    dialog.g0.gdInputActivateNext := 0;
    dialog.g0.gdInputActivatePrev := 0;
    dialog.g0.gdInputDefault := NIL;

    halfWidth := dialogWidth DIV 2;

    dialog.g1.gdType := ISup.gdtButton;
    dialog.g1.gdFlags := ButtonFlags;
    dialog.g1.gdLeftEdge := (halfWidth - buttonWidth) DIV 2;
    dialog.g1.gdTopEdge := dialog.g0.gdTopEdge + stringHeight + VSpace;
    dialog.g1.gdWidth := buttonWidth;
    dialog.g1.gdHeight := buttonHeight;
    dialog.g1.gdText := SYS.ADR(AcceptText);
    dialog.g1.gdTextAttr := NIL;
    dialog.g1.gdButtonSelected := 0;
    dialog.g1.gdButtonNormalRender := NIL;
    dialog.g1.gdButtonSelectRender := NIL;

    dialog.g2.gdType := ISup.gdtButton;
    dialog.g2.gdFlags := ButtonFlags;
    dialog.g2.gdLeftEdge := dialog.g1.gdLeftEdge + halfWidth;
    dialog.g2.gdTopEdge := dialog.g1.gdTopEdge;
    dialog.g2.gdWidth := buttonWidth;
    dialog.g2.gdHeight := buttonHeight;
    dialog.g2.gdText := SYS.ADR(CancelText);
    dialog.g2.gdTextAttr := NIL;
    dialog.g2.gdButtonSelected := 0;
    dialog.g2.gdButtonNormalRender := NIL;
    dialog.g2.gdButtonSelectRender := NIL;

    dialog.gDataEnd := ISup.DataEnd;
  END InitGadgets;

(* $D- disable copying of open arrays *)
BEGIN (* InitStrDlg *)
  CalcStrDlg ();
  dialog.rdTitle := SYS.ADR (title);
  dialog.rdWidth := dialogWidth;
  dialog.rdHeight := dialogHeight;
  dialog.rdFlags := {ISup.rdfInnerWindow};
  dialog.rdTexts := SYS.ADR (dialog.t0);
  dialog.rdGadgets := SYS.ADR (dialog.g0);
  InitTexts (dialog);
  InitGadgets (dialog);
  dialog.result := FALSE;
  NEW (sdp); sdp.Init(); sdp.strDlg := dialog;
  dialog.iSupPort := sdp
END InitStrDlg;


(*------------------------------------*)
PROCEDURE Activate *
  ( dialog     : StrDlg;
    window     : I.WindowPtr;
    VAR buffer : ARRAY OF CHAR )
  : BOOLEAN;

BEGIN (* Activate *)
  dialog.g0.gdInputDefault := SYS.ADR (buffer);
  dialog.textBuffer := NIL; dialog.result := FALSE;
  IF ISE.Activate (dialog, window) THEN
    IF dialog.result THEN COPY (dialog.textBuffer^, buffer) END
  END;
  RETURN dialog.result
END Activate;

END StringDialog.

(***************************************************************************

  $Log: StringDialog.mod $
  Revision 1.3  1994/05/12  21:26:09  fjc
  - Prepared for release

  Revision 1.2  1994/01/24  14:33:33  fjc
  Changed to conform with changes in Module Handlers:
    Handler procedures now reply to any messages they handle

  Revision 1.1  1994/01/15  17:32:38  fjc
  Start of revision control

***************************************************************************)