(*----------------------------------------------------------------------
  :Program.    MoveAndSet.mod
  :Contents.   Positionieren von Rechtecken zur Bestimmung der Position
  :Contents.   von Gadgets oder Texten im Window.
  :Author.     Hubert Bildstein
  :Copyright.  Public Domain
  :Language.   Modula-2
  :Translator. M2Amiga V3.3d
  :History.    V1.0   5.12.1990
  :Remark.     Hardware-Register zur LMB-Abfrage (leider), wegen
  :Remark.     einheitlicher Behandlung aller Gadget-Typen.
----------------------------------------------------------------------*)

IMPLEMENTATION MODULE MoveAndSet;
(* Positionieren von Rechtecken zur Bestimmung der Position von Gadgets *)

FROM SYSTEM    IMPORT ADDRESS,ADR;
FROM Dos       IMPORT Delay;
FROM Exec      IMPORT GetMsg, ReplyMsg;
FROM Graphics  IMPORT RastPortPtr, SetDrMd, DrawModeSet, DrawModes, jam1,
                      jam2, SetAPen, Move, Draw;
FROM Hardware  IMPORT ciaa, CIAA, CiaaPraFlagSet, CiaaPraFlags;
FROM Intuition IMPORT WindowPtr, IDCMPFlagSet, IDCMPFlags, IntuiMessagePtr,
                      ModifyIDCMP, GadgetPtr, strGadget, sizing, sysGadget,
                      IntuitionBasePtr, IntuitionBase, Window,
                      selectUp, selectDown, ScreenPtr, Screen,
                      OffGadget, OnGadget;
FROM Menu      IMPORT SetMenu, ClearMenu;
FROM Message   IMPORT WaitForMsg;
IMPORT Intuition;    (* für IntuitionBase *)

(*--------------------------------------------------------------------------*)
(* interne Prozeduren:                                                      *)
(*--------------------------------------------------------------------------*)

VAR IBPtr : IntuitionBasePtr;
    xmin,xmax,ymin,ymax : INTEGER;
    SizeGadget : GadgetPtr;

(*---------------------------------*)
PROCEDURE GetSizeGadget (w : WindowPtr) : GadgetPtr;
(* Zeiger auf sizing-Gadget des Windows holen *)

BEGIN

 SizeGadget := w^.firstGadget;
 WHILE (SizeGadget # NIL)
       AND (SizeGadget^.gadgetType # sizing+sysGadget) DO
     SizeGadget := SizeGadget^.nextGadget;
 END; (*WHILE*)
 RETURN SizeGadget

END GetSizeGadget;

(*--------------------------------------------------------------------------*)

PROCEDURE LimitMouse (WPtr : WindowPtr;
                      dxmin,dxmax,dymin,dymax : INTEGER);
(* Einschränken des Mauszeigerbereichs auf einen Window-Bereich *)

BEGIN

 IF (SizeGadget = NIL) THEN SizeGadget := GetSizeGadget(WPtr) END;
 IF (SizeGadget # NIL) THEN OffGadget (SizeGadget,WPtr,NIL) END;

 WITH IBPtr^ DO
   WITH WPtr^ DO
     minXMouse := leftEdge + dxmin + 4;
     maxXMouse := leftEdge + width - dxmax - 4;
     minYMouse := (topEdge+borderTop+dymin+wScreen^.topEdge)*2;
     maxYMouse := (topEdge+height-dymax-borderBottom+wScreen^.topEdge)*2;
     IF (minYMouse > ymax) THEN minYMouse := ymin END;
     IF (maxYMouse > ymax) THEN maxYMouse := ymax END;
   END; (*WITH*)
 END; (*WITH*)

END LimitMouse;

(*--------------------------------------------------------------------------*)

PROCEDURE UnlimitMouse (WPtr : WindowPtr);
(* Wiederherstellen des Mauszeigerbereichs *)
BEGIN

 WITH IBPtr^ DO
   minXMouse := xmin;
   maxXMouse := xmax;
   minYMouse := ymin;
   maxYMouse := ymax;
 END; (*WITH*)
 IF (SizeGadget # NIL) THEN OnGadget (SizeGadget,WPtr,NIL) END;

END UnlimitMouse;

(*--------------------------------------------------------------------------*)


PROCEDURE Rect (rp   : RastPortPtr;
                xMin,yMin,xMax,yMax : INTEGER);
(* Zeichnet ein nicht gefülltes Rechteck mit den angegebenen Koordinaten.*)
BEGIN
 Move (rp,xMin,yMin);
 Draw (rp,xMax,yMin);
 Draw (rp,xMax,yMax);
 Draw (rp,xMin,yMax);
 Draw (rp,xMin,yMin);
END Rect;

(*--------------------------------------------------------------------------*)
(*--------------------------------------------------------------------------*)

PROCEDURE SelectGadget (wptr : ADDRESS) : ADDRESS;
(* Wartet auf Anklicken eines Gadgets. Falls kein Gadget vorhanden, wird
   NIL zurückgegeben. *)

VAR WPtr  : WindowPtr;
    class : IDCMPFlagSet;
    code  : CARDINAL;
    GPtr  : GadgetPtr;

BEGIN

 WPtr := wptr;
 ClearMenu (WPtr);

 LOOP                              (* Auf Anklicken warten *)
    WaitForMsg (WPtr,class,code,GPtr);
    IF (mouseButtons IN class) THEN     (* CANCEL *)
       GPtr := NIL; EXIT
    ELSIF ((gadgetDown IN class) AND (GPtr^.gadgetType = strGadget))
       OR (gadgetUp IN class) THEN
         EXIT
    END; (*IF*)
 END; (*LOOP*)

 SetMenu (WPtr);
 RETURN GPtr;                         (* GadgetPtr zurückgeben *)

END SelectGadget;

(*--------------------------------------------------------------------------*)

PROCEDURE SetRect (    wptr          : ADDRESS;
                       sizing        : BOOLEAN;
                   VAR x,y           : INTEGER;
                   VAR width, height : INTEGER);
(* Ermöglicht das Positionieren eines Rechtecks im Window *)

VAR WPtr       : WindowPtr;
    rp         : RastPortPtr;
    class      : IDCMPFlagSet;
    code       : CARDINAL;
    addr       : GadgetPtr;
    xNow, yNow : INTEGER;
    swap       : INTEGER;
    xMin, yMin : INTEGER;
    xMax, yMax : INTEGER;
    IMes       : IntuiMessagePtr;

(*-------------------------------*)
 PROCEDURE DrawCross;   (* Fadenkreuz *)
 BEGIN
   Move (rp,xNow,yMin); Draw (rp,xNow,y);
   Move (rp,xNow,yNow); Draw (rp,xNow,yMax);
   Move (rp,xMin,yNow); Draw (rp,x,yNow);
   Move (rp,xNow,yNow); Draw (rp,xMax,yNow);
 END DrawCross;
(*-------------------------------*)

BEGIN

 WPtr := wptr;
 ClearMenu (WPtr);

 LimitMouse (WPtr,0,0,0,0);      (* Mausbereich auf Window begrenzen *)

 rp := WPtr^.rPort;
 xMax := WPtr^.width - WPtr^.borderRight;           (* Fenstergrenzen *)
 yMax := WPtr^.height - WPtr^.borderBottom;
 xMin := WPtr^.borderLeft; yMin := WPtr^.borderTop;

 (* DrawMode complement *)
 SetDrMd (rp,DrawModeSet{complement});

 REPEAT
 UNTIL (gamePort0 IN ciaa.pra);       (* LMB losgelassen *)

 xNow := WPtr^.mouseX; yNow := WPtr^.mouseY;     (* akt. Position *)

 IF NOT sizing THEN        (* Pos. der ersten Ecke bestimmen *)

    Move (rp,xNow,yMin); Draw (rp,xNow,yMax);  (* erstes Fadenkreuz *)
    Move (rp,xMin,yNow); Draw (rp,xMax,yNow);

    (* auf LMB warten und bei akt. Position Fadenkreuz zeichnen *)
    REPEAT
      WaitForMsg (WPtr,class,code,addr);
      IF (mouseMove IN class) THEN
        Move (rp,xNow,yMin); Draw (rp,xNow,yMax);    (* löschen *)
        Move (rp,xMin,yNow); Draw (rp,xMax,yNow);
        xNow := WPtr^.mouseX; yNow := WPtr^.mouseY;
        Move (rp,xNow,yMin); Draw (rp,xNow,yMax);    (* zeichnen *)
        Move (rp,xMin,yNow); Draw (rp,xMax,yNow);
      END; (*IF*)
    UNTIL (mouseButtons IN class) AND (code = selectDown);

    Move (rp,xNow,yMin); Draw (rp,xNow,yMax);  (* Fadenkreuz löschen *)
    Move (rp,xMin,yNow); Draw (rp,xMax,yNow);

    x := xNow; y := yNow;     (* akt. Position merken = erste Ecke*)

 END; (*IF*)

 Rect (rp,x,y,xNow,yNow);                  (* 1. Rechteck zeichnen *)
 DrawCross;

 REPEAT
   IMes := GetMsg (WPtr^.userPort);
   IF (IMes # NIL) THEN
      class := IMes^.class;
      ReplyMsg (IMes);

      IF (mouseMove IN class) THEN
         Rect (rp,x,y,xNow,yNow);                     (* löschen *)
         DrawCross;
         xNow := WPtr^.mouseX; yNow := WPtr^.mouseY;     (* zweite Ecke *)
         Rect (rp,x,y,xNow,yNow);                     (* neu zeichnen *)
         DrawCross;
      END; (*IF*)
   END; (*IF*)
   Delay (1);
 UNTIL ((gamePort0 IN ciaa.pra) AND NOT sizing)
       OR (NOT (gamePort0 IN ciaa.pra) AND sizing);

 Rect (rp,x,y,xNow,yNow);        (* letztes Rechteck wieder löschen *)
 DrawCross;

 SetDrMd (rp,jam1);              (* DrawMode normal*)

 width := ABS(xNow - x) + 1; height := ABS(yNow - y) + 1;
 IF (x > xNow) THEN x := xNow END;
 IF (y > yNow) THEN y := yNow END;

 SetMenu (WPtr);
 UnlimitMouse (WPtr);    (* normaler Mausbereich *)

END SetRect;

(*--------------------------------------------------------------------------*)

PROCEDURE PlaceRect (    wptr          : ADDRESS;
                         width, height : INTEGER;
                     VAR x,y           : INTEGER);
(* Ermöglicht die Positionierung eines Rechtecks bekannter Größe in einem
   Window *)

VAR WPtr           : WindowPtr;
    xOld, yOld     : INTEGER;
    xPlus, yPlus   : INTEGER;
    xMinus, yMinus : INTEGER;
    xMin, xMax     : INTEGER;
    yMin, yMax     : INTEGER;
    rp             : RastPortPtr;
    class          : IDCMPFlagSet;
    code           : CARDINAL;
    addr           : GadgetPtr;
    IMes           : IntuiMessagePtr;

(*-----------------------------*)
 PROCEDURE DrawLines;
 BEGIN
  Move (rp,xMin,yOld-yMinus);  (* 1. waagrechte Linie *)
  Draw (rp,xMax,yOld-yMinus);
  Move (rp,xMin,yOld+yPlus);   (* 2. waagrechte Linie *)
  Draw (rp,xMax,yOld+yPlus);
  Move (rp,xOld-xMinus,yMin);  (* 1. senkrechte Linie *)
  Draw (rp,xOld-xMinus,yMax);
  Move (rp,xOld+xPlus,yMin);   (* 2. senkrechte Linie *)
  Draw (rp,xOld+xPlus,yMax);
 END DrawLines;
(*-----------------------------*)

BEGIN

 WPtr := wptr;
 ClearMenu (WPtr);  (* Menu aus *)

 rp := WPtr^.rPort;    (* RastPort bestimmen *)
 xMax := WPtr^.width - WPtr^.borderRight;           (* Fenstergrenzen *)
 yMax := WPtr^.height - WPtr^.borderBottom;
 xMin := WPtr^.borderLeft; yMin := WPtr^.borderTop;

 (* Rechteck zerlegen *)
 xMinus := width DIV 2; xPlus := xMinus + (width MOD 2);
 yMinus := height DIV 2; yPlus := yMinus + (height MOD 2);

 LimitMouse (WPtr,xMinus,xPlus,yMinus,yPlus);       (* Maus einschränken *)

 SetDrMd (rp,DrawModeSet{complement});

 REPEAT
 UNTIL (gamePort0 IN ciaa.pra);       (* LMB losgelassen *)

 xOld := WPtr^.mouseX;
 yOld := WPtr^.mouseY;
 DrawLines; (* 1. Rechteck *)

 REPEAT
  IMes := GetMsg (WPtr^.userPort);
  IF (IMes # NIL) THEN
     class := IMes^.class;
     ReplyMsg (IMes);
     IF (mouseMove IN class) THEN
        DrawLines;  (* löschen *)
        xOld := WPtr^.mouseX;
        yOld := WPtr^.mouseY;
        DrawLines;  (* zeichnen *)
     END; (*IF*)
  END; (*IF*)
  Delay (1);
 UNTIL NOT (gamePort0 IN ciaa.pra);     (* LMB gedrückt *)

 DrawLines;  (* löschen *)

 SetDrMd (rp,jam1);

 x := xOld - xMinus; y := yOld - yMinus;      (* Ergebnis *)

 SetMenu (WPtr);
 UnlimitMouse (WPtr);    (* Maus frei *)
END PlaceRect;

(*--------------------------------------------------------------------------*)

BEGIN

 IBPtr := ADR(Intuition);        (* IntuitionBase *)

 xmin := IBPtr^.minXMouse;       (* ursprünglichen Mausbereich speichern *)
 xmax := IBPtr^.maxXMouse;
 ymin := IBPtr^.minYMouse;
 ymax := IBPtr^.maxYMouse;

 SizeGadget := NIL;              (* Zeiger auf sizing-Gadget des Windows *)

END MoveAndSet.