(*
  .name       GUI
  .task       interface to Intuition and GadTools
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.11
  .system     AmigaOS 2.04/2.1/3.0
  .author     Joachim Barheine
  .address    Hochgrevestraße 3, D-38640 Goslar
  .copyright  (c) 1994 by Joachim Barheine
*)

(* .info: 30/01/95, 19:30:14, version 86 *)

MODULE GUI;

IMPORT
  SYS:= SYSTEM,

  ASCII,
  Err:= ErrCodes,
  Exec,
  ExecSupport,
  GT:= GadTools,
  Gfx:= Graphics,
  IE:= InputEvent,
  I:= Intuition,
  IO:= IOServer,
  K:= Kernel,
  S:= Strings,
  Util:= Utility;

CONST
  uScoreCh* = "_";
  uScore* = ORD(uScoreCh);
  mxSpacing* = 3;
  cbSpacing* = 3;
  horizOffs* = 8;
  vertOffs* = 4;

  escKey* =     ORD(ASCII.esc); (* hook *)
  returnKey* = ORD(ASCII.cr);   (* hook *)
  tabKey* =     ORD(ASCII.ht);  (* gaTabCycle *)

TYPE
  LabelArray* = UNTRACED POINTER TO ARRAY 33 OF SYS.ADDRESS;

VAR
  prev- : I.GadgetPtr;  (* for gadget creation *)
  layoutX- , layoutY- , layoutSpc- : INTEGER;
  editHook: Util.HookPtr;
  reqFontSpec: Gfx.TextAttrPtr;
  reqFont- : Gfx.TextFontPtr;

  xWd-, zeroWd-, checkBoxWd-, mxWd-, cycleImgWd-, uScoreWd-: INTEGER;
  stringHt-, buttonHt-, checkBoxHt-, mxHt-, cycleHt-, textHt-,
  vertSpc-, horizSpc- : INTEGER;

  idCnt: INTEGER;

PROCEDURE Flash* ;

BEGIN
  I.DisplayBeep(IO.screen);
END Flash;

PROCEDURE OpenReqWindowXY* (title: ARRAY OF CHAR; at: I.WindowPtr; x, y, w, h: INTEGER;
                        idcmp: LONGSET; gadList: I.GadgetPtr): I.WindowPtr;

VAR
  win: I.WindowPtr;

(* $CopyArrays- *)

BEGIN
  win:= I.OpenWindowTagsA(NIL, I.waPubScreen, IO.screen,
                        I.waLeft, x, I.waTop, y,
                        I.waInnerWidth, w, I.waInnerHeight, h,
                        I.waTitle, SYS.ADR(title),
                        I.waDragBar, I.LTRUE, I.waDepthGadget, I.LTRUE,
                        I.waActivate, I.LTRUE,
                        I.waAutoAdjust, I.LTRUE, I.waSimpleRefresh, I.LTRUE,
                        I.waRMBTrap, I.LTRUE,
                        I.waGadgets, gadList,
                        I.waIDCMP, idcmp, Util.done);
  IF win # NIL THEN
    GT.RefreshWindow(win, NIL);
  END;
  RETURN win;
END OpenReqWindowXY;

PROCEDURE OpenReqWindow* (title: ARRAY OF CHAR; at: I.WindowPtr; w, h: INTEGER;
                          idcmp: LONGSET; gadList: I.GadgetPtr): I.WindowPtr;

(* $CopyArrays- *)

BEGIN
  RETURN OpenReqWindowXY(title, at, at.leftEdge + at.borderLeft + 8,
                         at.topEdge + at.borderTop + 4, w, h, idcmp, gadList);
END OpenReqWindow;

PROCEDURE GetMax* (VAR x: INTEGER; xn: INTEGER);

BEGIN
  IF xn > x THEN x:= xn END;
END GetMax;

PROCEDURE TextWidth* (text: ARRAY OF CHAR): INTEGER;

VAR
  i, w, l: INTEGER;

(* $CopyArrays- *)

BEGIN
   l:= SHORT(S.Length(text));
   w:= Gfx.TextLength(SYS.ADR(IO.screen.rastPort), text, l);
   FOR i:= 0 TO l - 1 DO
     IF text[i] = uScoreCh THEN DEC(w, uScoreWd) END;
   END;
   RETURN w;
END TextWidth;

PROCEDURE NewCol* (x, y, spc: INTEGER);

BEGIN
  IF x # -1 THEN layoutX:= x END;
  IF y # -1 THEN layoutY:= y END;
  IF spc # -1 THEN layoutSpc:= spc END;
END NewCol;

PROCEDURE InitNewGadget* (VAR ng: GT.NewGadget; id: INTEGER; width, height: INTEGER;
                        label: ARRAY OF CHAR; flags: LONGSET);

(* $CopyArrays- *)

BEGIN
  ng.leftEdge:=   layoutX + IO.screen.wBorLeft;
  ng.topEdge:=    layoutY + IO.screen.wBorTop + IO.screen.font.ySize + 1;
  ng.width:=      width;
  ng.height:=     height;
  ng.gadgetID:=   id;
  ng.visualInfo:= IO.visualInfo;
  ng.textAttr:=   reqFontSpec;
  IF label = "" THEN ng.gadgetText:= NIL ELSE ng.gadgetText:= SYS.ADR(label) END;
  ng.flags:=      flags;
  INC(layoutY, height + layoutSpc);
END InitNewGadget;

PROCEDURE CreateContextGad* (VAR gadList: I.GadgetPtr): I.GadgetPtr;

BEGIN
  prev:= GT.CreateContext(gadList);
  RETURN prev;
END CreateContextGad;

PROCEDURE CreateCheckBoxGad* (id: INTEGER; label: ARRAY OF CHAR;
                            checked, enabled: BOOLEAN): I.GadgetPtr;

VAR
  ng: GT.NewGadget;

(* $CopyArrays- *)

BEGIN
  InitNewGadget(ng, id, checkBoxWd, checkBoxHt, label, LONGSET{GT.placeTextRight});
  prev:= GT.CreateGadget(GT.checkBoxKind, prev, ng, GT.underscore, uScore,
                         GT.cbScaled, I.BoolToLong(checkBoxHt # 11),
                         GT.cbChecked, I.BoolToLong(checked),
                         I.gaDisabled, I.BoolToLong(~enabled),
                         Util.done);
  RETURN prev;
END CreateCheckBoxGad;

PROCEDURE CreateButtonGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
                          enabled: BOOLEAN): I.GadgetPtr;

VAR
  ng: GT.NewGadget;

(* $CopyArrays- *)

BEGIN
  InitNewGadget(ng, id, width, buttonHt, label, LONGSET{GT.placeTextIn});
  prev:= GT.CreateGadget(GT.buttonKind, prev, ng, GT.underscore, uScore,
                         I.gaDisabled, I.BoolToLong(~enabled), Util.done);
  RETURN prev;
END CreateButtonGad;

PROCEDURE CreateStringGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
                          VAR initial: ARRAY OF CHAR; enabled: BOOLEAN): I.GadgetPtr;

VAR
  ng: GT.NewGadget;

(* $CopyArrays- *)

BEGIN
  InitNewGadget(ng, id, width, stringHt, label, LONGSET{GT.placeTextLeft});
  prev:= GT.CreateGadget(GT.stringKind, prev, ng, GT.underscore, uScore,
                         GT.stString, SYS.ADR(initial),
                         GT.stMaxChars, LEN(initial) - 1,
                         I.gaTabCycle, I.LTRUE,
                         I.gaDisabled, I.BoolToLong(~enabled),
                         GT.stEditHook, editHook,
                         Util.done);
  RETURN prev;
END CreateStringGad;

PROCEDURE CreateTextGad* (label: ARRAY OF CHAR; width: INTEGER;
                        initial: ARRAY OF CHAR): I.GadgetPtr;

VAR
  ng: GT.NewGadget;

(* $CopyArrays- *)

BEGIN
  InitNewGadget(ng, idCnt, width, textHt, label, LONGSET{GT.placeTextLeft});
  INC(idCnt);
  prev:= GT.CreateGadget(GT.textKind, prev, ng, GT.underscore, uScore,
                         GT.txText, SYS.ADR(initial), GT.txCopyText, I.LTRUE,
                         GT.txBorder, I.LTRUE, Util.done);
  RETURN prev;
END CreateTextGad;

PROCEDURE CreateIntegerGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
                           initial: LONGINT; maxDigits: SHORTINT;
                           enabled: BOOLEAN): I.GadgetPtr;

VAR
  ng: GT.NewGadget;

(* $CopyArrays- *)

BEGIN
  InitNewGadget(ng, id, width, stringHt, label, LONGSET{GT.placeTextLeft});
  prev:= GT.CreateGadget(GT.integerKind, prev, ng, GT.underscore, uScore,
                         GT.inNumber, initial, GT.inMaxChars, maxDigits,
                         I.gaTabCycle, I.LTRUE, I.gaDisabled, I.BoolToLong(~enabled),
                         GT.inEditHook, editHook,
                         Util.done);
  RETURN prev;
END CreateIntegerGad;

PROCEDURE CreateCycleGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
                           choices: LabelArray; active: SHORTINT; enabled: BOOLEAN): I.GadgetPtr;

VAR
  ng: GT.NewGadget;

(* $CopyArrays- *)

BEGIN
  InitNewGadget(ng, id, width, cycleHt, label, LONGSET{GT.placeTextLeft});
  prev:= GT.CreateGadget(GT.cycleKind, prev, ng, GT.underscore, uScore,
                         GT.cyLabels, choices, GT.cyActive, active,
                         I.gaDisabled, I.BoolToLong(~enabled),
                         Util.done);
  RETURN prev;
END CreateCycleGad;

PROCEDURE CreateMXGad* (id: INTEGER; label: ARRAY OF CHAR;
                      choices: LabelArray; active: SHORTINT): I.GadgetPtr;

VAR
  ng: GT.NewGadget;

(* $CopyArrays- *)

BEGIN
  InitNewGadget(ng, id, mxWd, mxHt, label, LONGSET{GT.placeTextRight, GT.highLabel});
  prev:= GT.CreateGadget(GT.mxKind, prev, ng, GT.mxScaled, I.BoolToLong(mxHt # 9),
                         GT.mxLabels, choices, GT.mxActive, active,
                         GT.mxTitlePlace, LONGSET{GT.placeTextAbove},
                         GT.mxSpacing, mxSpacing, Util.done);
  RETURN prev;
END CreateMXGad;

PROCEDURE EnqueueOtherGad* (g: I.GadgetPtr);

BEGIN
  prev:= g;
END EnqueueOtherGad;

PROCEDURE* EditHook(hook: Util.HookPtr; obj, msg: Exec.APTR): Exec.APTR;

CONST
  done  = 1;
  unknown       = 0;

TYPE
  MsgPtr = UNTRACED POINTER TO STRUCT cmd: LONGINT END;

VAR
  sgw: I.SGWorkPtr;

BEGIN
  sgw:= SYS.VAL(I.SGWorkPtr, obj);
  IF SYS.VAL(MsgPtr, msg).cmd = I.sghKey THEN
    IF sgw.code = escKey THEN
      sgw.actions:= LONGSET{I.sgaEnd};
    ELSIF (sgw.editOp = I.eoEnter) & (sgw.code # tabKey) THEN
      sgw.actions:= LONGSET{I.sgaUse, I.sgaEnd, I.sgaNextActive};
    END;
    RETURN done;
  ELSE
    RETURN unknown;
  END;
END EditHook;

PROCEDURE CreateLabelArray* (VAR array: LabelArray; VAR len: SHORTINT;
                             VAR width: INTEGER; labelDef: ARRAY OF CHAR);

VAR
  label: UNTRACED POINTER TO ARRAY 80 OF CHAR;
  p0, p, w: INTEGER;

(* $CopyArrays- *)

BEGIN
  NEW(array);
  width:= 0; len:= 0; p:= -1;
  REPEAT
    INC(p); INC(len);
    NEW(label); array[len-1]:= label; p0:= p;
    WHILE (labelDef[p] # "|") & (labelDef[p] # 0X) DO
      label[p-p0]:= labelDef[p]; INC(p);
    END;
    label[p-p0]:= 0X;
    w:= TextWidth(label^); IF w > width THEN width:= w END;
  UNTIL labelDef[p] = 0X;
  array[len]:= NIL;  (* terminate *)
END CreateLabelArray;

PROCEDURE DisposeLabelArray* (VAR array: LabelArray);

VAR
  i: SHORTINT;

BEGIN
  i:= 0; WHILE array[i] # NIL DO DISPOSE(array[i]); INC(i) END;
  DISPOSE(array);
END DisposeLabelArray;

PROCEDURE ActivateGad* (g: I.GadgetPtr; w: I.WindowPtr);

BEGIN
  IF (I.gadgDisabled IN g.flags) OR ~I.ActivateGadget(g^, w, NIL) THEN
    Flash;
  END;
END ActivateGad;

PROCEDURE CycleGad* (g: I.GadgetPtr; w: I.WindowPtr; VAR i: SHORTINT; labels: SHORTINT);

BEGIN
  IF I.gadgDisabled IN g.flags THEN
    Flash;
  ELSE
    i:= (i + 1) MOD labels;
    GT.SetGadgetAttrs(g^, w, NIL, GT.cyActive, i, Util.done);
  END;
END CycleGad;

PROCEDURE ToggleGad* (g: I.GadgetPtr; w: I.WindowPtr; VAR checked: BOOLEAN);

BEGIN
  IF I.gadgDisabled IN g.flags THEN
    Flash;
  ELSE
    checked:= ~checked;
    GT.SetGadgetAttrs(g^, w, NIL, GT.cbChecked, I.BoolToLong(checked), Util.done);
  END;
END ToggleGad;

PROCEDURE ObtainIMsg* (w: I.WindowPtr): I.IntuiMessagePtr;

VAR
  iMsg: I.IntuiMessagePtr;

BEGIN
  iMsg:= GT.GetIMsg(w.userPort);
  WHILE iMsg = NIL DO
    Exec.WaitPort(w.userPort);
    iMsg:= GT.GetIMsg(w.userPort);
  END;
  RETURN iMsg;
END ObtainIMsg;

PROCEDURE IMsgClass* (class: LONGSET): SHORTINT;

VAR
  i: SHORTINT;

BEGIN
  FOR i:= 0 TO 31 DO
    IF i IN class THEN RETURN i END;
  END;
END IMsgClass;

BEGIN
  reqFontSpec:= IO.screen.font;
  reqFont:= Gfx.OpenFont(reqFontSpec^);
  K.Assert(reqFont # NIL, Err.userNoFont);

  idCnt:= 100;

  stringHt:= reqFont.ySize + 6;
  buttonHt:= reqFont.ySize + 4;
  checkBoxHt:= reqFont.ySize + 1; IF checkBoxHt < GT.checkboxHeight THEN checkBoxHt:= GT.checkboxHeight END;
  mxHt:= reqFont.ySize - 1; IF mxHt < GT.mxHeight THEN mxHt:= GT.mxHeight END;
  cycleHt:= reqFont.ySize + 6;
  textHt:= reqFont.ySize + 4;
  checkBoxWd:= (GT.checkboxWidth + 1) * checkBoxHt DIV GT.checkboxHeight;
  mxWd:= GT.mxWidth * mxHt DIV GT.mxHeight;
  cycleImgWd:= 23 * cycleHt DIV 14;
  uScoreWd:= Gfx.TextLength(SYS.ADR(IO.screen.rastPort), uScoreCh, 1);
  xWd:= TextWidth("x");
  zeroWd:= TextWidth("0");
  horizSpc:= reqFont.ySize;
  vertSpc:= (horizSpc + 1) DIV 2;
  NEW(editHook);
  Util.InitHook(editHook, EditHook);

CLOSE
  IF reqFont # NIL THEN
    Gfx.CloseFont(reqFont);
  END;
END GUI.