{-------------------------------------------------------------------------}

PROGRAM Aequipotential;

{--------------------------------------------------------------------------

                        Äquipotential V1.06 PAL
                 written by J.Matern December 23, 1990
                    last changed March 6, 1991
                         written in PCQ-Pascal
                      Compiler:PCQ-Compiler V1.1c
                                  //
                Written for the \X/ Amiga; tested on a
                    PAL Amiga 2000, Rev4.1; KickV1.2

                  Thanx to my brother Markus who gave
                     me help and some good ideas!

--------------------------------------------------------------------------}

{$I "Include:Ports.i"       : GetMsg, ReplyMsg, WaitPort }
{$I "Include:Intuition.i"   : AutoRequest, CloseScreen, CloseWindow,
                              ModifyIDCMP, OpenScreen, OpenWindow,
                              ScreenToBack, ScreenToFront, ShowTitle,
                              ViewPortAddress }
{$I "Include:Graphics.i"    : Draw, Move, RectFill, SetAPen,
                              SetDrMd, SetRGB4, WritePixel }
{$I "Include:Exec.i"        : CloseLibrary, Forbid, OpenLibrary, Permit }
{$I "Include:Screen.i"      : Screen-Record Definition }
{$I "Include:MathTrans.i"   : OpenMathTrans, CloseMathTrans, SPPow, SPSqrt }
{$I "Include:Text.i"        : GText }
{$I "Include:StringLib.i"   : AllocString, IntToString, stricmp, strcpy }
{$I "Include:Parameters.i"  : GetParam, GetStartupMsg }

{-------------------------------------------------------------------------}

CONST
        Ko        = 80.00;
        MaxPot    = 15.00;
        MaxLad    = 20;
        Skonst    = 256;    { PAL  }
       {Skonst    = 200;      NTSC }
        RMBTRAP_f = $10000; {fehlt in Intuition.i}

{-------------------------------------------------------------------------}

VAR
   Mathtest, NoHide     : BOOLEAN;
   MovedMouse, Quit     : BOOLEAN;
   Area, UpperLeft      : BOOLEAN;
   Rect, ReqFlag        : BOOLEAN;
   x,y,xf,yf,xs,ys      : INTEGER;
   i,t,Fast,Leave       : INTEGER;
   Anzahl,Modeflag      : INTEGER;
   Whoehe,Wbreite       : INTEGER;
   Shoehe,Sbreite,Smode : INTEGER;
   Minho,Minbr,Atf      : INTEGER;
   strlaeng             : INTEGER;
   LeftX, LeftY,
   RightX, RightY       : INTEGER;
   Dummy                : INTEGER;
   EPottest,Fak,Dist    : REAL;
   xkord, ykord, empty  : STRING;
   GrMode, SpMode       : STRING;
   Rpktx,Rpkty          : ARRAY [0..4] OF INTEGER;
   Apktx,Apkty          : ARRAY [0..8] OF INTEGER;
   Arbfeld,Arbb,Arbh    : ARRAY [0..8] OF INTEGER;
   Lad,Ladx,Lady        : ARRAY [0..MaxLad] OF REAL;
   Pottest              : ARRAY [0..4] OF REAL;

   s        : ScreenPtr;
   bw ,qw   : WindowPtr;
   rp       : RastPortPtr;
   m        : MessagePtr;
   vp       : Address;
   IM       : IntuiMessagePtr;
   StoreMsg : IntuiMessage;
   WBSP     : WBStartupPtr;
   OK,
   Cancel,
   Repair,
   Feintxt  : IntuiTextPtr;

{-------------------------------------------------------------------------}

FUNCTION OpenMyScreen : BOOLEAN;
VAR
ns : NewScreenPtr;
BEGIN {OpenMyScreen}
   new(ns);
   WITH ns^ DO BEGIN
      LeftEdge  := 0;
      TopEdge   := 0;
      Width     := Sbreite;
      Height    := Shoehe;
      Depth     := 3+ModeFlag;
      DetailPen := TRUNC(16.0/Fak);
      BlockPen  := 0;
      ViewModes := Smode;
      SType     := CUSTOMSCREEN_f;
      Font      := nil;
      DefaultTitle := "AequipotV1.06 © 1990/91 by J.Matern";
      Gadgets   := nil;
      CustomBitMap := nil;
   END;
   s := OpenScreen(ns);
   dispose(ns);
   OpenMyScreen := s <> nil;
END; {OpenMyScreen}

{-------------------------------------------------------------------------}

FUNCTION OpenBackWindow : BOOLEAN;
VAR
nw : NewWindowPtr;
BEGIN {OpenBackWindow}
   new(nw);
   WITH nw^ DO BEGIN
      LeftEdge  := 0;
      TopEdge   := 0;
      Width     := Wbreite;
      Height    := Whoehe;
      DetailPen := -1;
      BlockPen  := -1;
      IDCMPFlags := MOUSEBUTTONS_f;
      Flags := BACKDROP_f + BORDERLESS_f + SMART_REFRESH_f + ACTIVATE_f +
               REPORTMOUSE_f + RMBTRAP_f;
      FirstGadget := nil;
      CheckMark := nil;
      Title     := nil;   {kein Titel, da in ganzem Window gezeichnet wird}
      Screen    := s;
      BitMap    := nil;
      MinWidth  := 50;
      MaxWidth  := -1;
      MinHeight := 20;
      MaxHeight := -1;
      WType := CUSTOMSCREEN_f;
   END;
   bw := OpenWindow(nw);
   dispose(nw);
   OpenBackWindow := bw <> nil;
END; {OpenBackWindow}

{-------------------------------------------------------------------------}

PROCEDURE CloseAll;
BEGIN
   IF s <> nil THEN
      ScreenToBack(s);

   IF bw <> nil THEN BEGIN
      Forbid;
      REPEAT
         IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
         IF IM <> nil THEN ReplyMsg(MessagePtr(IM));
      UNTIL IM = nil;
      CloseWindow(bw);
      Permit;
   END;

   IF s <>nil THEN
      CloseScreen(s);

   IF GfxBase <> nil THEN
      CloseLibrary(GfxBase);

   IF Mathtest = TRUE THEN
      CloseMathTrans;

END;

{-------------------------------------------------------------------------}

PROCEDURE OpenAll;
BEGIN
   GfxBase := OpenLibrary("graphics.library", 0);
   IF GfxBase = nil THEN BEGIN
      WRITELN('Could not open Graphics.library');
         CloseAll;
      EXIT(20);
   END;

   Mathtest := OpenMathTrans();
   IF (NOT Mathtest) THEN BEGIN
      WRITELN('Could not open Mathtrans.library');
         CloseAll;
      EXIT(20);
   END;

   IF (NOT OpenMyScreen) THEN BEGIN
      writeln('Could not open the screen!');
      CloseAll;
      Exit(20);
   END;
   ShowTitle(s, FALSE);

   IF (NOT OpenBackWindow) THEN BEGIN
      writeln('Could not open the window!');
      CloseAll;
      Exit(20);
   END;
   rp:=bw^.RPort;

END;

{-------------------------------------------------------------------------}

FUNCTION Distance(x,y : REAL; xx,yy : INTEGER) : REAL;
{Entfernungsbestimmung mit Pythagoras zwischen (x,y) u. (xx,yy)}
BEGIN
   Distance:=SPsqrt(SQR(x-FLOAT(xx))+SQR(y-FLOAT(yy)));
   {SPsqrt ist viel schneller als SQRT!!}
END;

{-------------------------------------------------------------------------}

FUNCTION Potential(Lad,Dist : REAL) : REAL;
{Potentialbestimmung zur Ladung (Lad) in Entfernung (Dist)}
BEGIN
   Potential:=Ko*(Lad/Dist);
END;

{-------------------------------------------------------------------------}

PROCEDURE HandleMessage;
BEGIN
   IM := IntuiMessagePtr(WaitPort(bw^.UserPort));
   IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
   StoreMsg := IM^;
   ReplyMsg(MessagePtr(IM));
   CASE StoreMsg.Class OF
      MOUSEBUTTONS_f : BEGIN
         IF StoreMsg.Code = SELECTUP THEN BEGIN
            IF NoHide=TRUE THEN
               NoHide:=FALSE
            ELSE
               NoHide:=TRUE;
            ShowTitle(s, NoHide);
         END;
         IF StoreMsg.Code = MENUUP THEN BEGIN
            Quit:=TRUE;
         END;
      END;
   END;
END;

{-------------------------------------------------------------------------}

PROCEDURE RechnePotential; {Potential an jedem der fünf Rechenpunkte wird
                            berechnet=Pottest[0-4]}
BEGIN
   FOR t:=0 TO 4 DO BEGIN
      Pottest[t]:=0.0;
      FOR i:=1 TO Anzahl DO BEGIN
         Dist:=Distance(Ladx[i],Lady[i],Rpktx[t],Rpkty[t]);
         IF Dist<>0.0 THEN BEGIN
            Pottest[t]:=Pottest[t]+Potential(Lad[i],Dist);
         END ELSE
            Pottest[t]:=100.0*Lad[i];
      END;
   END;
END;

{-------------------------------------------------------------------------}

PROCEDURE Drawing(x,y : INTEGER); {Potential an x,y wird berechnet und
                                   gezeichnet}
BEGIN {Drawing}
   EPottest:=0.0;
   FOR i:=1 TO Anzahl DO BEGIN {Aufsummieren der Einzelpotentiale über
                                die verschiedenen Ladungen}
      Dist:=Distance(Ladx[i],Lady[i],x,y);
      IF Dist<>0.0 THEN BEGIN
         EPottest:=EPottest+Potential(Lad[i],Dist);
      END ELSE
         Epottest:=100.0*Lad[i];
   END;
   IF ABS(EPottest)<MaxPot THEN BEGIN     {wenn Potential nicht zu groß}
      SetAPen(rp,ROUND((EPottest+16.0)/Fak)); {dann Farbwahl und}
      WritePixel(rp,x,y);                     {Setzen eines Punktes}
   END;
END; {Drawing}

{-------------------------------------------------------------------------}

PROCEDURE FastDraw(xsta, ysta, xe, ye, xste, yste : INTEGER; Modus : BOOLEAN);
                        {Schneller Überblick über die Grafik}
                        {oder Reperatur, je nach Modus}
BEGIN {FastDraw}
   y:=ysta;
   REPEAT
   {Schleife für y-Koordinate}
      x:=xsta;
      REPEAT
      {Schleife für x-Koordinate}
         EPottest:=0.0;
         m:=GetMsg(bw^.UserPort);
         IF m <> nil THEN BEGIN {Abbruch bei Mausknopf}
            HandleMessage;
            IF Quit=TRUE THEN BEGIN
               x:=xe+1;
               y:=ye+1;
            END;
         END;
         FOR i:=1 TO Anzahl DO BEGIN    {Potential Aufsummieren}
            Dist:=Distance(Ladx[i],Lady[i],x,y);
            IF Dist<>0.0 THEN BEGIN
               EPottest:=EPottest+Potential(Lad[i],Dist);
            END ELSE
               EPottest:=100.0*Lad[i];
         END;
         IF ABS(EPottest)<MaxPot THEN BEGIN {falls Potential nicht zu groß}
            SetAPen(rp,ROUND((EPottest+16.0)/Fak)); {dann Farbwahl und}
            IF Modus THEN
               WritePixel(rp,x,y)                       {Punkt setzen}
            ELSE                                        {oder}
               RectFill(rp,x,y,x+xste,y+yste+1);        {Fläche füllen}
         END;
         x:=x+xste;
      UNTIL x >= xe; {Schleifenende x}
      y:=y+yste;
   UNTIL y >= ye; {Schleifenende y}
END; {FastDraw}

{-------------------------------------------------------------------------}

PROCEDURE Clear; {Window löschen}
BEGIN
   SetAPen(rp,0);
   RectFill(rp,0,0,Sbreite,Shoehe);
   SetAPen(rp,TRUNC(16.0/Fak));
END;

{-------------------------------------------------------------------------}

PROCEDURE Cross(x,y : INTEGER); {Zeichnet Kreuz bei x,y}
BEGIN
   MOVE(rp,x-2,y);
   DRAW(rp,x+2,y);
   MOVE(rp,x,y-2);
   DRAW(rp,x,y+2);
END;

{-------------------------------------------------------------------------}

PROCEDURE LadMark; {Übergibt Koordinaten jeder Ladung an Cross}
BEGIN
   Clear;
   FOR i:=1 TO Anzahl DO BEGIN
      x:=TRUNC(Ladx[i]);
      y:=TRUNC(Lady[i]);
      Cross(x,y);
   END;
END;

{-------------------------------------------------------------------------}

PROCEDURE Color; {Farbpalette wird in Abhängigkeit von ScreenAuflösung
                  gesetzt}
BEGIN {Color}
   vp:= ViewPortAddress(bw);
   IF ModeFlag=2 THEN BEGIN
      SetRGB4(vp, 0, 0, 0, 0);
      FOR i:=1 TO 16 DO
         SetRGB4(vp, i,15, i-1,0);
      FOR i:=16 TO 31 DO
         SetRGB4(vp, i,31-i,31-i,i-16);
   END ELSE BEGIN
      SetRGB4(vp, 0, 0, 0, 0);
      FOR i:=1 TO 8 DO
         SetRGB4(vp,i,15,i*2-1,0);
      FOR i:=8 TO 15 DO
         SetRGB4(vp, i,31-2*i,31-2*i,i*2-16);
   END;
   SetAPen(rp,TRUNC(16.0/Fak));
END; {Color}

{-------------------------------------------------------------------------}

PROCEDURE Pointtest; {Berechnung von fünf Probekoordinaten in Abhängigkeit
                      vom Arbeitspunkt; Berechnung des Potentials an den
                      fünf Rechenpunkten; je nach Ergebnis Füllen der
                      Fläche, Veränderung der Arbeitstiefe (Atf) und des
                      Arbeitsbereichs}
BEGIN {Pointtest}
   Rpktx[0]:=Apktx[Atf]; {Berechnung der Probekoordinaten}
   Rpkty[0]:=Apkty[Atf];
   Rpktx[1]:=Apktx[Atf]+Arbb[Atf]-1;
   Rpkty[1]:=Apkty[Atf];
   Rpktx[2]:=Apktx[Atf];
   Rpkty[2]:=Apkty[Atf]+Arbh[Atf]-1;
   Rpktx[3]:=Apktx[Atf]+Arbb[Atf]-1;
   Rpkty[3]:=Apkty[Atf]+Arbh[Atf]-1;
   Rpktx[4]:=Apktx[Atf]+Arbb[Atf+1]-1;
   Rpkty[4]:=Apkty[Atf]+Arbh[Atf+1]-1;
   RechnePotential; {Berechnung des Potentials an den fünf Punkten}
   IF (ROUND(Pottest[0]/Fak)=ROUND(Pottest[1]/Fak)) AND
    (ROUND(Pottest[1]/Fak)=ROUND(Pottest[2]/Fak)) AND
    (ROUND(Pottest[2]/Fak)=ROUND(Pottest[3]/Fak)) AND
    (ROUND(Pottest[3]/Fak)=ROUND(Pottest[4]/Fak)) THEN BEGIN {Falls das
                        Potential an allen fünf Punkten identisch ist}
      IF ABS(Pottest[0])<MaxPot THEN BEGIN
         SetAPen(rp,ROUND((Pottest[0]+16.0)/Fak)); {dann Farbauswahl und}
         RectFill(rp,Rpktx[0],Rpkty[0],Rpktx[3],Rpkty[3]); {Füllen der
                                          entsprechenden Fläche}
      END;
{*}   IF Arbfeld[Atf]=5 THEN BEGIN {Test, ob momentane Arbeitstiefe schon
                          vollständig bearbeitet wurde}
         REPEAT
            Arbfeld[Atf]:=1;       {dann Arbeitstiefe verringern}
            DEC(Atf);
         UNTIL Arbfeld[Atf]<5;
      END ELSE
         INC(Arbfeld[Atf]); {sonst Arbeitsbereich erhöhen}
   END ELSE BEGIN                 {wenn Fläche nicht gefüllt werden konnte,}
      IF (Atf=8) THEN BEGIN       {maximale Arbeitstiefe erreicht ist}
         IF (ABS(Pottest[0]/Fak)<Maxpot) OR
          (ABS(Pottest[1]/Fak)<Maxpot) OR
          (ABS(Pottest[2]/Fak)<Maxpot) OR
          (ABS(Pottest[3]/Fak)<Maxpot) THEN BEGIN {und Fläche nicht schwarz}
            FOR x:=Rpktx[0] TO Rpktx[3] DO BEGIN     {wird Fläche Pixel}
               FOR y:=Rpkty[0] TO Rpkty[3] DO BEGIN  {für Pixel berechnet}
                  Drawing(x,y);
               END;
            END;
         END;
         IF Arbfeld[Atf]=5 THEN BEGIN {siehe *}
            REPEAT
               Arbfeld[Atf]:=1;
               DEC(Atf);
            UNTIL Arbfeld[Atf]<5;
         END ELSE
            INC(Arbfeld[Atf]);
      END ELSE BEGIN    {Fläche konnte nicht gefüllt werden, maximale
                         Arbeitstiefe ist aber noch nicht erreicht}
         IF Arbfeld[Atf]=5 THEN
            Arbfeld[Atf]:=1
         ELSE
            INC(Arbfeld[Atf]);
         INC(Atf);    {Arbeitstiefe erhöhen}
      END;
   END;
END; {Pointtest}

{-------------------------------------------------------------------------}

PROCEDURE Areatest; {Test, in welchem der vier möglichen Arbeitsbereiche
                     momentan gerade gerechnet wird und entsprechende Wahl
                     des Arbeitpunktes (Apktx,Apkty) der momentanen
                     Arbeitstiefe (Atf)}
BEGIN {Areatest}
   REPEAT
      CASE Arbfeld[Atf] OF
         1 : BEGIN  {Bereich 1=links oben}
            xf:=0;
            yf:=0;
         END;
         2 : BEGIN  {Bereich 2=rechts oben}
            xf:=1;
            yf:=0;
         END;
         3 : BEGIN  {Bereich 3=links unten}
            xf:=0;
            yf:=1;
         END;
         ELSE BEGIN {Bereich 4=rechts unten}
            xf:=1;
            yf:=1;
         END;
      END;
      Apktx[Atf]:=Apktx[Atf-1]+xf*Arbb[Atf]; {Berechnung des neuen}
      Apkty[Atf]:=Apkty[Atf-1]+yf*Arbh[Atf]; {Arbeitpunktes in Tiefe Atf}
      Pointtest;
      Leave:=Apktx[Atf]+Arbb[Atf];
      m:=GetMsg(bw^.UserPort); {Test auf linke Maustaste}
      IF m <> nil THEN BEGIN
         HandleMessage;
         IF Quit=TRUE THEN               {und verlassen zum Hauptprogramm}
            Leave:=(640 DIV Modeflag)+1; {falls diese gedrückt wurde}
      END;
   UNTIL Leave>(640 DIV ModeFlag); {Test, ob der gesamte
                                    Bildschirm bereits
                                    berechnet wurde}
END; {Areatest}

{-------------------------------------------------------------------------}

PROCEDURE LadKoord;
BEGIN
   ModifyIDCMP(bw, MOUSEBUTTONS_f + MOUSEMOVE_f);
   Quit:=FALSE;
   MovedMouse:=FALSE;
   Anzahl:=0;
   Move(rp,(Sbreite-296) DIV 2,Shoehe DIV 2);
   GText(rp,"Mit linkem Mausknopf Ladungen setzen,",37);
   Move(rp,(Sbreite-240) DIV 2,(Shoehe DIV 2)+10);
   GText(rp,"mit rechtem Mausknopf beenden!",30);
   REPEAT
      IM := IntuiMessagePtr(WaitPort(bw^.UserPort));
      IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
      StoreMsg := IM^;
      ReplyMsg(MessagePtr(IM));
         CASE StoreMsg.Class OF
         MOUSEMOVE_f : BEGIN
            IF MovedMouse=FALSE THEN BEGIN
               Clear;
               MovedMouse:=TRUE;
            END ELSE BEGIN
               x:=StoreMsg.MouseX;
               y:=StoreMsg.MouseY;
               strlaeng:=IntToStr(xkord,x);
               Move(rp,Sbreite-25,Shoehe-12);
               Gtext(rp, empty, 3);
               Move(rp,Sbreite-25,Shoehe-12);
               Gtext(rp, xkord, strlaeng);
               strlaeng:=IntToStr(ykord,y);
               Move(rp,Sbreite-25,Shoehe-2);
               Gtext(rp, empty, 3);
               Move(rp,Sbreite-25,Shoehe-2);
               Gtext(rp, ykord, strlaeng);
            END;
         END;
         MOUSEBUTTONS_f : BEGIN
            IF (StoreMsg.Code = SELECTUP) AND
            (MovedMouse=TRUE) THEN BEGIN {linker Mausknopf}
               INC(Anzahl);
               x:=StoreMsg.MouseX;
               y:=StoreMsg.MouseY;
               Cross(x,y);
               Ladx[Anzahl]:=FLOAT(x);
               Lady[Anzahl]:=FLOAT(y);
            END;
            IF StoreMsg.Code = MENUUP THEN BEGIN   {rechter Mausknopf}
               Quit:=TRUE;
            END;
         END;
      END;
   UNTIL ((Quit=TRUE) OR (Anzahl=MaxLad)) AND (Anzahl>0);
   ModifyIDCMP(bw, MOUSEBUTTONS_f);
   Quit:=FALSE;
END;

{-------------------------------------------------------------------------}

PROCEDURE LadGet;
BEGIN
   ScreenToBack(s);
   FOR t:=1 TO Anzahl DO BEGIN
      WRITE('Ladung ',t,' (',TRUNC(Ladx[t]),',',TRUNC(Lady[t]),'): ');
      READLN(Lad[t]);
   END;
   ScreenToFront(s);
END;

{-------------------------------------------------------------------------}

PROCEDURE Usage;
BEGIN
   WRITELN('Usage: AEQUIPOT ScreenMode RenderingMode');
   WRITELN('       Where ScreenMode is h(igh) or l(ow)');
   WRITELN('       and RenderingMode is s(low) or f(ast).');
   WRITELN;
   EXIT(20);
END;

{-------------------------------------------------------------------------}

PROCEDURE RectArea;   {Zeichnet Rechteck (LeftX,LeftY/RightX,RightY)}
BEGIN
   Move(rp, LeftX, LeftY);
   Draw(rp, RightX, LeftY);
   Draw(rp, RightX, RightY);
   Draw(rp, LeftX, RightY);
   Draw(rp, LeftX, LeftY);
END;

{-------------------------------------------------------------------------}

PROCEDURE SetRepArea;
BEGIN
   ModifyIDCMP(bw, MOUSEMOVE_f + MOUSEBUTTONS_f);
   SetDrMd(rp, COMPLEMENT);
   Rect:=FALSE;
   UpperLeft:=FALSE;
   Area:=FALSE;
   REPEAT
      IM := IntuiMessagePtr(WaitPort(bw^.UserPort));
      IM := IntuiMessagePtr(GetMsg(bw^.UserPort));
      StoreMsg := IM^;
      ReplyMsg(MessagePtr(IM));
         CASE StoreMsg.Class OF
         MOUSEMOVE_f : BEGIN
            IF UpperLeft=TRUE THEN BEGIN
               RectArea;
               RightX := (StoreMsg.MouseX DIV 5)*5+4;
               RightY := (StoreMsg.MouseY DIV 4)*4+3;
               RectArea;
            END;
         END;
         MOUSEBUTTONS_f : BEGIN
            IF (StoreMsg.Code = SELECTUP) THEN BEGIN    {linker Mausknopf}
               IF UpperLeft THEN BEGIN                  {zum 2. mal}
                  UpperLeft:=FALSE;
                  RightX := (StoreMsg.MouseX DIV 5)*5+4;
                  RightY := (StoreMsg.MouseY DIV 4)*4+3;
               END ELSE BEGIN                           {zum 1. mal}
                  IF Rect = TRUE THEN                   {wenn Umrandung da}
                     RectArea;                          {diese löschen}
                  UpperLeft := TRUE;
                  Rect := TRUE;
                  LeftX := (StoreMsg.MouseX DIV 5)*5;
                  LeftY := (StoreMsg.MouseY DIV 4)*4;
                  RightX := LeftX;
                  RightY := LeftY;
                  RectArea;
               END;
            END;
            IF (StoreMsg.Code = MENUUP) AND
             (UpperLeft = FALSE) AND
             (Rect = TRUE) THEN BEGIN {rechter Mausknopf u. Bereich gewählt}
               RectArea;
               Area:=TRUE;
            END;
         END;
      END;
   UNTIL Area=TRUE;
   ModifyIDCMP(bw, MOUSEBUTTONS_f);
   SetDrMd(rp, JAM1);
END;

{-------------------------------------------------------------------------}

PROCEDURE RepairArea; {reparieren der Grafik}
BEGIN
   IF RightX < LeftX THEN BEGIN
      Dummy := LeftX;
      LeftX := RightX;
      RightX:= Dummy;
   END;
   IF RightY < LeftY THEN BEGIN
      Dummy := LeftY;
      LeftY := RightY;
      RightY:= Dummy;
   END;
   FastDraw(LeftX,LeftY,RightX,RightY,1,1,TRUE);
END;

{-------------------------------------------------------------------------}

PROCEDURE Parameter;
BEGIN
   GrMode := AllocString(10);
   SPMode := AllocString(10);

   WBSP := GetStartupMsg();

   IF WBSP <> nil THEN BEGIN                  {WB-Start}
      REPEAT
         WRITE('Geben Sie den Grafikmodus ein h(igh) oder l(ow): ');
         READLN(GrMode);
      UNTIL (stricmp(GrMode,"h")=0) OR (stricmp(GrMode,"l")=0);
      REPEAT
         WRITE('Geben Sie den Rechenmodus an f(ast) oder s(low): ');
         READLN(Spmode);
      UNTIL (stricmp(SpMode,"f")=0) OR (stricmp(SpMode,"s")=0);
   END ELSE BEGIN                             {CLI-Start}
      GetParam(1, GrMode);
      GetParam(2, SpMode);
   END;

   IF (stricmp(GrMode,"h")=0) OR (stricmp(GrMode,"l")=0) THEN BEGIN
      IF (stricmp(SpMode,"f")=0) OR (stricmp(SpMode,"s")=0) THEN BEGIN
         IF stricmp(GrMode,"l")=0 THEN
            Smode:=1
         ELSE
            Smode:=2;
         IF stricmp(SpMode,"f")=0 THEN
            Fast:=1
         ELSE
            Fast:=2;
      END ELSE
         Usage;
   END ELSE
       Usage;
END;

{-------------------------------------------------------------------------}

PROCEDURE TextDef;
BEGIN
   NEW(OK);
   WITH OK^ DO BEGIN
      FrontPen    := TRUNC(16.0/Fak);
      Backpen     := 0;
      DrawMode    := JAM1;
      KludgeFill  := 0; { Kludge is just a reminder here }
      LeftEdge    := 6; { relative to gadget }
      TopEdge     := 3; { -"- }
      ITextFont   := nil;
      IText       := "OK";
      NextText    := nil;
   END;
   NEW(Cancel);
   WITH Cancel^ DO BEGIN
      FrontPen    := TRUNC(16.0/Fak);
      Backpen     := 0;
      DrawMode    := JAM1;
      KludgeFill  := 0; { Kludge is just a reminder here }
      LeftEdge    := 7; { relative to gadget }
      TopEdge     := 3; { -"- }
      ITextFont   := nil;
      IText       := "Cancel";
      NextText    := nil;
   END;
   NEW(Repair);
   WITH Repair^ DO BEGIN
      FrontPen    := TRUNC(16.0/Fak);
      Backpen     := 0;
      DrawMode    := JAM1;
      KludgeFill  := 0; { Kludge is just a reminder here }
      LeftEdge    := 16;{ relative to gadget }
      TopEdge     := 8; { -"- }
      ITextFont   := nil;
      IText       := "Wollen sie reparieren?";
      NextText    := nil;
   END;
   NEW(Feintxt);
   WITH Feintxt^ DO BEGIN
      FrontPen    := TRUNC(16.0/Fak);
      Backpen     := 0;
      DrawMode    := JAM1;
      KludgeFill  := 0; { Kludge is just a reminder here }
      LeftEdge    := 16;{ relative to gadget }
      TopEdge     := 8; { -"- }
      ITextFont   := nil;
      IText       := "Wollen sie fein berechnen?";
      NextText    := nil;
   END;
END;

{-------------------------------------------------------------------------}

PROCEDURE Init; {Programmstart wird vorbereitet}
BEGIN {Init}
   WRITELN;
   WRITELN('Aequipot V1.06 PAL (March 6, 1991)');
   WRITELN('Copyright © 1990/91 Juergen Matern. All rights reserved.');
   WRITELN;

   Minbr:=5;
   Minho:=4;
   empty:="   ";

   Parameter;

   IF Smode=1 THEN BEGIN   {LoRes-Einstellungen}
      Sbreite:=320;
      Shoehe:=Skonst;
      Wbreite:=320;
      Whoehe:=Shoehe;
      Smode:=16384;      {LoRes=16384}
      ModeFlag:=2;
      Atf:=2;
   END ELSE BEGIN        {HiRes-Einstellungen}
      Sbreite:=640;
      Shoehe:=2*Skonst;
      Wbreite:=640;
      Whoehe:=Shoehe;
      Smode:=32772;      {HiRes=32768 Lace=4}
      ModeFlag:=1;
      Atf:=1;
   END;

   Fak:=(3.0-FLOAT(ModeFlag));
   xs:=Minbr*(3-ModeFlag);
   ys:=Minho*(3-ModeFlag);

   TextDef;

   Quit:=FALSE;
END; {Init}

{-------------------------------------------------------------------------}

BEGIN {MAIN}
   Init;
   OpenAll;

   FOR t:=0 TO 8 DO BEGIN {t heißt eigentlich Atf, ist aber schon besetzt}
      Arbb[t]:=TRUNC(FLOAT(Minbr)*SPPow(8.0-FLOAT(t),2.0)); {2^(8-t)}
      Arbh[t]:=TRUNC(FLOAT(Minho)*SPPow(8.0-FLOAT(t),2.0));
      Arbfeld[t]:=1;
      Apktx[t]:=0;
      Apkty[t]:=0;
   END;                   {Gehoert eigentlich in Init; dort ist aber die
                           MathTrans-Library (SPPow) noch nicht auf}

   Color;
   LadKoord;
   LadGet;
   LadMark;

   NoHide:=TRUE;
   ShowTitle(s, NoHide);

   IF Fast=1 THEN
      FastDraw(0,0,640 DIV Modeflag,(Skonst*2) DIV Modeflag,xs,ys,FALSE)
   ELSE
      Areatest;

   IF (NOT Quit) AND
    (Fast = 1) THEN BEGIN
      Reqflag:=AutoRequest(bw,Feintxt,OK,Cancel,20,20,257,60);
      IF ReqFlag THEN BEGIN
         NoHide:=TRUE;
         ShowTitle(s, NoHide);
         Clear;
         LadMark;
         AreaTest;
         Fast := 2;
      END;
   END;

   IF (NOT Quit) AND
    (Fast = 2) THEN BEGIN
      NoHide:=FALSE;
      ShowTitle(s, NoHide);
      REPEAT
         Reqflag:=AutoRequest(bw,Repair,OK,Cancel,20,20,225,60);
         IF ReqFlag THEN BEGIN
            SetRepArea;
            RepairArea;
         END ELSE BEGIN
            NoHide:=TRUE;
            ShowTitle(s, NoHide);
         END;
      UNTIL ReqFlag = FALSE;
   END;

   WHILE Quit=FALSE DO BEGIN
      m:=WaitPort(bw^.UserPort);
      m:=GetMsg(bw^.UserPort);
      IF m <> nil THEN BEGIN
         HandleMessage;
      END;
   END;

   CloseAll;
END. {MAIN}

{-------------------------------------------------------------------------}