(*********************************************************************
 *
 *  :Program.	HilfsModul für SCHIFFCHENVERSENKEN
 *  :Author.	Hans Schafft
 *  :Address.	Landfriedstraße 1A - Hinterhaus
 *  :Address.	6900 Heidelberg
 *  :Phone.	06221 - 22416
 *  :Version.	1.0
 *  :Date.	1990
 *  :Copyright.	PD
 *  :Language.	Modula-II
 *  :Translator.M2Amiga
 *  :Contents.
 *
 *********************************************************************)
IMPLEMENTATION MODULE Gadget;
(*$R-*)(*$V-*)(*$S-*)(*$F-*)
FROM SYSTEM	IMPORT	INLINE, ADDRESS, ADR, LONGSET, CAST;
FROM Graphics   IMPORT  ScrollRaster, SetAPen, RectFill,SetRast,TextLength,
			ClipBlit,Flood, Draw, Move, jam2, jam1;
FROM Exec       IMPORT  MemReqs, MemReqSet,AvailMem,WaitPort, ReplyMsg,
			CopyMem, AllocMem, FreeMem, GetMsg;
FROM Intuition	IMPORT	GadgetPtr, ScreenPtr, keyCodeQ, selectDown,menuUp,
			RefreshGList, IDCMPFlags, IDCMPFlagSet, PrintIText,
			boolGadget, ActivationFlags,ActivationFlagSet,
		        Border, Gadget, GadgetFlagSet, IntuiText,RemoveGList,
                        GadgetFlags, IntuiTextLength, gadgHighbits,menuDown,
                        RefreshGadgets, AddGadget, DrawBorder, gadgHNone,
                        RemoveGadget,IntuiMessagePtr, WindowPtr;

VAR	wiPtr	: WindowPtr;
        gadDim	: ARRAY [0..30],[1..4] OF INTEGER;
	KaroGad	: ARRAY [0..300] OF Gadget;

CONST	AbstandVonOben = 70;

(***************************************************************)
PROCEDURE InitGadget(le,te,wi,he,id : INTEGER);
VAR	stelle : INTEGER;
BEGIN
  WITH KaroGad[id] DO
    leftEdge  	 :=  le;
    topEdge  	 :=  te;
    width  	 :=  wi;
    height 	 :=  he;
    flags  	 :=  GadgetFlagSet{};
    activation	 :=  ActivationFlagSet{gadgImmediate,relVerify};
    gadgetType 	 :=  boolGadget;
    gadgetRender :=  NIL;
    gadgetText 	 :=  NIL;
    mutualExclude:=  LONGSET{};
    nextGadget 	 :=  NIL;
    selectRender :=  NIL;
    specialInfo  :=  NIL;
    userData     :=  NIL;
    gadgetID     :=  id;
  END;
  stelle := AddGadget(wiPtr,ADR(KaroGad[id]),-1);
  RefreshGadgets(ADR(KaroGad[id]),wiPtr,NIL);
END InitGadget;


(*************************************************************************)
(* Fragt die Gadgets ab und gibt den Screen fürs eigentliche Spiel frei, *)
(* sobald ein Gadget jeder Kategorie angeklickt und OK betätigt wurde.   *)
(*************************************************************************)
PROCEDURE Konstellation(wiPtr : WindowPtr; VAR prefs : SpielArtFlagSet);
VAR
  gadPtr	: GadgetPtr;
  gadNr		: INTEGER;
  msgPtr	: IntuiMessagePtr;
  class 	: IDCMPFlagSet;
  code		: CARDINAL;
  ende,bool	: BOOLEAN;

  (*------------------------------------------------------------------*)
  (* Includiert 'in' in prefs un excludiert ggf. 'ex1' oder 'ex2' aus *)
  (* prefs; außerdem invertiert sie die jeweils ausgewählten Gadgets  *)
  (* am Bildschirm *)
  (* -----------------------------------------------------------------*)
  PROCEDURE InEx(in,ex1,ex2 : SpielArtFlags);
  VAR a,b,c,x : INTEGER;
  BEGIN
    a := INTEGER(in);
    b := INTEGER(ex1);
    c := INTEGER(ex2);
    INCL(prefs,in);
    ClipBlit(wiPtr^.rPort,gadDim[a,1]-7,gadDim[a,2]-7,wiPtr^.rPort,
    	gadDim[a,1]-7,gadDim[a,2]-7,gadDim[a,3]+14,gadDim[a,4]+14,010H);
    x := RemoveGadget(wiPtr,ADR(KaroGad[a]));
    IF ex1 IN prefs THEN
      EXCL(prefs,ex1);
      ClipBlit(wiPtr^.rPort,gadDim[b,1]-7,gadDim[b,2]-7,wiPtr^.rPort,
    	gadDim[b,1]-7,gadDim[b,2]-7,gadDim[b,3]+14,gadDim[b,4]+14,010H);
        x := AddGadget(wiPtr,ADR(KaroGad[b]),-1);
    ELSIF ex2 IN prefs THEN
      EXCL(prefs,ex2);
      ClipBlit(wiPtr^.rPort,gadDim[c,1]-7,gadDim[c,2]-7,wiPtr^.rPort,
    	gadDim[c,1]-7,gadDim[c,2]-7,gadDim[c,3]+14,gadDim[c,4]+14,010H);
        x := AddGadget(wiPtr,ADR(KaroGad[c]),-1);
    ELSE
    END;
  END InEx;

BEGIN
  ende := FALSE;
  prefs := SpielArtFlagSet{};
  REPEAT
    WaitPort(wiPtr^.userPort);
    LOOP
      msgPtr := GetMsg(wiPtr^.userPort);
      IF msgPtr = NIL THEN EXIT END;

      class := msgPtr^.class;
      code  := msgPtr^.code;
      gadPtr := msgPtr^.iAddress;
      gadNr := gadPtr^.gadgetID;

      ReplyMsg(msgPtr);



      IF (class = IDCMPFlagSet{gadgetUp}) THEN
        CASE gadNr OF
        | ORD(spielregeln)	: prefs := SpielArtFlagSet{spielregeln};
        			  ende := TRUE;
        | ORD(bestenliste)	: prefs := SpielArtFlagSet{bestenliste};
        			  ende := TRUE;
        | ORD(beenden)		: prefs := SpielArtFlagSet{beenden};
        			  ende := TRUE;
        | ORD(kleinesFeld)  : InEx(kleinesFeld,grossesFeld,mittleresFeld);
        | ORD(mittleresFeld): InEx(mittleresFeld,kleinesFeld,grossesFeld);
        | ORD(grossesFeld)  : InEx(grossesFeld,mittleresFeld,kleinesFeld);
        | ORD(HandAufbau)   : InEx(HandAufbau,AutoAufbau,AutoAufbau);
        | ORD(AutoAufbau)   : InEx(AutoAufbau,HandAufbau,HandAufbau);
        | ORD(OK)	    : INCL(prefs,OK);ende  := TRUE;
        ELSE
        END;
      END;
      IF ende THEN
        IF ((spielregeln IN prefs) OR (bestenliste IN prefs) OR
        	(beenden IN prefs))  OR
          ( ((HandAufbau IN prefs) OR (AutoAufbau IN prefs)) AND
          ((mittleresFeld IN prefs) OR (grossesFeld IN prefs) OR
           (kleinesFeld IN prefs)) AND (OK IN prefs) ) THEN
	   gadNr := RemoveGList(wiPtr,wiPtr^.firstGadget,-1);
	   EXIT;
	ELSE
	  ende := FALSE;
	END;
      END;
    END; (* LOOP *)
  UNTIL ende;
END Konstellation;

(***************************************************************)
PROCEDURE FestGadgetAufbau(wPtr : WindowPtr);
VAR x	: INTEGER;
  YEcke : ARRAY [0..9] OF INTEGER;
CONST KnopfXPos  = 340;
BEGIN
  wiPtr := wPtr;
  YEcke[0]:=0;
  YEcke[1]:=50;
  YEcke[2]:=100;
  YEcke[3]:=170;
  YEcke[4]:=220;
  YEcke[5]:=270;
  YEcke[6]:=340;
  YEcke[7]:=390;
  YEcke[8]:=470;
  FOR x := 0 TO 8 DO
    gadDim[x,1] := KnopfXPos+6;
    gadDim[x,2] := YEcke[x]+6;
    gadDim[x,3] := 291;
    gadDim[x,4] := 25;
  END;

  FOR x := 0 TO 8 DO
    InitGadget(gadDim[x,1],gadDim[x,2],gadDim[x,3],gadDim[x,4],x);
  END;
END FestGadgetAufbau;

(******************************************************************)
PROCEDURE KaestchenGadgetAufbau(KaroZahl,seite : INTEGER);
VAR gadBreite,x,y,id : INTEGER;
BEGIN
  gadBreite := (310 DIV KaroZahl) - 1;
  id := 0;
  FOR x := 1 TO KaroZahl DO
    FOR y := 1 TO KaroZahl DO
      INC(id);
      InitGadget(320*seite+(x-1)*gadBreite+x,AbstandVonOben+(y-1)*gadBreite+y,
      			gadBreite,gadBreite,id);
    END;
  END;
END KaestchenGadgetAufbau;

(************************************************************************)
PROCEDURE GadgetIDHolen(maxID : INTEGER) : INTEGER;
VAR
  gadPtr	: GadgetPtr;
  msgPtr	: IntuiMessagePtr;
  class 	: IDCMPFlagSet;
  code		: CARDINAL;
  ende		: BOOLEAN;
  id		: INTEGER;
BEGIN
  ende := FALSE;
  REPEAT
    WaitPort(wiPtr^.userPort);
    LOOP
      msgPtr := GetMsg(wiPtr^.userPort);
      IF msgPtr = NIL THEN EXIT END;

      class := msgPtr^.class;
      code  := msgPtr^.code;
      gadPtr := msgPtr^.iAddress;
      id := gadPtr^.gadgetID;

      ReplyMsg(msgPtr);

      IF (gadgetUp IN class) AND (id > 0) AND (id <= maxID) THEN
        ende := TRUE;
        EXIT;
      ELSIF (mouseButtons IN class) AND (code = menuDown) THEN
        id := fertig+1;
        ende := TRUE;
        EXIT;
      ELSE
        ende := FALSE;
      END;

    END; (* LOOP *)
  UNTIL ende;
  RETURN id-1;
END GadgetIDHolen;

(************************************************************************)
PROCEDURE MausTaste(wiPtr : WindowPtr);
VAR
  msgPtr	: IntuiMessagePtr;
  class 	: IDCMPFlagSet;
  ende		: BOOLEAN;
BEGIN
  ende := FALSE;
  REPEAT
    WaitPort(wiPtr^.userPort);
    LOOP
      msgPtr := GetMsg(wiPtr^.userPort);
      IF msgPtr = NIL THEN EXIT END;

      class := msgPtr^.class;

      ReplyMsg(msgPtr);

      IF (mouseButtons IN class) THEN
        ende := TRUE;
      ELSE
        EXIT;
      END;

    END; (* LOOP *)
  UNTIL ende;
END MausTaste;

(************************************************************************)
(************************************************************************)
BEGIN
END Gadget.