home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 559b.lha / FFEX / source / request.mod < prev   
Encoding:
Modula Implementation  |  1991-09-19  |  9.3 KB  |  305 lines
  1. IMPLEMENTATION MODULE Request;
  2.  
  3. FROM Menu      IMPORT InitText;
  4. FROM Intuition IMPORT IntuiText, AutoRequest, Gadget, StringInfo, Border,
  5.                   GadgetFlags, GadgetFlagSet, ActivationFlags,
  6.                     ActivationFlagSet, boolGadget, strGadget,
  7.                WindowPtr, IntuiTextPtr, IDCMPFlags,IDCMPFlagSet,
  8.                   OpenWindow,CloseWindow,NewWindow, WindowFlags,
  9.                   WindowFlagSet, RefreshGadgets, ScreenPtr, customScreen,
  10.                   IntuiMessagePtr, ActivateGadget;
  11. FROM Exec      IMPORT WaitPort,GetMsg,ReplyMsg,CopyMem;
  12. FROM Graphics  IMPORT jam1, SetAPen, SetRast, Move, Draw, RectFill, Text,
  13.               SetDrMd, RastPortPtr, TextLength;
  14. FROM SYSTEM    IMPORT INLINE,ADR,ADDRESS, LONGSET;
  15. FROM Arts      IMPORT Assert, TermProcedure;
  16. FROM Str       IMPORT FirstPos,Length,noOccur,Copy,Concat;
  17. FROM Conversions         IMPORT StrToVal,ValToStr;
  18. FROM LongRealConversions IMPORT StrToReal,RealToStr;
  19.  
  20. VAR i,j : INTEGER;
  21.  
  22. (*** Requester *******************************************************)
  23.  
  24. CONST MAXBODYLINES=6;
  25.       OK=IDCMPFlagSet{};
  26.  
  27. VAR bodytxt        : ARRAY[0..MAXBODYLINES-1] OF IntuiText;
  28.     bodylines      : ARRAY[0..MAXBODYLINES-1],[0..79] OF CHAR;
  29.     postxt,negtxt  : IntuiText;
  30.     index,p,len,
  31.     oldpos,maxlen,
  32.     maxi,w,h     : INTEGER;
  33.     padr,nadr      : ADDRESS;
  34.  
  35. PROCEDURE Request(win:WindowPtr; VAR body,pos,neg:ARRAY OF CHAR):BOOLEAN;
  36.   BEGIN
  37.     (*** body in Zeilen zerlegen (mit | unterteilt) ***)
  38.     index:=0; oldpos:=0;
  39.     REPEAT
  40.       p:=FirstPos(body,oldpos,'|');
  41.       IF p=noOccur THEN
  42.         CopyMem(ADR(body[oldpos]),ADR(bodylines[index]),
  43.                 INTEGER(Length(body))-oldpos);
  44.         bodylines[index,INTEGER(Length(body))-oldpos]:=CHAR(0);
  45.       ELSE
  46.         CopyMem(ADR(body[oldpos]),ADR(bodylines[index]),p-oldpos);
  47.         bodylines[index,p-oldpos]:=CHAR(0);
  48.       END;
  49.       oldpos:=p+1;
  50.       INC(index);
  51.     UNTIL p=noOccur;
  52.     (*** größte Länge feststellen ***)
  53.     maxlen:=0; maxi:=0;
  54.     FOR i:=0 TO index-1 DO
  55.       len:=Length(bodylines[i]);
  56.       IF len>maxlen THEN maxlen:=len; maxi:=i END;
  57.     END;
  58.     FOR i:=0 TO index-1 DO
  59.       InitText(bodytxt[i],10,5+i*10,ADR(bodylines[i]));
  60.     END;
  61.     FOR i:=0 TO index-2 DO
  62.       bodytxt[i].nextText:=ADR(bodytxt[i+1])
  63.     END;
  64.  
  65.     InitText(postxt,6,3,ADR(pos)); (* wegen ADR(pos), ADR(neg) sind *)
  66.     InitText(negtxt,6,3,ADR(neg)); (* pos und neg VAR Parameter!!!  *)
  67.  
  68.     padr:=ADR(postxt);  nadr:=ADR(negtxt);
  69.     IF Length(pos)=0 THEN padr:=NIL END;
  70.     w:=TextLength(win^.rPort,ADR(bodylines[maxi]),maxlen)+38;
  71.     h:=42+index*10;
  72.     RETURN (AutoRequest(win, ADR(bodytxt[0]), padr, nadr, OK, OK, w, h));
  73.   END Request;
  74.  
  75. (***  Info-Requester *************************************************)
  76.  
  77. VAR infotext:ARRAY[0..255] OF CHAR;
  78.     ok,nok:ARRAY[0..9] OF CHAR;
  79.  
  80. PROCEDURE Info(win:WindowPtr);
  81.   BEGIN IF Request(win,infotext,ok,nok) THEN END; END Info;
  82.  
  83. (*** Limit-Requester *************************************************)
  84.  
  85. CONST
  86.   STR=ActivationFlagSet{gadgImmediate};
  87.   BOOL=ActivationFlagSet{gadgImmediate,relVerify};
  88.   EXPO=FALSE; (* Zahlen in Exponentenschreibweise *)
  89.  
  90.   RMIN=-2.1;
  91.   RMAX=0.6;
  92.   IMIN=-1.0;
  93.   IMAX=1.0;
  94.   ITER=50;
  95.  
  96. VAR
  97.   wi       : WindowPtr;
  98.   strinfo  : ARRAY[0..4] OF StringInfo;
  99.   gad      : ARRAY[0..8] OF Gadget;
  100.   buff     : ARRAY[0..3],[0..20] OF CHAR;
  101.   iterbuff : ARRAY[0..5] OF CHAR;
  102.   undo     : ARRAY[0..20] OF CHAR;
  103.   nw       : NewWindow;
  104.   msg      : IntuiMessagePtr;
  105.   id       : INTEGER;
  106.   help     : POINTER TO Gadget;
  107.   rp       : RastPortPtr;
  108.  
  109.  
  110. PROCEDURE InitGad(nr,x,y,w,h:INTEGER;
  111.                   act:ActivationFlagSet;
  112.                   typ:CARDINAL;info:ADDRESS);
  113.   BEGIN
  114.     WITH gad[nr] DO
  115.       nextGadget:=NIL; leftEdge:=x;topEdge:=y;width:=w;height:=h;
  116.       flags:=GadgetFlagSet{};activation:=act;
  117.       gadgetType:=typ;
  118.       gadgetRender:=NIL; selectRender:=NIL;
  119.       gadgetText:=NIL; mutualExclude:=LONGSET{};
  120.       specialInfo:=info; gadgetID:=nr;userData:=NIL;
  121.     END;
  122.   END InitGad;
  123.  
  124.  
  125. PROCEDURE BufferToVal(VAR rmin,rmax,imin,imax:LONGREAL;
  126.                       VAR maxiter:LONGINT):BOOLEAN;
  127.  
  128. (* Gadgets auslesen, bei falscher Eingabe Gad aktivieren *)
  129.  
  130.   VAR
  131.     err,dummy,sign:BOOLEAN;
  132.   BEGIN
  133.     sign:=FALSE;
  134.     StrToReal(buff[0],rmin,err);
  135.     IF err THEN dummy:=ActivateGadget(ADR(gad[0]),wi,NIL);
  136.     RETURN FALSE; END;
  137.  
  138.     StrToReal(buff[1],rmax,err);
  139.     IF err THEN dummy:=ActivateGadget(ADR(gad[1]),wi,NIL);
  140.     RETURN FALSE;END;
  141.  
  142.     StrToReal(buff[2],imin,err);
  143.     IF err THEN dummy:=ActivateGadget(ADR(gad[2]),wi,NIL);
  144.     RETURN FALSE;END;
  145.  
  146.     StrToReal(buff[3],imax,err);
  147.     IF err THEN dummy:=ActivateGadget(ADR(gad[3]),wi,NIL);
  148.     RETURN FALSE;END;
  149.  
  150.     StrToVal(iterbuff,maxiter,sign,10,err);
  151.     IF err THEN dummy:=ActivateGadget(ADR(gad[4]),wi,NIL);
  152.     RETURN FALSE;END;
  153.  
  154.     RETURN TRUE;
  155.   END BufferToVal;
  156.  
  157.  
  158. PROCEDURE ValToBuffer(rmin,rmax,imin,imax:LONGREAL;iter:LONGINT);
  159.   VAR
  160.     err:BOOLEAN;
  161.   BEGIN
  162.     RealToStr(rmin,buff[0],12,10,EXPO,err);
  163.     RealToStr(rmax,buff[1],12,10,EXPO,err);
  164.     RealToStr(imin,buff[2],12,10,EXPO,err);
  165.     RealToStr(imax,buff[3],12,10,EXPO,err);
  166.     ValToStr(iter,FALSE,iterbuff,10,-5,CHAR(0),err);
  167.     RefreshGadgets(ADR(gad[0]),wi,NIL);
  168.   END ValToBuffer;
  169.  
  170.  
  171. PROCEDURE GetLimits(s:ScreenPtr;
  172.                     VAR rmin,rmax,imin,imax:LONGREAL;
  173.                     VAR maxiter:LONGINT);
  174.  
  175.   BEGIN
  176.     nw.screen:=s;
  177.     nw.leftEdge:=(s^.width-300)/2;   (* Window zentrieren *)
  178.     nw.topEdge:=(s^.height-89)/2-10; (* 10 Pixel über der Mitte *)
  179.     wi:=OpenWindow(nw);
  180.     Assert(wi#NIL,ADR("Can't open Limits Window"));
  181.  
  182.     rp:=wi^.rPort;
  183.     SetAPen(rp,1); RectFill(rp,0,10,299,88); (* Hintergrund *)
  184.     SetAPen(rp,2); RectFill(rp,2,10,297,87);
  185.     SetAPen(rp,1); RectFill(rp,4,12,295,63); RectFill(rp,4,66,295,85);
  186.  
  187.     FOR i:=0 TO 3 DO (* Grafik für Bool Gadgets *)
  188.       SetAPen(rp,2);
  189.       RectFill(rp,14+i*70,68,71+i*70,82);
  190.       RectFill(rp,18+i*70,70,75+i*70,84);
  191.       SetAPen(rp,1);
  192.       RectFill(rp,15+i*70,69,70+i*70,81);
  193.     END;
  194.  
  195.     FOR i:=0 TO 1 DO
  196.       FOR j:=0 TO 1 DO
  197.         SetAPen(rp,2); RectFill(rp,57+i*121,15+j*18,162+i*121,24+j*18);
  198.         SetAPen(rp,0); RectFill(rp,58+i*121,16+j*18,161+i*121,23+j*18);
  199.       END;
  200.     END;
  201.  
  202.     SetAPen(rp,2); RectFill(rp,105,51,162,60);
  203.     SetAPen(rp,0); RectFill(rp,106,52,161,59);
  204.  
  205.     (* Texte ausgeben *)
  206.     SetDrMd(rp,jam1); SetAPen(rp,2);
  207.     Move(rp,16,22);  Text(rp,ADR("Real"),4);
  208.     Move(rp,158,22); Text(rp,ADR(" ; "),3);
  209.     Move(rp,16,40);  Text(rp,ADR("Imag"),4);
  210.     Move(rp,158,40); Text(rp,ADR(" ; "),3);
  211.     Move(rp,16,58);  Text(rp,ADR("Iterations"),10);
  212.     SetAPen(rp,0);
  213.     Move(rp,35,78); Text(rp,ADR("OK"),2);
  214.     Move(rp,93,78); Text(rp,ADR("Reset"),5);
  215.     Move(rp,168,78); Text(rp,ADR("Undo"),4);
  216.     Move(rp,230,78); Text(rp,ADR("CANCEL"),6);
  217.  
  218.     ValToBuffer(rmin,rmax,imin,imax,maxiter);
  219.  
  220.     RefreshGadgets(ADR(gad[0]),wi,NIL); (* Gadgets zeigen *)
  221.  
  222.     (*** Eingaben: ***)
  223.  
  224.     LOOP
  225.  
  226.       WaitPort(wi^.userPort);
  227.  
  228.       msg:=GetMsg(wi^.userPort);
  229.       WHILE msg#NIL DO
  230.         IF closeWindow IN msg^.class THEN
  231.           ReplyMsg(msg);
  232.           ValToBuffer(rmin,rmax,imin,imax,maxiter); EXIT;
  233.         ELSIF gadgetUp IN msg^.class THEN
  234.           id:=-1;
  235.           help:=msg^.iAddress;
  236.           id:=help^.gadgetID;
  237.           ReplyMsg(msg);
  238.           CASE id OF
  239.             5 : IF BufferToVal(rmin,rmax,imin,imax,maxiter) THEN EXIT END; |
  240.             6 : ValToBuffer(RMIN,RMAX,IMIN,IMAX,ITER); |
  241.             7 : ValToBuffer(rmin,rmax,imin,imax,maxiter); |
  242.             8 : ValToBuffer(rmin,rmax,imin,imax,maxiter); EXIT; |
  243.             ELSE;
  244.           END;
  245.         END;
  246.         msg:=GetMsg(wi^.userPort);
  247.       END; (* WHILE *)
  248.     END;   (* LOOP  *)
  249.     CloseWindow(wi);
  250.   END GetLimits;
  251.  
  252.  
  253. BEGIN
  254.   (*** Info Text initialisieren ***)
  255.  
  256.   Copy(infotext,  " Fast Fractal Exploration Set 4.0 |");
  257.   Concat(infotext,"  This program is public domain!  |");
  258.   Concat(infotext,"  Code & Design by Rob Brandner   |");
  259.   Concat(infotext,"Algorithm : Int_16  Int_32  Real  |");
  260.   Concat(infotext,"Precision : 10E-04  10E-09  10E-16|");
  261.   Concat(infotext,"Speed     : fast    medium  slow  ");
  262.  
  263.   ok:=""; nok:="OK";
  264.  
  265.   (*** Limit-Requester-Strukturen initialisieren *********************)
  266.  
  267.   FOR i:=0 TO 3 DO
  268.     WITH strinfo[i] DO
  269.       buffer:=ADR(buff[i]);maxChars:=21; undoBuffer:=ADR(undo);
  270.       bufferPos:=0;dispPos:=0;
  271.     END;
  272.   END;
  273.  
  274.   WITH strinfo[4] DO
  275.     buffer:=ADR(iterbuff);maxChars:=6; undoBuffer:=ADR(undo);
  276.     bufferPos:=0;dispPos:=0;
  277.   END;
  278.  
  279.   InitGad(0, 58,16,104,8,STR,strGadget,ADR(strinfo[0]));
  280.   InitGad(1,179,16,104,8,STR,strGadget,ADR(strinfo[1]));
  281.   InitGad(2, 58,34,104,8,STR,strGadget,ADR(strinfo[2]));
  282.   InitGad(3,179,34,104,8,STR,strGadget,ADR(strinfo[3]));
  283.   InitGad(4,106,52, 56,8,STR,strGadget,ADR(strinfo[4]));
  284.  
  285.   InitGad(5, 15,69,56,13,BOOL,boolGadget,NIL);
  286.   InitGad(6, 85,69,56,13,BOOL,boolGadget,NIL);
  287.   InitGad(7,155,69,56,13,BOOL,boolGadget,NIL);
  288.   InitGad(8,225,69,56,13,BOOL,boolGadget,NIL);
  289.  
  290.   FOR i:=0 TO 7 DO gad[i].nextGadget:=ADR(gad[i+1]) END;
  291.  
  292.   WITH nw DO
  293.     width:=300; height:=89; detailPen:=0; blockPen:=1;
  294.     idcmpFlags:=IDCMPFlagSet{gadgetUp,closeWindow};
  295.     flags:=WindowFlagSet{windowDrag,windowClose,activate,noCareRefresh};
  296.     firstGadget:=ADR(gad[0]); checkMark:=NIL;
  297.     title:=ADR("Setup Limits for Rendering");
  298.     screen:=NIL; bitMap:=NIL;
  299.     minWidth:=0; minHeight:=0; maxWidth:=-1; maxHeight:=-1;
  300.     type:=customScreen;
  301.   END;
  302.  
  303. END Request.mod
  304.  
  305.