(* Modul    : FFEX							 *)
(* Projekt  : FFEX (Fast Fractal Exploration Set)			 *)
(* Autor    : Robert Brandner						 *)
(* Funktion : Hauptmodul von FFEX - Menüabfragen, Zoom, Berechnungen ... *)
(* Copyright: Robert Brandner						 *)
(*	      Schillerstr. 3						 *)
(*	      A-8280 Fürstenfeld					 *)
(*	      AUSTRIA							 *)

MODULE FFEX;

FROM Menu      IMPORT SetMenu, MenuNum, ItemNum, SubNum, NextSelect;
FROM Render    IMPORT SetPixel,GetPixel,FastIter16,FastIter32,LongRealIter,
                      SetNormalPointer,SetZZZPointer,SetZoomPointer;
FROM Request   IMPORT Info, GetLimits, Request;
FROM ArpReq    IMPORT GetFileName;
FROM IlbmInOut IMPORT LoadILBM, SaveILBM;

FROM Arts      IMPORT Assert, TermProcedure;
FROM SYSTEM    IMPORT ADR, ADDRESS, CAST, INLINE, LONGSET;
FROM GfxMacros IMPORT RasSize;
FROM Graphics  IMPORT ViewModes,ViewModeSet,FontFlags,FontFlagSet,
                      TextFontPtr, OpenFont,normalFont,TextAttr,CloseFont,
                      LoadRGB4, SetRGB4, RastPortPtr,RectFill,SetAPen,
                      SetRast, Move, Draw, SetDrMd, DrawModeSet,DrawModes,
                      jam1, BltBitMap;
FROM Intuition IMPORT IntuiMessagePtr, menuNull, ShowTitle, ModifyIDCMP,
  		      ScreenPtr,NewScreen,OpenScreen,CloseScreen,
		      WindowPtr,NewWindow,OpenWindow,CloseWindow,
		      WindowFlags,WindowFlagSet,ScreenFlags,ScreenFlagSet,
		      customScreen, IDCMPFlagSet, IDCMPFlags, ScreenToFront,
		      ClearMenuStrip, menuDown, menuUp, selectDown, selectUp;
FROM Exec      IMPORT FindTask, TaskPtr, GetMsg, ReplyMsg, WaitPort, CopyMem;
FROM Dos       IMPORT ProcessPtr;

CONST
  SCREENTITLE="Fast Fractal Exploration Set 4.0";
  TOPAZ="topaz.font";
  LIMIT=4; (* bis zu dieser Größe werden Rechtecke gevierte(i)lt *)
  ESCAPE=045H;
  MENUFLAGS=IDCMPFlagSet{menuVerify,menuPick,mouseButtons};
  STARTPIC="FFEXStart.pic";

TYPE
  IterProc=PROCEDURE(LONGREAL,LONGREAL,LONGINT):LONGINT;

VAR
  ns        : NewScreen;
  nw        : NewWindow;
  Iterations: IterProc;
  win       : WindowPtr;
  scr       : ScreenPtr;
  topaz80   : TextFontPtr;
  attr      : TextAttr;
  thisTask  : ProcessPtr;
  QUIT,title: BOOLEAN;
  yadr      : ARRAY[0..512] OF LONGINT;
  rp        : RastPortPtr;
  msg       : IntuiMessagePtr;
  class     : IDCMPFlagSet;
  code      : CARDINAL;
  xres,yres,depth,i,maxcol: INTEGER;
  xmin,ymin,xmax,ymax     : LONGREAL; (* Koord. des zu zeichnenden Bildes *)
  xminr,yminr,xmaxr,ymaxr : LONGREAL; (* Koord. des letzten gez. Bildes *)
  x1,y1,x2,y2             : LONGREAL; (* Hilfsvariablen *)
  maxiter                 : LONGINT;
  zx,zy,zdx,zdy           : INTEGER;  (* Zoomrahmen *)
  fileok    : BOOLEAN;
  fname     : ARRAY[0..255] OF CHAR;  (* für Filerequester *)
  saved     : BOOLEAN;
  mess      : ARRAY[0..80] OF CHAR;
  no,yes    : ARRAY[0..9] OF CHAR;

PROCEDURE TextColorsOn; FORWARD;
PROCEDURE TextColorsOff; FORWARD;
PROCEDURE CreateDisplay(w,h,d:INTEGER); FORWARD;

PROCEDURE LoadIff(fn:BOOLEAN);
  VAR
    i,planebytes,ok:LONGINT;
    lscr:ScreenPtr;
  BEGIN
    IF NOT saved THEN
      mess:="This picture is not saved!|If you continue, it will be lost!";
      yes:="CONTINUE"; no:="CANCEL";
      IF NOT Request(win,mess,yes,no) THEN RETURN END;
    END;
    INCL(win^.flags,rmbTrap);
    ModifyIDCMP(win,IDCMPFlagSet{});
    IF fn THEN
      TextColorsOn;
      fileok:=GetFileName(win,ADR("Load File"),ADR(fname));
      TextColorsOff;
    ELSE
      fileok:=TRUE
    END;
    IF fileok THEN
      SetZZZPointer(win);
      fileok:=LoadILBM(fname,win,lscr,xminr,yminr,xmaxr,ymaxr,maxiter);
      IF fileok THEN
        xmin:=xminr; ymin:=yminr; xmax:=xmaxr; ymax:=ymaxr;
        IF (lscr^.width#xres) OR (lscr^.height#yres) THEN
          CreateDisplay(lscr^.width,lscr^.height,INTEGER(lscr^.bitMap.depth));
        END;
        saved:=TRUE;
        ShowTitle(scr,FALSE);
        ok:=BltBitMap(ADR(lscr^.bitMap),0,0,ADR(scr^.bitMap),0,0,
                      xres,yres,0C0H,0FFH,NIL);
        ShowTitle(scr,title);
        CloseScreen(lscr);
      END;
      SetNormalPointer(win);
    END;
    EXCL(win^.flags,rmbTrap);
    ModifyIDCMP(win,MENUFLAGS);
  END LoadIff;

PROCEDURE SaveIff;
  BEGIN
    ClearMenuStrip(win);
    ModifyIDCMP(win,IDCMPFlagSet{});
    TextColorsOn;
    fileok:=GetFileName(win,ADR("Save File"),ADR(fname));
    TextColorsOff;
    IF fileok THEN
      INCL(win^.flags,rmbTrap);
      SetZZZPointer(win); ShowTitle(scr,FALSE);
      fileok:=SaveILBM(fname,scr,xminr,yminr,xmaxr,ymaxr,maxiter);
      saved:=fileok;
      SetNormalPointer(win); ShowTitle(scr,title); EXCL(win^.flags,rmbTrap);
    END;
    ModifyIDCMP(win,MENUFLAGS);
    SetMenu(win);
  END SaveIff;

(*** Prozeduren für Screen und Window ********************************)

PROCEDURE ColorTable; (* $E- *)
  BEGIN
    INLINE(00000H,00FF0H,00FD0H,00FB0H,00F80H,00F60H,00F40H,00F20H,
	   00F00H,00F02H,00F05H,00F07H,00F09H,00F0BH,00F0DH,00F0FH,
	   00D0FH,00B0FH,0090FH,0070FH,0050FH,0030FH,0010FH,0001FH,
	   0003FH,0005FH,0007FH,0009FH,000BFH,000DFH,000FFH,00DDDH);
  END ColorTable;


PROCEDURE CloseIfOpen;
  BEGIN
    thisTask:=CAST(ProcessPtr,FindTask(NIL));
    thisTask^.windowPtr:=NIL;
    IF win#NIL THEN CloseWindow(win); win:=NIL END;
    IF scr#NIL THEN CloseScreen(scr); scr:=NIL END;
  END CloseIfOpen;


PROCEDURE CreateDisplay(w,h,d:INTEGER);
  BEGIN
    xres:=w; yres:=h; depth:=d; (* Werte für DrawFractal/Zoom merken *)
    IF NOT saved THEN
      mess:="This picture is not saved!|If you continue, it will be lost!";
      yes:="CONTINUE"; no:="CANCEL";
      IF NOT Request(win,mess,yes,no) THEN RETURN END;
    END;
    CloseIfOpen;
    WITH ns DO
      width:=w; height:=h; depth:=d; detailPen:=6; blockPen:=1;
      viewModes:=ViewModeSet{};
      IF w>320 THEN INCL(viewModes,hires) END;
      IF h>256 THEN INCL(viewModes,lace) END;
      type:=customScreen+ScreenFlagSet{screenBehind};
      font:=ADR(attr); defaultTitle:=ADR(SCREENTITLE);
      gadgets:=NIL; customBitMap:=NIL;
    END;
    scr:=OpenScreen(ns);
    Assert(scr#NIL,ADR("OpenScreen() failed!"));
    LoadRGB4(ADR(scr^.viewPort),ADR(ColorTable),32);
    IF d=5 THEN maxcol:=31 ELSE maxcol:=15 END;
    WITH nw DO
      width:=w; height:=h; detailPen:=3; blockPen:=1;
      idcmpFlags:=IDCMPFlagSet{menuVerify, menuPick, mouseButtons};
      flags:=WindowFlagSet{reportMouse,backDrop,borderless,
                           activate,noCareRefresh};
      firstGadget:=NIL;checkMark:=NIL;title:=NIL;
      screen:=scr; bitMap:=NIL;
      minWidth:=0; minHeight:=0; maxWidth:=-1; maxHeight:=-1;
      type:=customScreen;
    END;
    win:=OpenWindow(nw);
    Assert(win#NIL,ADR("OpenWindow() failed!"));
    rp:=win^.rPort;
    FOR i:=0 TO h-1 DO  (* Zeilenadressen berechnen      *)
      yadr[i]:=LONGINT(i)*LONGINT(rp^.bitMap^.bytesPerRow);
    END;
    ScreenToFront(scr);
    thisTask:=CAST(ProcessPtr,FindTask(NIL)); (* Systemrequester auf *)
    thisTask^.windowPtr:=win;		      (* eigenem Screen.     *)
    SetMenu(win);
    title:=TRUE; ShowTitle(scr,title);
  END CreateDisplay;


(*** Prozeduren für Fraktalgrafik ************************************)

PROCEDURE DrawFractal(rmin,rmax,imin,imax:LONGREAL;
		      maxcol:INTEGER;
		      maxiter:LONGINT);
VAR
  r,cxr,cyr,dxr,dyr:LONGREAL;
  lc:LONGINT;
  exit:BOOLEAN;

PROCEDURE HLine(xmin,xmax,y:INTEGER); (* waagrechte Linie *)
BEGIN
  cxr:=rmin+LONGREAL(xmin)*dxr;cyr:=imin+LONGREAL(y)*dyr;
  FOR i:=xmin TO xmax DO
    lc:=Iterations(cxr,cyr,maxiter);cxr:=cxr+dxr;
    SetPixel(i,yadr[y],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
  END
END HLine;

PROCEDURE VLine(ymin,ymax,x:INTEGER); (* senkrechte Linie *)
BEGIN
  cxr:=rmin+LONGREAL(x)*dxr;cyr:=imin+LONGREAL(ymin)*dyr;
  FOR i:=ymin TO ymax DO
    lc:=Iterations(cxr,cyr,maxiter);cyr:=cyr+dyr;
    SetPixel(x,yadr[i],lc,maxiter,maxcol,ADR(rp^.bitMap^.planes[0]));
  END
END VLine;

PROCEDURE Rectangle(xmin,ymin,xmax,ymax:INTEGER);
  VAR
    eq:BOOLEAN;
    dx2,dy2,k:INTEGER;
  BEGIN
    IF exit THEN RETURN END;
    msg:=GetMsg(win^.userPort);
    IF msg#NIL THEN
      ReplyMsg(msg);
      IF msg^.code=ESCAPE THEN exit:=TRUE END;
    END;
    dx2:=(xmax-xmin);dy2:=(ymax-ymin);
    IF (dx2<2) OR (dy2<2) THEN RETURN END;
    IF (dx2<LIMIT) OR (dy2<LIMIT) THEN
      FOR k:=ymin+1 TO ymax-1 DO HLine(xmin+1,xmax-1,k) END;
      RETURN;
    END;
    dx2:=(1+dx2) DIV 2;dy2:=(1+dy2) DIV 2;
    lc:=GetPixel(xmin,yadr[ymin],depth, ADR(rp^.bitMap^.planes[0]));
    i:=xmin;eq:=TRUE;
    REPEAT
      INC(i);
      eq:=(lc=GetPixel(i,yadr[ymin],depth,ADR(rp^.bitMap^.planes[0]))) &
          (lc=GetPixel(i,yadr[ymax],depth,ADR(rp^.bitMap^.planes[0])));
    UNTIL (i=xmax) OR NOT eq;
    IF eq THEN
      i:=ymin;
      REPEAT
        INC(i);
        eq:=(lc=GetPixel(xmin,yadr[i],depth,ADR(rp^.bitMap^.planes[0]))) &
            (lc=GetPixel(xmax,yadr[i],depth,ADR(rp^.bitMap^.planes[0])));
      UNTIL (i=ymax) OR NOT eq;
    END;
    IF eq THEN (* ganzer Rand einfärbig => Rechteck einfärbig *)
      SetAPen(rp,lc);RectFill(rp,xmin,ymin,xmax,ymax);
    ELSE
      (* Rechteck vierteln, und alle Viertel testen        *)
      HLine(xmin+1,xmax-1,ymin+dy2);
      VLine(ymin+1,ymax-1,xmin+dx2);
      Rectangle(xmin,ymin,xmin+dx2,ymin+dy2);
      Rectangle(xmin+dx2,ymin,xmax,ymin+dy2);
      Rectangle(xmin,ymin+dy2,xmin+dx2,ymax);
      Rectangle(xmin+dx2,ymin+dy2,xmax,ymax);
    END;
  END Rectangle;

  BEGIN	(* DrawFractal *)
    INCL(win^.flags,rmbTrap);
    ShowTitle(scr,FALSE); SetZZZPointer(win);
    ModifyIDCMP(win,IDCMPFlagSet{rawKey});
    ClearMenuStrip(win);
    saved:=FALSE;
    SetRast(rp,0);
    dxr:=(rmax-rmin)/LONGREAL(xres);
    dyr:=(imax-imin)/LONGREAL(yres);
    IF zx#-1 THEN (* wenn Zoomrahmen, dann diesen Ausschnitt zeichnen *)
      r:=rmin;
      rmin:=r+LONGREAL(zx-zdx)*dxr;
      rmax:=r+LONGREAL(zx+zdx)*dxr;
      r:=imin;
      imin:=r+LONGREAL(zy-zdy)*dyr;
      imax:=r+LONGREAL(zy+zdy)*dyr;
      dxr:=(rmax-rmin)/LONGREAL(xres);
      dyr:=(imax-imin)/LONGREAL(yres);
      zx:=-1; (* Damit der Rahmen anschließend nicht gezeichnet wird *)
    END;
    xminr:=rmin; xmaxr:=rmax; yminr:=imin; ymaxr:=imax;
    xmin:=rmin; xmax:=rmax; ymin:=imin; ymax:=imax;
    exit:=FALSE;
    HLine(0,xres-1,0);VLine(0,yres-1,xres-1); (* Anfangs-  *)
    HLine(0,xres-1,yres-1);VLine(0,yres-1,0); (* rechteck  *)
    Rectangle(0,0,xres-1,yres-1);
    EXCL(win^.flags,rmbTrap);
    SetMenu(win);
    ModifyIDCMP(win,IDCMPFlagSet{menuPick,menuVerify,mouseButtons});
    ShowTitle(scr,title); SetNormalPointer(win);
  END DrawFractal;


(*** Prozeduren für Zoom *********************************************)

PROCEDURE DrawFrame(x1,y1,dx,dy:INTEGER);
  BEGIN
    SetAPen(rp,15); (* 4 Bitplanes beeinflussen *)
    SetDrMd(rp,DrawModeSet{complement}); (* Bild nicht zerstören *)
    Move(rp,x1-dx,y1-dy);
    Draw(rp,x1+dx,y1-dy);Draw(rp,x1+dx,y1+dy);
    Draw(rp,x1-dx,y1+dy);Draw(rp,x1-dx,y1-dy);
    SetDrMd(rp,jam1);
  END DrawFrame;


PROCEDURE Zoom; (* Ausschnitt wählen, unverzerrt!        *)
  VAR
    x1,y1,dx,dy,mx,my:INTEGER;
    r,dxr,dyr:LONGREAL;
  BEGIN
    IF zx#-1 THEN DrawFrame(zx,zy,zdx,zdy) END;    (* Rahmen löschen *)
    xmin:=xminr; xmax:=xmaxr;
    ymin:=yminr; ymax:=ymaxr;
    ModifyIDCMP(win,IDCMPFlagSet{mouseButtons,mouseMove});
    ShowTitle(scr,FALSE);
    SetZoomPointer(win);
    REPEAT                          (* warten bis Maustaste gedrückt *)
      WaitPort(win^.userPort);
      msg:=GetMsg(win^.userPort);
      ReplyMsg(msg);
    UNTIL (mouseButtons IN msg^.class);
    IF (msg^.code = menuDown) THEN                 (* RMB => Abbruch *)
      ShowTitle(scr,title); SetNormalPointer(win);
      ModifyIDCMP(win,MENUFLAGS);
      zx:=-1;
      RETURN;
    END;
    IF (msg^.code = selectDown) THEN               (* LMB => Zoomen  *)
      x1:=msg^.mouseX; y1:=msg^.mouseY;            (* Mittelpunkt    *)
      dx:=0;dy:=0;
      DrawFrame(x1,y1,dx,dy);              (* ersten Rahmen zeichnen *)
      LOOP
        msg:=GetMsg(win^.userPort);
        IF msg#NIL THEN
          IF (mouseButtons IN msg^.class) & (msg^.code = menuDown) THEN
            DrawFrame(x1,y1,dx,dy);                (* Rahmen löschen *)
            zx:=-1;                   (* merken, daß Rahmen gelöscht *)
            ReplyMsg(msg);
            ShowTitle(scr,title); SetNormalPointer(win);
            ModifyIDCMP(win,MENUFLAGS);
            RETURN;
          END;
          IF (mouseButtons IN msg^.class) & (msg^.code = selectUp) THEN
            (* Position der Maus merken (für Rechteck)     *)
            mx:=msg^.mouseX;my:=msg^.mouseY;
            ReplyMsg(msg);
            zx:=x1; zy:=y1; zdx:=dx; zdy:=dy; (* Merken, wo der Rahmen ist *)
            EXIT;
          END;
          IF (mouseMove IN msg^.class) THEN
            DrawFrame(x1,y1,dx,dy); (* alten Rand löschen  *)
            mx:=msg^.mouseX;my:=msg^.mouseY;
            dx:=x1-mx; dy:=y1-my;
            dx:=ABS(dx); dy:=ABS(dy);
            (* Skalierung. hoffentlich richtig   	   *)
            IF (dy>dx) THEN
              dx:=(xres*dy)/yres;
            ELSE
              dy:=(yres*dx)/xres;
            END;
            DrawFrame(x1,y1,dx,dy); (* neuen Rand zeichnen *)
          END;
          ReplyMsg(msg);
        END;
      END;
    END;
    ShowTitle(scr,title); SetNormalPointer(win);
    ModifyIDCMP(win,MENUFLAGS);
  END Zoom;


(*** Prozeduren für Userinterface ************************************)

PROCEDURE TextColorsOn;
  BEGIN
    SetRGB4(ADR(scr^.viewPort),1,13,13,13);
    SetRGB4(ADR(scr^.viewPort),2,8,8,8);
    SetRGB4(ADR(scr^.viewPort),3,5,5,5);
    SetRGB4(ADR(scr^.viewPort),30,5,5,5);
    SetRGB4(ADR(scr^.viewPort),14,5,5,5);
    SetRGB4(ADR(scr^.viewPort),28,14,14,14);
    SetRGB4(ADR(scr^.viewPort),12,14,14,14);
    SetRGB4(ADR(scr^.viewPort),15,13,13,13);
  END TextColorsOn;

PROCEDURE TextColorsOff;
  BEGIN
    LoadRGB4(ADR(scr^.viewPort),ADR(ColorTable),32);
  END TextColorsOff;

PROCEDURE MenuHandler;
  VAR
    selection, menuNum, itemNum, subNum : CARDINAL;
  BEGIN
    LOOP
      msg:=GetMsg(win^.userPort);
      IF msg=NIL THEN EXIT END;
      class:=msg^.class;
      code :=msg^.code;
      IF class=IDCMPFlagSet{menuVerify} THEN
        TextColorsOn;
      END;
      ReplyMsg(msg); (* muß nach menuVerify-Abfrage stehen *)
      IF (mouseButtons IN class) & (code=menuUp) THEN
        TextColorsOff;
      END;
      IF menuPick IN class THEN
        selection:=code;
        WHILE selection#menuNull DO
          menuNum:=MenuNum(selection);
          itemNum:=ItemNum(selection);
          subNum :=SubNum(selection);
          CASE menuNum OF
            0 : (* Project Menü *)
            CASE itemNum OF
              0 : LoadIff(TRUE); zx:=-1;|
              1 : SaveIff;| (* -""- *)
              2 : ClearMenuStrip(win);
                  ModifyIDCMP(win,IDCMPFlagSet{});
                  TextColorsOn; Info(win); TextColorsOff;
                  SetMenu(win);
                  ModifyIDCMP(win,MENUFLAGS);
                  EXIT;|
              3 : IF NOT saved THEN
                    mess:="Really quit?!|Picture will be lost!";
                    yes:="QUIT!"; no:="NO!";
                    IF Request(win,mess,yes,no) THEN
                      QUIT:=TRUE; EXIT;
                    END
                  ELSE
                    QUIT:=TRUE; EXIT;
                  END;|
              ELSE;
            END;|
            1 : (* Setup Menü *)
            CASE itemNum OF
              0 : (* Auflösung  *)
              CASE subNum OF
                0 : zx:=-1; CreateDisplay(320, 256, 5); EXIT;|
                1 : zx:=-1; CreateDisplay(640, 256, 4); EXIT;|
                2 : zx:=-1; CreateDisplay(640, 512, 4); EXIT;|
                ELSE;
              END;|
              1 : (* Algorithmen *)
              CASE subNum OF
                0 : Iterations:=FastIter16;|
                1 : Iterations:=FastIter32;|
                2 : Iterations:=LongRealIter;|
                ELSE;
              END;|
              2 : ClearMenuStrip(win);
                  ModifyIDCMP(win,IDCMPFlagSet{});
                  TextColorsOn;
                  GetLimits(scr,xmin,xmax,ymin,ymax,maxiter);
                  TextColorsOff;
                  IF (zx#-1) AND
                    ((xminr#xmin) OR (xmaxr#xmax) OR   (* bei neuen *)
                    (yminr#ymin) OR (ymaxr#ymax)) THEN (* Grenzen   *)
                    DrawFrame(zx,zy,zdx,zdy); zx:=-1;  (* Rahmen    *)
                  END;                                 (* löschen   *)
		  SetMenu(win);
                  ModifyIDCMP(win,MENUFLAGS);|
              ELSE;
            END;|
            2 : (* Action Menü *)
            CASE itemNum OF
              0 : TextColorsOff; title:=NOT title; ShowTitle(scr, title);|
              1 : TextColorsOff; Zoom;|
              2 : TextColorsOff;
                  DrawFractal(xmin,xmax,ymin,ymax,maxcol,maxiter); |
              ELSE;
            END;|
            ELSE;
          END;
          selection:=NextSelect(selection);
        END;   (* WHILE  *)
      END;     (* IF *)
    END;     (* LOOP  *)
  END MenuHandler;


PROCEDURE CleanUp;
  BEGIN
    CloseIfOpen;
    IF topaz80#NIL THEN CloseFont(topaz80) END;
  END CleanUp;


  BEGIN
    TermProcedure(CleanUp);
    WITH attr DO
      name :=ADR(TOPAZ); ySize:=8; style:=normalFont;
      flags:=FontFlagSet{romFont,designed};
    END;
    topaz80:=OpenFont(ADR(attr));
    saved:=TRUE;
    zx:=-1;                     (* noch kein Zoomrahmen gezeichnet *)
    title:=TRUE;                              (* Titlebar sichtbar *)
    QUIT:=FALSE;
    xres:=320; yres:=256; depth:=5;        (* Anfangsauflösung *)
    Iterations:=FastIter16;
    fname:="FFEX_Start.pic";
    CreateDisplay(xres, yres, depth);
    LoadIff(FALSE);
    REPEAT
      WaitPort(win^.userPort);
      MenuHandler;
    UNTIL QUIT;
  END FFEX.