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

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

   Created by: fjc (Frank Copeland)
    $Revision: 1.7 $
      $Author: fjc $
        $Date: 1994/08/08 16:13:41 $

  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;

(*
** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N- NilChk
** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
** $V= OvflChk       $Z= ZeroVars
**
** Compiler NIL checking is replaced by ASSERTs at the appropriate places.
*)

IMPORT
  E := Exec, 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 : ARRAY 256 OF CHAR;
    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.textAttr) 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 tempHeight > height THEN
    height := tempHeight;
  END
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", NIL, tempWidth, tempHeight);
  tempWidth := tempWidth * visibleChars;
  INC (tempWidth, extraWidth);
  INC (tempHeight, extraHeight);
  IF tempWidth > width THEN
    width := tempWidth;
  END;
  IF tempHeight > height THEN
    height := tempHeight;
  END
END CalcInputGadgetBox;


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

  VAR result : INTEGER; str : E.STRPTR;

BEGIN (* HandleISup *)
  CASE msg.code OF
    StringGadgetID :
      str := msg.iAddress;
      COPY (str^, sdp.strDlg.textBuffer);
      result := Events.Continue
    |
    AcceptButtonID :
      sdp.strDlg.result := (sdp.strDlg.textBuffer # "");
      result := Events.Stop
    |
    CancelButtonID :
      sdp.strDlg.result := FALSE;
      result := Events.Stop
    |
  END;
  ISup.base.ReplyMsg (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.type     := ISup.text;
    dialog.t0.flags    := {ISup.tdCenter};
    dialog.t0.leftEdge := 0;
    dialog.t0.topEdge  := VSpace;
    dialog.t0.text     := SYS.ADR (prompt);
    dialog.t0.textAttr := NIL;
    dialog.tDataEnd    := ISup.dataEnd;
  END InitTexts;

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

    CONST
      StringGadgetFlags = {ISup.gdMovePointer};
      ButtonFlags = {ISup.gdHotKey};

    VAR halfWidth : INTEGER;

  BEGIN (* InitGadgets *)
    dialog.g0.type := ISup.string;
    dialog.g0.flags := StringGadgetFlags;
    dialog.g0.leftEdge := (dialogWidth - stringWidth) DIV 2;
    dialog.g0.topEdge := textHeight + (2 * VSpace);
    dialog.g0.width := stringWidth;
    dialog.g0.height := stringHeight;
    dialog.g0.text := NIL;
    dialog.g0.textAttr := NIL;
    dialog.g0.len := maxChars;
    dialog.g0.activateNext := 0;
    dialog.g0.activatePrev := 0;
    dialog.g0.default := NIL;

    halfWidth := dialogWidth DIV 2;

    dialog.g1.type := ISup.button;
    dialog.g1.flags := ButtonFlags;
    dialog.g1.leftEdge := (halfWidth - buttonWidth) DIV 2;
    dialog.g1.topEdge := dialog.g0.topEdge + stringHeight + VSpace;
    dialog.g1.width := buttonWidth;
    dialog.g1.height := buttonHeight;
    dialog.g1.text := SYS.ADR(AcceptText);
    dialog.g1.textAttr := NIL;
    dialog.g1.selected := 0;
    dialog.g1.normalRender := NIL;
    dialog.g1.selectRender := NIL;

    dialog.g2.type := ISup.button;
    dialog.g2.flags := ButtonFlags;
    dialog.g2.leftEdge := dialog.g1.leftEdge + halfWidth;
    dialog.g2.topEdge := dialog.g1.topEdge;
    dialog.g2.width := buttonWidth;
    dialog.g2.height := buttonHeight;
    dialog.g2.text := SYS.ADR(CancelText);
    dialog.g2.textAttr := NIL;
    dialog.g2.selected := 0;
    dialog.g2.normalRender := NIL;
    dialog.g2.selectRender := NIL;

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

(* $D- disable copying of open arrays *)
BEGIN (* InitStrDlg *)
  ASSERT (dialog # NIL, 137);
  CalcStrDlg ();
  dialog.title := SYS.ADR (title);
  dialog.width := dialogWidth;
  dialog.height := dialogHeight;
  dialog.flags := {ISup.rdInnerWindow};
  dialog.texts := SYS.ADR (dialog.t0);
  dialog.gadgets := SYS.ADR (dialog.g0);
  InitTexts (dialog);
  InitGadgets (dialog);
  dialog.result := FALSE;
  NEW (sdp); ASSERT (sdp # NIL, 137);
  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 *)
  ASSERT (dialog # NIL, 137);
  dialog.g0.default := SYS.ADR (buffer);
  dialog.textBuffer := ""; 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.7  1994/08/08  16:13:41  fjc
  Release 1.4

  Revision 1.6  1994/06/17  17:26:27  fjc
  - Updated for release

  Revision 1.5  1994/06/09  13:42:30  fjc
  - [bug] The text entered into the input gadget was in a
    buffer dynamically allocated by IntuiSup.  This was being
    freed before the text was copied.  Changed to copy the
    text into the dialog object instead of just keeping a
    pointer to it.

  Revision 1.4  1994/06/04  23:49:52  fjc
  - Changed to use new Amiga interface

  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

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