(*********************************************************
 *
 *  :Program.		Abfrage , gibt BOOLEAN zurück
 *  :Author.		Hans Schafft
 *  :Address.		Landfriedstraße 1A - Hinterhaus
 *  :Address.		6900 Heidelberg
 *  :Phone.		06221 - 22416
 *  :Version.		1.0
 *  :Date.		1989
 *  :Copyright.		PD
 *  :Language.		Modula-II
 *  :Translator.	M2Amiga
 *
 *********************************************************************)

IMPLEMENTATION MODULE SpielRegeln;

FROM SYSTEM	IMPORT  ADR, ADDRESS, LONGSET;
FROM Str	IMPORT	Copy,Length;
FROM Exec       IMPORT  MemReqs, MemReqSet, WaitPort, ReplyMsg, GetMsg;
FROM Graphics	IMPORT	jam2;
FROM Intuition IMPORT	GadgetPtr, WindowPtr,IntuiText,IntuiTextLength,
			IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet,
			boolGadget, reqGadget, ActivationFlags,Request,
		        ActivationFlagSet, Border, Gadget, GadgetFlagSet,
                        Requester, RequesterFlagSet, InitRequester;

CONST
  postext = "Sehr interessant !";
  negtext = "Wer hätte das gedacht !";

  XPosition = 10;
  YPosition = 130;

  Zeile1 = "SCHIFFCHENVERSENKEN (C) H.Schafft 1989/1990";
  Zeile2 = " ";
  Zeile3 = "Folgende Boote gibt es (unabhängig von der SpielFeldGröße) :";
  Zeile4 = " ";
  Zeile5 = "4 U-Boote..........á 1 Kästchen";
  Zeile6 = "3 Torpedos.........á 2 Kästchen";
  Zeile7 = "2 Kreuzer..........á 3 Kästchen";
  Zeile8 = "1 SchlachtSchiff...á 4 Kästchen";
  Zeile9 = " ";
  Zeile10 =
  "Beim SelbstAufbau können Sie sich korrigieren, wenn Sie auf irgendein ";
  Zeile11 =
  "BootsKästchen klicken ! Um jedes Schiff muß rundherum Wasser - oder Rand";
  Zeile12 =
  "sein, d.h. auch an den Ecken dürfen sie sich nicht berühren!";
  Zeile13 = " ";
  Zeile14 = "SpielEnde ->  rechte MausTaste  - sofern Sie gerade dran sind.";
  Zeile15 = " ";
  Zeile16 =
  "Bei Ihren TREFFERN wird das angeklickte Kästchen zunächst hellblau. Erst ";
  Zeile17 =
  "wenn das Boot VERSENKT ist, färbt es sich in der Boots-typischen Farbe.";
  Zeile18 = " ";
  Zeile19 =
  "Sollte wider Erwarten der Amiga gewinnen, kann er sich auch in die Liste";
  Zeile20 =
  "eintragen. Klicken Sie dazu nach dem Spiel einfach auf BestenListe!";
  Zeile21 = "§";
  Zeile22 = "§";
  Zeile23 = "§";


  ReqTextFarbeVorne = 5;
  ReqTextFarbeHinten = 4;
  ReqBackFill = 4;
  ReqRandFarbe = 9;

  posGadTextFarbeVorne = 1;
  posGadTextFarbeHinten = 0;
  posGadRandFarbe = 10;
  negGadTextFarbeVorne = 1;
  negGadTextFarbeHinten = 0;
  negGadRandFarbe = 11;

VAR
  RequBreite	: INTEGER;
  RequHoehe	: INTEGER;
  posGadBreite	: INTEGER;
  negGadBreite	: INTEGER;
  requester	: Requester;
  posGadText	: IntuiText;
  posGad	: Gadget;
  posGadBorder	: Border;
  posGadEcken	: ARRAY [1..10] OF INTEGER;
  negGadText	: IntuiText;
  negGad	: Gadget;
  negGadBorder	: Border;
  negGadEcken	: ARRAY [1..10] OF INTEGER;
  ReqBorder	: Border;
  ReqEcken	: ARRAY [1..10] OF INTEGER;
  text		: ARRAY [0..23],[0..75] OF CHAR;
  itext		: ARRAY [0..23] OF IntuiText;

(******************************************************************)
PROCEDURE ZeigeSpielRegeln(wiPtr : WindowPtr) : BOOLEAN;
VAR
  gadPtr	: GadgetPtr;
  gadNr		: INTEGER;
  msgPtr	: IntuiMessagePtr;
  class 	: IDCMPFlagSet;
  code		: CARDINAL;
  ende,mode	: BOOLEAN;
BEGIN
  IF Request(ADR(requester),wiPtr) THEN

    ende := FALSE;mode := TRUE;
    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
          | 1 : mode := TRUE;  ende := TRUE;
          | 2 : mode := FALSE; ende := TRUE;
          ELSE
          END;
        END;
        IF ende THEN EXIT END;
      END; (* LOOP *)
    UNTIL ende;
  END;
  RETURN mode;
END ZeigeSpielRegeln;

(******************************************************************)
PROCEDURE RichteEinGadgetJa;
BEGIN

  WITH posGadText DO
   leftEdge := 1;			topEdge	:= 1;
   frontPen := posGadTextFarbeVorne;	backPen := posGadTextFarbeHinten;
   drawMode := jam2;			iText   := ADR(postext);
   iTextFont:= NIL;			nextText:= NIL;
  END;

  posGadBreite := IntuiTextLength(ADR(posGadText));

   (* Koordinaten für den Rand der Gadget Box *)
  posGadEcken[1] := 0;              posGadEcken[2] := 0;
  posGadEcken[3] := posGadBreite+2; posGadEcken[4] := 0;
  posGadEcken[5] := posGadBreite+2; posGadEcken[6] := 11;
  posGadEcken[7] := 0;              posGadEcken[8] := 11;
  posGadEcken[9] := 0;              posGadEcken[10]:= 0;

  WITH posGadBorder DO
    leftEdge := -1; 			topEdge  := -1;
    frontPen := posGadRandFarbe;	backPen  := ReqBackFill;
    drawMode := jam2; 	     		count    := 5;
    xy       := ADR(posGadEcken); 	nextBorder := NIL;
  END;

  WITH posGad DO
   leftEdge  	:=  10;
   topEdge  	:=  RequHoehe - 15;
   width  	:=  posGadBreite;
   height 	:=  10;
   flags  	:=  GadgetFlagSet{};
   activation 	:=  ActivationFlagSet{endGadget, relVerify};
   gadgetType 	:=  boolGadget + reqGadget;
   gadgetRender :=  ADR(posGadBorder);
   gadgetText 	:=  ADR(posGadText);
   mutualExclude:=  LONGSET{};
   nextGadget 	:=  ADR(negGad);
   selectRender :=  NIL;
   specialInfo 	:=  NIL;
   userData     :=  NIL;
   gadgetID	:=  1;
  END;
 END RichteEinGadgetJa;

(******************************************************************)
PROCEDURE RichteEinGadgetNein;
BEGIN

  WITH negGadText DO
   leftEdge := 1;			topEdge	:= 1;
   frontPen := negGadTextFarbeVorne;	backPen := negGadTextFarbeHinten;
   drawMode := jam2;			iText   := ADR(negtext);
   iTextFont := NIL;			nextText := NIL;
  END;

  negGadBreite := IntuiTextLength(ADR(negGadText));

   (* Koordinaten für den Rand der Gadget Box *)
  negGadEcken[1] := 0;              negGadEcken[2] := 0;
  negGadEcken[3] := negGadBreite+2; negGadEcken[4] := 0;
  negGadEcken[5] := negGadBreite+2; negGadEcken[6] := 11;
  negGadEcken[7] := 0;              negGadEcken[8] := 11;
  negGadEcken[9] := 0;              negGadEcken[10] := 0;

  WITH negGadBorder DO
    leftEdge := -1; 			topEdge  := -1;
    frontPen := negGadRandFarbe;	backPen  := ReqBackFill;
    drawMode := jam2; 	     		count    := 5;
    xy       := ADR(negGadEcken);	nextBorder := NIL;
  END;

  WITH negGad DO
    leftEdge  	 := RequBreite - (negGadBreite + 14);
    topEdge  	 := RequHoehe - 15;
    width  	 := negGadBreite;
    height	 := 10;
    flags  	 := GadgetFlagSet{};
    activation 	 := ActivationFlagSet{endGadget, relVerify};
    gadgetType 	 := boolGadget + reqGadget;
    gadgetRender := ADR(negGadBorder);
    gadgetText 	 := ADR(negGadText);
    mutualExclude:= LONGSET{};
    nextGadget 	 := NIL;
    selectRender := NIL;
    specialInfo  := NIL;
    userData 	 := NIL;
    gadgetID 	 := 2;
  END;
 END RichteEinGadgetNein;

(******************************************************************)
PROCEDURE RichteEinRequesterText;
VAR x,y :CARDINAL;
BEGIN
  Copy(text[23],"§");
  RequBreite := 0;
  x := 0;
  REPEAT
    WITH itext[x] DO
      drawMode  := jam2;  iText    := ADR(text[x]);
      iTextFont := NIL;   nextText := ADR(itext[x+1]);
      topEdge   := x*10;
      frontPen  := ReqTextFarbeVorne;
      backPen   := ReqTextFarbeHinten;
    END;
    IF RequBreite < IntuiTextLength(ADR(itext[x])) THEN
      RequBreite := IntuiTextLength(ADR(itext[x]));
    END;
    INC(x);
  UNTIL text[x,0] = "§";

  RequHoehe := x*10 + 23;
  RequBreite := RequBreite + 40;

  itext[x-1].nextText := NIL;

  FOR y := 0 TO x-1 DO
    itext[y].leftEdge := (RequBreite - IntuiTextLength(ADR(itext[y]))) DIV 2;
  END;

END RichteEinRequesterText;

(******************************************************************)
PROCEDURE RichteEinRequester;
BEGIN
  RichteEinRequesterText;
  RichteEinGadgetJa;
  RichteEinGadgetNein;

  ReqEcken[1] := 0;              ReqEcken[2] := 0;
  ReqEcken[3] := RequBreite-3;   ReqEcken[4] := 0;
  ReqEcken[5] := RequBreite-3;   ReqEcken[6] := RequHoehe-3;
  ReqEcken[7] := 0;              ReqEcken[8] := RequHoehe-3;
  ReqEcken[9] := 0;              ReqEcken[10] := 0;

  WITH ReqBorder DO
    leftEdge := 1; 			topEdge  := 1;
    frontPen := ReqRandFarbe;		backPen  := ReqBackFill;
    drawMode := jam2; 	     		count    := 5;
    xy       := ADR(ReqEcken); 		nextBorder := NIL;
  END;

  InitRequester(ADR(requester));

  WITH requester DO
    leftEdge	:= XPosition;
    topEdge	:= YPosition;
    width	:= RequBreite;
    height	:= RequHoehe;
    reqGadget	:= ADR(posGad);
    reqText	:= ADR(itext[0]);
    reqBorder	:= ADR(ReqBorder);
    backFill	:= ReqBackFill;
  END;

 END RichteEinRequester;

(******************************************************************)
(******************************************************************)
BEGIN
  Copy(text[1],Zeile1);
  Copy(text[2],Zeile2);
  Copy(text[3],Zeile3);
  Copy(text[4],Zeile4);
  Copy(text[5],Zeile5);
  Copy(text[6],Zeile6);
  Copy(text[7],Zeile7);
  Copy(text[8],Zeile8);
  Copy(text[9],Zeile9);
  Copy(text[10],Zeile10);
  Copy(text[11],Zeile11);
  Copy(text[12],Zeile12);
  Copy(text[13],Zeile13);
  Copy(text[14],Zeile14);
  Copy(text[15],Zeile15);
  Copy(text[16],Zeile16);
  Copy(text[17],Zeile17);
  Copy(text[18],Zeile18);
  Copy(text[19],Zeile19);
  Copy(text[20],Zeile20);
  Copy(text[21],Zeile21);
  Copy(text[22],Zeile22);

  RichteEinRequester;
END SpielRegeln.