(*
  .name       EdtOS37
  .task       support-library for systems running OS 2.04
  .release    1.0
  .language   Oberon-2
  .translator Amiga Oberon 3.2
  .system     AmigaOS 2.04/2.1/3.0
  .author     J. Barheine
  .address    Hochgrevestr. 3
  .copyright  38640 Goslar
*)

(* .info: 31/01/95, 22:33:15, version 1 *)

MODULE EdtOS37;  (* $StackChk- $NilChk- $RangeChk- $OvflChk- $ReturnChk- *)

IMPORT
  SYS:= SYSTEM,

  Exec,
  ExecSupport,
  Gfx:= Graphics,
  GT:= GadTools,
  I:= Intuition,
  OberonLib,
  S:= Strings,
  Util:= Utility;

PROCEDURE ReqScreen* (w{8}: I.WindowPtr; VAR mode{1}: LONGINT; VAR depth{2}: INTEGER)
                      : BOOLEAN;


TYPE
  DisplayNodePtr = UNTRACED POINTER TO DisplayNode;
  DisplayNode = STRUCT (node: Exec.Node)
    dimInfo: Gfx.DimensionInfo;
    modeID: LONGINT;
  END;

CONST
  sModeID = 0;
  sDepthID = 1;
  aOkID = 2;
  aCancelID = 3;

VAR
  win: I.WindowPtr;
  screen: I.ScreenPtr;
  visualInfo: GT.VisualInfo;
  g, context, gadList, modeGad, depthGad, aOkGad, aCancelGad: I.GadgetPtr;
  iMsg: I.IntuiMessagePtr;
  c: CHAR;
  code: INTEGER;
  modeList: Exec.List;
  newModeID: LONGINT;
  newDepth: INTEGER;
  result: BOOLEAN;

  PROCEDURE GetNode(n: LONGINT): DisplayNodePtr;

  VAR
    node: Exec.NodePtr;

  BEGIN
    node:= modeList.head;
    WHILE n > 0 DO node:= node.succ; DEC(n) END;
    RETURN node(DisplayNode);
  END GetNode;

  PROCEDURE GetModeNr(id: LONGINT): INTEGER;

  VAR
    n: INTEGER;
    node: Exec.NodePtr;

  BEGIN
    n:= 0;
    node:= modeList.head;
    LOOP
      IF node.succ= NIL THEN
        RETURN 0;
      ELSIF node(DisplayNode).modeID = id THEN
        RETURN n;
      END;
      node:= node.succ;
      INC(n);
    END;
  END GetModeNr;

  PROCEDURE NewMode(nr: INTEGER);

  VAR
    node: DisplayNodePtr;

  BEGIN
    node:= GetNode(nr);
    IF newDepth > node.dimInfo.maxDepth THEN newDepth:= node.dimInfo.maxDepth END;
    GT.SetGadgetAttrs(depthGad^, win, NIL, GT.slMin, 1, GT.slMax, node.dimInfo.maxDepth,
                      GT.slLevel, newDepth, Util.done);
    newModeID:= node.modeID;
  END NewMode;

  PROCEDURE ScanModes(): BOOLEAN;

  VAR
    dnode: DisplayNodePtr;
    nameInfo: Gfx.NameInfo;
    id: LONGINT;

  BEGIN
    id:= Gfx.invalidID;
    ExecSupport.NewList(modeList);
    id:= Gfx.NextDisplayInfo(id);
    WHILE id # Gfx.invalidID DO
      IF (Gfx.ModeNotAvailable(id) = 0) & (id # Gfx.monitorIDMask) THEN
        NEW(dnode);
        IF (Gfx.GetDisplayInfoData(NIL, dnode.dimInfo, SIZE(dnode.dimInfo),
                                 Gfx.dtagDims, id) # 0)
         & (Gfx.GetDisplayInfoData(NIL, nameInfo, SIZE(nameInfo), Gfx.dtagName, id) # 0) THEN
          SYS.NEW(dnode.node.name, S.Length(nameInfo.name) + 1);
          COPY(nameInfo.name, dnode.node.name^);
          dnode.modeID:= id;
          Exec.AddTail(modeList, dnode);
        ELSE
          DISPOSE(dnode);
        END;
      END;
      id:= Gfx.NextDisplayInfo(id);
    END;
    RETURN ~ExecSupport.ListEmpty(modeList);
  END ScanModes;

  PROCEDURE DisposeModes;

  VAR
    node, next: Exec.NodePtr;

  BEGIN
    node:= modeList.head;
    WHILE node.succ # NIL DO
      next:= node.succ;
      Exec.Remove(node);
      DISPOSE(node.name);
      DISPOSE(node);
      node:= next;
    END;
  END DisposeModes;

  PROCEDURE CreateGadgets(): BOOLEAN;

  CONST
    topaz8 = Gfx.TextAttr(SYS.ADR("topaz.font"), 8, SHORTSET{}, SHORTSET{});

  VAR
    ng: GT.NewGadget;
    nr: INTEGER;
    node: DisplayNodePtr;

  BEGIN
    nr:= GetModeNr(newModeID);
    node:= GetNode(nr);

    context:= GT.CreateContext(gadList);
    IF context = NIL THEN RETURN FALSE END;

    ng.leftEdge:= 8 + screen.wBorLeft;
    ng.topEdge:= 4 + screen.wBorTop + screen.font.ySize + 1;
    ng.width:= 248;
    ng.height:= 100;
    ng.gadgetID:= sModeID;
    ng.visualInfo:= visualInfo;
    ng.textAttr:= SYS.ADR(topaz8);
    ng.gadgetText:= NIL;
    ng.flags:= LONGSET{GT.placeTextAbove};
    modeGad:= GT.CreateGadget(GT.listViewKind, context, ng,
                              GT.lvLabels, SYS.ADR(modeList), GT.lvShowSelected, NIL,
                              GT.lvSelected, nr, GT.lvTop, nr, GT.lvMakeVisible, nr,
                              Util.done);

    ng.leftEdge:= modeGad.leftEdge + 80;
    ng.topEdge:= modeGad.topEdge + 100 + 4;
    ng.width:= modeGad.width - 80;
    ng.height:= 12;
    ng.gadgetID:= sDepthID;
    ng.visualInfo:= visualInfo;
    ng.textAttr:= SYS.ADR(topaz8);
    ng.gadgetText:= SYS.ADR("Tiefe:   ");
    ng.flags:= LONGSET{GT.placeTextLeft};
    depthGad:= GT.CreateGadget(GT.sliderKind, modeGad, ng,
                               GT.slMin, 1, GT.slMax, node.dimInfo.maxDepth,
                               GT.slLevel, newDepth, GT.slLevelFormat, SYS.ADR("%ld"),
                               GT.slMaxLevelLen, 2,
                               GT.slLevelPlace, LONGSET{GT.placeTextLeft},
                               I.pgaFreedom, I.lorientHoriz, I.gaRelVerify, I.LTRUE,
                               Util.done);

    ng.leftEdge:= modeGad.leftEdge;
    ng.topEdge:= depthGad.topEdge + 14 + 8;
    ng.width:= 88;
    ng.height:= 14;
    ng.gadgetID:= aOkID;
    ng.visualInfo:= visualInfo;
    ng.textAttr:= SYS.ADR(topaz8);
    ng.gadgetText:= SYS.ADR("OK");
    ng.flags:= LONGSET{GT.placeTextIn};
    aOkGad:= GT.CreateGadget(GT.buttonKind, depthGad, ng, Util.done);

    ng.leftEdge:= modeGad.leftEdge + 248 - 88;
    ng.topEdge:= aOkGad.topEdge;
    ng.width:= 88;
    ng.height:= 14;
    ng.gadgetID:= aCancelID;
    ng.visualInfo:= visualInfo;
    ng.textAttr:= SYS.ADR(topaz8);
    ng.gadgetText:= SYS.ADR("Abbrechen");
    ng.flags:= LONGSET{GT.placeTextIn};
    aCancelGad:= GT.CreateGadget(GT.buttonKind, aOkGad, ng, Util.done);

    RETURN aCancelGad # NIL;
  END CreateGadgets;

  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;

(* $SaveRegs+ *)

BEGIN
  OberonLib.SetA5;
  result:= FALSE;
  gadList:= NIL;
  newModeID:= mode;
  newDepth:= depth;
  screen:= w.wScreen;
  visualInfo:= GT.GetVisualInfo(screen, Util.done);
  IF ScanModes() THEN
    IF CreateGadgets() THEN
      win:= I.OpenWindowTagsA(NIL, I.waPubScreen, screen,
                        I.waLeft, w.leftEdge + w.borderLeft + 8, I.waTop, w.topEdge + w.borderTop + 4,
                        I.waInnerWidth, 248 + 2*8 , I.waInnerHeight, 100 + 2*14 + 20,
                        I.waTitle, SYS.ADR("Bildschirm-Modus"),
                        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, LONGSET{I.refreshWindow} + GT.buttonIDCMP +
                        GT.sliderIDCMP + GT.listViewIDCMP, Util.done);
      IF win # NIL THEN
        GT.RefreshWindow(win, NIL);
        LOOP
          iMsg:= GT.GetIMsg(win.userPort);
          WHILE iMsg = NIL DO
            Exec.WaitPort(win.userPort); iMsg:= GT.GetIMsg(win.userPort);
          END;
          CASE IMsgClass(iMsg.class) OF
            I.refreshWindow: GT.BeginRefresh(win);
                             GT.EndRefresh(win, I.LTRUE);
          | I.gadgetUp:      g:= iMsg.iAddress;
                             CASE g.gadgetID OF
                               sDepthID: newDepth:= iMsg.code;
                             | sModeID : NewMode(iMsg.code);
                             ELSE
                               result:= (g.gadgetID = aOkID);
                               GT.ReplyIMsg(iMsg);
                               EXIT;
                             END;
          ELSE (* ignore *)
          END;
          GT.ReplyIMsg(iMsg);
        END;
        IF result THEN
          mode:= newModeID;
          depth:= newDepth;
        END;
        I.CloseWindow(win);
      END;
      GT.FreeGadgets(gadList);
    END;
    DisposeModes();
  END;
  IF visualInfo # NIL THEN GT.FreeVisualInfo(visualInfo) END;
  RETURN result;
END ReqScreen;

END EdtOS37.